hasbolt 0.1.1.1 → 0.1.1.2

raw patch · 9 files changed

+92/−72 lines, 9 filesdep ~binarydep ~hasboltPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependency ranges changed: binary, hasbolt

API changes (from Hackage documentation)

Files

• hasbolt.cabal +3/−3
• src/Database/Bolt.hs +2/−2
• src/Database/Bolt/Connection.hs +49/−29
• src/Database/Bolt/Connection/Instances.hs +2/−2
• src/Database/Bolt/Connection/Pipe.hs +6/−6
• src/Database/Bolt/Record.hs +9/−9
• src/Database/Bolt/Value/Helpers.hs +4/−4
• src/Database/Bolt/Value/Instances.hs +8/−8
• src/Database/Bolt/Value/Structure.hs +9/−9

@@ -1,5 +1,5 @@ name: hasbolt-version: 0.1.1.1+version: 0.1.1.2 cabal-version: >=1.10 build-type: Simple license: BSD3@@ -37,7 +37,7 @@         bytestring >=0.10.8.1 && <0.11,         text >=1.2.2.1 && <1.3,         containers >=0.5.7.1 && <0.6,-        binary >=0.8.3.0 && <0.9,+        binary >=0.8.3.0 && <1.0,         data-binary-ieee754 >=0.4.4 && <0.5,         transformers >=0.5.2.0 && <0.6,         network >=2.6.3.1 && <2.7,@@ -63,7 +63,7 @@     main-is: Spec.hs     build-depends:         base >=4.8 && <5,-        hasbolt >=0.1.1.1 && <0.2,+        hasbolt >=0.1.1.2 && <0.2,         hspec >=2.4.1 && <2.5,         QuickCheck >=2.9.2 && <2.10,         hex >=0.1.2 && <0.2,

@@ -1,7 +1,7 @@ module Database.Bolt     ( BoltActionT     , connect, close, reset-    , run, queryP, query, queryP_, query_+    , run, queryP, query, queryP', query', queryP_, query_     , Pipe     , BoltCfg (..), Default (..)     , BoltValue (..), Value (..), Record, RecordValue (..), at@@ -9,9 +9,9 @@     ) where  import           Database.Bolt.Connection-import           Database.Bolt.Record import           Database.Bolt.Connection.Pipe import           Database.Bolt.Connection.Type+import           Database.Bolt.Record import           Database.Bolt.Value.Instances () import           Database.Bolt.Value.Structure () import           Database.Bolt.Value.Type

@@ -1,4 +1,10 @@-module Database.Bolt.Connection where+module Database.Bolt.Connection+  ( BoltActionT+  , run+  , queryP, query+  , queryP', query'+  , queryP_, query_+  ) where  import           Database.Bolt.Connection.Pipe import           Database.Bolt.Connection.Instances@@ -22,43 +28,57 @@  -- |Runs Cypher query with parameters and returns list of obtained 'Record's queryP :: MonadIO m => Text -> Map Text Value -> BoltActionT m [Record]-queryP cypher params = do keys <- pullKeys-                          pipe <- ask-                          liftIO $ pullRecords pipe keys-  where-        pullKeys :: MonadIO m => BoltActionT m [Text]-        pullKeys =  sendRequest cypher params $ \status -> do-                      pipe <- ask-                      flush pipe RequestPullAll-                      mkKeys status-    -        pullRecords :: Pipe -> [Text] -> IO [Record]-        pullRecords pipe keys = do resp <- fetch pipe-                                   if isSuccess resp-                                     then return []-                                     else do let record = mkRecord keys resp-                                             rest <- unsafeInterleaveIO $ pullRecords pipe keys-                                             return (record:rest)+queryP = querySL False  -- |Runs Cypher query and returns list of obtained 'Record's query :: MonadIO m => Text -> BoltActionT m [Record] query cypher = queryP cypher empty +-- |Runs Cypher query with parameters and returns list of obtained 'Record's. Strict version+queryP' :: MonadIO m => Text -> Map Text Value -> BoltActionT m [Record]+queryP' = querySL True++-- |Runs Cypher query and returns list of obtained 'Record's. Strict version+query' :: MonadIO m => Text -> BoltActionT m [Record]+query' cypher = queryP' cypher empty+ -- |Runs Cypher query with parameters and ignores response queryP_ :: MonadIO m => Text -> Map Text Value -> BoltActionT m ()-queryP_ cypher params = sendRequest cypher params $ \_ -> do-                          pipe <- ask-                          discardAll pipe-+queryP_ cypher params =+  do pipe <- ask+     liftIO $ sendRequest pipe cypher params $ \_ -> discardAll pipe+      -- |Runs Cypher query and ignores response query_ :: MonadIO m => Text -> BoltActionT m () query_ cypher = queryP_ cypher empty +-- Helper functions++querySL :: MonadIO m => Bool -> Text -> Map Text Value -> BoltActionT m [Record]+querySL strict cypher params = do pipe <- ask+                                  keys <- liftIO $ pullKeys pipe cypher params+                                  liftIO $ pullRecords pipe keys strict++pullKeys :: Pipe -> Text -> Map Text Value -> IO [Text]+pullKeys pipe cypher params = sendRequest pipe cypher params $ \status -> do+  flush pipe RequestPullAll+  mkKeys status++pullRecords :: Pipe -> [Text] -> Bool -> IO [Record]+pullRecords pipe keys strict = do resp <- fetch pipe+                                  if isSuccess resp+                                    then pure []+                                    else do let record = mkRecord keys resp+                                            let pull = pullRecords pipe keys strict+                                            rest <- if strict then pull+                                                              else unsafeInterleaveIO pull+                                            pure (record:rest)+ -- |Sends request to database and makes an action-sendRequest :: MonadIO m => Text -> Map Text Value -> (Response -> BoltActionT m a) -> BoltActionT m a-sendRequest cypher params f = do pipe <- ask-                                 flush pipe $ RequestRun cypher params-                                 status <- fetch pipe-                                 if isSuccess status then f status-                                                     else do ackFailure pipe-                                                             mkFailure status+sendRequest :: Pipe -> Text -> Map Text Value -> (Response -> IO a) -> IO a+sendRequest pipe cypher params f =+  do flush pipe $ RequestRun cypher params+     status <- fetch pipe+     if isSuccess status then f status+       else do ackFailure pipe+               mkFailure status

@@ -22,7 +22,7 @@ instance FromStructure Response where   fromStructure Structure{..}     | signature == sigSucc = ResponseSuccess <$> extractMap (head fields)-    | signature == sigRecs = return $ ResponseRecord (removeExtList fields)+    | signature == sigRecs = pure $ ResponseRecord (removeExtList fields)     | signature == sigIgn  = ResponseIgnored <$> extractMap (head fields)     | signature == sigFail = ResponseFailure <$> extractMap (head fields)     | otherwise            = fail "Not a Response value"@@ -68,7 +68,7 @@                        ]  extractMap :: Monad m => Value -> m (Map Text Value)-extractMap (M mp) = return mp+extractMap (M mp) = pure mp extractMap _      = fail "Not a Dict value"  mkFailure :: Monad m => Response -> m a

@@ -20,7 +20,7 @@ connect bcfg = do (sock, _) <- connectSock (host bcfg) (show $ port bcfg)                   let pipe = Pipe sock (maxChunkSize bcfg)                   handshake pipe bcfg-                  return pipe+                  pure pipe  -- |Closes 'Pipe' close :: MonadIO m => Pipe -> m ()@@ -32,7 +32,7 @@                 response <- fetch pipe                 when (isFailure response) $                   fail "Reset failed"-                return ()+                pure ()  ackFailure :: MonadIO m => Pipe -> m () ackFailure pipe = flush pipe RequestAckFailure >> void (fetch pipe)@@ -62,9 +62,9 @@         chunks = do size <- decodeStrict <$> recvChunk sock 2                     chunk <- recvChunk sock size                     if B.null chunk-                      then return []+                      then pure []                       else do rest <- chunks-                              return (chunk:rest)+                              pure (chunk:rest)  -- Helper functions @@ -79,7 +79,7 @@                          response <- fetch pipe                          unless (isSuccess response) $                            fail "Authentification failed"-                         return ()+                         pure ()  boltVersionProposal :: BoltCfg -> ByteString boltVersionProposal bcfg = B.concat $ encodeStrict <$> [version bcfg, 0, 0, 0]@@ -87,7 +87,7 @@ recvChunk :: MonadIO m => Socket -> Word16 -> m ByteString recvChunk sock size = B.concat <$> helper (fromIntegral size)   where helper :: MonadIO m => Int -> m [ByteString]-        helper 0  = return []+        helper 0  = pure []         helper sz = do mbChunk <- recv sock sz                        case mbChunk of                          Just chunk -> (chunk:) <$> helper (sz - B.length chunk)

@@ -21,23 +21,23 @@   exact :: Monad m => Value -> m a  instance RecordValue () where-  exact (N _) = return ()+  exact (N _) = pure ()   exact x     = fail $ show x ++ " is not a Null value"  instance RecordValue Bool where-  exact (B b) = return b+  exact (B b) = pure b   exact x     = fail $ show x ++ " is not a Bool value"  instance RecordValue Int where-  exact (I i) = return i+  exact (I i) = pure i   exact x     = fail $ show x ++ " is not an Int value"  instance RecordValue Double where-  exact (F d) = return d+  exact (F d) = pure d   exact x     = fail $ show x ++ " is not a Double value"  instance RecordValue Text where-  exact (T t) = return t+  exact (T t) = pure t   exact x     = fail $ show x ++ " is not a Text value"  instance RecordValue a => RecordValue [a] where@@ -45,11 +45,11 @@   exact x     = fail $ show x ++ " is not a List value"  instance RecordValue a => RecordValue (Maybe a) where-  exact (N _) = return Nothing+  exact (N _) = pure Nothing   exact x     = Just <$> exact x  instance RecordValue (Map Text Value) where-  exact (M m) = return m+  exact (M m) = pure m   exact x     = fail $ show x ++ " is not a Map value"  instance RecordValue Node where@@ -70,12 +70,12 @@  at :: Monad m => Record -> Text -> m Value at record key = case key `M.lookup` record of-                  Just result -> return result+                  Just result -> pure result                   Nothing     -> fail $ "No such key (" ++ show key ++ ") in record"  mkKeys :: Monad m => Response -> m [Text] mkKeys (ResponseSuccess response) = let mbKeys = exact =<< ("fields" `M.lookup` response)-                                    in return $ fromMaybe [] mbKeys+                                    in pure $ fromMaybe [] mbKeys mkKeys x = mkFailure x  mkRecord :: [Text] -> Response -> Record

@@ -34,7 +34,7 @@ isInt = do x <- liftA2 (||) (== int8Code) (== int16Code)            y <- liftA2 (||) (== int32Code) (== int64Code)            z <- isTinyWord-           return $ x || y || z+           pure $ x || y || z  isDouble :: Word8 -> Bool isDouble = (== doubleCode)@@ -42,17 +42,17 @@ isDict :: Word8 -> Bool isDict = do x <- liftA2 (||) (== dict8Code) (== dict16Code)             y <- liftA2 (||) (== dict32Code) isTinyDict-            return $ x || y+            pure $ x || y  isText :: Word8 -> Bool isText = do x <- liftA2 (||) (== text8Code) (== text16Code)             y <- liftA2 (||) (== text32Code) isTinyText-            return $ x || y+            pure $ x || y  isList :: Word8 -> Bool isList = do x <- liftA2 (||) (== list8Code) (== list16Code)             y <- liftA2 (||) (== list32Code) isTinyList-            return $ x || y+            pure $ x || y  isStruct :: Word8 -> Bool isStruct = liftA3 (\x y z -> x || y || z) (== struct8Code) (== struct16Code) isTinyStruct

@@ -25,7 +25,7 @@   pack () = singleton nullCode    unpackT = unpackW8 >>= unpackByMarker-    where unpackByMarker m | m == nullCode = return ()+    where unpackByMarker m | m == nullCode = pure ()                            | otherwise     = fail "Not a Null value"  instance BoltValue Bool where@@ -33,8 +33,8 @@   pack False = singleton falseCode    unpackT = unpackW8 >>= unpackByMarker-    where unpackByMarker m | m == trueCode  = return True-                           | m == falseCode = return False+    where unpackByMarker m | m == trueCode  = pure True+                           | m == falseCode = pure False                            | otherwise      = fail "Not a Bool value"  instance BoltValue Int where@@ -46,7 +46,7 @@            | otherwise     = error "Cannot pack so large integer"    unpackT = unpackW8 >>= unpackByMarker-    where unpackByMarker m | isTinyWord m   = return . toInt $ (fromIntegral m :: Int8)+    where unpackByMarker m | isTinyWord m   = pure . toInt $ (fromIntegral m :: Int8)                            | m == int8Code  = toInt <$> unpackI8                            | m == int16Code = toInt <$> unpackI16                            | m == int32Code = toInt <$> unpackI32@@ -72,7 +72,7 @@                            | otherwise       = fail "Not a Text value"           unpackTextBySize size = do str <- gets (B.take size)                                      modify (B.drop size)-                                     return $ decodeUtf8 str+                                     pure $ decodeUtf8 str  instance BoltValue a => BoltValue [a] where   pack lst = mkPackedCollection (length lst) pbs (listConst, list8Code, list16Code, list32Code)@@ -101,7 +101,7 @@           unpackPairsBySize size = forM [1..size] $ const $ do                                      key <- unpackT                                      value <- unpackT-                                     return (key, value)+                                     pure (key, value)  instance BoltValue Structure where   pack (Structure sig lst) | size < size4  = (structConst + fromIntegral size) `cons` pData@@ -118,7 +118,7 @@                            | otherwise         = fail "Not a Structure value"           unpackStructureBySize size = do sig <- unpackW8                                           lst <- replicateM size unpackT-                                          return $ Structure sig lst+                                          pure $ Structure sig lst  instance BoltValue Value where   pack (N n) = pack n@@ -197,7 +197,7 @@ popBS :: Monad m => Int -> UnpackT m ByteString popBS size = do top <- topBS size                 modify (B.drop size)-                return top+                pure top  -- |Pack collection using it's size and set of BOLT constants mkPackedCollection :: Int -> ByteString -> (Word8, Word8, Word8, Word8) -> ByteString

@@ -20,7 +20,7 @@   fromStructure (Structure sig lst) | sig == sigRel = mkRel lst                                     | otherwise     = failRel     where mkRel :: Monad m => [Value] -> m Relationship-          mkRel [I rid, I sni, I eni, T rt, M rp] = return $ Relationship rid sni eni rt rp+          mkRel [I rid, I sni, I eni, T rt, M rp] = pure $ Relationship rid sni eni rt rp           mkRel _                                 = failRel            failRel :: Monad m => m Relationship@@ -30,7 +30,7 @@   fromStructure (Structure sig lst) | sig == sigURel = mkURel lst                                     | otherwise      = failURel     where mkURel :: Monad m => [Value] -> m URelationship-          mkURel [I rid, T rt, M rp] = return $ URelationship rid rt rp+          mkURel [I rid, T rt, M rp] = pure $ URelationship rid rt rp           mkURel _                   = failURel            failURel :: Monad m => m URelationship@@ -43,7 +43,7 @@           mkPath [L vnp, L vrp, L vip] = do np <- cnvN vnp                                             rp <- cnvR vrp                                             ip <- cnvI vip-                                            return $ Path np rp ip+                                            pure $ Path np rp ip           mkPath _                     = failPath            failPath :: Monad m => m Path@@ -52,25 +52,25 @@ -- = Helper functions  cnvT :: Monad m => [Value] -> m [Text]-cnvT []       = return []+cnvT []       = pure [] cnvT (T x:xs) = (x:) <$> cnvT xs cnvT (x:_)    = fail $ "Non-text value (" ++ show x ++ ") in text list"  cnvN :: Monad m => [Value] -> m [Node]-cnvN []       = return []+cnvN []       = pure [] cnvN (S x:xs) = do hd <- fromStructure x                    rest <- cnvN xs-                   return (hd:rest)+                   pure (hd:rest) cnvN (x:_)    = fail $ "Non-node value (" ++ show x ++ ") in node list"  cnvR :: Monad m => [Value] -> m [URelationship]-cnvR []       = return []+cnvR []       = pure [] cnvR (S x:xs) = do hd <- fromStructure x                    rest <- cnvR xs-                   return (hd:rest)+                   pure (hd:rest) cnvR (x:_)    = fail $ "Non-(u)relationship value (" ++ show x ++ ") in (u)relationship list"  cnvI :: Monad m => [Value] -> m [Int]-cnvI []       = return []+cnvI []       = pure [] cnvI (I x:xs) = (x:) <$> cnvI xs cnvI (x:_)    = fail $ "Non-int value (" ++ show x ++ ") in int list"