{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.PackStream.Structure
( ToStructure (..), FromStructure (..)
, Node (..), Relationship (..), UnboundRelationship (..), Path (..)
-- , Date (..), Time (..), LocalTime (..), DateTime (..), DateTimeZoneId (..), LocalDateTime (..)
-- , Duration (..)
-- , Point2D (..), Point3D (..)
) where

import Data.Text (Text)
import Data.Map.Strict (Map)
import Control.Monad.Except (MonadError(..))
import Control.Monad ((>=>))

import Data.PackStream.Internal.Type

-- * Structure coverters
-- 
-- 'PackStream' protocol provides several built-in 'Structure' types. They
-- are the objects with specific fields and one-byte structure signature.
-- The 'ToStructure' and 'FromStructure' typeclasses help to convert
-- Haskell representation of these objects into and from generic 'Structure'
-- type.

-- |The set of types, that can be presented as 'PackStream' 'Structure's
class ToStructure a where
    -- |Convert object to 'Structure'
    toStructure :: a -> Structure

-- |The set of types, that can be parsed from 'PackStream' 'Structure's
class FromStructure a where
    -- |Convert 'Structure' to the object of selected type
    fromStructure :: Structure -> Either PackStreamError a

-- * Built-in structure types

-- |Snapshot of a node within a graph database
data Node = Node { Node -> Int
nodeId    :: Int            -- ^Node identifier
                 , Node -> [Text]
labels    :: [Text]         -- ^List of node labels
                 , Node -> Map Text Value
nodeProps :: Map Text Value -- ^Dict of node properties
                 }
  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"

-- |Snapshot of a relationship within a graph database
data Relationship = Relationship { Relationship -> Int
relId       :: Int            -- ^Relationship identifier
                                 , Relationship -> Int
startNodeId :: Int            -- ^Identifier of the start node
                                 , Relationship -> Int
endNodeId   :: Int            -- ^Identifier of the end node
                                 , Relationship -> Text
relType     :: Text           -- ^Relationship type
                                 , Relationship -> Map Text Value
relProps    :: Map Text Value -- ^Dict of relationship properties
                                 }
  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"

-- |Relationship detail without start or end node information
data UnboundRelationship = UnboundRelationship { UnboundRelationship -> Int
urelId    :: Int            -- ^Relationship identifier
                                               , UnboundRelationship -> Text
urelType  :: Text           -- ^Relationship type
                                               , UnboundRelationship -> Map Text Value
urelProps :: Map Text Value -- ^Dict of relationship properties
                                               }
  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"

-- |Alternating sequence of nodes and relationships
data Path = Path { Path -> [Node]
nodes :: [Node]                -- ^Chain of 'Node's in path
                 , Path -> [UnboundRelationship]
rels  :: [UnboundRelationship] -- ^Chain of 'UnboundRelationship's in path
                 , Path -> [Int]
ids   :: [Int]                 -- ^The ids is a list of relationship id and node id to represent the path
                 }
  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"

-- |The days are days since the Unix epoch
newtype Date = Date { Date -> Int
days :: Int -- ^The days are days since the Unix epoch
                    }
  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"

-- data Time
-- data LocalTime
-- data DateTime
-- data DateTimeZoneId
-- data LocalDateTime
-- data Duration
-- data Point2D
-- data Point3D