cayley-client 0.4.19.4 → 0.4.19.5
raw patch · 9 files changed
+435/−421 lines, 9 filesdep ~aesonPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: aeson
API changes (from Hackage documentation)
Files
- Database/Cayley/Client.hs +0/−231
- Database/Cayley/Client/Internal.hs +0/−32
- Database/Cayley/Types.hs +0/−148
- LICENSE +1/−1
- README.md +1/−1
- cayley-client.cabal +22/−8
- src/Database/Cayley/Client.hs +231/−0
- src/Database/Cayley/Client/Internal.hs +32/−0
- src/Database/Cayley/Types.hs +148/−0
− Database/Cayley/Client.hs
@@ -1,231 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE RecordWildCards #-}--module Database.Cayley.Client (-- Quad (..)-- -- * Connection- , defaultCayleyConfig- , connectCayley-- -- * Operations- , query- , Shape- , queryShape- , write- , writeQuad- , writeQuads- , writeNQuadFile- , delete- , deleteQuad- , deleteQuads-- -- * Utils- , createQuad- , isValid- , results-- ) where--import Control.Applicative ((<|>))-import Control.Lens.Fold ((^?))-import Control.Monad.Catch-import Control.Monad.Reader-import qualified Data.Aeson as A-import qualified Data.Aeson.Lens as L-import qualified Data.Attoparsec.Text as APT-import qualified Data.Text as T-import Data.Text.Encoding (encodeUtf8)-import Network.HTTP.Client-import Network.HTTP.Client.MultipartFormData--import Database.Cayley.Client.Internal-import Database.Cayley.Types---- | Get a connection to Cayley with the given configuration.------ >λ> conn <- connectCayley defaultCayleyConfig----connectCayley :: CayleyConfig -> IO CayleyConnection-connectCayley c =- newManager defaultManagerSettings- >>= \m -> return $ CayleyConnection { cayleyConfig = c, manager = m }---- | Perform a query, in Gremlin graph query language per default (or in MQL).------ >λ> query conn "graph.Vertex('Humphrey Bogart').In('name').All()"--- >Right (Array (fromList [Object (fromList [("id",String "/en/humphrey_bogart")])]))----query :: CayleyConnection- -> Query- -> IO (Either String A.Value)-query CayleyConnection{..} =- doQuery manager cayleyConfig- where- doQuery m CayleyConfig{..} q = do- r <- apiRequest- m (urlBase serverName apiVersion- ++ "/query/" ++ show queryLang)- serverPort (RequestBodyBS $ encodeUtf8 q)- return $- case r of- Just a ->- case a ^? L.key "result" of- Just v -> Right v- Nothing ->- case a ^? L.key "error" . L._String of- Just e -> Left (show e)- Nothing -> Left "No JSON response from Cayley server"- Nothing -> Left "Can't get any response from Cayley server"---- | Return the description of the given executed query.-queryShape :: CayleyConnection- -> Query- -> IO (Either String Shape)-queryShape CayleyConnection{..} =- doShape manager cayleyConfig- where- doShape m CayleyConfig{..} q = do- r <- apiRequest- m (urlBase serverName apiVersion ++ "/shape/" ++ show queryLang)- serverPort (RequestBodyBS $ encodeUtf8 q)- return $- case r of- Just o ->- case A.fromJSON o of- A.Success s -> Right s- A.Error e -> Left ("Not a shape (\"" ++ e ++ "\")")- Nothing -> Left "API request error"---- | Write a 'Quad' with the given subject, predicate, object and optional--- label. Throw result or extract amount of query 'results'--- from it.------ >λ> writeQuad conn "Humphrey" "loves" "Lauren" (Just "In love")--- >Just (Object (fromList [("result",String "Successfully wrote 1 quads.")]))----writeQuad :: CayleyConnection- -> Subject- -> Predicate- -> Object- -> Maybe Label- -> IO (Maybe A.Value)-writeQuad c s p o l =- writeQuads c [Quad { subject = s, predicate = p, object = o, label = l }]---- | Write the given 'Quad'.-write :: CayleyConnection- -> Quad- -> IO (Maybe A.Value)-write c q = writeQuads c [q]---- | Delete the 'Quad' defined by the given subject, predicate, object--- and optional label.-deleteQuad :: CayleyConnection- -> Subject- -> Predicate- -> Object- -> Maybe Label- -> IO (Maybe A.Value)-deleteQuad c s p o l =- deleteQuads c [Quad { subject = s, predicate = p, object = o, label = l }]---- | Delete the given 'Quad'.-delete :: CayleyConnection -> Quad -> IO (Maybe A.Value)-delete c q = deleteQuads c [q]---- | Write the given list of 'Quad'(s).-writeQuads :: CayleyConnection- -> [Quad]- -> IO (Maybe A.Value)-writeQuads CayleyConnection{..} =- writeQuads' manager cayleyConfig- where- writeQuads' m CayleyConfig{..} qs =- apiRequest- m (urlBase serverName apiVersion ++ "/write")- serverPort (toRequestBody qs)---- | Delete the given list of 'Quad'(s).-deleteQuads :: CayleyConnection- -> [Quad]- -> IO (Maybe A.Value)-deleteQuads CayleyConnection{..} =- doDeletions manager cayleyConfig- where- doDeletions m CayleyConfig{..} qs =- apiRequest- m (urlBase serverName apiVersion ++ "/delete")- serverPort (toRequestBody qs)---- | Write a N-Quad file.------ >λ> writeNQuadFile conn "testdata.nq"--- >Just (Object (fromList [("result",String "Successfully wrote 11 quads.")]))----writeNQuadFile :: (MonadThrow m, MonadIO m)- => CayleyConnection- -> FilePath- -> m (Maybe A.Value)-writeNQuadFile CayleyConnection{..} =- doWrite manager cayleyConfig- where- doWrite m CayleyConfig{..} fp = do- r <- parseRequest (urlBase serverName apiVersion ++ "/write/file/nquad")- >>= \r -> return r { port = serverPort }- t <- liftIO $- try $- flip httpLbs m- =<< formDataBody [partFileSource "NQuadFile" fp] r- return $- case t of- Right b -> A.decode (responseBody b)- Left e -> Just $- A.object ["error" A..= T.pack (show (e :: SomeException))]---- | A valid 'Quad' has its subject, predicate and object not empty.-isValid :: Quad -> Bool-isValid Quad{..} = T.empty `notElem` [subject, predicate, object]---- | Given a subject, a predicate, an object and an optional label,--- create a valid 'Quad'.-createQuad :: Subject- -> Predicate- -> Object- -> Maybe Label- -> Maybe Quad-createQuad s p o l =- if T.empty `notElem` [s,p,o]- then Just Quad { subject = s, predicate = p, object = o, label = l }- else Nothing---- | Get amount of results from a write/delete 'Quad'(s) operation,--- or an explicite error message.------ >λ> writeNQuadFile conn "testdata.nq" >>= results--- >Right 11----results :: Maybe A.Value- -> IO (Either String Int)-results m = return $- case m of- Just v ->- case v ^? L.key "result" . L._String of- Just r ->- case APT.parse getAmount r of- APT.Done "" i -> Right i- _ -> Left "Can't get amount of results"- Nothing ->- case v ^? L.key "error" . L._String of- Just e -> Left (show e)- Nothing -> Left "No JSON response from Cayley server"- Nothing -> Left "Can't get any response from Cayley server"- where- getAmount = do- _ <- APT.string "Successfully "- _ <- APT.string "deleted " <|> APT.string "wrote "- a <- APT.decimal- _ <- APT.string " quads."- return a-
− Database/Cayley/Client/Internal.hs
@@ -1,32 +0,0 @@-module Database.Cayley.Client.Internal where--import Control.Monad.Catch-import Control.Monad.IO.Class-import qualified Data.Aeson as A-import qualified Data.Text as T (pack)-import Data.Vector (fromList)-import Network.HTTP.Client--import Database.Cayley.Types--apiRequest :: Manager- -> String- -> Int- -> RequestBody- -> IO (Maybe A.Value)-apiRequest m u p b = do- r <- parseRequest u >>= \c ->- return c { method = "POST", port = p, requestBody = b }- t <- liftIO (try $ httpLbs r m)- case t of- Right r' -> return (A.decode $ responseBody r')- Left e ->- return $- Just $ A.object ["error" A..= T.pack (show (e :: SomeException))]--toRequestBody :: [Quad] -> RequestBody-toRequestBody = RequestBodyLBS . A.encode . fromList . map A.toJSON--urlBase :: String -> APIVersion -> String-urlBase s a = "http://" ++ s ++ "/api/v" ++ show a-
− Database/Cayley/Types.hs
@@ -1,148 +0,0 @@-{-# 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 V1 = "1"--data QueryLang = Gremlin | MQL--instance Show QueryLang where- show Gremlin = "gremlin"- show MQL = "mql"--data CayleyConfig = CayleyConfig- { serverPort :: !Int- , serverName :: !String- , apiVersion :: !APIVersion- , queryLang :: !QueryLang- } deriving (Show)---- | CayleyConfig { serverPort = 64210 , serverName = "localhost" , apiVersion = V1 , queryLang = Gremlin }-defaultCayleyConfig :: CayleyConfig-defaultCayleyConfig = CayleyConfig- { serverPort = 64210- , serverName = "localhost"- , apiVersion = V1- , queryLang = Gremlin- }--data CayleyConnection = CayleyConnection- { cayleyConfig :: !CayleyConfig- , manager :: !Manager- }--data Quad = Quad- { subject :: !T.Text -- ^ Subject node- , predicate :: !T.Text -- ^ Predicate node- , object :: !T.Text -- ^ Object node- , label :: !(Maybe T.Text) -- ^ Label node- } deriving (Generic)--instance Binary Quad--instance Show Quad where- show (Quad s p o (Just l)) = T.unpack s- ++ " -- "- ++ T.unpack p- ++ " -> "- ++ T.unpack o- ++ " ("- ++ T.unpack l- ++ ")"- show (Quad s p o Nothing) = T.unpack s- ++ " -- "- ++ T.unpack p- ++ " -> "- ++ T.unpack o---- | Two quads are equals when subject, predicate, object /and/ label are equals.-instance Eq Quad where- Quad s p o l == Quad s' p' o' l' = s == s' && p == p' && o == o' && l == l'--instance A.ToJSON Quad where- toJSON (Quad s p o l) =- A.object [ "subject" A..= s- , "predicate" A..= p- , "object" A..= o- , "label" A..= l- ]--instance A.FromJSON Quad where- parseJSON (A.Object v) =- Quad <$>- v A..: "subject" <*>- v A..: "predicate" <*>- v A..: "object" <*>- v A..:? "label"- parseJSON _ = mzero--data Shape = Shape- { nodes :: ![Node]- , links :: ![Link]- } deriving (Eq, Show)--instance A.FromJSON Shape where- parseJSON (A.Object v) = do- vnds <- v A..: "nodes"- nds <- mapM parseNode $ V.toList vnds- vlks <- v A..: "links"- lks <- mapM parseLink $ V.toList vlks- return Shape { nodes = nds, links = lks }- parseJSON _ = mzero--parseNode :: A.Value -> AT.Parser Node-parseNode (A.Object v) = Node <$>- v A..: "id"<*>- v A..:? "tags" <*>- v A..:? "values" <*>- v A..: "is_link_node" <*>- v A..: "is_fixed"-parseNode _ = fail "Node expected"--parseLink :: AT.Value -> AT.Parser Link-parseLink (A.Object v) = Link <$>- v A..: "source" <*>- v A..: "target" <*>- v A..: "link_node"-parseLink _ = fail "Link expected"--data Node = Node- { id :: !Integer- , tags :: !(Maybe [Tag]) -- ^ list of tags from the query- , values :: !(Maybe [Value]) -- ^ Known values from the query- , isLinkNode :: !Bool -- ^ Does the node represent the link or the node (the oval shapes)- , isFixed :: !Bool -- ^ Is the node a fixed starting point of the query- } deriving (Eq, Show)--data Link = Link- { source :: !Integer -- ^ Node ID- , target :: !Integer -- ^ Node ID- , linkNode :: !Integer -- ^ Node ID- } deriving (Eq, 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-
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2015-2016, Michel Boucey+Copyright (c) 2015-2025, Michel Boucey All rights reserved. Redistribution and use in source and binary forms, with or without
README.md view
@@ -1,4 +1,4 @@-# A Cayley client for Haskell +# A Cayley client for Haskell  [](https://hackage.haskell.org/package/cayley-client) Cayley-client up to 0.4.* implements the [RESTful API](https://github.com/google/cayley/blob/master/docs/HTTP.md) of [Cayley database graph](https://github.com/google/cayley) up to v0.6.0. [Cayley v0.6.1](https://github.com/cayleygraph/cayley/releases/tag/v0.6.1) "includes all the pending features that can be merged before v0.7, which will be a major release [...] and may cause breaking changes".
cayley-client.cabal view
@@ -1,5 +1,5 @@ name: cayley-client-version: 0.4.19.4+version: 0.4.19.5 synopsis: A Haskell client for the Cayley graph database description: cayley-client implements the RESTful API of the Cayley graph database. homepage: https://github.com/MichelBoucey/cayley-client@@ -7,38 +7,52 @@ license-file: LICENSE author: Michel Boucey maintainer: michel.boucey@gmail.com-copyright: (c) 2015-2024 - Michel Boucey+copyright: (c) 2015-2025 - Michel Boucey category: Database build-type: Simple cabal-version: >=1.10 extra-source-files: README.md , tests/testdata.nq -Tested-With: GHC ==8.10.7 || ==9.0.2 || ==9.2.8 || ==9.4.8 || ==9.6.5 || ==9.8.2+Tested-With:+ GHC ==8.8.4+ || ==8.10.7+ || ==9.0.2+ || ==9.2.8+ || ==9.4.8+ || ==9.6.7+ || ==9.8.4+ || ==9.10.2+ || ==9.12.2+ || ==9.14.1 Source-Repository head Type: git Location: https://github.com/MichelBoucey/cayley-client.git library+ hs-source-dirs: src/ exposed-modules: Database.Cayley.Client , Database.Cayley.Types other-modules: Database.Cayley.Client.Internal default-extensions: OverloadedStrings++ if !impl(ghc >=9.4.8)+ build-depends: bytestring >= 0.10.6 && < 0.13+ , http-conduit >= 2.1.8 && < 2.4+ , transformers >= 0.4.2 && < 0.7+ , unordered-containers >= 0.2.5.1 && < 0.3+ build-depends: aeson >= 2 && < 2.3 , attoparsec >= 0.12 && < 0.15 , base >= 4.8.1.0 && < 5- , bytestring >= 0.10.6 && < 0.13- , binary >= 0.7.5 && < 0.13 , exceptions >= 0.8.0.2 && < 0.11+ , binary >= 0.7.5 && < 0.13 , http-client >= 0.4.30 && < 0.8- , http-conduit >= 2.1.8 && < 2.4 , lens >= 4.12.3 && < 5.4 , mtl >= 2.2.1 && < 2.4 , lens-aeson >= 1.1 && < 1.3 , text >= 1.2.2 && < 2.3- , transformers >= 0.4.2 && < 0.7- , unordered-containers >= 0.2.5.1 && < 0.3 , vector >= 0.9 && < 0.14 default-language: Haskell2010
+ src/Database/Cayley/Client.hs view
@@ -0,0 +1,231 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RecordWildCards #-}++module Database.Cayley.Client (++ Quad (..)++ -- * Connection+ , defaultCayleyConfig+ , connectCayley++ -- * Operations+ , query+ , Shape+ , queryShape+ , write+ , writeQuad+ , writeQuads+ , writeNQuadFile+ , delete+ , deleteQuad+ , deleteQuads++ -- * Utils+ , createQuad+ , isValid+ , results++ ) where++import Control.Applicative ((<|>))+import Control.Lens.Fold ((^?))+import Control.Monad.Catch+import Control.Monad.Reader+import qualified Data.Aeson as A+import qualified Data.Aeson.Lens as L+import qualified Data.Attoparsec.Text as APT+import qualified Data.Text as T+import Data.Text.Encoding (encodeUtf8)+import Network.HTTP.Client+import Network.HTTP.Client.MultipartFormData++import Database.Cayley.Client.Internal+import Database.Cayley.Types++-- | Get a connection to Cayley with the given configuration.+--+-- >λ> conn <- connectCayley defaultCayleyConfig+--+connectCayley :: CayleyConfig -> IO CayleyConnection+connectCayley c =+ newManager defaultManagerSettings+ >>= \m -> return $ CayleyConnection { cayleyConfig = c, manager = m }++-- | Perform a query, in Gremlin graph query language per default (or in MQL).+--+-- >λ> query conn "graph.Vertex('Humphrey Bogart').In('name').All()"+-- >Right (Array (fromList [Object (fromList [("id",String "/en/humphrey_bogart")])]))+--+query :: CayleyConnection+ -> Query+ -> IO (Either String A.Value)+query CayleyConnection{..} =+ doQuery manager cayleyConfig+ where+ doQuery m CayleyConfig{..} q = do+ r <- apiRequest+ m (urlBase serverName apiVersion+ ++ "/query/" ++ show queryLang)+ serverPort (RequestBodyBS $ encodeUtf8 q)+ return $+ case r of+ Just a ->+ case a ^? L.key "result" of+ Just v -> Right v+ Nothing ->+ case a ^? L.key "error" . L._String of+ Just e -> Left (show e)+ Nothing -> Left "No JSON response from Cayley server"+ Nothing -> Left "Can't get any response from Cayley server"++-- | Return the description of the given executed query.+queryShape :: CayleyConnection+ -> Query+ -> IO (Either String Shape)+queryShape CayleyConnection{..} =+ doShape manager cayleyConfig+ where+ doShape m CayleyConfig{..} q = do+ r <- apiRequest+ m (urlBase serverName apiVersion ++ "/shape/" ++ show queryLang)+ serverPort (RequestBodyBS $ encodeUtf8 q)+ return $+ case r of+ Just o ->+ case A.fromJSON o of+ A.Success s -> Right s+ A.Error e -> Left ("Not a shape (\"" ++ e ++ "\")")+ Nothing -> Left "API request error"++-- | Write a 'Quad' with the given subject, predicate, object and optional+-- label. Throw result or extract amount of query 'results'+-- from it.+--+-- >λ> writeQuad conn "Humphrey" "loves" "Lauren" (Just "In love")+-- >Just (Object (fromList [("result",String "Successfully wrote 1 quads.")]))+--+writeQuad :: CayleyConnection+ -> Subject+ -> Predicate+ -> Object+ -> Maybe Label+ -> IO (Maybe A.Value)+writeQuad c s p o l =+ writeQuads c [Quad { subject = s, predicate = p, object = o, label = l }]++-- | Write the given 'Quad'.+write :: CayleyConnection+ -> Quad+ -> IO (Maybe A.Value)+write c q = writeQuads c [q]++-- | Delete the 'Quad' defined by the given subject, predicate, object+-- and optional label.+deleteQuad :: CayleyConnection+ -> Subject+ -> Predicate+ -> Object+ -> Maybe Label+ -> IO (Maybe A.Value)+deleteQuad c s p o l =+ deleteQuads c [Quad { subject = s, predicate = p, object = o, label = l }]++-- | Delete the given 'Quad'.+delete :: CayleyConnection -> Quad -> IO (Maybe A.Value)+delete c q = deleteQuads c [q]++-- | Write the given list of 'Quad'(s).+writeQuads :: CayleyConnection+ -> [Quad]+ -> IO (Maybe A.Value)+writeQuads CayleyConnection{..} =+ writeQuads' manager cayleyConfig+ where+ writeQuads' m CayleyConfig{..} qs =+ apiRequest+ m (urlBase serverName apiVersion ++ "/write")+ serverPort (toRequestBody qs)++-- | Delete the given list of 'Quad'(s).+deleteQuads :: CayleyConnection+ -> [Quad]+ -> IO (Maybe A.Value)+deleteQuads CayleyConnection{..} =+ doDeletions manager cayleyConfig+ where+ doDeletions m CayleyConfig{..} qs =+ apiRequest+ m (urlBase serverName apiVersion ++ "/delete")+ serverPort (toRequestBody qs)++-- | Write a N-Quad file.+--+-- >λ> writeNQuadFile conn "testdata.nq"+-- >Just (Object (fromList [("result",String "Successfully wrote 11 quads.")]))+--+writeNQuadFile :: (MonadThrow m, MonadIO m)+ => CayleyConnection+ -> FilePath+ -> m (Maybe A.Value)+writeNQuadFile CayleyConnection{..} =+ doWrite manager cayleyConfig+ where+ doWrite m CayleyConfig{..} fp = do+ r <- parseRequest (urlBase serverName apiVersion ++ "/write/file/nquad")+ >>= \r -> return r { port = serverPort }+ t <- liftIO $+ try $+ flip httpLbs m+ =<< formDataBody [partFileSource "NQuadFile" fp] r+ return $+ case t of+ Right b -> A.decode (responseBody b)+ Left e -> Just $+ A.object ["error" A..= T.pack (show (e :: SomeException))]++-- | A valid 'Quad' has its subject, predicate and object not empty.+isValid :: Quad -> Bool+isValid Quad{..} = T.empty `notElem` [subject, predicate, object]++-- | Given a subject, a predicate, an object and an optional label,+-- create a valid 'Quad'.+createQuad :: Subject+ -> Predicate+ -> Object+ -> Maybe Label+ -> Maybe Quad+createQuad s p o l =+ if T.empty `notElem` [s,p,o]+ then Just Quad { subject = s, predicate = p, object = o, label = l }+ else Nothing++-- | Get amount of results from a write/delete 'Quad'(s) operation,+-- or an explicite error message.+--+-- >λ> writeNQuadFile conn "testdata.nq" >>= results+-- >Right 11+--+results :: Maybe A.Value+ -> IO (Either String Int)+results m = return $+ case m of+ Just v ->+ case v ^? L.key "result" . L._String of+ Just r ->+ case APT.parse getAmount r of+ APT.Done "" i -> Right i+ _ -> Left "Can't get amount of results"+ Nothing ->+ case v ^? L.key "error" . L._String of+ Just e -> Left (show e)+ Nothing -> Left "No JSON response from Cayley server"+ Nothing -> Left "Can't get any response from Cayley server"+ where+ getAmount = do+ _ <- APT.string "Successfully "+ _ <- APT.string "deleted " <|> APT.string "wrote "+ a <- APT.decimal+ _ <- APT.string " quads."+ return a+
+ src/Database/Cayley/Client/Internal.hs view
@@ -0,0 +1,32 @@+module Database.Cayley.Client.Internal where++import Control.Monad.Catch+import Control.Monad.IO.Class+import qualified Data.Aeson as A+import qualified Data.Text as T (pack)+import Data.Vector (fromList)+import Network.HTTP.Client++import Database.Cayley.Types++apiRequest :: Manager+ -> String+ -> Int+ -> RequestBody+ -> IO (Maybe A.Value)+apiRequest m u p b = do+ r <- parseRequest u >>= \c ->+ return c { method = "POST", port = p, requestBody = b }+ t <- liftIO (try $ httpLbs r m)+ case t of+ Right r' -> return (A.decode $ responseBody r')+ Left e ->+ return $+ Just $ A.object ["error" A..= T.pack (show (e :: SomeException))]++toRequestBody :: [Quad] -> RequestBody+toRequestBody = RequestBodyLBS . A.encode . fromList . map A.toJSON++urlBase :: String -> APIVersion -> String+urlBase s a = "http://" ++ s ++ "/api/v" ++ show a+
+ src/Database/Cayley/Types.hs view
@@ -0,0 +1,148 @@+{-# 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 V1 = "1"++data QueryLang = Gremlin | MQL++instance Show QueryLang where+ show Gremlin = "gremlin"+ show MQL = "mql"++data CayleyConfig = CayleyConfig+ { serverPort :: !Int+ , serverName :: !String+ , apiVersion :: !APIVersion+ , queryLang :: !QueryLang+ } deriving (Show)++-- | CayleyConfig { serverPort = 64210 , serverName = "localhost" , apiVersion = V1 , queryLang = Gremlin }+defaultCayleyConfig :: CayleyConfig+defaultCayleyConfig = CayleyConfig+ { serverPort = 64210+ , serverName = "localhost"+ , apiVersion = V1+ , queryLang = Gremlin+ }++data CayleyConnection = CayleyConnection+ { cayleyConfig :: !CayleyConfig+ , manager :: !Manager+ }++data Quad = Quad+ { subject :: !T.Text -- ^ Subject node+ , predicate :: !T.Text -- ^ Predicate node+ , object :: !T.Text -- ^ Object node+ , label :: !(Maybe T.Text) -- ^ Label node+ } deriving (Generic)++instance Binary Quad++instance Show Quad where+ show (Quad s p o (Just l)) = T.unpack s+ ++ " -- "+ ++ T.unpack p+ ++ " -> "+ ++ T.unpack o+ ++ " ("+ ++ T.unpack l+ ++ ")"+ show (Quad s p o Nothing) = T.unpack s+ ++ " -- "+ ++ T.unpack p+ ++ " -> "+ ++ T.unpack o++-- | Two quads are equals when subject, predicate, object /and/ label are equals.+instance Eq Quad where+ Quad s p o l == Quad s' p' o' l' = s == s' && p == p' && o == o' && l == l'++instance A.ToJSON Quad where+ toJSON (Quad s p o l) =+ A.object [ "subject" A..= s+ , "predicate" A..= p+ , "object" A..= o+ , "label" A..= l+ ]++instance A.FromJSON Quad where+ parseJSON (A.Object v) =+ Quad <$>+ v A..: "subject" <*>+ v A..: "predicate" <*>+ v A..: "object" <*>+ v A..:? "label"+ parseJSON _ = mzero++data Shape = Shape+ { nodes :: ![Node]+ , links :: ![Link]+ } deriving (Eq, Show)++instance A.FromJSON Shape where+ parseJSON (A.Object v) = do+ vnds <- v A..: "nodes"+ nds <- mapM parseNode $ V.toList vnds+ vlks <- v A..: "links"+ lks <- mapM parseLink $ V.toList vlks+ return Shape { nodes = nds, links = lks }+ parseJSON _ = mzero++parseNode :: A.Value -> AT.Parser Node+parseNode (A.Object v) = Node <$>+ v A..: "id"<*>+ v A..:? "tags" <*>+ v A..:? "values" <*>+ v A..: "is_link_node" <*>+ v A..: "is_fixed"+parseNode _ = fail "Node expected"++parseLink :: AT.Value -> AT.Parser Link+parseLink (A.Object v) = Link <$>+ v A..: "source" <*>+ v A..: "target" <*>+ v A..: "link_node"+parseLink _ = fail "Link expected"++data Node = Node+ { id :: !Integer+ , tags :: !(Maybe [Tag]) -- ^ list of tags from the query+ , values :: !(Maybe [Value]) -- ^ Known values from the query+ , isLinkNode :: !Bool -- ^ Does the node represent the link or the node (the oval shapes)+ , isFixed :: !Bool -- ^ Is the node a fixed starting point of the query+ } deriving (Eq, Show)++data Link = Link+ { source :: !Integer -- ^ Node ID+ , target :: !Integer -- ^ Node ID+ , linkNode :: !Integer -- ^ Node ID+ } deriving (Eq, 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+