{-# LANGUAGE UndecidableInstances #-}
module Binrep.Get.Struct where
import Binrep.Get.Error
import Bytezap.Parser.Struct
import Bytezap.Parser.Struct.Generic
import Binrep.CBLen
import Foreign.Ptr ( Ptr )
import Data.Void ( Void )
import GHC.Exts ( Proxy#, Int(I#) )
import GHC.TypeNats ( KnownNat )
import GHC.Generics
import Binrep.Common.Via.Prim ( ViaPrim(..) )
import Raehik.Compat.Data.Primitive.Types ( Prim' )
import Data.Word ( Word8 )
import Data.Int ( Int8 )
import Binrep.Util.ByteOrder
import Data.Functor.Identity
import Raehik.Compat.Data.Primitive.Types.Endian ( ByteSwap )
import Data.ByteString qualified as B
import Generic.Type.Assert
import Binrep.Common.Via.Generically.NonSum
import Refined
import Refined.Unsafe
type GetterC = Parser E
class GetC a where getC :: GetterC a
runGetCBs
:: forall a. (GetC a, KnownNat (CBLen a))
=> B.ByteString -> Either E a
runGetCBs :: forall a. (GetC a, KnownNat (CBLen a)) => ByteString -> Either E a
runGetCBs ByteString
bs =
if forall a. KnownNat (CBLen a) => Int
forall {k} (a :: k). KnownNat (CBLen a) => Int
cblen @a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteString -> Int
B.length ByteString
bs
then (forall e. ByteString -> Parser e a -> Result e a)
-> ByteString -> Either E a
forall a buf.
GetC a =>
(forall e. buf -> Parser e a -> Result e a) -> buf -> Either E a
unsafeRunGetC' ByteString -> Parser e a -> Result e a
forall e. ByteString -> Parser e a -> Result e a
forall a e. ByteString -> Parser e a -> Result e a
unsafeRunParserBs ByteString
bs
else E -> Either E a
forall a b. a -> Either a b
Left (E -> Either E a) -> E -> Either E a
forall a b. (a -> b) -> a -> b
$ Int -> EMiddle -> E
E Int
0 (EMiddle -> E) -> EMiddle -> E
forall a b. (a -> b) -> a -> b
$ EBase -> EMiddle
EBase (EBase -> EMiddle) -> EBase -> EMiddle
forall a b. (a -> b) -> a -> b
$ Int -> EBase
ERanOut Int
0
unsafeRunGetC'
:: forall a buf. GetC a
=> (forall e. buf -> Parser e a -> Result e a)
-> buf -> Either E a
unsafeRunGetC' :: forall a buf.
GetC a =>
(forall e. buf -> Parser e a -> Result e a) -> buf -> Either E a
unsafeRunGetC' forall e. buf -> Parser e a -> Result e a
p buf
buf =
case buf -> Parser E a -> Result E a
forall e. buf -> Parser e a -> Result e a
p buf
buf Parser E a
forall a. GetC a => GetterC a
getC of
OK a
a -> a -> Either E a
forall a b. b -> Either a b
Right a
a
Result E a
Fail -> E -> Either E a
forall a b. a -> Either a b
Left E
EFail
Err E
e -> E -> Either E a
forall a b. a -> Either a b
Left E
e
unsafeRunGetCPtr
:: forall a. GetC a
=> Ptr Word8 -> Either E a
unsafeRunGetCPtr :: forall a. GetC a => Ptr Word8 -> Either E a
unsafeRunGetCPtr = (forall e. Ptr Word8 -> Parser e a -> Result e a)
-> Ptr Word8 -> Either E a
forall a buf.
GetC a =>
(forall e. buf -> Parser e a -> Result e a) -> buf -> Either E a
unsafeRunGetC' Ptr Word8 -> Parser e a -> Result e a
forall e. Ptr Word8 -> Parser e a -> Result e a
forall a e. Ptr Word8 -> Parser e a -> Result e a
unsafeRunParserPtr
instance GParseBase GetC where
type GParseBaseSt GetC = Proxy# Void
type GParseBaseC GetC a = GetC a
type GParseBaseE GetC = E
gParseBase :: forall a.
GParseBaseC GetC a =>
ParserT (GParseBaseSt GetC) (GParseBaseE GetC) a
gParseBase = GetterC a
ParserT (GParseBaseSt GetC) (GParseBaseE GetC) a
forall a. GetC a => GetterC a
getC
type GParseBaseLenTF GetC = CBLenSym
getGenericStruct
:: forall a
. ( Generic a, GParse GetC (Rep a)
, GAssertNotVoid a, GAssertNotSum a
) => GetterC a
getGenericStruct :: forall a.
(Generic a, GParse GetC (Rep a), GAssertNotVoid a,
GAssertNotSum a) =>
GetterC a
getGenericStruct = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (Rep a Any -> a)
-> ParserT PureMode E (Rep a Any) -> ParserT PureMode E a
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {k} {k1} (tag :: k) (gf :: k1 -> Type) (p :: k1).
GParse tag gf =>
ParserT (GParseBaseSt tag) (GParseBaseE tag) (gf p)
forall (tag :: Type -> Constraint) (gf :: Type -> Type) p.
GParse tag gf =>
ParserT (GParseBaseSt tag) (GParseBaseE tag) (gf p)
gParse @GetC
instance
( Generic a, GParse GetC (Rep a)
, GAssertNotVoid a, GAssertNotSum a
) => GetC (Generically a) where
getC :: GetterC (Generically a)
getC = a -> Generically a
forall a. a -> Generically a
Generically (a -> Generically a)
-> ParserT PureMode E a -> GetterC (Generically a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT PureMode E a
forall a.
(Generic a, GParse GetC (Rep a), GAssertNotVoid a,
GAssertNotSum a) =>
GetterC a
getGenericStruct
instance
( Generic a, GParse GetC (Rep a)
, GAssertNotVoid a, GAssertNotSum a
) => GetC (GenericallyNonSum a) where
getC :: GetterC (GenericallyNonSum a)
getC = a -> GenericallyNonSum a
forall a. a -> GenericallyNonSum a
GenericallyNonSum (a -> GenericallyNonSum a)
-> ParserT PureMode E a -> GetterC (GenericallyNonSum a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT PureMode E a
forall a.
(Generic a, GParse GetC (Rep a), GAssertNotVoid a,
GAssertNotSum a) =>
GetterC a
getGenericStruct
instance GetC (Refined pr (Refined pl a))
=> GetC (Refined (pl `And` pr) a) where
getC :: GetterC (Refined (And pl pr) a)
getC = (a -> Refined (And pl pr) a
forall {k} x (p :: k). x -> Refined p x
reallyUnsafeRefine (a -> Refined (And pl pr) a)
-> (Refined pr (Refined pl a) -> a)
-> Refined pr (Refined pl a)
-> Refined (And pl pr) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: k) x. Refined p x -> x
forall {k} (p :: k) x. Refined p x -> x
unrefine @pl (Refined pl a -> a)
-> (Refined pr (Refined pl a) -> Refined pl a)
-> Refined pr (Refined pl a)
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: k1) x. Refined p x -> x
forall {k} (p :: k) x. Refined p x -> x
unrefine @pr) (Refined pr (Refined pl a) -> Refined (And pl pr) a)
-> ParserT PureMode E (Refined pr (Refined pl a))
-> GetterC (Refined (And pl pr) a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT PureMode E (Refined pr (Refined pl a))
forall a. GetC a => GetterC a
getC
instance GetC () where
{-# INLINE getC #-}
getC :: GetterC ()
getC = () -> GetterC ()
forall a (st :: ZeroBitType) e. a -> ParserT st e a
constParse ()
instance Prim' a => GetC (ViaPrim a) where
getC :: GetterC (ViaPrim a)
getC = a -> ViaPrim a
forall a. a -> ViaPrim a
ViaPrim (a -> ViaPrim a) -> ParserT PureMode E a -> GetterC (ViaPrim a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT PureMode E a
forall a (st :: ZeroBitType) e. Prim' a => ParserT st e a
prim
{-# INLINE getC #-}
instance GetC a => GetC (Identity a) where getC :: GetterC (Identity a)
getC = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> ParserT PureMode E a -> GetterC (Identity a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT PureMode E a
forall a. GetC a => GetterC a
getC
deriving via ViaPrim Word8 instance GetC Word8
deriving via ViaPrim Int8 instance GetC Int8
deriving via Word8 instance GetC (ByteOrdered end Word8)
deriving via Int8 instance GetC (ByteOrdered end Int8)
deriving via ViaPrim (ByteOrdered 'LittleEndian a)
instance (Prim' a, ByteSwap a) => GetC (ByteOrdered 'LittleEndian a)
deriving via ViaPrim (ByteOrdered 'BigEndian a)
instance (Prim' a, ByteSwap a) => GetC (ByteOrdered 'BigEndian a)
eCBase :: EBase -> GetterC a
eCBase :: forall a. EBase -> GetterC a
eCBase EBase
eb = ParserT# PureMode E a -> ParserT PureMode E a
forall (st :: ZeroBitType) e a. ParserT# st e a -> ParserT st e a
ParserT (ParserT# PureMode E a -> ParserT PureMode E a)
-> ParserT# PureMode E a -> ParserT PureMode E a
forall a b. (a -> b) -> a -> b
$ \ForeignPtrContents
_fpc Addr#
_base Int#
os# PureMode
st ->
PureMode -> E -> Res# PureMode E a
forall (st :: ZeroBitType) e a. st -> e -> Res# st e a
Err# PureMode
st (Int -> EMiddle -> E
E (Int# -> Int
I# Int#
os#) (EMiddle -> E) -> EMiddle -> E
forall a b. (a -> b) -> a -> b
$ EBase -> EMiddle
EBase EBase
eb)
getECBase :: GetterC a -> EBase -> GetterC a
getECBase :: forall a. GetterC a -> EBase -> GetterC a
getECBase (ParserT ParserT# PureMode E a
p) EBase
eb = ParserT# PureMode E a -> ParserT PureMode E a
forall (st :: ZeroBitType) e a. ParserT# st e a -> ParserT st e a
ParserT (ParserT# PureMode E a -> ParserT PureMode E a)
-> ParserT# PureMode E a -> ParserT PureMode E a
forall a b. (a -> b) -> a -> b
$ \ForeignPtrContents
fpc Addr#
base Int#
os# PureMode
st0 ->
case ParserT# PureMode E a
p ForeignPtrContents
fpc Addr#
base Int#
os# PureMode
st0 of
Fail# PureMode
st1 -> PureMode -> E -> Res# PureMode E a
forall (st :: ZeroBitType) e a. st -> e -> Res# st e a
Err# PureMode
st1 (Int -> EMiddle -> E
E (Int# -> Int
I# Int#
os#) (EMiddle -> E) -> EMiddle -> E
forall a b. (a -> b) -> a -> b
$ EBase -> EMiddle
EBase EBase
eb)
Err# PureMode
st1 E
e -> PureMode -> E -> Res# PureMode E a
forall (st :: ZeroBitType) e a. st -> e -> Res# st e a
Err# PureMode
st1 (Int -> EMiddle -> E
E (Int# -> Int
I# Int#
os#) (EMiddle -> E) -> EMiddle -> E
forall a b. (a -> b) -> a -> b
$ E -> EBase -> EMiddle
EAnd E
e EBase
eb)
Res# PureMode E a
x -> Res# PureMode E a
x