hasbolt 0.1.1.0 → 0.1.1.1
raw patch · 4 files changed
+49/−47 lines, 4 filesdep ~hasboltPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: hasbolt
API changes (from Hackage documentation)
Files
- hasbolt.cabal +2/−2
- src/Database/Bolt/Connection.hs +32/−25
- src/Database/Bolt/Connection/Pipe.hs +8/−13
- src/Database/Bolt/Record.hs +7/−7
hasbolt.cabal view
@@ -1,5 +1,5 @@ name: hasbolt-version: 0.1.1.0+version: 0.1.1.1 cabal-version: >=1.10 build-type: Simple license: BSD3@@ -63,7 +63,7 @@ main-is: Spec.hs build-depends: base >=4.8 && <5,- hasbolt >=0.1.1.0 && <0.2,+ hasbolt >=0.1.1.1 && <0.2, hspec >=2.4.1 && <2.5, QuickCheck >=2.9.2 && <2.10, hex >=0.1.2 && <0.2,
src/Database/Bolt/Connection.hs view
@@ -6,12 +6,13 @@ import Database.Bolt.Value.Type import Database.Bolt.Record -import Control.Monad (when)-import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.IO.Class (MonadIO (..), liftIO) import Control.Monad.Trans.Reader (ReaderT (..), ask, runReaderT) import Data.Text (Text) import Data.Map.Strict (Map, empty) +import System.IO.Unsafe (unsafeInterleaveIO)+ -- |Monad Transformer to do all BOLT actions in type BoltActionT = ReaderT Pipe @@ -21,21 +22,23 @@ -- |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 = pullRequests >>= toRecords- where pullRequests :: MonadIO m => BoltActionT m [Response]- pullRequests = do pipe <- ask- let request = RequestRun cypher params- flush pipe request- status <- fetch pipe- if isSuccess status then do flush pipe RequestPullAll- (status:) <$> pullRest pipe- else do ackFailure pipe- mkFailure status-- pullRest :: MonadIO m => Pipe -> m [Response]- pullRest pipe = do resp <- fetch pipe- if isSuccess resp then return [resp]- else (resp:) <$> pullRest pipe+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) -- |Runs Cypher query and returns list of obtained 'Record's query :: MonadIO m => Text -> BoltActionT m [Record]@@ -43,15 +46,19 @@ -- |Runs Cypher query with parameters and ignores response queryP_ :: MonadIO m => Text -> Map Text Value -> BoltActionT m ()-queryP_ cypher params = do pipe <- ask- flush pipe $ RequestRun cypher params- status <- fetch pipe- when (isFailure status) $ do- ackFailure pipe- mkFailure status- when (isSuccess status) $- discardAll pipe+queryP_ cypher params = sendRequest cypher params $ \_ -> do+ pipe <- ask+ discardAll pipe -- |Runs Cypher query and ignores response query_ :: MonadIO m => Text -> BoltActionT m () query_ cypher = queryP_ cypher empty++-- |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
src/Database/Bolt/Connection/Pipe.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE ScopedTypeVariables #-}- module Database.Bolt.Connection.Pipe where import Database.Bolt.Connection.Instances@@ -9,12 +7,10 @@ import Control.Monad (forM_, unless, void, when) import Control.Monad.IO.Class (MonadIO (..))-import Data.Binary (Binary (..)) import Data.ByteString (ByteString) import qualified Data.ByteString as B (concat, length, null, splitAt)-import Data.Maybe (fromMaybe)-import Data.Word (Word16, Word32)+import Data.Word (Word16) import Network.Simple.TCP (Socket, closeSock, connectSock, recv, send, sendMany)@@ -59,13 +55,16 @@ fetch :: MonadIO m => Pipe -> m Response fetch pipe = do bs <- B.concat <$> chunks- (unpack $! bs) >>= fromStructure+ unpack bs >>= fromStructure where sock = connectionSocket pipe chunks :: MonadIO m => m [ByteString]- chunks = do size <- recvWord sock 2+ chunks = do size <- decodeStrict <$> recvChunk sock 2 chunk <- recvChunk sock size- if B.null chunk then return [] else (chunk:) <$> chunks+ if B.null chunk+ then return []+ else do rest <- chunks+ return (chunk:rest) -- Helper functions @@ -73,7 +72,7 @@ handshake pipe bcfg = do let sock = connectionSocket pipe send sock (encodeStrict $ magic bcfg) send sock (boltVersionProposal bcfg)- serverVersion :: Word32 <- recvWord sock 4+ serverVersion <- decodeStrict <$> recvChunk sock 4 when (serverVersion /= version bcfg) $ fail "Unsupported server version" flush pipe (createInit bcfg)@@ -84,10 +83,6 @@ boltVersionProposal :: BoltCfg -> ByteString boltVersionProposal bcfg = B.concat $ encodeStrict <$> [version bcfg, 0, 0, 0]--recvWord :: (MonadIO m, Binary a, Integral a) => Socket -> Int -> m a-recvWord sock size = do bs <- recv sock size- return (fromMaybe 0 $ decodeStrict <$> bs) recvChunk :: MonadIO m => Socket -> Word16 -> m ByteString recvChunk sock size = B.concat <$> helper (fromIntegral size)
src/Database/Bolt/Record.hs view
@@ -73,10 +73,10 @@ Just result -> return result Nothing -> fail $ "No such key (" ++ show key ++ ") in record" -toRecords :: Monad m => [Response] -> m [Record]-toRecords (ResponseSuccess response:rest) =- let keys :: [Text]- keys = fromMaybe [] $ exact =<< ("fields" `M.lookup` response)- in return $ map (M.fromList . zip keys . recsList) $ init rest-toRecords (x:_) = mkFailure x-toRecords _ = fail "Empty response"+mkKeys :: Monad m => Response -> m [Text]+mkKeys (ResponseSuccess response) = let mbKeys = exact =<< ("fields" `M.lookup` response)+ in return $ fromMaybe [] mbKeys+mkKeys x = mkFailure x++mkRecord :: [Text] -> Response -> Record+mkRecord keys = M.fromList . zip keys . recsList