nikita-volkov/hasql
1
1
Fork 0
mirror of https://github.com/nikita-volkov/hasql.git synced 2024-11-22 18:22:05 +03:00
Code Issues Projects Releases Wiki Activity

Progress

Browse Source
This commit is contained in:
Nikita Volkov 2024-04-21 12:12:35 +03:00
parent c2ab043911
commit eac7e7ccb7
3 changed files with 21 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
hspec/Hasql/PipelineSpec.hs
View File

@ -9,7 +9,7 @@ spec :: Spec
spec = do spec = do
describe "Single-statement" do describe "Single-statement" do
describe "Unprepared" do describe "Unprepared" do
fit "Collects results and sends params" do it "Collects results and sends params" do
result <- result <-
Dsl.runPipelineOnLocalDb Dsl.runPipelineOnLocalDb
$ GenerateSeries.pipeline False GenerateSeries.Params {start = 0, end = 2} $ GenerateSeries.pipeline False GenerateSeries.Params {start = 0, end = 2}
@ -23,14 +23,6 @@ spec = do
shouldBe result (Right [0 .. 2]) shouldBe result (Right [0 .. 2])
describe "Normally" do describe "Normally" do
describe "On prepared statements" do
it "Collects results and sends params" do
result <-
Dsl.runPipelineOnLocalDb
$ replicateM 2
$ GenerateSeries.pipeline True GenerateSeries.Params {start = 0, end = 2}
shouldBe result (Right [[0 .. 2], [0 .. 2]])
describe "On unprepared statements" do describe "On unprepared statements" do
it "Collects results and sends params" do it "Collects results and sends params" do
result <- result <-
@ -39,6 +31,14 @@ spec = do
$ GenerateSeries.pipeline False GenerateSeries.Params {start = 0, end = 2} $ GenerateSeries.pipeline False GenerateSeries.Params {start = 0, end = 2}
shouldBe result (Right [[0 .. 2], [0 .. 2]]) shouldBe result (Right [[0 .. 2], [0 .. 2]])
describe "On prepared statements" do
it "Collects results and sends params" do
result <-
Dsl.runPipelineOnLocalDb
$ replicateM 2
$ GenerateSeries.pipeline True GenerateSeries.Params {start = 0, end = 2}
shouldBe result (Right [[0 .. 2], [0 .. 2]])
describe "When some part fails" do describe "When some part fails" do
it "Works" do it "Works" do
pending pending

5
library/Hasql/Decoders/Result.hs
View File

@ -19,6 +19,11 @@ run :: Result a -> Bool -> LibPQ.Result -> IO (Either ResultError a)
run (Result reader) idt result = run (Result reader) idt result =
runExceptT (runReaderT reader (idt, result)) runExceptT (runReaderT reader (idt, result))
{-# INLINE pipelineSync #-}
pipelineSync :: Result ()
pipelineSync =
checkExecStatus [LibPQ.PipelineSync]
{-# INLINE noResult #-} {-# INLINE noResult #-}
noResult :: Result () noResult :: Result ()
noResult = noResult =

17
library/Hasql/Pipeline/Core.hs
View File

@ -32,8 +32,8 @@ run (Pipeline send) (Connection.Connection pqConnectionRef integerDatetimes regi
runCommandFailing pqConnection $ Pq.pipelineSync pqConnection runCommandFailing pqConnection $ Pq.pipelineSync pqConnection
putStrLn "recv" putStrLn "recv"
recvResult <- recv recvResult <- recv
putStrLn "dropRemainders" putStrLn "pipelineSync"
handleEither =<< Decoders.Results.run Decoders.Results.dropRemainders pqConnection integerDatetimes handleEither =<< Decoders.Results.run (Decoders.Results.single Decoders.Result.pipelineSync) pqConnection integerDatetimes
putStrLn "exitPipelineMode" putStrLn "exitPipelineMode"
runCommandFailing pqConnection $ Pq.exitPipelineMode pqConnection runCommandFailing pqConnection $ Pq.exitPipelineMode pqConnection
putStrLn "return" putStrLn "return"
@ -100,14 +100,11 @@ statement params (Statement.Statement sql (Encoders.Params encoder) (Decoders.Re
then pure (True, Right (key, recv)) then pure (True, Right (key, recv))
else (False,) . Left . commandToQueryError . ClientError <$> Pq.errorMessage connection else (False,) . Left . commandToQueryError . ClientError <$> Pq.errorMessage connection
where where
recv :: IO (Either QueryError ()) recv =
recv = do fmap (mapLeft commandToQueryError)
Pq.getResult connection >>= \case $ (<*)
Nothing -> <$> Decoders.Results.run (Decoders.Results.single Decoders.Result.noResult) connection integerDatetimes
Left . commandToQueryError . ClientError <$> Pq.errorMessage connection <*> Decoders.Results.run Decoders.Results.dropRemainders connection integerDatetimes
Just result ->
mapLeft (commandToQueryError . ResultError)
<$> Decoders.Result.run Decoders.Result.noResult integerDatetimes result
onOldRemoteKey key = onOldRemoteKey key =
pure (Right (key, pure (Right ()))) pure (Right (key, pure (Right ())))