cayley-client 0.2.0.0 → 0.2.1.0

raw patch · 6 files changed

+216/−197 lines, 6 filesdep +binarydep ~aesondep ~attoparsecdep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: binary

Dependency ranges changed: aeson, attoparsec, base, bytestring, exceptions, http-client, http-conduit, lens, lens-aeson, mtl, text, transformers, unordered-containers, vector

API changes (from Hackage documentation)

Files

• Database/Cayley/Client.hs +104/−91
• Database/Cayley/Internal.hs +8/−9
• Database/Cayley/Types.hs +68/−62
• LICENSE +1/−1
• README.md +2/−2
• cayley-client.cabal +33/−32

@@ -6,14 +6,14 @@        Quad (..) -    -- * Connect & query+    -- * Connection     , defaultCayleyConfig     , connectCayley++    -- * Operations     , query     , Shape     , queryShape--    -- * REST API operations     , write     , writeQuad     , writeQuads@@ -50,50 +50,53 @@ -- connectCayley :: CayleyConfig -> IO CayleyConnection connectCayley c =-    newManager defaultManagerSettings >>= \m -> return $ CayleyConnection (c,m)+  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 -> Query -> IO (Either String A.Value)+query :: CayleyConnection+      -> Query+      -> IO (Either String A.Value) query c q =-    runReaderT (doQuery (getManager c) (encodeUtf8 q)) (getConfig c)+  runReaderT (doQuery (getManager c) (encodeUtf8 q)) (getConfig c)   where     doQuery m _q = do-        CayleyConfig {..} <- ask+        CayleyConfig{..} <- ask         r <- apiRequest-                 m (urlBase serverName apiVersion-                   ++ "/query/" ++ show queryLang)-                 serverPort (RequestBodyBS _q)+               m (urlBase serverName apiVersion+                 ++ "/query/" ++ show queryLang)+               serverPort (RequestBodyBS _q)         return $ case r of-            Just a  ->-                case a ^? key "result" of-                    Just v  -> Right v-                    Nothing ->-                      case a ^? 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"+          Just a  ->+            case a ^? key "result" of+              Just v  -> Right v+              Nothing ->+                case a ^? 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" --- | Return the description of the given query.-queryShape :: CayleyConnection -> Query -> IO (A.Result Shape)+-- | Return the description of the given executed query.+queryShape :: CayleyConnection+           -> Query+           -> IO (A.Result Shape) queryShape c q =-    runReaderT (doShape (getManager c) (encodeUtf8 q)) (getConfig c)+  runReaderT (doShape (getManager c) (encodeUtf8 q)) (getConfig c)   where     doShape m _q = do-        CayleyConfig {..} <- ask-        r <- apiRequest-                 m (urlBase serverName apiVersion ++ "/shape/" ++ show queryLang)-                 serverPort (RequestBodyBS _q)-        case r of-            Just o  -> return $ A.fromJSON o-            Nothing -> return $ A.Error "API request error"+      CayleyConfig{..} <- ask+      r <- apiRequest+             m (urlBase serverName apiVersion ++ "/shape/" ++ show queryLang)+             serverPort (RequestBodyBS _q)+      case r of+        Just o  -> return $ A.fromJSON o+        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'@@ -109,10 +112,12 @@           -> Maybe Label           -> IO (Maybe A.Value) writeQuad c s p o l =-   writeQuads c [Quad { subject = s, predicate = p, object = o, label = l }]+  writeQuads c [Quad { subject = s, predicate = p, object = o, label = l }]  -- | Write the given 'Quad'.-write :: CayleyConnection -> Quad -> IO (Maybe A.Value)+write :: CayleyConnection+      -> Quad+      -> IO (Maybe A.Value) write c q = writeQuads c [q]  -- | Delete the 'Quad' defined by the given subject, predicate, object@@ -124,34 +129,38 @@            -> Maybe Label            -> IO (Maybe A.Value) deleteQuad c s p o l =-    deleteQuads c [Quad { subject = s, predicate = p, object = o, label = 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 :: 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 (urlBase serverName apiVersion ++ "/write")-             serverPort (toRequestBody _qs)+      CayleyConfig{..} <- ask+      apiRequest+        m (urlBase serverName apiVersion ++ "/write")+        serverPort (toRequestBody _qs)  -- | Delete the given list of 'Quad'(s).-deleteQuads :: CayleyConnection -> [Quad] -> IO (Maybe A.Value)+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-        CayleyConfig {..} <- ask-        apiRequest-            m (urlBase serverName apiVersion ++ "/delete")-            serverPort-            (toRequestBody _qs)+      CayleyConfig{..} <- ask+      apiRequest+        m (urlBase serverName apiVersion ++ "/delete")+        serverPort+        (toRequestBody _qs)  -- | Write a N-Quad file. --@@ -163,32 +172,36 @@                -> FilePath                -> m (Maybe A.Value) writeNQuadFile c p =-    runReaderT (writenq (getManager c) p) (getConfig c)+  runReaderT (writenq (getManager c) p) (getConfig c)   where     writenq m _p = do-        CayleyConfig {..} <- ask-        r <- parseUrl (urlBase serverName apiVersion ++ "/write/file/nquad")-                 >>= \r -> return r { port = serverPort }-        t <- liftIO $-                 try $-                    flip httpLbs m-                        =<< formDataBody [partFileSource "NQuadFile" _p] r-        return $ case t of-            Right _r -> A.decode $ responseBody _r-            Left e   -> Just $-                A.object ["error" A..= T.pack (show (e :: SomeException))]+      CayleyConfig{..} <- ask+      r <- parseUrl (urlBase serverName apiVersion ++ "/write/file/nquad")+             >>= \r -> return r { port = serverPort }+      t <- liftIO $+             try $+               flip httpLbs m+                 =<< formDataBody [partFileSource "NQuadFile" _p] r+      return $ case t of+        Right _r -> A.decode $ responseBody _r+        Left e   -> Just $+          A.object ["error" A..= T.pack (show (e :: SomeException))]  -- | A valid 'Quad' has its subject, predicate and object not empty. isValid :: Quad -> Bool-isValid Quad {..} = T.empty `notElem` [subject, predicate, object]+isValid Quad{..} = T.empty `notElem` [subject, predicate, object]  -- | Given a subject, a predicate, an object and an optional label, -- create a valid 'Quad'.-createQuad :: Subject -> Predicate -> Object -> Maybe Label -> 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+  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, or an explicite error message.@@ -196,32 +209,32 @@ -- >λ> writeNQuadFile conn "testdata.nq" >>= successfulResults -- >Right 11 ---successfulResults :: Maybe A.Value -> IO (Either String Int)+successfulResults :: Maybe A.Value+                  -> IO (Either String Int) successfulResults m = return $-    case m of-        Just a  ->-            case a ^? key "result" of-                Just v  ->-                    case A.fromJSON v of-                        A.Success s ->-                            case AT.parse getAmount s of-                                AT.Done "" b -> Right b-                                _            ->-                                    Left "Can't get amount of successful results"-                        A.Error e   -> Left e-                Nothing ->-                    case a ^? key "error" of-                        Just e  ->-                            case A.fromJSON e of-                                A.Success s -> Left s-                                A.Error r   -> Left r-                        Nothing -> Left "No JSON response from Cayley server"-        Nothing -> Left "Can't get any response from Cayley server"+  case m of+    Just a  ->+      case a ^? key "result" of+        Just v  ->+          case A.fromJSON v of+            A.Success s ->+              case AT.parse getAmount s of+                AT.Done "" b -> Right b+                _            -> Left "Can't get amount of successful results"+            A.Error e   -> Left e+        Nothing ->+          case a ^? key "error" of+            Just e  ->+              case A.fromJSON e of+                A.Success s -> Left s+                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 "-        a <- AT.decimal-        _ <- AT.string " quads."-        return a+  getAmount = do+      _ <- AT.string "Successfully "+      _ <- AT.string "deleted " <|> AT.string "wrote "+      a <- AT.decimal+      _ <- AT.string " quads."+      return a 

@@ -18,15 +18,14 @@            -> 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))]+  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

@@ -1,12 +1,15 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveGeneric #-}  module Database.Cayley.Types where  import           Control.Monad       (mzero) import qualified Data.Aeson          as A import qualified Data.Aeson.Types    as AT+import           Data.Binary import qualified Data.Text           as T import qualified Data.Vector         as V+import           GHC.Generics        (Generic) import           Network.HTTP.Client (Manager)  data APIVersion = V1@@ -17,82 +20,85 @@ data QueryLang = Gremlin | MQL  instance Show QueryLang where-    show Gremlin = "gremlin"-    show MQL     = "mql"+  show Gremlin = "gremlin"+  show MQL     = "mql"  data CayleyConfig = CayleyConfig-    { serverPort :: Int-    , serverName :: String-    , apiVersion :: APIVersion-    , queryLang  :: QueryLang-    } deriving (Show)+  { serverPort :: Int+  , serverName :: String+  , apiVersion :: APIVersion+  , queryLang  :: QueryLang+  } deriving (Show)  -- | CayleyConfig { serverPort = 64210 , serverName = "localhost" , apiVersion = V1 , queryLang  = Gremlin } defaultCayleyConfig :: CayleyConfig defaultCayleyConfig = CayleyConfig-    { serverPort = 64210-    , serverName = "localhost"-    , apiVersion = V1-    , queryLang  = Gremlin-    }+  { serverPort = 64210+  , serverName = "localhost"+  , apiVersion = V1+  , queryLang  = Gremlin+  }  data CayleyConnection = CayleyConnection (CayleyConfig, Manager)  data Quad = Quad-    { subject   :: T.Text       -- ^ Subject node-    , predicate :: T.Text       -- ^ Predicate node-    , object    :: T.Text       -- ^ Object node-    , label     :: Maybe T.Text -- ^ Label node-    }+  { subject   :: !T.Text         -- ^ Subject node+  , predicate :: !T.Text         -- ^ Predicate node+  , object    :: !T.Text         -- ^ Object node+  , label     :: !(Maybe T.Text) -- ^ Label node+  } deriving (Generic) +instance Binary Quad+ instance Show Quad where-    show (Quad s p o (Just l)) = T.unpack s-                                 ++ " -- "-                                 ++ T.unpack p-                                 ++ " -> "-                                 ++ T.unpack o-                                 ++ " ("-                                 ++ T.unpack l-                                 ++ ")"-    show (Quad s p o Nothing)  = T.unpack s-                                 ++ " -- "-                                 ++ T.unpack p-                                 ++ " -> "-                                 ++ T.unpack o+  show (Quad s p o (Just l)) = T.unpack s+                               ++ " -- "+                               ++ T.unpack p+                               ++ " -> "+                               ++ T.unpack o+                               ++ " ("+                               ++ T.unpack l+                               ++ ")"+  show (Quad s p o Nothing)  = T.unpack s+                               ++ " -- "+                               ++ T.unpack p+                               ++ " -> "+                               ++ T.unpack o  -- | Two quads are equals when subject, predicate, object /and/ label are equals. instance Eq Quad where-    Quad s p o l == Quad s' p' o' l' = s == s' && p == p' && o == o' && l == l'+  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 s p o l) =-        A.object [ "subject"   A..= s-                 , "predicate" A..= p-                 , "object"    A..= o-                 , "label"     A..= l-                 ]+  toJSON (Quad s p o l) =+    A.object [ "subject"   A..= s+             , "predicate" A..= p+             , "object"    A..= o+             , "label"     A..= l+             ]  instance A.FromJSON Quad where-    parseJSON (A.Object v) = Quad <$>-                             v A..: "subject" <*>-                             v A..: "predicate" <*>-                             v A..: "object" <*>-                             v A..: "label"-    parseJSON _            = mzero+  parseJSON (A.Object v) =+    Quad <$>+    v A..: "subject" <*>+    v A..: "predicate" <*>+    v A..: "object" <*>+    v A..:? "label"+  parseJSON _            = mzero  data Shape = Shape-    { nodes :: [Node]-    , links :: [Link]+    { nodes :: ![Node]+    , links :: ![Link]     } deriving (Eq, Show)  instance A.FromJSON Shape where-    parseJSON (A.Object v) = do-        vnds <- v A..: "nodes"-        nds  <- mapM parseNode $ V.toList vnds-        vlks <- v A..: "links"-        lks  <- mapM parseLink $ V.toList vlks-        return Shape { nodes = nds, links = lks}-    parseJSON _            = mzero+  parseJSON (A.Object v) = do+    vnds <- v A..: "nodes"+    nds  <- mapM parseNode $ V.toList vnds+    vlks <- v A..: "links"+    lks  <- mapM parseLink $ V.toList vlks+    return Shape { nodes = nds, links = lks }+  parseJSON _            = mzero  parseNode :: A.Value -> AT.Parser Node parseNode (A.Object v) = Node <$>@@ -111,18 +117,18 @@ parseLink _            = fail "Link expected"  data Node = Node-    { id           :: Integer-    , tags         :: Maybe [Tag]   -- ^ list of tags from the query-    , values       :: Maybe [Value] -- ^ Known values from the query-    , isLinkNode   :: Bool          -- ^ Does the node represent the link or the node (the oval shapes)-    , isFixed      :: Bool          -- ^ Is the node a fixed starting point of the query-    } deriving (Eq, Show)+  { id           :: !Integer+  , tags         :: !(Maybe [Tag])   -- ^ list of tags from the query+  , values       :: !(Maybe [Value]) -- ^ Known values from the query+  , isLinkNode   :: !Bool            -- ^ Does the node represent the link or the node (the oval shapes)+  , isFixed      :: !Bool            -- ^ Is the node a fixed starting point of the query+  } deriving (Eq, Show)  data Link = Link-    { source    :: Integer -- ^ Node ID-    , target    :: Integer -- ^ Node ID-    , linkNode  :: Integer -- ^ Node ID-    } deriving (Eq, Show)+  { source    :: !Integer -- ^ Node ID+  , target    :: !Integer -- ^ Node ID+  , linkNode  :: !Integer -- ^ Node ID+  } deriving (Eq, Show)  type Query = T.Text 

@@ -1,4 +1,4 @@-Copyright (c) 2015, Michel Boucey+Copyright (c) 2015-2016, Michel Boucey All rights reserved.  Redistribution and use in source and binary forms, with or without

@@ -1,3 +1,3 @@-#A Cayley client for Haskell [![Build Status](https://travis-ci.org/MichelBoucey/cayley-client.svg?branch=master)](https://travis-ci.org/MichelBoucey/cayley-client)+# A Cayley client for Haskell [![Build Status](https://travis-ci.org/MichelBoucey/cayley-client.svg?branch=master)](https://travis-ci.org/MichelBoucey/cayley-client) -Cayley-client is a Haskell library that implements the [RESTful API](https://github.com/google/cayley/blob/master/docs/HTTP.md) of [Cayley database graph](https://github.com/google/cayley).+Cayley-client implements the [RESTful API](https://github.com/google/cayley/blob/master/docs/HTTP.md) of [Cayley database graph](https://github.com/google/cayley).

@@ -1,13 +1,13 @@ name:                cayley-client-version:             0.2.0.0+version:             0.2.1.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 license:             BSD3 license-file:        LICENSE author:              Michel Boucey-maintainer:          michel.boucey@gmail.com-copyright:           Copyright (c) 2015-2016 - Michel Boucey+maintainer:          michel.boucey@cybervisible.fr+copyright:           (c) 2015-2016 - Michel Boucey category:            Database build-type:          Simple cabal-version:       >=1.10@@ -19,35 +19,36 @@   Location: https://github.com/MichelBoucey/cayley-client.git  library-  exposed-modules:     Database.Cayley.Client-                     , Database.Cayley.Types-  other-modules:       Database.Cayley.Internal-  other-extensions:    OverloadedStrings-  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+  exposed-modules:    Database.Cayley.Client+                    , Database.Cayley.Types+  other-modules:      Database.Cayley.Internal+  other-extensions:   OverloadedStrings+  build-depends:      base >=4.7 && <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+  default-language:   Haskell2010+  GHC-Options:      -Wall  test-suite tests-  type:                exitcode-stdio-1.0-  hs-source-dirs:      tests-  main-is:             hspec.hs-  build-depends:       hspec >= 2.2.2-                     , base >= 4.7 && < 5-                     , cayley-client-                     , aeson >=0.8-                     , unordered-containers >= 0.2.5-  default-language:    Haskell2010+  type:               exitcode-stdio-1.0+  hs-source-dirs:     tests+  main-is:            hspec.hs+  build-depends:      hspec >= 2.2.2+                    , base >= 4.7 && < 5+                    , cayley-client+                    , aeson >=0.8+                    , unordered-containers >= 0.2.5+  default-language:   Haskell2010