Skip to content

Commit

Permalink
Make stream more general
Browse files Browse the repository at this point in the history
  • Loading branch information
Johannes committed May 24, 2023
1 parent 38e0434 commit db33563
Show file tree
Hide file tree
Showing 4 changed files with 11 additions and 11 deletions.
4 changes: 2 additions & 2 deletions app/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,7 @@ repl c = do
hSetBuffering stdout LineBuffering
catch
(catch
(do (_, count) <- ODBC.stream c input output (False, 0 :: Int)
(do (_, count) <- ODBC.stream c input output (\_ -> pure (False, 0 :: Int))
putStrLn ("Rows: " ++ show count))
(\case
UserInterrupt -> pure ()
Expand All @@ -54,7 +54,7 @@ piped c = do
hSetBuffering stdout LineBuffering
catch
(catch
(do (_, count) <- ODBC.stream c input output (False, 0 :: Int)
(do (_, count) <- ODBC.stream c input output (\_ -> pure (False, 0 :: Int))
putStrLn ("Rows: " ++ show count))
(\case
UserInterrupt -> pure ()
Expand Down
11 changes: 5 additions & 6 deletions src/Database/ODBC/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -334,7 +334,7 @@ stream ::
-> (state -> [(Column, Value)] -> m (Step state))
-- ^ A stepping function that gets as input the current @state@ and
-- a row, returning either a new @state@ or a final @result@.
-> state
-> ([Column] -> m state)
-- ^ A state that you can use for the computation. Strictly
-- evaluated each iteration.
-> m state
Expand All @@ -352,7 +352,7 @@ streamWithParams ::
-> (state -> [(Column, Value)] -> m (Step state))
-- ^ A stepping function that gets as input the current @state@ and
-- a row, returning either a new @state@ or a final @result@.
-> state
-> ([Column] -> m state)
-- ^ A state that you can use for the computation. Strictly
-- evaluated each iteration.
-> m state
Expand Down Expand Up @@ -496,7 +496,7 @@ fetchIterator ::
Ptr EnvAndDbc
-> UnliftIO m
-> (state -> [(Column, Value)] -> m (Step state))
-> state
-> ([Column] -> m state)
-> SQLHSTMT s
-> IO state
fetchIterator dbc (UnliftIO runInIO) step state0 stmt = do
Expand Down Expand Up @@ -533,9 +533,8 @@ fetchIterator dbc (UnliftIO runInIO) step state0 stmt = do
(coerce retcode0)
"Unexpected return code"
sqlState)
if cols > 0
then loop state0
else pure state0

(if cols > 0 then loop else pure) =<< runInIO (state0 types)

-- | Fetch all results from possible multiple statements.
fetchAllResults :: Ptr EnvAndDbc -> SQLHSTMT s -> IO ()
Expand Down
5 changes: 3 additions & 2 deletions src/Database/ODBC/SQLServer.hs
Original file line number Diff line number Diff line change
Expand Up @@ -42,6 +42,7 @@ module Database.ODBC.SQLServer

, stream
, Internal.Step(..)
, Internal.Column(..)

-- * Exceptions
-- $exceptions
Expand Down Expand Up @@ -455,7 +456,7 @@ stream ::
-> (state -> row -> m (Internal.Step state))
-- ^ A stepping function that gets as input the current @state@ and
-- a row, returning either a new @state@ or a final @result@.
-> state
-> ([Internal.Column] -> m state)
-- ^ A state that you can use for the computation. Strictly
-- evaluated each iteration.
-> m state
Expand Down Expand Up @@ -494,7 +495,7 @@ renderedAndParams q = (renderParts parts', params)
map
(\case
ValuePart v
| Just {} <- valueToParam v ->
| Just _ <- valueToParam v ->
case v of
TextValue t -> TextPart "CAST(? AS NVARCHAR(MAX))"
_ -> TextPart "?"
Expand Down
2 changes: 1 addition & 1 deletion test/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -231,7 +231,7 @@ dataRetrieval = do
c
"DROP TABLE IF EXISTS no_such_table"
(\s _ -> pure (Stop s))
[]
(\_ -> pure [])
shouldBe (map (map snd) (rows1 ++ rows2)) [])
quickCheckInternalRoundtrip
"Int"
Expand Down

0 comments on commit db33563

Please sign in to comment.