{-# LANGUAGE OverloadedStrings #-}
{-# 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)
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
, Quad -> Text
predicate :: !T.Text
, Quad -> Text
object :: !T.Text
, Quad -> Maybe Text
label :: !(Maybe T.Text)
} 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
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])
, Node -> Maybe [Text]
values :: !(Maybe [Value])
, Node -> Bool
isLinkNode :: !Bool
, Node -> Bool
isFixed :: !Bool
} 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
, Link -> Integer
target :: !Integer
, Link -> Integer
linkNode :: !Integer
} 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