{-# 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.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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {f :: * -> *}. MonadFail f => Word8 -> f ()
unpackByMarker
where unpackByMarker :: Word8 -> f ()
unpackByMarker Word8
m | Word8
m forall a. Eq a => a -> a -> Bool
== Word8
nullCode = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise = 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {f :: * -> *}. MonadFail f => Word8 -> f Bool
unpackByMarker
where unpackByMarker :: Word8 -> f Bool
unpackByMarker Word8
m | Word8
m forall a. Eq a => a -> a -> Bool
== Word8
trueCode = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
| Word8
m forall a. Eq a => a -> a -> Bool
== Word8
falseCode = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
| Bool
otherwise = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected bool"
instance BoltValue Int where
pack :: Int -> Put
pack Int
int | forall a. Integral a => a -> Bool
isTinyInt Int
int = Word8 -> Put
putWord8 forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
int
| forall x. Integral x => x -> x -> Bool
isIntX Int
8 Int
int = Word8 -> Put
putWord8 Word8
int8Code forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
int)
| forall x. Integral x => x -> x -> Bool
isIntX Int
16 Int
int = Word8 -> Put
putWord8 Word8
int16Code forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Put
putWord16be (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
int :: Word16)
| forall x. Integral x => x -> x -> Bool
isIntX Int
32 Int
int = Word8 -> Put
putWord8 Word8
int32Code forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
putWord32be (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
int :: Word32)
| forall x. Integral x => x -> x -> Bool
isIntX Int
64 Int
int = Word8 -> Put
putWord8 Word8
int64Code forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Put
putWord64be (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
int :: Word64)
| Bool
otherwise = forall a. HasCallStack => String -> a
error String
"Cannot pack so large integer"
unpackT :: Get Int
unpackT = Get Word8
getWord8 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 = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Int
toInt forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
m :: Int8)
| Word8
m forall a. Eq a => a -> a -> Bool
== Word8
int8Code = forall a. Integral a => a -> Int
toInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
getInt8
| Word8
m forall a. Eq a => a -> a -> Bool
== Word8
int16Code = forall a. Integral a => a -> Int
toInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16be
| Word8
m forall a. Eq a => a -> a -> Bool
== Word8
int32Code = forall a. Integral a => a -> Int
toInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
getInt32be
| Word8
m forall a. Eq a => a -> a -> Bool
== Word8
int64Code = forall a. Integral a => a -> Int
toInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int64
getInt64be
| Bool
otherwise = 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 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 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 forall a. Eq a => a -> a -> Bool
== Word8
doubleCode = Word64 -> Double
wordToDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
getWord64be
| Bool
otherwise = 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 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 forall a. Eq a => a -> a -> Bool
== Word8
text8Code = forall a. Integral a => a -> Int
toInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
getInt8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get Text
unpackTextBySize
| Word8
m forall a. Eq a => a -> a -> Bool
== Word8
text16Code = forall a. Integral a => a -> Int
toInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16be forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get Text
unpackTextBySize
| Word8
m forall a. Eq a => a -> a -> Bool
== Word8
text32Code = forall a. Integral a => a -> Int
toInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
getInt32be forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get Text
unpackTextBySize
| Bool
otherwise = 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
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 (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 = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. BoltValue a => a -> Put
pack [a]
lst
unpackT :: Get [a]
unpackT = Get Word8
getWord8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {b}. BoltValue b => Word8 -> Get [b]
unpackByMarker
where unpackByMarker :: Word8 -> Get [b]
unpackByMarker Word8
m | Word8 -> Bool
isTinyList Word8
m = forall {a} {b}. (Num a, Enum a, BoltValue b) => a -> Get [b]
unpackListBySize (Word8 -> Int
getSize Word8
m)
| Word8
m forall a. Eq a => a -> a -> Bool
== Word8
list8Code = forall a. Integral a => a -> Int
toInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
getInt8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a} {b}. (Num a, Enum a, BoltValue b) => a -> Get [b]
unpackListBySize
| Word8
m forall a. Eq a => a -> a -> Bool
== Word8
list16Code = forall a. Integral a => a -> Int
toInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16be forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a} {b}. (Num a, Enum a, BoltValue b) => a -> Get [b]
unpackListBySize
| Word8
m forall a. Eq a => a -> a -> Bool
== Word8
list32Code = forall a. Integral a => a -> Int
toInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
getInt32be forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a} {b}. (Num a, Enum a, BoltValue b) => a -> Get [b]
unpackListBySize
| Bool
otherwise = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected list"
unpackListBySize :: a -> Get [b]
unpackListBySize a
size = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [a
1..a
size] forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const 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 (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 = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall {a} {a}. (BoltValue a, BoltValue a) => (a, a) -> Put
mkPairPack forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.assocs Map Text a
dict
mkPairPack :: (a, a) -> Put
mkPairPack (a
key, a
val) = forall a. BoltValue a => a -> Put
pack a
key forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. BoltValue a => a -> Put
pack a
val
unpackT :: Get (Map Text a)
unpackT = Get Word8
getWord8 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 forall a. Eq a => a -> a -> Bool
== Word8
dict8Code = forall a. Integral a => a -> Int
toInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16be forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get (Map Text a)
unpackDictBySize
| Word8
m forall a. Eq a => a -> a -> Bool
== Word8
dict16Code = forall a. Integral a => a -> Int
toInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16be forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get (Map Text a)
unpackDictBySize
| Word8
m forall a. Eq a => a -> a -> Bool
== Word8
dict32Code = forall a. Integral a => a -> Int
toInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int32
getInt32be forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get (Map Text a)
unpackDictBySize
| Bool
otherwise = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected dict"
unpackDictBySize :: Int -> Get (Map Text a)
unpackDictBySize = (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {a} {b}.
(Num a, Enum a, BoltValue a, BoltValue b) =>
a -> Get [(a, b)]
unpackPairsBySize
unpackPairsBySize :: a -> Get [(a, b)]
unpackPairsBySize a
size = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [a
1..a
size] forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ do
!a
key <- forall a. BoltValue a => Get a
unpackT
!b
value <- forall a. BoltValue a => Get a
unpackT
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 forall a. Ord a => a -> a -> Bool
< forall a. Integral a => a
size4 = Word8 -> Put
putWord8 (Word8
structConst forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
size) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Put
pData
| Word16
size forall a. Ord a => a -> a -> Bool
< forall a. Integral a => a
size8 = Word8 -> Put
putWord8 Word8
struct8Code forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
size) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Put
pData
| Word16
size forall a. Ord a => a -> a -> Bool
< forall a. Integral a => a
size16 = Word8 -> Put
putWord8 Word8
struct16Code forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Put
putWord16be Word16
size forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Put
pData
| Bool
otherwise = forall a. HasCallStack => String -> a
error String
"Cannot pack so large structure"
where size :: Word16
size = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
lst :: Word16
pData :: Put
pData = Word8 -> Put
putWord8 Word8
sig forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. BoltValue a => a -> Put
pack [Value]
lst
unpackT :: Get Structure
unpackT = Get Word8
getWord8 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 forall a. Eq a => a -> a -> Bool
== Word8
struct8Code = forall a. Integral a => a -> Int
toInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int8
getInt8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get Structure
unpackStructureBySize
| Word8
m forall a. Eq a => a -> a -> Bool
== Word8
struct16Code = forall a. Integral a => a -> Int
toInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Int16
getInt16be forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Get Structure
unpackStructureBySize
| Bool
otherwise = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"expected structure"
unpackStructureBySize :: Int -> Get Structure
unpackStructureBySize Int
size = Word8 -> [Value] -> Structure
Structure forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word8
getWord8 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
size forall a. BoltValue a => Get a
unpackT
instance BoltValue Value where
pack :: Value -> Put
pack (N ()
n) = forall a. BoltValue a => a -> Put
pack ()
n
pack (B Bool
b) = forall a. BoltValue a => a -> Put
pack Bool
b
pack (I Int
i) = forall a. BoltValue a => a -> Put
pack Int
i
pack (F Double
d) = forall a. BoltValue a => a -> Put
pack Double
d
pack (T Text
t) = forall a. BoltValue a => a -> Put
pack Text
t
pack (L [Value]
l) = forall a. BoltValue a => a -> Put
pack [Value]
l
pack (M Map Text Value
m) = forall a. BoltValue a => a -> Put
pack Map Text Value
m
pack (S Structure
s) = forall a. BoltValue a => a -> Put
pack Structure
s
unpackT :: Get Value
unpackT = forall a. Get a -> Get a
lookAhead Get Word8
getWord8 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. BoltValue a => Get a
unpackT
| Word8 -> Bool
isBool Word8
m = Bool -> Value
B forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. BoltValue a => Get a
unpackT
| Word8 -> Bool
isInt Word8
m = Int -> Value
I forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. BoltValue a => Get a
unpackT
| Word8 -> Bool
isDouble Word8
m = Double -> Value
F forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. BoltValue a => Get a
unpackT
| Word8 -> Bool
isText Word8
m = Text -> Value
T forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. BoltValue a => Get a
unpackT
| Word8 -> Bool
isList Word8
m = [Value] -> Value
L forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. BoltValue a => Get a
unpackT
| Word8 -> Bool
isDict Word8
m = Map Text Value -> Value
M forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. BoltValue a => Get a
unpackT
| Word8 -> Bool
isStruct Word8
m = Structure -> Value
S forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. BoltValue a => Get a
unpackT
| Bool
otherwise = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"not value"
instance FromStructure Node where
fromStructure :: forall (m :: * -> *).
MonadError UnpackError m =>
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 forall a. Eq a => a -> a -> Bool
== Word8
sigNode -> forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> [Text] -> Map Text Value -> Node
Node Int
nid) Map Text Value
prps forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {f :: * -> *}.
MonadError UnpackError f =>
[Value] -> f [Text]
cnvT [Value]
vlbls
Structure
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> UnpackError
Not Text
"Node"
where
cnvT :: [Value] -> f [Text]
cnvT [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
cnvT (T Text
x:[Value]
xs) = (Text
xforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value] -> f [Text]
cnvT [Value]
xs
cnvT [Value]
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError UnpackError
NotString
instance FromStructure Relationship where
fromStructure :: forall (m :: * -> *).
MonadError UnpackError m =>
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 forall a. Eq a => a -> a -> Bool
== Word8
sigRel -> forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> UnpackError
Not Text
"Relationship"
instance FromStructure URelationship where
fromStructure :: forall (m :: * -> *).
MonadError UnpackError m =>
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 forall a. Eq a => a -> a -> Bool
== Word8
sigURel -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> Text -> Map Text Value -> URelationship
URelationship Int
rid Text
rt Map Text Value
rp
Structure
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> UnpackError
Not Text
"URelationship"
instance FromStructure Path where
fromStructure :: forall (m :: * -> *).
MonadError UnpackError m =>
Structure -> m Path
fromStructure Structure
struct =
case Structure
struct of
(Structure Word8
sig [L [Value]
vnp, L [Value]
vrp, L [Value]
vip]) | Word8
sig forall a. Eq a => a -> a -> Bool
== Word8
sigPath -> [Node] -> [URelationship] -> [Int] -> Path
Path forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {f :: * -> *} {a}.
(FromStructure a, MonadError UnpackError f) =>
[Value] -> f [a]
cnvN [Value]
vnp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {f :: * -> *} {a}.
(FromStructure a, MonadError UnpackError f) =>
[Value] -> f [a]
cnvR [Value]
vrp forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {f :: * -> *}.
MonadError UnpackError f =>
[Value] -> f [Int]
cnvI [Value]
vip
Structure
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> UnpackError
Not Text
"Path"
where
cnvN :: [Value] -> f [a]
cnvN [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
cnvN (S Structure
x:[Value]
xs) = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(FromStructure a, MonadError UnpackError m) =>
Structure -> m a
fromStructure Structure
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Value] -> f [a]
cnvN [Value]
xs
cnvN [Value]
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Text -> UnpackError
Not Text
"Node"
cnvR :: [Value] -> f [a]
cnvR [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
cnvR (S Structure
x:[Value]
xs) = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(FromStructure a, MonadError UnpackError m) =>
Structure -> m a
fromStructure Structure
x forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Value] -> f [a]
cnvR [Value]
xs
cnvR [Value]
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError UnpackError
NotStructure
cnvI :: [Value] -> f [Int]
cnvI [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
cnvI (I Int
x:[Value]
xs) = (Int
xforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value] -> f [Int]
cnvI [Value]
xs
cnvI [Value]
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError UnpackError
NotInt
decodeStrict :: Binary a => ByteString -> a
decodeStrict :: forall a. Binary a => ByteString -> a
decodeStrict = forall a. Binary a => ByteString -> a
decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict
encodeStrict :: Binary a => a -> ByteString
encodeStrict :: forall a. Binary a => a -> ByteString
encodeStrict = ByteString -> ByteString
toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Ord a => a -> a -> Bool
< forall a. Integral a => a
size4 = Word8 -> Put
putWord8 (Word8
wt forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Put
bst
| Int
size forall a. Ord a => a -> a -> Bool
< forall a. Integral a => a
size8 = Word8 -> Put
putWord8 Word8
w8 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Put
bst
| Int
size forall a. Ord a => a -> a -> Bool
< forall a. Integral a => a
size16 = Word8 -> Put
putWord8 Word8
w16 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Put
putWord16be (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size :: Word16) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Put
bst
| Int
size forall a. Ord a => a -> a -> Bool
< forall a. Integral a => a
size32 = Word8 -> Put
putWord8 Word8
w32 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
putWord32be (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size :: Word32) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Put
bst
| Bool
otherwise = forall a. HasCallStack => String -> a
error String
"Cannot pack so large collection"
size4,size8, size16,size32 :: Integral a => a
size4 :: forall a. Integral a => a
size4 = a
2forall a b. (Num a, Integral b) => a -> b -> a
^(Int
4 :: Int)
size8 :: forall a. Integral a => a
size8 = a
2forall a b. (Num a, Integral b) => a -> b -> a
^(Int
8 :: Int)
size16 :: forall a. Integral a => a
size16 = a
2forall a b. (Num a, Integral b) => a -> b -> a
^(Int
16 :: Int)
size32 :: forall a. Integral a => a
size32 = a
2forall a b. (Num a, Integral b) => a -> b -> a
^(Int
32 :: Int)