    {-# 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 (a -> Builder
    forall a. BinaryEx a => a -> Builder
    putEx a
    a) Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> BinaryOp b -> b -> Builder
    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 = ByteString -> a
    forall a. BinaryEx a => ByteString -> a
    getEx ByteString
    bs1 in (a
    a, BinaryOp b -> ByteString -> b
    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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < a -> Int
    forall a. Storable a => a -> Int
    sizeOf (a
    forall a. HasCallStack => a
    undefined :: a) = [Char] -> (a, ByteString)
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Reading from ByteString, insufficient left"
                   | Bool
    otherwise = ByteString -> (a, ByteString)
    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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < a -> Int
    forall a. Storable a => a -> Int
    sizeOf (a
    forall a. HasCallStack => a
    undefined :: a) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + b -> Int
    forall a. Storable a => a -> Int
    sizeOf (b
    forall a. HasCallStack => a
    undefined :: b) = [Char] -> (a, b, ByteString)
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Reading from ByteString, insufficient left"
                    | (a
    a,ByteString
    bs) <- ByteString -> (a, ByteString)
    forall a. Storable a => ByteString -> (a, ByteString)
    unsafeBinarySplit ByteString
    bs, (b
    b,ByteString
    bs) <- ByteString -> (b, ByteString)
    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 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < a -> Int
    forall a. Storable a => a -> Int
    sizeOf (a
    forall a. HasCallStack => a
    undefined :: a) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + b -> Int
    forall a. Storable a => a -> Int
    sizeOf (b
    forall a. HasCallStack => a
    undefined :: b) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + c -> Int
    forall a. Storable a => a -> Int
    sizeOf (c
    forall a. HasCallStack => a
    undefined :: c) = [Char] -> (a, b, c, ByteString)
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Reading from ByteString, insufficient left"
                    | (a
    a,ByteString
    bs) <- ByteString -> (a, ByteString)
    forall a. Storable a => ByteString -> (a, ByteString)
    unsafeBinarySplit ByteString
    bs, (b
    b,ByteString
    bs) <- ByteString -> (b, ByteString)
    forall a. Storable a => ByteString -> (a, ByteString)
    unsafeBinarySplit ByteString
    bs, (c
    c,ByteString
    bs) <- ByteString -> (c, ByteString)
    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 (a -> Int
    forall a. Storable a => a -> Int
    sizeOf a
    v) ByteString
    bs)
        where v :: a
    v = IO a -> a
    forall a. IO a -> a
    unsafePerformIO (IO a -> a) -> IO a -> a
    forall a b. (a -> b) -> a -> b
    $ ByteString -> (CString -> IO a) -> IO a
    forall a. ByteString -> (CString -> IO a) -> IO a
    BS.unsafeUseAsCString ByteString
    bs ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \CString
    ptr -> Ptr a -> IO a
    forall a. Storable a => Ptr a -> IO a
    peek (CString -> Ptr a
    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 = (a -> b -> m c) -> [a] -> [b] -> m ()
    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) = IO ByteString -> ByteString
    forall a. IO a -> a
    unsafePerformIO (IO ByteString -> ByteString) -> IO ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ Int -> (Ptr Word8 -> IO ()) -> IO ByteString
    BS.create Int
    i ((Ptr Word8 -> IO ()) -> IO ByteString)
    -> (Ptr Word8 -> IO ()) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    ptr -> Ptr Word8 -> Int -> IO ()
    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
    x1Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    y1) ((forall a. Ptr a -> Int -> IO ()) -> Builder)
    -> (forall a. Ptr a -> Int -> IO ()) -> Builder
    forall a b. (a -> b) -> a -> b
    $ \Ptr a
    p Int
    i -> do Ptr a -> Int -> IO ()
    forall a. Ptr a -> Int -> IO ()
    x2 Ptr a
    p Int
    i; Ptr a -> Int -> IO ()
    forall a. Ptr a -> Int -> IO ()
    y2 Ptr a
    p (Int -> IO ()) -> Int -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int
    iInt -> Int -> Int
    forall 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. Ptr a -> Int -> IO ()) -> Builder)
    -> (forall a. Ptr a -> Int -> IO ()) -> Builder
    forall a b. (a -> b) -> a -> b
    $ \Ptr a
    _ Int
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
        mappend :: Builder -> Builder -> Builder
    mappend = Builder -> Builder -> Builder
    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. Ptr a -> Int -> IO ()) -> Builder)
    -> (forall a. Ptr a -> Int -> IO ()) -> Builder
    forall a b. (a -> b) -> a -> b
    $ \Ptr a
    ptr Int
    i -> ByteString -> (CString -> IO ()) -> IO ()
    forall a. ByteString -> (CString -> IO a) -> IO a
    BS.useAsCString ByteString
    x ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \CString
    bs -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
    BS.memcpy (Ptr a
    ptr Ptr a -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    i) (CString -> Ptr Word8
    forall a b. Ptr a -> Ptr b
    castPtr CString
    bs) (Int -> Int
    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 = ByteString -> ByteString
    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 (Int64 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int64 -> Int) -> Int64 -> Int
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Int64
    LBS.length ByteString
    x) ((forall a. Ptr a -> Int -> IO ()) -> Builder)
    -> (forall a. Ptr a -> Int -> IO ()) -> Builder
    forall a b. (a -> b) -> a -> b
    $ \Ptr a
    ptr Int
    i -> do
            let go :: Int -> [ByteString] -> IO ()
    go Int
    _ [] = () -> IO ()
    forall a. a -> IO a
    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
                    ByteString -> (CString -> IO ()) -> IO ()
    forall a. ByteString -> (CString -> IO a) -> IO a
    BS.useAsCString ByteString
    x ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \CString
    bs -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()
    BS.memcpy (Ptr a
    ptr Ptr a -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    i) (CString -> Ptr Word8
    forall a b. Ptr a -> Ptr b
    castPtr CString
    bs) (Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    n)
                    Int -> [ByteString] -> IO ()
    go (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    n) [ByteString]
    xs
            Int -> [ByteString] -> IO ()
    go Int
    i ([ByteString] -> IO ()) -> [ByteString] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> [ByteString]
    LBS.toChunks ByteString
    x
        getEx :: ByteString -> ByteString
    getEx = [ByteString] -> ByteString
    LBS.fromChunks ([ByteString] -> ByteString)
    -> (ByteString -> [ByteString]) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> [ByteString]
    forall a. a -> [a]
    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 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    4) Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + [Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum [Int]
    ns) ((forall a. Ptr a -> Int -> IO ()) -> Builder)
    -> (forall a. Ptr a -> Int -> IO ()) -> Builder
    forall a b. (a -> b) -> a -> b
    $ \Ptr a
    p Int
    i -> do
            Ptr a -> Int -> Word32 -> IO ()
    forall b. Ptr b -> Int -> Word32 -> IO ()
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
    pokeByteOff Ptr a
    p Int
    i (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    n :: Word32)
            [Int] -> [Int] -> (Int -> Int -> IO ()) -> IO ()
    forall {m :: * -> *} {a} {b} {c}.
    Applicative m =>
    [a] -> [b] -> (a -> b -> m c) -> m ()
    for2M_ [Int
    4Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    i,Int
    8Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    i..] [Int]
    ns ((Int -> Int -> IO ()) -> IO ()) -> (Int -> Int -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    i Int
    x -> Ptr a -> Int -> Word32 -> IO ()
    forall b. Ptr b -> Int -> Word32 -> IO ()
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
    pokeByteOff Ptr a
    p Int
    i (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    x :: Word32)
            Ptr Any
    p<- Ptr Any -> IO (Ptr Any)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Ptr Any -> IO (Ptr Any)) -> Ptr Any -> IO (Ptr Any)
    forall a b. (a -> b) -> a -> b
    $ Ptr a
    p Ptr a -> Int -> Ptr Any
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` (Int
    i Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    4 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    4))
            [Int] -> [ByteString] -> (Int -> ByteString -> IO ()) -> IO ()
    forall {m :: * -> *} {a} {b} {c}.
    Applicative m =>
    [a] -> [b] -> (a -> b -> m c) -> m ()
    for2M_ ((Int -> Int -> Int) -> Int -> [Int] -> [Int]
    forall b a. (b -> a -> b) -> b -> [a] -> [b]
    scanl Int -> Int -> Int
    forall a. Num a => a -> a -> a
    (+) Int
    0 [Int]
    ns) [ByteString]
    xs ((Int -> ByteString -> IO ()) -> IO ())
    -> (Int -> ByteString -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    i ByteString
    x -> ByteString -> (CStringLen -> IO ()) -> IO ()
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
    BS.useAsCStringLen ByteString
    x ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(CString
    bs, Int
    n) ->
                Ptr Word8 -> Ptr Word8 -> Int -> IO ()
    BS.memcpy (Ptr Any
    p Ptr Any -> Int -> Ptr Word8
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    i) (CString -> Ptr Word8
    forall a b. Ptr a -> Ptr b
    castPtr CString
    bs) (Int -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    n)
            where ns :: [Int]
    ns = (ByteString -> Int) -> [ByteString] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map ByteString -> Int
    BS.length [ByteString]
    xs
                  n :: Int
    n = [Int] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Int]
    ns

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

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

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

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

    instance BinaryEx (String, [String]) where
        putEx :: ([Char], [[Char]]) -> Builder
    putEx ([Char]
    a,[[Char]]
    bs) = [[Char]] -> Builder
    forall a. BinaryEx a => a -> Builder
    putEx ([[Char]] -> Builder) -> [[Char]] -> Builder
    forall a b. (a -> b) -> a -> b
    $ [Char]
    a[Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    :[[Char]]
    bs
        getEx :: ByteString -> ([Char], [[Char]])
    getEx ByteString
    x = let [Char]
    a:[[Char]]
    bs = ByteString -> [[Char]]
    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. Ptr a -> Int -> IO ()) -> Builder)
    -> (forall a. Ptr a -> Int -> IO ()) -> Builder
    forall a b. (a -> b) -> a -> b
    $ \Ptr a
    ptr Int
    i -> Ptr a -> Int -> Word8 -> IO ()
    forall b. Ptr b -> Int -> Word8 -> IO ()
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
    pokeByteOff Ptr a
    ptr Int
    i (Word8
    0 :: Word8)
        putEx Bool
    True = Builder
    forall a. Monoid a => a
    mempty
        getEx :: ByteString -> Bool
    getEx = ByteString -> Bool
    BS.null

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

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

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

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

    instance BinaryEx Float where
        putEx :: Float -> Builder
    putEx = Float -> Builder
    forall a. Storable a => a -> Builder
    putExStorable
        getEx :: ByteString -> Float
    getEx = ByteString -> Float
    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 (a -> Int
    forall a. Storable a => a -> Int
    sizeOf a
    x) ((forall a. Ptr a -> Int -> IO ()) -> Builder)
    -> (forall a. Ptr a -> Int -> IO ()) -> Builder
    forall a b. (a -> b) -> a -> b
    $ \Ptr a
    p Int
    i -> Ptr a -> Int -> a -> IO ()
    forall b. Ptr b -> Int -> a -> IO ()
    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 -> IO a -> a
    forall a. IO a -> a
    unsafePerformIO (IO a -> a) -> IO a -> a
    forall a b. (a -> b) -> a -> b
    $ ByteString -> (CStringLen -> IO a) -> IO a
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
    BS.useAsCStringLen ByteString
    bs ((CStringLen -> IO a) -> IO a) -> (CStringLen -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \(CString
    p, Int
    size) ->
            if Int
    size Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    n then [Char] -> IO a
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "size mismatch" else Ptr a -> IO a
    forall a. Storable a => Ptr a -> IO a
    peek (CString -> Ptr a
    forall a b. Ptr a -> Ptr b
    castPtr CString
    p)
        where n :: Int
    n = a -> Int
    forall a. Storable a => a -> Int
    sizeOf (a
    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 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * [a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    xs) ((forall a. Ptr a -> Int -> IO ()) -> Builder)
    -> (forall a. Ptr a -> Int -> IO ()) -> Builder
    forall a b. (a -> b) -> a -> b
    $ \Ptr a
    ptr Int
    i ->
        [Int] -> [a] -> (Int -> a -> IO ()) -> IO ()
    forall {m :: * -> *} {a} {b} {c}.
    Applicative m =>
    [a] -> [b] -> (a -> b -> m c) -> m ()
    for2M_ [Int
    i,Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    n..] [a]
    xs ((Int -> a -> IO ()) -> IO ()) -> (Int -> a -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Int
    i a
    x -> Ptr a -> Int -> a -> IO ()
    forall b. Ptr b -> Int -> a -> IO ()
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
    pokeByteOff Ptr a
    ptr Int
    i a
    x
        where n :: Int
    n = a -> Int
    forall a. Storable a => a -> Int
    sizeOf (a
    forall a. HasCallStack => a
    undefined :: a)

    getExStorableList :: forall a . Storable a => BS.ByteString -> [a]
    getExStorableList :: forall a. Storable a => ByteString -> [a]
    getExStorableList = \ByteString
    bs -> IO [a] -> [a]
    forall a. IO a -> a
    unsafePerformIO (IO [a] -> [a]) -> IO [a] -> [a]
    forall a b. (a -> b) -> a -> b
    $ ByteString -> (CStringLen -> IO [a]) -> IO [a]
    forall a. ByteString -> (CStringLen -> IO a) -> IO a
    BS.useAsCStringLen ByteString
    bs ((CStringLen -> IO [a]) -> IO [a])
    -> (CStringLen -> IO [a]) -> IO [a]
    forall a b. (a -> b) -> a -> b
    $ \(CString
    p, Int
    size) ->
        let (Int
    d,Int
    m) = Int
    size Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    `divMod` Int
    n in
        if Int
    m Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    0 then [Char] -> IO [a]
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "size mismatch" else [Int] -> (Int -> IO a) -> IO [a]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [Int
    0..Int
    dInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1] ((Int -> IO a) -> IO [a]) -> (Int -> IO a) -> IO [a]
    forall a b. (a -> b) -> a -> b
    $ \Int
    i -> Ptr a -> Int -> IO a
    forall a. Storable a => Ptr a -> Int -> IO a
    peekElemOff (CString -> Ptr a
    forall a b. Ptr a -> Ptr b
    castPtr CString
    p) Int
    i
        where n :: Int
    n = a -> Int
    forall a. Storable a => a -> Int
    sizeOf (a
    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 ([Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ (Builder -> Int) -> [Builder] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Builder
    b -> Builder -> Int
    sizeBuilder Builder
    b Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    4) [Builder]
    xs) ((forall a. Ptr a -> Int -> IO ()) -> Builder)
    -> (forall a. Ptr a -> Int -> IO ()) -> Builder
    forall a b. (a -> b) -> a -> b
    $ \Ptr a
    p Int
    i -> do
        let go :: Int -> [Builder] -> IO ()
    go Int
    _ [] = () -> IO ()
    forall a. a -> IO a
    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
                Ptr a -> Int -> Word32 -> IO ()
    forall b. Ptr b -> Int -> Word32 -> IO ()
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
    pokeByteOff Ptr a
    p Int
    i (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    n :: Word32)
                Ptr a -> Int -> IO ()
    forall a. Ptr a -> Int -> IO ()
    b Ptr a
    p (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    4)
                Int -> [Builder] -> IO ()
    go (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    4Int -> Int -> Int
    forall 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 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 = []
        | Int
    len Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    4
        , (Word32
    n :: Word32, ByteString
    bs) <- ByteString -> (Word32, ByteString)
    forall a. Storable a => ByteString -> (a, ByteString)
    unsafeBinarySplit ByteString
    bs
        , Int
    n <- Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    n
        , (Int
    len Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    4) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    n
        = Int -> ByteString -> ByteString
    BS.unsafeTake Int
    n ByteString
    bs ByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    : ByteString -> [ByteString]
    getExList (Int -> ByteString -> ByteString
    BS.unsafeDrop Int
    n ByteString
    bs)
        | Bool
    otherwise = [Char] -> [ByteString]
    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
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    4) ((forall a. Ptr a -> Int -> IO ()) -> Builder)
    -> (forall a. Ptr a -> Int -> IO ()) -> Builder
    forall a b. (a -> b) -> a -> b
    $ \Ptr a
    p Int
    i -> do
        Ptr a -> Int -> Word32 -> IO ()
    forall b. Ptr b -> Int -> Word32 -> IO ()
    forall a b. Storable a => Ptr b -> Int -> a -> IO ()
    pokeByteOff Ptr a
    p Int
    i (Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    n :: Word32)
        Ptr a -> Int -> IO ()
    forall a. Ptr a -> Int -> IO ()
    old Ptr a
    p (Int -> IO ()) -> Int -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    4

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