content: {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE TypeOperators #-}
  {-# LANGUAGE RankNTypes #-}
  
  -----------------------------------------------------------------------------
  -- | Modified from cereal, which is
  -- Copyright   : Lennart Kolmodin, Galois Inc. 2009
  -- License     : BSD3-style
  
  module T9630a (
        Serialize(..), GSerialize (..), Putter, Get
      ) where
  
  import Data.ByteString.Builder (Builder)
  import Data.ByteString as B
  import GHC.Generics
  import Control.Applicative (Applicative (..), (<$>))
  
  class Serialize t where
      put :: Putter t
      get :: Get t
  
  instance Serialize () where
      put ()  = pure ()
      get     = pure ()
  
  -- Generics
  
  class GSerialize f where
      gPut :: Putter (f a)
      gGet :: Get (f a)
  
  instance (GSerialize a, GSerialize b) => GSerialize (a :*: b) where
      gPut (a :*: b) = gPut a *> gPut b
      gGet = (:*:) <$> gGet  <*> gGet
  
  instance GSerialize a => GSerialize (M1 i c a) where
      gPut = gPut . unM1
      gGet = M1 <$> gGet
  
  instance Serialize a => GSerialize (K1 i a) where
      gPut = put . unK1
      gGet = K1 <$> get
  
  
  -- Put
  
  data PairS a = PairS a !Builder
  
  newtype PutM a = Put { unPut :: PairS a }
  
  type Put = PutM ()
  
  type Putter a = a -> Put
  
  instance Functor PutM where
          fmap f m = Put $ let PairS a w = unPut m in PairS (f a) w
  
  instance Applicative PutM where
          pure a = Put (PairS a mempty)
  
          m <*> k = Put $
              let PairS f w  = unPut m
                  PairS x w' = unPut k
              in PairS (f x) (w `mappend` w')
  
  -- Get
  
  data Result r = Fail String B.ByteString
                | Partial (B.ByteString -> Result r)
                | Done r B.ByteString
  
  
  newtype Get a = Get
    { unGet :: forall r. Input -> Buffer -> More
                      -> Failure r -> Success a r
                      -> Result r }
  
  type Input  = B.ByteString
  type Buffer = Maybe B.ByteString
  
  type Failure   r = Input -> Buffer -> More -> [String] -> String -> Result r
  type Success a r = Input -> Buffer -> More -> a                  -> Result r
  
  data More
    = Complete
    | Incomplete (Maybe Int)
      deriving (Eq)
  
  
  instance Functor Get where
      fmap p m =        Get $ \ s0 b0 m0 kf ks ->
        unGet m s0 b0 m0 kf $ \ s1 b1 m1 a     -> ks s1 b1 m1 (p a)
  
  instance Applicative Get where
      pure a = Get $ \ s0 b0 m0 _ ks -> ks s0 b0 m0 a
  
      f <*> x =         Get $ \ s0 b0 m0 kf ks ->
        unGet f s0 b0 m0 kf $ \ s1 b1 m1 g     ->
        unGet x s1 b1 m1 kf $ \ s2 b2 m2 y     -> ks s2 b2 m2 (g y)
  