diff --git a/.envrc b/.envrc new file mode 100644 index 0000000..758946a --- /dev/null +++ b/.envrc @@ -0,0 +1,4 @@ +nix_direnv_watch_file odbc.cabal +nix_direnv_watch_file default.nix +use nix + diff --git a/.gitignore b/.gitignore index f99a865..cc6bf28 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,4 @@ .stack-work _release +result +cabal.project.local diff --git a/app/Main.hs b/app/Main.hs index 9ee1221..fa0b784 100644 --- a/app/Main.hs +++ b/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 () diff --git a/default.nix b/default.nix new file mode 100644 index 0000000..ebd5418 --- /dev/null +++ b/default.nix @@ -0,0 +1,20 @@ +# -*- compile-command: "nix-shell --run 'cabal exec -- ghc-pkg list'"; -*- +{ pkgs ? import {} }: + # 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 + ''; });} diff --git a/shell.nix b/shell.nix new file mode 100644 index 0000000..35a86e6 --- /dev/null +++ b/shell.nix @@ -0,0 +1,2 @@ +# -*- compile-command: "nix-shell --run 'cabal exec -- ghc-pkg list'"; -*- +(import ./. {}).env diff --git a/src/Database/ODBC/Internal.hs b/src/Database/ODBC/Internal.hs index 1609d14..2fc482c 100644 --- a/src/Database/ODBC/Internal.hs +++ b/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 () diff --git a/src/Database/ODBC/SQLServer.hs b/src/Database/ODBC/SQLServer.hs index a76941d..d9745be 100644 --- a/src/Database/ODBC/SQLServer.hs +++ b/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 diff --git a/test/Main.hs b/test/Main.hs index f24dc3f..d9f62fb 100644 --- a/test/Main.hs +++ b/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"