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.Nums (FloatBE, FloatLE, Int16BE, Int16LE, Int24BE, Int24LE, Int32BE, Int32LE, Word16BE, Word16LE,
                    Word24BE, Word24LE, Word32BE, Word32LE)
import Dahdit.Sizes (ByteCount, ElementCount, StaticByteSized (..))
import Data.ByteString.Short (ShortByteString)
import Data.Int (Int8)
import Data.Primitive (ByteArray, Prim)
import Data.Primitive.PrimArray (PrimArray)
import Data.Proxy (Proxy (..))
import Data.Sequence (Seq)
import Data.Word (Word8)

data GetStaticSeqF a where
  GetStaticSeqF :: (StaticByteSized z) => !ElementCount -> 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 ElementCount
n Get z
g Seq z -> a
k) = forall z a.
StaticByteSized z =>
ElementCount -> Get z -> (Seq z -> a) -> GetStaticSeqF a
GetStaticSeqF ElementCount
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 :: (StaticByteSized z, Prim z) => !ElementCount -> Proxy z -> (PrimArray z -> a) -> GetStaticArrayF a

instance Functor GetStaticArrayF where
  fmap :: forall a b. (a -> b) -> GetStaticArrayF a -> GetStaticArrayF b
fmap a -> b
f (GetStaticArrayF ElementCount
n Proxy z
p PrimArray z -> a
k) = forall z a.
(StaticByteSized z, Prim z) =>
ElementCount -> Proxy z -> (PrimArray z -> a) -> GetStaticArrayF a
GetStaticArrayF ElementCount
n Proxy z
p (a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimArray 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)
  | GetFFloatLE (FloatLE -> a)
  | GetFWord16BE (Word16BE -> a)
  | GetFInt16BE (Int16BE -> a)
  | GetFWord24BE (Word24BE -> a)
  | GetFInt24BE (Int24BE -> a)
  | GetFWord32BE (Word32BE -> a)
  | GetFInt32BE (Int32BE -> a)
  | GetFFloatBE (FloatBE -> 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 !String
  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. String -> GetF a
GetFFail String
msg)))

data PutStaticSeqF a where
  PutStaticSeqF :: StaticByteSized z => !ElementCount -> !(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 ElementCount
n Maybe z
z z -> PutM ()
p Seq z
s a
k) = forall z a.
StaticByteSized z =>
ElementCount
-> Maybe z -> (z -> PutM ()) -> Seq z -> a -> PutStaticSeqF a
PutStaticSeqF ElementCount
n Maybe z
z z -> PutM ()
p Seq z
s (a -> b
f a
k)

data PutStaticArrayF a where
  PutStaticArrayF :: (StaticByteSized z, Prim z) => !ElementCount -> !(Maybe z) -> !(PrimArray z) -> a -> PutStaticArrayF a

instance Functor PutStaticArrayF where
  fmap :: forall a b. (a -> b) -> PutStaticArrayF a -> PutStaticArrayF b
fmap a -> b
f (PutStaticArrayF ElementCount
n Maybe z
z PrimArray z
a a
k) = forall z a.
(StaticByteSized z, Prim z) =>
ElementCount -> Maybe z -> PrimArray z -> a -> PutStaticArrayF a
PutStaticArrayF ElementCount
n Maybe z
z PrimArray 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
  | PutFFloatLE !FloatLE a
  | PutFWord16BE !Word16BE a
  | PutFInt16BE !Int16BE a
  | PutFWord24BE !Word24BE a
  | PutFInt24BE !Int24BE a
  | PutFWord32BE !Word32BE a
  | PutFInt32BE !Int32BE a
  | PutFFloatBE !FloatBE 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 ()