{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# 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.Except (MonadError (..))
import Data.Binary (Binary (..), Put, decode, encode)
import Data.Binary.Get
import Data.Binary.IEEE754 (doubleToWord, wordToDouble)
import Data.Binary.Put (putByteString, putWord16be, putWord32be, putWord64be,
putWord8)
import Data.ByteString (ByteString)
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 :: () -> Put
pack () = Word8 -> Put
putWord8 Word8
nullCode
unpackT :: Get ()
unpackT = Get Word8
getWord8 Get Word8 -> (Word8 -> Get ()) -> Get ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Get ()
forall (f :: * -> *). MonadFail 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 = String -> f ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected null"
instance BoltValue Bool where
pack :: Bool -> Put
pack Bool
True = Word8 -> Put
putWord8 Word8
trueCode
pack Bool
False = Word8 -> Put
putWord8 Word8
falseCode
unpackT :: Get Bool
unpackT = Get Word8
getWord8 Get Word8 -> (Word8 -> Get Bool) -> Get Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Get Bool
forall (f :: * -> *). MonadFail 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 = String -> f Bool
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected bool"
instance BoltValue Int where
pack :: Int -> Put
pack Int
int | Int -> Bool
forall a. Integral a => a -> Bool
isTinyInt Int
int = Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
int
| Int -> Int -> Bool
forall x. Integral x => x -> x -> Bool
isIntX Int
8 Int
int = Word8 -> Put
putWord8 Word8
int8Code Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
int)
| Int -> Int -> Bool
forall x. Integral x => x -> x -> Bool
isIntX Int
16 Int
int = Word8 -> Put
putWord8 Word8
int16Code Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Put
putWord16be (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 -> Put
putWord8 Word8
int32Code Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
putWord32be (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 -> Put
putWord8 Word8
int64Code Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
putWord64be (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
int :: Word64)
| Bool
otherwise = String -> Put
forall a. HasCallStack => String -> a
error String
"Cannot pack so large integer"
unpackT :: Get Int
unpackT = Get Word8
getWord8 Get Word8 -> (Word8 -> Get Int) -> Get Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Get Int
unpackByMarker
where unpackByMarker :: Word8 -> Get Int
unpackByMarker Word8
m | Word8 -> Bool
isTinyWord Word8
m = Int -> Get Int
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Get Int) -> (Int8 -> Int) -> Int8 -> Get Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int8 -> Int
forall a. Integral a => a -> Int
toInt (Int8 -> Get Int) -> Int8 -> Get 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) -> Get Int8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
getInt8
| 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) -> Get Int16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16be
| 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) -> Get Int32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
getInt32be
| 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) -> Get Int64 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
getInt64be
| Bool
otherwise = String -> Get Int
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected int"
instance BoltValue Double where
pack :: Double -> Put
pack Double
dbl = Word8 -> Put
putWord8 Word8
doubleCode Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
putWord64be (Double -> Word64
doubleToWord Double
dbl)
unpackT :: Get Double
unpackT = Get Word8
getWord8 Get Word8 -> (Word8 -> Get Double) -> Get Double
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Get Double
unpackByMarker
where unpackByMarker :: Word8 -> Get Double
unpackByMarker Word8
m | Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
doubleCode = Word64 -> Double
wordToDouble (Word64 -> Double) -> Get Word64 -> Get Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64be
| Bool
otherwise = String -> Get Double
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected double"
instance BoltValue Text where
pack :: Text -> Put
pack Text
txt = Int -> Put -> (Word8, Word8, Word8, Word8) -> Put
mkPackedCollection (ByteString -> Int
B.length ByteString
bs) Put
pbs (Word8
textConst, Word8
text8Code, Word8
text16Code, Word8
text32Code)
where bs :: ByteString
bs = Text -> ByteString
encodeUtf8 Text
txt
pbs :: Put
pbs = ByteString -> Put
putByteString ByteString
bs
unpackT :: Get Text
unpackT = Get Word8
getWord8 Get Word8 -> (Word8 -> Get Text) -> Get Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Get Text
unpackByMarker
where unpackByMarker :: Word8 -> Get Text
unpackByMarker Word8
m | Word8 -> Bool
isTinyText Word8
m = Int -> Get Text
unpackTextBySize (Word8 -> Int
getSize Word8
m)
| Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
text8Code = Int8 -> Int
forall a. Integral a => a -> Int
toInt (Int8 -> Int) -> Get Int8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
getInt8 Get Int -> (Int -> Get Text) -> Get Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get Text
unpackTextBySize
| Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
text16Code = Int16 -> Int
forall a. Integral a => a -> Int
toInt (Int16 -> Int) -> Get Int16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16be Get Int -> (Int -> Get Text) -> Get Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get Text
unpackTextBySize
| Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
text32Code = Int32 -> Int
forall a. Integral a => a -> Int
toInt (Int32 -> Int) -> Get Int32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
getInt32be Get Int -> (Int -> Get Text) -> Get Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get Text
unpackTextBySize
| Bool
otherwise = String -> Get Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected text"
unpackTextBySize :: Int -> Get Text
unpackTextBySize Int
size = do ByteString
str <- Int -> Get ByteString
getByteString Int
size
Text -> Get Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Get Text) -> Text -> Get Text
forall a b. (a -> b) -> a -> b
$! ByteString -> Text
decodeUtf8 ByteString
str
instance BoltValue a => BoltValue [a] where
pack :: [a] -> Put
pack [a]
lst = Int -> Put -> (Word8, Word8, Word8, Word8) -> Put
mkPackedCollection ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
lst) Put
pbs (Word8
listConst, Word8
list8Code, Word8
list16Code, Word8
list32Code)
where pbs :: Put
pbs = (a -> Put) -> [a] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> Put
forall a. BoltValue a => a -> Put
pack [a]
lst
unpackT :: Get [a]
unpackT = Get Word8
getWord8 Get Word8 -> (Word8 -> Get [a]) -> Get [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Get [a]
forall b. BoltValue b => Word8 -> Get [b]
unpackByMarker
where unpackByMarker :: Word8 -> Get [b]
unpackByMarker Word8
m | Word8 -> Bool
isTinyList Word8
m = Int -> Get [b]
forall b b. (Num b, Enum b, BoltValue b) => b -> Get [b]
unpackListBySize (Word8 -> Int
getSize Word8
m)
| Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
list8Code = Int8 -> Int
forall a. Integral a => a -> Int
toInt (Int8 -> Int) -> Get Int8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
getInt8 Get Int -> (Int -> Get [b]) -> Get [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get [b]
forall b b. (Num b, Enum b, BoltValue b) => b -> Get [b]
unpackListBySize
| Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
list16Code = Int16 -> Int
forall a. Integral a => a -> Int
toInt (Int16 -> Int) -> Get Int16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16be Get Int -> (Int -> Get [b]) -> Get [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get [b]
forall b b. (Num b, Enum b, BoltValue b) => b -> Get [b]
unpackListBySize
| Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
list32Code = Int32 -> Int
forall a. Integral a => a -> Int
toInt (Int32 -> Int) -> Get Int32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
getInt32be Get Int -> (Int -> Get [b]) -> Get [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get [b]
forall b b. (Num b, Enum b, BoltValue b) => b -> Get [b]
unpackListBySize
| Bool
otherwise = String -> Get [b]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected list"
unpackListBySize :: b -> Get [b]
unpackListBySize b
size = [b] -> (b -> Get b) -> Get [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [b
1..b
size] ((b -> Get b) -> Get [b]) -> (b -> Get b) -> Get [b]
forall a b. (a -> b) -> a -> b
$ Get b -> b -> Get b
forall a b. a -> b -> a
const Get b
forall a. BoltValue a => Get a
unpackT
instance BoltValue a => BoltValue (Map Text a) where
pack :: Map Text a -> Put
pack Map Text a
dict = Int -> Put -> (Word8, Word8, Word8, Word8) -> Put
mkPackedCollection (Map Text a -> Int
forall k a. Map k a -> Int
M.size Map Text a
dict) Put
pbs (Word8
dictConst, Word8
dict8Code, Word8
dict16Code, Word8
dict32Code)
where pbs :: Put
pbs = ((Text, a) -> Put) -> [(Text, a)] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text, a) -> Put
forall a a. (BoltValue a, BoltValue a) => (a, a) -> Put
mkPairPack ([(Text, a)] -> Put) -> [(Text, a)] -> Put
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) -> Put
mkPairPack (a
key, a
val) = a -> Put
forall a. BoltValue a => a -> Put
pack a
key Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> Put
forall a. BoltValue a => a -> Put
pack a
val
unpackT :: Get (Map Text a)
unpackT = Get Word8
getWord8 Get Word8 -> (Word8 -> Get (Map Text a)) -> Get (Map Text a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Get (Map Text a)
unpackByMarker
where unpackByMarker :: Word8 -> Get (Map Text a)
unpackByMarker Word8
m | Word8 -> Bool
isTinyDict Word8
m = Int -> Get (Map Text a)
unpackDictBySize (Word8 -> Int
getSize Word8
m)
| Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
dict8Code = Int16 -> Int
forall a. Integral a => a -> Int
toInt (Int16 -> Int) -> Get Int16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16be Get Int -> (Int -> Get (Map Text a)) -> Get (Map Text a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get (Map Text a)
unpackDictBySize
| Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
dict16Code = Int16 -> Int
forall a. Integral a => a -> Int
toInt (Int16 -> Int) -> Get Int16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16be Get Int -> (Int -> Get (Map Text a)) -> Get (Map Text a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get (Map Text a)
unpackDictBySize
| Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
dict32Code = Int32 -> Int
forall a. Integral a => a -> Int
toInt (Int32 -> Int) -> Get Int32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
getInt32be Get Int -> (Int -> Get (Map Text a)) -> Get (Map Text a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get (Map Text a)
unpackDictBySize
| Bool
otherwise = String -> Get (Map Text a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected dict"
unpackDictBySize :: Int -> Get (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) -> Get [(Text, a)] -> Get (Map Text a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Get [(Text, a)] -> Get (Map Text a))
-> (Int -> Get [(Text, a)]) -> Int -> Get (Map Text a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Get [(Text, a)]
forall b a b.
(Num b, Enum b, BoltValue a, BoltValue b) =>
b -> Get [(a, b)]
unpackPairsBySize
unpackPairsBySize :: b -> Get [(a, b)]
unpackPairsBySize b
size = [b] -> (b -> Get (a, b)) -> Get [(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 -> Get (a, b)) -> Get [(a, b)])
-> (b -> Get (a, b)) -> Get [(a, b)]
forall a b. (a -> b) -> a -> b
$ Get (a, b) -> b -> Get (a, b)
forall a b. a -> b -> a
const (Get (a, b) -> b -> Get (a, b)) -> Get (a, b) -> b -> Get (a, b)
forall a b. (a -> b) -> a -> b
$ do
!a
key <- Get a
forall a. BoltValue a => Get a
unpackT
!b
value <- Get b
forall a. BoltValue a => Get a
unpackT
(a, b) -> Get (a, b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
key, b
value)
instance BoltValue Structure where
pack :: Structure -> Put
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 -> Put
putWord8 (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) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Put
pData
| Word16
size Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
< Word16
forall a. Integral a => a
size8 = Word8 -> Put
putWord8 Word8
struct8Code Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
size) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Put
pData
| Word16
size Word16 -> Word16 -> Bool
forall a. Ord a => a -> a -> Bool
< Word16
forall a. Integral a => a
size16 = Word8 -> Put
putWord8 Word8
struct16Code Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Put
putWord16be Word16
size Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Put
pData
| Bool
otherwise = String -> Put
forall a. HasCallStack => String -> a
error String
"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 :: Put
pData = Word8 -> Put
putWord8 Word8
sig Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Value -> Put) -> [Value] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Value -> Put
forall a. BoltValue a => a -> Put
pack [Value]
lst
unpackT :: Get Structure
unpackT = Get Word8
getWord8 Get Word8 -> (Word8 -> Get Structure) -> Get Structure
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Get Structure
unpackByMarker
where unpackByMarker :: Word8 -> Get Structure
unpackByMarker Word8
m | Word8 -> Bool
isTinyStruct Word8
m = Int -> Get Structure
unpackStructureBySize (Word8 -> Int
getSize Word8
m)
| Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
struct8Code = Int8 -> Int
forall a. Integral a => a -> Int
toInt (Int8 -> Int) -> Get Int8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
getInt8 Get Int -> (Int -> Get Structure) -> Get Structure
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get Structure
unpackStructureBySize
| Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
struct16Code = Int16 -> Int
forall a. Integral a => a -> Int
toInt (Int16 -> Int) -> Get Int16 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16be Get Int -> (Int -> Get Structure) -> Get Structure
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get Structure
unpackStructureBySize
| Bool
otherwise = String -> Get Structure
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected structure"
unpackStructureBySize :: Int -> Get Structure
unpackStructureBySize Int
size = Word8 -> [Value] -> Structure
Structure (Word8 -> [Value] -> Structure)
-> Get Word8 -> Get ([Value] -> Structure)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8 Get ([Value] -> Structure) -> Get [Value] -> Get Structure
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> Get Value -> Get [Value]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
size Get Value
forall a. BoltValue a => Get a
unpackT
instance BoltValue Value where
pack :: Value -> Put
pack (N ()
n) = () -> Put
forall a. BoltValue a => a -> Put
pack ()
n
pack (B Bool
b) = Bool -> Put
forall a. BoltValue a => a -> Put
pack Bool
b
pack (I Int
i) = Int -> Put
forall a. BoltValue a => a -> Put
pack Int
i
pack (F Double
d) = Double -> Put
forall a. BoltValue a => a -> Put
pack Double
d
pack (T Text
t) = Text -> Put
forall a. BoltValue a => a -> Put
pack Text
t
pack (L [Value]
l) = [Value] -> Put
forall a. BoltValue a => a -> Put
pack [Value]
l
pack (M Map Text Value
m) = Map Text Value -> Put
forall a. BoltValue a => a -> Put
pack Map Text Value
m
pack (S Structure
s) = Structure -> Put
forall a. BoltValue a => a -> Put
pack Structure
s
unpackT :: Get Value
unpackT = Get Word8 -> Get Word8
forall a. Get a -> Get a
lookAhead Get Word8
getWord8 Get Word8 -> (Word8 -> Get Value) -> Get Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Get Value
unpackByMarker
where unpackByMarker :: Word8 -> Get Value
unpackByMarker Word8
m | Word8 -> Bool
isNull Word8
m = () -> Value
N (() -> Value) -> Get () -> Get Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ()
forall a. BoltValue a => Get a
unpackT
| Word8 -> Bool
isBool Word8
m = Bool -> Value
B (Bool -> Value) -> Get Bool -> Get Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Bool
forall a. BoltValue a => Get a
unpackT
| Word8 -> Bool
isInt Word8
m = Int -> Value
I (Int -> Value) -> Get Int -> Get Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int
forall a. BoltValue a => Get a
unpackT
| Word8 -> Bool
isDouble Word8
m = Double -> Value
F (Double -> Value) -> Get Double -> Get Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Double
forall a. BoltValue a => Get a
unpackT
| Word8 -> Bool
isText Word8
m = Text -> Value
T (Text -> Value) -> Get Text -> Get Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Text
forall a. BoltValue a => Get a
unpackT
| Word8 -> Bool
isList Word8
m = [Value] -> Value
L ([Value] -> Value) -> Get [Value] -> Get Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Value]
forall a. BoltValue a => Get a
unpackT
| Word8 -> Bool
isDict Word8
m = Map Text Value -> Value
M (Map Text Value -> Value) -> Get (Map Text Value) -> Get Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Map Text Value)
forall a. BoltValue a => Get a
unpackT
| Word8 -> Bool
isStruct Word8
m = Structure -> Value
S (Structure -> Value) -> Get Structure -> Get Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Structure
forall a. BoltValue a => Get a
unpackT
| Bool
otherwise = String -> Get Value
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not value"
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
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
mkPackedCollection :: Int -> Put -> (Word8, Word8, Word8, Word8) -> Put
mkPackedCollection :: Int -> Put -> (Word8, Word8, Word8, Word8) -> Put
mkPackedCollection Int
size Put
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 -> Put
putWord8 (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) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Put
bst
| Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
forall a. Integral a => a
size8 = Word8 -> Put
putWord8 Word8
w8 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Put
bst
| Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
forall a. Integral a => a
size16 = Word8 -> Put
putWord8 Word8
w16 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Put
putWord16be (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size :: Word16) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Put
bst
| Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
forall a. Integral a => a
size32 = Word8 -> Put
putWord8 Word8
w32 Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
putWord32be (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size :: Word32) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Put
bst
| Bool
otherwise = String -> Put
forall a. HasCallStack => String -> a
error String
"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)