diff --git a/Database/Cayley/Client.hs b/Database/Cayley/Client.hs --- a/Database/Cayley/Client.hs +++ b/Database/Cayley/Client.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings, FlexibleContexts, RecordWildCards #-} module Database.Cayley.Client ( Quad (..) @@ -7,14 +7,16 @@ , connectCayley , query -- * REST API operations + , write , writeQuad - , deleteQuad , writeQuads - , deleteQuads , writeNQuadFile + , delete + , deleteQuad + , deleteQuads -- * Utils - , isValid , createQuad + , isValid , successfulResults ) where @@ -42,25 +44,25 @@ connectCayley c = newManager defaultManagerSettings >>= \m -> return $ CayleyConnection (c,m) --- | Perform a query in Gremlin graph query language per default (or in MQL). +-- | 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 -> T.Text -> IO (Either String A.Value) +query :: CayleyConnection -> Query -> IO (Either String A.Value) query c q = runReaderT (doQuery (getManager c) (encodeUtf8 q)) (getConfig c) where doQuery m q = do - c <- ask + CayleyConfig {..} <- ask r <- apiRequest m ("http://" - ++ serverName c + ++ serverName ++ "/api/v" - ++ show (apiVersion c) + ++ show apiVersion ++ "/query/" - ++ show (queryLang c)) - (serverPort c) (RequestBodyBS q) + ++ show queryLang) + serverPort (RequestBodyBS q) return $ case r of Just a -> case a ^? key "result" of @@ -72,8 +74,8 @@ A.Success s -> Left s A.Error e -> Left e Nothing -> - Left "No JSON response from Cayley" - Nothing -> Left "Can't get any response from Cayley" + Left "No JSON response from Cayley server" + Nothing -> Left "Can't get any response from Cayley server" -- | Write a 'Quad' with the given subject, predicate, object and optional -- label. Throw result or extract amount of query 'successfulResults' @@ -82,40 +84,38 @@ -- >λ> writeQuad conn "Humphrey" "loves" "Lauren" (Just "In love") -- >Just (Object (fromList [("result",String "Successfully wrote 1 quads.")])) -- -writeQuad :: CayleyConnection - -> T.Text -- ^ Subject node - -> T.Text -- ^ Predicate node - -> T.Text -- ^ Object node - -> Maybe T.Text -- ^ Label node - -> IO (Maybe A.Value) +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 - -> T.Text -- ^ Subject node - -> T.Text -- ^ Predicate node - -> T.Text -- ^ Object node - -> Maybe T.Text -- ^ Label node - -> IO (Maybe A.Value) +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 c qs = runReaderT (write (getManager c) qs) (getConfig c) where write m qs = do - c <- ask + CayleyConfig {..} <- ask apiRequest m ("http://" - ++ serverName c + ++ serverName ++ "/api/v" - ++ show (apiVersion c) + ++ show apiVersion ++ "/write") - (serverPort c) (toRequestBody qs) + serverPort (toRequestBody qs) -- | Delete the given list of 'Quad'(s). deleteQuads :: CayleyConnection -> [Quad] -> IO (Maybe A.Value) @@ -123,14 +123,14 @@ runReaderT (delete (getManager c) qs) (getConfig c) where delete m qs = do - c <- ask + CayleyConfig {..} <- ask apiRequest m ("http://" - ++ serverName c + ++ serverName ++ "/api/v" - ++ show (apiVersion c) + ++ show apiVersion ++ "/delete") - (serverPort c) + serverPort (toRequestBody qs) -- | Write a N-Quad file. @@ -142,13 +142,13 @@ runReaderT (writenq (getManager c) p) (getConfig c) where writenq m p = do - c <- ask + CayleyConfig {..} <- ask r <- parseUrl ("http://" - ++ serverName c + ++ serverName ++ "/api/v" - ++ show (apiVersion c) + ++ show apiVersion ++ "/write/file/nquad") - >>= \r -> return r { port = serverPort c} + >>= \r -> return r { port = serverPort } t <- liftIO $ try $ flip httpLbs m @@ -160,18 +160,18 @@ -- | A valid 'Quad' has its subject, predicate and object not empty. isValid :: Quad -> Bool -isValid q = T.empty `notElem` [subject q, predicate q, object q] +isValid Quad {..} = T.empty `notElem` [subject, predicate, object] -- | Given a subject, a predicate, an object and an optional label, -- create a valid 'Quad'. -createQuad :: T.Text -> T.Text -> T.Text -> Maybe T.Text -> Maybe 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 successful results from a write/delete 'Quad'(s) --- operation. +-- operation, or an explicite error message. -- -- >λ> writeNQuadFile conn "testdata.nq" >>= successfulResults -- >Right 11 @@ -195,8 +195,8 @@ case A.fromJSON e of A.Success s -> Left s A.Error e -> Left e - Nothing -> Left "No JSON response from Cayley" - Nothing -> Left "Can't get any response from Cayley" + Nothing -> Left "No JSON response from Cayley server" + Nothing -> Left "Can't get any response from Cayley server" where getAmount = do AT.string "Successfully " diff --git a/Database/Cayley/Internal.hs b/Database/Cayley/Internal.hs --- a/Database/Cayley/Internal.hs +++ b/Database/Cayley/Internal.hs @@ -13,17 +13,17 @@ import Database.Cayley.Types apiRequest :: Manager - -> String - -> Int - -> RequestBody - -> ReaderT CayleyConfig IO (Maybe A.Value) + -> String + -> Int + -> RequestBody + -> ReaderT CayleyConfig IO (Maybe A.Value) apiRequest m u p b = do r <- parseUrl 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 -> + Left e -> return $ Just $ A.object ["error" A..= T.pack (show (e :: SomeException))] @@ -34,3 +34,4 @@ getManager (CayleyConnection (_,m)) = m getConfig (CayleyConnection (c,_)) = c + diff --git a/Database/Cayley/Types.hs b/Database/Cayley/Types.hs --- a/Database/Cayley/Types.hs +++ b/Database/Cayley/Types.hs @@ -35,7 +35,7 @@ } data CayleyConnection = CayleyConnection (CayleyConfig,Manager) - + data Quad = Quad { subject :: T.Text -- ^ Subject node , predicate :: T.Text -- ^ Predicate node @@ -77,3 +77,14 @@ v A..: "object" <*> v A..: "label" parseJSON _ = mzero + +type Query = T.Text + +type Subject = T.Text + +type Predicate = T.Text + +type Object = T.Text + +type Label = T.Text + diff --git a/cayley-client.cabal b/cayley-client.cabal --- a/cayley-client.cabal +++ b/cayley-client.cabal @@ -1,5 +1,5 @@ name: cayley-client -version: 0.1.4.0 +version: 0.1.5.0 stability: Experimental synopsis: A Haskell client for the Cayley graph database description: cayley-client implements the RESTful API of the Cayley graph database. @@ -8,7 +8,7 @@ license-file: LICENSE author: Michel Boucey maintainer: michel.boucey@gmail.com -copyright: Copyright © 2015 - Michel Boucey +copyright: Copyright © 2015-2016 - Michel Boucey category: Database build-type: Simple cabal-version: >=1.10