{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.PackStream.Structure
( ToStructure (..), FromStructure (..)
, Node (..), Relationship (..), UnboundRelationship (..), Path (..)
) where
import Data.Text (Text)
import Data.Map.Strict (Map)
import Control.Monad.Except (MonadError(..))
import Control.Monad ((>=>))
import Data.PackStream.Internal.Type
class ToStructure a where
toStructure :: a -> Structure
class FromStructure a where
fromStructure :: Structure -> Either PackStreamError a
data Node = Node { Node -> Int
nodeId :: Int
, Node -> [Text]
labels :: [Text]
, Node -> Map Text Value
nodeProps :: Map Text Value
}
deriving (Int -> Node -> ShowS
[Node] -> ShowS
Node -> String
(Int -> Node -> ShowS)
-> (Node -> String) -> ([Node] -> ShowS) -> Show Node
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Node] -> ShowS
$cshowList :: [Node] -> ShowS
show :: Node -> String
$cshow :: Node -> String
showsPrec :: Int -> Node -> ShowS
$cshowsPrec :: Int -> Node -> ShowS
Show, Node -> Node -> Bool
(Node -> Node -> Bool) -> (Node -> Node -> Bool) -> Eq Node
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c== :: Node -> Node -> Bool
Eq)
instance ToStructure Node where
toStructure :: Node -> Structure
toStructure Node{Int
[Text]
Map Text Value
nodeProps :: Map Text Value
labels :: [Text]
nodeId :: Int
nodeProps :: Node -> Map Text Value
labels :: Node -> [Text]
nodeId :: Node -> Int
..} = Word8 -> [Value] -> Structure
Structure Word8
0x4E [ Int -> Value
forall a. ToValue a => a -> Value
toValue Int
nodeId
, [Text] -> Value
forall a. ToValue a => a -> Value
toValue [Text]
labels
, Map Text Value -> Value
forall a. ToValue a => a -> Value
toValue Map Text Value
nodeProps
]
instance FromStructure Node where
fromStructure :: Structure -> Either PackStreamError Node
fromStructure (Structure Word8
0x4E [I Int
nid, L [Value]
lbls, D Map Text Value
nps]) = Int -> [Text] -> Map Text Value -> Node
Node Int
nid ([Text] -> Map Text Value -> Node)
-> Either PackStreamError [Text]
-> Either PackStreamError (Map Text Value -> Node)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Either PackStreamError Text)
-> [Value] -> Either PackStreamError [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Either PackStreamError Text
forall a. FromValue a => Value -> Either PackStreamError a
fromValue [Value]
lbls Either PackStreamError (Map Text Value -> Node)
-> Either PackStreamError (Map Text Value)
-> Either PackStreamError Node
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Map Text Value -> Either PackStreamError (Map Text Value)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map Text Value
nps
fromStructure Structure
_ = PackStreamError -> Either PackStreamError Node
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PackStreamError -> Either PackStreamError Node)
-> PackStreamError -> Either PackStreamError Node
forall a b. (a -> b) -> a -> b
$ Text -> PackStreamError
WrongStructure Text
"Node"
data Relationship = Relationship { Relationship -> Int
relId :: Int
, Relationship -> Int
startNodeId :: Int
, Relationship -> Int
endNodeId :: Int
, Relationship -> Text
relType :: Text
, Relationship -> Map Text Value
relProps :: Map Text Value
}
deriving (Int -> Relationship -> ShowS
[Relationship] -> ShowS
Relationship -> String
(Int -> Relationship -> ShowS)
-> (Relationship -> String)
-> ([Relationship] -> ShowS)
-> Show Relationship
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Relationship] -> ShowS
$cshowList :: [Relationship] -> ShowS
show :: Relationship -> String
$cshow :: Relationship -> String
showsPrec :: Int -> Relationship -> ShowS
$cshowsPrec :: Int -> Relationship -> ShowS
Show, Relationship -> Relationship -> Bool
(Relationship -> Relationship -> Bool)
-> (Relationship -> Relationship -> Bool) -> Eq Relationship
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Relationship -> Relationship -> Bool
$c/= :: Relationship -> Relationship -> Bool
== :: Relationship -> Relationship -> Bool
$c== :: Relationship -> Relationship -> Bool
Eq)
instance ToStructure Relationship where
toStructure :: Relationship -> Structure
toStructure Relationship{Int
Map Text Value
Text
relProps :: Map Text Value
relType :: Text
endNodeId :: Int
startNodeId :: Int
relId :: Int
relProps :: Relationship -> Map Text Value
relType :: Relationship -> Text
endNodeId :: Relationship -> Int
startNodeId :: Relationship -> Int
relId :: Relationship -> Int
..} = Word8 -> [Value] -> Structure
Structure Word8
0x52 [ Int -> Value
forall a. ToValue a => a -> Value
toValue Int
relId
, Int -> Value
forall a. ToValue a => a -> Value
toValue Int
startNodeId
, Int -> Value
forall a. ToValue a => a -> Value
toValue Int
endNodeId
, Text -> Value
forall a. ToValue a => a -> Value
toValue Text
relType
, Map Text Value -> Value
forall a. ToValue a => a -> Value
toValue Map Text Value
relProps
]
instance FromStructure Relationship where
fromStructure :: Structure -> Either PackStreamError Relationship
fromStructure (Structure Word8
0x52 [I Int
rid, I Int
snid, I Int
enid, T Text
rt, D Map Text Value
rps]) = Relationship -> Either PackStreamError Relationship
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Relationship -> Either PackStreamError Relationship)
-> Relationship -> Either PackStreamError Relationship
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> Text -> Map Text Value -> Relationship
Relationship Int
rid Int
snid Int
enid Text
rt Map Text Value
rps
fromStructure Structure
_ = PackStreamError -> Either PackStreamError Relationship
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PackStreamError -> Either PackStreamError Relationship)
-> PackStreamError -> Either PackStreamError Relationship
forall a b. (a -> b) -> a -> b
$ Text -> PackStreamError
WrongStructure Text
"Relationship"
data UnboundRelationship = UnboundRelationship { UnboundRelationship -> Int
urelId :: Int
, UnboundRelationship -> Text
urelType :: Text
, UnboundRelationship -> Map Text Value
urelProps :: Map Text Value
}
deriving (Int -> UnboundRelationship -> ShowS
[UnboundRelationship] -> ShowS
UnboundRelationship -> String
(Int -> UnboundRelationship -> ShowS)
-> (UnboundRelationship -> String)
-> ([UnboundRelationship] -> ShowS)
-> Show UnboundRelationship
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnboundRelationship] -> ShowS
$cshowList :: [UnboundRelationship] -> ShowS
show :: UnboundRelationship -> String
$cshow :: UnboundRelationship -> String
showsPrec :: Int -> UnboundRelationship -> ShowS
$cshowsPrec :: Int -> UnboundRelationship -> ShowS
Show, UnboundRelationship -> UnboundRelationship -> Bool
(UnboundRelationship -> UnboundRelationship -> Bool)
-> (UnboundRelationship -> UnboundRelationship -> Bool)
-> Eq UnboundRelationship
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnboundRelationship -> UnboundRelationship -> Bool
$c/= :: UnboundRelationship -> UnboundRelationship -> Bool
== :: UnboundRelationship -> UnboundRelationship -> Bool
$c== :: UnboundRelationship -> UnboundRelationship -> Bool
Eq)
instance ToStructure UnboundRelationship where
toStructure :: UnboundRelationship -> Structure
toStructure UnboundRelationship{Int
Map Text Value
Text
urelProps :: Map Text Value
urelType :: Text
urelId :: Int
urelProps :: UnboundRelationship -> Map Text Value
urelType :: UnboundRelationship -> Text
urelId :: UnboundRelationship -> Int
..} = Word8 -> [Value] -> Structure
Structure Word8
0x72 [ Int -> Value
forall a. ToValue a => a -> Value
toValue Int
urelId
, Text -> Value
forall a. ToValue a => a -> Value
toValue Text
urelType
, Map Text Value -> Value
forall a. ToValue a => a -> Value
toValue Map Text Value
urelProps
]
instance FromStructure UnboundRelationship where
fromStructure :: Structure -> Either PackStreamError UnboundRelationship
fromStructure (Structure Word8
0x72 [I Int
rid, T Text
rt, D Map Text Value
rps]) = UnboundRelationship -> Either PackStreamError UnboundRelationship
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UnboundRelationship -> Either PackStreamError UnboundRelationship)
-> UnboundRelationship
-> Either PackStreamError UnboundRelationship
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Map Text Value -> UnboundRelationship
UnboundRelationship Int
rid Text
rt Map Text Value
rps
fromStructure Structure
_ = PackStreamError -> Either PackStreamError UnboundRelationship
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PackStreamError -> Either PackStreamError UnboundRelationship)
-> PackStreamError -> Either PackStreamError UnboundRelationship
forall a b. (a -> b) -> a -> b
$ Text -> PackStreamError
WrongStructure Text
"UnboundRelationship"
data Path = Path { Path -> [Node]
nodes :: [Node]
, Path -> [UnboundRelationship]
rels :: [UnboundRelationship]
, Path -> [Int]
ids :: [Int]
}
deriving (Int -> Path -> ShowS
[Path] -> ShowS
Path -> String
(Int -> Path -> ShowS)
-> (Path -> String) -> ([Path] -> ShowS) -> Show Path
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Path] -> ShowS
$cshowList :: [Path] -> ShowS
show :: Path -> String
$cshow :: Path -> String
showsPrec :: Int -> Path -> ShowS
$cshowsPrec :: Int -> Path -> ShowS
Show, Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c== :: Path -> Path -> Bool
Eq)
instance ToStructure Path where
toStructure :: Path -> Structure
toStructure Path{[Int]
[UnboundRelationship]
[Node]
ids :: [Int]
rels :: [UnboundRelationship]
nodes :: [Node]
ids :: Path -> [Int]
rels :: Path -> [UnboundRelationship]
nodes :: Path -> [Node]
..} = Word8 -> [Value] -> Structure
Structure Word8
0x50 [ [Structure] -> Value
forall a. ToValue a => a -> Value
toValue ([Structure] -> Value) -> [Structure] -> Value
forall a b. (a -> b) -> a -> b
$ (Node -> Structure) -> [Node] -> [Structure]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Node -> Structure
forall a. ToStructure a => a -> Structure
toStructure [Node]
nodes
, [Structure] -> Value
forall a. ToValue a => a -> Value
toValue ([Structure] -> Value) -> [Structure] -> Value
forall a b. (a -> b) -> a -> b
$ (UnboundRelationship -> Structure)
-> [UnboundRelationship] -> [Structure]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UnboundRelationship -> Structure
forall a. ToStructure a => a -> Structure
toStructure [UnboundRelationship]
rels
, [Int] -> Value
forall a. ToValue a => a -> Value
toValue [Int]
ids
]
instance FromStructure Path where
fromStructure :: Structure -> Either PackStreamError Path
fromStructure (Structure Word8
0x50 [L [Value]
nds, L [Value]
rls, L [Value]
is]) = [Node] -> [UnboundRelationship] -> [Int] -> Path
Path ([Node] -> [UnboundRelationship] -> [Int] -> Path)
-> Either PackStreamError [Node]
-> Either PackStreamError ([UnboundRelationship] -> [Int] -> Path)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Either PackStreamError Node)
-> [Value] -> Either PackStreamError [Node]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Value -> Either PackStreamError Structure
forall a. FromValue a => Value -> Either PackStreamError a
fromValue (Value -> Either PackStreamError Structure)
-> (Structure -> Either PackStreamError Node)
-> Value
-> Either PackStreamError Node
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Structure -> Either PackStreamError Node
forall a. FromStructure a => Structure -> Either PackStreamError a
fromStructure) [Value]
nds
Either PackStreamError ([UnboundRelationship] -> [Int] -> Path)
-> Either PackStreamError [UnboundRelationship]
-> Either PackStreamError ([Int] -> Path)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Either PackStreamError UnboundRelationship)
-> [Value] -> Either PackStreamError [UnboundRelationship]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Value -> Either PackStreamError Structure
forall a. FromValue a => Value -> Either PackStreamError a
fromValue (Value -> Either PackStreamError Structure)
-> (Structure -> Either PackStreamError UnboundRelationship)
-> Value
-> Either PackStreamError UnboundRelationship
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Structure -> Either PackStreamError UnboundRelationship
forall a. FromStructure a => Structure -> Either PackStreamError a
fromStructure) [Value]
rls
Either PackStreamError ([Int] -> Path)
-> Either PackStreamError [Int] -> Either PackStreamError Path
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Value -> Either PackStreamError Int)
-> [Value] -> Either PackStreamError [Int]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Either PackStreamError Int
forall a. FromValue a => Value -> Either PackStreamError a
fromValue [Value]
is
fromStructure Structure
_ = PackStreamError -> Either PackStreamError Path
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PackStreamError -> Either PackStreamError Path)
-> PackStreamError -> Either PackStreamError Path
forall a b. (a -> b) -> a -> b
$ Text -> PackStreamError
WrongStructure Text
"Path"
newtype Date = Date { Date -> Int
days :: Int
}
deriving (Int -> Date -> ShowS
[Date] -> ShowS
Date -> String
(Int -> Date -> ShowS)
-> (Date -> String) -> ([Date] -> ShowS) -> Show Date
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Date] -> ShowS
$cshowList :: [Date] -> ShowS
show :: Date -> String
$cshow :: Date -> String
showsPrec :: Int -> Date -> ShowS
$cshowsPrec :: Int -> Date -> ShowS
Show, Date -> Date -> Bool
(Date -> Date -> Bool) -> (Date -> Date -> Bool) -> Eq Date
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Date -> Date -> Bool
$c/= :: Date -> Date -> Bool
== :: Date -> Date -> Bool
$c== :: Date -> Date -> Bool
Eq)
instance ToStructure Date where
toStructure :: Date -> Structure
toStructure Date{Int
days :: Int
days :: Date -> Int
..} = Word8 -> [Value] -> Structure
Structure Word8
0x44 [Int -> Value
forall a. ToValue a => a -> Value
toValue Int
days]
instance FromStructure Date where
fromStructure :: Structure -> Either PackStreamError Date
fromStructure (Structure Word8
0x44 [I Int
ds]) = Date -> Either PackStreamError Date
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Date -> Either PackStreamError Date)
-> Date -> Either PackStreamError Date
forall a b. (a -> b) -> a -> b
$ Int -> Date
Date Int
ds
fromStructure Structure
_ = PackStreamError -> Either PackStreamError Date
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PackStreamError -> Either PackStreamError Date)
-> PackStreamError -> Either PackStreamError Date
forall a b. (a -> b) -> a -> b
$ Text -> PackStreamError
WrongStructure Text
"Date"