-- |
-- Module: M.Pack.Internal.Types
-- Description: Core serialization type system
-- Copyright: (c) axionbuster, 2025
-- License: BSD-3-Clause
--
-- Defines the core type system for binary serialization and deserialization,
-- including Pack and Unpack typeclasses and related utilities.
module M.Pack.Internal.Types
  ( Pack (..),
    SomePack (..),
    Unpack (..),
    SomeUnpack (..),
    Parser,
    Result,
    ParseError (..),
    parsepure,
    parsepure0,
    castsomepack,
    castsomeunpack,
    unpacksome,
  )
where

import Control.Applicative
import Control.Exception
import Control.Monad.ST.Strict
import Data.ByteString (ByteString)
import Data.ByteString.Builder (Builder)
import Data.Data
import Data.String
import Data.Void
import FlatParse.Stateful qualified as F
import GHC.Generics
import Language.Haskell.TH.Syntax (Lift)

-- | our parser type
type Parser st r = F.ParserT st r ParseError

-- | our parse result
type Result = F.Result ParseError

-- | our parser error type
newtype ParseError = ParseError {ParseError -> String
showparseerror :: String} -- generic message
  deriving newtype (ParseError -> ParseError -> Bool
(ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> Bool) -> Eq ParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParseError -> ParseError -> Bool
== :: ParseError -> ParseError -> Bool
$c/= :: ParseError -> ParseError -> Bool
/= :: ParseError -> ParseError -> Bool
Eq, Eq ParseError
Eq ParseError =>
(ParseError -> ParseError -> Ordering)
-> (ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> Bool)
-> (ParseError -> ParseError -> ParseError)
-> (ParseError -> ParseError -> ParseError)
-> Ord ParseError
ParseError -> ParseError -> Bool
ParseError -> ParseError -> Ordering
ParseError -> ParseError -> ParseError
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ParseError -> ParseError -> Ordering
compare :: ParseError -> ParseError -> Ordering
$c< :: ParseError -> ParseError -> Bool
< :: ParseError -> ParseError -> Bool
$c<= :: ParseError -> ParseError -> Bool
<= :: ParseError -> ParseError -> Bool
$c> :: ParseError -> ParseError -> Bool
> :: ParseError -> ParseError -> Bool
$c>= :: ParseError -> ParseError -> Bool
>= :: ParseError -> ParseError -> Bool
$cmax :: ParseError -> ParseError -> ParseError
max :: ParseError -> ParseError -> ParseError
$cmin :: ParseError -> ParseError -> ParseError
min :: ParseError -> ParseError -> ParseError
Ord, Int -> ParseError -> String -> String
[ParseError] -> String -> String
ParseError -> String
(Int -> ParseError -> String -> String)
-> (ParseError -> String)
-> ([ParseError] -> String -> String)
-> Show ParseError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ParseError -> String -> String
showsPrec :: Int -> ParseError -> String -> String
$cshow :: ParseError -> String
show :: ParseError -> String
$cshowList :: [ParseError] -> String -> String
showList :: [ParseError] -> String -> String
Show, String -> ParseError
(String -> ParseError) -> IsString ParseError
forall a. (String -> a) -> IsString a
$cfromString :: String -> ParseError
fromString :: String -> ParseError
IsString)
  deriving stock (Typeable, Typeable ParseError
Typeable ParseError =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ParseError -> c ParseError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ParseError)
-> (ParseError -> Constr)
-> (ParseError -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ParseError))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ParseError))
-> ((forall b. Data b => b -> b) -> ParseError -> ParseError)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ParseError -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ParseError -> r)
-> (forall u. (forall d. Data d => d -> u) -> ParseError -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ParseError -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ParseError -> m ParseError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ParseError -> m ParseError)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ParseError -> m ParseError)
-> Data ParseError
ParseError -> Constr
ParseError -> DataType
(forall b. Data b => b -> b) -> ParseError -> ParseError
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ParseError -> u
forall u. (forall d. Data d => d -> u) -> ParseError -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParseError -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParseError -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParseError -> m ParseError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParseError -> m ParseError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParseError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParseError -> c ParseError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParseError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ParseError)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParseError -> c ParseError
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ParseError -> c ParseError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParseError
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ParseError
$ctoConstr :: ParseError -> Constr
toConstr :: ParseError -> Constr
$cdataTypeOf :: ParseError -> DataType
dataTypeOf :: ParseError -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParseError)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ParseError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ParseError)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ParseError)
$cgmapT :: (forall b. Data b => b -> b) -> ParseError -> ParseError
gmapT :: (forall b. Data b => b -> b) -> ParseError -> ParseError
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParseError -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ParseError -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParseError -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ParseError -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ParseError -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ParseError -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ParseError -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ParseError -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParseError -> m ParseError
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ParseError -> m ParseError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParseError -> m ParseError
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParseError -> m ParseError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParseError -> m ParseError
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ParseError -> m ParseError
Data, (forall x. ParseError -> Rep ParseError x)
-> (forall x. Rep ParseError x -> ParseError) -> Generic ParseError
forall x. Rep ParseError x -> ParseError
forall x. ParseError -> Rep ParseError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ParseError -> Rep ParseError x
from :: forall x. ParseError -> Rep ParseError x
$cto :: forall x. Rep ParseError x -> ParseError
to :: forall x. Rep ParseError x -> ParseError
Generic, (forall (m :: * -> *). Quote m => ParseError -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    ParseError -> Code m ParseError)
-> Lift ParseError
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => ParseError -> m Exp
forall (m :: * -> *). Quote m => ParseError -> Code m ParseError
$clift :: forall (m :: * -> *). Quote m => ParseError -> m Exp
lift :: forall (m :: * -> *). Quote m => ParseError -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => ParseError -> Code m ParseError
liftTyped :: forall (m :: * -> *). Quote m => ParseError -> Code m ParseError
Lift)
  deriving anyclass (Show ParseError
Typeable ParseError
(Typeable ParseError, Show ParseError) =>
(ParseError -> SomeException)
-> (SomeException -> Maybe ParseError)
-> (ParseError -> String)
-> Exception ParseError
SomeException -> Maybe ParseError
ParseError -> String
ParseError -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> String) -> Exception e
$ctoException :: ParseError -> SomeException
toException :: ParseError -> SomeException
$cfromException :: SomeException -> Maybe ParseError
fromException :: SomeException -> Maybe ParseError
$cdisplayException :: ParseError -> String
displayException :: ParseError -> String
Exception)

-- | run a pure parser efficiently (by inlining)
parsepure :: (forall st. Parser st r a) -> r -> Int -> ByteString -> Result a
parsepure :: forall r a.
(forall (st :: ZeroBitType). Parser st r a)
-> r -> Int -> ByteString -> Result a
parsepure forall (st :: ZeroBitType). Parser st r a
p r
r Int
i ByteString
b = (forall s. ST s (Result a)) -> Result a
forall a. (forall s. ST s a) -> a
runST (ParserST s r ParseError a
-> r -> Int -> ByteString -> ST s (Result a)
forall s r e a.
ParserST s r e a -> r -> Int -> ByteString -> ST s (Result e a)
F.runParserST ParserST s r ParseError a
forall (st :: ZeroBitType). Parser st r a
p r
r Int
i ByteString
b)
{-# INLINE parsepure #-}

-- | run a pure parser with no state efficiently (by inlining)
parsepure0 :: (forall st. Parser st () a) -> ByteString -> Result a
parsepure0 :: forall a.
(forall (st :: ZeroBitType). Parser st () a)
-> ByteString -> Result a
parsepure0 forall (st :: ZeroBitType). Parser st () a
p = (forall (st :: ZeroBitType). Parser st () a)
-> () -> Int -> ByteString -> Result a
forall r a.
(forall (st :: ZeroBitType). Parser st r a)
-> r -> Int -> ByteString -> Result a
parsepure Parser st () a
forall (st :: ZeroBitType). Parser st () a
p () Int
0
{-# INLINE parsepure0 #-}

-- | produce a 'Builder' from a value
class Pack a where
  -- | produce a 'Builder' from a value
  pack :: a -> Builder
  default pack :: (Generic a, GPack (Rep a)) => a -> Builder
  pack = Rep a Any -> Builder
forall a. Rep a a -> Builder
forall {k} (f :: k -> *) (a :: k). GPack f => f a -> Builder
gpack (Rep a Any -> Builder) -> (a -> Rep a Any) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from
  {-# INLINE pack #-}

-- | existential 'Pack' container
data SomePack = forall a. (Typeable a, Pack a, Show a) => SomePack a
  deriving stock (Typeable)

instance Pack SomePack where
  pack :: SomePack -> Builder
pack (SomePack a
x) = a -> Builder
forall a. Pack a => a -> Builder
pack a
x
  {-# INLINE pack #-}

instance Show SomePack where
  show :: SomePack -> String
show (SomePack a
x) = a -> String
forall a. Show a => a -> String
show a
x
  {-# INLINE show #-}

-- | cast a 'SomePack' to a type
castsomepack :: (Typeable a) => SomePack -> Maybe a
castsomepack :: forall a. Typeable a => SomePack -> Maybe a
castsomepack = SomePack -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast
{-# INLINE castsomepack #-}

-- | retrieve a 'Parser' for a type
class Unpack a where
  -- | retrieve a 'Parser' for a type
  unpack :: Parser st r a
  default unpack :: (Generic a, GUnpack (Rep a)) => Parser st r a
  unpack = 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 st r ParseError (Rep a Any) -> ParserT st r ParseError a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT st r ParseError (Rep a Any)
forall (st :: ZeroBitType) r a. Parser st r (Rep a a)
forall {k} (f :: k -> *) (st :: ZeroBitType) r (a :: k).
GUnpack f =>
Parser st r (f a)
gunpack
  {-# INLINE unpack #-}

-- | existential 'Unpack' container
--
-- to 'unpack' this, try using 'unpacksome' with a type application
data SomeUnpack = forall a. (Typeable a, Unpack a, Show a) => SomeUnpack a
  deriving stock (Typeable)

instance Show SomeUnpack where
  show :: SomeUnpack -> String
show (SomeUnpack a
x) = a -> String
forall a. Show a => a -> String
show a
x
  {-# INLINE show #-}

-- | use a type application to retrieve a 'SomeUnpack'
unpacksome ::
  forall a st r.
  (Typeable a, Unpack a, Show a) =>
  Parser st r SomeUnpack
unpacksome :: forall a (st :: ZeroBitType) r.
(Typeable a, Unpack a, Show a) =>
Parser st r SomeUnpack
unpacksome = a -> SomeUnpack
forall a. (Typeable a, Unpack a, Show a) => a -> SomeUnpack
SomeUnpack (a -> SomeUnpack)
-> ParserT st r ParseError a -> ParserT st r ParseError SomeUnpack
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack @a
{-# INLINE unpacksome #-}

-- | cast a 'SomeUnpack' to a type
castsomeunpack :: (Typeable a) => SomeUnpack -> Maybe a
castsomeunpack :: forall a. Typeable a => SomeUnpack -> Maybe a
castsomeunpack = SomeUnpack -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast
{-# INLINE castsomeunpack #-}

-- | generic implementor of 'Pack'
class GPack f where
  -- | implement 'pack'
  gpack :: f a -> Builder

-- GPack is implemented for most type combos, except sum types
-- where programmer's attention is required

instance GPack V1 where
  gpack :: forall (a :: k). V1 a -> Builder
gpack V1 a
v = case V1 a
v of {}
  {-# INLINE gpack #-}

instance GPack U1 where
  gpack :: forall (a :: k). U1 a -> Builder
gpack U1 a
_ = Builder
forall a. Monoid a => a
mempty
  {-# INLINE gpack #-}

instance (Pack a) => GPack (K1 i a) where
  gpack :: forall (a :: k). K1 i a a -> Builder
gpack (K1 a
x) = a -> Builder
forall a. Pack a => a -> Builder
pack a
x
  {-# INLINE gpack #-}

instance (GPack f) => GPack (M1 i c f) where
  gpack :: forall (a :: k). M1 i c f a -> Builder
gpack (M1 f a
x) = f a -> Builder
forall (a :: k). f a -> Builder
forall {k} (f :: k -> *) (a :: k). GPack f => f a -> Builder
gpack f a
x
  {-# INLINE gpack #-}

instance (GPack f, GPack g) => GPack (f :*: g) where
  gpack :: forall (a :: k). (:*:) f g a -> Builder
gpack (f a
x :*: g a
y) = f a -> Builder
forall (a :: k). f a -> Builder
forall {k} (f :: k -> *) (a :: k). GPack f => f a -> Builder
gpack f a
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> g a -> Builder
forall (a :: k). g a -> Builder
forall {k} (f :: k -> *) (a :: k). GPack f => f a -> Builder
gpack g a
y
  {-# INLINE gpack #-}

-- | generic implementor of 'Unpack'
class GUnpack f where
  -- | implement 'unpack'
  gunpack :: Parser st r (f a)

instance GUnpack V1 where
  gunpack :: forall (st :: ZeroBitType) r (a :: k). Parser st r (V1 a)
gunpack = ParseError -> ParserT st r ParseError (V1 a)
forall e (st :: ZeroBitType) r a. e -> ParserT st r e a
F.err ParseError
"impossible (GUnpack V1)"
  {-# INLINE gunpack #-}

instance GUnpack U1 where
  gunpack :: forall (st :: ZeroBitType) r (a :: k). Parser st r (U1 a)
gunpack = U1 a -> ParserT st r ParseError (U1 a)
forall a. a -> ParserT st r ParseError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 a
forall k (p :: k). U1 p
U1
  {-# INLINE gunpack #-}

instance (Unpack a) => GUnpack (K1 i a) where
  gunpack :: forall (st :: ZeroBitType) r (a :: k). Parser st r (K1 i a a)
gunpack = a -> K1 i a a
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 i a a)
-> ParserT st r ParseError a -> ParserT st r ParseError (K1 i a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT st r ParseError a
forall (st :: ZeroBitType) r. Parser st r a
forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack
  {-# INLINE gunpack #-}

instance (GUnpack f) => GUnpack (M1 i c f) where
  gunpack :: forall (st :: ZeroBitType) r (a :: k). Parser st r (M1 i c f a)
gunpack = f a -> M1 i c f a
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f a -> M1 i c f a)
-> ParserT st r ParseError (f a)
-> ParserT st r ParseError (M1 i c f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT st r ParseError (f a)
forall (st :: ZeroBitType) r (a :: k). Parser st r (f a)
forall {k} (f :: k -> *) (st :: ZeroBitType) r (a :: k).
GUnpack f =>
Parser st r (f a)
gunpack
  {-# INLINE gunpack #-}

instance (GUnpack f, GUnpack g) => GUnpack (f :*: g) where
  gunpack :: forall (st :: ZeroBitType) r (a :: k). Parser st r ((:*:) f g a)
gunpack = (f a -> g a -> (:*:) f g a)
-> ParserT st r ParseError (f a)
-> ParserT st r ParseError (g a)
-> ParserT st r ParseError ((:*:) f g a)
forall a b c.
(a -> b -> c)
-> ParserT st r ParseError a
-> ParserT st r ParseError b
-> ParserT st r ParseError c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) ParserT st r ParseError (f a)
forall (st :: ZeroBitType) r (a :: k). Parser st r (f a)
forall {k} (f :: k -> *) (st :: ZeroBitType) r (a :: k).
GUnpack f =>
Parser st r (f a)
gunpack ParserT st r ParseError (g a)
forall (st :: ZeroBitType) r (a :: k). Parser st r (g a)
forall {k} (f :: k -> *) (st :: ZeroBitType) r (a :: k).
GUnpack f =>
Parser st r (f a)
gunpack
  {-# INLINE gunpack #-}

-- some very basic instances

instance Pack Void where
  pack :: Void -> Builder
pack = Void -> Builder
forall a. Void -> a
absurd
  {-# INLINE pack #-}

instance Unpack Void where
  unpack :: forall (st :: ZeroBitType) r. Parser st r Void
unpack = ParseError -> ParserT st r ParseError Void
forall e (st :: ZeroBitType) r a. e -> ParserT st r e a
F.err ParseError
"impossible (Unpack Void)"
  {-# INLINE unpack #-}

instance Pack () where
  pack :: () -> Builder
pack ()
_ = Builder
forall a. Monoid a => a
mempty
  {-# INLINE pack #-}

instance Unpack () where
  unpack :: forall (st :: ZeroBitType) r. Parser st r ()
unpack = () -> ParserT st r ParseError ()
forall a. a -> ParserT st r ParseError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  {-# INLINE unpack #-}

-- tuples up to five

instance (Pack a, Pack b) => Pack (a, b) where
  pack :: (a, b) -> Builder
pack (a
a, b
b) = a -> Builder
forall a. Pack a => a -> Builder
pack a
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> b -> Builder
forall a. Pack a => a -> Builder
pack b
b
  {-# INLINE pack #-}

instance (Unpack a, Unpack b) => Unpack (a, b) where
  unpack :: forall (st :: ZeroBitType) r. Parser st r (a, b)
unpack = (a -> b -> (a, b))
-> ParserT st r ParseError a
-> ParserT st r ParseError b
-> ParserT st r ParseError (a, b)
forall a b c.
(a -> b -> c)
-> ParserT st r ParseError a
-> ParserT st r ParseError b
-> ParserT st r ParseError c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) ParserT st r ParseError a
forall (st :: ZeroBitType) r. Parser st r a
forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack ParserT st r ParseError b
forall (st :: ZeroBitType) r. Parser st r b
forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack
  {-# INLINE unpack #-}

instance (Pack a, Pack b, Pack c) => Pack (a, b, c) where
  pack :: (a, b, c) -> Builder
pack (a
a, b
b, c
c) = a -> Builder
forall a. Pack a => a -> Builder
pack a
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> b -> Builder
forall a. Pack a => a -> Builder
pack b
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> c -> Builder
forall a. Pack a => a -> Builder
pack c
c
  {-# INLINE pack #-}

instance (Unpack a, Unpack b, Unpack c) => Unpack (a, b, c) where
  unpack :: forall (st :: ZeroBitType) r. Parser st r (a, b, c)
unpack = (a -> b -> c -> (a, b, c))
-> ParserT st r ParseError a
-> ParserT st r ParseError b
-> ParserT st r ParseError c
-> ParserT st r ParseError (a, b, c)
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 (,,) ParserT st r ParseError a
forall (st :: ZeroBitType) r. Parser st r a
forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack ParserT st r ParseError b
forall (st :: ZeroBitType) r. Parser st r b
forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack ParserT st r ParseError c
forall (st :: ZeroBitType) r. Parser st r c
forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack
  {-# INLINE unpack #-}

instance (Pack a, Pack b, Pack c, Pack d) => Pack (a, b, c, d) where
  pack :: (a, b, c, d) -> Builder
pack (a
a, b
b, c
c, d
d) = a -> Builder
forall a. Pack a => a -> Builder
pack a
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> b -> Builder
forall a. Pack a => a -> Builder
pack b
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> c -> Builder
forall a. Pack a => a -> Builder
pack c
c Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> d -> Builder
forall a. Pack a => a -> Builder
pack d
d
  {-# INLINE pack #-}

instance (Unpack a, Unpack b, Unpack c, Unpack d) => Unpack (a, b, c, d) where
  unpack :: forall (st :: ZeroBitType) r. Parser st r (a, b, c, d)
unpack = (,,,) (a -> b -> c -> d -> (a, b, c, d))
-> ParserT st r ParseError a
-> ParserT st r ParseError (b -> c -> d -> (a, b, c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT st r ParseError a
forall (st :: ZeroBitType) r. Parser st r a
forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack ParserT st r ParseError (b -> c -> d -> (a, b, c, d))
-> ParserT st r ParseError b
-> ParserT st r ParseError (c -> d -> (a, b, c, d))
forall a b.
ParserT st r ParseError (a -> b)
-> ParserT st r ParseError a -> ParserT st r ParseError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParserT st r ParseError b
forall (st :: ZeroBitType) r. Parser st r b
forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack ParserT st r ParseError (c -> d -> (a, b, c, d))
-> ParserT st r ParseError c
-> ParserT st r ParseError (d -> (a, b, c, d))
forall a b.
ParserT st r ParseError (a -> b)
-> ParserT st r ParseError a -> ParserT st r ParseError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParserT st r ParseError c
forall (st :: ZeroBitType) r. Parser st r c
forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack ParserT st r ParseError (d -> (a, b, c, d))
-> ParserT st r ParseError d
-> ParserT st r ParseError (a, b, c, d)
forall a b.
ParserT st r ParseError (a -> b)
-> ParserT st r ParseError a -> ParserT st r ParseError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParserT st r ParseError d
forall (st :: ZeroBitType) r. Parser st r d
forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack
  {-# INLINE unpack #-}

instance (Pack a, Pack b, Pack c, Pack d, Pack e) => Pack (a, b, c, d, e) where
  pack :: (a, b, c, d, e) -> Builder
pack (a
a, b
b, c
c, d
d, e
e) = a -> Builder
forall a. Pack a => a -> Builder
pack a
a Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> b -> Builder
forall a. Pack a => a -> Builder
pack b
b Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> c -> Builder
forall a. Pack a => a -> Builder
pack c
c Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> d -> Builder
forall a. Pack a => a -> Builder
pack d
d Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> e -> Builder
forall a. Pack a => a -> Builder
pack e
e
  {-# INLINE pack #-}

instance
  (Unpack a, Unpack b, Unpack c, Unpack d, Unpack e) =>
  Unpack (a, b, c, d, e)
  where
  unpack :: forall (st :: ZeroBitType) r. Parser st r (a, b, c, d, e)
unpack = (,,,,) (a -> b -> c -> d -> e -> (a, b, c, d, e))
-> ParserT st r ParseError a
-> ParserT st r ParseError (b -> c -> d -> e -> (a, b, c, d, e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT st r ParseError a
forall (st :: ZeroBitType) r. Parser st r a
forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack ParserT st r ParseError (b -> c -> d -> e -> (a, b, c, d, e))
-> ParserT st r ParseError b
-> ParserT st r ParseError (c -> d -> e -> (a, b, c, d, e))
forall a b.
ParserT st r ParseError (a -> b)
-> ParserT st r ParseError a -> ParserT st r ParseError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParserT st r ParseError b
forall (st :: ZeroBitType) r. Parser st r b
forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack ParserT st r ParseError (c -> d -> e -> (a, b, c, d, e))
-> ParserT st r ParseError c
-> ParserT st r ParseError (d -> e -> (a, b, c, d, e))
forall a b.
ParserT st r ParseError (a -> b)
-> ParserT st r ParseError a -> ParserT st r ParseError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParserT st r ParseError c
forall (st :: ZeroBitType) r. Parser st r c
forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack ParserT st r ParseError (d -> e -> (a, b, c, d, e))
-> ParserT st r ParseError d
-> ParserT st r ParseError (e -> (a, b, c, d, e))
forall a b.
ParserT st r ParseError (a -> b)
-> ParserT st r ParseError a -> ParserT st r ParseError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParserT st r ParseError d
forall (st :: ZeroBitType) r. Parser st r d
forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack ParserT st r ParseError (e -> (a, b, c, d, e))
-> ParserT st r ParseError e
-> ParserT st r ParseError (a, b, c, d, e)
forall a b.
ParserT st r ParseError (a -> b)
-> ParserT st r ParseError a -> ParserT st r ParseError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParserT st r ParseError e
forall (st :: ZeroBitType) r. Parser st r e
forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack
  {-# INLINE unpack #-}