packages feed

cayley-client (empty) → 0.1.0.0

raw patch · 4 files changed

+215/−0 lines, 4 filesdep +aesondep +attoparsecdep +basesetup-changed

Dependencies added: aeson, attoparsec, base, bytestring, exceptions, http-client, http-conduit, lens, lens-aeson, mtl, text, transformers, unordered-containers, vector

Files

+ Database/Cayley/Client.hs view
@@ -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
+ LICENSE view
@@ -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.+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ cayley-client.cabal view
@@ -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