sqlite-simple 0.4.18.2 → 0.4.19.0
raw patch · 16 files changed
+178/−84 lines, 16 filesdep +exceptions
Dependencies added: exceptions
Files
- Database/SQLite/Simple.hs +44/−20
- Database/SQLite/Simple/FromField.hs +4/−3
- Database/SQLite/Simple/FromRow.hs +1/−2
- Database/SQLite/Simple/Function.hs +4/−4
- Database/SQLite/Simple/Internal.hs +6/−1
- Database/SQLite/Simple/Ok.hs +5/−1
- Database/SQLite/Simple/QQ.hs +2/−2
- Database/SQLite/Simple/ToField.hs +1/−2
- Database/SQLite/Simple/Types.hs +1/−1
- README.markdown +3/−2
- changelog +0/−3
- sqlite-simple.cabal +4/−3
- test/DirectSqlite.hs +1/−1
- test/Errors.hs +97/−35
- test/Main.hs +1/−0
- test/Simple.hs +4/−4
Database/SQLite/Simple.hs view
@@ -84,6 +84,7 @@ , withTransaction , withImmediateTransaction , withExclusiveTransaction+ , withSavepoint -- * Low-level statement API for stream access and prepared statements , openStatement , closeStatement@@ -107,6 +108,7 @@ import Control.Monad.Trans.Reader import Control.Monad.Trans.State.Strict import Data.Int (Int64)+import Data.IORef import qualified Data.Text as T import qualified Data.Text.Encoding as TE import Data.Typeable (Typeable)@@ -132,7 +134,11 @@ data NamedParam where (:=) :: (ToField v) => T.Text -> v -> NamedParam -data TransactionType = Deferred | Immediate | Exclusive+data TransactionType+ = Deferred+ | Immediate+ | Exclusive+ | Savepoint T.Text infixr 3 := @@ -160,11 +166,11 @@ -- connection. This database will vanish when you close the -- connection. open :: String -> IO Connection-open fname = Connection <$> Base.open (T.pack fname)+open fname = Connection <$> Base.open (T.pack fname) <*> newIORef 0 -- | Close a database connection. close :: Connection -> IO ()-close (Connection c) = Base.close c+close = Base.close . connectionHandle -- | Opens a database connection, executes an action using this connection, and -- closes the connection, even in the presence of exceptions.@@ -182,8 +188,8 @@ -- Warning: If the logger callback throws an exception, your whole -- program may crash. Enable only for debugging! setTrace :: Connection -> Maybe (T.Text -> IO ()) -> IO ()-setTrace (Connection db) logger =- BaseD.setTrace db (fmap (\lf -> lf . unUtf8) logger)+setTrace conn logger =+ BaseD.setTrace (connectionHandle conn) (fmap (\lf -> lf . unUtf8) logger) -- | Binds parameters to a prepared statement. Once 'nextRow' returns 'Nothing', -- the statement must be reset with the 'reset' function before it can be@@ -238,7 +244,7 @@ reset :: Statement -> IO () reset (Statement stmt) = Base.reset stmt --- | Return the name of a a particular column in the result set of a+-- | Return the name of a particular column in the result set of a -- 'Statement'. Throws an 'ArrayException' if the colum index is out -- of bounds. --@@ -273,8 +279,8 @@ -- 'Nothing', you need to invoke 'reset' before reexecuting the statement again -- with 'nextRow'. openStatement :: Connection -> Query -> IO Statement-openStatement (Connection c) (Query t) = do- stmt <- Base.prepare c t+openStatement conn (Query t) = do+ stmt <- Base.prepare (connectionHandle conn) t return $ Statement stmt -- | Closes a prepared statement.@@ -498,12 +504,17 @@ commit return r where- begin = case ttype of- Deferred -> execute_ conn "BEGIN TRANSACTION"- Immediate -> execute_ conn "BEGIN IMMEDIATE TRANSACTION"- Exclusive -> execute_ conn "BEGIN EXCLUSIVE TRANSACTION"- commit = execute_ conn "COMMIT TRANSACTION"- rollback = execute_ conn "ROLLBACK TRANSACTION"+ begin = execute_ conn $ case ttype of+ Deferred -> "BEGIN TRANSACTION"+ Immediate -> "BEGIN IMMEDIATE TRANSACTION"+ Exclusive -> "BEGIN EXCLUSIVE TRANSACTION"+ Savepoint name -> Query $ "SAVEPOINT '" <> name <> "'"+ commit = execute_ conn $ case ttype of+ Savepoint name -> Query $ "RELEASE '" <> name <> "'"+ _ -> "COMMIT TRANSACTION"+ rollback = execute_ conn $ case ttype of+ Savepoint name -> Query $ "ROLLBACK TO '" <> name <> "'"+ _ -> "ROLLBACK TRANSACTION" -- | Run an IO action inside a SQL transaction started with @BEGIN IMMEDIATE@@ -532,21 +543,21 @@ -- -- See also <http://www.sqlite.org/c3ref/last_insert_rowid.html>. lastInsertRowId :: Connection -> IO Int64-lastInsertRowId (Connection c) = BaseD.lastInsertRowId c+lastInsertRowId = BaseD.lastInsertRowId . connectionHandle -- | <http://www.sqlite.org/c3ref/changes.html> -- -- Return the number of rows that were changed, inserted, or deleted -- by the most recent @INSERT@, @DELETE@, or @UPDATE@ statement. changes :: Connection -> IO Int-changes (Connection c) = BaseD.changes c+changes = BaseD.changes . connectionHandle -- | <http://www.sqlite.org/c3ref/total_changes.html> -- -- Return the total number of row changes caused by @INSERT@, @DELETE@, -- or @UPDATE@ statements since the 'Database' was opened. totalChanges :: Connection -> IO Int-totalChanges (Connection c) = BaseD.totalChanges c+totalChanges = BaseD.totalChanges . connectionHandle -- | Run an IO action inside a SQL transaction started with @BEGIN -- TRANSACTION@. If the action throws any kind of an exception, the@@ -556,6 +567,19 @@ withTransaction conn action = withTransactionPrivate conn action Deferred +-- | Run an IO action inside an SQLite @SAVEPOINT@. If the action throws any+-- kind of an exception, the transaction will be rolled back to the savepoint+-- with @ROLLBACK TO@. Otherwise the results are released to the outer+-- transaction if any with @RELEASE@.+--+-- See <https://sqlite.org/lang_savepoint.html> for a full description of+-- savepoint semantics.+withSavepoint :: Connection -> IO a -> IO a+withSavepoint conn action = do+ n <- atomicModifyIORef' (connectionTempNameCounter conn) $ \n -> (n + 1, n)+ withTransactionPrivate conn action $+ Savepoint $ "sqlite_simple_savepoint_" <> T.pack (show n)+ fmtError :: Show v => String -> Query -> [v] -> a fmtError msg q xs = throw FormatError {@@ -624,13 +648,13 @@ -- To most easily construct a query, enable GHC's @OverloadedStrings@ -- language extension and write your query as a normal literal string. ----- > {-# LANGUAGE OverloadedStrings #-}+-- > {-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} -- > -- > import Database.SQLite.Simple -- > -- > hello = do -- > conn <- open "test.db"--- > [[x]] <- query_ conn "select 2 + 2"+-- > [[x :: Int]] <- query_ conn "select 2 + 2" -- > print x -- -- A 'Query' value does not represent the actual query that will be@@ -782,7 +806,7 @@ -- -- Although SQL can accommodate @NULL@ as a value for any of these -- types, Haskell cannot. If your result contains columns that may be--- @NULL@, be sure that you use 'Maybe' in those positions of of your+-- @NULL@, be sure that you use 'Maybe' in those positions of your -- tuple. -- -- > (Text, Maybe Int, Int)
Database/SQLite/Simple/FromField.hs view
@@ -1,6 +1,7 @@-{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-}-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-} ------------------------------------------------------------------------------ -- |
Database/SQLite/Simple/FromRow.hs view
@@ -1,5 +1,4 @@-{-# LANGUAGE RecordWildCards, DefaultSignatures, FlexibleContexts,- StandaloneDeriving #-}+{-# LANGUAGE DefaultSignatures, FlexibleContexts #-} ------------------------------------------------------------------------------ -- |
Database/SQLite/Simple/Function.hs view
@@ -55,8 +55,8 @@ Errors ex -> throw $ ManyErrors ex createFunction :: forall f . Function f => Connection -> T.Text -> f -> IO (Either Base.Error ())-createFunction (Connection db) fn f = Base.createFunction- db+createFunction conn fn f = Base.createFunction+ (connectionHandle conn) (Base.Utf8 $ TE.encodeUtf8 fn) (Just $ Base.ArgCount $ argCount (Proxy :: Proxy f)) (deterministicFn (Proxy :: Proxy f))@@ -65,7 +65,7 @@ ((const :: IO () -> SomeException -> IO ()) $ Base.funcResultNull ctx)) deleteFunction :: Connection -> T.Text -> IO (Either Base.Error ())-deleteFunction (Connection db) fn = Base.deleteFunction- db+deleteFunction conn fn = Base.deleteFunction+ (connectionHandle conn) (Base.Utf8 $ TE.encodeUtf8 fn) Nothing
Database/SQLite/Simple/Internal.hs view
@@ -24,7 +24,9 @@ import Control.Applicative import Data.ByteString (ByteString) import Data.ByteString.Char8()+import Data.IORef import Data.Typeable (Typeable)+import Data.Word import Control.Monad.Trans.State.Strict import Control.Monad.Trans.Reader @@ -39,7 +41,10 @@ -- functionality that's not exposed in the sqlite-simple API. This -- should be a safe thing to do although mixing both APIs is -- discouraged.-newtype Connection = Connection { connectionHandle :: Base.Database }+data Connection = Connection+ { connectionHandle :: {-# UNPACK #-} !Base.Database+ , connectionTempNameCounter :: {-# UNPACK #-} !(IORef Word64)+ } data ColumnOutOfBounds = ColumnOutOfBounds { errorColumnIndex :: !Int } deriving (Eq, Show, Typeable)
Database/SQLite/Simple/Ok.hs view
@@ -19,7 +19,7 @@ -- commonly-used type and typeclass included in @base@. -- -- Extending the failure case to a list of 'SomeException's enables a--- more sensible 'Alternative' instance definitions: '<|>' concatinates+-- more sensible 'Alternative' instance definitions: '<|>' concatenates -- the list of exceptions when both cases fail, and 'empty' is defined as -- 'Errors []'. Though '<|>' one could pick one of two exceptions, and -- throw away the other, and have 'empty' provide a generic exception,@@ -33,6 +33,7 @@ import Control.Applicative import Control.Exception import Control.Monad (MonadPlus(..))+import Control.Monad.Catch (MonadThrow, throwM) import Data.Typeable #if !MIN_VERSION_base(4,13,0) && MIN_VERSION_base(4,9,0)@@ -80,6 +81,9 @@ #if MIN_VERSION_base(4,9,0) instance MonadFail Ok where fail str = Errors [SomeException (ErrorCall str)]++instance MonadThrow Ok where+ throwM = fail . show #endif -- | a way to reify a list of exceptions into a single exception
Database/SQLite/Simple/QQ.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TemplateHaskellQuotes #-} ------------------------------------------------------------------------------ -- |@@ -27,7 +27,7 @@ One should consider turning on the @-XQuasiQuotes@ pragma in that module: @-{-# LANGUAGE QuasiQuoter #-}+{-# LANGUAGE QuasiQuotes #-} myQuery = query conn [sql| SELECT
Database/SQLite/Simple/ToField.hs view
@@ -1,5 +1,4 @@-{-# LANGUAGE DeriveDataTypeable, DeriveFunctor #-}-{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-} ------------------------------------------------------------------------------ -- |
Database/SQLite/Simple/Types.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, GeneralizedNewtypeDeriving, CPP #-}+{-# LANGUAGE DeriveDataTypeable, CPP #-} ------------------------------------------------------------------------------ -- |
README.markdown view
@@ -1,7 +1,7 @@ sqlite-simple: mid-level bindings to the sqlite database ======================================================== -[](http://travis-ci.org/nurpax/sqlite-simple)+[](https://github.com/nurpax/sqlite-simple/actions/workflows/haskell-ci.yml) [](https://hackage.haskell.org/package/sqlite-simple) This library is a mid-level Haskell binding to the SQLite database. @@ -95,7 +95,8 @@ ## Credits - [Janne Hellsten](https://github.com/nurpax) author, long-term maintainer-- [Sergey Bushnyak](https://github.com/sigrlami) current maintainer+- [Sergey Bushnyak](https://github.com/sigrlami) long-term maintainer+- [Joshua Chia](https://github.com/jchia) current maintainer A lot of the code is directly borrowed from [mysql-simple](http://github.com/bos/mysql-simple) by Bryan O'Sullivan
changelog view
@@ -1,6 +1,3 @@-0.4.18.2- * Depend on semigroups only for old GHC versions- 0.4.18.1 * Add generic implementation of 'FromRow' and 'ToRow'.
sqlite-simple.cabal view
@@ -1,5 +1,5 @@ Name: sqlite-simple-Version: 0.4.18.2+Version: 0.4.19.0 Synopsis: Mid-Level SQLite client library Description: Mid-level SQLite client library, based on postgresql-simple.@@ -23,7 +23,7 @@ Build-type: Simple Cabal-version: >= 1.10-+tested-with: GHC == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.8 || == 9.4.8 || == 9.6.3 || == 9.8.1 extra-source-files: README.markdown changelog @@ -51,12 +51,13 @@ bytestring >= 0.9, containers, direct-sqlite >= 2.3.13 && < 2.4,+ exceptions >= 0.4, template-haskell, text >= 0.11, time, transformers, Only >= 0.1 && < 0.1.1- + if impl(ghc < 8.0) Build-depends: semigroups >= 0.18 && < 0.20
test/DirectSqlite.hs view
@@ -14,7 +14,7 @@ testDirectSqlite TestEnv{..} = TestCase $ do let dsConn = connectionHandle conn bracket (DS.prepare dsConn "SELECT 1+1") DS.finalize testDirect- [Only (res :: Int)] <- query_ (Connection dsConn) "SELECT 1+2"+ [Only (res :: Int)] <- query_ conn "SELECT 1+2" assertEqual "1+2" 3 res where testDirect stmt = do
test/Errors.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE ScopedTypeVariables, BangPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-} module Errors ( testErrorsColumns@@ -9,6 +9,7 @@ , testErrorsTransaction , testErrorsImmediateTransaction , testErrorsExclusiveTransaction+ , testErrorsSavepoint ) where import Control.Exception@@ -22,15 +23,11 @@ import Common import Database.SQLite.Simple.Types (Null) --- The "length (show e) `seq` .." trickery below is to force evaluate--- the contents of error messages. Another option would be to log--- them (would be useful), but I don't know if HUnit has any logging--- mechanisms. Just printing them as is will look like the tests are--- hitting errors and would be confusing.-assertResultErrorCaught :: IO a -> Assertion-assertResultErrorCaught action = do- catch (action >> return False) (\(e :: ResultError) -> length (show e) `seq` return True) >>=- assertBool "assertResultError exc"+assertResultErrorThrown :: IO a -> ResultError -> Assertion+assertResultErrorThrown action expectedError =+ catch+ (action >> assertFailure ("Expected error: " ++ show expectedError ++ ", but nothing was thrown"))+ (\(e :: ResultError) -> assertEqual "assertResultErrorThrown" expectedError e) assertFormatErrorCaught :: IO a -> Assertion assertFormatErrorCaught action = do@@ -55,54 +52,85 @@ assertEqual "row count" 1 (length rows) assertEqual "string" (Only "test string") (head rows) -- Mismatched number of output columns (selects two, dest type has 1 field)- assertResultErrorCaught (query_ conn "SELECT id,t FROM cols" :: IO [Only Int])+ assertResultErrorThrown (query_ conn "SELECT id,t FROM cols" :: IO [Only Int])+ ConversionFailed+ { errSQLType = "2 values: [(\"INTEGER\",\"SQLInteger 1\"),(\"TEXT\",\"SQLText \\\"test s[...]\")]"+ , errHaskellType = "at least 1 slots in target type"+ , errMessage = "mismatch between number of columns to convert and number in target type"+ } -- Same as above but the other way round (select 1, dst has two)- assertResultErrorCaught (query_ conn "SELECT id FROM cols" :: IO [(Int, String)])- -- Mismatching types (source int,text doesn't match dst string,int- assertResultErrorCaught (query_ conn "SELECT id, t FROM cols" :: IO [(String, Int)])- -- Mismatching types (source string doesn't match dst integer- assertResultErrorCaught (query_ conn "SELECT 'foo'" :: IO [Only Integer])+ assertResultErrorThrown (query_ conn "SELECT id FROM cols" :: IO [(Int, String)])+ ConversionFailed+ { errSQLType = "1 values: [(\"INTEGER\",\"SQLInteger 1\")]"+ , errHaskellType = "at least 2 slots in target type"+ , errMessage = "mismatch between number of columns to convert and number in target type"+ }+ -- Mismatching types (source int,text doesn't match dst string,int)+ assertResultErrorThrown (query_ conn "SELECT id, t FROM cols" :: IO [(String, Int)])+ ConversionFailed {errSQLType = "INTEGER", errHaskellType = "[Char]", errMessage = "expecting SQLText column type"}+ -- Mismatching types (source string doesn't match dst integer)+ assertResultErrorThrown (query_ conn "SELECT 'foo'" :: IO [Only Integer])+ ConversionFailed {errSQLType = "TEXT", errHaskellType = "Integer", errMessage = "need an int"} -- Mismatching types (sources don't match destination float/double type)- assertResultErrorCaught (query_ conn "SELECT 1" :: IO [Only Double])- assertResultErrorCaught (query_ conn "SELECT 'foo'" :: IO [Only Double])- assertResultErrorCaught (query_ conn "SELECT 1" :: IO [Only Float])- assertResultErrorCaught (query_ conn "SELECT 'foo'" :: IO [Only Float])+ assertResultErrorThrown (query_ conn "SELECT 1" :: IO [Only Double])+ ConversionFailed {errSQLType = "INTEGER", errHaskellType = "Double", errMessage = "expecting an SQLFloat column type"}+ assertResultErrorThrown (query_ conn "SELECT 'foo'" :: IO [Only Double])+ ConversionFailed {errSQLType = "TEXT", errHaskellType = "Double", errMessage = "expecting an SQLFloat column type"}+ assertResultErrorThrown (query_ conn "SELECT 1" :: IO [Only Float])+ ConversionFailed {errSQLType = "INTEGER", errHaskellType = "Float", errMessage = "expecting an SQLFloat column type"}+ assertResultErrorThrown (query_ conn "SELECT 'foo'" :: IO [Only Float])+ ConversionFailed {errSQLType = "TEXT", errHaskellType = "Float", errMessage = "expecting an SQLFloat column type"} -- Mismatching types (sources don't match destination bool type, or is out of bounds)- assertResultErrorCaught (query_ conn "SELECT 'true'" :: IO [Only Bool])- assertResultErrorCaught (query_ conn "SELECT 2" :: IO [Only Bool])+ assertResultErrorThrown (query_ conn "SELECT 'true'" :: IO [Only Bool])+ ConversionFailed {errSQLType = "TEXT", errHaskellType = "Bool", errMessage = "expecting an SQLInteger column type"}+ assertResultErrorThrown (query_ conn "SELECT 2" :: IO [Only Bool])+ ConversionFailed {errSQLType = "INTEGER", errHaskellType = "Bool", errMessage = "bool must be 0 or 1, got 2"} -- Mismatching types (sources don't match destination string types (text, string)- assertResultErrorCaught (query_ conn "SELECT 1" :: IO [Only T.Text])- assertResultErrorCaught (query_ conn "SELECT 1" :: IO [Only LT.Text])- assertResultErrorCaught (query_ conn "SELECT 1.0" :: IO [Only T.Text])- assertResultErrorCaught (query_ conn "SELECT 1.0" :: IO [Only LT.Text])+ assertResultErrorThrown (query_ conn "SELECT 1" :: IO [Only T.Text])+ ConversionFailed {errSQLType = "INTEGER", errHaskellType = "Text", errMessage = "need a text"}+ assertResultErrorThrown (query_ conn "SELECT 1" :: IO [Only LT.Text])+ ConversionFailed {errSQLType = "INTEGER", errHaskellType = "Text", errMessage = "need a text"}+ assertResultErrorThrown (query_ conn "SELECT 1.0" :: IO [Only T.Text])+ ConversionFailed {errSQLType = "FLOAT", errHaskellType = "Text", errMessage = "need a text"}+ assertResultErrorThrown (query_ conn "SELECT 1.0" :: IO [Only LT.Text])+ ConversionFailed {errSQLType = "FLOAT", errHaskellType = "Text", errMessage = "need a text"} -- Mismatching types (sources don't match destination string types (time/date)- assertResultErrorCaught (query_ conn "SELECT 1" :: IO [Only UTCTime])- assertResultErrorCaught (query_ conn "SELECT 1" :: IO [Only Day])+ assertResultErrorThrown (query_ conn "SELECT 1" :: IO [Only UTCTime])+ ConversionFailed {errSQLType = "INTEGER", errHaskellType = "UTCTime", errMessage = "expecting SQLText column type"}+ assertResultErrorThrown (query_ conn "SELECT 1" :: IO [Only Day])+ ConversionFailed {errSQLType = "INTEGER", errHaskellType = "Day", errMessage = "expecting SQLText column type"} -- Mismatching types (sources don't match destination bytestring) [Only (_ :: B.ByteString)] <- query_ conn "SELECT X'3177'"- assertResultErrorCaught (query_ conn "SELECT 1" :: IO [Only B.ByteString])- assertResultErrorCaught (query_ conn "SELECT 1" :: IO [Only LB.ByteString])- assertResultErrorCaught (query_ conn "SELECT 'foo'" :: IO [Only B.ByteString])- assertResultErrorCaught (query_ conn "SELECT 'foo'" :: IO [Only LB.ByteString])+ assertResultErrorThrown (query_ conn "SELECT 1" :: IO [Only B.ByteString])+ ConversionFailed {errSQLType = "INTEGER", errHaskellType = "ByteString", errMessage = "expecting SQLBlob column type"}+ assertResultErrorThrown (query_ conn "SELECT 1" :: IO [Only LB.ByteString])+ ConversionFailed {errSQLType = "INTEGER", errHaskellType = "ByteString", errMessage = "expecting SQLBlob column type"}+ assertResultErrorThrown (query_ conn "SELECT 'foo'" :: IO [Only B.ByteString])+ ConversionFailed {errSQLType = "TEXT", errHaskellType = "ByteString", errMessage = "expecting SQLBlob column type"}+ assertResultErrorThrown (query_ conn "SELECT 'foo'" :: IO [Only LB.ByteString])+ ConversionFailed {errSQLType = "TEXT", errHaskellType = "ByteString", errMessage = "expecting SQLBlob column type"} -- Trying to get a blob into a string let d = B.pack ([0..127] :: [Word8]) execute_ conn "CREATE TABLE cols_blobs (id INTEGER, b BLOB)" execute conn "INSERT INTO cols_blobs (id, b) VALUES (?,?)" (1 :: Int, d)- assertResultErrorCaught+ assertResultErrorThrown (do [Only _t1] <- query conn "SELECT b FROM cols_blobs WHERE id = ?" (Only (1 :: Int)) :: IO [Only String] return ())+ ConversionFailed {errSQLType = "BLOB", errHaskellType = "[Char]", errMessage = "expecting SQLText column type"} execute_ conn "CREATE TABLE cols_bools (id INTEGER PRIMARY KEY, b BOOLEAN)" -- 3 = invalid value for bool, must be 0 or 1 execute_ conn "INSERT INTO cols_bools (b) VALUES (3)"- assertResultErrorCaught+ assertResultErrorThrown (do [Only _t1] <- query_ conn "SELECT b FROM cols_bools" :: IO [Only Bool] return ())+ ConversionFailed {errSQLType = "INTEGER", errHaskellType = "Bool", errMessage = "bool must be 0 or 1, got 3"} [Only (nullVal :: Null)] <- query_ conn "SELECT NULL" False @=? nullVal == nullVal False @=? nullVal /= nullVal- assertResultErrorCaught+ assertResultErrorThrown (do [Only (_t1 :: Null)] <- query_ conn "SELECT 1" :: IO [Only Null] return ())+ ConversionFailed {errSQLType = "INTEGER", errHaskellType = "Null", errMessage = "data is not null"} testErrorsInvalidParams :: TestEnv -> Test testErrorsInvalidParams TestEnv{..} = TestCase $ do@@ -238,6 +266,40 @@ where rowExists = do rows <- query_ conn "SELECT t FROM etrans" :: IO [Only String]+ case rows of+ [Only txt] -> do+ "foo" @=? txt+ return True+ [] ->+ return False+ _ -> error "should have only one row"++testErrorsSavepoint :: TestEnv -> Test+testErrorsSavepoint TestEnv{..} = TestCase $ do+ execute_ conn "CREATE TABLE strans (id INTEGER PRIMARY KEY, t TEXT)"+ v <- withSavepoint conn $ do+ executeNamed conn "INSERT INTO strans (t) VALUES (:txt)" [":txt" := ("foo" :: String)]+ [Only r] <- query_ conn "SELECT t FROM strans" :: IO [Only String]+ return r+ v @=? "foo"+ e <- rowExists+ True @=? e+ execute_ conn "DELETE FROM strans"+ e <- rowExists+ False @=? e+ assertFormatErrorCaught+ (withSavepoint conn $ do+ -- this execute should be automatically rolled back on error+ executeNamed conn+ "INSERT INTO strans (t) VALUES (:txt)" [":txt" := ("foo" :: String)]+ -- intentional mistake here to hit an error & cause rollback of txn+ executeNamed conn+ "INSERT INTO strans (t) VALUES (:txt)" [":missing" := ("foo" :: String)])+ e <- rowExists+ False @=? e+ where+ rowExists = do+ rows <- query_ conn "SELECT t FROM strans" :: IO [Only String] case rows of [Only txt] -> do "foo" @=? txt
test/Main.hs view
@@ -52,6 +52,7 @@ , TestLabel "Errors" . testErrorsTransaction , TestLabel "Errors" . testErrorsImmediateTransaction , TestLabel "Errors" . testErrorsExclusiveTransaction+ , TestLabel "Errors" . testErrorsSavepoint , TestLabel "Utf8" . testUtf8Simplest , TestLabel "Utf8" . testBlobs , TestLabel "Instances" . testUserFromField
test/Simple.hs view
@@ -174,7 +174,7 @@ [d] <- query conn "SELECT ?" (Only (T.append zulu "Z")) matchDates (zulu, d) where- matchDates (str,(Only date)) = do+ matchDates (str, Only date) = do -- Remove 'T' when reading in to Haskell let t = read (makeReadable str) :: UTCTime t @=? date@@ -198,9 +198,9 @@ execute_ conn "CREATE TABLE utctimestz (t TIMESTAMP)" mapM_ (\t -> execute conn "INSERT INTO utctimestz (t) VALUES (?)" (Only t)) timestrs dates <- query_ conn "SELECT t from utctimestz" :: IO [Only UTCTime]- mapM_ matchDates (zip (timestrs) dates)+ mapM_ matchDates (zip timestrs dates) where- matchDates (str,(Only date)) = do+ matchDates (str, Only date) = do -- Remove 'T' when reading in to Haskell let t = read . T.unpack $ str :: UTCTime t @=? date@@ -221,7 +221,7 @@ assertEqual "UTCTime" tstr t testSimpleQueryCov :: TestEnv -> Test-testSimpleQueryCov TestEnv{..} = TestCase $ do+testSimpleQueryCov _ = TestCase $ do let str = "SELECT 1+1" :: T.Text q = "SELECT 1+1" :: Query fromQuery q @=? str