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

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

import Binrep.Get.Error
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) )
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 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.Type.Assert

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

import Refined
import Refined.Unsafe

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

type Getter a = FP.Parser E a

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

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 E a -> Getter (GenericallyNonSum a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT PureMode E a
forall a.
(Generic a, GTraverseNonSum Get (Rep a), GAssertNotVoid a,
 GAssertNotSum a) =>
Getter a
getGenericNonSum

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

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

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

-- | Convert a bytezap struct parser to a flatparse parser.
bzToFp
    :: forall a e st. KnownNat (CBLen a)
    => BZ.ParserT st e a -> FP.ParserT st e a
bzToFp :: forall a e (st :: ZeroBitType).
KnownNat (CBLen a) =>
ParserT st e a -> ParserT st e a
bzToFp (BZ.ParserT ParserT# st e a
p) = Int -> ParserT st e ()
forall (st :: ZeroBitType) e. Int -> ParserT st e ()
FP.ensure (Int# -> Int
I# Int#
len#) ParserT st e () -> ParserT st e a -> ParserT st e a
forall a b. ParserT st e a -> ParserT st e b -> ParserT st e b
forall (m :: Type -> Type) a b. Monad m => m a -> m b -> m b
>> ((ForeignPtrContents -> Addr# -> Addr# -> st -> Res# st e a)
-> ParserT st e 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 e a)
 -> ParserT st e a)
-> (ForeignPtrContents -> Addr# -> Addr# -> st -> Res# st e a)
-> ParserT st e a
forall a b. (a -> b) -> a -> b
$ \ForeignPtrContents
fpc Addr#
_eob Addr#
s st
st0 ->
    case ParserT# st e a
p ForeignPtrContents
fpc Addr#
s Int#
0# st
st0 of
      BZ.OK#   st
st1 a
a -> st -> a -> Addr# -> Res# st e a
forall (st :: ZeroBitType) a e. st -> a -> Addr# -> Res# st e a
FP.OK#   st
st1 a
a (Addr#
s Addr# -> Int# -> Addr#
`plusAddr#` Int#
len#)
      BZ.Fail# st
st1   -> st -> Res# st e a
forall (st :: ZeroBitType) e a. st -> Res# st e a
FP.Fail# st
st1
      BZ.Err#  st
st1 e
e -> st -> e -> Res# st e a
forall (st :: ZeroBitType) e a. st -> e -> Res# st e a
FP.Err#  st
st1 e
e
    )
  where
    !(I# Int#
len#) = forall a. KnownNat (CBLen a) => Int
forall {k} (a :: k). KnownNat (CBLen a) => Int
cblen @a

fpToBz
    :: FP.ParserT st e a -> Int#
    -> (a -> Int# -> BZ.ParserT st e r) -> BZ.ParserT st e r
fpToBz :: forall (st :: ZeroBitType) e a r.
ParserT st e a
-> Int# -> (a -> Int# -> ParserT st e r) -> ParserT st e r
fpToBz (FP.ParserT ForeignPtrContents -> Addr# -> Addr# -> st -> Res# st e a
p) Int#
len# a -> Int# -> ParserT st e r
fp = ParserT# st e r -> ParserT st e r
forall (st :: ZeroBitType) e a. ParserT# st e a -> ParserT st e a
BZ.ParserT (ParserT# st e r -> ParserT st e r)
-> ParserT# st e r -> ParserT st e r
forall a b. (a -> b) -> a -> b
$ \ForeignPtrContents
fpc Addr#
base# Int#
os# st
st0 ->
    case ForeignPtrContents -> Addr# -> Addr# -> st -> Res# st e 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 e r -> ParserT# st e r
forall (st :: ZeroBitType) e a. ParserT st e a -> ParserT# st e a
BZ.runParserT# (a -> Int# -> ParserT st e r
fp a
a Int#
unconsumed#) ForeignPtrContents
fpc Addr#
base# (Int#
os# Int# -> Int# -> Int#
+# Int#
unconsumed#) st
st1
      FP.Fail# st
st1     -> st -> Res# st e r
forall (st :: ZeroBitType) e a. st -> Res# st e a
BZ.Fail# st
st1
      FP.Err#  st
st1 e
e   -> st -> e -> Res# st e r
forall (st :: ZeroBitType) e a. st -> e -> Res# st e a
BZ.Err#  st
st1 e
e

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

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 E a -> Getter (ViaGetC a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT PureMode E a -> ParserT PureMode E a
forall a e (st :: ZeroBitType).
KnownNat (CBLen a) =>
ParserT st e a -> ParserT st e a
bzToFp ParserT PureMode E a
forall a. GetC a => GetterC a
getC

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

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} 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))
-> Getter (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. 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

-}