{-# OPTIONS_GHC -Wno-orphans #-}

-- |
-- Module: M.NBT.Internal.P
-- Description: NBT parsing and serialization
-- Copyright: (c) axionbuster, 2025
-- License: BSD-3-Clause
--
-- Implements parsing and serialization for NBT data structures,
-- handling named pairs and tag types.
module M.NBT.Internal.P (NamedPair (..)) where

import Control.Applicative.Combinators
import Control.DeepSeq
import Control.Monad
import Data.ByteString qualified as B
import Data.ByteString.Builder (Builder, byteString)
import Data.Data
import Data.Functor
import Data.HashMap.Strict qualified as M
import Data.Int
import Data.Text (Text)
import Data.Vector qualified as V
import Data.Vector.Unboxed qualified as VU
import FlatParse.Stateful qualified as F
import GHC.Generics
import M.NBT.Internal.JS
import M.NBT.Internal.Types
import M.Pack

-- unpack orphan instance for 'Tg'

-- parser returns parser. use 'join' from Control.Monad to use it

-- | named pair of a 'Text' and a 'Tg'
data NamedPair = NamedPair !Text !Tg
  deriving stock (NamedPair -> NamedPair -> Bool
(NamedPair -> NamedPair -> Bool)
-> (NamedPair -> NamedPair -> Bool) -> Eq NamedPair
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NamedPair -> NamedPair -> Bool
== :: NamedPair -> NamedPair -> Bool
$c/= :: NamedPair -> NamedPair -> Bool
/= :: NamedPair -> NamedPair -> Bool
Eq, Eq NamedPair
Eq NamedPair =>
(NamedPair -> NamedPair -> Ordering)
-> (NamedPair -> NamedPair -> Bool)
-> (NamedPair -> NamedPair -> Bool)
-> (NamedPair -> NamedPair -> Bool)
-> (NamedPair -> NamedPair -> Bool)
-> (NamedPair -> NamedPair -> NamedPair)
-> (NamedPair -> NamedPair -> NamedPair)
-> Ord NamedPair
NamedPair -> NamedPair -> Bool
NamedPair -> NamedPair -> Ordering
NamedPair -> NamedPair -> NamedPair
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 :: NamedPair -> NamedPair -> Ordering
compare :: NamedPair -> NamedPair -> Ordering
$c< :: NamedPair -> NamedPair -> Bool
< :: NamedPair -> NamedPair -> Bool
$c<= :: NamedPair -> NamedPair -> Bool
<= :: NamedPair -> NamedPair -> Bool
$c> :: NamedPair -> NamedPair -> Bool
> :: NamedPair -> NamedPair -> Bool
$c>= :: NamedPair -> NamedPair -> Bool
>= :: NamedPair -> NamedPair -> Bool
$cmax :: NamedPair -> NamedPair -> NamedPair
max :: NamedPair -> NamedPair -> NamedPair
$cmin :: NamedPair -> NamedPair -> NamedPair
min :: NamedPair -> NamedPair -> NamedPair
Ord, Int -> NamedPair -> ShowS
[NamedPair] -> ShowS
NamedPair -> String
(Int -> NamedPair -> ShowS)
-> (NamedPair -> String)
-> ([NamedPair] -> ShowS)
-> Show NamedPair
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NamedPair -> ShowS
showsPrec :: Int -> NamedPair -> ShowS
$cshow :: NamedPair -> String
show :: NamedPair -> String
$cshowList :: [NamedPair] -> ShowS
showList :: [NamedPair] -> ShowS
Show, ReadPrec [NamedPair]
ReadPrec NamedPair
Int -> ReadS NamedPair
ReadS [NamedPair]
(Int -> ReadS NamedPair)
-> ReadS [NamedPair]
-> ReadPrec NamedPair
-> ReadPrec [NamedPair]
-> Read NamedPair
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS NamedPair
readsPrec :: Int -> ReadS NamedPair
$creadList :: ReadS [NamedPair]
readList :: ReadS [NamedPair]
$creadPrec :: ReadPrec NamedPair
readPrec :: ReadPrec NamedPair
$creadListPrec :: ReadPrec [NamedPair]
readListPrec :: ReadPrec [NamedPair]
Read, (forall x. NamedPair -> Rep NamedPair x)
-> (forall x. Rep NamedPair x -> NamedPair) -> Generic NamedPair
forall x. Rep NamedPair x -> NamedPair
forall x. NamedPair -> Rep NamedPair x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NamedPair -> Rep NamedPair x
from :: forall x. NamedPair -> Rep NamedPair x
$cto :: forall x. Rep NamedPair x -> NamedPair
to :: forall x. Rep NamedPair x -> NamedPair
Generic, Typeable, Typeable NamedPair
Typeable NamedPair =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> NamedPair -> c NamedPair)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c NamedPair)
-> (NamedPair -> Constr)
-> (NamedPair -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c NamedPair))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NamedPair))
-> ((forall b. Data b => b -> b) -> NamedPair -> NamedPair)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> NamedPair -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> NamedPair -> r)
-> (forall u. (forall d. Data d => d -> u) -> NamedPair -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> NamedPair -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> NamedPair -> m NamedPair)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> NamedPair -> m NamedPair)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> NamedPair -> m NamedPair)
-> Data NamedPair
NamedPair -> Constr
NamedPair -> DataType
(forall b. Data b => b -> b) -> NamedPair -> NamedPair
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) -> NamedPair -> u
forall u. (forall d. Data d => d -> u) -> NamedPair -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NamedPair -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NamedPair -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NamedPair -> m NamedPair
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NamedPair -> m NamedPair
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NamedPair
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NamedPair -> c NamedPair
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NamedPair)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NamedPair)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NamedPair -> c NamedPair
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NamedPair -> c NamedPair
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NamedPair
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NamedPair
$ctoConstr :: NamedPair -> Constr
toConstr :: NamedPair -> Constr
$cdataTypeOf :: NamedPair -> DataType
dataTypeOf :: NamedPair -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NamedPair)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NamedPair)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NamedPair)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NamedPair)
$cgmapT :: (forall b. Data b => b -> b) -> NamedPair -> NamedPair
gmapT :: (forall b. Data b => b -> b) -> NamedPair -> NamedPair
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NamedPair -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NamedPair -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NamedPair -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NamedPair -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> NamedPair -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> NamedPair -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NamedPair -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NamedPair -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NamedPair -> m NamedPair
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NamedPair -> m NamedPair
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NamedPair -> m NamedPair
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NamedPair -> m NamedPair
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NamedPair -> m NamedPair
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NamedPair -> m NamedPair
Data)
  deriving anyclass (NamedPair -> ()
(NamedPair -> ()) -> NFData NamedPair
forall a. (a -> ()) -> NFData a
$crnf :: NamedPair -> ()
rnf :: NamedPair -> ()
NFData)

-- NamedPair used to be called 'S', hence the 'sp' function name
sp :: NamedPair -> (Text, Tg)
sp :: NamedPair -> (Text, Tg)
sp (NamedPair Text
t Tg
p) = (Text
t, Tg
p)
{-# INLINE sp #-}

instance Unpack NamedPair where
  unpack :: forall (st :: ZeroBitType) r. Parser st r NamedPair
unpack = Parser st r (Parser st r Tg)
forall (st :: ZeroBitType) r. Parser st r (Parser st r Tg)
tag Parser st r (Parser st r Tg)
-> (Parser st r Tg -> ParserT st r ParseError NamedPair)
-> ParserT st r ParseError NamedPair
forall a b.
ParserT st r ParseError a
-> (a -> ParserT st r ParseError b) -> ParserT st r ParseError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Tg -> NamedPair)
-> ParserT st r ParseError Text
-> Parser st r Tg
-> ParserT st r ParseError NamedPair
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 Text -> Tg -> NamedPair
NamedPair ParserT st r ParseError Text
forall (st :: ZeroBitType) r. Parser st r Text
string0
  {-# INLINE unpack #-}

instance Unpack Tg where
  unpack :: forall (st :: ZeroBitType) r. Parser st r Tg
unpack = ParserT st r ParseError (ParserT st r ParseError Tg)
-> ParserT st r ParseError Tg
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ParserT st r ParseError (ParserT st r ParseError Tg)
forall (st :: ZeroBitType) r. Parser st r (Parser st r Tg)
tag
  {-# INLINE unpack #-}

tag :: Parser st r (Parser st r Tg)
tag :: forall (st :: ZeroBitType) r. Parser st r (Parser st r Tg)
tag =
  forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack @Ty Parser st r Ty
-> (Ty -> Parser st r Tg)
-> ParserT st r ParseError (Parser st r Tg)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    Ty
TEnd -> Tg -> Parser st r Tg
forall a. a -> ParserT st r ParseError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tg
End
    Ty
TByte -> Int8 -> Tg
Byte (Int8 -> Tg) -> ParserT st r ParseError Int8 -> Parser st r Tg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT st r ParseError Int8
forall (st :: ZeroBitType) r. Parser st r Int8
forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack
    Ty
TShort -> Int16 -> Tg
Short (Int16 -> Tg) -> ParserT st r ParseError Int16 -> Parser st r Tg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT st r ParseError Int16
forall (st :: ZeroBitType) r. Parser st r Int16
forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack
    Ty
TInt -> Int32 -> Tg
Int (Int32 -> Tg) -> ParserT st r ParseError Int32 -> Parser st r Tg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT st r ParseError Int32
forall (st :: ZeroBitType) r. Parser st r Int32
forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack
    Ty
TLong -> Int64 -> Tg
Long (Int64 -> Tg) -> ParserT st r ParseError Int64 -> Parser st r Tg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT st r ParseError Int64
forall (st :: ZeroBitType) r. Parser st r Int64
forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack
    Ty
TFloat -> Float -> Tg
Float (Float -> Tg) -> ParserT st r ParseError Float -> Parser st r Tg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT st r ParseError Float
forall (st :: ZeroBitType) r. Parser st r Float
forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack
    Ty
TDouble -> Double -> Tg
Double (Double -> Tg) -> ParserT st r ParseError Double -> Parser st r Tg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT st r ParseError Double
forall (st :: ZeroBitType) r. Parser st r Double
forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack
    Ty
TByteArray ->
      forall a b (st :: ZeroBitType) r.
(Integral a, Unpack a, Integral b) =>
Parser st r b
unpackfi @Int32
        Parser st r Int -> (Int -> Parser st r Int) -> Parser st r Int
forall a b.
ParserT st r ParseError a
-> (a -> ParserT st r ParseError b) -> ParserT st r ParseError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Int -> Parser st r Int
forall a (st :: ZeroBitType) r.
(Num a, Ord a, Show a) =>
String -> a -> Parser st r a
guardnat String
"Tg.ByteArray length"
        Parser st r Int -> (Int -> Parser st r Tg) -> Parser st r Tg
forall a b.
ParserT st r ParseError a
-> (a -> ParserT st r ParseError b) -> ParserT st r ParseError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ByteString -> Tg
ByteArray <$>) (ParserT st r ParseError ByteString -> Parser st r Tg)
-> (Int -> ParserT st r ParseError ByteString)
-> Int
-> Parser st r Tg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ParserT st r ParseError ByteString
forall (st :: ZeroBitType) r e. Int -> ParserT st r e ByteString
F.take
    Ty
TString -> Text -> Tg
String (Text -> Tg) -> ParserT st r ParseError Text -> Parser st r Tg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT st r ParseError Text
forall (st :: ZeroBitType) r. Parser st r Text
string0
    Ty
TList -> do
      Parser st r Tg
p <- ParserT st r ParseError (Parser st r Tg)
-> ParserT st r ParseError (Parser st r Tg)
forall (st :: ZeroBitType) r e a.
ParserT st r e a -> ParserT st r e a
F.lookahead ParserT st r ParseError (Parser st r Tg)
forall (st :: ZeroBitType) r. Parser st r (Parser st r Tg)
tag
      Ty
ty <- forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack @Ty
      Int
n <- forall a b (st :: ZeroBitType) r.
(Integral a, Unpack a, Integral b) =>
Parser st r b
unpackfi @Int32 Parser st r Int -> (Int -> Parser st r Int) -> Parser st r Int
forall a b.
ParserT st r ParseError a
-> (a -> ParserT st r ParseError b) -> ParserT st r ParseError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Int -> Parser st r Int
forall a (st :: ZeroBitType) r.
(Num a, Ord a, Show a) =>
String -> a -> Parser st r a
guardnat String
"Tg.List length"
      if Ty
ty Ty -> Ty -> Bool
forall a. Eq a => a -> a -> Bool
== Ty
TEnd Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
        then ParseError -> Parser st r Tg
forall e (st :: ZeroBitType) r a. e -> ParserT st r e a
F.err ParseError
"only empty lists may have the end tag as element type"
        else Ty -> Vector Tg -> Tg
List Ty
ty (Vector Tg -> Tg)
-> ParserT st r ParseError (Vector Tg) -> Parser st r Tg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser st r Tg -> ParserT st r ParseError (Vector Tg)
forall (m :: * -> *) a. Monad m => Int -> m a -> m (Vector a)
V.replicateM Int
n Parser st r Tg
p
    Ty
TCompound -> HashMap Text Tg -> Tg
Compound (HashMap Text Tg -> Tg)
-> ([(Text, Tg)] -> HashMap Text Tg) -> [(Text, Tg)] -> Tg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Tg)] -> HashMap Text Tg
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList ([(Text, Tg)] -> Tg)
-> ParserT st r ParseError [(Text, Tg)] -> Parser st r Tg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT st r ParseError (Text, Tg)
-> ParserT st r ParseError ()
-> ParserT st r ParseError [(Text, Tg)]
forall (m :: * -> *) a end. Alternative m => m a -> m end -> m [a]
manyTill (NamedPair -> (Text, Tg)
sp (NamedPair -> (Text, Tg))
-> ParserT st r ParseError NamedPair
-> ParserT st r ParseError (Text, Tg)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParserT st r ParseError NamedPair
forall (st :: ZeroBitType) r. Parser st r NamedPair
forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack) ParserT st r ParseError ()
forall {st :: ZeroBitType} {r}. ParserT st r ParseError ()
end
      where
        end :: ParserT st r ParseError ()
end = forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack @Ty Parser st r Ty
-> (Ty -> ParserT st r ParseError ()) -> ParserT st r ParseError ()
forall a b.
ParserT st r ParseError a
-> (a -> ParserT st r ParseError b) -> ParserT st r ParseError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> ParserT st r ParseError ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> ParserT st r ParseError ())
-> (Ty -> Bool) -> Ty -> ParserT st r ParseError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Ty -> Ty -> Bool
forall a. Eq a => a -> a -> Bool
== Ty
TEnd)
        {-# INLINE end #-}
    Ty
TIntArray -> Vector Int32 -> Tg
IntArray (Vector Int32 -> Tg)
-> ParserT st r ParseError (Vector Int32) -> Parser st r Tg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ParserT st r ParseError Int32
-> ParserT st r ParseError (Vector Int32)
forall a (st :: ZeroBitType) r.
Unbox a =>
String -> Parser st r a -> Parser st r (Vector a)
arr0 String
"Tg.IntArray length" (forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack @Int32)
    Ty
TLongArray -> Vector Int64 -> Tg
LongArray (Vector Int64 -> Tg)
-> ParserT st r ParseError (Vector Int64) -> Parser st r Tg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ParserT st r ParseError Int64
-> ParserT st r ParseError (Vector Int64)
forall a (st :: ZeroBitType) r.
Unbox a =>
String -> Parser st r a -> Parser st r (Vector a)
arr0 String
"Tg.LongArray length" (forall a (st :: ZeroBitType) r. Unpack a => Parser st r a
unpack @Int64)

arr0 :: (VU.Unbox a) => String -> Parser st r a -> Parser st r (VU.Vector a)
arr0 :: forall a (st :: ZeroBitType) r.
Unbox a =>
String -> Parser st r a -> Parser st r (Vector a)
arr0 String
n Parser st r a
p = forall a b (st :: ZeroBitType) r.
(Integral a, Unpack a, Integral b) =>
Parser st r b
unpackfi @Int32 Parser st r Int -> (Int -> Parser st r Int) -> Parser st r Int
forall a b.
ParserT st r ParseError a
-> (a -> ParserT st r ParseError b) -> ParserT st r ParseError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Int -> Parser st r Int
forall a (st :: ZeroBitType) r.
(Num a, Ord a, Show a) =>
String -> a -> Parser st r a
guardnat String
n Parser st r Int
-> (Int -> ParserT st r ParseError (Vector a))
-> ParserT st r ParseError (Vector a)
forall a b.
ParserT st r ParseError a
-> (a -> ParserT st r ParseError b) -> ParserT st r ParseError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Parser st r a -> ParserT st r ParseError (Vector a)
forall (m :: * -> *) a.
(Monad m, Unbox a) =>
Int -> m a -> m (Vector a)
`VU.replicateM` Parser st r a
p)
{-# INLINE arr0 #-}

string0 :: Parser st r Text
string0 :: forall (st :: ZeroBitType) r. Parser st r Text
string0 =
  forall a b (st :: ZeroBitType) r.
(Integral a, Unpack a, Integral b) =>
Parser st r b
unpackfi @Int16
    Parser st r Int -> (Int -> Parser st r Int) -> Parser st r Int
forall a b.
ParserT st r ParseError a
-> (a -> ParserT st r ParseError b) -> ParserT st r ParseError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Int -> Parser st r Int
forall a (st :: ZeroBitType) r.
(Num a, Ord a, Show a) =>
String -> a -> Parser st r a
guardnat String
"Tg.String length"
    Parser st r Int
-> (Int -> ParserT st r ParseError Text)
-> ParserT st r ParseError Text
forall a b.
ParserT st r ParseError a
-> (a -> ParserT st r ParseError b) -> ParserT st r ParseError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (JS -> Text
getjs <$>) (ParserT st r ParseError JS -> ParserT st r ParseError Text)
-> (Int -> ParserT st r ParseError JS)
-> Int
-> ParserT st r ParseError Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> ParserT st r ParseError JS -> ParserT st r ParseError JS
forall (st :: ZeroBitType) r e a.
Int -> ParserT st r e a -> ParserT st r e a
`F.isolate` ParserT st r ParseError JS
forall (st :: ZeroBitType) r. Parser st r JS
fromcesu8p)
{-# INLINE string0 #-}

-- pack

instance Pack NamedPair where
  pack :: NamedPair -> Builder
pack (NamedPair Text
t Tg
p) = Ty -> Builder
forall a. Pack a => a -> Builder
pack (Tg -> Ty
getty Tg
p) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
spack Text
t Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Tg -> Builder
bodypack Tg
p
  {-# INLINE pack #-}

spack :: Text -> Builder
spack :: Text -> Builder
spack Text
s =
  let c :: ByteString
c = JS -> ByteString
tocesu8 (Text -> JS
JS Text
s)
   in forall a b. (Integral a, Pack a, Integral b) => b -> Builder
packfi @Int16 (ByteString -> Int
B.length ByteString
c) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
c
{-# INLINE spack #-}

instance Pack Tg where
  pack :: Tg -> Builder
pack Tg
t = Ty -> Builder
forall a. Pack a => a -> Builder
pack (Tg -> Ty
getty Tg
t) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Tg -> Builder
bodypack Tg
t
  {-# INLINE pack #-}

bodypack :: Tg -> Builder
bodypack :: Tg -> Builder
bodypack Tg
End = Builder
forall a. Monoid a => a
mempty
bodypack (Byte Int8
p) = Int8 -> Builder
forall a. Pack a => a -> Builder
pack Int8
p
bodypack (Short Int16
p) = Int16 -> Builder
forall a. Pack a => a -> Builder
pack Int16
p
bodypack (Int Int32
p) = Int32 -> Builder
forall a. Pack a => a -> Builder
pack Int32
p
bodypack (Long Int64
p) = Int64 -> Builder
forall a. Pack a => a -> Builder
pack Int64
p
bodypack (Float Float
p) = Float -> Builder
forall a. Pack a => a -> Builder
pack Float
p
bodypack (Double Double
p) = Double -> Builder
forall a. Pack a => a -> Builder
pack Double
p
bodypack (ByteArray ByteString
p) = forall a b. (Integral a, Pack a, Integral b) => b -> Builder
packfi @Int32 (ByteString -> Int
B.length ByteString
p) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
byteString ByteString
p
bodypack (String Text
p) = Text -> Builder
spack Text
p
bodypack (List Ty
t Vector Tg
p) =
  Ty -> Builder
forall a. Pack a => a -> Builder
pack Ty
t
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall a b. (Integral a, Pack a, Integral b) => b -> Builder
packfi @Int32 (Vector Tg -> Int
forall a. Vector a -> Int
V.length Vector Tg
p)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Tg -> Builder) -> Vector Tg -> Builder
forall m a. Monoid m => (a -> m) -> Vector a -> m
V.foldMap Tg -> Builder
bodypack Vector Tg
p
bodypack (Compound HashMap Text Tg
p) =
  ((Text, Tg) -> Builder) -> [(Text, Tg)] -> Builder
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
    (NamedPair -> Builder
forall a. Pack a => a -> Builder
pack (NamedPair -> Builder)
-> ((Text, Tg) -> NamedPair) -> (Text, Tg) -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Tg -> NamedPair) -> (Text, Tg) -> NamedPair
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Tg -> NamedPair
NamedPair)
    (HashMap Text Tg -> [(Text, Tg)]
forall k v. HashMap k v -> [(k, v)]
M.toList HashMap Text Tg
p)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Ty -> Builder
forall a. Pack a => a -> Builder
pack Ty
TEnd
bodypack (IntArray Vector Int32
p) = forall a b. (Integral a, Pack a, Integral b) => b -> Builder
packfi @Int32 (Vector Int32 -> Int
forall a. Unbox a => Vector a -> Int
VU.length Vector Int32
p) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Int32 -> Builder) -> Vector Int32 -> Builder
forall m a. (Monoid m, Unbox a) => (a -> m) -> Vector a -> m
VU.foldMap Int32 -> Builder
forall a. Pack a => a -> Builder
pack Vector Int32
p
bodypack (LongArray Vector Int64
p) = forall a b. (Integral a, Pack a, Integral b) => b -> Builder
packfi @Int32 (Vector Int64 -> Int
forall a. Unbox a => Vector a -> Int
VU.length Vector Int64
p) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Int64 -> Builder) -> Vector Int64 -> Builder
forall m a. (Monoid m, Unbox a) => (a -> m) -> Vector a -> m
VU.foldMap Int64 -> Builder
forall a. Pack a => a -> Builder
pack Vector Int64
p