module Dahdit.Free
  ( GetStaticSeqF (..)
  , GetStaticArrayF (..)
  , GetLookAheadF (..)
  , GetScopeF (..)
  , ScopeMode (..)
  , GetF (..)
  , Get (..)
  , PutStaticSeqF (..)
  , PutStaticArrayF (..)
  , PutStaticHintF (..)
  , PutF (..)
  , PutM (..)
  , Put
  )
where

import Control.Monad.Free.Church (F (..))
import Dahdit.LiftedPrim (LiftedPrim)
import Dahdit.LiftedPrimArray (LiftedPrimArray)
import Dahdit.Nums
  ( DoubleBE
  , DoubleLE
  , FloatBE
  , FloatLE
  , Int16BE
  , Int16LE
  , Int24BE
  , Int24LE
  , Int32BE
  , Int32LE
  , Int64BE
  , Int64LE
  , Word16BE
  , Word16LE
  , Word24BE
  , Word24LE
  , Word32BE
  , Word32LE
  , Word64BE
  , Word64LE
  )
import Dahdit.Sizes (ByteCount, ElemCount, StaticByteSized (..))
import Data.ByteString.Short (ShortByteString)
import Data.Int (Int8)
import Data.Primitive (ByteArray)
import Data.Proxy (Proxy (..))
import Data.Sequence (Seq)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Word (Word8)

data GetStaticSeqF a where
  GetStaticSeqF :: (StaticByteSized z) => !ElemCount -> Get z -> (Seq z -> a) -> GetStaticSeqF a

instance Functor GetStaticSeqF where
  fmap :: forall a b. (a -> b) -> GetStaticSeqF a -> GetStaticSeqF b
fmap a -> b
f (GetStaticSeqF ElemCount
n Get z
g Seq z -> a
k) = forall z a.
StaticByteSized z =>
ElemCount -> Get z -> (Seq z -> a) -> GetStaticSeqF a
GetStaticSeqF ElemCount
n Get z
g (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq z -> a
k)

data GetStaticArrayF a where
  GetStaticArrayF :: (LiftedPrim z) => !ElemCount -> Proxy z -> (LiftedPrimArray z -> a) -> GetStaticArrayF a

instance Functor GetStaticArrayF where
  fmap :: forall a b. (a -> b) -> GetStaticArrayF a -> GetStaticArrayF b
fmap a -> b
f (GetStaticArrayF ElemCount
n Proxy z
p LiftedPrimArray z -> a
k) = forall z a.
LiftedPrim z =>
ElemCount
-> Proxy z -> (LiftedPrimArray z -> a) -> GetStaticArrayF a
GetStaticArrayF ElemCount
n Proxy z
p (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. LiftedPrimArray z -> a
k)

data GetLookAheadF a where
  GetLookAheadF :: Get z -> (z -> a) -> GetLookAheadF a

instance Functor GetLookAheadF where
  fmap :: forall a b. (a -> b) -> GetLookAheadF a -> GetLookAheadF b
fmap a -> b
f (GetLookAheadF Get z
g z -> a
k) = forall z a. Get z -> (z -> a) -> GetLookAheadF a
GetLookAheadF Get z
g (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. z -> a
k)

data GetScopeF a where
  GetScopeF :: !ScopeMode -> !ByteCount -> Get z -> (z -> a) -> GetScopeF a

instance Functor GetScopeF where
  fmap :: forall a b. (a -> b) -> GetScopeF a -> GetScopeF b
fmap a -> b
f (GetScopeF ScopeMode
sm ByteCount
bc Get z
g z -> a
k) = forall z a.
ScopeMode -> ByteCount -> Get z -> (z -> a) -> GetScopeF a
GetScopeF ScopeMode
sm ByteCount
bc Get z
g (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. z -> a
k)

data ScopeMode
  = ScopeModeExact
  | ScopeModeWithin
  deriving stock (ScopeMode -> ScopeMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScopeMode -> ScopeMode -> Bool
$c/= :: ScopeMode -> ScopeMode -> Bool
== :: ScopeMode -> ScopeMode -> Bool
$c== :: ScopeMode -> ScopeMode -> Bool
Eq, Int -> ScopeMode -> ShowS
[ScopeMode] -> ShowS
ScopeMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScopeMode] -> ShowS
$cshowList :: [ScopeMode] -> ShowS
show :: ScopeMode -> String
$cshow :: ScopeMode -> String
showsPrec :: Int -> ScopeMode -> ShowS
$cshowsPrec :: Int -> ScopeMode -> ShowS
Show)

data GetF a
  = GetFWord8 (Word8 -> a)
  | GetFInt8 (Int8 -> a)
  | GetFWord16LE (Word16LE -> a)
  | GetFInt16LE (Int16LE -> a)
  | GetFWord24LE (Word24LE -> a)
  | GetFInt24LE (Int24LE -> a)
  | GetFWord32LE (Word32LE -> a)
  | GetFInt32LE (Int32LE -> a)
  | GetFWord64LE (Word64LE -> a)
  | GetFInt64LE (Int64LE -> a)
  | GetFFloatLE (FloatLE -> a)
  | GetFDoubleLE (DoubleLE -> a)
  | GetFWord16BE (Word16BE -> a)
  | GetFInt16BE (Int16BE -> a)
  | GetFWord24BE (Word24BE -> a)
  | GetFInt24BE (Int24BE -> a)
  | GetFWord32BE (Word32BE -> a)
  | GetFInt32BE (Int32BE -> a)
  | GetFWord64BE (Word64BE -> a)
  | GetFInt64BE (Int64BE -> a)
  | GetFFloatBE (FloatBE -> a)
  | GetFDoubleBE (DoubleBE -> a)
  | GetFShortByteString !ByteCount (ShortByteString -> a)
  | GetFStaticSeq !(GetStaticSeqF a)
  | GetFStaticArray !(GetStaticArrayF a)
  | GetFByteArray !ByteCount (ByteArray -> a)
  | GetFScope !(GetScopeF a)
  | GetFSkip !ByteCount a
  | GetFLookAhead !(GetLookAheadF a)
  | GetFRemainingSize (ByteCount -> a)
  | GetFFail !Text
  deriving stock (forall a b. a -> GetF b -> GetF a
forall a b. (a -> b) -> GetF a -> GetF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> GetF b -> GetF a
$c<$ :: forall a b. a -> GetF b -> GetF a
fmap :: forall a b. (a -> b) -> GetF a -> GetF b
$cfmap :: forall a b. (a -> b) -> GetF a -> GetF b
Functor)

newtype Get a = Get {forall a. Get a -> F GetF a
unGet :: F GetF a}
  deriving newtype (forall a b. a -> Get b -> Get a
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Get b -> Get a
$c<$ :: forall a b. a -> Get b -> Get a
fmap :: forall a b. (a -> b) -> Get a -> Get b
$cfmap :: forall a b. (a -> b) -> Get a -> Get b
Functor, Functor Get
forall a. a -> Get a
forall a b. Get a -> Get b -> Get a
forall a b. Get a -> Get b -> Get b
forall a b. Get (a -> b) -> Get a -> Get b
forall a b c. (a -> b -> c) -> Get a -> Get b -> Get c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. Get a -> Get b -> Get a
$c<* :: forall a b. Get a -> Get b -> Get a
*> :: forall a b. Get a -> Get b -> Get b
$c*> :: forall a b. Get a -> Get b -> Get b
liftA2 :: forall a b c. (a -> b -> c) -> Get a -> Get b -> Get c
$cliftA2 :: forall a b c. (a -> b -> c) -> Get a -> Get b -> Get c
<*> :: forall a b. Get (a -> b) -> Get a -> Get b
$c<*> :: forall a b. Get (a -> b) -> Get a -> Get b
pure :: forall a. a -> Get a
$cpure :: forall a. a -> Get a
Applicative, Applicative Get
forall a. a -> Get a
forall a b. Get a -> Get b -> Get b
forall a b. Get a -> (a -> Get b) -> Get b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> Get a
$creturn :: forall a. a -> Get a
>> :: forall a b. Get a -> Get b -> Get b
$c>> :: forall a b. Get a -> Get b -> Get b
>>= :: forall a b. Get a -> (a -> Get b) -> Get b
$c>>= :: forall a b. Get a -> (a -> Get b) -> Get b
Monad)

instance MonadFail Get where
  fail :: forall a. String -> Get a
fail String
msg = forall a. F GetF a -> Get a
Get (forall (f :: * -> *) a.
(forall r. (a -> r) -> (f r -> r) -> r) -> F f a
F (\a -> r
_ GetF r -> r
y -> GetF r -> r
y (forall a. Text -> GetF a
GetFFail (String -> Text
T.pack String
msg))))

data PutStaticSeqF a where
  PutStaticSeqF :: (StaticByteSized z) => !ElemCount -> !(Maybe z) -> (z -> Put) -> !(Seq z) -> a -> PutStaticSeqF a

instance Functor PutStaticSeqF where
  fmap :: forall a b. (a -> b) -> PutStaticSeqF a -> PutStaticSeqF b
fmap a -> b
f (PutStaticSeqF ElemCount
n Maybe z
z z -> PutM ()
p Seq z
s a
k) = forall z a.
StaticByteSized z =>
ElemCount
-> Maybe z -> (z -> PutM ()) -> Seq z -> a -> PutStaticSeqF a
PutStaticSeqF ElemCount
n Maybe z
z z -> PutM ()
p Seq z
s (a -> b
f a
k)

data PutStaticArrayF a where
  PutStaticArrayF :: (LiftedPrim z) => !ElemCount -> !(Maybe z) -> !(LiftedPrimArray z) -> a -> PutStaticArrayF a

instance Functor PutStaticArrayF where
  fmap :: forall a b. (a -> b) -> PutStaticArrayF a -> PutStaticArrayF b
fmap a -> b
f (PutStaticArrayF ElemCount
n Maybe z
z LiftedPrimArray z
a a
k) = forall z a.
LiftedPrim z =>
ElemCount -> Maybe z -> LiftedPrimArray z -> a -> PutStaticArrayF a
PutStaticArrayF ElemCount
n Maybe z
z LiftedPrimArray z
a (a -> b
f a
k)

data PutStaticHintF a where
  PutStaticHintF :: !ByteCount -> Put -> a -> PutStaticHintF a

instance Functor PutStaticHintF where
  fmap :: forall a b. (a -> b) -> PutStaticHintF a -> PutStaticHintF b
fmap a -> b
f (PutStaticHintF ByteCount
n PutM ()
p a
k) = forall a. ByteCount -> PutM () -> a -> PutStaticHintF a
PutStaticHintF ByteCount
n PutM ()
p (a -> b
f a
k)

data PutF a
  = PutFWord8 !Word8 a
  | PutFInt8 !Int8 a
  | PutFWord16LE !Word16LE a
  | PutFInt16LE !Int16LE a
  | PutFWord24LE !Word24LE a
  | PutFInt24LE !Int24LE a
  | PutFWord32LE !Word32LE a
  | PutFInt32LE !Int32LE a
  | PutFWord64LE !Word64LE a
  | PutFInt64LE !Int64LE a
  | PutFFloatLE !FloatLE a
  | PutFDoubleLE !DoubleLE a
  | PutFWord16BE !Word16BE a
  | PutFInt16BE !Int16BE a
  | PutFWord24BE !Word24BE a
  | PutFInt24BE !Int24BE a
  | PutFWord32BE !Word32BE a
  | PutFWord64BE !Word64BE a
  | PutFInt64BE !Int64BE a
  | PutFInt32BE !Int32BE a
  | PutFFloatBE !FloatBE a
  | PutFDoubleBE !DoubleBE a
  | PutFShortByteString !ByteCount !ShortByteString a
  | PutFStaticSeq !(PutStaticSeqF a)
  | PutFStaticArray !(PutStaticArrayF a)
  | PutFByteArray !ByteCount !ByteArray a
  | PutFStaticHint !(PutStaticHintF a)
  deriving stock (forall a b. a -> PutF b -> PutF a
forall a b. (a -> b) -> PutF a -> PutF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> PutF b -> PutF a
$c<$ :: forall a b. a -> PutF b -> PutF a
fmap :: forall a b. (a -> b) -> PutF a -> PutF b
$cfmap :: forall a b. (a -> b) -> PutF a -> PutF b
Functor)

newtype PutM a = PutM {forall a. PutM a -> F PutF a
unPutM :: F PutF a}
  deriving newtype (forall a b. a -> PutM b -> PutM a
forall a b. (a -> b) -> PutM a -> PutM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> PutM b -> PutM a
$c<$ :: forall a b. a -> PutM b -> PutM a
fmap :: forall a b. (a -> b) -> PutM a -> PutM b
$cfmap :: forall a b. (a -> b) -> PutM a -> PutM b
Functor, Functor PutM
forall a. a -> PutM a
forall a b. PutM a -> PutM b -> PutM a
forall a b. PutM a -> PutM b -> PutM b
forall a b. PutM (a -> b) -> PutM a -> PutM b
forall a b c. (a -> b -> c) -> PutM a -> PutM b -> PutM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. PutM a -> PutM b -> PutM a
$c<* :: forall a b. PutM a -> PutM b -> PutM a
*> :: forall a b. PutM a -> PutM b -> PutM b
$c*> :: forall a b. PutM a -> PutM b -> PutM b
liftA2 :: forall a b c. (a -> b -> c) -> PutM a -> PutM b -> PutM c
$cliftA2 :: forall a b c. (a -> b -> c) -> PutM a -> PutM b -> PutM c
<*> :: forall a b. PutM (a -> b) -> PutM a -> PutM b
$c<*> :: forall a b. PutM (a -> b) -> PutM a -> PutM b
pure :: forall a. a -> PutM a
$cpure :: forall a. a -> PutM a
Applicative, Applicative PutM
forall a. a -> PutM a
forall a b. PutM a -> PutM b -> PutM b
forall a b. PutM a -> (a -> PutM b) -> PutM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> PutM a
$creturn :: forall a. a -> PutM a
>> :: forall a b. PutM a -> PutM b -> PutM b
$c>> :: forall a b. PutM a -> PutM b -> PutM b
>>= :: forall a b. PutM a -> (a -> PutM b) -> PutM b
$c>>= :: forall a b. PutM a -> (a -> PutM b) -> PutM b
Monad)

instance Semigroup (PutM ()) where
  PutM ()
p <> :: PutM () -> PutM () -> PutM ()
<> PutM ()
q = PutM ()
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> PutM ()
q

instance Monoid (PutM ()) where
  mappend :: PutM () -> PutM () -> PutM ()
mappend = forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: PutM ()
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

type Put = PutM ()