haskell-neo4j-client 0.1.5.0 → 0.2.0.0

raw patch · 2 files changed

+99/−2 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• haskell-neo4j-client.cabal +3/−2
• src/Database/Neo4j/Batch/Types.hs +96/−0

@@ -1,5 +1,5 @@ name:                haskell-neo4j-client-version:             0.1.5.0+version:             0.2.0.0 synopsis:            A Haskell neo4j client description:              Library to interact with Neo4j databases. For now, its API covers basic operations for nodes, relationships, labels@@ -45,13 +45,14 @@                      lifted-base ==0.2.*,                      hashable ==1.2.*,                      mtl ==2.2.*+ library   hs-source-dirs:      src   exposed-modules:     Database.Neo4j, Database.Neo4j.Graph, Database.Neo4j.Batch, Database.Neo4j.Cypher   other-modules:       Database.Neo4j.Types, Database.Neo4j.Http, Database.Neo4j.Node, Database.Neo4j.Relationship,                        Database.Neo4j.Property, Database.Neo4j.Label, Database.Neo4j.Index, Database.Neo4j.Batch.Node,                        Database.Neo4j.Batch.Relationship, Database.Neo4j.Batch.Property, Database.Neo4j.Types,-                       Database.Neo4j.Batch.Label+                       Database.Neo4j.Batch.Label, Database.Neo4j.Batch.Types   build-depends:       base ==4.6.*,                        containers ==0.5.*,                        text ==1.1.*,

@@ -0,0 +1,96 @@+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE FlexibleInstances  #-}++module Database.Neo4j.Batch.Types where++import Control.Exception.Base (throw)+import Data.Aeson ((.=), (.:))+import Data.Maybe (fromMaybe)+import Control.Monad.State (state, State, runState)++import qualified Data.Aeson as J+import qualified Data.Aeson.Types as JT+import qualified Data.ByteString.Lazy as L+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Data.Vector as V+import qualified Network.HTTP.Types as HT++import Database.Neo4j.Graph+import Database.Neo4j.Http+import Database.Neo4j.Types++newtype BatchFuture a = BatchFuture Int++type CmdParser = J.Value -> Graph -> Graph++data BatchCmd = BatchCmd {cmdMethod :: HT.Method, cmdPath ::T.Text, cmdBody :: J.Value,+                            cmdParse :: CmdParser, cmdId :: Int}++defCmd :: BatchCmd+defCmd = BatchCmd{cmdMethod = HT.methodGet, cmdPath = "", cmdBody = "", cmdParse = \_ g -> g, cmdId = -1}++data BatchState = BatchState {commands :: [BatchCmd], batchId :: Int}++type Batch a = State BatchState a++getCmds :: Batch a -> [BatchCmd]+getCmds s = let (_, BatchState cmds _) = runState s (BatchState [] (-1)) in reverse cmds++instance J.ToJSON (Batch a) where+    toJSON b = J.toJSON $ getCmds b++instance J.ToJSON BatchCmd where+    toJSON (BatchCmd m p b _ cId) = J.object ["method" .= TE.decodeUtf8 m, "to" .= p, "body" .= b, "id" .= cId]++-- | Helper function to parse a batch element response from a body entry+tryParseBody :: J.FromJSON a => J.Value -> a+tryParseBody (J.Object jb) = let res = flip JT.parseEither jb $ \obj -> (obj .: "body") >>= J.parseJSON+               in case res of+                     Right entity -> entity+                     Left e -> throw $ Neo4jParseException ("Error parsing entity: " ++ e)+tryParseBody _ = throw $ Neo4jParseException "Error expecting an object"++-- | Helper function to parse a batch element response from a from entry+tryParseFrom :: J.FromJSON a => J.Value -> a+tryParseFrom (J.Object jb) = let res = flip JT.parseEither jb $ \obj -> (obj .: "from") >>= J.parseJSON+               in case res of+                     Right entity -> entity+                     Left e -> throw $ Neo4jParseException ("Error parsing entity: " ++ e)+tryParseFrom _ = throw $ Neo4jParseException "Error expecting an object"++nextState :: BatchCmd -> Batch (BatchFuture a)+nextState cmd = state $ \(BatchState cmds cId) ->+                                 (BatchFuture $ cId + 1, BatchState (cmd{cmdId = cId + 1} : cmds) (cId + 1))++parseBatchResponse :: J.Array -> Batch a -> Graph+parseBatchResponse jarr b = foldl (flip ($)) empty appliedParsers+    where cmds = getCmds b+          parsers = foldr (\cmd ps -> cmdParse cmd : ps) [] cmds+          appliedParsers = zipWith ($) parsers (V.toList jarr)++-- | Get teh exception type for a given batch exception message, if nothing is found a default exception is given+exceptionByName :: Neo4jException -> T.Text -> T.Text -> Neo4jException+exceptionByName _ "NoSuchPropertyException" msg = Neo4jNoSuchProperty msg+exceptionByName def _ _ = def++-- | Parse batch exceptions+parseException :: L.ByteString -> Neo4jException+parseException b = fromMaybe defaultException $ do+                    parsedobj <- J.decode b+                    msg <- flip JT.parseMaybe parsedobj $ \obj -> (obj .: "message") >>= J.parseJSON +                    parsedmsg <- J.decode (L.fromStrict $ TE.encodeUtf8 msg)+                    (errName, expl) <- flip JT.parseMaybe parsedmsg $ \obj -> do+                                                                        expl <- obj .: "message"+                                                                        errName <- obj .: "exception"+                                                                        return (errName, expl)+                    return $ exceptionByName defaultException errName expl+    where defaultException = Neo4jBatchException b++runBatch :: Batch a -> Neo4j Graph+runBatch b = Neo4j $ \conn -> do+        res <- httpCreate500Explained conn "/db/data/batch" $ J.encode b+        let arr = case res of+                    Left bodyErr -> throw $ parseException bodyErr+                    Right bodySuc -> bodySuc+        return $ parseBatchResponse arr b