diff --git a/Database/Cayley/Client.hs b/Database/Cayley/Client.hs new file mode 100644 --- /dev/null +++ b/Database/Cayley/Client.hs @@ -0,0 +1,161 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Database.Cayley.Client + ( defaultCayleyConfig + , connectCayley + , query + , writeQuad + , deleteQuad + , writeQuads + , deleteQuads + , writeNQuadFile + , 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 + +-- | Get a connection to Cayley with the given configuration. +-- +-- >λ> conn <- connectCayley defaultCayleyConfig +-- +connectCayley :: CayleyConfig -> IO CayleyConnection +connectCayley c = + newManager defaultManagerSettings >>= \m -> return $ CayleyConnection (c,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 -> T.Text -> IO (Either String A.Value) +query c q = + runReaderT (doQuery (getManager c) (encodeUtf8 q)) (getConfig c) + where + doQuery m q = do + c <- ask + r <- apiRequest + m ("http://" ++ serverName c ++ "/api/v" ++ + apiVersion c ++ "/query/" ++ queryLang c) + (serverPort c) (RequestBodyBS q) + case r of + Just a -> + case a ^? key "result" of + Just v -> return $ Right v + Nothing -> + case a ^? key "error" of + Just e -> + case A.fromJSON e of + A.Success s -> return $ Left s + A.Error e -> return $ Left e + Nothing -> + return $ Left "No JSON response from Cayley" + Nothing -> return $ Left "Can't get any response from Cayley" + +-- | Write a 'Quad' with the given subject, predicate, object and optional +-- label. Throw result or extract amount of query 'successfulResults' +-- from it. +-- +-- >λ> writeQuad conn "Humphrey" "loves" "Lauren" (Just "In love") +-- >Just (Object (fromList [("result",String "Successfully wrote 1 triples.")])) +-- +writeQuad :: CayleyConnection + -> T.Text -- ^ Subject node + -> T.Text -- ^ Predicate node + -> T.Text -- ^ Object node + -> Maybe T.Text -- ^ Label node + -> IO (Maybe A.Value) +writeQuad c s p o l = + writeQuads c [Quad { subject = s, predicate = p, object = o, label = l }] + +-- | Delete the 'Quad' defined by the given subject, predicate, object +-- and optional label. +deleteQuad :: CayleyConnection + -> T.Text + -> T.Text + -> T.Text + -> Maybe T.Text + -> IO (Maybe A.Value) +deleteQuad c s p o l = + deleteQuads c [Quad { subject = s, predicate = p, object = o, label = l }] + +-- | 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 + apiRequest + m ("http://" ++ serverName c ++ + "/api/v" ++ apiVersion c ++ "/write") + (serverPort c) (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) + where + delete m qs = do + c <- ask + apiRequest + m ("http://" ++ serverName c ++ + "/api/v" ++ apiVersion c ++ "/delete") + (serverPort c) + (toRequestBody qs) + +-- | Write a N-Quad file. +writeNQuadFile c p = + runReaderT (writenq (getManager c) p) (getConfig c) + where + writenq m p = do + c <- ask + r <- parseUrl ("http://" ++ serverName c ++ "/api/v" + ++ apiVersion c ++ "/write/file/nquad") + >>= \r -> return r { port = serverPort c} + t <- liftIO $ + try $ + flip httpLbs m + =<< formDataBody [partFileSource "NQuadFile" p] r + case t of + Right r -> return $ A.decode $ responseBody r + Left e -> + return $ + Just $ + A.object + ["error" A..= T.pack (show (e :: SomeException))] + +-- | Get amount of successful results from a write/delete 'Quad'(s) +-- operation. +-- +-- >λ> writeNQuadFile conn "testdata.nq" >>= successfulResults +-- >Right 9 +-- +successfulResults :: Maybe A.Value -> IO (Either String Int) +successfulResults v = + case A.fromJSON (fromJust $ fromJust v ^? key "result") of + A.Success s -> + case AT.parse getAmount s of + AT.Done "" a -> return $ Right a + _ -> return $ Left "Can't get amount of successful results" + A.Error e -> return $ Left e + where + getAmount = do + AT.string "Successfully " + AT.string "deleted " <|> AT.string "wrote " + a <- AT.decimal + AT.string " triples." + return a diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,28 @@ +Copyright (c) 2015, Michel Boucey +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +* Neither the name of cayley-client nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cayley-client.cabal b/cayley-client.cabal new file mode 100644 --- /dev/null +++ b/cayley-client.cabal @@ -0,0 +1,24 @@ +name: cayley-client +version: 0.1.0.0 +stability: Experimental +synopsis: An Haskell client for Cayley graph database +description: cayley-client implements the RESTful API of the Cayley database graph. +homepage: http://mb.cybervisible.fr/haskell-cayley-client +license: BSD3 +license-file: LICENSE +author: Michel Boucey +maintainer: michel.boucey@gmail.com +copyright: Copyright © 2015 - Michel Boucey +category: Database +build-type: Simple +cabal-version: >=1.10 + +Source-Repository head + Type: git + Location: https://github.com/MichelBoucey/cayley-client + +library + exposed-modules: Database.Cayley.Client + other-extensions: OverloadedStrings + build-depends: base >=4.7 && <4.8, mtl >=2.1 && <2.2, transformers >=0.3 && <0.4, attoparsec >=0.12 && <0.13, bytestring >=0.10 && <0.11, text >=1.2 && <1.3, vector >=0.10 && <0.11, http-conduit >=2.1 && <2.2, http-client >=0.4 && <0.5, aeson >=0.8 && <0.9, lens >= 4.6.0.1, lens-aeson >=1.0.0.3, unordered-containers >=0.2 && <0.3, exceptions >= 0.6 && <0.7 + default-language: Haskell2010