Make stream more general

.envrc

@@ -0,0 +1,4 @@
+nix_direnv_watch_file odbc.cabal
+nix_direnv_watch_file default.nix
+use nix
+

.gitignore

@@ -1,2 +1,4 @@
 .stack-work
 _release
+result
+cabal.project.local

app/Main.hs

@@ -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 ()
@@ -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 ()

default.nix

@@ -0,0 +1,20 @@
+# -*- compile-command: "nix-shell --run 'cabal exec -- ghc-pkg list'"; -*-
+{ pkgs ? import <nixpkgs> {} }:
+  # https://github.com/NixOS/nixpkgs/blob/master/pkgs/development/haskell-modules/make-package-set.nix
+let this = pkgs.haskellPackages.developPackage {
+    root = ./.;
+    withHoogle = false;
+    returnShellEnv = false;
+    modifier = with pkgs.haskell.lib; drv:
+      disableLibraryProfiling
+        (addExtraLibraries
+          (dontHaddock
+            (addBuildTools drv
+              (with pkgs.haskellPackages; [ cabal-install ghcid pkgs.unixODBC])))
+        [ pkgs.unixODBC ]);
+
+  };
+in this
+   // { env = this.env.overrideAttrs(_: prev: { shellHook = prev.shellHook + ''
+   export LD_LIBRARY_PATH=${pkgs.unixODBC}/lib
+   ''; });}

shell.nix

@@ -0,0 +1,2 @@
+# -*- compile-command: "nix-shell --run 'cabal exec -- ghc-pkg list'"; -*-
+(import ./. {}).env

src/Database/ODBC/Internal.hs

@@ -342,7 +342,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
@@ -360,7 +360,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
@@ -504,7 +504,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
@@ -541,9 +541,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 ()

src/Database/ODBC/SQLServer.hs

@@ -42,6 +42,7 @@ module Database.ODBC.SQLServer
 
   , stream
   , Internal.Step(..)
+  , Internal.Column(..)
 
     -- * Exceptions
     -- $exceptions
@@ -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

test/Main.hs

@@ -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"