{-# 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"

-- = Structure instances for Neo4j structures

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

-- |Pack collection using it's size and set of BOLT constants
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)