packages feed

dani-sqlite 0.1.0.0 → 0.1.1.0

raw patch · 19 files changed

+419/−328 lines, 19 filesdep −HUnitPVP ok

version bump matches the API change (PVP)

Dependencies removed: HUnit

API changes (from Hackage documentation)

+ Sqlite.Query.FromRow: instance (GHC.Internal.Generics.Generic a, Sqlite.Query.FromRow.GFromRow (GHC.Internal.Generics.Rep a)) => Sqlite.Query.FromRow.FromRow (GHC.Internal.Generics.Generically a)
+ Sqlite.Query.ToRow: instance (GHC.Internal.Generics.Generic a, Sqlite.Query.ToRow.GToRow (GHC.Internal.Generics.Rep a)) => Sqlite.Query.ToRow.ToRow (GHC.Internal.Generics.Generically a)

Files

CHANGELOG.md view
@@ -1,3 +1,9 @@+0.1.1.0+=======++- Bring back the 'Show' instance for 'Utf8', this time reusing 'ByteString''s Show instance.+- 'FromRow' and 'ToRow' instances for 'Generically', to allow for 'DerivingVia'.+- Bring back compatibility with older GHCs.  0.1.0.0 =======
dani-sqlite.cabal view
@@ -1,22 +1,21 @@ cabal-version:      3.8 name:               dani-sqlite-version:            0.1.0.0-synopsis:           Low-level binding to Sqlite3.-description:        Low-level binding to Sqlite3. -                    UTF8 and BLOB support.+version:            0.1.1.0+synopsis:           SQLite client library.+description:        SQLite client library.                      sqlite library not included. license:            BSD-3-Clause license-file:       LICENSE copyright:          Copyright (c) 2022 - 2022 Daniel Díaz author:             Daniel Díaz <diaz_carrete@yahoo.com>-maintainer:         Daniel Díaz <diaz_carrete@yahoo.com>+maintainer:         Daniel Díaz category:           Database homepage:           https://github.com/danidiaz/dani-sqlite bug-reports:        https://github.com/danidiaz/dani-sqlite/issues/new build-type:         Simple extra-doc-files:    CHANGELOG.md,                     README.md-tested-with:  GHC == {9.10.1, 9.12.2}+tested-with:  GHC == {9.8.4, 9.10.1, 9.12.2}  source-repository head   type:     git@@ -38,7 +37,7 @@                   , text       >= 2.0 && <2.2                   , dani-sqlite:bindings                   , dani-sqlite:direct-  default-language: GHC2024+  default-language: GHC2021   ghc-options:      -Wall -fwarn-tabs  library direct@@ -47,7 +46,7 @@   build-depends:    base       >= 4.16.0.0 && < 5                   , bytestring >= 0.9.2.1 && < 0.13                   , dani-sqlite:bindings-  default-language: GHC2024+  default-language: GHC2021   ghc-options:      -Wall -fwarn-tabs   visibility: public @@ -57,7 +56,7 @@                     Sqlite.Types   build-depends:    base       >= 4.16.0.0 && < 5                   , bytestring >= 0.9.2.1 && < 0.13-  default-language: GHC2024+  default-language: GHC2021   ghc-options:      -Wall -fwarn-tabs   visibility: public   extra-libraries: sqlite3@@ -78,13 +77,12 @@                     , dani-sqlite                     , dani-sqlite:bindings                     , dani-sqlite:direct-  default-language: GHC2024+  default-language: GHC2021   ghc-options:        -Wall -threaded -fno-warn-name-shadowing -fno-warn-unused-do-bind  test-suite test-query-  default-language: GHC2024+  default-language: GHC2021   type:             exitcode-stdio-1.0-   hs-source-dirs: test-query   main-is:        Main.hs   other-modules:  Common@@ -97,13 +95,11 @@                 , TestImports                 , UserInstances                 , Utf8Strings-   ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind--   build-depends: base                , base16-bytestring                , bytestring >= 0.9-               , HUnit+               , tasty >= 1.4.2.1+               , tasty-hunit >= 0.10.0.3                , dani-sqlite                , text
lib-direct/Sqlite/Direct.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DerivingStrategies #-}  -- | -- This API is a slightly lower-level version of "Sqlite3".  Namely:@@ -156,26 +157,27 @@ import System.IO.Unsafe qualified as IOU  newtype Connection = Connection (Ptr CConnection)-  deriving (Eq, Show)+  deriving stock (Eq, Show)  newtype PreparedStatement = PreparedStatement (Ptr CStatement)-  deriving (Eq, Show)+  deriving stock (Eq, Show)  data StepResult   = Row   | Done-  deriving (Eq, Show)+  deriving stock (Eq, Show)  data BackupStepResult   = -- | There are still more pages to be copied.     BackupOK   | -- | All pages were successfully copied.     BackupDone-  deriving (Eq, Show)+  deriving stock (Eq, Show)  -- | A 'ByteString' containing UTF8-encoded text with no NUL characters. newtype Utf8 = Utf8 ByteString-  deriving (Eq, Ord, Semigroup, Monoid)+  deriving stock (Eq, Ord)+  deriving newtype (Semigroup, Monoid, Show)  packUtf8 :: a -> (Utf8 -> a) -> CString -> IO a packUtf8 n f cstr@@ -232,19 +234,19 @@  -- | The context in which a custom SQL function is executed. newtype FuncContext = FuncContext (Ptr CContext)-  deriving (Eq, Show)+  deriving stock (Eq, Show)  -- | The arguments of a custom SQL function. data FuncArgs = FuncArgs CArgCount (Ptr (Ptr CValue))  -- | The type of blob handles used for incremental blob I/O data Blob = Blob Connection (Ptr CBlob) -- we include the db handle to use in-  deriving (Eq, Show) -- error messages since it cannot+  deriving stock (Eq, Show) -- error messages since it cannot   -- be retrieved any other way  -- | A handle for an online backup process. data Backup = Backup Connection (Ptr CBackup)-  deriving (Eq, Show)+  deriving stock (Eq, Show)  -- we include the destination db handle to use in error messages since -- it cannot be retrieved any other way@@ -618,6 +620,9 @@   packCStringLen ptr len  -- | <https://www.sqlite.org/c3ref/last_insert_rowid.html>+--+-- Returns the rowid of the most recent successful INSERT on the+-- given database connection. lastInsertRowId :: Connection -> IO Int64 lastInsertRowId (Connection db) =   c_sqlite3_last_insert_rowid db
lib/Sqlite/Query.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE OverloadedStrings #-}  ------------------------------------------------------------------------------@@ -6,6 +7,7 @@ ------------------------------------------------------------------------------  -- |+-- -- A 'Sql' type representing queries and statements, along with functions for -- executing those. Serialization of parameters and deserialization of results -- from/to common Haskell types.@@ -56,7 +58,7 @@     selectWith,     selectWith_,     selectNamed,-    lastInsertRowId,+    Sqlite.Direct.lastInsertRowId,     changes,     totalChanges, @@ -100,7 +102,6 @@  import Control.Exception import Control.Monad (forM_, void, when)-import Data.Int (Int64) import Data.Text qualified as T import Data.Text.Encoding qualified as TE import Sqlite (ColumnIndex, PreparedStatement, SqlData)@@ -137,7 +138,7 @@     fmtSql :: Sql,     fmtParams :: [String]   }-  deriving (Eq, Show)+  deriving stock (Eq, Show)  instance Exception FormatError @@ -326,28 +327,28 @@   IO [r] select = selectWith fromRow --- | A version of 'query' that does not perform query substitution.+-- | A version of 'select' that does not perform query substitution. select_ :: (FromRow r) => Connection -> Sql -> IO [r] select_ = selectWith_ fromRow --- | A version of 'query' that takes an explicit 'RowParser'.+-- | A version of 'select' that takes an explicit 'RowParser'. selectWith :: (ToRow q) => RowParser r -> Connection -> Sql -> q -> IO [r] selectWith fromRow_ conn templ qs =   withStatementParams conn templ qs do doFoldToList fromRow_ --- | A version of 'query' that does not perform query substitution and+-- | A version of 'select' that does not perform query substitution and -- takes an explicit 'RowParser'. selectWith_ :: RowParser r -> Connection -> Sql -> IO [r] selectWith_ fromRow_ conn query =   withStatement conn query do doFoldToList fromRow_ --- | A version of 'query' where the query parameters (placeholders)+-- | A version of 'select' where the query parameters (placeholders) -- are named. -- -- Example: -- -- @--- r \<- 'queryNamed' c \"SELECT * FROM posts WHERE id=:id AND date>=:date\" [\":id\" ':=' postId, \":date\" ':=' afterDate]+-- r \<- 'selectNamed' c \"SELECT * FROM posts WHERE id=:id AND date>=:date\" [\":id\" ':=' postId, \":date\" ':=' afterDate] -- @ selectNamed :: (FromRow r) => Connection -> Sql -> [NamedParam] -> IO [r] selectNamed conn templ params =@@ -521,13 +522,6 @@ withExclusiveTransaction conn action =   withTransactionPrivate conn action Exclusive --- | Returns the rowid of the most recent successful INSERT on the--- given database connection.------ See also <http://www.sqlite.org/c3ref/last_insert_rowid.html>.-lastInsertRowId :: Connection -> IO Int64-lastInsertRowId = Sqlite.Direct.lastInsertRowId- -- | <http://www.sqlite.org/c3ref/changes.html> -- -- Return the number of rows that were changed, inserted, or deleted@@ -573,33 +567,36 @@ -- refer to a previously inserted row) and 'executeNamed' (an easier -- to maintain form of query parameter naming). ----- >{-# LANGUAGE OverloadedStrings #-}--- >--- >import           Control.Applicative--- >import qualified Data.Text as T--- >import           Sqlite--- >import           Sqlite.Query--- >--- >data TestField = TestField Int T.Text deriving (Show)--- >--- >instance FromRow TestField where--- >  fromRow = TestField <$> field <*> field--- >--- >instance ToRow TestField where--- >  toRow (TestField id_ str) = toRow (id_, str)--- >--- >main :: IO ()--- >main = do--- >  conn <- open "test.db"--- >  execute_ conn "CREATE TABLE IF NOT EXISTS test (id INTEGER PRIMARY KEY, str TEXT)"--- >  execute conn "INSERT INTO test (str) VALUES (?)" (Only ("test string 2" :: String))--- >  execute conn "INSERT INTO test (id, str) VALUES (?,?)" (TestField 13 "test string 3")--- >  rowId <- lastInsertRowId conn--- >  executeNamed conn "UPDATE test SET str = :str WHERE id = :id" [":str" := ("updated str" :: T.Text), ":id" := rowId]--- >  r <- query_ conn "SELECT * from test" :: IO [TestField]--- >  mapM_ print r--- >  execute conn "DELETE FROM test WHERE id = ?" (Only rowId)--- >  close conn+-- >>> :{+-- import Sqlite+-- import Sqlite.Query+-- import Control.Applicative+-- import Data.Text qualified as T+-- --+-- data TestField = TestField Int T.Text deriving (Show)+-- --+-- instance FromRow TestField where+--   fromRow = TestField <$> field <*> field+-- --+-- instance ToRow TestField where+--   toRow (TestField id_ str) = toRow (id_, str)+-- :}+--+-- >>> :{+-- do+--   conn <- open ":memory:"+--   execute_ conn "CREATE TABLE IF NOT EXISTS test (id INTEGER PRIMARY KEY, str TEXT)"+--   execute conn "INSERT INTO test (str) VALUES (?)" (MkSolo ("test string 2" :: String))+--   execute conn "INSERT INTO test (id, str) VALUES (?,?)" (TestField 13 "test string 3")+--   rowId <- lastInsertRowId conn+--   executeNamed conn "UPDATE test SET str = :str WHERE id = :id" [":str" := ("updated str" :: T.Text), ":id" := rowId]+--   r <- select_ conn "SELECT * from test" :: IO [TestField]+--   mapM_ print r+--   execute conn "DELETE FROM test WHERE id = ?" (MkSolo rowId)+--   close conn+-- :}+-- TestField 1 "test string 2"+-- TestField 13 "updated str"  -- $querytype --@@ -613,7 +610,7 @@ -- facility to address both ease of use and security.  A 'Sql' is a -- @newtype@-wrapped 'Text'. It intentionally exposes a tiny API that -- is not compatible with the 'Text' API; this makes it difficult to--- construct queries from fragments of strings.  The 'query' and+-- construct queries from fragments of strings.  The 'select' and -- 'execute' functions require queries to be of type 'Sql'. -- -- To most easily construct a query, enable GHC's @OverloadedStrings@@@ -626,7 +623,7 @@ -- > -- > hello = do -- >   conn <- open "test.db"--- >   [[x]] <- query_ conn "select 2 + 2"+-- >   [[x]] <- select_ conn "select 2 + 2" -- >   print x -- -- A 'Sql' value does not represent the actual query that will be@@ -652,8 +649,8 @@  -- $substpos ----- The 'Sql' template accepted by 'query', 'execute' and 'fold' can--- contain any number of \"@?@\" characters.  Both 'query' and+-- The 'Sql' template accepted by 'select', 'execute' and 'fold' can+-- contain any number of \"@?@\" characters.  Both 'select' and -- 'execute' accept a third argument, typically a tuple. When the -- query executes, the first \"@?@\" in the template will be replaced -- with the first element of the tuple, the second \"@?@\" with the@@ -683,7 +680,7 @@  -- $substnamed ----- Named parameters are accepted by 'queryNamed', 'executeNamed' and+-- Named parameters are accepted by 'selectNamed', 'executeNamed' and -- 'foldNamed'.  These functions take a list of 'NamedParam's which -- are key-value pairs binding a value to an argument name.  As is the -- case with \"@?@\" parameters, named parameters are automatically@@ -693,7 +690,7 @@ -- Example: -- -- @--- r \<- 'queryNamed' c \"SELECT id,text FROM posts WHERE id = :id AND date >= :date\" [\":id\" ':=' postId, \":date\" ':=' afterDate]+-- r \<- 'selectNamed' c \"SELECT id,text FROM posts WHERE id = :id AND date >= :date\" [\":id\" ':=' postId, \":date\" ':=' afterDate] -- @ -- -- Note that you can mix different value types in the same list.@@ -704,7 +701,7 @@ -- @ -- -- The parameter name (or key) in the 'NamedParam' must match exactly--- the name written in the Sql query.  E.g., if you used @:foo@ in+-- the name written in the Sql query. E.g., if you used @:foo@ in -- your Sql statement, you need to use @\":foo\"@ as the parameter -- key, not @\"foo\"@.  Some libraries like Python's sqlite3 -- automatically drop the @:@ character from the name.@@ -717,13 +714,13 @@ -- types. Consider a case where you write a numeric literal in a -- parameter tuple: ----- > query conn "select ? + ?" (40,2)+-- > select conn "select ? + ?" (40,2) -- -- The above query will be rejected by the compiler, because it does -- not know the specific numeric types of the literals @40@ and @2@. -- This is easily fixed: ----- > query conn "select ? + ?" (40 :: Double, 2 :: Double)+-- > select conn "select ? + ?" (40 :: Double, 2 :: Double) -- -- The same kind of problem can arise with string literals if you have -- the @OverloadedStrings@ language extension enabled.  Again, just@@ -746,7 +743,7 @@  -- $result ----- The 'query' and 'query_' functions return a list of values in the+-- The 'select' and 'select_' functions return a list of values in the -- 'FromRow' typeclass. This class performs automatic extraction -- and type conversion of rows from a query result. --@@ -754,7 +751,7 @@ -- -- > import qualified Data.Text as T -- >--- > xs <- query_ conn "select name,age from users"+-- > xs <- select_ conn "select name,age from users" -- > forM_ xs $ \(name,age) -> -- >   putStrLn $ T.unpack name ++ " is " ++ show (age :: Int) --@@ -783,7 +780,7 @@ -- -- > (Text, Maybe Int, Int) ----- If 'query' encounters a @NULL@ in a row where the corresponding+-- If 'select' encounters a @NULL@ in a row where the corresponding -- Haskell type is not 'Maybe', it will throw a 'ResultError' -- exception. @@ -792,7 +789,7 @@ -- To specify that a query returns a single-column result, use the -- 'Only' type. ----- > xs <- query_ conn "select id from users"+-- > xs <- select_ conn "select id from users" -- > forM_ xs $ \(Only dbid) -> {- ... -}  -- $types@@ -803,7 +800,7 @@ -- * For numeric types, any Haskell type that can accurately represent --   an Sqlite INTEGER is considered \"compatible\". ----- * If a numeric incompatibility is found, 'query' will throw a+-- * If a numeric incompatibility is found, 'select' will throw a --   'ResultError'. -- -- * Sqlite's TEXT type is always encoded in UTF-8.  Thus any text@@ -815,3 +812,9 @@ -- -- You can extend conversion support to your own types be adding your -- own 'FromField' / 'ToField' instances.++-- $setup+-- >>> :set -XBlockArguments+-- >>> :set -XOverloadedStrings+-- >>> import Sqlite+-- >>> import Data.Tuple
lib/Sqlite/Query/FromRow.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE UndecidableInstances #-}  ------------------------------------------------------------------------------ @@ -99,8 +100,11 @@ -- For more details refer to 'GFromRow'. class FromRow a where   fromRow :: RowParser a-  default fromRow :: (Generic a) => (GFromRow (Rep a)) => RowParser a+  default fromRow :: (Generic a, GFromRow (Rep a)) => RowParser a   fromRow = to <$> gfromRow++instance (Generic a, GFromRow (Rep a)) => FromRow (Generically a) where+  fromRow = Generically . to <$> gfromRow  fieldWith :: FieldParser a -> RowParser a fieldWith fieldP = do
lib/Sqlite/Query/ToRow.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE UndecidableInstances #-}  ------------------------------------------------------------------------------ @@ -52,8 +53,11 @@ class ToRow a where   toRow :: a -> [SqlData]   -- ^ 'ToField' a collection of values.-  default toRow :: (Generic a) => (GToRow (Rep a)) => a -> [SqlData]+  default toRow :: (Generic a, GToRow (Rep a)) => a -> [SqlData]   toRow a = gtoRow $ from a++instance (Generic a, GToRow (Rep a)) => ToRow (Generically a) where+  toRow (Generically a) = gtoRow $ from a  deriving instance ToRow ()
lib/Sqlite/Query/Types.hs view
@@ -4,7 +4,6 @@  ------------------------------------------------------------------------------ --- | module Sqlite.Query.Types   ( Null (..),     Solo (..),
test-query/Common.hs view
@@ -3,14 +3,12 @@     -- so that we trap we by default export enough out of     -- Database.Sqlite.Simple to make it useful as a single import.     module Sqlite.Query,-    module Test.HUnit,     TestEnv (..),     Solo (..),   ) where  import Sqlite.Query-import Test.HUnit  data TestEnv   = TestEnv
test-query/DirectSqlite.hs view
@@ -9,9 +9,12 @@ import Common import Control.Exception (bracket) import Sqlite qualified as DS+import Test.Tasty.HUnit+import Test.Tasty.HUnit qualified as Tasty -testDirectSqlite :: TestEnv -> Test-testDirectSqlite TestEnv {..} = TestCase $ do+testDirectSqlite :: IO TestEnv -> Tasty.Assertion+testDirectSqlite ioenv = do+  TestEnv {..} <- ioenv   let dsConn = conn   bracket (DS.prepare dsConn "SELECT 1+1") DS.finalize testDirect   [MkSolo (res :: Int)] <- select_ conn "SELECT 1+2"
test-query/Errors.hs view
@@ -19,6 +19,8 @@ import Data.ByteString.Lazy qualified as LB import Data.Word import Sqlite.Query.Types (Null)+import Test.Tasty.HUnit+import Test.Tasty.HUnit qualified as Tasty  -- The "length (show e) `seq` .." trickery below is to force evaluate -- the contents of error messages.  Another option would be to log@@ -45,8 +47,9 @@   catch (action >> return False) (\(e :: ArrayException) -> length (show e) `seq` return True)     >>= assertBool "assertOOBCaught exc" -testErrorsColumns :: TestEnv -> Test-testErrorsColumns TestEnv {..} = TestCase $ do+testErrorsColumns :: IO TestEnv -> Tasty.Assertion+testErrorsColumns ioenv = do+  TestEnv {..} <- ioenv   execute_ conn "CREATE TABLE cols (id INTEGER PRIMARY KEY, t TEXT)"   execute_ conn "INSERT INTO cols (t) VALUES ('test string')"   rows <- select_ conn "SELECT t FROM cols" :: IO [Solo String]@@ -106,8 +109,9 @@         return ()     ) -testErrorsInvalidParams :: TestEnv -> Test-testErrorsInvalidParams TestEnv {..} = TestCase $ do+testErrorsInvalidParams :: IO TestEnv -> Tasty.Assertion+testErrorsInvalidParams ioenv = do+  TestEnv {..} <- ioenv   execute_ conn "CREATE TABLE invparams (id INTEGER PRIMARY KEY, t TEXT)"   -- Test that only unnamed params are accepted   assertFormatErrorCaught@@ -119,8 +123,9 @@   assertFormatErrorCaught     (execute conn "INSERT INTO invparams (id, t) VALUES (?, ?)" (MkSolo (3 :: Int))) -testErrorsInvalidNamedParams :: TestEnv -> Test-testErrorsInvalidNamedParams TestEnv {..} = TestCase $ do+testErrorsInvalidNamedParams :: IO TestEnv -> Tasty.Assertion+testErrorsInvalidNamedParams ioenv = do+  TestEnv {..} <- ioenv   -- Test that only unnamed params are accepted   assertFormatErrorCaught     (selectNamed conn "SELECT :foo" [":foox" := (1 :: Int)] :: IO [Solo Int])@@ -132,32 +137,35 @@   assertFormatErrorCaught     (select conn "SELECT :foo" (MkSolo (1 :: Int)) :: IO [Solo Int]) -testErrorsWithStatement :: TestEnv -> Test-testErrorsWithStatement TestEnv {..} = TestCase $ do+testErrorsWithStatement :: IO TestEnv -> Tasty.Assertion+testErrorsWithStatement ioenv = do+  TestEnv {..} <- ioenv   execute_ conn "CREATE TABLE invstat (id INTEGER PRIMARY KEY, t TEXT)"   assertSQLErrorCaught $     withStatement conn "SELECT id, t, t1 FROM invstat" $ \_stmt ->       assertFailure "Error not detected" -testErrorsColumnName :: TestEnv -> Test-testErrorsColumnName TestEnv {..} = TestCase $ do+testErrorsColumnName :: IO TestEnv -> Tasty.Assertion+testErrorsColumnName ioenv = do+  TestEnv {..} <- ioenv   execute_ conn "CREATE TABLE invcolumn (id INTEGER PRIMARY KEY, t TEXT)"   assertOOBCaught $     withStatement conn "SELECT id FROM invcolumn" $ \stmt ->       columnName stmt (ColumnIndex (-1)) >> assertFailure "Error not detected" -testErrorsTransaction :: TestEnv -> Test-testErrorsTransaction TestEnv {..} = TestCase $ do+testErrorsTransaction :: IO TestEnv -> Tasty.Assertion+testErrorsTransaction ioenv = do+  TestEnv {conn} <- ioenv   execute_ conn "CREATE TABLE trans (id INTEGER PRIMARY KEY, t TEXT)"   v <- withTransaction conn $ do     executeNamed conn "INSERT INTO trans (t) VALUES (:txt)" [":txt" := ("foo" :: String)]     [MkSolo r] <- select_ conn "SELECT t FROM trans" :: IO [Solo String]     return r   v @=? "foo"-  e <- rowExists+  e <- rowExists conn   True @=? e   execute_ conn "DELETE FROM trans"-  e <- rowExists+  e <- rowExists conn   False @=? e   assertFormatErrorCaught     ( withTransaction conn $ do@@ -172,10 +180,10 @@           "INSERT INTO trans (t) VALUES (:txt)"           [":missing" := ("foo" :: String)]     )-  e <- rowExists+  e <- rowExists conn   False @=? e   where-    rowExists = do+    rowExists conn = do       rows <- select_ conn "SELECT t FROM trans" :: IO [Solo String]       case rows of         [MkSolo txt] -> do@@ -185,18 +193,19 @@           return False         _ -> error "should have only one row" -testErrorsImmediateTransaction :: TestEnv -> Test-testErrorsImmediateTransaction TestEnv {..} = TestCase $ do+testErrorsImmediateTransaction :: IO TestEnv -> Tasty.Assertion+testErrorsImmediateTransaction ioenv = do+  TestEnv {..} <- ioenv   execute_ conn "CREATE TABLE itrans (id INTEGER PRIMARY KEY, t TEXT)"   v <- withImmediateTransaction conn $ do     executeNamed conn "INSERT INTO itrans (t) VALUES (:txt)" [":txt" := ("foo" :: String)]     [MkSolo r] <- select_ conn "SELECT t FROM itrans" :: IO [Solo String]     return r   v @=? "foo"-  e <- rowExists+  e <- rowExists conn   True @=? e   execute_ conn "DELETE FROM itrans"-  e <- rowExists+  e <- rowExists conn   False @=? e   assertFormatErrorCaught     ( withImmediateTransaction conn $ do@@ -211,10 +220,10 @@           "INSERT INTO itrans (t) VALUES (:txt)"           [":missing" := ("foo" :: String)]     )-  e <- rowExists+  e <- rowExists conn   False @=? e   where-    rowExists = do+    rowExists conn = do       rows <- select_ conn "SELECT t FROM itrans" :: IO [Solo String]       case rows of         [MkSolo txt] -> do@@ -224,18 +233,19 @@           return False         _ -> error "should have only one row" -testErrorsExclusiveTransaction :: TestEnv -> Test-testErrorsExclusiveTransaction TestEnv {..} = TestCase $ do+testErrorsExclusiveTransaction :: IO TestEnv -> Tasty.Assertion+testErrorsExclusiveTransaction ioenv = do+  TestEnv {..} <- ioenv   execute_ conn "CREATE TABLE etrans (id INTEGER PRIMARY KEY, t TEXT)"   v <- withExclusiveTransaction conn $ do     executeNamed conn "INSERT INTO etrans (t) VALUES (:txt)" [":txt" := ("foo" :: String)]     [MkSolo r] <- select_ conn "SELECT t FROM etrans" :: IO [Solo String]     return r   v @=? "foo"-  e <- rowExists+  e <- rowExists conn   True @=? e   execute_ conn "DELETE FROM etrans"-  e <- rowExists+  e <- rowExists conn   False @=? e   assertFormatErrorCaught     ( withExclusiveTransaction conn $ do@@ -250,10 +260,10 @@           "INSERT INTO etrans (t) VALUES (:txt)"           [":missing" := ("foo" :: String)]     )-  e <- rowExists+  e <- rowExists conn   False @=? e   where-    rowExists = do+    rowExists conn = do       rows <- select_ conn "SELECT t FROM etrans" :: IO [Solo String]       case rows of         [MkSolo txt] -> do
test-query/Fold.hs view
@@ -8,18 +8,20 @@ where  import Common+import Test.Tasty.HUnit qualified as Tasty -testFolds :: TestEnv -> Test-testFolds TestEnv {..} = TestCase $ do+testFolds :: IO TestEnv -> Tasty.Assertion+testFolds ioenv = do+  TestEnv {..} <- ioenv   execute_ conn "CREATE TABLE testf (id INTEGER PRIMARY KEY, t INT)"   execute_ conn "INSERT INTO testf (t) VALUES (4)"   execute_ conn "INSERT INTO testf (t) VALUES (5)"   execute_ conn "INSERT INTO testf (t) VALUES (6)"   val <- fold_ conn "SELECT id,t FROM testf" sumValues do pure ([], [])-  assertEqual "fold_" val ([3, 2, 1], [6, 5, 4])+  Tasty.assertEqual "fold_" val ([3, 2, 1], [6, 5, 4])   val <- fold conn "SELECT id,t FROM testf WHERE id > ?" (MkSolo (1 :: Int)) sumValues do pure ([], [])-  assertEqual "fold" val ([3, 2], [6, 5])+  Tasty.assertEqual "fold" val ([3, 2], [6, 5])   val <- foldNamed conn "SELECT id,t FROM testf WHERE id > :id" [":id" := (1 :: Int)] sumValues do pure ([], [])-  assertEqual "fold" val ([3, 2], [6, 5])+  Tasty.assertEqual "fold" val ([3, 2], [6, 5])   where     sumValues (accId, accT) (id_ :: Int, t :: Int) = return (id_ : accId, t : accT)
test-query/Main.hs view
@@ -3,8 +3,6 @@ module Main where  import Common-import Control.Exception (bracket)-import Control.Monad (when) import DirectSqlite import Errors import Fold@@ -12,70 +10,96 @@ import PreparedStatement import Query import Sqlite-import System.Exit (exitFailure)-import System.IO+import Test.Tasty qualified as Tasty+import Test.Tasty.HUnit qualified as Tasty import TestImports-import TestImports () import UserInstances import Utf8Strings -tests :: [TestEnv -> Test]-tests =-  [ TestLabel "Query" . testSimpleSelect,-    TestLabel "Query" . testSimpleOnePlusOne,-    TestLabel "Query" . testSimpleParams,-    TestLabel "Query" . testSimpleInsertId,-    TestLabel "Query" . testSimpleMultiInsert,-    TestLabel "Query" . testSimpleQueryCov,-    TestLabel "Query" . testSimpleStrings,-    TestLabel "Query" . testSimpleChanges,-    TestLabel "ParamConv" . testParamConvNull,-    TestLabel "ParamConv" . testParamConvInt,-    TestLabel "ParamConv" . testParamConvIntWidths,-    TestLabel "ParamConv" . testParamConvIntWidthsFromField,-    TestLabel "ParamConv" . testParamConvFloat,-    TestLabel "ParamConv" . testParamConvBools,-    TestLabel "ParamConv" . testParamConvToRow,-    TestLabel "ParamConv" . testParamConvFromRow,-    TestLabel "ParamConv" . testParamConvComposite,-    TestLabel "ParamConv" . testParamNamed,-    TestLabel "Errors" . testErrorsColumns,-    TestLabel "Errors" . testErrorsInvalidParams,-    TestLabel "Errors" . testErrorsInvalidNamedParams,-    TestLabel "Errors" . testErrorsWithStatement,-    TestLabel "Errors" . testErrorsColumnName,-    TestLabel "Errors" . testErrorsTransaction,-    TestLabel "Errors" . testErrorsImmediateTransaction,-    TestLabel "Errors" . testErrorsExclusiveTransaction,-    TestLabel "Utf8" . testUtf8Simplest,-    TestLabel "Utf8" . testBlobs,-    TestLabel "Instances" . testUserFromField,-    TestLabel "Instances" . testSqlDataFromField,-    TestLabel "Fold" . testFolds,-    TestLabel "Statement" . testBind,-    TestLabel "Statement" . testDoubleBind,-    TestLabel "Statement" . testPreparedStatements,-    TestLabel "Statement" . testPreparedStatementsColumnCount,-    TestLabel "Direct" . testDirectSqlite,-    TestLabel "Imports" . testImports-  ]+main :: IO ()+main = do+  tastyMain --- | Action for connecting to the database that will be used for testing.------ Note that some tests, such as Notify, use multiple connections, and assume--- that 'testConnect' connects to the same database every time it is called.-testConnect :: IO Connection-testConnect = open ":memory:"+tastyMain :: IO ()+tastyMain = do+  Tasty.defaultMain $+    withTestEnv $ \ioenv ->+      Tasty.testGroup+        "All"+        [ Tasty.testGroup+            "Query"+            [ Tasty.testCase "SimpleSelect" $ testSimpleSelect ioenv,+              Tasty.testCase "OutOfRangeParserSelect" $ testOutOfRangeParserSelect ioenv,+              Tasty.testCase "SimpleOnePlusOne" $ testSimpleOnePlusOne ioenv,+              Tasty.testCase "SimpleParams" $ testSimpleParams ioenv,+              Tasty.testCase "SimpleInsertId" $ testSimpleInsertId ioenv,+              Tasty.testCase "SimpleMultiInsert" $ testSimpleMultiInsert ioenv,+              Tasty.testCase "SimpleQueryCov" $ testSimpleQueryCov ioenv,+              Tasty.testCase "SimpleStrings" $ testSimpleStrings ioenv,+              Tasty.testCase "SimpleChanges" $ testSimpleChanges ioenv+            ],+          Tasty.testGroup+            "ParamConv"+            [ Tasty.testCase "testParamConvNull" $ testParamConvNull ioenv,+              Tasty.testCase "testParamConvInt" $ testParamConvInt ioenv,+              Tasty.testCase "testParamConvIntWidths" $ testParamConvIntWidths ioenv,+              Tasty.testCase "testParamConvIntWidthsFromField" $ testParamConvIntWidthsFromField ioenv,+              Tasty.testCase "testParamConvFloat" $ testParamConvFloat ioenv,+              Tasty.testCase "testParamConvBools" $ testParamConvBools ioenv,+              Tasty.testCase "testParamConvToRow" $ testParamConvToRow ioenv,+              Tasty.testCase "testParamConvFromRow" $ testParamConvFromRow ioenv,+              Tasty.testCase "testParamConvComposite" $ testParamConvComposite ioenv,+              Tasty.testCase "testParamName" $ testParamNamed ioenv+            ],+          Tasty.testGroup+            "Errors"+            [ Tasty.testCase "ErrorsColumns" $ testErrorsColumns ioenv,+              Tasty.testCase "ErrorsInvalidParams" $ testErrorsInvalidParams ioenv,+              Tasty.testCase "ErrorsInvalidNamedParams" $ testErrorsInvalidNamedParams ioenv,+              Tasty.testCase "ErrorsWithStatement" $ testErrorsWithStatement ioenv,+              Tasty.testCase "ErrorsColumnName" $ testErrorsColumnName ioenv,+              Tasty.testCase "ErrorsTransaction" $ testErrorsTransaction ioenv,+              Tasty.testCase "ErrorsImmediateTransaction" $ testErrorsImmediateTransaction ioenv,+              Tasty.testCase "ErrorsExclusiveTransaction" $ testErrorsExclusiveTransaction ioenv+            ],+          Tasty.testGroup+            "Utf8"+            [ Tasty.testCase "Utf8Simplest" $ testUtf8Simplest ioenv,+              Tasty.testCase "Blobs" $ testBlobs ioenv+            ],+          Tasty.testGroup+            "Instances"+            [ Tasty.testCase "UserFromField" $ testUserFromField ioenv,+              Tasty.testCase "SqlDataFromField" $ testSqlDataFromField ioenv+            ],+          Tasty.testGroup+            "Fold"+            [ Tasty.testCase "Folds" $ testFolds ioenv+            ],+          Tasty.testGroup+            "Statement"+            [ Tasty.testCase "Bind" $ testBind ioenv,+              Tasty.testCase "DoubleBind" $ testDoubleBind ioenv,+              Tasty.testCase "PreparedStatements" $ testPreparedStatements ioenv,+              Tasty.testCase "PreparedStatementsColumnCount" $ testPreparedStatementsColumnCount ioenv+            ],+          Tasty.testGroup+            "Direct"+            [ Tasty.testCase "DirectSqlite" $ testDirectSqlite ioenv+            ],+          Tasty.testGroup+            "Imports"+            [ Tasty.testCase "Imports" $ testImports ioenv+            ]+        ] -withTestEnv :: (TestEnv -> IO a) -> IO a-withTestEnv cb =-  withConn $ \conn -> cb TestEnv {conn = conn}+withTestEnv ::+  (IO TestEnv -> Tasty.TestTree) ->+  Tasty.TestTree+withTestEnv =+  Tasty.withResource allocFile deallocFile   where-    withConn = bracket testConnect close--main :: IO ()-main = do-  mapM_ (`hSetBuffering` LineBuffering) [stdout, stderr]-  Counts {cases, tried, errors, failures} <--    withTestEnv $ \env -> runTestTT $ TestList $ map ($ env) tests-  when (cases /= tried || errors /= 0 || failures /= 0) $ exitFailure+    allocFile = do+      conn <- open ":memory:"+      pure TestEnv {conn}+    deallocFile TestEnv {conn} = close conn
test-query/ParamConv.hs view
@@ -2,10 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}--#if MIN_VERSION_base(4,9,0) {-# OPTIONS_GHC -Wno-overflowed-literals #-}-#endif  module ParamConv   ( testParamConvNull,@@ -26,134 +23,143 @@ import Data.Text qualified as T import Data.Word import Sqlite.Query.Types (Null (..))+import Test.Tasty.HUnit+import Test.Tasty.HUnit qualified as Tasty  one, two, three :: Int one = 1 two = 2 three = 3 -testParamConvNull :: TestEnv -> Test-testParamConvNull TestEnv {..} = TestCase $ do+testParamConvNull :: IO TestEnv -> Tasty.Assertion+testParamConvNull ioenv = do+  TestEnv {..} <- ioenv   execute_ conn "CREATE TABLE nulltype (id INTEGER PRIMARY KEY, t1 TEXT)"   [MkSolo r] <- (select_ conn "SELECT NULL") :: IO [Solo Null]   execute conn "INSERT INTO nulltype (id, t1) VALUES (?,?)" (one, r)   [MkSolo mr1] <- select_ conn "SELECT t1 FROM nulltype WHERE id = 1" :: IO [Solo (Maybe String)]-  assertEqual "nulls" Nothing mr1+  Tasty.assertEqual "nulls" Nothing mr1   execute conn "INSERT INTO nulltype (id, t1) VALUES (?,?)" (two, "foo" :: String)   [MkSolo mr2] <- select_ conn "SELECT t1 FROM nulltype WHERE id = 2" :: IO [Solo (Maybe String)]-  assertEqual "nulls" (Just "foo") mr2+  Tasty.assertEqual "nulls" (Just "foo") mr2 -testParamConvInt :: TestEnv -> Test-testParamConvInt TestEnv {..} = TestCase $ do+testParamConvInt :: IO TestEnv -> Tasty.Assertion+testParamConvInt ioenv = do+  TestEnv {..} <- ioenv   [MkSolo r] <- (select conn "SELECT ?" (MkSolo one)) :: IO [Solo Int]-  assertEqual "value" 1 r+  Tasty.assertEqual "value" 1 r   [MkSolo r] <- (select conn "SELECT ?" (MkSolo one)) :: IO [Solo Integer]-  assertEqual "value" 1 r+  Tasty.assertEqual "value" 1 r   [MkSolo r] <- (select conn "SELECT ?+?" (one, two)) :: IO [Solo Int]-  assertEqual "value" 3 r+  Tasty.assertEqual "value" 3 r   [MkSolo r] <- (select conn "SELECT ?+?" (one, 15 :: Int64)) :: IO [Solo Int]-  assertEqual "value" 16 r+  Tasty.assertEqual "value" 16 r   [MkSolo r] <- (select conn "SELECT ?+?" (two, 14 :: Int32)) :: IO [Solo Int]-  assertEqual "value" 16 r+  Tasty.assertEqual "value" 16 r   [MkSolo r] <- (select conn "SELECT ?+?" (two, 14 :: Integer)) :: IO [Solo Int]-  assertEqual "value" 16 r+  Tasty.assertEqual "value" 16 r   -- This overflows 32-bit ints, verify that we get more than 32-bits out   [MkSolo r] <- (select conn "SELECT 255*?" (MkSolo (0x7FFFFFFF :: Int32))) :: IO [Solo Int64]-  assertEqual+  Tasty.assertEqual     "> 32-bit result"     (255 * 0x7FFFFFFF :: Int64)     (fromIntegral r)   [MkSolo r] <- (select conn "SELECT 2*?" (MkSolo (0x7FFFFFFFFF :: Int64))) :: IO [Solo Int64]-  assertEqual+  Tasty.assertEqual     "> 32-bit result & param"     (2 * 0x7FFFFFFFFF :: Int64)     (fromIntegral r)   [MkSolo r] <- (select_ conn "SELECT NULL") :: IO [Solo (Maybe Int)]-  assertEqual "should see nothing" Nothing r+  Tasty.assertEqual "should see nothing" Nothing r   [MkSolo r] <- (select_ conn "SELECT 3") :: IO [Solo (Maybe Int)]-  assertEqual "should see Just 3" (Just 3) r+  Tasty.assertEqual "should see Just 3" (Just 3) r   [MkSolo r] <- (select conn "SELECT ?") (MkSolo (Nothing :: Maybe Int)) :: IO [Solo (Maybe Int)]-  assertEqual "should see nothing" Nothing r+  Tasty.assertEqual "should see nothing" Nothing r   [MkSolo r] <- (select conn "SELECT ?") (MkSolo (Just three :: Maybe Int)) :: IO [Solo (Maybe Int)]-  assertEqual "should see 4" (Just 3) r+  Tasty.assertEqual "should see 4" (Just 3) r -testParamConvIntWidths :: TestEnv -> Test-testParamConvIntWidths TestEnv {..} = TestCase $ do+testParamConvIntWidths :: IO TestEnv -> Tasty.Assertion+testParamConvIntWidths ioenv = do+  TestEnv {..} <- ioenv   [MkSolo r] <- (select conn "SELECT ?" (MkSolo (1 :: Int8))) :: IO [Solo Int]-  assertEqual "value" 1 r+  Tasty.assertEqual "value" 1 r   [MkSolo r] <- (select conn "SELECT ?" (MkSolo (257 :: Int8))) :: IO [Solo Int] -- wrap around-  assertEqual "value" 1 r+  Tasty.assertEqual "value" 1 r   [MkSolo r] <- (select conn "SELECT ?" (MkSolo (257 :: Int16))) :: IO [Solo Int]-  assertEqual "value" 257 r+  Tasty.assertEqual "value" 257 r   [MkSolo r] <- (select conn "SELECT ?" (MkSolo (258 :: Int32))) :: IO [Solo Int]-  assertEqual "value" 258 r+  Tasty.assertEqual "value" 258 r   [MkSolo r] <- (select conn "SELECT ?" (MkSolo (1 :: Word8))) :: IO [Solo Int]-  assertEqual "value" 1 r+  Tasty.assertEqual "value" 1 r   [MkSolo r] <- (select conn "SELECT ?" (MkSolo (257 :: Word8))) :: IO [Solo Int] -- wrap around-  assertEqual "value" 1 r+  Tasty.assertEqual "value" 1 r   [MkSolo r] <- (select conn "SELECT ?" (MkSolo (257 :: Word16))) :: IO [Solo Int]-  assertEqual "value" 257 r+  Tasty.assertEqual "value" 257 r   [MkSolo r] <- (select conn "SELECT ?" (MkSolo (257 :: Word32))) :: IO [Solo Int]-  assertEqual "value" 257 r+  Tasty.assertEqual "value" 257 r   [MkSolo r] <- (select conn "SELECT ?" (MkSolo (0x100000000 :: Word64))) :: IO [Solo Int]-  assertEqual "value" 0x100000000 r+  Tasty.assertEqual "value" 0x100000000 r   [MkSolo r] <- (select conn "SELECT ?" (MkSolo (1 :: Integer))) :: IO [Solo Int]-  assertEqual "value" 1 r+  Tasty.assertEqual "value" 1 r   [MkSolo r] <- (select conn "SELECT ?" (MkSolo (1 :: Word))) :: IO [Solo Int]-  assertEqual "value" 1 r+  Tasty.assertEqual "value" 1 r -testParamConvIntWidthsFromField :: TestEnv -> Test-testParamConvIntWidthsFromField TestEnv {..} = TestCase $ do+testParamConvIntWidthsFromField :: IO TestEnv -> Tasty.Assertion+testParamConvIntWidthsFromField ioenv = do+  TestEnv {..} <- ioenv   [MkSolo r] <- (select conn "SELECT ?" (MkSolo (1 :: Int))) :: IO [Solo Int8]-  assertEqual "value" 1 r+  Tasty.assertEqual "value" 1 r   [MkSolo r] <- (select conn "SELECT ?" (MkSolo (257 :: Int))) :: IO [Solo Int8] -- wrap around-  assertEqual "value" 1 r+  Tasty.assertEqual "value" 1 r   [MkSolo r] <- (select conn "SELECT ?" (MkSolo (65536 :: Int))) :: IO [Solo Int16] -- wrap around-  assertEqual "value" 0 r+  Tasty.assertEqual "value" 0 r   [MkSolo r] <- (select conn "SELECT ?" (MkSolo (65536 :: Int))) :: IO [Solo Int32] -- wrap around-  assertEqual "value" 65536 r+  Tasty.assertEqual "value" 65536 r   [MkSolo r] <- (select conn "SELECT ?" (MkSolo (258 :: Int))) :: IO [Solo Int32]-  assertEqual "value" 258 r+  Tasty.assertEqual "value" 258 r   [MkSolo r] <- (select conn "SELECT ?" (MkSolo (1 :: Int))) :: IO [Solo Word8]-  assertEqual "value" 1 r+  Tasty.assertEqual "value" 1 r   [MkSolo r] <- (select conn "SELECT ?" (MkSolo (257 :: Int))) :: IO [Solo Word8] -- wrap around-  assertEqual "value" 1 r+  Tasty.assertEqual "value" 1 r   [MkSolo r] <- (select conn "SELECT ?" (MkSolo (257 :: Int))) :: IO [Solo Word16]-  assertEqual "value" 257 r+  Tasty.assertEqual "value" 257 r   [MkSolo r] <- (select conn "SELECT ?" (MkSolo (257 :: Int))) :: IO [Solo Word32]-  assertEqual "value" 257 r+  Tasty.assertEqual "value" 257 r   [MkSolo r] <- (select conn "SELECT ?" (MkSolo (0x100000000 :: Int64))) :: IO [Solo Word64]-  assertEqual "value" 0x100000000 r+  Tasty.assertEqual "value" 0x100000000 r   [MkSolo r] <- (select conn "SELECT ?" (MkSolo (1 :: Int))) :: IO [Solo Word]-  assertEqual "value" 1 r+  Tasty.assertEqual "value" 1 r -testParamConvFloat :: TestEnv -> Test-testParamConvFloat TestEnv {..} = TestCase $ do+testParamConvFloat :: IO TestEnv -> Tasty.Assertion+testParamConvFloat ioenv = do+  TestEnv {..} <- ioenv   [MkSolo r] <- select conn "SELECT ?" (MkSolo (1.0 :: Double)) :: IO [Solo Double]-  assertEqual "value" 1.0 r+  Tasty.assertEqual "value" 1.0 r   [MkSolo r] <- select conn "SELECT ?*0.25" (MkSolo (8.0 :: Double)) :: IO [Solo Double]-  assertEqual "value" 2.0 r+  Tasty.assertEqual "value" 2.0 r -testParamConvBools :: TestEnv -> Test-testParamConvBools TestEnv {..} = TestCase $ do+testParamConvBools :: IO TestEnv -> Tasty.Assertion+testParamConvBools ioenv = do+  TestEnv {..} <- ioenv   execute_ conn "CREATE TABLE bt (id INTEGER PRIMARY KEY, b BOOLEAN)"   -- Booleans are ints with values 0 or 1 on Sqlite   execute_ conn "INSERT INTO bt (b) VALUES (0)"   execute_ conn "INSERT INTO bt (b) VALUES (1)"   [MkSolo r1, MkSolo r2] <- select_ conn "SELECT b from bt" :: IO [Solo Bool]-  assertEqual "bool" False r1-  assertEqual "bool" True r2+  Tasty.assertEqual "bool" False r1+  Tasty.assertEqual "bool" True r2   execute conn "INSERT INTO bt (b) VALUES (?)" (MkSolo True)   execute conn "INSERT INTO bt (b) VALUES (?)" (MkSolo False)   execute conn "INSERT INTO bt (b) VALUES (?)" (MkSolo False)   [MkSolo r3, MkSolo r4, MkSolo r5] <-     select_ conn "SELECT b from bt where id in (3, 4, 5) ORDER BY id" :: IO [Solo Bool]-  assertEqual "bool" True r3-  assertEqual "bool" False r4-  assertEqual "bool" False r5+  Tasty.assertEqual "bool" True r3+  Tasty.assertEqual "bool" False r4+  Tasty.assertEqual "bool" False r5 -testParamConvFromRow :: TestEnv -> Test-testParamConvFromRow TestEnv {..} = TestCase $ do+testParamConvFromRow :: IO TestEnv -> Tasty.Assertion+testParamConvFromRow ioenv = do+  TestEnv {..} <- ioenv   [(1, 2)] <- select_ conn "SELECT 1,2" :: IO [(Int, Int)]   [(1, 2, 3)] <- select_ conn "SELECT 1,2,3" :: IO [(Int, Int, Int)]   [(1, 2, 3, 4)] <- select_ conn "SELECT 1,2,3,4" :: IO [(Int, Int, Int, Int)]@@ -166,8 +172,9 @@   [[1, 2, 3]] <- select_ conn "SELECT 1,2,3" :: IO [[Int]]   return () -testParamConvToRow :: TestEnv -> Test-testParamConvToRow TestEnv {..} = TestCase $ do+testParamConvToRow :: IO TestEnv -> Tasty.Assertion+testParamConvToRow ioenv = do+  TestEnv {..} <- ioenv   [MkSolo (s :: Int)] <- select conn "SELECT 13" ()   13 @=? s   [MkSolo (s :: Int)] <- select conn "SELECT ?" (MkSolo one)@@ -223,8 +230,9 @@ instance ToRow TestTuple2 where   toRow (TestTuple2 a b) = [SqlText a, SqlText b] -testParamConvComposite :: TestEnv -> Test-testParamConvComposite TestEnv {..} = TestCase $ do+testParamConvComposite :: IO TestEnv -> Tasty.Assertion+testParamConvComposite ioenv = do+  TestEnv {..} <- ioenv   [t1] <- select_ conn "SELECT 1,2"   TestTuple 1 2 @=? t1   [t2] <- select_ conn "SELECT 'foo','bar'"@@ -237,8 +245,9 @@   z @=? "baz"   w @=? "xyzz" -testParamNamed :: TestEnv -> Test-testParamNamed TestEnv {..} = TestCase $ do+testParamNamed :: IO TestEnv -> Tasty.Assertion+testParamNamed ioenv = do+  TestEnv {..} <- ioenv   [MkSolo t1] <- selectNamed conn "SELECT :foo / :bar" [":foo" := two, ":bar" := one]   t1 @=? (2 :: Int)   [(t1, t2)] <- selectNamed conn "SELECT :foo,:bar" [":foo" := ("foo" :: T.Text), ":bar" := one]
test-query/PreparedStatement.hs view
@@ -12,46 +12,47 @@ import Common   ( ColumnIndex (ColumnIndex),     Solo (..),-    Test (TestCase),     TestEnv (..),-    assertEqual,     columnCount,     columnName,     execute_,     nextRow,     withBind,     withStatement,-    (@=?),-    (@?=),   ) import Data.Maybe (fromJust) import Sqlite qualified as Base+import Test.Tasty.HUnit+import Test.Tasty.HUnit qualified as Tasty -testBind :: TestEnv -> Test-testBind TestEnv {..} = TestCase $ do+testBind :: IO TestEnv -> Tasty.Assertion+testBind ioenv = do+  TestEnv {..} <- ioenv   execute_ conn "CREATE TABLE test_bind (id INTEGER PRIMARY KEY, t TEXT)"   execute_ conn "INSERT INTO test_bind VALUES(1, 'result')"   withStatement conn "SELECT t FROM test_bind WHERE id=?" $ \stmt ->     withBind stmt [1 :: Int] $ do       row <- nextRow stmt :: IO (Maybe (Solo String))-      assertEqual "result" (MkSolo "result") (fromJust row)+      Tasty.assertEqual "result" (MkSolo "result") (fromJust row) -testDoubleBind :: TestEnv -> Test-testDoubleBind TestEnv {..} = TestCase $ do+testDoubleBind :: IO TestEnv -> Tasty.Assertion+testDoubleBind ioenv = do+  TestEnv {..} <- ioenv   execute_ conn "CREATE TABLE test_double_bind (id INTEGER PRIMARY KEY, t TEXT)"   execute_ conn "INSERT INTO test_double_bind VALUES(1, 'first result')"   execute_ conn "INSERT INTO test_double_bind VALUES(2, 'second result')"   withStatement conn "SELECT t FROM test_double_bind WHERE id=?" $ \stmt -> do     withBind stmt [1 :: Int] $ do       row <- nextRow stmt :: IO (Maybe (Solo String))-      assertEqual "first result" (MkSolo "first result") (fromJust row)+      Tasty.assertEqual "first result" (MkSolo "first result") (fromJust row)      withBind stmt [2 :: Int] $ do       row <- nextRow stmt :: IO (Maybe (Solo String))-      assertEqual "second result" (MkSolo "second result") (fromJust row)+      Tasty.assertEqual "second result" (MkSolo "second result") (fromJust row) -testPreparedStatements :: TestEnv -> Test-testPreparedStatements TestEnv {..} = TestCase $ do+testPreparedStatements :: IO TestEnv -> Tasty.Assertion+testPreparedStatements ioenv = do+  TestEnv {..} <- ioenv   execute_ conn "CREATE TABLE ps (id INTEGER PRIMARY KEY, t TEXT)"   execute_ conn "INSERT INTO ps VALUES(1, 'first result')"   execute_ conn "INSERT INTO ps VALUES(2, 'second result')"@@ -67,8 +68,9 @@         Nothing <- nextRow stmt :: IO (Maybe (Solo String))         return r -testPreparedStatementsColumnCount :: TestEnv -> Test-testPreparedStatementsColumnCount TestEnv {..} = TestCase $ do+testPreparedStatementsColumnCount :: IO TestEnv -> Tasty.Assertion+testPreparedStatementsColumnCount ioenv = do+  TestEnv {..} <- ioenv   execute_ conn "CREATE TABLE ps2 (id INTEGER PRIMARY KEY, t TEXT)"   execute_ conn "INSERT INTO ps2 VALUES(1, 'first result')"   withStatement conn "SELECT t FROM ps2 WHERE id=?" $ \stmt -> do
test-query/Query.hs view
@@ -5,6 +5,7 @@ module Query   ( testSimpleOnePlusOne,     testSimpleSelect,+    testOutOfRangeParserSelect,     testSimpleParams,     testSimpleInsertId,     testSimpleMultiInsert,@@ -17,74 +18,86 @@ -- orphan IsString instance in older byteString  import Common+import Control.Exception import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as LBS import Data.ByteString.Lazy.Char8 () import Data.Text qualified as T import Data.Text.Lazy qualified as LT--#if !MIN_VERSION_base(4,11,0)-import Data.Monoid ((<>))-#endif+import Test.Tasty.HUnit+import Test.Tasty.HUnit qualified as Tasty  -- Simplest SELECT-testSimpleOnePlusOne :: TestEnv -> Test-testSimpleOnePlusOne TestEnv {..} = TestCase $ do+testSimpleOnePlusOne :: IO TestEnv -> Tasty.Assertion+testSimpleOnePlusOne ioenv = do+  TestEnv {..} <- ioenv   rows <- select_ conn "SELECT 1+1" :: IO [Solo Int]-  assertEqual "row count" 1 (length rows)-  assertEqual "value" (MkSolo 2) (head rows)+  Tasty.assertEqual "row count" 1 (length rows)+  Tasty.assertEqual "value" (MkSolo 2) (head rows) -testSimpleSelect :: TestEnv -> Test-testSimpleSelect TestEnv {..} = TestCase $ do+testSimpleSelect :: IO TestEnv -> Tasty.Assertion+testSimpleSelect ioenv = do+  TestEnv {..} <- ioenv   execute_ conn "CREATE TABLE test1 (id INTEGER PRIMARY KEY, t TEXT)"   execute_ conn "INSERT INTO test1 (t) VALUES ('test string')"   rows <- select_ conn "SELECT t FROM test1" :: IO [Solo String]-  assertEqual "row count" 1 (length rows)-  assertEqual "string" (MkSolo "test string") (head rows)+  Tasty.assertEqual "row count" 1 (length rows)+  Tasty.assertEqual "string" (MkSolo "test string") (head rows)   rows <- select_ conn "SELECT id,t FROM test1" :: IO [(Int, String)]-  assertEqual "int,string" (1, "test string") (head rows)+  Tasty.assertEqual "int,string" (1, "test string") (head rows)   -- Add another row   execute_ conn "INSERT INTO test1 (t) VALUES ('test string 2')"   rows <- select_ conn "SELECT id,t FROM test1" :: IO [(Int, String)]-  assertEqual "row count" 2 (length rows)-  assertEqual "int,string" (1, "test string") (rows !! 0)-  assertEqual "int,string" (2, "test string 2") (rows !! 1)+  Tasty.assertEqual "row count" 2 (length rows)+  Tasty.assertEqual "int,string" (1, "test string") (rows !! 0)+  Tasty.assertEqual "int,string" (2, "test string 2") (rows !! 1)   [MkSolo r] <- select_ conn "SELECT NULL" :: IO [Solo (Maybe Int)]-  assertEqual "nulls" Nothing r+  Tasty.assertEqual "nulls" Nothing r   [MkSolo r] <- select_ conn "SELECT 1" :: IO [Solo (Maybe Int)]-  assertEqual "nulls" (Just 1) r+  Tasty.assertEqual "nulls" (Just 1) r   [MkSolo r] <- select_ conn "SELECT 1.0" :: IO [Solo Double]-  assertEqual "doubles" 1.0 r+  Tasty.assertEqual "doubles" 1.0 r   [MkSolo r] <- select_ conn "SELECT 1.0" :: IO [Solo Float]-  assertEqual "floats" 1.0 r+  Tasty.assertEqual "floats" 1.0 r -testSimpleParams :: TestEnv -> Test-testSimpleParams TestEnv {..} = TestCase $ do+testOutOfRangeParserSelect :: IO TestEnv -> Tasty.Assertion+testOutOfRangeParserSelect ioenv = do+  TestEnv {..} <- ioenv+  e <- try @ResultError (select_ conn "SELECT 1" :: IO [(Int, Int)])+  case e of+    Left (ConversionFailed {}) -> pure ()+    Left _ -> assertFailure "Actually, we expected another type of error here!"+    Right _ -> assertFailure "Actually, we expected an error here!"++testSimpleParams :: IO TestEnv -> Tasty.Assertion+testSimpleParams ioenv = do+  TestEnv {..} <- ioenv   execute_ conn "CREATE TABLE testparams (id INTEGER PRIMARY KEY, t TEXT)"   execute_ conn "CREATE TABLE testparams2 (id INTEGER, t TEXT, t2 TEXT)"   [MkSolo i] <- select conn "SELECT ?" (MkSolo (42 :: Int)) :: IO [Solo Int]-  assertEqual "select int param" 42 i+  Tasty.assertEqual "select int param" 42 i   execute conn "INSERT INTO testparams (t) VALUES (?)" (MkSolo ("test string" :: String))   rows <- select conn "SELECT t FROM testparams WHERE id = ?" (MkSolo (1 :: Int)) :: IO [Solo String]-  assertEqual "row count" 1 (length rows)-  assertEqual "string" (MkSolo "test string") (head rows)+  Tasty.assertEqual "row count" 1 (length rows)+  Tasty.assertEqual "string" (MkSolo "test string") (head rows)   execute_ conn "INSERT INTO testparams (t) VALUES ('test2')"   [MkSolo row] <- select conn "SELECT t FROM testparams WHERE id = ?" (MkSolo (1 :: Int)) :: IO [Solo String]-  assertEqual "select params" "test string" row+  Tasty.assertEqual "select params" "test string" row   [MkSolo row] <- select conn "SELECT t FROM testparams WHERE id = ?" (MkSolo (2 :: Int)) :: IO [Solo String]-  assertEqual "select params" "test2" row+  Tasty.assertEqual "select params" "test2" row   [MkSolo r1, MkSolo r2] <- select conn "SELECT t FROM testparams WHERE (id = ? OR id = ?)" (1 :: Int, 2 :: Int) :: IO [Solo String]-  assertEqual "select params" "test string" r1-  assertEqual "select params" "test2" r2+  Tasty.assertEqual "select params" "test string" r1+  Tasty.assertEqual "select params" "test2" r2   [MkSolo i] <- select conn "SELECT ?+?" [42 :: Int, 1 :: Int] :: IO [Solo Int]-  assertEqual "select int param" 43 i+  Tasty.assertEqual "select int param" 43 i   [MkSolo d] <- select conn "SELECT ?" [2.0 :: Double] :: IO [Solo Double]-  assertEqual "select double param" 2.0 d+  Tasty.assertEqual "select double param" 2.0 d   [MkSolo f] <- select conn "SELECT ?" [4.0 :: Float] :: IO [Solo Float]-  assertEqual "select double param" 4.0 f+  Tasty.assertEqual "select double param" 4.0 f -testSimpleInsertId :: TestEnv -> Test-testSimpleInsertId TestEnv {..} = TestCase $ do+testSimpleInsertId :: IO TestEnv -> Tasty.Assertion+testSimpleInsertId ioenv = do+  TestEnv {..} <- ioenv   execute_ conn "CREATE TABLE test_row_id (id INTEGER PRIMARY KEY, t TEXT)"   execute conn "INSERT INTO test_row_id (t) VALUES (?)" (MkSolo ("test string" :: String))   id1 <- lastInsertRowId conn@@ -98,8 +111,9 @@   [MkSolo row] <- select conn "SELECT t FROM test_row_id WHERE id = ?" (MkSolo (2 :: Int)) :: IO [Solo String]   "test2" @=? row -testSimpleMultiInsert :: TestEnv -> Test-testSimpleMultiInsert TestEnv {..} = TestCase $ do+testSimpleMultiInsert :: IO TestEnv -> Tasty.Assertion+testSimpleMultiInsert ioenv = do+  TestEnv {..} <- ioenv   execute_ conn "CREATE TABLE test_multi_insert (id INTEGER PRIMARY KEY, t1 TEXT, t2 TEXT)"   executeMany conn "INSERT INTO test_multi_insert (t1, t2) VALUES (?, ?)" ([("foo", "bar"), ("baz", "bat")] :: [(String, String)])   id2 <- lastInsertRowId conn@@ -108,8 +122,9 @@   rows <- select_ conn "SELECT id,t1,t2 FROM test_multi_insert" :: IO [(Int, String, String)]   [(1, "foo", "bar"), (2, "baz", "bat")] @=? rows -testSimpleQueryCov :: TestEnv -> Test-testSimpleQueryCov _ = TestCase $ do+testSimpleQueryCov :: IO TestEnv -> Tasty.Assertion+testSimpleQueryCov ioenv = do+  TestEnv {..} <- ioenv   let str = "SELECT 1+1" :: T.Text       q = "SELECT 1+1" :: Sql   sqlText q @=? str@@ -120,8 +135,9 @@   q @=? foldr mappend mempty ["SELECT ", "1", "+", "1"]   True @=? q <= q -testSimpleStrings :: TestEnv -> Test-testSimpleStrings TestEnv {..} = TestCase $ do+testSimpleStrings :: IO TestEnv -> Tasty.Assertion+testSimpleStrings ioenv = do+  TestEnv {..} <- ioenv   [MkSolo s] <- select_ conn "SELECT 'str1'" :: IO [Solo T.Text]   s @=? "str1"   [MkSolo s] <- select_ conn "SELECT 'strLazy'" :: IO [Solo LT.Text]@@ -139,21 +155,22 @@   [MkSolo s] <- select conn "SELECT ?" (MkSolo ("strBsPLazy2" :: BS.ByteString)) :: IO [Solo LBS.ByteString]   s @=? "strBsPLazy2" -testSimpleChanges :: TestEnv -> Test-testSimpleChanges TestEnv {..} = TestCase $ do+testSimpleChanges :: IO TestEnv -> Tasty.Assertion+testSimpleChanges ioenv = do+  TestEnv {..} <- ioenv   execute_ conn "CREATE TABLE testchanges (id INTEGER PRIMARY KEY, t TEXT)"   execute conn "INSERT INTO testchanges(t) VALUES (?)" (MkSolo ("test string" :: String))   numChanges <- changes conn-  assertEqual "changed/inserted rows" 1 numChanges+  Tasty.assertEqual "changed/inserted rows" 1 numChanges   execute conn "INSERT INTO testchanges(t) VALUES (?)" (MkSolo ("test string 2" :: String))   numChanges <- changes conn-  assertEqual "changed/inserted rows" 1 numChanges+  Tasty.assertEqual "changed/inserted rows" 1 numChanges   execute_ conn "UPDATE testchanges SET t = 'foo' WHERE id = 1"   numChanges <- changes conn-  assertEqual "changed/inserted rows" 1 numChanges+  Tasty.assertEqual "changed/inserted rows" 1 numChanges   execute_ conn "UPDATE testchanges SET t = 'foo' WHERE id = 100"   numChanges <- changes conn-  assertEqual "changed/inserted rows" 0 numChanges+  Tasty.assertEqual "changed/inserted rows" 0 numChanges   execute_ conn "UPDATE testchanges SET t = 'foo'"   numChanges <- changes conn-  assertEqual "changed/inserted rows" 2 numChanges+  Tasty.assertEqual "changed/inserted rows" 2 numChanges
test-query/TestImports.hs view
@@ -11,6 +11,7 @@ import Control.Exception import Data.Text qualified as T import Sqlite+import Test.Tasty.HUnit qualified as Tasty  data TestType = TestType Int Int Int @@ -18,7 +19,7 @@ instance FromRow TestType where   fromRow = TestType <$> field <*> field <*> field -test1 :: IO ()+test1 :: Tasty.Assertion test1 = do   conn <- open ":memory:"   execute_ conn "CREATE TABLE testimp (id INTEGER PRIMARY KEY, id2 INTEGER, id3 INTEGER)"@@ -27,7 +28,7 @@   [_v] <- select conn "SELECT ?+?" (3 :: Int, 4 :: Int) :: IO [(Solo Int)]   close conn -test2 :: Connection -> IO ()+test2 :: Connection -> Tasty.Assertion test2 conn = do   execute_ conn "CREATE TABLE testimp (id INTEGER PRIMARY KEY)"   execute_ conn "INSERT INTO testimp (id) VALUES (1)"@@ -36,13 +37,14 @@   where     q = T.concat ["SELECT * FROM ", "testimp"] -test3 :: Connection -> IO ()+test3 :: Connection -> Tasty.Assertion test3 conn = do   [_v] <- select conn "SELECT ?+?" (3 :: Int, 4 :: Int) :: IO [(Solo Int)]   return () -testImports :: TestEnv -> Test-testImports env = TestCase $ do+testImports :: IO TestEnv -> Tasty.Assertion+testImports ioenv = do+  env <- ioenv   test1   bracket (open ":memory:") close test2   test3 (conn env)
test-query/UserInstances.hs view
@@ -13,6 +13,8 @@ import Sqlite.Query.FromField import Sqlite.Query.Ok import Sqlite.Query.ToField+import Test.Tasty.HUnit+import Test.Tasty.HUnit qualified as Tasty  newtype MyType = MyType String deriving (Eq, Show) @@ -27,8 +29,9 @@   -- Prefix with "toField " to really ensure we got here   toField (MyType s) = SqlText . T.pack $ ("toField " ++ s) -testUserFromField :: TestEnv -> Test-testUserFromField TestEnv {..} = TestCase $ do+testUserFromField :: IO TestEnv -> Tasty.Assertion+testUserFromField ioenv = do+  TestEnv {..} <- ioenv   execute_ conn "CREATE TABLE fromfield (t TEXT)"   execute conn "INSERT INTO fromfield (t) VALUES (?)" (MkSolo ("test string" :: String))   [MkSolo r] <- select_ conn "SELECT t FROM fromfield" :: IO [(Solo MyType)]@@ -38,8 +41,9 @@   [MkSolo r] <- select_ conn "SELECT t FROM fromfield" :: IO [(Solo String)]   "toField test2" @=? r -testSqlDataFromField :: TestEnv -> Test-testSqlDataFromField TestEnv {..} = TestCase $ do+testSqlDataFromField :: IO TestEnv -> Tasty.Assertion+testSqlDataFromField ioenv = do+  TestEnv {..} <- ioenv   execute_ conn "CREATE TABLE sqldatafromfield (t TEXT, i INT, b BOOLEAN, f FLOAT)"   execute     conn
test-query/Utf8Strings.hs view
@@ -10,23 +10,26 @@ import Common import Data.ByteString qualified as B import Data.Word+import Test.Tasty.HUnit qualified as Tasty -testUtf8Simplest :: TestEnv -> Test-testUtf8Simplest TestEnv {..} = TestCase $ do+testUtf8Simplest :: IO TestEnv -> Tasty.Assertion+testUtf8Simplest ioenv = do+  TestEnv {..} <- ioenv   execute_ conn "CREATE TABLE utf (id INTEGER, t TEXT)"   execute_ conn "INSERT INTO utf (id, t) VALUES (1, 'ääöö')"   execute conn "INSERT INTO utf (id, t) VALUES (?,?)" (2 :: Int, "ääööåå" :: String)   [MkSolo t1] <- select conn "SELECT t FROM utf WHERE id = ?" (MkSolo (1 :: Int))-  assertEqual "utf8" ("ääöö" :: String) t1+  Tasty.assertEqual "utf8" ("ääöö" :: String) t1   [MkSolo t2] <- select conn "SELECT t FROM utf WHERE id = ?" (MkSolo (2 :: Int))-  assertEqual "utf8" ("ääööåå" :: String) t2+  Tasty.assertEqual "utf8" ("ääööåå" :: String) t2 -testBlobs :: TestEnv -> Test-testBlobs TestEnv {..} = TestCase $ do+testBlobs :: IO TestEnv -> Tasty.Assertion+testBlobs ioenv = do+  TestEnv {..} <- ioenv   let d = B.pack ([0 .. 127] :: [Word8])   execute_ conn "CREATE TABLE blobs (id INTEGER, b BLOB)"   execute conn "INSERT INTO blobs (id, b) VALUES (?,?)" (1 :: Int, d)   [MkSolo t1] <- select conn "SELECT b FROM blobs WHERE id = ?" (MkSolo (1 :: Int))-  assertEqual "blob" d t1-  assertEqual "blob nul char" 0 (B.index d 0)-  assertEqual "blob first char" 1 (B.index d 1)+  Tasty.assertEqual "blob" d t1+  Tasty.assertEqual "blob nul char" 0 (B.index d 0)+  Tasty.assertEqual "blob first char" 1 (B.index d 1)
test/Main.hs view