{-
Module      :  Data.Nbt
Copyright   :  (c) David R. Garland 2022
License     :  MIT
Maintainer  :  davidrgarland@me.com

Functions related to parsing & serializing the NBT file format.
-}

module Data.Nbt
  ( Type (..)
  , Nbt (..)
  , Nbt'
  , MapNbt
  , Tag (..)
  , Tag'
  , MapTag
  , Cmpnd (..)
  , Cmpnd'
  , MapCmpnd
  , pattern Compound'
  , lookupNbt
  , getNbt
  , lookupTag
  , getTag
  , typeOf
  , readUncompressed
  , writeUncompressed
  , readCompressed
  , writeCompressed
  ) where

import Codec.Compression.GZip as GZ
import Control.Monad
import Data.ByteString qualified as B
import Data.ByteString.Lazy qualified as BL
import Data.Foldable
import Data.Foldable.WithIndex
import Data.Int
import Data.Map.Strict qualified as M
import Data.Map.Strict (Map)
import Data.RRBVector qualified as R
import Data.RRBVector (Vector, (<|))
import Data.Serialize hiding (label)
import Data.Text (Text)
import Data.Text.Encoding
import Data.Word

-- | An NBT tag type, in order so that 'toEnum' and 'fromEnum' are useful for serialization and
-- deserialization.
data Type
  = EndType       -- ^ 0x00 NUL. Denotes the end of a file.
  | ByteType      -- ^ 0x01 SOH. Corresponds to `Data.Nbt.Byte`.
  | ShortType     -- ^ 0x02 STX. Corresponds to `Data.Nbt.Short`.
  | IntType       -- ^ 0x03 ETX. Corresponds to `Data.Nbt.Int`.
  | LongType      -- ^ 0x04 EOT. Corresponds to `Data.Nbt.Long`.
  | FloatType     -- ^ 0x05 ENQ. Corresponds to `Data.Nbt.Float`.
  | DoubleType    -- ^ 0x06 ACK. Corresponds to `Data.Nbt.Double`.
  | ByteArrayType -- ^ 0x07 BEL. Corresponds to `ByteArray`.
  | StringType    -- ^ 0x08 BS. Corresponds to `Data.Nbt.String`.
  | ListType      -- ^ 0x09 HT. Corresponds to `List`.
  | CompoundType  -- ^ 0x0a LF. Corresponds to `Compound`.
  | IntArrayType  -- ^ 0x0b VT. Corresponds to `IntArray`.
  | LongArrayType -- ^ 0x0c FF. Corresponds to `LongArray`.
  deriving (Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show, Type -> Type -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq, Eq Type
Type -> Type -> Bool
Type -> Type -> Ordering
Type -> Type -> Type
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
min :: Type -> Type -> Type
$cmin :: Type -> Type -> Type
max :: Type -> Type -> Type
$cmax :: Type -> Type -> Type
>= :: Type -> Type -> Bool
$c>= :: Type -> Type -> Bool
> :: Type -> Type -> Bool
$c> :: Type -> Type -> Bool
<= :: Type -> Type -> Bool
$c<= :: Type -> Type -> Bool
< :: Type -> Type -> Bool
$c< :: Type -> Type -> Bool
compare :: Type -> Type -> Ordering
$ccompare :: Type -> Type -> Ordering
Ord, Int -> Type
Type -> Int
Type -> [Type]
Type -> Type
Type -> Type -> [Type]
Type -> Type -> Type -> [Type]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Type -> Type -> Type -> [Type]
$cenumFromThenTo :: Type -> Type -> Type -> [Type]
enumFromTo :: Type -> Type -> [Type]
$cenumFromTo :: Type -> Type -> [Type]
enumFromThen :: Type -> Type -> [Type]
$cenumFromThen :: Type -> Type -> [Type]
enumFrom :: Type -> [Type]
$cenumFrom :: Type -> [Type]
fromEnum :: Type -> Int
$cfromEnum :: Type -> Int
toEnum :: Int -> Type
$ctoEnum :: Int -> Type
pred :: Type -> Type
$cpred :: Type -> Type
succ :: Type -> Type
$csucc :: Type -> Type
Enum)

-- | The main NBT type, with support for serialization and deserialization. It couples a 'Text' label with a 'Tag'.
-- 
-- When serialized: 1-byte unsigned 'Type' + 2-byte unsigned integer length + N bytes utf-8 text + 'Tag'
data Nbt b = Nbt
  { forall b. Nbt b -> Text
label :: Text
  , forall b. Nbt b -> Tag b
tag :: Tag b
  }
  deriving (Int -> Nbt b -> ShowS
forall b. Show b => Int -> Nbt b -> ShowS
forall b. Show b => [Nbt b] -> ShowS
forall b. Show b => Nbt b -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Nbt b] -> ShowS
$cshowList :: forall b. Show b => [Nbt b] -> ShowS
show :: Nbt b -> String
$cshow :: forall b. Show b => Nbt b -> String
showsPrec :: Int -> Nbt b -> ShowS
$cshowsPrec :: forall b. Show b => Int -> Nbt b -> ShowS
Show, Nbt b -> Nbt b -> Bool
forall b. Eq b => Nbt b -> Nbt b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Nbt b -> Nbt b -> Bool
$c/= :: forall b. Eq b => Nbt b -> Nbt b -> Bool
== :: Nbt b -> Nbt b -> Bool
$c== :: forall b. Eq b => Nbt b -> Nbt b -> Bool
Eq, Nbt b -> Nbt b -> Bool
Nbt b -> Nbt b -> Ordering
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
forall {b}. Ord b => Eq (Nbt b)
forall b. Ord b => Nbt b -> Nbt b -> Bool
forall b. Ord b => Nbt b -> Nbt b -> Ordering
forall b. Ord b => Nbt b -> Nbt b -> Nbt b
min :: Nbt b -> Nbt b -> Nbt b
$cmin :: forall b. Ord b => Nbt b -> Nbt b -> Nbt b
max :: Nbt b -> Nbt b -> Nbt b
$cmax :: forall b. Ord b => Nbt b -> Nbt b -> Nbt b
>= :: Nbt b -> Nbt b -> Bool
$c>= :: forall b. Ord b => Nbt b -> Nbt b -> Bool
> :: Nbt b -> Nbt b -> Bool
$c> :: forall b. Ord b => Nbt b -> Nbt b -> Bool
<= :: Nbt b -> Nbt b -> Bool
$c<= :: forall b. Ord b => Nbt b -> Nbt b -> Bool
< :: Nbt b -> Nbt b -> Bool
$c< :: forall b. Ord b => Nbt b -> Nbt b -> Bool
compare :: Nbt b -> Nbt b -> Ordering
$ccompare :: forall b. Ord b => Nbt b -> Nbt b -> Ordering
Ord, forall a b. a -> Nbt b -> Nbt a
forall a b. (a -> b) -> Nbt a -> Nbt b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Nbt b -> Nbt a
$c<$ :: forall a b. a -> Nbt b -> Nbt a
fmap :: forall a b. (a -> b) -> Nbt a -> Nbt b
$cfmap :: forall a b. (a -> b) -> Nbt a -> Nbt b
Functor)

-- | The "simple" form of `Nbt`, which has no label map on `Compound`s.
type Nbt' = Nbt ()

-- | A version of `Nbt` which has a map from labels to element indices for fast lookup.
type MapNbt = Nbt (Map Text Int)

-- | An NBT tag, responsible for storing the actual data.
data Tag b
  = Byte      Int8             -- ^ 1-byte signed integer
  | Short     Int16            -- ^ 2-byte signed integer
  | Int       Int32            -- ^ 4-byte signed integer
  | Long      Int64            -- ^ 8-byte signed integer
  | Float     Float            -- ^ 4-byte float
  | Double    Double           -- ^ 8-byte double
  | ByteArray (Vector Int8)    -- ^ 4-byte signed integer length + N 1-byte signed integers
  | String    Text             -- ^ 2-byte unsigned integer length + N bytes utf-8 text
  | List      (Vector (Tag b)) -- ^ 1-byte unsigned 'Type' + 4-byte signed integer length + N homogenous tags
  | Compound  (Cmpnd b)        -- ^ N heterogenous NBT elements punctuated by an 'EndType'
  | IntArray  (Vector Int32)   -- ^ 4-byte signed integer length + N 4-byte signed integers
  | LongArray (Vector Int64)   -- ^ 4-byte signed integer length + N 8-byte signed integers
  deriving (Int -> Tag b -> ShowS
forall b. Show b => Int -> Tag b -> ShowS
forall b. Show b => [Tag b] -> ShowS
forall b. Show b => Tag b -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tag b] -> ShowS
$cshowList :: forall b. Show b => [Tag b] -> ShowS
show :: Tag b -> String
$cshow :: forall b. Show b => Tag b -> String
showsPrec :: Int -> Tag b -> ShowS
$cshowsPrec :: forall b. Show b => Int -> Tag b -> ShowS
Show, Tag b -> Tag b -> Bool
forall b. Eq b => Tag b -> Tag b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tag b -> Tag b -> Bool
$c/= :: forall b. Eq b => Tag b -> Tag b -> Bool
== :: Tag b -> Tag b -> Bool
$c== :: forall b. Eq b => Tag b -> Tag b -> Bool
Eq, Tag b -> Tag b -> Ordering
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
forall {b}. Ord b => Eq (Tag b)
forall b. Ord b => Tag b -> Tag b -> Bool
forall b. Ord b => Tag b -> Tag b -> Ordering
forall b. Ord b => Tag b -> Tag b -> Tag b
min :: Tag b -> Tag b -> Tag b
$cmin :: forall b. Ord b => Tag b -> Tag b -> Tag b
max :: Tag b -> Tag b -> Tag b
$cmax :: forall b. Ord b => Tag b -> Tag b -> Tag b
>= :: Tag b -> Tag b -> Bool
$c>= :: forall b. Ord b => Tag b -> Tag b -> Bool
> :: Tag b -> Tag b -> Bool
$c> :: forall b. Ord b => Tag b -> Tag b -> Bool
<= :: Tag b -> Tag b -> Bool
$c<= :: forall b. Ord b => Tag b -> Tag b -> Bool
< :: Tag b -> Tag b -> Bool
$c< :: forall b. Ord b => Tag b -> Tag b -> Bool
compare :: Tag b -> Tag b -> Ordering
$ccompare :: forall b. Ord b => Tag b -> Tag b -> Ordering
Ord, forall a b. a -> Tag b -> Tag a
forall a b. (a -> b) -> Tag a -> Tag b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Tag b -> Tag a
$c<$ :: forall a b. a -> Tag b -> Tag a
fmap :: forall a b. (a -> b) -> Tag a -> Tag b
$cfmap :: forall a b. (a -> b) -> Tag a -> Tag b
Functor)

-- | A pattern synonym for "Compound (Cmpnd () v)".
pattern Compound' :: Vector Nbt' -> Tag'
pattern $bCompound' :: Vector (Nbt ()) -> Tag'
$mCompound' :: forall {r}. Tag' -> (Vector (Nbt ()) -> r) -> ((# #) -> r) -> r
Compound' v <- Compound (Cmpnd () v)
  where Compound' Vector (Nbt ())
v = forall b. Cmpnd b -> Tag b
Compound (forall b. b -> Vector (Nbt b) -> Cmpnd b
Cmpnd () Vector (Nbt ())
v)
{-# COMPLETE Byte, Short, Int, Long, Float, Double, ByteArray, String, List, Compound', IntArray, LongArray #-}

-- | The "simple" form of `Tag`, which has no label map on `Compound`s.
type Tag' = Tag ()

-- | A version of `Tag` which has a map from labels to element indices for fast lookup.
type MapTag = Tag (Map Text Int)

-- | The payload of the `Compound` constructor.
data Cmpnd b = Cmpnd b (Vector (Nbt b))
  deriving (Int -> Cmpnd b -> ShowS
forall b. Show b => Int -> Cmpnd b -> ShowS
forall b. Show b => [Cmpnd b] -> ShowS
forall b. Show b => Cmpnd b -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cmpnd b] -> ShowS
$cshowList :: forall b. Show b => [Cmpnd b] -> ShowS
show :: Cmpnd b -> String
$cshow :: forall b. Show b => Cmpnd b -> String
showsPrec :: Int -> Cmpnd b -> ShowS
$cshowsPrec :: forall b. Show b => Int -> Cmpnd b -> ShowS
Show, Cmpnd b -> Cmpnd b -> Bool
forall b. Eq b => Cmpnd b -> Cmpnd b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cmpnd b -> Cmpnd b -> Bool
$c/= :: forall b. Eq b => Cmpnd b -> Cmpnd b -> Bool
== :: Cmpnd b -> Cmpnd b -> Bool
$c== :: forall b. Eq b => Cmpnd b -> Cmpnd b -> Bool
Eq, Cmpnd b -> Cmpnd b -> Bool
Cmpnd b -> Cmpnd b -> Ordering
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
forall {b}. Ord b => Eq (Cmpnd b)
forall b. Ord b => Cmpnd b -> Cmpnd b -> Bool
forall b. Ord b => Cmpnd b -> Cmpnd b -> Ordering
forall b. Ord b => Cmpnd b -> Cmpnd b -> Cmpnd b
min :: Cmpnd b -> Cmpnd b -> Cmpnd b
$cmin :: forall b. Ord b => Cmpnd b -> Cmpnd b -> Cmpnd b
max :: Cmpnd b -> Cmpnd b -> Cmpnd b
$cmax :: forall b. Ord b => Cmpnd b -> Cmpnd b -> Cmpnd b
>= :: Cmpnd b -> Cmpnd b -> Bool
$c>= :: forall b. Ord b => Cmpnd b -> Cmpnd b -> Bool
> :: Cmpnd b -> Cmpnd b -> Bool
$c> :: forall b. Ord b => Cmpnd b -> Cmpnd b -> Bool
<= :: Cmpnd b -> Cmpnd b -> Bool
$c<= :: forall b. Ord b => Cmpnd b -> Cmpnd b -> Bool
< :: Cmpnd b -> Cmpnd b -> Bool
$c< :: forall b. Ord b => Cmpnd b -> Cmpnd b -> Bool
compare :: Cmpnd b -> Cmpnd b -> Ordering
$ccompare :: forall b. Ord b => Cmpnd b -> Cmpnd b -> Ordering
Ord, forall a b. a -> Cmpnd b -> Cmpnd a
forall a b. (a -> b) -> Cmpnd a -> Cmpnd b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Cmpnd b -> Cmpnd a
$c<$ :: forall a b. a -> Cmpnd b -> Cmpnd a
fmap :: forall a b. (a -> b) -> Cmpnd a -> Cmpnd b
$cfmap :: forall a b. (a -> b) -> Cmpnd a -> Cmpnd b
Functor)

-- | The "simple" form of `Cmpnd`, which has no label map.
type Cmpnd' = Cmpnd ()

-- | A version of `Cmpnd` which has a map from labels to element indices for fast lookup.
type MapCmpnd = Cmpnd (Map Text Int)

-- | Use a `MapCmpnd` to quickly look up a `MapNbt` by label.
lookupNbt :: Text -> MapCmpnd -> Maybe MapNbt
lookupNbt :: Text -> MapCmpnd -> Maybe (Nbt (Map Text Int))
lookupNbt Text
t (Cmpnd Map Text Int
m Vector (Nbt (Map Text Int))
v) = (Vector (Nbt (Map Text Int))
v forall a. HasCallStack => Vector a -> Int -> a
R.!) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
t Map Text Int
m

-- | Use a `MapCmpnd` to quickly get a `MapNbt` by label.
getNbt :: Text -> MapCmpnd -> MapNbt
getNbt :: Text -> MapCmpnd -> Nbt (Map Text Int)
getNbt Text
t (Cmpnd Map Text Int
m Vector (Nbt (Map Text Int))
v) = Vector (Nbt (Map Text Int))
v forall a. HasCallStack => Vector a -> Int -> a
R.! (Map Text Int
m forall k a. Ord k => Map k a -> k -> a
M.! Text
t)

-- | Runs `lookupNbt`, then retrieves the `tag`.
lookupTag :: Text -> MapCmpnd -> Maybe MapTag
lookupTag :: Text -> MapCmpnd -> Maybe MapTag
lookupTag Text
t MapCmpnd
c = forall b. Nbt b -> Tag b
tag forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> MapCmpnd -> Maybe (Nbt (Map Text Int))
lookupNbt Text
t MapCmpnd
c

-- | Runs `getNbt`, then retrieves the `tag`.
getTag :: Text -> MapCmpnd -> MapTag
getTag :: Text -> MapCmpnd -> MapTag
getTag Text
t MapCmpnd
c = forall b. Nbt b -> Tag b
tag forall a b. (a -> b) -> a -> b
$ Text -> MapCmpnd -> Nbt (Map Text Int)
getNbt Text
t MapCmpnd
c

instance Serialize (Nbt ()) where
  get :: Get (Nbt ())
get = forall t. Serialize t => Get t
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b. GenMap b => Type -> Get (Nbt b)
getNbtByType
  put :: Putter (Nbt ())
put (Nbt Text
n Tag'
d) = forall t. Serialize t => Putter t
put (forall b. Tag b -> Type
typeOf Tag'
d) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> PutM ()
putString Text
n forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall b. Serialize (Nbt b) => Tag b -> PutM ()
putTag Tag'
d

instance Serialize (Nbt (Map Text Int)) where
  get :: Get (Nbt (Map Text Int))
get = forall t. Serialize t => Get t
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b. GenMap b => Type -> Get (Nbt b)
getNbtByType
  put :: Putter (Nbt (Map Text Int))
put (Nbt Text
n MapTag
d) = forall t. Serialize t => Putter t
put (forall b. Tag b -> Type
typeOf MapTag
d) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> PutM ()
putString Text
n forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall b. Serialize (Nbt b) => Tag b -> PutM ()
putTag MapTag
d

instance Serialize Type where
  get :: Get Type
get = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8
  put :: Putter Type
put = Putter Word8
putWord8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum

class GenMap b where
  genMap :: Vector (Nbt b) -> b

instance GenMap () where
  genMap :: Vector (Nbt ()) -> ()
genMap = forall a b. a -> b -> a
const ()
  {-# INLINE CONLIKE genMap #-}

instance GenMap (Map Text Int) where
  genMap :: Vector (Nbt (Map Text Int)) -> Map Text Int
genMap = forall i (f :: * -> *) a b.
FoldableWithIndex i f =>
(i -> a -> b -> b) -> b -> f a -> b
ifoldr (\Int
i (Nbt Text
l MapTag
_) Map Text Int
a -> forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Text
l Int
i Map Text Int
a) forall k a. Map k a
M.empty
  {-# INLINE genMap #-}

-- | Get the type of an NBT tag.
typeOf :: Tag b -> Type
typeOf :: forall b. Tag b -> Type
typeOf = \case
  Byte Int8
_ -> Type
ByteType
  Short Int16
_ -> Type
ShortType
  Int Int32
_ -> Type
IntType
  Long Int64
_ -> Type
LongType
  Float Float
_ -> Type
FloatType
  Double Double
_ -> Type
DoubleType
  ByteArray Vector Int8
_ -> Type
ByteArrayType
  String Text
_ -> Type
StringType
  List Vector (Tag b)
_ -> Type
ListType
  Compound Cmpnd b
_ -> Type
CompoundType
  IntArray Vector Int32
_ -> Type
IntArrayType
  LongArray Vector Int64
_ -> Type
LongArrayType

putTag :: Serialize (Nbt b) => Tag b -> Put
putTag :: forall b. Serialize (Nbt b) => Tag b -> PutM ()
putTag = \case
  Byte Int8
b -> forall t. Serialize t => Putter t
put Int8
b
  Short Int16
s -> forall t. Serialize t => Putter t
put Int16
s
  Int Int32
i -> forall t. Serialize t => Putter t
put Int32
i
  Long Int64
l -> forall t. Serialize t => Putter t
put Int64
l
  Float Float
f -> Float -> PutM ()
putFloat32be Float
f
  Double Double
d -> Double -> PutM ()
putFloat64be Double
d
  ByteArray Vector Int8
bs -> forall e. (e -> PutM ()) -> Vector e -> PutM ()
putArray forall t. Serialize t => Putter t
put Vector Int8
bs
  String Text
str -> Text -> PutM ()
putString Text
str
  List Vector (Tag b)
ts -> do
    Type
ty <-
      if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Vector (Tag b)
ts then do
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
EndType
      else do
        let xt :: Type
xt = forall b. Tag b -> Type
typeOf (Vector (Tag b)
ts forall a. HasCallStack => Vector a -> Int -> a
R.! Int
0)
        let xs :: Vector (Tag b)
xs = forall a. Int -> Vector a -> Vector a
R.drop Int
1 Vector (Tag b)
ts
        if forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Tag b
e -> forall b. Tag b -> Type
typeOf Tag b
e forall a. Eq a => a -> a -> Bool
== Type
xt) Vector (Tag b)
xs then
          forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
xt
        else
          forall a. HasCallStack => String -> a
error String
"attempted to write heterogenous list"
    forall t. Serialize t => Putter t
put Type
ty
    forall e. (e -> PutM ()) -> Vector e -> PutM ()
putArray forall b. Serialize (Nbt b) => Tag b -> PutM ()
putTag Vector (Tag b)
ts
  Compound (Cmpnd b
_ Vector (Nbt b)
ts) -> forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall t. Serialize t => Putter t
put Vector (Nbt b)
ts forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall t. Serialize t => Putter t
put Type
EndType
  IntArray Vector Int32
is -> forall e. (e -> PutM ()) -> Vector e -> PutM ()
putArray forall t. Serialize t => Putter t
put Vector Int32
is
  LongArray Vector Int64
is -> forall e. (e -> PutM ()) -> Vector e -> PutM ()
putArray forall t. Serialize t => Putter t
put Vector Int64
is
  where
    putArray :: (e -> Put) -> Vector e -> Put
    putArray :: forall e. (e -> PutM ()) -> Vector e -> PutM ()
putArray e -> PutM ()
putter Vector e
a = do
      forall t. Serialize t => Putter t
put (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length Vector e
a) :: Int32)
      forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ e -> PutM ()
putter Vector e
a
{-# SPECIALIZE putTag :: Tag () -> Put #-}
{-# SPECIALIZE putTag :: Tag (Map Text Int) -> Put #-}

getNbtByType :: GenMap b => Type -> Get (Nbt b)
getNbtByType :: forall b. GenMap b => Type -> Get (Nbt b)
getNbtByType Type
ty = forall b. Text -> Tag b -> Nbt b
Nbt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
getString forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall b. GenMap b => Type -> Get (Tag b)
getByType Type
ty
{-# SPECIALIZE getNbtByType :: Type -> Get (Nbt ()) #-}
{-# SPECIALIZE getNbtByType :: Type -> Get (Nbt (Map Text Int)) #-}

getByType :: GenMap b => Type -> Get (Tag b)
getByType :: forall b. GenMap b => Type -> Get (Tag b)
getByType = \case
  Type
EndType -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot get a value of EndType"
  Type
ByteType -> forall b. Int8 -> Tag b
Byte forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Serialize t => Get t
get
  Type
ShortType -> forall b. Int16 -> Tag b
Short forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Serialize t => Get t
get
  Type
IntType -> forall b. Int32 -> Tag b
Int forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Serialize t => Get t
get
  Type
LongType -> forall b. Int64 -> Tag b
Long forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Serialize t => Get t
get
  Type
FloatType -> forall b. Float -> Tag b
Float forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Float
getFloat32be
  Type
DoubleType -> forall b. Double -> Tag b
Double forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Double
getFloat64be
  Type
ByteArrayType -> forall b. Vector Int8 -> Tag b
ByteArray forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Get e -> Get (Vector e)
getArray forall t. Serialize t => Get t
get
  Type
StringType -> forall b. Text -> Tag b
String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
getString
  Type
ListType -> forall b. Vector (Tag b) -> Tag b
List forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e. Get e -> Get (Vector e)
getArray forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. GenMap b => Type -> Get (Tag b)
getByType forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall t. Serialize t => Get t
get)
  Type
CompoundType -> do
    Vector (Nbt b)
x <- forall b. GenMap b => Get (Vector (Nbt b))
getCompound
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall b. Cmpnd b -> Tag b
Compound (forall b. b -> Vector (Nbt b) -> Cmpnd b
Cmpnd (forall b. GenMap b => Vector (Nbt b) -> b
genMap Vector (Nbt b)
x) Vector (Nbt b)
x)
  Type
IntArrayType -> forall b. Vector Int32 -> Tag b
IntArray forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Get e -> Get (Vector e)
getArray forall t. Serialize t => Get t
get
  Type
LongArrayType -> forall b. Vector Int64 -> Tag b
LongArray forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e. Get e -> Get (Vector e)
getArray forall t. Serialize t => Get t
get
  where
    getCompound :: GenMap b => Get (Vector (Nbt b))
    getCompound :: forall b. GenMap b => Get (Vector (Nbt b))
getCompound = forall t. Serialize t => Get t
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Type
EndType -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Vector a
R.empty
      Type
ty -> forall a. a -> Vector a -> Vector a
(<|) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b. GenMap b => Type -> Get (Nbt b)
getNbtByType Type
ty forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall b. GenMap b => Get (Vector (Nbt b))
getCompound
{-# SPECIALIZE getByType :: Type -> Get (Tag ()) #-}
{-# SPECIALIZE getByType :: Type -> Get (Tag (Map Text Int)) #-}

{-
-- File IO
-}

-- | Read an uncompressed NBT file. Exceptions are thrown as usual if the internal call to 'Data.ByteString.readFile' fails,
-- and the 'Either' message is that returned by 'Data.Serialize.decode'.
readUncompressed :: Serialize (Nbt b) => FilePath -> IO (Either String (Nbt b))
readUncompressed :: forall b. Serialize (Nbt b) => String -> IO (Either String (Nbt b))
readUncompressed String
fp = forall a. Serialize a => ByteString -> Either String a
decode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
B.readFile String
fp

-- | Write an uncompressed NBT file.
writeUncompressed :: Serialize (Nbt b) => FilePath -> Nbt b -> IO ()
writeUncompressed :: forall b. Serialize (Nbt b) => String -> Nbt b -> IO ()
writeUncompressed String
fp Nbt b
nbt = String -> ByteString -> IO ()
B.writeFile String
fp forall a b. (a -> b) -> a -> b
$ PutM () -> ByteString
runPut (forall t. Serialize t => Putter t
put Nbt b
nbt)

-- | Read a GZip-compressed NBT file. Exceptions are thrown as usual if the internal call to 'Data.ByteString.Lazy.readFile' fails,
-- and the 'Either' message is that returned by 'Data.Serialize.decode'.
readCompressed :: Serialize (Nbt b) => FilePath -> IO (Either String (Nbt b))
readCompressed :: forall b. Serialize (Nbt b) => String -> IO (Either String (Nbt b))
readCompressed String
fp = do
  ByteString
bs <- ByteString -> ByteString
GZ.decompress forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BL.readFile String
fp
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialize a => ByteString -> Either String a
decode forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B.toStrict ByteString
bs

-- | Write a GZip-compressed NBT file.
writeCompressed :: Serialize (Nbt b) => FilePath -> Nbt b -> IO ()
writeCompressed :: forall b. Serialize (Nbt b) => String -> Nbt b -> IO ()
writeCompressed String
fp Nbt b
nbt = do
  let bs :: ByteString
bs = ByteString -> ByteString
GZ.compress forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.fromStrict forall a b. (a -> b) -> a -> b
$ PutM () -> ByteString
runPut (forall t. Serialize t => Putter t
put Nbt b
nbt)
  String -> ByteString -> IO ()
B.writeFile String
fp (ByteString -> ByteString
B.toStrict ByteString
bs)

{-
-- Internal Utility Functions
-}

getArray :: Get e -> Get (Vector e)
getArray :: forall e. Get e -> Get (Vector e)
getArray Get e
getter = do
  Int32
len <- forall t. Serialize t => Get t
get :: Get Int32
  [e]
elts <- forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
len) Get e
getter
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
R.fromList forall a b. (a -> b) -> a -> b
$ [e]
elts

getString :: Get Text
getString :: Get Text
getString = do
  Word16
len <- forall t. Serialize t => Get t
get :: Get Word16
  ByteString -> Text
decodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get ByteString
getByteString (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
len)

putString :: Text -> Put
putString :: Text -> PutM ()
putString Text
t = do
  let b :: ByteString
b = Text -> ByteString
encodeUtf8 Text
t
  forall t. Serialize t => Putter t
put (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
b) :: Word16)
  Putter ByteString
putByteString ByteString
b