{-# LANGUAGE UndecidableInstances #-} -- required below GHC 9.6
{-# LANGUAGE BlockArguments #-}

module Binrep.Get
  ( Getter, Get(..), runGet, runGetter
  , E(..), EBase(..), EGeneric(..), EGenericSum(..)
  , eBase
  , getEBase
  -- , GetWith(..), runGetWith
  , getPrim
  , getGenericNonSum, getGenericSum
  ) where

import Data.Functor.Identity
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 FlatParse.Basic qualified as FP
import Raehik.Compat.FlatParse.Basic.Prim qualified as FP

import Data.ByteString qualified as B

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

import Data.Void
import Data.Word
import Data.Int

import Data.Text ( Text )

import Numeric.Natural

import GHC.Generics
import Generic.Data.Function.Traverse
import Generic.Data.Function.Common
import Generic.Data.Rep.Assert

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

type Getter a = FP.Parser E a

-- | Structured parse error.
data E
  = E Int EMiddle

  -- | Unhandled parse error.
  --
  -- You get this if you don't change a flatparse fail to an error.
  --
  -- Should not be set except by library code.
  | EFail

    deriving stock (E -> E -> Bool
(E -> E -> Bool) -> (E -> E -> Bool) -> Eq E
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: E -> E -> Bool
== :: E -> E -> Bool
$c/= :: E -> E -> Bool
/= :: E -> E -> Bool
Eq, Int -> E -> ShowS
[E] -> ShowS
E -> String
(Int -> E -> ShowS) -> (E -> String) -> ([E] -> ShowS) -> Show E
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> E -> ShowS
showsPrec :: Int -> E -> ShowS
$cshow :: E -> String
show :: E -> String
$cshowList :: [E] -> ShowS
showList :: [E] -> ShowS
Show, (forall x. E -> Rep E x) -> (forall x. Rep E x -> E) -> Generic E
forall x. Rep E x -> E
forall x. E -> Rep E x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. E -> Rep E x
from :: forall x. E -> Rep E x
$cto :: forall x. Rep E x -> E
to :: forall x. Rep E x -> E
Generic)

data EMiddle

  -- | Parse error with no further context.
  = EBase EBase

  -- | Somehow, we got two parse errors.
  --
  -- I have a feeling that seeing this indicates a problem in your code.
  | EAnd E EBase

  -- | Parse error decorated with generic info.
  --
  -- Should not be set except by library code.
  | EGeneric String {- ^ data type name -} (EGeneric E)

    deriving stock (EMiddle -> EMiddle -> Bool
(EMiddle -> EMiddle -> Bool)
-> (EMiddle -> EMiddle -> Bool) -> Eq EMiddle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EMiddle -> EMiddle -> Bool
== :: EMiddle -> EMiddle -> Bool
$c/= :: EMiddle -> EMiddle -> Bool
/= :: EMiddle -> EMiddle -> Bool
Eq, Int -> EMiddle -> ShowS
[EMiddle] -> ShowS
EMiddle -> String
(Int -> EMiddle -> ShowS)
-> (EMiddle -> String) -> ([EMiddle] -> ShowS) -> Show EMiddle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EMiddle -> ShowS
showsPrec :: Int -> EMiddle -> ShowS
$cshow :: EMiddle -> String
show :: EMiddle -> String
$cshowList :: [EMiddle] -> ShowS
showList :: [EMiddle] -> ShowS
Show, (forall x. EMiddle -> Rep EMiddle x)
-> (forall x. Rep EMiddle x -> EMiddle) -> Generic EMiddle
forall x. Rep EMiddle x -> EMiddle
forall x. EMiddle -> Rep EMiddle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EMiddle -> Rep EMiddle x
from :: forall x. EMiddle -> Rep EMiddle x
$cto :: forall x. Rep EMiddle x -> EMiddle
to :: forall x. Rep EMiddle x -> EMiddle
Generic)

data EBase
  = EExpectedByte Word8 Word8
  -- ^ expected first, got second

  | EOverlong Int Int
  -- ^ expected first, got second

  | EExpected B.ByteString B.ByteString
  -- ^ expected first, got second

  | EFailNamed String
  -- ^ known fail

  | EFailParse String B.ByteString Word8
  -- ^ parse fail (where you parse a larger object, then a smaller one in it)

  | ERanOut Int
  -- ^ ran out of input, needed precisely @n@ bytes for this part (n > 0)
  --
  -- Actually a 'Natural', but we use 'Int' because that's what flatparse uses
  -- internally.

    deriving stock (EBase -> EBase -> Bool
(EBase -> EBase -> Bool) -> (EBase -> EBase -> Bool) -> Eq EBase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EBase -> EBase -> Bool
== :: EBase -> EBase -> Bool
$c/= :: EBase -> EBase -> Bool
/= :: EBase -> EBase -> Bool
Eq, Int -> EBase -> ShowS
[EBase] -> ShowS
EBase -> String
(Int -> EBase -> ShowS)
-> (EBase -> String) -> ([EBase] -> ShowS) -> Show EBase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EBase -> ShowS
showsPrec :: Int -> EBase -> ShowS
$cshow :: EBase -> String
show :: EBase -> String
$cshowList :: [EBase] -> ShowS
showList :: [EBase] -> ShowS
Show, (forall x. EBase -> Rep EBase x)
-> (forall x. Rep EBase x -> EBase) -> Generic EBase
forall x. Rep EBase x -> EBase
forall x. EBase -> Rep EBase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EBase -> Rep EBase x
from :: forall x. EBase -> Rep EBase x
$cto :: forall x. Rep EBase x -> EBase
to :: forall x. Rep EBase x -> EBase
Generic)

-- | A generic context layer for a parse error of type @e@.
--
-- Recursive: parse errors occurring in fields are wrapped up here. (Those
-- errors may also have a generic context layer.)
--
-- Making this explicitly recursive may seem strange, but it clarifies that this
-- data type is to be seen as a layer over a top-level type.
data EGeneric e
  -- | Parse error relating to sum types (constructors).
  = EGenericSum (EGenericSum e)

  -- | Parse error in a constructor field.
  | EGenericField
        String          -- ^ constructor name
        (Maybe String)  -- ^ field record name (if present)
        Natural         -- ^ field index in constructor
        e               -- ^ field parse error
    deriving stock (EGeneric e -> EGeneric e -> Bool
(EGeneric e -> EGeneric e -> Bool)
-> (EGeneric e -> EGeneric e -> Bool) -> Eq (EGeneric e)
forall e. Eq e => EGeneric e -> EGeneric e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall e. Eq e => EGeneric e -> EGeneric e -> Bool
== :: EGeneric e -> EGeneric e -> Bool
$c/= :: forall e. Eq e => EGeneric e -> EGeneric e -> Bool
/= :: EGeneric e -> EGeneric e -> Bool
Eq, Int -> EGeneric e -> ShowS
[EGeneric e] -> ShowS
EGeneric e -> String
(Int -> EGeneric e -> ShowS)
-> (EGeneric e -> String)
-> ([EGeneric e] -> ShowS)
-> Show (EGeneric e)
forall e. Show e => Int -> EGeneric e -> ShowS
forall e. Show e => [EGeneric e] -> ShowS
forall e. Show e => EGeneric e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall e. Show e => Int -> EGeneric e -> ShowS
showsPrec :: Int -> EGeneric e -> ShowS
$cshow :: forall e. Show e => EGeneric e -> String
show :: EGeneric e -> String
$cshowList :: forall e. Show e => [EGeneric e] -> ShowS
showList :: [EGeneric e] -> ShowS
Show, (forall x. EGeneric e -> Rep (EGeneric e) x)
-> (forall x. Rep (EGeneric e) x -> EGeneric e)
-> Generic (EGeneric e)
forall x. Rep (EGeneric e) x -> EGeneric e
forall x. EGeneric e -> Rep (EGeneric e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e x. Rep (EGeneric e) x -> EGeneric e
forall e x. EGeneric e -> Rep (EGeneric e) x
$cfrom :: forall e x. EGeneric e -> Rep (EGeneric e) x
from :: forall x. EGeneric e -> Rep (EGeneric e) x
$cto :: forall e x. Rep (EGeneric e) x -> EGeneric e
to :: forall x. Rep (EGeneric e) x -> EGeneric e
Generic)

data EGenericSum e
  -- | Parse error parsing prefix tag.
  = EGenericSumTag e

  -- | Unable to match a constructor to the parsed prefix tag.
  | EGenericSumTagNoMatch
        [String] -- ^ constructors tested
        Text     -- ^ prettified prefix tag
    deriving stock (EGenericSum e -> EGenericSum e -> Bool
(EGenericSum e -> EGenericSum e -> Bool)
-> (EGenericSum e -> EGenericSum e -> Bool) -> Eq (EGenericSum e)
forall e. Eq e => EGenericSum e -> EGenericSum e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall e. Eq e => EGenericSum e -> EGenericSum e -> Bool
== :: EGenericSum e -> EGenericSum e -> Bool
$c/= :: forall e. Eq e => EGenericSum e -> EGenericSum e -> Bool
/= :: EGenericSum e -> EGenericSum e -> Bool
Eq, Int -> EGenericSum e -> ShowS
[EGenericSum e] -> ShowS
EGenericSum e -> String
(Int -> EGenericSum e -> ShowS)
-> (EGenericSum e -> String)
-> ([EGenericSum e] -> ShowS)
-> Show (EGenericSum e)
forall e. Show e => Int -> EGenericSum e -> ShowS
forall e. Show e => [EGenericSum e] -> ShowS
forall e. Show e => EGenericSum e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall e. Show e => Int -> EGenericSum e -> ShowS
showsPrec :: Int -> EGenericSum e -> ShowS
$cshow :: forall e. Show e => EGenericSum e -> String
show :: EGenericSum e -> String
$cshowList :: forall e. Show e => [EGenericSum e] -> ShowS
showList :: [EGenericSum e] -> ShowS
Show, (forall x. EGenericSum e -> Rep (EGenericSum e) x)
-> (forall x. Rep (EGenericSum e) x -> EGenericSum e)
-> Generic (EGenericSum e)
forall x. Rep (EGenericSum e) x -> EGenericSum e
forall x. EGenericSum e -> Rep (EGenericSum e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall e x. Rep (EGenericSum e) x -> EGenericSum e
forall e x. EGenericSum e -> Rep (EGenericSum e) x
$cfrom :: forall e x. EGenericSum e -> Rep (EGenericSum e) x
from :: forall x. EGenericSum e -> Rep (EGenericSum e) x
$cto :: forall e x. Rep (EGenericSum e) x -> EGenericSum e
to :: forall x. Rep (EGenericSum e) x -> EGenericSum e
Generic)

eBase :: EBase -> Getter a
eBase :: forall a. EBase -> Getter a
eBase EBase
eb = (ForeignPtrContents
 -> Addr# -> Addr# -> PureMode -> Res# PureMode E a)
-> ParserT PureMode E a
forall (st :: ZeroBitType) e a.
(ForeignPtrContents -> Addr# -> Addr# -> st -> Res# st e a)
-> ParserT st e a
FP.ParserT \ForeignPtrContents
_fp Addr#
eob Addr#
s PureMode
st ->
    let os :: Int
os = Int# -> Int
I# (Addr# -> Addr# -> Int#
minusAddr# Addr#
eob Addr#
s)
     in PureMode -> E -> Res# PureMode E a
forall (st :: ZeroBitType) e a. st -> e -> Res# st e a
FP.Err# PureMode
st (Int -> EMiddle -> E
E Int
os (EMiddle -> E) -> EMiddle -> E
forall a b. (a -> b) -> a -> b
$ EBase -> EMiddle
EBase EBase
eb)

getEBase :: Getter a -> EBase -> Getter a
getEBase :: forall a. Getter a -> EBase -> Getter a
getEBase (FP.ParserT ForeignPtrContents
-> Addr# -> Addr# -> PureMode -> Res# PureMode E a
f) EBase
eb =
    (ForeignPtrContents
 -> Addr# -> Addr# -> PureMode -> Res# PureMode E a)
-> ParserT PureMode E a
forall (st :: ZeroBitType) e a.
(ForeignPtrContents -> Addr# -> Addr# -> st -> Res# st e a)
-> ParserT st e a
FP.ParserT \ForeignPtrContents
fp Addr#
eob Addr#
s PureMode
st ->
        let os :: Int
os = Int# -> Int
I# (Addr# -> Addr# -> Int#
minusAddr# Addr#
eob Addr#
s)
         in case ForeignPtrContents
-> Addr# -> Addr# -> PureMode -> Res# PureMode E a
f ForeignPtrContents
fp Addr#
eob Addr#
s PureMode
st of
              FP.Fail# PureMode
st'   -> PureMode -> E -> Res# PureMode E a
forall (st :: ZeroBitType) e a. st -> e -> Res# st e a
FP.Err# PureMode
st' (Int -> EMiddle -> E
E Int
os (EMiddle -> E) -> EMiddle -> E
forall a b. (a -> b) -> a -> b
$ EBase -> EMiddle
EBase EBase
eb)
              FP.Err#  PureMode
st' E
e -> PureMode -> E -> Res# PureMode E a
forall (st :: ZeroBitType) e a. st -> e -> Res# st e a
FP.Err# PureMode
st' (Int -> EMiddle -> E
E 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

-- | Parse. On parse error, coat it in a generic context layer.
getWrapGeneric :: Get a => String -> (E -> EGeneric E) -> Getter a
getWrapGeneric :: forall a. Get a => String -> (E -> EGeneric E) -> Getter a
getWrapGeneric = Getter a -> String -> (E -> EGeneric E) -> Getter a
forall a. Getter a -> String -> (E -> EGeneric E) -> Getter a
getWrapGeneric' Getter a
forall a. Get a => Getter a
get

getWrapGeneric' :: Getter a -> String -> (E -> EGeneric E) -> Getter a
getWrapGeneric' :: forall a. Getter a -> String -> (E -> EGeneric E) -> Getter a
getWrapGeneric' (FP.ParserT ForeignPtrContents
-> Addr# -> Addr# -> PureMode -> Res# PureMode E a
f) String
cd E -> EGeneric E
fe =
    (ForeignPtrContents
 -> Addr# -> Addr# -> PureMode -> Res# PureMode E a)
-> ParserT PureMode E a
forall (st :: ZeroBitType) e a.
(ForeignPtrContents -> Addr# -> Addr# -> st -> Res# st e a)
-> ParserT st e a
FP.ParserT \ForeignPtrContents
fp Addr#
eob Addr#
s PureMode
st ->
        let os :: Int
os = Int# -> Int
I# (Addr# -> Addr# -> Int#
minusAddr# Addr#
eob Addr#
s)
         in case ForeignPtrContents
-> Addr# -> Addr# -> PureMode -> Res# PureMode E a
f ForeignPtrContents
fp Addr#
eob Addr#
s PureMode
st of
              FP.Fail# PureMode
st'   -> PureMode -> E -> Res# PureMode E a
forall (st :: ZeroBitType) e a. st -> e -> Res# st e a
FP.Err# PureMode
st' (Int -> EMiddle -> E
E Int
os (EMiddle -> E) -> EMiddle -> E
forall a b. (a -> b) -> a -> b
$ String -> EGeneric E -> EMiddle
EGeneric String
cd (EGeneric E -> EMiddle) -> EGeneric E -> EMiddle
forall a b. (a -> b) -> a -> b
$ E -> EGeneric E
fe E
EFail)
              FP.Err#  PureMode
st' E
e -> PureMode -> E -> Res# PureMode E a
forall (st :: ZeroBitType) e a. st -> e -> Res# st e a
FP.Err# PureMode
st' (Int -> EMiddle -> E
E Int
os (EMiddle -> E) -> EMiddle -> E
forall a b. (a -> b) -> a -> b
$ String -> EGeneric E -> EMiddle
EGeneric String
cd (EGeneric E -> EMiddle) -> EGeneric E -> EMiddle
forall a b. (a -> b) -> a -> b
$ E -> EGeneric E
fe E
e)
              Res# PureMode E a
x -> Res# PureMode E a
x

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

runGet :: Get a => B.ByteString -> Either E (a, B.ByteString)
runGet :: forall a. Get a => ByteString -> Either E (a, ByteString)
runGet = Getter a -> ByteString -> Either E (a, ByteString)
forall a. Getter a -> ByteString -> Either E (a, ByteString)
runGetter Getter a
forall a. Get a => Getter a
get

runGetter :: Getter a -> B.ByteString -> Either E (a, B.ByteString)
runGetter :: forall a. Getter a -> ByteString -> Either E (a, ByteString)
runGetter Getter a
g ByteString
bs = case Getter a -> ByteString -> Result E a
forall e a. Parser e a -> ByteString -> Result e a
FP.runParser Getter a
g ByteString
bs of
                   FP.OK a
a ByteString
bs' -> (a, ByteString) -> Either E (a, ByteString)
forall a b. b -> Either a b
Right (a
a, ByteString
bs')
                   Result E a
FP.Fail     -> E -> Either E (a, ByteString)
forall a b. a -> Either a b
Left E
EFail
                   FP.Err E
e    -> E -> Either E (a, ByteString)
forall a b. a -> Either a b
Left E
e

instance GenericTraverse Get where
    type GenericTraverseF Get = FP.Parser E
    type GenericTraverseC Get a = Get a
    genericTraverseAction :: forall a.
GenericTraverseC Get a =>
String
-> String -> Maybe String -> Natural -> GenericTraverseF Get a
genericTraverseAction String
cd String
cc Maybe String
mcs Natural
si =
        String -> (E -> EGeneric E) -> Getter a
forall a. Get a => String -> (E -> EGeneric E) -> Getter a
getWrapGeneric String
cd ((E -> EGeneric E) -> Getter a) -> (E -> EGeneric E) -> Getter a
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> Natural -> E -> EGeneric E
forall e. String -> Maybe String -> Natural -> e -> EGeneric e
EGenericField String
cc Maybe String
mcs Natural
si

instance GenericTraverseSum Get where
    genericTraverseSumPfxTagAction :: forall pt.
GenericTraverseC Get pt =>
String -> GenericTraverseF Get pt
genericTraverseSumPfxTagAction String
cd =
        String -> (E -> EGeneric E) -> Getter pt
forall a. Get a => String -> (E -> EGeneric E) -> Getter a
getWrapGeneric String
cd ((E -> EGeneric E) -> Getter pt) -> (E -> EGeneric E) -> Getter pt
forall a b. (a -> b) -> a -> b
$ EGenericSum E -> EGeneric E
forall e. EGenericSum e -> EGeneric e
EGenericSum (EGenericSum E -> EGeneric E)
-> (E -> EGenericSum E) -> E -> EGeneric E
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E -> EGenericSum E
forall e. e -> EGenericSum e
EGenericSumTag
    -- TODO proper offset info
    genericTraverseSumNoMatchingCstrAction :: forall a. String -> [String] -> Text -> GenericTraverseF Get a
genericTraverseSumNoMatchingCstrAction String
cd [String]
cstrs Text
ptText =
        E -> ParserT PureMode E a
forall e (st :: ZeroBitType) a. e -> ParserT st e a
FP.err (E -> ParserT PureMode E a) -> E -> ParserT PureMode 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
$ String -> EGeneric E -> EMiddle
EGeneric String
cd (EGeneric E -> EMiddle) -> EGeneric E -> EMiddle
forall a b. (a -> b) -> a -> b
$ EGenericSum E -> EGeneric E
forall e. EGenericSum e -> EGeneric e
EGenericSum (EGenericSum E -> EGeneric E) -> EGenericSum E -> EGeneric E
forall a b. (a -> b) -> a -> b
$ [String] -> Text -> EGenericSum E
forall e. [String] -> Text -> EGenericSum e
EGenericSumTagNoMatch [String]
cstrs Text
ptText

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

getGenericSum
    :: forall pt a
    .  ( Generic a, GTraverseSum Get 'SumOnly (Rep a)
       , Get pt
       , GAssertNotVoid a, GAssertSum a
    ) => PfxTagCfg pt -> Getter a
getGenericSum :: forall pt a.
(Generic a, GTraverseSum Get 'SumOnly (Rep a), Get pt,
 GAssertNotVoid a, GAssertSum a) =>
PfxTagCfg pt -> Getter a
getGenericSum = forall {k} (tag :: k) (opts :: SumOpts) a pt.
(Generic a, Functor (GenericTraverseF tag),
 GTraverseSum tag opts (Rep a), GenericTraverseC tag pt) =>
PfxTagCfg pt -> GenericTraverseF tag a
forall (tag :: Type -> Constraint) (opts :: SumOpts) a pt.
(Generic a, Functor (GenericTraverseF tag),
 GTraverseSum tag opts (Rep a), GenericTraverseC tag pt) =>
PfxTagCfg pt -> GenericTraverseF tag a
genericTraverseSum @Get @'SumOnly

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

-}

instance Get a => Get (Identity a) where get :: Getter (Identity a)
get = a -> Identity a
forall a. a -> Identity a
Identity (a -> Identity a) -> ParserT PureMode E a -> Getter (Identity a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT PureMode E a
forall a. Get a => Getter a
get

-- | Unit type parses nothing.
instance Get () where
    {-# INLINE get #-}
    get :: Getter ()
get = () -> Getter ()
forall a. a -> ParserT PureMode E 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 E 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
    get :: Getter [a]
get = Getter [a]
go
      where
        go :: Getter [a]
go = do
            Getter () -> (() -> Getter [a]) -> Getter [a] -> Getter [a]
forall (st :: ZeroBitType) e a r.
ParserT st e a
-> (a -> ParserT st e r) -> ParserT st e r -> ParserT st e r
FP.withOption Getter ()
forall (st :: ZeroBitType) e. ParserT st e ()
FP.eof (\() -> [a] -> Getter [a]
forall a. a -> ParserT PureMode E a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure []) (Getter [a] -> Getter [a]) -> Getter [a] -> Getter [a]
forall a b. (a -> b) -> a -> b
$ do
                a
a <- Getter a
forall a. Get a => Getter a
get
                [a]
as <- Getter [a]
go
                [a] -> Getter [a]
forall a. a -> ParserT PureMode E a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([a] -> Getter [a]) -> [a] -> Getter [a]
forall a b. (a -> b) -> a -> b
$ 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 Identity Word8 instance Get (ByteOrdered end Word8)

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

-- | Parse any 'Prim''.
getPrim :: forall a. Prim' a => Getter a
getPrim :: forall a. Prim' a => Getter a
getPrim = Getter a -> EBase -> Getter a
forall a. Getter a -> EBase -> Getter a
getEBase Getter a
forall a e (st :: ZeroBitType). Prim' a => ParserT st e a
FP.anyPrim (Int -> EBase
ERanOut (a -> Int
forall a. Prim a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a)))

instance Prim' a => Get (ViaPrim a) where get :: Getter (ViaPrim a)
get = a -> ViaPrim a
forall a. a -> ViaPrim a
ViaPrim (a -> ViaPrim a) -> ParserT PureMode E a -> Getter (ViaPrim a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT PureMode E a
forall a. Prim' 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) => Get (ByteOrdered 'LittleEndian a)
deriving via ViaPrim (ByteOrdered    'BigEndian a)
    instance (Prim' a, ByteSwap a) => Get (ByteOrdered    'BigEndian a)

{-

-- | 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

-}