cayley-client 0.1.5.0 → 0.1.5.1
raw patch · 4 files changed
+89/−66 lines, 4 filesdep ~aesondep ~attoparsecdep ~base
Dependency ranges changed: aeson, attoparsec, base, bytestring, exceptions, http-client, http-conduit, lens, lens-aeson, mtl, text, transformers, unordered-containers, vector
Files
- Database/Cayley/Client.hs +46/−40
- Database/Cayley/Internal.hs +12/−10
- Database/Cayley/Types.hs +11/−11
- cayley-client.cabal +20/−5
Database/Cayley/Client.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE OverloadedStrings, FlexibleContexts, RecordWildCards #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} module Database.Cayley.Client ( Quad (..)@@ -19,23 +21,22 @@ , isValid , successfulResults ) where- -import Control.Applicative ((<|>))-import Control.Lens.Fold ((^?))-import Control.Monad.Catch-import Control.Monad.Reader-import qualified Data.Aeson as A-import Data.Aeson.Lens (key)-import qualified Data.Attoparsec.Text as AT-import Data.Maybe (fromJust)-import qualified Data.Text as T-import Data.Text.Encoding (encodeUtf8)-import Network.HTTP.Client-import Network.HTTP.Client.MultipartFormData -import Database.Cayley.Internal-import Database.Cayley.Types+import Control.Applicative ((<|>))+import Control.Lens.Fold ((^?))+import Control.Monad.Catch+import Control.Monad.Reader+import qualified Data.Aeson as A+import Data.Aeson.Lens (key)+import qualified Data.Attoparsec.Text as AT+import qualified Data.Text as T+import Data.Text.Encoding (encodeUtf8)+import Network.HTTP.Client+import Network.HTTP.Client.MultipartFormData +import Database.Cayley.Internal+import Database.Cayley.Types+ -- | Get a connection to Cayley with the given configuration. -- -- >λ> conn <- connectCayley defaultCayleyConfig@@ -53,7 +54,7 @@ query c q = runReaderT (doQuery (getManager c) (encodeUtf8 q)) (getConfig c) where- doQuery m q = do+ doQuery m _q = do CayleyConfig {..} <- ask r <- apiRequest m ("http://"@@ -62,7 +63,7 @@ ++ show apiVersion ++ "/query/" ++ show queryLang)- serverPort (RequestBodyBS q)+ serverPort (RequestBodyBS _q) return $ case r of Just a -> case a ^? key "result" of@@ -72,7 +73,7 @@ Just e -> case A.fromJSON e of A.Success s -> Left s- A.Error e -> Left e+ A.Error _e -> Left _e Nothing -> Left "No JSON response from Cayley server" Nothing -> Left "Can't get any response from Cayley server"@@ -105,24 +106,24 @@ -- | Write the given list of 'Quad'(s). writeQuads :: CayleyConnection -> [Quad] -> IO (Maybe A.Value) writeQuads c qs =- runReaderT (write (getManager c) qs) (getConfig c)+ runReaderT (_write (getManager c) qs) (getConfig c) where- write m qs = do- CayleyConfig {..} <- ask- apiRequest- m ("http://"- ++ serverName- ++ "/api/v"- ++ show apiVersion- ++ "/write")- serverPort (toRequestBody qs)+ _write m _qs = do+ CayleyConfig {..} <- ask+ apiRequest+ m ("http://"+ ++ serverName+ ++ "/api/v"+ ++ show apiVersion+ ++ "/write")+ serverPort (toRequestBody _qs) -- | Delete the given list of 'Quad'(s). deleteQuads :: CayleyConnection -> [Quad] -> IO (Maybe A.Value) deleteQuads c qs =- runReaderT (delete (getManager c) qs) (getConfig c)+ runReaderT (_delete (getManager c) qs) (getConfig c) where- delete m qs = do+ _delete m _qs = do CayleyConfig {..} <- ask apiRequest m ("http://"@@ -131,17 +132,21 @@ ++ show apiVersion ++ "/delete") serverPort- (toRequestBody qs)+ (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 c p = runReaderT (writenq (getManager c) p) (getConfig c) where- writenq m p = do+ writenq m _p = do CayleyConfig {..} <- ask r <- parseUrl ("http://" ++ serverName@@ -152,9 +157,9 @@ t <- liftIO $ try $ flip httpLbs m- =<< formDataBody [partFileSource "NQuadFile" p] r+ =<< formDataBody [partFileSource "NQuadFile" _p] r return $ case t of- Right r -> A.decode $ responseBody r+ Right _r -> A.decode $ responseBody _r Left e -> Just $ A.object ["error" A..= T.pack (show (e :: SomeException))] @@ -185,7 +190,7 @@ case A.fromJSON v of A.Success s -> case AT.parse getAmount s of- AT.Done "" a -> Right a+ AT.Done "" b -> Right b _ -> Left "Can't get amount of successful results" A.Error e -> Left e@@ -194,13 +199,14 @@ Just e -> case A.fromJSON e of A.Success s -> Left s- A.Error e -> Left e+ A.Error r -> Left r Nothing -> Left "No JSON response from Cayley server" Nothing -> Left "Can't get any response from Cayley server" where getAmount = do- AT.string "Successfully "- AT.string "deleted " <|> AT.string "wrote "+ _ <- AT.string "Successfully "+ _ <- AT.string "deleted " <|> AT.string "wrote " a <- AT.decimal- AT.string " quads."+ _ <- AT.string " quads." return a+
Database/Cayley/Internal.hs view
@@ -1,17 +1,17 @@ {-# LANGUAGE OverloadedStrings #-} module Database.Cayley.Internal where- -import Control.Monad.Catch-import Control.Monad.IO.Class-import Control.Monad.Reader-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+import Control.Monad.Catch+import Control.Monad.IO.Class+import Control.Monad.Reader+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@@ -22,7 +22,7 @@ return c { method = "POST", port = p, requestBody = b } t <- liftIO $ try $ httpLbs r m case t of- Right r -> return $ A.decode $ responseBody r+ Right _r -> return $ A.decode $ responseBody _r Left e -> return $ Just $@@ -31,7 +31,9 @@ toRequestBody :: [Quad] -> RequestBody toRequestBody qs = RequestBodyLBS $ A.encode $ fromList $ map A.toJSON qs +getManager :: CayleyConnection -> Manager getManager (CayleyConnection (_,m)) = m +getConfig :: CayleyConnection -> CayleyConfig getConfig (CayleyConnection (c,_)) = c
Database/Cayley/Types.hs view
@@ -2,11 +2,10 @@ module Database.Cayley.Types where -import qualified Data.Aeson as A-import Control.Applicative-import Control.Monad-import qualified Data.Text as T-import Network.HTTP.Client (Manager)+import Control.Monad+import qualified Data.Aeson as A+import qualified Data.Text as T+import Network.HTTP.Client (Manager) data APIVersion = V1 @@ -27,6 +26,7 @@ } deriving (Show) -- | CayleyConfig { serverPort = 64210 , serverName = "localhost" , apiVersion = V1 , queryLang = Gremlin }+defaultCayleyConfig :: CayleyConfig defaultCayleyConfig = CayleyConfig { serverPort = 64210 , serverName = "localhost"@@ -63,11 +63,11 @@ 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 subject predicate object label) =- A.object [ "subject" A..= subject- , "predicate" A..= predicate- , "object" A..= object- , "label" A..= label+ toJSON (Quad _subject _predicate _object _label) =+ A.object [ "subject" A..= _subject+ , "predicate" A..= _predicate+ , "object" A..= _object+ , "label" A..= _label ] instance A.FromJSON Quad where@@ -77,7 +77,7 @@ v A..: "object" <*> v A..: "label" parseJSON _ = mzero- + type Query = T.Text type Subject = T.Text
cayley-client.cabal view
@@ -1,6 +1,5 @@ name: cayley-client-version: 0.1.5.0-stability: Experimental+version: 0.1.5.1 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@@ -8,7 +7,7 @@ license-file: LICENSE author: Michel Boucey maintainer: michel.boucey@gmail.com-copyright: Copyright © 2015-2016 - Michel Boucey+copyright: Copyright (c) 2015-2016 - Michel Boucey category: Database build-type: Simple cabal-version: >=1.10@@ -18,7 +17,23 @@ Location: https://github.com/MichelBoucey/cayley-client.git library- exposed-modules: Database.Cayley.Client, Database.Cayley.Types, Database.Cayley.Internal+ exposed-modules: Database.Cayley.Client+ , Database.Cayley.Types+ , Database.Cayley.Internal other-extensions: OverloadedStrings- build-depends: base >=4.7 && <=4.9, mtl >=2.1, transformers >=0.3, attoparsec >=0.12, bytestring >=0.10, text >=1.2, vector >=0.10, http-conduit >=2.1, http-client >=0.4, aeson >=0.8, lens >= 4.6.0.1, lens-aeson >=1.0.0.3, unordered-containers >=0.2, exceptions >= 0.6+ build-depends: base >=4.7 && <5+ , mtl >=2.1+ , transformers >=0.3+ , attoparsec >=0.12+ , bytestring >=0.10+ , text >=1.2+ , vector >=0.10+ , http-conduit >=2.1+ , http-client >=0.4+ , aeson >=0.8+ , lens >= 4.6.0.1+ , lens-aeson >=1.0.0.3+ , unordered-containers >=0.2+ , exceptions >= 0.6 default-language: Haskell2010+ GHC-Options: -Wall