{-# LANGUAGE UndecidableInstances #-} -- for various stuff
{-# LANGUAGE AllowAmbiguousTypes #-} -- for type-level sum type handling
{-# LANGUAGE OverloadedStrings #-} -- for easy error building

module Binrep.Get
  ( module Binrep.Get
  , module Binrep.Get.Error
  ) where

import Binrep.Get.Error
import Data.Text.Builder.Linear qualified as TBL
import GHC.Exts ( fromString )
import Binrep.Util.ByteOrder
import Binrep.Common.Via.Prim ( ViaPrim(..) )
import Raehik.Compat.Data.Primitive.Types ( Prim', sizeOf )
import Raehik.Compat.Data.Primitive.Types.Endian ( ByteSwap )

import Binrep.Get.Struct ( GetC(getC), GetterC )
import Bytezap.Parser.Struct qualified as BZ
import Binrep.CBLen ( IsCBLen(CBLen), cblen )
import GHC.TypeLits ( KnownNat )

import FlatParse.Basic qualified as FP
import Raehik.Compat.FlatParse.Basic.Prim qualified as FP
import Raehik.Compat.FlatParse.Basic.CutWithPos qualified as FP
import Raehik.Compat.FlatParse.Basic.Remaining qualified as FP

import Data.ByteString qualified as B

import Binrep.Common.Class.TypeErrors ( ENoSum, ENoEmpty )
import GHC.TypeLits ( TypeError )

import GHC.Generics
import Generic.Data.Function.Traverse
import Generic.Data.MetaParse.Cstr ( Raw, ParseCstrTo )
import Generic.Type.Assert

import GHC.Exts ( minusAddr#, Int(I#), Int#, plusAddr#, (+#) )

import Rerefined.Refine
import Rerefined.Predicate.Logical.And

import Data.Word
import Data.Int
import Data.Void
import Binrep.Common.Via.Generically.NonSum

import Generic.Data.FOnCstr
import Generic.Data.Function.Traverse.Constructor hiding ( ENoEmpty )
import GHC.Exts ( Proxy# )

import Data.Typeable ( Typeable, TypeRep, typeRep, Proxy(Proxy) )

type Getter = FP.Parser (ParseError FP.Pos TBL.Builder)

class Get a where
    -- | Parse from binary.
    get :: Getter a

runGet
    :: Get a
    => B.ByteString
    -> Either (ParseError Int TBL.Builder) (a, B.ByteString)
runGet :: forall a.
Get a =>
ByteString -> Either (ParseError Int Builder) (a, ByteString)
runGet = Getter a
-> ByteString -> Either (ParseError Int Builder) (a, ByteString)
forall a.
Getter a
-> ByteString -> Either (ParseError Int Builder) (a, ByteString)
runGetter Getter a
forall a. Get a => Getter a
get

runGetter
    :: Getter a
    -> B.ByteString
    -> Either (ParseError Int TBL.Builder) (a, B.ByteString)
runGetter :: forall a.
Getter a
-> ByteString -> Either (ParseError Int Builder) (a, ByteString)
runGetter Getter a
p ByteString
bs =
    case Getter a -> ByteString -> Result (ParseError Pos Builder) a
forall e a. Parser e a -> ByteString -> Result e a
FP.runParser Getter a
p ByteString
bs of
      FP.OK   a
a ByteString
bs' -> (a, ByteString) -> Either (ParseError Int Builder) (a, ByteString)
forall a b. b -> Either a b
Right (a
a, ByteString
bs')
      FP.Err  ParseError Pos Builder
e     ->
        -- TODO check this is right. might need length of bs' ... ?
        ParseError Int Builder
-> Either (ParseError Int Builder) (a, ByteString)
forall a b. a -> Either a b
Left (ParseError Int Builder
 -> Either (ParseError Int Builder) (a, ByteString))
-> ParseError Int Builder
-> Either (ParseError Int Builder) (a, ByteString)
forall a b. (a -> b) -> a -> b
$ (ParseErrorSingle Pos Builder -> ParseErrorSingle Int Builder)
-> ParseError Pos Builder -> ParseError Int Builder
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Pos -> Int)
-> ParseErrorSingle Pos Builder -> ParseErrorSingle Int Builder
forall pos1 pos2 text.
(pos1 -> pos2)
-> ParseErrorSingle pos1 text -> ParseErrorSingle pos2 text
mapParseErrorSinglePos (\(FP.Pos Int
pos) -> Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pos)) ParseError Pos Builder
e
      Result (ParseError Pos Builder) a
FP.Fail       -> ParseError Int Builder
-> Either (ParseError Int Builder) (a, ByteString)
forall a b. a -> Either a b
Left []
  where len :: Int
len = ByteString -> Int
B.length ByteString
bs

instance GenericTraverse Get where
    type GenericTraverseF Get = Getter
    type GenericTraverseC Get a = Get a
    genericTraverseAction :: forall a.
GenericTraverseC Get a =>
String
-> String -> Maybe String -> Natural -> GenericTraverseF Get a
genericTraverseAction String
dtName String
cstrName Maybe String
mFieldName Natural
fieldIdx =
        Getter a
forall a. Get a => Getter a
get Getter a -> [Builder] -> Getter a
forall (st :: ZeroBitType) text a.
ParserT st (ParseError Pos text) a
-> [text] -> ParserT st (ParseError Pos text) a
`cutting1` [Builder]
e
      where
        e :: [Builder]
e = String -> String -> Maybe String -> Natural -> [Builder]
parseErrorTextGenericFieldBld String
dtName String
cstrName Maybe String
mFieldName Natural
fieldIdx

getGenericNonSum
    :: forall a
    .  ( Generic a, GTraverseNonSum Get (Rep a)
       , GAssertNotVoid a, GAssertNotSum a
    ) => Getter a
getGenericNonSum :: forall a.
(Generic a, GTraverseNonSum Get (Rep a), GAssertNotVoid a,
 GAssertNotSum a) =>
Getter a
getGenericNonSum = forall {k} (tag :: k) a.
(Generic a, Functor (GenericTraverseF tag),
 GTraverseNonSum tag (Rep a)) =>
GenericTraverseF tag a
forall (tag :: Type -> Constraint) a.
(Generic a, Functor (GenericTraverseF tag),
 GTraverseNonSum tag (Rep a)) =>
GenericTraverseF tag a
genericTraverseNonSum @Get

instance
  ( Generic a, GTraverseNonSum Get (Rep a)
  , GAssertNotVoid a, GAssertNotSum a
  ) => Get (GenericallyNonSum a) where
    get :: Getter (GenericallyNonSum a)
get = a -> GenericallyNonSum a
forall a. a -> GenericallyNonSum a
GenericallyNonSum (a -> GenericallyNonSum a)
-> ParserT PureMode (ParseError Pos Builder) a
-> Getter (GenericallyNonSum a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT PureMode (ParseError Pos Builder) a
forall a.
(Generic a, GTraverseNonSum Get (Rep a), GAssertNotVoid a,
 GAssertNotSum a) =>
Getter a
getGenericNonSum

getGenericSum
    :: forall sumtag pt a
    .  ( Generic a, GTraverseSum Get sumtag (Rep a)
       , Get pt
       , GAssertNotVoid a, GAssertSum a
    ) => ParseCstrTo sumtag pt
      -> (pt -> pt -> Bool)
      -> Getter a
getGenericSum :: forall {k} (sumtag :: k) pt a.
(Generic a, GTraverseSum Get sumtag (Rep a), Get pt,
 GAssertNotVoid a, GAssertSum a) =>
ParseCstrTo sumtag pt -> (pt -> pt -> Bool) -> Getter a
getGenericSum ParseCstrTo sumtag pt
parseCstr pt -> pt -> Bool
ptEq =
    forall {k1} {k2} (tag :: k1) (sumtag :: k2) a pt.
(Generic a, Functor (GenericTraverseF tag),
 GTraverseSum tag sumtag (Rep a)) =>
ParseCstrTo sumtag pt
-> (String -> GenericTraverseF tag pt)
-> (forall x. String -> GenericTraverseF tag x)
-> (pt -> pt -> Bool)
-> GenericTraverseF tag a
forall (tag :: Type -> Constraint) (sumtag :: k) a pt.
(Generic a, Functor (GenericTraverseF tag),
 GTraverseSum tag sumtag (Rep a)) =>
ParseCstrTo sumtag pt
-> (String -> GenericTraverseF tag pt)
-> (forall x. String -> GenericTraverseF tag x)
-> (pt -> pt -> Bool)
-> GenericTraverseF tag a
genericTraverseSum @Get @sumtag Proxy# x -> pt
ParseCstrTo sumtag pt
parseCstr String -> ParserT PureMode (ParseError Pos Builder) pt
String -> GenericTraverseF Get pt
forall {a}.
Get a =>
String -> ParserT PureMode (ParseError Pos Builder) a
ptGet String -> ParserT PureMode (ParseError Pos Builder) x
String -> GenericTraverseF Get x
forall {st :: ZeroBitType} {a}.
String -> ParserT st (ParseError Pos Builder) a
forall x. String -> GenericTraverseF Get x
fNoMatch pt -> pt -> Bool
ptEq
  where
      fNoMatch :: String -> ParserT st (ParseError Pos Builder) a
fNoMatch String
dtName = [Builder] -> ParserT st (ParseError Pos Builder) a
forall text (st :: ZeroBitType) a.
[text] -> ParserT st (ParseError Pos text) a
err1 (String -> [Builder]
parseErrorTextGenericNoCstrMatchBld String
dtName)
      ptGet :: String -> ParserT PureMode (ParseError Pos Builder) a
ptGet String
dtName = ParserT PureMode (ParseError Pos Builder) a
forall a. Get a => Getter a
get ParserT PureMode (ParseError Pos Builder) a
-> [Builder] -> ParserT PureMode (ParseError Pos Builder) a
forall (st :: ZeroBitType) text a.
ParserT st (ParseError Pos text) a
-> [text] -> ParserT st (ParseError Pos text) a
`cutting1` String -> [Builder]
parseErrorTextGenericSumTagBld String
dtName

getGenericSumRaw
    :: forall pt a
    .  ( Generic a, GTraverseSum Get Raw (Rep a)
       , Get pt
       , GAssertNotVoid a, GAssertSum a
    ) => (String -> pt)
      -> (pt -> pt -> Bool)
      -> Getter a
getGenericSumRaw :: forall pt a.
(Generic a, GTraverseSum Get Raw (Rep a), Get pt, GAssertNotVoid a,
 GAssertSum a) =>
(String -> pt) -> (pt -> pt -> Bool) -> Getter a
getGenericSumRaw String -> pt
parseCstr pt -> pt -> Bool
ptEq =
    forall {k} (tag :: k) a pt.
(Generic a, Functor (GenericTraverseF tag),
 GTraverseSum tag Raw (Rep a)) =>
(String -> pt)
-> (String -> GenericTraverseF tag pt)
-> (forall x. String -> GenericTraverseF tag x)
-> (pt -> pt -> Bool)
-> GenericTraverseF tag a
forall (tag :: Type -> Constraint) a pt.
(Generic a, Functor (GenericTraverseF tag),
 GTraverseSum tag Raw (Rep a)) =>
(String -> pt)
-> (String -> GenericTraverseF tag pt)
-> (forall x. String -> GenericTraverseF tag x)
-> (pt -> pt -> Bool)
-> GenericTraverseF tag a
genericTraverseSumRaw @Get String -> pt
parseCstr String -> ParserT PureMode (ParseError Pos Builder) pt
String -> GenericTraverseF Get pt
forall {a}.
Get a =>
String -> ParserT PureMode (ParseError Pos Builder) a
ptGet String -> ParserT PureMode (ParseError Pos Builder) x
String -> GenericTraverseF Get x
forall {st :: ZeroBitType} {a}.
String -> ParserT st (ParseError Pos Builder) a
forall x. String -> GenericTraverseF Get x
fNoMatch pt -> pt -> Bool
ptEq
  where
      fNoMatch :: String -> ParserT st (ParseError Pos Builder) a
fNoMatch String
dtName = [Builder] -> ParserT st (ParseError Pos Builder) a
forall text (st :: ZeroBitType) a.
[text] -> ParserT st (ParseError Pos text) a
err1 (String -> [Builder]
parseErrorTextGenericNoCstrMatchBld String
dtName)
      ptGet :: String -> ParserT PureMode (ParseError Pos Builder) a
ptGet String
dtName = ParserT PureMode (ParseError Pos Builder) a
forall a. Get a => Getter a
get ParserT PureMode (ParseError Pos Builder) a
-> [Builder] -> ParserT PureMode (ParseError Pos Builder) a
forall (st :: ZeroBitType) text a.
ParserT st (ParseError Pos text) a
-> [text] -> ParserT st (ParseError Pos text) a
`cutting1` String -> [Builder]
parseErrorTextGenericSumTagBld String
dtName

-- | Emit a single error. Use with flatparse primitives that only 'FP.Fail'.
err1 :: [text] -> FP.ParserT st (ParseError FP.Pos text) a
err1 :: forall text (st :: ZeroBitType) a.
[text] -> ParserT st (ParseError Pos text) a
err1 = (Pos -> ParseError Pos text) -> ParserT st (ParseError Pos text) a
forall e (st :: ZeroBitType) a. (Pos -> e) -> ParserT st e a
FP.err' ((Pos -> ParseError Pos text)
 -> ParserT st (ParseError Pos text) a)
-> ([text] -> Pos -> ParseError Pos text)
-> [text]
-> ParserT st (ParseError Pos text) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [text] -> Pos -> ParseError Pos text
forall text pos. [text] -> pos -> ParseError pos text
parseError1

-- | Turn a 'FP.Fail' into a single error. (Re-emits existing 'FP.Error's.)
--
-- Use when wrapping flatparse primitives that directly only 'FP.Fail'. (It's
-- fine to use with combinators if the combinator itself doesn't 'FP.Error'.)
cut1
    :: FP.ParserT st (ParseError FP.Pos text) a -> [text]
    -> FP.ParserT st (ParseError FP.Pos text) a
cut1 :: forall (st :: ZeroBitType) text a.
ParserT st (ParseError Pos text) a
-> [text] -> ParserT st (ParseError Pos text) a
cut1 ParserT st (ParseError Pos text) a
p [text]
texts = ParserT st (ParseError Pos text) a
p ParserT st (ParseError Pos text) a
-> (Pos -> ParseError Pos text)
-> ParserT st (ParseError Pos text) a
forall (st :: ZeroBitType) e a.
ParserT st e a -> (Pos -> e) -> ParserT st e a
`FP.cut'` [text] -> Pos -> ParseError Pos text
forall text pos. [text] -> pos -> ParseError pos text
parseError1 [text]
texts

-- | Turn a 'FP.Fail' into a single error, or prepend it to any existing ones.
--
-- Use when wrapping other 'get'ters.
--
-- We reimplement 'FP.cutting' with a tweak. Otherwise, we'd have to join lists
-- in the error case (instead of simply prepending).
cutting1
    :: FP.ParserT st (ParseError FP.Pos text) a -> [text]
    -> FP.ParserT st (ParseError FP.Pos text) a
cutting1 :: forall (st :: ZeroBitType) text a.
ParserT st (ParseError Pos text) a
-> [text] -> ParserT st (ParseError Pos text) a
cutting1 (FP.ParserT ForeignPtrContents
-> Addr# -> Addr# -> st -> Res# st (ParseError Pos text) a
p) [text]
texts =
    ParserT st (ParseError Pos text) Pos
forall (st :: ZeroBitType) e. ParserT st e Pos
FP.getPos ParserT st (ParseError Pos text) Pos
-> (Pos -> ParserT st (ParseError Pos text) a)
-> ParserT st (ParseError Pos text) a
forall a b.
ParserT st (ParseError Pos text) a
-> (a -> ParserT st (ParseError Pos text) b)
-> ParserT st (ParseError Pos text) b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Pos
pos -> (ForeignPtrContents
 -> Addr# -> Addr# -> st -> Res# st (ParseError Pos text) a)
-> ParserT st (ParseError Pos text) a
forall (st :: ZeroBitType) e a.
(ForeignPtrContents -> Addr# -> Addr# -> st -> Res# st e a)
-> ParserT st e a
FP.ParserT ((ForeignPtrContents
  -> Addr# -> Addr# -> st -> Res# st (ParseError Pos text) a)
 -> ParserT st (ParseError Pos text) a)
-> (ForeignPtrContents
    -> Addr# -> Addr# -> st -> Res# st (ParseError Pos text) a)
-> ParserT st (ParseError Pos text) a
forall a b. (a -> b) -> a -> b
$ \ForeignPtrContents
fp Addr#
eob Addr#
s st
st ->
        case ForeignPtrContents
-> Addr# -> Addr# -> st -> Res# st (ParseError Pos text) a
p ForeignPtrContents
fp Addr#
eob Addr#
s st
st of
          FP.Fail# st
st'    -> st -> ParseError Pos text -> Res# st (ParseError Pos text) a
forall (st :: ZeroBitType) e a. st -> e -> Res# st e a
FP.Err# st
st' [Pos -> [text] -> ParseErrorSingle Pos text
forall pos text. pos -> [text] -> ParseErrorSingle pos text
ParseErrorSingle Pos
pos [text]
texts]
          FP.Err#  st
st' ParseError Pos text
e' -> st -> ParseError Pos text -> Res# st (ParseError Pos text) a
forall (st :: ZeroBitType) e a. st -> e -> Res# st e a
FP.Err# st
st' (Pos -> [text] -> ParseErrorSingle Pos text
forall pos text. pos -> [text] -> ParseErrorSingle pos text
ParseErrorSingle Pos
pos [text]
texts ParseErrorSingle Pos text
-> ParseError Pos text -> ParseError Pos text
forall a. a -> [a] -> [a]
: ParseError Pos text
e')
          Res# st (ParseError Pos text) a
x            -> Res# st (ParseError Pos text) a
x

-- We can't provide a Generically instance because the user must choose between
-- sum and non-sum handlers.

instance GenericFOnCstr Get where
    type GenericFOnCstrF Get = Getter
    type GenericFOnCstrC Get dtName cstrName gf =
        GTraverseC Get dtName cstrName 0 gf
    genericFOnCstrF :: forall {k1} (dtName :: Symbol) (cstrName :: Symbol)
       (gf :: k1 -> Type) (p :: k1).
GenericFOnCstrC Get dtName cstrName gf =>
Proxy# '(dtName, cstrName) -> GenericFOnCstrF Get (gf p)
genericFOnCstrF (Proxy# '(dtName, cstrName)
_ :: Proxy# '(dtName, cstrName)) =
        forall {k} {k1} (tag :: k) (cd :: Symbol) (cc :: Symbol)
       (si :: Natural) (gf :: k1 -> Type) (p :: k1).
GTraverseC tag cd cc si gf =>
GenericTraverseF tag (gf p)
forall (tag :: Type -> Constraint) (cd :: Symbol) (cc :: Symbol)
       (si :: Natural) (gf :: k1 -> Type) (p :: k1).
GTraverseC tag cd cc si gf =>
GenericTraverseF tag (gf p)
gTraverseC @Get @dtName @cstrName @0

-- TODO this is hard to parse visually. document...?
fpToBz
    :: FP.ParserT st (ParseError FP.Pos text) a -> Int#
    -> (a -> Int# -> BZ.ParserT st (ParseError Int text) r)
    -> BZ.ParserT st (ParseError Int text) r
fpToBz :: forall (st :: ZeroBitType) text a r.
ParserT st (ParseError Pos text) a
-> Int#
-> (a -> Int# -> ParserT st (ParseError Int text) r)
-> ParserT st (ParseError Int text) r
fpToBz (FP.ParserT ForeignPtrContents
-> Addr# -> Addr# -> st -> Res# st (ParseError Pos text) a
p) Int#
len# a -> Int# -> ParserT st (ParseError Int text) r
fp = ParserT# st (ParseError Int text) r
-> ParserT st (ParseError Int text) r
forall (st :: ZeroBitType) e a. ParserT# st e a -> ParserT st e a
BZ.ParserT (ParserT# st (ParseError Int text) r
 -> ParserT st (ParseError Int text) r)
-> ParserT# st (ParseError Int text) r
-> ParserT st (ParseError Int text) r
forall a b. (a -> b) -> a -> b
$ \ForeignPtrContents
fpc Addr#
base# Int#
os# st
st0 ->
    case ForeignPtrContents
-> Addr# -> Addr# -> st -> Res# st (ParseError Pos text) a
p ForeignPtrContents
fpc (Addr#
base# Addr# -> Int# -> Addr#
`plusAddr#` (Int#
os# Int# -> Int# -> Int#
+# Int#
len#)) (Addr#
base# Addr# -> Int# -> Addr#
`plusAddr#` Int#
os#) st
st0 of
      FP.OK#   st
st1 a
a Addr#
s ->
        let unconsumed# :: Int#
unconsumed# = Addr#
s Addr# -> Addr# -> Int#
`minusAddr#` (Addr#
base# Addr# -> Int# -> Addr#
`plusAddr#` Int#
os#)
        in  ParserT st (ParseError Int text) r
-> ParserT# st (ParseError Int text) r
forall (st :: ZeroBitType) e a. ParserT st e a -> ParserT# st e a
BZ.runParserT# (a -> Int# -> ParserT st (ParseError Int text) r
fp a
a Int#
unconsumed#) ForeignPtrContents
fpc Addr#
base# (Int#
os# Int# -> Int# -> Int#
+# Int#
unconsumed#) st
st1
      FP.Err#  st
st1 ParseError Pos text
e   ->
        -- on error, we turn the flatparse 'FP.Pos' indices into actual byte
        -- offsets (which bytezap deals in), then emit
        let e' :: ParseError Int text
e' = (ParseErrorSingle Pos text -> ParseErrorSingle Int text)
-> ParseError Pos text -> ParseError Int text
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Pos -> Int)
-> ParseErrorSingle Pos text -> ParseErrorSingle Int text
forall pos1 pos2 text.
(pos1 -> pos2)
-> ParseErrorSingle pos1 text -> ParseErrorSingle pos2 text
mapParseErrorSinglePos (\(FP.Pos Int
pos) -> Int# -> Int
I# Int#
len# Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pos)) ParseError Pos text
e
        in  st -> ParseError Int text -> Res# st (ParseError Int text) r
forall (st :: ZeroBitType) e a. st -> e -> Res# st e a
BZ.Err# st
st1 ParseError Int text
e'
      FP.Fail# st
st1     -> st -> Res# st (ParseError Int text) r
forall (st :: ZeroBitType) e a. st -> Res# st e a
BZ.Fail# st
st1

newtype ViaGetC a = ViaGetC { forall a. ViaGetC a -> a
unViaGetC :: a }
instance (GetC a, KnownNat (CBLen a)) => Get (ViaGetC a) where
    {-# INLINE get #-}
    get :: Getter (ViaGetC a)
get = a -> ViaGetC a
forall a. a -> ViaGetC a
ViaGetC (a -> ViaGetC a)
-> ParserT PureMode (ParseError Pos Builder) a
-> Getter (ViaGetC a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> GetterC a -> ParserT PureMode (ParseError Pos Builder) a
forall a. KnownNat (CBLen a) => GetterC a -> Getter a
bzToFp GetterC a
forall a. GetC a => GetterC a
getC

-- TODO messy ran out of input handling. should be a util for it
-- TODO pos handling seems correct on quick test. need stronger assertion plz
bzToFp :: forall a. KnownNat (CBLen a) => GetterC a -> Getter a
bzToFp :: forall a. KnownNat (CBLen a) => GetterC a -> Getter a
bzToFp (BZ.ParserT ParserT# PureMode (ParseError Int Builder) a
p) =
    (Int -> ParserT PureMode (ParseError Pos Builder) ()
forall (st :: ZeroBitType) e. Int -> ParserT st e ()
FP.ensure (Int# -> Int
I# Int#
len#) ParserT PureMode (ParseError Pos Builder) ()
-> [Builder] -> ParserT PureMode (ParseError Pos Builder) ()
forall (st :: ZeroBitType) text a.
ParserT st (ParseError Pos text) a
-> [text] -> ParserT st (ParseError Pos text) a
`cut1` [Builder]
eRanOut) ParserT PureMode (ParseError Pos Builder) ()
-> ParserT PureMode (ParseError Pos Builder) Pos
-> ParserT PureMode (ParseError Pos Builder) Pos
forall a b.
ParserT PureMode (ParseError Pos Builder) a
-> ParserT PureMode (ParseError Pos Builder) b
-> ParserT PureMode (ParseError Pos Builder) b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> ParserT PureMode (ParseError Pos Builder) Pos
forall (st :: ZeroBitType) e. ParserT st e Pos
FP.getPos ParserT PureMode (ParseError Pos Builder) Pos
-> (Pos -> ParserT PureMode (ParseError Pos Builder) a)
-> ParserT PureMode (ParseError Pos Builder) a
forall a b.
ParserT PureMode (ParseError Pos Builder) a
-> (a -> ParserT PureMode (ParseError Pos Builder) b)
-> ParserT PureMode (ParseError Pos Builder) b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(FP.Pos Int
pos) ->
        (ForeignPtrContents
 -> Addr#
 -> Addr#
 -> PureMode
 -> Res# PureMode (ParseError Pos Builder) a)
-> ParserT PureMode (ParseError Pos Builder) a
forall (st :: ZeroBitType) e a.
(ForeignPtrContents -> Addr# -> Addr# -> st -> Res# st e a)
-> ParserT st e a
FP.ParserT ((ForeignPtrContents
  -> Addr#
  -> Addr#
  -> PureMode
  -> Res# PureMode (ParseError Pos Builder) a)
 -> ParserT PureMode (ParseError Pos Builder) a)
-> (ForeignPtrContents
    -> Addr#
    -> Addr#
    -> PureMode
    -> Res# PureMode (ParseError Pos Builder) a)
-> ParserT PureMode (ParseError Pos Builder) a
forall a b. (a -> b) -> a -> b
$ \ForeignPtrContents
fpc Addr#
_eob Addr#
s PureMode
st0 ->
            case ParserT# PureMode (ParseError Int Builder) a
p ForeignPtrContents
fpc Addr#
s Int#
0# PureMode
st0 of
              BZ.OK#   PureMode
st1 a
a -> PureMode -> a -> Addr# -> Res# PureMode (ParseError Pos Builder) a
forall (st :: ZeroBitType) a e. st -> a -> Addr# -> Res# st e a
FP.OK#   PureMode
st1 a
a (Addr#
s Addr# -> Int# -> Addr#
`plusAddr#` Int#
len#)
              BZ.Err#  PureMode
st1 ParseError Int Builder
e ->
                let e' :: ParseError Pos Builder
e' = (ParseErrorSingle Int Builder -> ParseErrorSingle Pos Builder)
-> ParseError Int Builder -> ParseError Pos Builder
forall a b. (a -> b) -> [a] -> [b]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int -> Pos)
-> ParseErrorSingle Int Builder -> ParseErrorSingle Pos Builder
forall pos1 pos2 text.
(pos1 -> pos2)
-> ParseErrorSingle pos1 text -> ParseErrorSingle pos2 text
mapParseErrorSinglePos (\Int
idx -> Int -> Pos
FP.Pos (Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
idx))) ParseError Int Builder
e
                in  PureMode
-> ParseError Pos Builder
-> Res# PureMode (ParseError Pos Builder) a
forall (st :: ZeroBitType) e a. st -> e -> Res# st e a
FP.Err# PureMode
st1 ParseError Pos Builder
e'
              BZ.Fail# PureMode
st1   -> PureMode -> Res# PureMode (ParseError Pos Builder) a
forall (st :: ZeroBitType) e a. st -> Res# st e a
FP.Fail# PureMode
st1
  where
    !(I# Int#
len#) = forall a. KnownNat (CBLen a) => Int
forall {k} (a :: k). KnownNat (CBLen a) => Int
cblen @a
    eRanOut :: [Builder]
eRanOut = [ Builder
"ran out of input while running inner parser"
              , Builder
"bytes needed: "Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>Int -> Builder
forall a. (Integral a, FiniteBits a) => a -> Builder
TBL.fromDec (Int# -> Int
I# Int#
len#) ]

instance TypeError ENoEmpty => Get Void where get :: Getter Void
get = Getter Void
forall a. HasCallStack => a
undefined
instance TypeError ENoSum => Get (Either a b) where get :: Getter (Either a b)
get = Getter (Either a b)
forall a. HasCallStack => a
undefined

{-

-- | Parse a bytestring and... immediate reserialize it.
--
-- Note that this _does_ perform work: we make a new bytestring so we don't rely
-- on the input bytestring. To use the input bytestring directly, see
-- "Binrep.Type.Thin".
instance Get Write where
    {-# INLINE get #-}
    get = fmap BZ.byteString $ fmap B.copy $ FP.takeRest

-}

-- | Unit type parses nothing.
instance Get () where
    {-# INLINE get #-}
    get :: ParserT PureMode (ParseError Pos Builder) ()
get = () -> ParserT PureMode (ParseError Pos Builder) ()
forall a. a -> ParserT PureMode (ParseError Pos Builder) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()

-- | Parse tuples left-to-right.
instance (Get l, Get r) => Get (l, r) where
    {-# INLINE get #-}
    get :: Getter (l, r)
get = do
        l
l <- Getter l
forall a. Get a => Getter a
get
        r
r <- Getter r
forall a. Get a => Getter a
get
        (l, r) -> Getter (l, r)
forall a. a -> ParserT PureMode (ParseError Pos Builder) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (l
l, r
r)

-- | Parse elements until EOF. Sometimes used at the "top" of binary formats.
instance Get a => Get [a] where
    -- TODO slow, uses reverse. build a DList instead
    get :: Getter [a]
get = [a] -> Getter [a]
forall {a}.
Get a =>
[a] -> ParserT PureMode (ParseError Pos Builder) [a]
go []
      where
        go :: [a] -> ParserT PureMode (ParseError Pos Builder) [a]
go [a]
as = ParserT PureMode (ParseError Pos Builder) ()
-> ParserT PureMode (ParseError Pos Builder) [a]
-> ParserT PureMode (ParseError Pos Builder) [a]
-> ParserT PureMode (ParseError Pos Builder) [a]
forall (st :: ZeroBitType) e a b.
ParserT st e a
-> ParserT st e b -> ParserT st e b -> ParserT st e b
FP.branch ParserT PureMode (ParseError Pos Builder) ()
forall (st :: ZeroBitType) e. ParserT st e ()
FP.eof ([a] -> ParserT PureMode (ParseError Pos Builder) [a]
forall a. a -> ParserT PureMode (ParseError Pos Builder) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
as)) (Getter a
forall a. Get a => Getter a
get Getter a
-> (a -> ParserT PureMode (ParseError Pos Builder) [a])
-> ParserT PureMode (ParseError Pos Builder) [a]
forall a b.
ParserT PureMode (ParseError Pos Builder) a
-> (a -> ParserT PureMode (ParseError Pos Builder) b)
-> ParserT PureMode (ParseError Pos Builder) b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
a -> [a] -> ParserT PureMode (ParseError Pos Builder) [a]
go (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as))

-- | Return the rest of the input.
--
-- A plain unannotated bytestring isn't very useful -- you'll usually want to
-- null-terminate or length-prefix it.
--
-- Note that this _does_ perform work: we make a new bytestring so we don't rely
-- on the input bytestring. To use the input bytestring directly, see
-- "Binrep.Type.Thin".
instance Get B.ByteString where
    {-# INLINE get #-}
    get :: Getter ByteString
get = ByteString -> ByteString
B.copy (ByteString -> ByteString)
-> Getter ByteString -> Getter ByteString
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Getter ByteString
forall (st :: ZeroBitType) e. ParserT st e ByteString
FP.takeRest

-- | 8-bit (1-byte) words do not require byte order in order to precisely
--   define their representation.
deriving via ViaPrim Word8 instance Get Word8

-- | 8-bit (1-byte) words do not require byte order in order to precisely
--   define their representation.
deriving via ViaPrim  Int8 instance Get  Int8

-- | Byte order is irrelevant for 8-bit (1-byte) words.
deriving via Word8 instance Get (ByteOrdered end Word8)

-- | Byte order is irrelevant for 8-bit (1-byte) words.
deriving via  Int8 instance Get (ByteOrdered end  Int8)

-- | Parse any 'Prim''.
getPrim :: forall a. (Prim' a, Typeable a) => Getter a
getPrim :: forall a. (Prim' a, Typeable a) => Getter a
getPrim = do
    Int
lenAvail <- ParserT PureMode (ParseError Pos Builder) Int
forall (st :: ZeroBitType) e. ParserT st e Int
FP.remaining
    Getter a
forall a e (st :: ZeroBitType). Prim' a => ParserT st e a
FP.anyPrim Getter a -> [Builder] -> Getter a
forall (st :: ZeroBitType) text a.
ParserT st (ParseError Pos text) a
-> [text] -> ParserT st (ParseError Pos text) a
`cut1`
        [  Builder
"ran out of bytes while parsing " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
strTR
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
", needed "    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
strLenNeed
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
", remaining " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall a. (Integral a, FiniteBits a) => a -> Builder
TBL.fromDec Int
lenAvail
        ]
  where
    strTR :: Builder
strTR       = String -> Builder
forall a. IsString a => String -> a
fromString (TypeRep -> String
forall a. Show a => a -> String
show (forall a. Typeable a => TypeRep
forall {k} (a :: k). Typeable a => TypeRep
typeRep' @a))
    strLenNeed :: Builder
strLenNeed  = Int -> Builder
forall a. (Integral a, FiniteBits a) => a -> Builder
TBL.fromDec (a -> Int
forall a. Prim a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a))

typeRep' :: forall a. Typeable a => TypeRep
typeRep' :: forall {k} (a :: k). Typeable a => TypeRep
typeRep' = Proxy a -> TypeRep
forall {k} (proxy :: k -> Type) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @a)

instance (Prim' a, Typeable a) => Get (ViaPrim a) where
    get :: Getter (ViaPrim a)
get = a -> ViaPrim a
forall a. a -> ViaPrim a
ViaPrim (a -> ViaPrim a)
-> ParserT PureMode (ParseError Pos Builder) a
-> Getter (ViaPrim a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT PureMode (ParseError Pos Builder) a
forall a. (Prim' a, Typeable a) => Getter a
getPrim

-- ByteSwap is required on opposite endian platforms, but we're not checking
-- here, so make sure to keep it on both.
deriving via ViaPrim (ByteOrdered LittleEndian a)
    instance (Prim' a, ByteSwap a, Typeable a)
      => Get (ByteOrdered LittleEndian a)
deriving via ViaPrim (ByteOrdered    BigEndian a)
    instance (Prim' a, ByteSwap a, Typeable a)
      => Get (ByteOrdered    BigEndian a)

instance Get (Refined pr (Refined pl a)) => Get (Refined (pl `And` pr) a) where
    get :: Getter (Refined (And pl pr) a)
get = (a -> Refined (And pl pr) a
forall {k} a (p :: k). a -> Refined p a
unsafeRefine (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) a. Refined p a -> a
forall {k} (p :: k) a. Refined p a -> a
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) a. Refined p a -> a
forall {k} (p :: k) a. Refined p a -> a
unrefine @pr) (Refined pr (Refined pl a) -> Refined (And pl pr) a)
-> ParserT
     PureMode (ParseError Pos Builder) (Refined pr (Refined pl a))
-> Getter (Refined (And pl pr) a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT
  PureMode (ParseError Pos Builder) (Refined pr (Refined pl a))
forall a. Get a => Getter a
get

{-

-- | A type that can be parsed from binary given some environment.
--
-- Making this levity polymorphic makes things pretty strange, but is useful.
-- See @Binrep.Example.FileTable@.
class GetWith (r :: TYPE rep) a | a -> r where
    -- | Parse from binary with the given environment.
    getWith :: r -> Getter a
    -- can no longer provide default implementation due to levity polymorphism
    --default getWith :: Get a => r -> Getter a
    --getWith _ = get

--deriving anyclass instance Get a => GetWith r [a]

-- Note that @r@ is not levity polymorphic, GHC forces it to be lifted. You
-- can't bind (LHS) a levity polymorphic value.
runGetWith
    :: GetWith (r :: TYPE LiftedRep) a
    => r -> B.ByteString -> Either E (a, B.ByteString)
runGetWith r bs = runGetter (getWith r) bs

-}