diff --git a/Database/Cayley/Client.hs b/Database/Cayley/Client.hs --- a/Database/Cayley/Client.hs +++ b/Database/Cayley/Client.hs @@ -25,7 +25,7 @@ -- * Utils , createQuad , isValid - , successfulResults + , results ) where @@ -41,7 +41,7 @@ import Network.HTTP.Client import Network.HTTP.Client.MultipartFormData -import Database.Cayley.Internal +import Database.Cayley.Client.Internal import Database.Cayley.Types -- | Get a connection to Cayley with the given configuration. @@ -74,13 +74,10 @@ case a ^? L.key "result" of Just v -> Right v Nothing -> - case a ^? L.key "error" of - Just e -> - case A.fromJSON e of - A.Success s -> Left s - A.Error _e -> Left _e - Nothing -> Left "No JSON response from Cayley server" - Nothing -> Left "Can't get any response from Cayley server" + case a ^? L.key "error" . L._String of + Just e -> fail (show e) + Nothing -> fail "No JSON response from Cayley server" + Nothing -> fail "Can't get any response from Cayley server" -- | Return the description of the given executed query. queryShape :: CayleyConnection @@ -99,7 +96,7 @@ Nothing -> return $ A.Error "API request error" -- | Write a 'Quad' with the given subject, predicate, object and optional --- label. Throw result or extract amount of query 'successfulResults' +-- label. Throw result or extract amount of query 'results' -- from it. -- -- >λ> writeQuad conn "Humphrey" "loves" "Lauren" (Just "In love") @@ -203,25 +200,25 @@ 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, or an explicite error message. +-- | Get amount of results from a write/delete 'Quad'(s) operation, +-- or an explicite error message. -- --- >λ> writeNQuadFile conn "testdata.nq" >>= successfulResults +-- >λ> writeNQuadFile conn "testdata.nq" >>= results -- >Right 11 -- -successfulResults :: Maybe A.Value - -> IO (Either String Int) -successfulResults m = return $ +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 - _ -> fail "Can't get amount of successful results" + _ -> fail "Can't get amount of results" Nothing -> case v ^? L.key "error" . L._String of - Just e -> fail (T.unpack e) + Just e -> fail (show e) Nothing -> fail "No JSON response from Cayley server" Nothing -> fail "Can't get any response from Cayley server" where diff --git a/Database/Cayley/Client/Internal.hs b/Database/Cayley/Client/Internal.hs new file mode 100644 --- /dev/null +++ b/Database/Cayley/Client/Internal.hs @@ -0,0 +1,41 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Database.Cayley.Client.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 + +apiRequest :: Manager + -> 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 -> + return $ + Just $ A.object ["error" A..= T.pack (show (e :: SomeException))] + +toRequestBody :: [Quad] -> RequestBody +toRequestBody = RequestBodyLBS . A.encode . fromList . map A.toJSON + +getManager :: CayleyConnection -> Manager +getManager (CayleyConnection (_,m)) = m + +getConfig :: CayleyConnection -> CayleyConfig +getConfig (CayleyConnection (c,_)) = c + +urlBase :: String -> APIVersion -> String +urlBase s a = "http://" ++ s ++ "/api/v" ++ show a + diff --git a/Database/Cayley/Internal.hs b/Database/Cayley/Internal.hs deleted file mode 100644 --- a/Database/Cayley/Internal.hs +++ /dev/null @@ -1,41 +0,0 @@ -{-# 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 - -apiRequest :: Manager - -> 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 -> - return $ - Just $ A.object ["error" A..= T.pack (show (e :: SomeException))] - -toRequestBody :: [Quad] -> RequestBody -toRequestBody = RequestBodyLBS . A.encode . fromList . map A.toJSON - -getManager :: CayleyConnection -> Manager -getManager (CayleyConnection (_,m)) = m - -getConfig :: CayleyConnection -> CayleyConfig -getConfig (CayleyConnection (c,_)) = c - -urlBase :: String -> APIVersion -> String -urlBase s a = "http://" ++ s ++ "/api/v" ++ show a - 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.2.1.1 +version: 0.3.0 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 @@ -21,23 +21,24 @@ library exposed-modules: Database.Cayley.Client , Database.Cayley.Types - other-modules: Database.Cayley.Internal + , Database.Cayley.Client.Internal other-extensions: OverloadedStrings - build-depends: base >=4.8 && <5 - , mtl >=2.1 - , transformers >=0.3 - , attoparsec >=0.12 - , binary >=0.7.5 - , 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: aeson >= 0.8.0.2 && < 1.1 + , attoparsec >= 0.12.1.6 && < 0.14 + , base >= 4.8.1.0 && < 5 + , bytestring >= 0.10.6 && < 0.11 + , binary >= 0.7.5 && < 0.9 + , exceptions >= 0.8.0.2 && < 0.9 + , http-client >= 0.4.26 && < 0.6 + , http-conduit >= 2.1.8 && < 2.3 + , lens >= 4.12.3 && < 4.16 + , mtl >= 2.2.1 && < 2.3 + , lens-aeson >= 1.0.0 && < 1.1 + , text >= 1.2.2 && < 1.3 + , transformers >= 0.4.2 && < 0.6 + , unordered-containers >= 0.2.5.1 && < 0.3 + , vector >= 0.10.12.3 && < 0.12 + default-language: Haskell2010 GHC-Options: -Wall @@ -45,10 +46,10 @@ type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: hspec.hs - build-depends: hspec >= 2.2.2 + build-depends: hspec >= 2.1.10 && < 2.2 , base >= 4.8 && < 5 , cayley-client - , aeson >=0.8 - , unordered-containers >= 0.2.5 + , aeson >=0.8.0.2 && < 1.1 + , unordered-containers >= 0.2.5 && < 0.3 default-language: Haskell2010 diff --git a/tests/hspec.hs b/tests/hspec.hs --- a/tests/hspec.hs +++ b/tests/hspec.hs @@ -28,5 +28,5 @@ describe "writeNQuadFile" $ it "writes quads from a file to Cayley server" $ do c <- connectCayley defaultCayleyConfig - (writeNQuadFile c "./tests/testdata.nq" >>= successfulResults) `shouldReturn` Right 15 + (writeNQuadFile c "./tests/testdata.nq" >>= results) `shouldReturn` Right 15