{-# 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
showList :: [CayleyConfig] -> ShowS
$cshowList :: [CayleyConfig] -> ShowS
show :: CayleyConfig -> String
$cshow :: CayleyConfig -> String
showsPrec :: Int -> CayleyConfig -> ShowS
$cshowsPrec :: Int -> CayleyConfig -> ShowS
Show)

-- | CayleyConfig { serverPort = 64210 , serverName = "localhost" , apiVersion = V1 , queryLang  = Gremlin }
defaultCayleyConfig :: CayleyConfig
defaultCayleyConfig :: CayleyConfig
defaultCayleyConfig = CayleyConfig :: Int -> String -> APIVersion -> QueryLang -> CayleyConfig
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 -> Text
subject   :: !T.Text         -- ^ Subject node
  , Quad -> Text
predicate :: !T.Text         -- ^ Predicate node
  , Quad -> Text
object    :: !T.Text         -- ^ Object node
  , Quad -> Maybe Text
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
$cto :: forall x. Rep Quad x -> Quad
$cfrom :: forall x. Quad -> Rep Quad x
Generic)

instance Binary Quad

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

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

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

instance A.FromJSON Quad where
  parseJSON :: Value -> Parser Quad
parseJSON (A.Object Object
v) =
    Text -> Text -> Text -> Maybe Text -> Quad
Quad (Text -> Text -> Text -> Maybe Text -> Quad)
-> Parser Text -> Parser (Text -> Text -> Maybe Text -> Quad)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"subject" Parser (Text -> Text -> Maybe Text -> Quad)
-> Parser Text -> Parser (Text -> Maybe Text -> Quad)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"predicate" Parser (Text -> Maybe Text -> Quad)
-> Parser Text -> Parser (Maybe Text -> Quad)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"object" Parser (Maybe Text -> Quad) -> Parser (Maybe Text) -> Parser Quad
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"label"
  parseJSON Value
_            = Parser Quad
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
/= :: Shape -> Shape -> Bool
$c/= :: Shape -> Shape -> Bool
== :: Shape -> Shape -> Bool
$c== :: 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
showList :: [Shape] -> ShowS
$cshowList :: [Shape] -> ShowS
show :: Shape -> String
$cshow :: Shape -> String
showsPrec :: Int -> Shape -> ShowS
$cshowsPrec :: Int -> 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)
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)
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 (m :: * -> *) a. Monad m => a -> m a
return Shape :: [Node] -> [Link] -> Shape
Shape { nodes :: [Node]
nodes = [Node]
nds, links :: [Link]
links = [Link]
lks }
  parseJSON Value
_            = Parser Shape
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 [Text] -> Maybe [Text] -> Bool -> Bool -> Node
Node (Integer -> Maybe [Text] -> Maybe [Text] -> Bool -> Bool -> Node)
-> Parser Integer
-> Parser (Maybe [Text] -> Maybe [Text] -> 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 [Text] -> Maybe [Text] -> Bool -> Bool -> Node)
-> Parser (Maybe [Text])
-> Parser (Maybe [Text] -> Bool -> Bool -> Node)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                       Object
v Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"tags" Parser (Maybe [Text] -> Bool -> Bool -> Node)
-> Parser (Maybe [Text]) -> Parser (Bool -> Bool -> Node)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
                       Object
v Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"values" Parser (Bool -> Bool -> Node)
-> Parser Bool -> Parser (Bool -> Node)
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 (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 (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 (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 (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 (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Link expected"

data Node = Node
  { Node -> Integer
id           :: !Integer
  , Node -> Maybe [Text]
tags         :: !(Maybe [Tag])   -- ^ list of tags from the query
  , Node -> Maybe [Text]
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
/= :: Node -> Node -> Bool
$c/= :: Node -> Node -> Bool
== :: Node -> Node -> Bool
$c== :: 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
showList :: [Node] -> ShowS
$cshowList :: [Node] -> ShowS
show :: Node -> String
$cshow :: Node -> String
showsPrec :: Int -> Node -> ShowS
$cshowsPrec :: Int -> 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
/= :: Link -> Link -> Bool
$c/= :: Link -> Link -> Bool
== :: Link -> Link -> Bool
$c== :: 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
showList :: [Link] -> ShowS
$cshowList :: [Link] -> ShowS
show :: Link -> String
$cshow :: Link -> String
showsPrec :: Int -> Link -> ShowS
$cshowsPrec :: Int -> 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