{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
-- | Tasty-based test suite for duckdb-simple.
module Main (main) where
import Control.Applicative ((<|>))
import Control.Exception (ErrorCall, Exception, try)
import Control.Monad (replicateM_)
import qualified Data.ByteString as BS
import Data.IORef (atomicModifyIORef', newIORef)
import Data.Int (Int64)
import qualified Data.Text as Text
import Data.Time.Calendar (fromGregorian)
import Data.Time.Clock (UTCTime (..))
import Data.Time.LocalTime (
LocalTime (..),
TimeOfDay (..),
localTimeToUTC,
minutesToTimeZone,
timeOfDayToTime,
utc,
)
import Data.Word (Word16, Word32, Word64, Word8)
import Database.DuckDB.Simple
import Database.DuckDB.Simple.FromField (
Field (..),
IntervalValue (..),
TimeWithZone (..),
returnError,
)
import GHC.Generics (Generic)
import Test.Tasty (TestTree, defaultMain, testGroup)
import Test.Tasty.HUnit
import Database.DuckDB.Simple.Ok (Ok(..))
data Person = Person
{ personId :: Int
, personName :: Text.Text
}
deriving stock (Eq, Show, Generic)
deriving anyclass (FromRow)
data WithRemaining = WithRemaining Int Int
deriving (Eq, Show)
instance FromRow WithRemaining where
fromRow = do
firstVal <- field
remaining <- numFieldsRemaining
replicateM_ remaining (fieldWith (const (Ok ())))
pure (WithRemaining firstVal remaining)
newtype YesNo = YesNo Bool
deriving (Eq, Show)
instance FromRow YesNo where
fromRow = parseYes <|> parseNo
where
parseYes = YesNo True <$ fieldWith (match (Text.pack "yes"))
parseNo = YesNo False <$ fieldWith (match (Text.pack "no"))
match expected fld@Field{} =
case fromField fld :: Ok Text.Text of
Errors err -> Errors err
Ok txt ->
let normalized = Text.toLower txt
in if normalized == expected
then Ok ()
else returnError ConversionFailed fld "failed to match exact string"
newtype NonEmptyText = NonEmptyText Text.Text
deriving (Eq, Show)
nonEmptyTextParser :: FieldParser NonEmptyText
nonEmptyTextParser f@Field{} =
case fromField f of
Errors err -> Errors err
Ok txt
| Text.null txt ->
returnError ConversionFailed f "NonEmptyText requires a non-empty string"
| otherwise -> Ok (NonEmptyText txt)
instance FromField NonEmptyText where
fromField = nonEmptyTextParser
main :: IO ()
main = defaultMain tests
tests :: TestTree
tests =
testGroup
"duckdb-simple"
[ connectionTests
, withConnectionTests
, statementTests
, typeTests
, streamingTests
, functionsTests
, transactionTests
]
connectionTests :: TestTree
connectionTests =
testGroup
"open/close"
[ testCase "opens and closes an in-memory database" $ do
conn <- open ":memory:"
close conn
, testCase "allows closing the same connection twice" $ do
conn <- open ":memory:"
close conn
close conn
]
withConnectionTests :: TestTree
withConnectionTests =
testGroup
"withConnection"
[ testCase "returns the action result" $ do
result <- withConnection ":memory:" \_ -> pure (21 :: Int)
assertEqual "action result" 21 result
, testCase "propagates exceptions from the action" $
assertThrowsErrorCall $
withConnection ":memory:" (\_ -> error "boom" :: IO ())
]
statementTests :: TestTree
statementTests =
testGroup
"statements"
[ testCase "prepares and closes a simple statement" $
withConnection ":memory:" \conn -> do
stmt <- openStatement conn "SELECT 42"
closeStatement stmt
, testCase "allows closing a statement twice" $
withConnection ":memory:" \conn -> do
stmt <- openStatement conn "SELECT 1"
closeStatement stmt
closeStatement stmt
, testCase "rejects preparing statements on a closed connection" $ do
conn <- open ":memory:"
close conn
assertThrowsSQLError $
openStatement conn "SELECT 1"
, testCase "throws SQLError for invalid SQL" $
withConnection ":memory:" \conn ->
assertThrowsSQLError $
openStatement conn "THIS IS NOT VALID SQL"
, testCase "withStatement closes the statement automatically" $
withConnection ":memory:" \conn -> do
result <- withStatement conn "SELECT 1" \_ -> pure ("done" :: String)
assertEqual "withStatement result" "done" result
, testCase "withStatement closes statements even when the action fails" $
withConnection ":memory:" \conn -> do
assertThrowsErrorCall $
withStatement conn "SELECT 1" (\_ -> error "boom" :: IO ())
stmt <- openStatement conn "SELECT 1"
closeStatement stmt
, testCase "execute returns affected row count" $
withConnection ":memory:" \conn -> do
_ <- execute_ conn "CREATE TABLE test_exec (x INTEGER)"
count <- execute conn "INSERT INTO test_exec VALUES (?)" (Only (1 :: Int))
assertEqual "rows affected" 1 count
, testCase "execute runs with positional parameters" $
withConnection ":memory:" \conn -> do
_ <- execute_ conn "CREATE TABLE exec_params (a INTEGER, b TEXT)"
count <- execute conn "INSERT INTO exec_params VALUES (?, ?)" (5 :: Int, "hi" :: String)
assertEqual "rows affected" 1 count
, testCase "rejects invalid direct execution" $
withConnection ":memory:" \conn ->
assertThrowsSQLError $
execute_ conn "THIS IS NOT SQL"
, testCase "binds positional parameters" $
withConnection ":memory:" \conn -> do
_ <- execute_ conn "CREATE TABLE params (a INTEGER, b TEXT)"
withStatement conn "INSERT INTO params VALUES (?, ?)" \stmt -> do
bind stmt [toField (5 :: Int), toField ("hi" :: String)]
changed <- executeStatement stmt
assertEqual "rows affected" 1 changed
, testCase "executeMany reuses prepared statements" $
withConnection ":memory:" \conn -> do
_ <- execute_ conn "CREATE TABLE params_many (a INTEGER, b TEXT)"
total <- executeMany conn "INSERT INTO params_many VALUES (?, ?)" [(1 :: Int, "x" :: String), (2 :: Int, "y" :: String)]
assertEqual "rows affected" 2 total
, testCase "executeNamed binds named parameters" $
withConnection ":memory:" \conn -> do
_ <- execute_ conn "CREATE TABLE named_params (a INTEGER, b TEXT)"
count <- executeNamed conn "INSERT INTO named_params VALUES ($a, $b)" ["$a" := (1 :: Int), "$b" := ("named" :: String)]
assertEqual "rows affected" 1 count
rows <- queryNamed conn "SELECT a FROM named_params WHERE b = $label" ["$label" := ("named" :: String)]
assertEqual "named query" [Only (1 :: Int)] rows
, testCase "rejects incorrect positional argument counts" $
withConnection ":memory:" \conn -> do
_ <- execute_ conn "CREATE TABLE param_count (a INTEGER, b INTEGER)"
assertThrowsFormatError
(execute conn "INSERT INTO param_count VALUES (?, ?)" (Only (1 :: Int)))
(Text.isInfixOf "parameter(s)" . formatErrorMessage)
, testCase "rejects positional bindings on named statements" $
withConnection ":memory:" \conn -> do
_ <- execute_ conn "CREATE TABLE mixed_mode (a INTEGER)"
assertThrowsFormatError
(execute conn "INSERT INTO mixed_mode VALUES ($a)" (Only (1 :: Int)))
(Text.isInfixOf "named parameters" . formatErrorMessage)
, testCase "reports error when mixing positional and named parameters" $
withConnection ":memory:" \conn -> do
_ <- execute_ conn "CREATE TABLE mixed_params (a INTEGER, b TEXT)"
assertThrows
( withStatement conn "INSERT INTO mixed_params VALUES (?, $label)" \stmt -> do
bind stmt [toField (1 :: Int)]
bindNamed stmt ["$label" := ("combo" :: String)]
_ <- executeStatement stmt
pure ()
)
( \(err :: SQLError) ->
Text.isInfixOf "Mixing named and positional parameters" (sqlErrorMessage err)
)
, testCase "generic FromRow derivation works" $
withConnection ":memory:" \conn -> do
_ <- execute_ conn "CREATE TABLE person (id INTEGER, name TEXT)"
_ <- executeMany conn "INSERT INTO person VALUES (?, ?)" [(1 :: Int, "Alice" :: String), (2 :: Int, "Bob" :: String)]
people <- query_ conn "SELECT id, name FROM person ORDER BY id" :: IO [Person]
assertEqual "person rows" [Person 1 (Text.pack "Alice"), Person 2 (Text.pack "Bob")] people
, testCase "(:.) composes row parsing and parameter encoding" $
withConnection ":memory:" \conn -> do
_ <- execute_ conn "CREATE TABLE dot_pair (a INTEGER, b INTEGER, label TEXT)"
let payload = Only (7 :: Int) :. (8 :: Int, Text.pack "hi")
_ <- execute conn "INSERT INTO dot_pair VALUES (?, ?, ?)" payload
rows <- query_ conn "SELECT a, b, label FROM dot_pair" :: IO [Only Int :. (Int, Text.Text)]
case rows of
[Only a :. (b, label)] -> do
assertEqual "(:.) first" 7 a
assertEqual "(:.) second" 8 b
assertEqual "(:.) label" (Text.pack "hi") label
other -> assertFailure ("unexpected (:.) rows: " <> show other)
, testCase "query_ fetches rows" $
withConnection ":memory:" \conn -> do
_ <- execute_ conn "CREATE TABLE query_rows (a INTEGER, b TEXT)"
_ <- executeMany conn "INSERT INTO query_rows VALUES (?, ?)" [(1 :: Int, "x" :: String), (2 :: Int, "y" :: String)]
rows <- query_ conn "SELECT a, b FROM query_rows ORDER BY a"
assertEqual "query rows" [(1 :: Int, "x" :: String), (2 :: Int, "y" :: String)] rows
, testCase "query decodes NULL as Maybe" $
withConnection ":memory:" \conn -> do
_ <- execute_ conn "CREATE TABLE maybe_vals (a TEXT)"
_ <- execute conn "INSERT INTO maybe_vals VALUES (?)" (Only (Just ("present" :: String)))
_ <- execute conn "INSERT INTO maybe_vals VALUES (?)" (Only (Nothing :: Maybe String))
rows <- query_ conn "SELECT a FROM maybe_vals ORDER BY a IS NULL, a"
assertEqual "maybe decoding" [Only (Just ("present" :: String)), Only Nothing] rows
, testCase "query fetches rows with parameters" $
withConnection ":memory:" \conn -> do
_ <- execute_ conn "CREATE TABLE query_params (a INTEGER, b TEXT)"
_ <- executeMany conn "INSERT INTO query_params VALUES (?, ?)" [(1 :: Int, "x" :: String), (2 :: Int, "y" :: String)]
rows <- query conn "SELECT a FROM query_params WHERE b = ?" (Only ("y" :: String))
assertEqual "query result" [Only (2 :: Int)] rows
, testCase "column mismatch surfaces as SQLError" $
withConnection ":memory:" \conn -> do
_ <- execute_ conn "CREATE TABLE mismatch (a INTEGER, b INTEGER)"
_ <- execute_ conn "INSERT INTO mismatch VALUES (1, 2)"
assertThrows
(query_ conn "SELECT a, b FROM mismatch" :: IO [Only Int])
(Text.isInfixOf "column index" . sqlErrorMessage)
, testCase "clears statement bindings without error" $
withConnection ":memory:" \conn -> do
stmt <- openStatement conn "SELECT ?"
clearStatementBindings stmt
closeStatement stmt
, testCase "resolves named parameter indices" $
withConnection ":memory:" \conn -> do
stmt <- openStatement conn "SELECT $named_param"
idx <- namedParameterIndex stmt "named_param"
assertEqual "named parameter index" (Just 1) idx
idxWithPrefix <- namedParameterIndex stmt "$named_param"
assertEqual "named parameter index with prefix" (Just 1) idxWithPrefix
colonIdx <- namedParameterIndex stmt ":named_param"
assertEqual "named parameter index with colon" (Just 1) colonIdx
none <- namedParameterIndex stmt "missing"
assertEqual "missing parameter index" Nothing none
closeStatement stmt
, testCase "reports column metadata for statements" $
withConnection ":memory:" \conn -> do
stmt <- openStatement conn "SELECT 1 AS a, 2 AS b"
count <- columnCount stmt
assertEqual "column count" 2 count
name0 <- columnName stmt 0
name1 <- columnName stmt 1
assertEqual "column names" [Text.pack "a", Text.pack "b"] [name0, name1]
assertThrows
(columnName stmt 2)
(Text.isInfixOf "out of bounds" . sqlErrorMessage)
closeStatement stmt
, testCase "bindNamed rejects statements without named placeholders" $
withConnection ":memory:" \conn -> do
stmt <- openStatement conn "SELECT ?"
assertThrowsFormatError
(bindNamed stmt [":value" := (1 :: Int)])
(Text.isInfixOf "does not define named parameters" . formatErrorMessage)
closeStatement stmt
, testCase "bindNamed rejects unknown parameters" $
withConnection ":memory:" \conn -> do
stmt <- openStatement conn "SELECT $known"
assertThrowsFormatError
(bindNamed stmt ["$missing" := (1 :: Int)])
(Text.isInfixOf "unknown named parameter" . formatErrorMessage)
closeStatement stmt
, testCase "numFieldsRemaining reports remaining columns" $
withConnection ":memory:" \conn -> do
_ <- execute_ conn "CREATE TABLE remaining (a INTEGER, b INTEGER, c INTEGER)"
_ <- execute conn "INSERT INTO remaining VALUES (?, ?, ?)" (1 :: Int, 2 :: Int, 3 :: Int)
rows <- query_ conn "SELECT a, b, c FROM remaining" :: IO [WithRemaining]
assertEqual "remaining count" [WithRemaining 1 2] rows
, testCase "RowParser alternatives fall back" $
withConnection ":memory:" \conn -> do
_ <- execute_ conn "CREATE TABLE yesno (answer TEXT)"
_ <- executeMany conn "INSERT INTO yesno VALUES (?)" [Only ("yes" :: String), Only ("no" :: String)]
rows <- query_ conn "SELECT answer FROM yesno ORDER BY answer" :: IO [YesNo]
assertEqual "yes/no parsing" [YesNo False, YesNo True] rows
]
typeTests :: TestTree
typeTests =
testGroup
"types"
[ testCase "round-trips date/time/timestamp" $
withConnection ":memory:" \conn -> do
_ <- execute_ conn "CREATE TABLE temporals (d DATE, t TIME, ts TIMESTAMP)"
let dayVal = fromGregorian 2024 10 12
timeVal = TimeOfDay 14 30 15.123456
tsVal = LocalTime dayVal timeVal
_ <- execute conn "INSERT INTO temporals VALUES (?, ?, ?)" (dayVal, timeVal, tsVal)
[(dRes, tRes, tsRes)] <- query_ conn "SELECT d, t, ts FROM temporals"
assertEqual "date round-trip" dayVal dRes
assertEqual "time round-trip" timeVal tRes
assertEqual "timestamp round-trip" tsVal tsRes
[Only utcRes] <- query_ conn "SELECT ts FROM temporals" :: IO [Only UTCTime]
assertEqual "timestamp as UTC" (localTimeToUTC utc tsVal) utcRes
, testCase "round-trips blob payloads" $
withConnection ":memory:" \conn -> do
_ <- execute_ conn "CREATE TABLE blobs (payload BLOB)"
let payload = BS.pack [0, 1, 2, 3, 255]
_ <- execute conn "INSERT INTO blobs VALUES (?)" (Only payload)
[Only blobOut] <- query_ conn "SELECT payload FROM blobs"
assertEqual "blob round-trip" payload blobOut
, testCase "round-trips unsigned integers" $
withConnection ":memory:" \conn -> do
_ <- execute_ conn "CREATE TABLE unsigneds (u8 UTINYINT, u16 USMALLINT, u32 UINTEGER, u64 UBIGINT)"
let w8 = 200 :: Word8
w16 = 60000 :: Word16
w32 = 4000000000 :: Word32
w64 = maxBound :: Word64
_ <- execute conn "INSERT INTO unsigneds VALUES (?, ?, ?, ?)" (w8, w16, w32, w64)
[(r8, r16, r32, r64)] <- query_ conn "SELECT u8, u16, u32, u64 FROM unsigneds"
assertEqual "Word8 round-trip" w8 r8
assertEqual "Word16 round-trip" w16 r16
assertEqual "Word32 round-trip" w32 r32
assertEqual "Word64 round-trip" w64 r64
[Only (asWord :: Word)] <- query_ conn "SELECT u64 FROM unsigneds"
assertEqual "Word from UBIGINT" (fromIntegral w64) asWord
, testCase "decodes huge integers as Integer" $
withConnection ":memory:" \conn -> do
let hugeValue = 170141183460469231731687303715884105727 :: Integer
[Only (hugeOut :: Integer)] <-
query_ conn "SELECT 170141183460469231731687303715884105727::HUGEINT"
assertEqual "hugeint" hugeValue hugeOut
, testCase "decodes interval components" $
withConnection ":memory:" \conn -> do
[Only intervalVal] <-
query_ conn "SELECT INTERVAL '2 months 3 days 04:05:06.007008'"
let IntervalValue{intervalMonths, intervalDays, intervalMicros} = intervalVal
expectedMicros =
(((4 * 60 + 5) * 60) + 6) * 1000000 + 7008
assertEqual "interval months" 2 intervalMonths
assertEqual "interval days" 3 intervalDays
assertEqual "interval micros" expectedMicros intervalMicros
, testCase "decodes decimals via Double conversion" $
withConnection ":memory:" \conn -> do
[Only decimalAsDouble] <-
(query_ conn "SELECT CAST(12345.6789 AS DECIMAL(18,4))" :: IO [Only Double])
assertBool
"decimal as double"
(abs (decimalAsDouble - 12345.6789) < 1e-6)
, testCase "decodes time with time zone" $
withConnection ":memory:" \conn -> do
[Only tzVal] <- query_ conn "SELECT TIMETZ '14:30:15+02:30'"
let expectedTime = TimeOfDay 14 30 15
expectedZone = minutesToTimeZone 150
assertEqual "timetz time" expectedTime (timeWithZoneTime tzVal)
assertEqual "timetz zone" expectedZone (timeWithZoneZone tzVal)
, testCase "decodes timestamp with time zone as UTC" $
withConnection ":memory:" \conn -> do
[Only utcVal] <-
(query_ conn "SELECT TIMESTAMPTZ '2024-10-12 14:30:15+02:30'" :: IO [Only UTCTime])
let expected =
UTCTime
(fromGregorian 2024 10 12)
(timeOfDayToTime (TimeOfDay 12 0 15))
assertEqual "timestamptz utc" expected utcVal
, testCase "custom FieldParser enforces invariants" $
withConnection ":memory:" \conn -> do
_ <- execute_ conn "CREATE TABLE nonempty (name TEXT)"
_ <- execute conn "INSERT INTO nonempty VALUES (?)" (Only (Text.pack "okay"))
rows <- query_ conn "SELECT name FROM nonempty" :: IO [Only NonEmptyText]
assertEqual "non-empty success" [Only (NonEmptyText (Text.pack "okay"))] rows
_ <- execute conn "INSERT INTO nonempty VALUES (?)" (Only (Text.pack ""))
assertThrows
(query_ conn "SELECT name FROM nonempty" :: IO [Only NonEmptyText])
(Text.isInfixOf "NonEmptyText requires a non-empty string" . sqlErrorMessage)
]
streamingTests :: TestTree
streamingTests =
testGroup
"streaming"
[ testCase "fold_ accumulates large result sets" $
withConnection ":memory:" \conn -> do
_ <- execute_ conn "CREATE TABLE stream_fold (n INTEGER)"
let rows = fmap Only [1 .. 1000 :: Int]
_ <- executeMany conn "INSERT INTO stream_fold VALUES (?)" rows
total <- fold_ conn "SELECT n FROM stream_fold ORDER BY n" 0 \acc (Only n) -> pure (acc + n)
assertEqual "folded sum" (sum ([1 .. 1000] :: [Int])) total
, testCase "fold and foldNamed respect parameters" $
withConnection ":memory:" \conn -> do
_ <- execute_ conn "CREATE TABLE stream_filter (n INTEGER)"
let values = fmap Only [1 .. 50 :: Int]
_ <- executeMany conn "INSERT INTO stream_filter VALUES (?)" values
gtTotal <-
fold conn "SELECT n FROM stream_filter WHERE n > ?" (Only (40 :: Int)) 0 $
\acc (Only n) -> pure (acc + n)
let expected = sum ([41 .. 50] :: [Int])
assertEqual "filtered fold sum" expected gtTotal
leCount <-
foldNamed conn "SELECT n FROM stream_filter WHERE n <= $limit" ["$limit" := (10 :: Int)] 0 $
\acc (Only (_ :: Int)) -> pure (acc + 1)
assertEqual "foldNamed count" (10 :: Int) leCount
, testCase "nextRow streams rows sequentially" $
withConnection ":memory:" \conn -> do
_ <- execute_ conn "CREATE TABLE stream_cursor (n INTEGER)"
_ <- executeMany conn "INSERT INTO stream_cursor VALUES (?)" (fmap Only [1 .. 3 :: Int])
withStatement conn "SELECT n FROM stream_cursor ORDER BY n" \stmt -> do
first <- nextRow stmt
second <- nextRow stmt
third <- nextRow stmt
done <- nextRow stmt
assertEqual
"cursor iteration"
[Just (Only (1 :: Int)), Just (Only 2), Just (Only 3), Nothing]
[first, second, third, done]
]
functionsTests :: TestTree
functionsTests =
testGroup
"user-defined functions"
[ testCase "registers pure scalar function" $
withConnection ":memory:" \conn -> do
createFunction conn "hs_times_two" (\(x :: Int64) -> x * 2)
result <- query_ conn "SELECT hs_times_two(21)" :: IO [Only Int64]
assertEqual "times_two result" [Only 42] result
, testCase "handles nullable arguments and results" $
withConnection ":memory:" \conn -> do
createFunction conn "hs_optional" (\(mx :: Maybe Int64) -> fmap (+ 1) mx)
rows <-
query_ conn "SELECT hs_optional(x) FROM (VALUES (NULL), (41)) AS t(x)" ::
IO [Only (Maybe Int64)]
assertEqual "optional results" [Only Nothing, Only (Just 42)] rows
, testCase "supports IO-based functions" $
withConnection ":memory:" \conn -> do
ref <- newIORef (0 :: Int)
createFunction conn "hs_counter" $ do
atomicModifyIORef' ref \n ->
let next = n + 1
in (next, next)
first <- query_ conn "SELECT hs_counter()" :: IO [Only Int]
second <- query_ conn "SELECT hs_counter()" :: IO [Only Int]
assertEqual "first counter call" [Only 1] first
assertEqual "second counter call" [Only 2] second
]
transactionTests :: TestTree
transactionTests =
testGroup
"transactions"
[ testCase "withTransaction commits on success" $
withConnection ":memory:" \conn -> do
_ <- execute_ conn "CREATE TABLE tx_commit (x INTEGER)"
withTransaction conn $ do
_ <- execute conn "INSERT INTO tx_commit VALUES (?)" (Only (1 :: Int))
pure ()
rows <- query_ conn "SELECT COUNT(*) FROM tx_commit" :: IO [Only Int]
assertEqual "commit" [Only 1] rows
, testCase "withTransaction rolls back on exception" $
withConnection ":memory:" \conn -> do
_ <- execute_ conn "CREATE TABLE tx_rollback (x INTEGER)"
assertThrowsErrorCall $
withTransaction conn $ do
_ <- execute conn "INSERT INTO tx_rollback VALUES (?)" (Only (1 :: Int))
error "boom"
rows <- query_ conn "SELECT COUNT(*) FROM tx_rollback" :: IO [Only Int]
assertEqual "rollback" [Only 0] rows
]
assertThrows :: forall e a. (Exception e) => IO a -> (e -> Bool) -> Assertion
assertThrows action predicate = do
outcome <- try action
case outcome of
Left (err :: e) -> assertBool "unexpected exception" (predicate err)
Right _ -> assertFailure "expected exception, but action succeeded"
assertThrowsSQLError :: IO a -> Assertion
assertThrowsSQLError action =
assertThrows action (const True :: SQLError -> Bool)
assertThrowsErrorCall :: IO a -> Assertion
assertThrowsErrorCall action =
assertThrows action (const True :: ErrorCall -> Bool)
assertThrowsFormatError :: IO a -> (FormatError -> Bool) -> Assertion
assertThrowsFormatError = assertThrows