{-# LANGUAGE DeriveGeneric #-}

module Database.Cayley.Types where

import           Control.Monad       (mzero)
import qualified Data.Aeson          as A
import qualified Data.Aeson.Types    as AT
import           Data.Binary
import qualified Data.Text           as T
import qualified Data.Vector         as V
import           GHC.Generics        (Generic)
import           Network.HTTP.Client (Manager)

data APIVersion = V1

instance Show APIVersion where
    show :: APIVersion -> String
show APIVersion
V1 = String
"1"

data QueryLang = Gremlin | MQL

instance Show QueryLang where
  show :: QueryLang -> String
show QueryLang
Gremlin = String
"gremlin"
  show QueryLang
MQL     = String
"mql"

data CayleyConfig = CayleyConfig
  { CayleyConfig -> Int
serverPort :: !Int
  , CayleyConfig -> String
serverName :: !String
  , CayleyConfig -> APIVersion
apiVersion :: !APIVersion
  , CayleyConfig -> QueryLang
queryLang  :: !QueryLang
  } deriving (Int -> CayleyConfig -> ShowS
[CayleyConfig] -> ShowS
CayleyConfig -> String
(Int -> CayleyConfig -> ShowS)
-> (CayleyConfig -> String)
-> ([CayleyConfig] -> ShowS)
-> Show CayleyConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CayleyConfig -> ShowS
showsPrec :: Int -> CayleyConfig -> ShowS
$cshow :: CayleyConfig -> String
show :: CayleyConfig -> String
$cshowList :: [CayleyConfig] -> ShowS
showList :: [CayleyConfig] -> ShowS
Show)

-- | CayleyConfig { serverPort = 64210 , serverName = "localhost" , apiVersion = V1 , queryLang  = Gremlin }
defaultCayleyConfig :: CayleyConfig
defaultCayleyConfig :: CayleyConfig
defaultCayleyConfig = CayleyConfig
  { serverPort :: Int
serverPort = Int
64210
  , serverName :: String
serverName = String
"localhost"
  , apiVersion :: APIVersion
apiVersion = APIVersion
V1
  , queryLang :: QueryLang
queryLang  = QueryLang
Gremlin
  }

data CayleyConnection = CayleyConnection
  { CayleyConnection -> CayleyConfig
cayleyConfig :: !CayleyConfig
  , CayleyConnection -> Manager
manager      :: !Manager
  }

data Quad = Quad
  { Quad -> Tag
subject   :: !T.Text         -- ^ Subject node
  , Quad -> Tag
predicate :: !T.Text         -- ^ Predicate node
  , Quad -> Tag
object    :: !T.Text         -- ^ Object node
  , Quad -> Maybe Tag
label     :: !(Maybe T.Text) -- ^ Label node
  } deriving ((forall x. Quad -> Rep Quad x)
-> (forall x. Rep Quad x -> Quad) -> Generic Quad
forall x. Rep Quad x -> Quad
forall x. Quad -> Rep Quad x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Quad -> Rep Quad x
from :: forall x. Quad -> Rep Quad x
$cto :: forall x. Rep Quad x -> Quad
to :: forall x. Rep Quad x -> Quad
Generic)

instance Binary Quad

instance Show Quad where
  show :: Quad -> String
show (Quad Tag
s Tag
p Tag
o (Just Tag
l)) = Tag -> String
T.unpack Tag
s
                               String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -- "
                               String -> ShowS
forall a. [a] -> [a] -> [a]
++ Tag -> String
T.unpack Tag
p
                               String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -> "
                               String -> ShowS
forall a. [a] -> [a] -> [a]
++ Tag -> String
T.unpack Tag
o
                               String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ("
                               String -> ShowS
forall a. [a] -> [a] -> [a]
++ Tag -> String
T.unpack Tag
l
                               String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  show (Quad Tag
s Tag
p Tag
o Maybe Tag
Nothing)  = Tag -> String
T.unpack Tag
s
                               String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -- "
                               String -> ShowS
forall a. [a] -> [a] -> [a]
++ Tag -> String
T.unpack Tag
p
                               String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" -> "
                               String -> ShowS
forall a. [a] -> [a] -> [a]
++ Tag -> String
T.unpack Tag
o

-- | Two quads are equals when subject, predicate, object /and/ label are equals.
instance Eq Quad where
  Quad Tag
s Tag
p Tag
o Maybe Tag
l == :: Quad -> Quad -> Bool
== Quad Tag
s' Tag
p' Tag
o' Maybe Tag
l' = Tag
s Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
s' Bool -> Bool -> Bool
&& Tag
p Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
p' Bool -> Bool -> Bool
&& Tag
o Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Tag
o' Bool -> Bool -> Bool
&& Maybe Tag
l Maybe Tag -> Maybe Tag -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Tag
l'

instance A.ToJSON Quad where
  toJSON :: Quad -> Value
toJSON (Quad Tag
s Tag
p Tag
o Maybe Tag
l) =
    [Pair] -> Value
A.object [ Key
"subject"   Key -> Tag -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Tag
s
             , Key
"predicate" Key -> Tag -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Tag
p
             , Key
"object"    Key -> Tag -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Tag
o
             , Key
"label"     Key -> Maybe Tag -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Maybe Tag
l
             ]

instance A.FromJSON Quad where
  parseJSON :: Value -> Parser Quad
parseJSON (A.Object Object
v) =
    Tag -> Tag -> Tag -> Maybe Tag -> Quad
Quad (Tag -> Tag -> Tag -> Maybe Tag -> Quad)
-> Parser Tag -> Parser (Tag -> Tag -> Maybe Tag -> Quad)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Object
v Object -> Key -> Parser Tag
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"subject" Parser (Tag -> Tag -> Maybe Tag -> Quad)
-> Parser Tag -> Parser (Tag -> Maybe Tag -> Quad)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
v Object -> Key -> Parser Tag
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"predicate" Parser (Tag -> Maybe Tag -> Quad)
-> Parser Tag -> Parser (Maybe Tag -> Quad)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
v Object -> Key -> Parser Tag
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"object" Parser (Maybe Tag -> Quad) -> Parser (Maybe Tag) -> Parser Quad
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
v Object -> Key -> Parser (Maybe Tag)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"label"
  parseJSON Value
_            = Parser Quad
forall a. Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

data Shape = Shape
    { Shape -> [Node]
nodes :: ![Node]
    , Shape -> [Link]
links :: ![Link]
    } deriving (Shape -> Shape -> Bool
(Shape -> Shape -> Bool) -> (Shape -> Shape -> Bool) -> Eq Shape
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Shape -> Shape -> Bool
== :: Shape -> Shape -> Bool
$c/= :: Shape -> Shape -> Bool
/= :: Shape -> Shape -> Bool
Eq, Int -> Shape -> ShowS
[Shape] -> ShowS
Shape -> String
(Int -> Shape -> ShowS)
-> (Shape -> String) -> ([Shape] -> ShowS) -> Show Shape
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Shape -> ShowS
showsPrec :: Int -> Shape -> ShowS
$cshow :: Shape -> String
show :: Shape -> String
$cshowList :: [Shape] -> ShowS
showList :: [Shape] -> ShowS
Show)

instance A.FromJSON Shape where
  parseJSON :: Value -> Parser Shape
parseJSON (A.Object Object
v) = do
    Vector Value
vnds <- Object
v Object -> Key -> Parser (Vector Value)
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"nodes"
    [Node]
nds  <- (Value -> Parser Node) -> [Value] -> Parser [Node]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> Parser Node
parseNode ([Value] -> Parser [Node]) -> [Value] -> Parser [Node]
forall a b. (a -> b) -> a -> b
$ Vector Value -> [Value]
forall a. Vector a -> [a]
V.toList Vector Value
vnds
    Vector Value
vlks <- Object
v Object -> Key -> Parser (Vector Value)
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"links"
    [Link]
lks  <- (Value -> Parser Link) -> [Value] -> Parser [Link]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> Parser Link
parseLink ([Value] -> Parser [Link]) -> [Value] -> Parser [Link]
forall a b. (a -> b) -> a -> b
$ Vector Value -> [Value]
forall a. Vector a -> [a]
V.toList Vector Value
vlks
    Shape -> Parser Shape
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return Shape { nodes :: [Node]
nodes = [Node]
nds, links :: [Link]
links = [Link]
lks }
  parseJSON Value
_            = Parser Shape
forall a. Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero

parseNode :: A.Value -> AT.Parser Node
parseNode :: Value -> Parser Node
parseNode (A.Object Object
v) = Integer -> Maybe [Tag] -> Maybe [Tag] -> Bool -> Bool -> Node
Node (Integer -> Maybe [Tag] -> Maybe [Tag] -> Bool -> Bool -> Node)
-> Parser Integer
-> Parser (Maybe [Tag] -> Maybe [Tag] -> Bool -> Bool -> Node)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                       Object
v Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"id"Parser (Maybe [Tag] -> Maybe [Tag] -> Bool -> Bool -> Node)
-> Parser (Maybe [Tag])
-> Parser (Maybe [Tag] -> Bool -> Bool -> Node)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                       Object
v Object -> Key -> Parser (Maybe [Tag])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"tags" Parser (Maybe [Tag] -> Bool -> Bool -> Node)
-> Parser (Maybe [Tag]) -> Parser (Bool -> Bool -> Node)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                       Object
v Object -> Key -> Parser (Maybe [Tag])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"values" Parser (Bool -> Bool -> Node)
-> Parser Bool -> Parser (Bool -> Node)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                       Object
v Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"is_link_node" Parser (Bool -> Node) -> Parser Bool -> Parser Node
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                       Object
v Object -> Key -> Parser Bool
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"is_fixed"
parseNode Value
_            = String -> Parser Node
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Node expected"

parseLink :: AT.Value -> AT.Parser Link
parseLink :: Value -> Parser Link
parseLink (A.Object Object
v) = Integer -> Integer -> Integer -> Link
Link (Integer -> Integer -> Integer -> Link)
-> Parser Integer -> Parser (Integer -> Integer -> Link)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                       Object
v Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"source" Parser (Integer -> Integer -> Link)
-> Parser Integer -> Parser (Integer -> Link)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                       Object
v Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"target" Parser (Integer -> Link) -> Parser Integer -> Parser Link
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                       Object
v Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"link_node"
parseLink Value
_            = String -> Parser Link
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Link expected"

data Node = Node
  { Node -> Integer
id         :: !Integer
  , Node -> Maybe [Tag]
tags       :: !(Maybe [Tag])   -- ^ list of tags from the query
  , Node -> Maybe [Tag]
values     :: !(Maybe [Value]) -- ^ Known values from the query
  , Node -> Bool
isLinkNode :: !Bool            -- ^ Does the node represent the link or the node (the oval shapes)
  , Node -> Bool
isFixed    :: !Bool            -- ^ Is the node a fixed starting point of the query
  } deriving (Node -> Node -> Bool
(Node -> Node -> Bool) -> (Node -> Node -> Bool) -> Eq Node
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
/= :: Node -> Node -> Bool
Eq, 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
$cshowsPrec :: Int -> Node -> ShowS
showsPrec :: Int -> Node -> ShowS
$cshow :: Node -> String
show :: Node -> String
$cshowList :: [Node] -> ShowS
showList :: [Node] -> ShowS
Show)

data Link = Link
  { Link -> Integer
source   :: !Integer -- ^ Node ID
  , Link -> Integer
target   :: !Integer -- ^ Node ID
  , Link -> Integer
linkNode :: !Integer -- ^ Node ID
  } deriving (Link -> Link -> Bool
(Link -> Link -> Bool) -> (Link -> Link -> Bool) -> Eq Link
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Link -> Link -> Bool
== :: Link -> Link -> Bool
$c/= :: Link -> Link -> Bool
/= :: Link -> Link -> Bool
Eq, Int -> Link -> ShowS
[Link] -> ShowS
Link -> String
(Int -> Link -> ShowS)
-> (Link -> String) -> ([Link] -> ShowS) -> Show Link
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Link -> ShowS
showsPrec :: Int -> Link -> ShowS
$cshow :: Link -> String
show :: Link -> String
$cshowList :: [Link] -> ShowS
showList :: [Link] -> ShowS
Show)

type Query = T.Text

type Subject = T.Text

type Predicate = T.Text

type Object = T.Text

type Label = T.Text

type Tag = T.Text

type Value = T.Text