{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

module Database.Bolt.Value.Instances where

import           Database.Bolt.Value.Helpers
import           Database.Bolt.Value.Type

import           Control.Applicative          (pure)
import           Control.Monad                (forM, replicateM)
import           Control.Monad.State          (gets, modify)
import           Control.Monad.Except         (MonadError (..))
import           Data.Binary                  (Binary (..), decode, encode)
import           Data.Binary.IEEE754          (doubleToWord, wordToDouble)
import           Data.ByteString              (ByteString, append, cons,
                                               singleton)
import qualified Data.ByteString              as B
import           Data.ByteString.Lazy         (fromStrict, toStrict)
import           Data.Int
import           Data.Map.Strict              (Map)
import qualified Data.Map.Strict              as M
import           Data.Text                    (Text)
import           Data.Text.Encoding           (decodeUtf8, encodeUtf8)
import           Data.Word

instance BoltValue () where
  pack :: () -> ByteString
pack () = Word8 -> ByteString
singleton Word8
nullCode

  unpackT :: UnpackT m ()
unpackT = UnpackT m Word8
forall (m :: * -> *). Monad m => UnpackT m Word8
unpackW8 UnpackT m Word8 -> (Word8 -> UnpackT m ()) -> UnpackT m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> UnpackT m ()
forall (f :: * -> *). MonadError UnpackError f => Word8 -> f ()
unpackByMarker
    where unpackByMarker :: Word8 -> f ()
unpackByMarker Word8
m | Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
nullCode = () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
                           | Bool
otherwise     = UnpackError -> f ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError UnpackError
NotNull

instance BoltValue Bool where
  pack :: Bool -> ByteString
pack Bool
True  = Word8 -> ByteString
singleton Word8
trueCode
  pack Bool
False = Word8 -> ByteString
singleton Word8
falseCode

  unpackT :: UnpackT m Bool
unpackT = UnpackT m Word8
forall (m :: * -> *). Monad m => UnpackT m Word8
unpackW8 UnpackT m Word8 -> (Word8 -> UnpackT m Bool) -> UnpackT m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> UnpackT m Bool
forall (f :: * -> *). MonadError UnpackError f => Word8 -> f Bool
unpackByMarker
    where unpackByMarker :: Word8 -> f Bool
unpackByMarker Word8
m | Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
trueCode  = Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
                           | Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
falseCode = Bool -> f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
                           | Bool
otherwise      = UnpackError -> f Bool
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError UnpackError
NotBool

instance BoltValue Int where
  pack :: Int -> ByteString
pack Int
int | Int -> Bool
forall a. Integral a => a -> Bool
isTinyInt Int
int = Word8 -> ByteString
forall a. Binary a => a -> ByteString
encodeStrict (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
int :: Word8)
           | Int -> Int -> Bool
forall x. Integral x => x -> x -> Bool
isIntX  Int
8 Int
int = Word8 -> ByteString -> ByteString
cons  Word8
int8Code (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString
forall a. Binary a => a -> ByteString
encodeStrict (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
int :: Word8)
           | Int -> Int -> Bool
forall x. Integral x => x -> x -> Bool
isIntX Int
16 Int
int = Word8 -> ByteString -> ByteString
cons Word8
int16Code (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Word16 -> ByteString
forall a. Binary a => a -> ByteString
encodeStrict (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
int :: Word16)
           | Int -> Int -> Bool
forall x. Integral x => x -> x -> Bool
isIntX Int
32 Int
int = Word8 -> ByteString -> ByteString
cons Word8
int32Code (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Word32 -> ByteString
forall a. Binary a => a -> ByteString
encodeStrict (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
int :: Word32)
           | Int -> Int -> Bool
forall x. Integral x => x -> x -> Bool
isIntX Int
62 Int
int = Word8 -> ByteString -> ByteString
cons Word8
int64Code (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Word64 -> ByteString
forall a. Binary a => a -> ByteString
encodeStrict (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
int :: Word64)
           | Bool
otherwise     = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot pack so large integer"

  unpackT :: UnpackT m Int
unpackT = UnpackT m Word8
forall (m :: * -> *). Monad m => UnpackT m Word8
unpackW8 UnpackT m Word8 -> (Word8 -> UnpackT m Int) -> UnpackT m Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> UnpackT m Int
forall (m :: * -> *). Monad m => Word8 -> UnpackT m Int
unpackByMarker
    where unpackByMarker :: Word8 -> UnpackT m Int
unpackByMarker Word8
m | Word8 -> Bool
isTinyWord Word8
m   = Int -> UnpackT m Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> UnpackT m Int) -> (Int8 -> Int) -> Int8 -> UnpackT m Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Int
forall a. Integral a => a -> Int
toInt (Int8 -> UnpackT m Int) -> Int8 -> UnpackT m Int
forall a b. (a -> b) -> a -> b
$ (Word8 -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
m :: Int8)
                           | Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
int8Code  = Int8 -> Int
forall a. Integral a => a -> Int
toInt (Int8 -> Int) -> UnpackT m Int8 -> UnpackT m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnpackT m Int8
forall (m :: * -> *). Monad m => UnpackT m Int8
unpackI8
                           | Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
int16Code = Int16 -> Int
forall a. Integral a => a -> Int
toInt (Int16 -> Int) -> UnpackT m Int16 -> UnpackT m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnpackT m Int16
forall (m :: * -> *). Monad m => UnpackT m Int16
unpackI16
                           | Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
int32Code = Int32 -> Int
forall a. Integral a => a -> Int
toInt (Int32 -> Int) -> UnpackT m Int32 -> UnpackT m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnpackT m Int32
forall (m :: * -> *). Monad m => UnpackT m Int32
unpackI32
                           | Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
int64Code = Int64 -> Int
forall a. Integral a => a -> Int
toInt (Int64 -> Int) -> UnpackT m Int64 -> UnpackT m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnpackT m Int64
forall (m :: * -> *). Monad m => UnpackT m Int64
unpackI64
                           | Bool
otherwise      = UnpackError -> UnpackT m Int
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError UnpackError
NotInt

instance BoltValue Double where
  pack :: Double -> ByteString
pack Double
dbl = Word8 -> ByteString -> ByteString
cons Word8
doubleCode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Word64 -> ByteString
forall a. Binary a => a -> ByteString
encodeStrict (Double -> Word64
doubleToWord Double
dbl)

  unpackT :: UnpackT m Double
unpackT = UnpackT m Word8
forall (m :: * -> *). Monad m => UnpackT m Word8
unpackW8 UnpackT m Word8 -> (Word8 -> UnpackT m Double) -> UnpackT m Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> UnpackT m Double
forall (m :: * -> *). Monad m => Word8 -> UnpackT m Double
unpackByMarker
    where unpackByMarker :: Word8 -> UnpackT m Double
unpackByMarker Word8
m | Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
doubleCode = Word64 -> Double
wordToDouble (Word64 -> Double) -> UnpackT m Word64 -> UnpackT m Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnpackT m Word64
forall (m :: * -> *). Monad m => UnpackT m Word64
unpackW64
                           | Bool
otherwise       = UnpackError -> UnpackT m Double
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError UnpackError
NotFloat

instance BoltValue Text where
  pack :: Text -> ByteString
pack Text
txt = Int -> ByteString -> (Word8, Word8, Word8, Word8) -> ByteString
mkPackedCollection (ByteString -> Int
B.length ByteString
pbs) ByteString
pbs (Word8
textConst, Word8
text8Code, Word8
text16Code, Word8
text32Code)
    where pbs :: ByteString
pbs = Text -> ByteString
encodeUtf8 Text
txt

  unpackT :: UnpackT m Text
unpackT = UnpackT m Word8
forall (m :: * -> *). Monad m => UnpackT m Word8
unpackW8 UnpackT m Word8 -> (Word8 -> UnpackT m Text) -> UnpackT m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> UnpackT m Text
forall (m :: * -> *). Monad m => Word8 -> UnpackT m Text
unpackByMarker
    where unpackByMarker :: Word8 -> UnpackT m Text
unpackByMarker Word8
m | Word8 -> Bool
isTinyText Word8
m    = Int -> UnpackT m Text
forall (m :: * -> *). MonadState ByteString m => Int -> m Text
unpackTextBySize (Word8 -> Int
getSize Word8
m)
                           | Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
text8Code  = Word8 -> Int
forall a. Integral a => a -> Int
toInt (Word8 -> Int) -> UnpackT m Word8 -> UnpackT m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnpackT m Word8
forall (m :: * -> *). Monad m => UnpackT m Word8
unpackW8 UnpackT m Int -> (Int -> UnpackT m Text) -> UnpackT m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> UnpackT m Text
forall (m :: * -> *). MonadState ByteString m => Int -> m Text
unpackTextBySize
                           | Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
text16Code = Word16 -> Int
forall a. Integral a => a -> Int
toInt (Word16 -> Int) -> UnpackT m Word16 -> UnpackT m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnpackT m Word16
forall (m :: * -> *). Monad m => UnpackT m Word16
unpackW16 UnpackT m Int -> (Int -> UnpackT m Text) -> UnpackT m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> UnpackT m Text
forall (m :: * -> *). MonadState ByteString m => Int -> m Text
unpackTextBySize
                           | Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
text32Code = Word32 -> Int
forall a. Integral a => a -> Int
toInt (Word32 -> Int) -> UnpackT m Word32 -> UnpackT m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnpackT m Word32
forall (m :: * -> *). Monad m => UnpackT m Word32
unpackW32 UnpackT m Int -> (Int -> UnpackT m Text) -> UnpackT m Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> UnpackT m Text
forall (m :: * -> *). MonadState ByteString m => Int -> m Text
unpackTextBySize
                           | Bool
otherwise       = UnpackError -> UnpackT m Text
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError UnpackError
NotString
          unpackTextBySize :: Int -> m Text
unpackTextBySize Int
size = do ByteString
str <- (ByteString -> ByteString) -> m ByteString
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Int -> ByteString -> ByteString
B.take Int
size)
                                     (ByteString -> ByteString) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Int -> ByteString -> ByteString
B.drop Int
size)
                                     Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
str

instance BoltValue a => BoltValue [a] where
  pack :: [a] -> ByteString
pack [a]
lst = Int -> ByteString -> (Word8, Word8, Word8, Word8) -> ByteString
mkPackedCollection ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
lst) ByteString
pbs (Word8
listConst, Word8
list8Code, Word8
list16Code, Word8
list32Code)
    where pbs :: ByteString
pbs = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (a -> ByteString) -> [a] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map a -> ByteString
forall a. BoltValue a => a -> ByteString
pack [a]
lst

  unpackT :: UnpackT m [a]
unpackT = UnpackT m Word8
forall (m :: * -> *). Monad m => UnpackT m Word8
unpackW8 UnpackT m Word8 -> (Word8 -> UnpackT m [a]) -> UnpackT m [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> UnpackT m [a]
forall (m :: * -> *) b.
(Monad m, BoltValue b) =>
Word8 -> UnpackT m [b]
unpackByMarker
    where unpackByMarker :: Word8 -> UnpackT m [b]
unpackByMarker Word8
m | Word8 -> Bool
isTinyList Word8
m    = Int -> UnpackT m [b]
forall (m :: * -> *) b b.
(Monad m, Num b, Enum b, BoltValue b) =>
b -> UnpackT m [b]
unpackListBySize (Word8 -> Int
getSize Word8
m)
                           | Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
list8Code  = Word8 -> Int
forall a. Integral a => a -> Int
toInt (Word8 -> Int) -> UnpackT m Word8 -> UnpackT m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnpackT m Word8
forall (m :: * -> *). Monad m => UnpackT m Word8
unpackW8 UnpackT m Int -> (Int -> UnpackT m [b]) -> UnpackT m [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> UnpackT m [b]
forall (m :: * -> *) b b.
(Monad m, Num b, Enum b, BoltValue b) =>
b -> UnpackT m [b]
unpackListBySize
                           | Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
list16Code = Word16 -> Int
forall a. Integral a => a -> Int
toInt (Word16 -> Int) -> UnpackT m Word16 -> UnpackT m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnpackT m Word16
forall (m :: * -> *). Monad m => UnpackT m Word16
unpackW16 UnpackT m Int -> (Int -> UnpackT m [b]) -> UnpackT m [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> UnpackT m [b]
forall (m :: * -> *) b b.
(Monad m, Num b, Enum b, BoltValue b) =>
b -> UnpackT m [b]
unpackListBySize
                           | Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
list32Code = Word32 -> Int
forall a. Integral a => a -> Int
toInt (Word32 -> Int) -> UnpackT m Word32 -> UnpackT m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnpackT m Word32
forall (m :: * -> *). Monad m => UnpackT m Word32
unpackW32 UnpackT m Int -> (Int -> UnpackT m [b]) -> UnpackT m [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> UnpackT m [b]
forall (m :: * -> *) b b.
(Monad m, Num b, Enum b, BoltValue b) =>
b -> UnpackT m [b]
unpackListBySize
                           | Bool
otherwise       = UnpackError -> UnpackT m [b]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError UnpackError
NotList
          unpackListBySize :: b -> UnpackT m [b]
unpackListBySize b
size = [b] -> (b -> UnpackT m b) -> UnpackT m [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [b
1..b
size] ((b -> UnpackT m b) -> UnpackT m [b])
-> (b -> UnpackT m b) -> UnpackT m [b]
forall a b. (a -> b) -> a -> b
$ UnpackT m b -> b -> UnpackT m b
forall a b. a -> b -> a
const UnpackT m b
forall a (m :: * -> *). (BoltValue a, Monad m) => UnpackT m a
unpackT

instance BoltValue a => BoltValue (Map Text a) where
  pack :: Map Text a -> ByteString
pack Map Text a
dict = Int -> ByteString -> (Word8, Word8, Word8, Word8) -> ByteString
mkPackedCollection (Map Text a -> Int
forall k a. Map k a -> Int
M.size Map Text a
dict) ByteString
pbs (Word8
dictConst, Word8
dict8Code, Word8
dict16Code, Word8
dict32Code)
    where pbs :: ByteString
pbs = [ByteString] -> ByteString
B.concat ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ((Text, a) -> ByteString) -> [(Text, a)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (Text, a) -> ByteString
forall a a. (BoltValue a, BoltValue a) => (a, a) -> ByteString
mkPairPack ([(Text, a)] -> [ByteString]) -> [(Text, a)] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Map Text a -> [(Text, a)]
forall k a. Map k a -> [(k, a)]
M.assocs Map Text a
dict
          mkPairPack :: (a, a) -> ByteString
mkPairPack (a
key, a
val) = a -> ByteString
forall a. BoltValue a => a -> ByteString
pack a
key ByteString -> ByteString -> ByteString
`append` a -> ByteString
forall a. BoltValue a => a -> ByteString
pack a
val

  unpackT :: UnpackT m (Map Text a)
unpackT = UnpackT m Word8
forall (m :: * -> *). Monad m => UnpackT m Word8
unpackW8 UnpackT m Word8
-> (Word8 -> UnpackT m (Map Text a)) -> UnpackT m (Map Text a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> UnpackT m (Map Text a)
unpackByMarker
    where unpackByMarker :: Word8 -> UnpackT m (Map Text a)
unpackByMarker Word8
m | Word8 -> Bool
isTinyDict Word8
m    = Int -> UnpackT m (Map Text a)
unpackDictBySize (Word8 -> Int
getSize Word8
m)
                           | Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
dict8Code  = Word8 -> Int
forall a. Integral a => a -> Int
toInt (Word8 -> Int) -> UnpackT m Word8 -> UnpackT m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnpackT m Word8
forall (m :: * -> *). Monad m => UnpackT m Word8
unpackW8 UnpackT m Int
-> (Int -> UnpackT m (Map Text a)) -> UnpackT m (Map Text a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> UnpackT m (Map Text a)
unpackDictBySize
                           | Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
dict16Code = Word16 -> Int
forall a. Integral a => a -> Int
toInt (Word16 -> Int) -> UnpackT m Word16 -> UnpackT m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnpackT m Word16
forall (m :: * -> *). Monad m => UnpackT m Word16
unpackW16 UnpackT m Int
-> (Int -> UnpackT m (Map Text a)) -> UnpackT m (Map Text a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> UnpackT m (Map Text a)
unpackDictBySize
                           | Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
dict32Code = Word32 -> Int
forall a. Integral a => a -> Int
toInt (Word32 -> Int) -> UnpackT m Word32 -> UnpackT m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnpackT m Word32
forall (m :: * -> *). Monad m => UnpackT m Word32
unpackW32 UnpackT m Int
-> (Int -> UnpackT m (Map Text a)) -> UnpackT m (Map Text a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> UnpackT m (Map Text a)
unpackDictBySize
                           | Bool
otherwise       = UnpackError -> UnpackT m (Map Text a)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError UnpackError
NotDict 
          unpackDictBySize :: Int -> UnpackT m (Map Text a)
unpackDictBySize = ([(Text, a)] -> Map Text a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Text, a)] -> Map Text a)
-> UnpackT m [(Text, a)] -> UnpackT m (Map Text a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (UnpackT m [(Text, a)] -> UnpackT m (Map Text a))
-> (Int -> UnpackT m [(Text, a)]) -> Int -> UnpackT m (Map Text a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> UnpackT m [(Text, a)]
forall (m :: * -> *) b a b.
(Monad m, Num b, Enum b, BoltValue a, BoltValue b) =>
b -> UnpackT m [(a, b)]
unpackPairsBySize
          unpackPairsBySize :: b -> UnpackT m [(a, b)]
unpackPairsBySize b
size = [b] -> (b -> UnpackT m (a, b)) -> UnpackT m [(a, b)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [b
1..b
size] ((b -> UnpackT m (a, b)) -> UnpackT m [(a, b)])
-> (b -> UnpackT m (a, b)) -> UnpackT m [(a, b)]
forall a b. (a -> b) -> a -> b
$ UnpackT m (a, b) -> b -> UnpackT m (a, b)
forall a b. a -> b -> a
const (UnpackT m (a, b) -> b -> UnpackT m (a, b))
-> UnpackT m (a, b) -> b -> UnpackT m (a, b)
forall a b. (a -> b) -> a -> b
$ do
                                     a
key <- UnpackT m a
forall a (m :: * -> *). (BoltValue a, Monad m) => UnpackT m a
unpackT
                                     b
value <- UnpackT m b
forall a (m :: * -> *). (BoltValue a, Monad m) => UnpackT m a
unpackT
                                     (a, b) -> UnpackT m (a, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
key, b
value)

instance BoltValue Structure where
  pack :: Structure -> ByteString
pack (Structure Word8
sig [Value]
lst) | Word16
size Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
< Word16
forall a. Integral a => a
size4  = (Word8
structConst Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
size) Word8 -> ByteString -> ByteString
`cons` ByteString
pData
                           | Word16
size Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
< Word16
forall a. Integral a => a
size8  = Word8
struct8Code Word8 -> ByteString -> ByteString
`cons` Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
size Word8 -> ByteString -> ByteString
`cons` ByteString
pData
                           | Word16
size Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
< Word16
forall a. Integral a => a
size16 = Word8
struct16Code Word8 -> ByteString -> ByteString
`cons` Word16 -> ByteString
forall a. Binary a => a -> ByteString
encodeStrict Word16
size ByteString -> ByteString -> ByteString
`append` ByteString
pData
                           | Bool
otherwise     = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot pack so large structure"
    where size :: Word16
size = Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ [Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
lst :: Word16
          pData :: ByteString
pData = Word8
sig Word8 -> ByteString -> ByteString
`cons` [ByteString] -> ByteString
B.concat ((Value -> ByteString) -> [Value] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Value -> ByteString
forall a. BoltValue a => a -> ByteString
pack [Value]
lst)

  unpackT :: UnpackT m Structure
unpackT = UnpackT m Word8
forall (m :: * -> *). Monad m => UnpackT m Word8
unpackW8 UnpackT m Word8
-> (Word8 -> UnpackT m Structure) -> UnpackT m Structure
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> UnpackT m Structure
forall (m :: * -> *). Monad m => Word8 -> UnpackT m Structure
unpackByMarker
    where unpackByMarker :: Word8 -> UnpackT m Structure
unpackByMarker Word8
m | Word8 -> Bool
isTinyStruct Word8
m    = Int -> UnpackT m Structure
forall (m :: * -> *). Monad m => Int -> UnpackT m Structure
unpackStructureBySize (Word8 -> Int
getSize Word8
m)
                           | Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
struct8Code  = Word8 -> Int
forall a. Integral a => a -> Int
toInt (Word8 -> Int) -> UnpackT m Word8 -> UnpackT m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnpackT m Word8
forall (m :: * -> *). Monad m => UnpackT m Word8
unpackW8 UnpackT m Int
-> (Int -> UnpackT m Structure) -> UnpackT m Structure
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> UnpackT m Structure
forall (m :: * -> *). Monad m => Int -> UnpackT m Structure
unpackStructureBySize
                           | Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
struct16Code = Word16 -> Int
forall a. Integral a => a -> Int
toInt (Word16 -> Int) -> UnpackT m Word16 -> UnpackT m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnpackT m Word16
forall (m :: * -> *). Monad m => UnpackT m Word16
unpackW16 UnpackT m Int
-> (Int -> UnpackT m Structure) -> UnpackT m Structure
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> UnpackT m Structure
forall (m :: * -> *). Monad m => Int -> UnpackT m Structure
unpackStructureBySize
                           | Bool
otherwise         = UnpackError -> UnpackT m Structure
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError UnpackError
NotStructure
          unpackStructureBySize :: Int -> UnpackT m Structure
unpackStructureBySize Int
size = Word8 -> [Value] -> Structure
Structure (Word8 -> [Value] -> Structure)
-> UnpackT m Word8 -> UnpackT m ([Value] -> Structure)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnpackT m Word8
forall (m :: * -> *). Monad m => UnpackT m Word8
unpackW8 UnpackT m ([Value] -> Structure)
-> UnpackT m [Value] -> UnpackT m Structure
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> UnpackT m Value -> UnpackT m [Value]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
size UnpackT m Value
forall a (m :: * -> *). (BoltValue a, Monad m) => UnpackT m a
unpackT

instance BoltValue Value where
  pack :: Value -> ByteString
pack (N ()
n) = () -> ByteString
forall a. BoltValue a => a -> ByteString
pack ()
n
  pack (B Bool
b) = Bool -> ByteString
forall a. BoltValue a => a -> ByteString
pack Bool
b
  pack (I Int
i) = Int -> ByteString
forall a. BoltValue a => a -> ByteString
pack Int
i
  pack (F Double
d) = Double -> ByteString
forall a. BoltValue a => a -> ByteString
pack Double
d
  pack (T Text
t) = Text -> ByteString
forall a. BoltValue a => a -> ByteString
pack Text
t
  pack (L [Value]
l) = [Value] -> ByteString
forall a. BoltValue a => a -> ByteString
pack [Value]
l
  pack (M Map Text Value
m) = Map Text Value -> ByteString
forall a. BoltValue a => a -> ByteString
pack Map Text Value
m
  pack (S Structure
s) = Structure -> ByteString
forall a. BoltValue a => a -> ByteString
pack Structure
s

  unpackT :: UnpackT m Value
unpackT = UnpackT m Word8
forall (m :: * -> *). Monad m => UnpackT m Word8
observeW8 UnpackT m Word8 -> (Word8 -> UnpackT m Value) -> UnpackT m Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> UnpackT m Value
forall (m :: * -> *). Monad m => Word8 -> UnpackT m Value
unpackByMarker
    where unpackByMarker :: Word8 -> UnpackT m Value
unpackByMarker Word8
m | Word8 -> Bool
isNull   Word8
m = () -> Value
N (() -> Value) -> UnpackT m () -> UnpackT m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnpackT m ()
forall a (m :: * -> *). (BoltValue a, Monad m) => UnpackT m a
unpackT
                           | Word8 -> Bool
isBool   Word8
m = Bool -> Value
B (Bool -> Value) -> UnpackT m Bool -> UnpackT m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnpackT m Bool
forall a (m :: * -> *). (BoltValue a, Monad m) => UnpackT m a
unpackT
                           | Word8 -> Bool
isInt    Word8
m = Int -> Value
I (Int -> Value) -> UnpackT m Int -> UnpackT m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnpackT m Int
forall a (m :: * -> *). (BoltValue a, Monad m) => UnpackT m a
unpackT
                           | Word8 -> Bool
isDouble Word8
m = Double -> Value
F (Double -> Value) -> UnpackT m Double -> UnpackT m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnpackT m Double
forall a (m :: * -> *). (BoltValue a, Monad m) => UnpackT m a
unpackT
                           | Word8 -> Bool
isText   Word8
m = Text -> Value
T (Text -> Value) -> UnpackT m Text -> UnpackT m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnpackT m Text
forall a (m :: * -> *). (BoltValue a, Monad m) => UnpackT m a
unpackT
                           | Word8 -> Bool
isList   Word8
m = [Value] -> Value
L ([Value] -> Value) -> UnpackT m [Value] -> UnpackT m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnpackT m [Value]
forall a (m :: * -> *). (BoltValue a, Monad m) => UnpackT m a
unpackT
                           | Word8 -> Bool
isDict   Word8
m = Map Text Value -> Value
M (Map Text Value -> Value)
-> UnpackT m (Map Text Value) -> UnpackT m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnpackT m (Map Text Value)
forall a (m :: * -> *). (BoltValue a, Monad m) => UnpackT m a
unpackT
                           | Word8 -> Bool
isStruct Word8
m = Structure -> Value
S (Structure -> Value) -> UnpackT m Structure -> UnpackT m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UnpackT m Structure
forall a (m :: * -> *). (BoltValue a, Monad m) => UnpackT m a
unpackT
                           | Bool
otherwise  = UnpackError -> UnpackT m Value
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError UnpackError
NotValue 

-- = Structure instances for Neo4j structures

instance FromStructure Node where
  fromStructure :: Structure -> m Node
fromStructure Structure
struct =
    case Structure
struct of
      (Structure Word8
sig [I Int
nid, L [Value]
vlbls, M Map Text Value
prps]) | Word8
sig Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
sigNode -> ([Text] -> Map Text Value -> Node)
-> Map Text Value -> [Text] -> Node
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> [Text] -> Map Text Value -> Node
Node Int
nid) Map Text Value
prps ([Text] -> Node) -> m [Text] -> m Node
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value] -> m [Text]
forall (f :: * -> *).
MonadError UnpackError f =>
[Value] -> f [Text]
cnvT [Value]
vlbls
      Structure
_                                                         -> UnpackError -> m Node
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnpackError -> m Node) -> UnpackError -> m Node
forall a b. (a -> b) -> a -> b
$ Text -> UnpackError
Not Text
"Node"
    where
      cnvT :: [Value] -> f [Text]
cnvT []       = [Text] -> f [Text]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      cnvT (T Text
x:[Value]
xs) = (Text
xText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:) ([Text] -> [Text]) -> f [Text] -> f [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value] -> f [Text]
cnvT [Value]
xs
      cnvT [Value]
_        = UnpackError -> f [Text]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError UnpackError
NotString 

instance FromStructure Relationship where
  fromStructure :: Structure -> m Relationship
fromStructure Structure
struct =
    case Structure
struct of
      (Structure Word8
sig [I Int
rid, I Int
sni, I Int
eni, T Text
rt, M Map Text Value
rp]) | Word8
sig Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
sigRel -> Relationship -> m Relationship
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Relationship -> m Relationship) -> Relationship -> m Relationship
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Text -> Map Text Value -> Relationship
Relationship Int
rid Int
sni Int
eni Text
rt Map Text Value
rp
      Structure
_                                                                 -> UnpackError -> m Relationship
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnpackError -> m Relationship) -> UnpackError -> m Relationship
forall a b. (a -> b) -> a -> b
$ Text -> UnpackError
Not Text
"Relationship"

instance FromStructure URelationship where
  fromStructure :: Structure -> m URelationship
fromStructure Structure
struct =
    case Structure
struct of
      (Structure Word8
sig [I Int
rid, T Text
rt, M Map Text Value
rp]) | Word8
sig Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
sigURel -> URelationship -> m URelationship
forall (f :: * -> *) a. Applicative f => a -> f a
pure (URelationship -> m URelationship)
-> URelationship -> m URelationship
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Map Text Value -> URelationship
URelationship Int
rid Text
rt Map Text Value
rp
      Structure
_                                                    -> UnpackError -> m URelationship
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnpackError -> m URelationship) -> UnpackError -> m URelationship
forall a b. (a -> b) -> a -> b
$ Text -> UnpackError
Not Text
"URelationship"

instance FromStructure Path where
  fromStructure :: Structure -> m Path
fromStructure Structure
struct = 
    case Structure
struct of
      (Structure Word8
sig [L [Value]
vnp, L [Value]
vrp, L [Value]
vip]) | Word8
sig Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
sigPath -> [Node] -> [URelationship] -> [Int] -> Path
Path ([Node] -> [URelationship] -> [Int] -> Path)
-> m [Node] -> m ([URelationship] -> [Int] -> Path)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value] -> m [Node]
forall (f :: * -> *) a.
(FromStructure a, MonadError UnpackError f) =>
[Value] -> f [a]
cnvN [Value]
vnp m ([URelationship] -> [Int] -> Path)
-> m [URelationship] -> m ([Int] -> Path)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Value] -> m [URelationship]
forall (f :: * -> *) a.
(FromStructure a, MonadError UnpackError f) =>
[Value] -> f [a]
cnvR [Value]
vrp m ([Int] -> Path) -> m [Int] -> m Path
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Value] -> m [Int]
forall (f :: * -> *).
MonadError UnpackError f =>
[Value] -> f [Int]
cnvI [Value]
vip
      Structure
_                                                      -> UnpackError -> m Path
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnpackError -> m Path) -> UnpackError -> m Path
forall a b. (a -> b) -> a -> b
$ Text -> UnpackError
Not Text
"Path"
    where
      cnvN :: [Value] -> f [a]
cnvN []       = [a] -> f [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      cnvN (S Structure
x:[Value]
xs) = (:) (a -> [a] -> [a]) -> f a -> f ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Structure -> f a
forall a (m :: * -> *).
(FromStructure a, MonadError UnpackError m) =>
Structure -> m a
fromStructure Structure
x f ([a] -> [a]) -> f [a] -> f [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Value] -> f [a]
cnvN [Value]
xs
      cnvN [Value]
_        = UnpackError -> f [a]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnpackError -> f [a]) -> UnpackError -> f [a]
forall a b. (a -> b) -> a -> b
$ Text -> UnpackError
Not Text
"Node"
      
      cnvR :: [Value] -> f [a]
cnvR []       = [a] -> f [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      cnvR (S Structure
x:[Value]
xs) = (:) (a -> [a] -> [a]) -> f a -> f ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Structure -> f a
forall a (m :: * -> *).
(FromStructure a, MonadError UnpackError m) =>
Structure -> m a
fromStructure Structure
x f ([a] -> [a]) -> f [a] -> f [a]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Value] -> f [a]
cnvR [Value]
xs
      cnvR [Value]
_        = UnpackError -> f [a]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError UnpackError
NotStructure  
      
      cnvI :: [Value] -> f [Int]
cnvI []       = [Int] -> f [Int]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      cnvI (I Int
x:[Value]
xs) = (Int
xInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) ([Int] -> [Int]) -> f [Int] -> f [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value] -> f [Int]
cnvI [Value]
xs
      cnvI [Value]
_        = UnpackError -> f [Int]
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError UnpackError
NotInt


-- = Integer values unpackers

observeW8 :: Monad m => UnpackT m Word8
observeW8 :: UnpackT m Word8
observeW8 = Int -> UnpackT m Word8
forall (m :: * -> *) a. (Monad m, Binary a) => Int -> UnpackT m a
observeNum Int
1

unpackW8 :: Monad m => UnpackT m Word8
unpackW8 :: UnpackT m Word8
unpackW8 = Int -> UnpackT m Word8
forall (m :: * -> *) a. (Monad m, Binary a) => Int -> UnpackT m a
unpackNum Int
1

unpackW16 :: Monad m => UnpackT m Word16
unpackW16 :: UnpackT m Word16
unpackW16 = Int -> UnpackT m Word16
forall (m :: * -> *) a. (Monad m, Binary a) => Int -> UnpackT m a
unpackNum Int
2

unpackW32 :: Monad m => UnpackT m Word32
unpackW32 :: UnpackT m Word32
unpackW32 = Int -> UnpackT m Word32
forall (m :: * -> *) a. (Monad m, Binary a) => Int -> UnpackT m a
unpackNum Int
4

unpackW64 :: Monad m => UnpackT m Word64
unpackW64 :: UnpackT m Word64
unpackW64 = Int -> UnpackT m Word64
forall (m :: * -> *) a. (Monad m, Binary a) => Int -> UnpackT m a
unpackNum Int
8

unpackI8 :: Monad m => UnpackT m Int8
unpackI8 :: UnpackT m Int8
unpackI8 = Int -> UnpackT m Int8
forall (m :: * -> *) a. (Monad m, Binary a) => Int -> UnpackT m a
unpackNum Int
1

unpackI16 :: Monad m => UnpackT m Int16
unpackI16 :: UnpackT m Int16
unpackI16 = Int -> UnpackT m Int16
forall (m :: * -> *) a. (Monad m, Binary a) => Int -> UnpackT m a
unpackNum Int
2

unpackI32 :: Monad m => UnpackT m Int32
unpackI32 :: UnpackT m Int32
unpackI32 = Int -> UnpackT m Int32
forall (m :: * -> *) a. (Monad m, Binary a) => Int -> UnpackT m a
unpackNum Int
4

unpackI64 :: Monad m => UnpackT m Int64
unpackI64 :: UnpackT m Int64
unpackI64 = Int -> UnpackT m Int64
forall (m :: * -> *) a. (Monad m, Binary a) => Int -> UnpackT m a
unpackNum Int
8

-- = Other helpers

-- |Unpacks n bytes as a numeric type
observeNum :: (Monad m, Binary a) => Int -> UnpackT m a
observeNum :: Int -> UnpackT m a
observeNum = (ByteString -> a
forall a. Binary a => ByteString -> a
decodeStrict (ByteString -> a) -> UnpackT m ByteString -> UnpackT m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (UnpackT m ByteString -> UnpackT m a)
-> (Int -> UnpackT m ByteString) -> Int -> UnpackT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> UnpackT m ByteString
forall (m :: * -> *). Monad m => Int -> UnpackT m ByteString
topBS

unpackNum :: (Monad m, Binary a) => Int -> UnpackT m a
unpackNum :: Int -> UnpackT m a
unpackNum = (ByteString -> a
forall a. Binary a => ByteString -> a
decodeStrict (ByteString -> a) -> UnpackT m ByteString -> UnpackT m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (UnpackT m ByteString -> UnpackT m a)
-> (Int -> UnpackT m ByteString) -> Int -> UnpackT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> UnpackT m ByteString
forall (m :: * -> *). Monad m => Int -> UnpackT m ByteString
popBS

decodeStrict :: Binary a => ByteString -> a
decodeStrict :: ByteString -> a
decodeStrict = ByteString -> a
forall a. Binary a => ByteString -> a
decode (ByteString -> a) -> (ByteString -> ByteString) -> ByteString -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict

encodeStrict :: Binary a => a -> ByteString
encodeStrict :: a -> ByteString
encodeStrict = ByteString -> ByteString
toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. Binary a => a -> ByteString
encode

-- |Obtain first n bytes of 'ByteString'
topBS :: Monad m => Int -> UnpackT m ByteString
topBS :: Int -> UnpackT m ByteString
topBS Int
size = (ByteString -> ByteString) -> UnpackT m ByteString
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (Int -> ByteString -> ByteString
B.take Int
size)

-- |Obtain first n bytes of 'ByteString' and move offset by n
popBS :: Monad m => Int -> UnpackT m ByteString
popBS :: Int -> UnpackT m ByteString
popBS Int
size = do ByteString
top <- Int -> UnpackT m ByteString
forall (m :: * -> *). Monad m => Int -> UnpackT m ByteString
topBS Int
size
                (ByteString -> ByteString) -> UnpackT m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Int -> ByteString -> ByteString
B.drop Int
size)
                ByteString -> UnpackT m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
top

-- |Pack collection using it's size and set of BOLT constants
mkPackedCollection :: Int -> ByteString -> (Word8, Word8, Word8, Word8) -> ByteString
mkPackedCollection :: Int -> ByteString -> (Word8, Word8, Word8, Word8) -> ByteString
mkPackedCollection Int
size ByteString
bst (Word8
wt, Word8
w8, Word8
w16, Word8
w32)
  | Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
forall a. Integral a => a
size4  = Word8 -> ByteString -> ByteString
cons (Word8
wt Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) ByteString
bst
  | Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
forall a. Integral a => a
size8  = Word8 -> ByteString -> ByteString
cons Word8
w8 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> ByteString
cons (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) ByteString
bst
  | Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
forall a. Integral a => a
size16 = Word8 -> ByteString -> ByteString
cons Word8
w16 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Word16 -> ByteString
forall a. Binary a => a -> ByteString
encodeStrict (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size :: Word16) ByteString -> ByteString -> ByteString
`append` ByteString
bst
  | Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
forall a. Integral a => a
size32 = Word8 -> ByteString -> ByteString
cons Word8
w32 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Word32 -> ByteString
forall a. Binary a => a -> ByteString
encodeStrict (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size :: Word32) ByteString -> ByteString -> ByteString
`append` ByteString
bst
  | Bool
otherwise  = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot pack so large collection"

size4,size8, size16,size32 :: Integral a => a
size4 :: a
size4   = a
2a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
4  :: Int)
size8 :: a
size8   = a
2a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
8  :: Int)
size16 :: a
size16  = a
2a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
16 :: Int)
size32 :: a
size32  = a
2a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
32 :: Int)