{-# LANGUAGE FlexibleInstances, ScopedTypeVariables, Rank2Types #-}

module General.Binary(
    BinaryOp(..), binaryOpMap,
    binarySplit, binarySplit2, binarySplit3, unsafeBinarySplit,
    Builder(..), runBuilder, sizeBuilder,
    BinaryEx(..),
    Storable, putExStorable, getExStorable, putExStorableList, getExStorableList,
    putExList, getExList, putExN, getExN
    ) where

import Development.Shake.Classes
import Control.Monad
import Data.Binary
import Data.List.Extra
import Data.Tuple.Extra
import Foreign.Storable
import Foreign.Ptr
import System.IO.Unsafe as U
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString.Unsafe as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.UTF8 as UTF8
import Data.Semigroup
import Prelude


---------------------------------------------------------------------
-- STORE TYPE

-- | An explicit and more efficient version of Binary
data BinaryOp v = BinaryOp
    {forall v. BinaryOp v -> v -> Builder
putOp :: v -> Builder
    ,forall v. BinaryOp v -> ByteString -> v
getOp :: BS.ByteString -> v
    }

binaryOpMap :: BinaryEx a => (a -> BinaryOp b) -> BinaryOp (a, b)
binaryOpMap :: forall a b. BinaryEx a => (a -> BinaryOp b) -> BinaryOp (a, b)
binaryOpMap a -> BinaryOp b
mp = BinaryOp
    {putOp :: (a, b) -> Builder
putOp = \(a
a, b
b) -> Builder -> Builder
putExN (forall a. BinaryEx a => a -> Builder
putEx a
a) forall a. Semigroup a => a -> a -> a
<> forall v. BinaryOp v -> v -> Builder
putOp (a -> BinaryOp b
mp a
a) b
b
    ,getOp :: ByteString -> (a, b)
getOp = \ByteString
bs -> let (ByteString
bs1,ByteString
bs2) = ByteString -> (ByteString, ByteString)
getExN ByteString
bs; a :: a
a = forall a. BinaryEx a => ByteString -> a
getEx ByteString
bs1 in (a
a, forall v. BinaryOp v -> ByteString -> v
getOp (a -> BinaryOp b
mp a
a) ByteString
bs2)
    }


binarySplit :: forall a . Storable a => BS.ByteString -> (a, BS.ByteString)
binarySplit :: forall a. Storable a => ByteString -> (a, ByteString)
binarySplit ByteString
bs | ByteString -> Int
BS.length ByteString
bs forall a. Ord a => a -> a -> Bool
< forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a) = forall a. HasCallStack => [Char] -> a
error [Char]
"Reading from ByteString, insufficient left"
               | Bool
otherwise = forall a. Storable a => ByteString -> (a, ByteString)
unsafeBinarySplit ByteString
bs

binarySplit2 :: forall a b . (Storable a, Storable b) => BS.ByteString -> (a, b, BS.ByteString)
binarySplit2 :: forall a b.
(Storable a, Storable b) =>
ByteString -> (a, b, ByteString)
binarySplit2 ByteString
bs | ByteString -> Int
BS.length ByteString
bs forall a. Ord a => a -> a -> Bool
< forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a) forall a. Num a => a -> a -> a
+ forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: b) = forall a. HasCallStack => [Char] -> a
error [Char]
"Reading from ByteString, insufficient left"
                | (a
a,ByteString
bs) <- forall a. Storable a => ByteString -> (a, ByteString)
unsafeBinarySplit ByteString
bs, (b
b,ByteString
bs) <- forall a. Storable a => ByteString -> (a, ByteString)
unsafeBinarySplit ByteString
bs = (a
a,b
b,ByteString
bs)

binarySplit3 :: forall a b c . (Storable a, Storable b, Storable c) => BS.ByteString -> (a, b, c, BS.ByteString)
binarySplit3 :: forall a b c.
(Storable a, Storable b, Storable c) =>
ByteString -> (a, b, c, ByteString)
binarySplit3 ByteString
bs | ByteString -> Int
BS.length ByteString
bs forall a. Ord a => a -> a -> Bool
< forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a) forall a. Num a => a -> a -> a
+ forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: b) forall a. Num a => a -> a -> a
+ forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: c) = forall a. HasCallStack => [Char] -> a
error [Char]
"Reading from ByteString, insufficient left"
                | (a
a,ByteString
bs) <- forall a. Storable a => ByteString -> (a, ByteString)
unsafeBinarySplit ByteString
bs, (b
b,ByteString
bs) <- forall a. Storable a => ByteString -> (a, ByteString)
unsafeBinarySplit ByteString
bs, (c
c,ByteString
bs) <- forall a. Storable a => ByteString -> (a, ByteString)
unsafeBinarySplit ByteString
bs = (a
a,b
b,c
c,ByteString
bs)


unsafeBinarySplit :: Storable a => BS.ByteString -> (a, BS.ByteString)
unsafeBinarySplit :: forall a. Storable a => ByteString -> (a, ByteString)
unsafeBinarySplit ByteString
bs = (a
v, Int -> ByteString -> ByteString
BS.unsafeDrop (forall a. Storable a => a -> Int
sizeOf a
v) ByteString
bs)
    where v :: a
v = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. ByteString -> (CString -> IO a) -> IO a
BS.unsafeUseAsCString ByteString
bs forall a b. (a -> b) -> a -> b
$ \CString
ptr -> forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr CString
ptr)


-- forM for zipWith
for2M_ :: [a] -> [b] -> (a -> b -> m c) -> m ()
for2M_ [a]
as [b]
bs a -> b -> m c
f = forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ a -> b -> m c
f [a]
as [b]
bs

---------------------------------------------------------------------
-- BINARY SERIALISATION

-- We can't use the Data.ByteString builder as that doesn't track the size of the chunk.
data Builder = Builder {-# UNPACK #-} !Int (forall a . Ptr a -> Int -> IO ())

sizeBuilder :: Builder -> Int
sizeBuilder :: Builder -> Int
sizeBuilder (Builder Int
i forall a. Ptr a -> Int -> IO ()
_) = Int
i

runBuilder :: Builder -> BS.ByteString
runBuilder :: Builder -> ByteString
runBuilder (Builder Int
i forall a. Ptr a -> Int -> IO ()
f) = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ Int -> (Ptr Word8 -> IO ()) -> IO ByteString
BS.create Int
i forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> forall a. Ptr a -> Int -> IO ()
f Ptr Word8
ptr Int
0

instance Semigroup Builder where
    (Builder Int
x1 forall a. Ptr a -> Int -> IO ()
x2) <> :: Builder -> Builder -> Builder
<> (Builder Int
y1 forall a. Ptr a -> Int -> IO ()
y2) = Int -> (forall a. Ptr a -> Int -> IO ()) -> Builder
Builder (Int
x1forall a. Num a => a -> a -> a
+Int
y1) forall a b. (a -> b) -> a -> b
$ \Ptr a
p Int
i -> do forall a. Ptr a -> Int -> IO ()
x2 Ptr a
p Int
i; forall a. Ptr a -> Int -> IO ()
y2 Ptr a
p forall a b. (a -> b) -> a -> b
$ Int
iforall a. Num a => a -> a -> a
+Int
x1

instance Monoid Builder where
    mempty :: Builder
mempty = Int -> (forall a. Ptr a -> Int -> IO ()) -> Builder
Builder Int
0 forall a b. (a -> b) -> a -> b
$ \Ptr a
_ Int
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    mappend :: Builder -> Builder -> Builder
mappend = forall a. Semigroup a => a -> a -> a
(<>)

-- | Methods for Binary serialisation that go directly between strict ByteString values.
--   When the Database is read each key/value will be loaded as a separate ByteString,
--   and for certain types (e.g. file rules) this may remain the preferred format for storing keys.
--   Optimised for performance.
class BinaryEx a where
    putEx :: a -> Builder
    getEx :: BS.ByteString -> a

instance BinaryEx BS.ByteString where
    putEx :: ByteString -> Builder
putEx ByteString
x = Int -> (forall a. Ptr a -> Int -> IO ()) -> Builder
Builder Int
n forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr Int
i -> forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
x forall a b. (a -> b) -> a -> b
$ \CString
bs -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
BS.memcpy (Ptr a
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
i) (forall a b. Ptr a -> Ptr b
castPtr CString
bs) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
        where n :: Int
n = ByteString -> Int
BS.length ByteString
x
    getEx :: ByteString -> ByteString
getEx = forall a. a -> a
id

instance BinaryEx LBS.ByteString where
    putEx :: ByteString -> Builder
putEx ByteString
x = Int -> (forall a. Ptr a -> Int -> IO ()) -> Builder
Builder (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
LBS.length ByteString
x) forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr Int
i -> do
        let go :: Int -> [ByteString] -> IO ()
go Int
_ [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            go Int
i (ByteString
x:[ByteString]
xs) = do
                let n :: Int
n = ByteString -> Int
BS.length ByteString
x
                forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
x forall a b. (a -> b) -> a -> b
$ \CString
bs -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
BS.memcpy (Ptr a
ptr forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
i) (forall a b. Ptr a -> Ptr b
castPtr CString
bs) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
                Int -> [ByteString] -> IO ()
go (Int
iforall a. Num a => a -> a -> a
+Int
n) [ByteString]
xs
        Int -> [ByteString] -> IO ()
go Int
i forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
LBS.toChunks ByteString
x
    getEx :: ByteString -> ByteString
getEx = [ByteString] -> ByteString
LBS.fromChunks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance BinaryEx [BS.ByteString] where
    -- Format:
    -- n :: Word32 - number of strings
    -- ns :: [Word32]{n} - length of each string
    -- contents of each string concatenated (sum ns bytes)
    putEx :: [ByteString] -> Builder
putEx [ByteString]
xs = Int -> (forall a. Ptr a -> Int -> IO ()) -> Builder
Builder (Int
4 forall a. Num a => a -> a -> a
+ (Int
n forall a. Num a => a -> a -> a
* Int
4) forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Int]
ns) forall a b. (a -> b) -> a -> b
$ \Ptr a
p Int
i -> do
        forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr a
p Int
i (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n :: Word32)
        forall {m :: * -> *} {a} {b} {c}.
Applicative m =>
[a] -> [b] -> (a -> b -> m c) -> m ()
for2M_ [Int
4forall a. Num a => a -> a -> a
+Int
i,Int
8forall a. Num a => a -> a -> a
+Int
i..] [Int]
ns forall a b. (a -> b) -> a -> b
$ \Int
i Int
x -> forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr a
p Int
i (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x :: Word32)
        Ptr Any
p<- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Ptr a
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` (Int
i forall a. Num a => a -> a -> a
+ Int
4 forall a. Num a => a -> a -> a
+ (Int
n forall a. Num a => a -> a -> a
* Int
4))
        forall {m :: * -> *} {a} {b} {c}.
Applicative m =>
[a] -> [b] -> (a -> b -> m c) -> m ()
for2M_ (forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(+) Int
0 [Int]
ns) [ByteString]
xs forall a b. (a -> b) -> a -> b
$ \Int
i ByteString
x -> forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
x forall a b. (a -> b) -> a -> b
$ \(CString
bs, Int
n) ->
            Ptr Word8 -> Ptr Word8 -> Int -> IO ()
BS.memcpy (Ptr Any
p forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
i) (forall a b. Ptr a -> Ptr b
castPtr CString
bs) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
        where ns :: [Int]
ns = forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Int
BS.length [ByteString]
xs
              n :: Int
n = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
ns

    getEx :: ByteString -> [ByteString]
getEx ByteString
bs = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. ByteString -> (CString -> IO a) -> IO a
BS.useAsCString ByteString
bs forall a b. (a -> b) -> a -> b
$ \CString
p -> do
        Int
n <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff CString
p Int
0 :: IO Word32)
        [Word32]
ns :: [Word32] <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
1..forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n] forall a b. (a -> b) -> a -> b
$ \Int
i -> forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff CString
p (Int
i forall a. Num a => a -> a -> a
* Int
4)
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (\ByteString
bs Word32
i -> forall a b. (a, b) -> (b, a)
swap forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i) ByteString
bs) (Int -> ByteString -> ByteString
BS.drop (Int
4 forall a. Num a => a -> a -> a
+ (Int
n forall a. Num a => a -> a -> a
* Int
4)) ByteString
bs) [Word32]
ns

instance BinaryEx () where
    putEx :: () -> Builder
putEx () = forall a. Monoid a => a
mempty
    getEx :: ByteString -> ()
getEx ByteString
_ = ()

instance BinaryEx String where
    putEx :: [Char] -> Builder
putEx = forall a. BinaryEx a => a -> Builder
putEx forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
UTF8.fromString
    getEx :: ByteString -> [Char]
getEx = ByteString -> [Char]
UTF8.toString

instance BinaryEx (Maybe String) where
    putEx :: Maybe [Char] -> Builder
putEx Maybe [Char]
Nothing = forall a. Monoid a => a
mempty
    putEx (Just [Char]
xs) = forall a. BinaryEx a => a -> Builder
putEx forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
UTF8.fromString forall a b. (a -> b) -> a -> b
$ Char
'\0' forall a. a -> [a] -> [a]
: [Char]
xs
    getEx :: ByteString -> Maybe [Char]
getEx = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe (a, [a])
uncons forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
UTF8.toString

instance BinaryEx [String] where
    putEx :: [[Char]] -> Builder
putEx = forall a. BinaryEx a => a -> Builder
putEx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map [Char] -> ByteString
UTF8.fromString
    getEx :: ByteString -> [[Char]]
getEx = forall a b. (a -> b) -> [a] -> [b]
map ByteString -> [Char]
UTF8.toString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. BinaryEx a => ByteString -> a
getEx

instance BinaryEx (String, [String]) where
    putEx :: ([Char], [[Char]]) -> Builder
putEx ([Char]
a,[[Char]]
bs) = forall a. BinaryEx a => a -> Builder
putEx forall a b. (a -> b) -> a -> b
$ [Char]
aforall a. a -> [a] -> [a]
:[[Char]]
bs
    getEx :: ByteString -> ([Char], [[Char]])
getEx ByteString
x = let [Char]
a:[[Char]]
bs = forall a. BinaryEx a => ByteString -> a
getEx ByteString
x in ([Char]
a,[[Char]]
bs)

instance BinaryEx Bool where
    putEx :: Bool -> Builder
putEx Bool
False = Int -> (forall a. Ptr a -> Int -> IO ()) -> Builder
Builder Int
1 forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr Int
i -> forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr a
ptr Int
i (Word8
0 :: Word8)
    putEx Bool
True = forall a. Monoid a => a
mempty
    getEx :: ByteString -> Bool
getEx = ByteString -> Bool
BS.null

instance BinaryEx Word8 where
    putEx :: Word8 -> Builder
putEx = forall a. Storable a => a -> Builder
putExStorable
    getEx :: ByteString -> Word8
getEx = forall a. Storable a => ByteString -> a
getExStorable

instance BinaryEx Word16 where
    putEx :: Word16 -> Builder
putEx = forall a. Storable a => a -> Builder
putExStorable
    getEx :: ByteString -> Word16
getEx = forall a. Storable a => ByteString -> a
getExStorable

instance BinaryEx Word32 where
    putEx :: Word32 -> Builder
putEx = forall a. Storable a => a -> Builder
putExStorable
    getEx :: ByteString -> Word32
getEx = forall a. Storable a => ByteString -> a
getExStorable

instance BinaryEx Int where
    putEx :: Int -> Builder
putEx = forall a. Storable a => a -> Builder
putExStorable
    getEx :: ByteString -> Int
getEx = forall a. Storable a => ByteString -> a
getExStorable

instance BinaryEx Float where
    putEx :: Float -> Builder
putEx = forall a. Storable a => a -> Builder
putExStorable
    getEx :: ByteString -> Float
getEx = forall a. Storable a => ByteString -> a
getExStorable


putExStorable :: forall a . Storable a => a -> Builder
putExStorable :: forall a. Storable a => a -> Builder
putExStorable a
x = Int -> (forall a. Ptr a -> Int -> IO ()) -> Builder
Builder (forall a. Storable a => a -> Int
sizeOf a
x) forall a b. (a -> b) -> a -> b
$ \Ptr a
p Int
i -> forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr a
p Int
i a
x

getExStorable :: forall a . Storable a => BS.ByteString -> a
getExStorable :: forall a. Storable a => ByteString -> a
getExStorable = \ByteString
bs -> forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
bs forall a b. (a -> b) -> a -> b
$ \(CString
p, Int
size) ->
        if Int
size forall a. Eq a => a -> a -> Bool
/= Int
n then forall a. HasCallStack => [Char] -> a
error [Char]
"size mismatch" else forall a. Storable a => Ptr a -> IO a
peek (forall a b. Ptr a -> Ptr b
castPtr CString
p)
    where n :: Int
n = forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a)


putExStorableList :: forall a . Storable a => [a] -> Builder
putExStorableList :: forall a. Storable a => [a] -> Builder
putExStorableList [a]
xs = Int -> (forall a. Ptr a -> Int -> IO ()) -> Builder
Builder (Int
n forall a. Num a => a -> a -> a
* forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs) forall a b. (a -> b) -> a -> b
$ \Ptr a
ptr Int
i ->
    forall {m :: * -> *} {a} {b} {c}.
Applicative m =>
[a] -> [b] -> (a -> b -> m c) -> m ()
for2M_ [Int
i,Int
iforall a. Num a => a -> a -> a
+Int
n..] [a]
xs forall a b. (a -> b) -> a -> b
$ \Int
i a
x -> forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr a
ptr Int
i a
x
    where n :: Int
n = forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a)

getExStorableList :: forall a . Storable a => BS.ByteString -> [a]
getExStorableList :: forall a. Storable a => ByteString -> [a]
getExStorableList = \ByteString
bs -> forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. ByteString -> (CStringLen -> IO a) -> IO a
BS.useAsCStringLen ByteString
bs forall a b. (a -> b) -> a -> b
$ \(CString
p, Int
size) ->
    let (Int
d,Int
m) = Int
size forall a. Integral a => a -> a -> (a, a)
`divMod` Int
n in
    if Int
m forall a. Eq a => a -> a -> Bool
/= Int
0 then forall a. HasCallStack => [Char] -> a
error [Char]
"size mismatch" else forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Int
0..Int
dforall a. Num a => a -> a -> a
-Int
1] forall a b. (a -> b) -> a -> b
$ \Int
i -> forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (forall a b. Ptr a -> Ptr b
castPtr CString
p) Int
i
    where n :: Int
n = forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined :: a)


-- repeating:
--     Word32, length of BS
--     BS
putExList :: [Builder] -> Builder
putExList :: [Builder] -> Builder
putExList [Builder]
xs = Int -> (forall a. Ptr a -> Int -> IO ()) -> Builder
Builder (forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Builder
b -> Builder -> Int
sizeBuilder Builder
b forall a. Num a => a -> a -> a
+ Int
4) [Builder]
xs) forall a b. (a -> b) -> a -> b
$ \Ptr a
p Int
i -> do
    let go :: Int -> [Builder] -> IO ()
go Int
_ [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        go Int
i (Builder Int
n forall a. Ptr a -> Int -> IO ()
b:[Builder]
xs) = do
            forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr a
p Int
i (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n :: Word32)
            forall a. Ptr a -> Int -> IO ()
b Ptr a
p (Int
iforall a. Num a => a -> a -> a
+Int
4)
            Int -> [Builder] -> IO ()
go (Int
iforall a. Num a => a -> a -> a
+Int
4forall a. Num a => a -> a -> a
+Int
n) [Builder]
xs
    Int -> [Builder] -> IO ()
go Int
i [Builder]
xs

getExList :: BS.ByteString -> [BS.ByteString]
getExList :: ByteString -> [ByteString]
getExList ByteString
bs
    | Int
len forall a. Eq a => a -> a -> Bool
== Int
0 = []
    | Int
len forall a. Ord a => a -> a -> Bool
>= Int
4
    , (Word32
n :: Word32, ByteString
bs) <- forall a. Storable a => ByteString -> (a, ByteString)
unsafeBinarySplit ByteString
bs
    , Int
n <- forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n
    , (Int
len forall a. Num a => a -> a -> a
- Int
4) forall a. Ord a => a -> a -> Bool
>= Int
n
    = Int -> ByteString -> ByteString
BS.unsafeTake Int
n ByteString
bs forall a. a -> [a] -> [a]
: ByteString -> [ByteString]
getExList (Int -> ByteString -> ByteString
BS.unsafeDrop Int
n ByteString
bs)
    | Bool
otherwise = forall a. HasCallStack => [Char] -> a
error [Char]
"getList, corrupted binary"
    where len :: Int
len = ByteString -> Int
BS.length ByteString
bs

putExN :: Builder -> Builder
putExN :: Builder -> Builder
putExN (Builder Int
n forall a. Ptr a -> Int -> IO ()
old) = Int -> (forall a. Ptr a -> Int -> IO ()) -> Builder
Builder (Int
nforall a. Num a => a -> a -> a
+Int
4) forall a b. (a -> b) -> a -> b
$ \Ptr a
p Int
i -> do
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr a
p Int
i (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n :: Word32)
    forall a. Ptr a -> Int -> IO ()
old Ptr a
p forall a b. (a -> b) -> a -> b
$ Int
iforall a. Num a => a -> a -> a
+Int
4

getExN :: BS.ByteString -> (BS.ByteString, BS.ByteString)
getExN :: ByteString -> (ByteString, ByteString)
getExN ByteString
bs
    | Int
len forall a. Ord a => a -> a -> Bool
>= Int
4
    , (Word32
n :: Word32, ByteString
bs) <- forall a. Storable a => ByteString -> (a, ByteString)
unsafeBinarySplit ByteString
bs
    , Int
n <- forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
n
    , (Int
len forall a. Num a => a -> a -> a
- Int
4) forall a. Ord a => a -> a -> Bool
>= Int
n
    = (Int -> ByteString -> ByteString
BS.unsafeTake Int
n ByteString
bs, Int -> ByteString -> ByteString
BS.unsafeDrop Int
n ByteString
bs)
    | Bool
otherwise = forall a. HasCallStack => [Char] -> a
error [Char]
"getList, corrupted binary"
    where len :: Int
len = ByteString -> Int
BS.length ByteString
bs