diff --git a/hasbolt.cabal b/hasbolt.cabal --- a/hasbolt.cabal +++ b/hasbolt.cabal @@ -1,5 +1,5 @@ name: hasbolt -version: 0.1.0.5 +version: 0.1.0.6 cabal-version: >=1.10 build-type: Simple license: BSD3 @@ -63,7 +63,7 @@ main-is: Spec.hs build-depends: base >=4.9.0.0 && <4.10, - hasbolt >=0.1.0.5 && <0.2, + hasbolt >=0.1.0.6 && <0.2, hspec >=2.2.4 && <2.3, QuickCheck >=2.8.2 && <2.9, hex >=0.1.2 && <0.2, diff --git a/src/Database/Bolt.hs b/src/Database/Bolt.hs --- a/src/Database/Bolt.hs +++ b/src/Database/Bolt.hs @@ -1,7 +1,7 @@ module Database.Bolt ( BoltActionT , connect, close, reset - , run, queryP, query, query_ + , run, queryP, query, queryP_, query_ , Pipe , BoltCfg (..), Default (..) , BoltValue (..), Value (..), Record, RecordValue (..), at diff --git a/src/Database/Bolt/Connection.hs b/src/Database/Bolt/Connection.hs --- a/src/Database/Bolt/Connection.hs +++ b/src/Database/Bolt/Connection.hs @@ -21,7 +21,7 @@ -- |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 = toRecords <$> pullRequests +queryP cypher params = pullRequests >>= toRecords where pullRequests :: MonadIO m => BoltActionT m [Response] pullRequests = do pipe <- ask let request = RequestRun cypher params @@ -41,12 +41,18 @@ 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 = do pipe <- ask + flush pipe $ RequestRun cypher params + status <- fetch pipe + when (isFailure status) $ do + ackFailure pipe + mkFailure status + when (isSuccess status) $ + discardAll pipe + + -- |Runs Cypher query and ignores response query_ :: MonadIO m => Text -> BoltActionT m () -query_ cypher = do pipe <- ask - flush pipe (createRun cypher) - status <- fetch pipe - when (isFailure status) $ - ackFailure pipe - when (isSuccess status) $ - discardAll pipe +query_ cypher = queryP_ cypher empty diff --git a/src/Database/Bolt/Connection/Instances.hs b/src/Database/Bolt/Connection/Instances.hs --- a/src/Database/Bolt/Connection/Instances.hs +++ b/src/Database/Bolt/Connection/Instances.hs @@ -8,19 +8,19 @@ import Database.Bolt.Value.Helpers import Database.Bolt.Value.Type -import Data.Map.Strict (Map, fromList, empty) +import Data.Map.Strict (Map, fromList, empty, (!)) import Data.Text (Text) instance ToStructure Request where - toStructure (RequestInit{..}) = Structure sigInit [T agent, M $ tokenMap token] - toStructure (RequestRun{..}) = Structure sigRun [T statement, M parameters] + toStructure RequestInit{..} = Structure sigInit [T agent, M $ tokenMap token] + toStructure RequestRun{..} = Structure sigRun [T statement, M parameters] toStructure RequestReset = Structure sigReset [] toStructure RequestAckFailure = Structure sigAFail [] toStructure RequestPullAll = Structure sigPAll [] toStructure RequestDiscardAll = Structure sigDAll [] instance FromStructure Response where - fromStructure (Structure{..}) + fromStructure Structure{..} | signature == sigSucc = ResponseSuccess <$> extractMap (head fields) | signature == sigRecs = return $ ResponseRecord (removeExtList fields) | signature == sigIgn = ResponseIgnored <$> extractMap (head fields) @@ -70,3 +70,10 @@ extractMap :: Monad m => Value -> m (Map Text Value) extractMap (M mp) = return mp extractMap _ = fail "Not a Dict value" + +mkFailure :: Monad m => Response -> m a +mkFailure ResponseFailure{..} = + let (T code) = failMap ! "code" + (T msg) = failMap ! "message" + in fail $ "code: " ++ show code ++ ", message: " ++ show msg +mkFailure _ = fail "Unknown error" diff --git a/src/Database/Bolt/Record.hs b/src/Database/Bolt/Record.hs --- a/src/Database/Bolt/Record.hs +++ b/src/Database/Bolt/Record.hs @@ -4,6 +4,7 @@ module Database.Bolt.Record where import Database.Bolt.Connection.Type +import Database.Bolt.Connection.Instances import Database.Bolt.Value.Structure () import Database.Bolt.Value.Type @@ -44,7 +45,7 @@ exact _ = fail "Not a List value" instance RecordValue a => RecordValue (Maybe a) where - exact (N _) = return $ Nothing + exact (N _) = return Nothing exact x = Just <$> exact x instance RecordValue (Map Text Value) where @@ -72,9 +73,10 @@ Just result -> return result Nothing -> fail "No such key in record" -toRecords :: [Response] -> [Record] +toRecords :: Monad m => [Response] -> m [Record] toRecords (ResponseSuccess response:rest) = let keys :: [Text] keys = fromMaybe [] $ exact =<< ("fields" `M.lookup` response) - in map (M.fromList . zip keys . recsList) $ init rest -toRecords _ = [] + in return $ map (M.fromList . zip keys . recsList) $ init rest +toRecords (x:_) = mkFailure x +toRecords _ = fail "Empty response" diff --git a/src/Database/Bolt/Value/Instances.hs b/src/Database/Bolt/Value/Instances.hs --- a/src/Database/Bolt/Value/Instances.hs +++ b/src/Database/Bolt/Value/Instances.hs @@ -42,7 +42,8 @@ | isIntX 8 int = cons int8Code $ encodeStrict (fromIntegral int :: Word8) | isIntX 16 int = cons int16Code $ encodeStrict (fromIntegral int :: Word16) | isIntX 32 int = cons int32Code $ encodeStrict (fromIntegral int :: Word32) - | otherwise = cons int64Code $ encodeStrict (fromIntegral int :: Word64) + | isIntX 62 int = cons int64Code $ encodeStrict (fromIntegral int :: Word64) + | otherwise = error "Cannot pack so large integer" unpackT = unpackW8 >>= unpackByMarker where unpackByMarker m | isTinyWord m = return . toInt $ (fromIntegral m :: Int8) @@ -105,7 +106,8 @@ instance BoltValue Structure where pack (Structure sig lst) | size < size4 = (structConst + fromIntegral size) `cons` pData | size < size8 = struct8Code `cons` fromIntegral size `cons` pData - | otherwise = struct16Code `cons` encodeStrict size `append` pData + | size < size16 = struct16Code `cons` encodeStrict size `append` pData + | otherwise = error "Cannot pack so large structure" where size = fromIntegral $ length lst :: Word16 pData = sig `cons` B.concat (map pack lst) @@ -211,4 +213,3 @@ size8 = 2^(8 :: Int) size16 = 2^(16 :: Int) size32 = 2^(32 :: Int) -