{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE OverloadedStrings #-}
module Specs where

import Control.Monad (replicateM_)
import Control.Exception (catchJust, try, catch)
import Control.Exception.Lifted (bracket)
import Control.Monad.IO.Class (liftIO, MonadIO)
import qualified Data.ByteString as ByteString
import Data.Text (Text)
import qualified Data.Text as X
import GHC.Stack (HasCallStack)
import System.FilePath ((</>))
import Hedgehog (checkSequential, discover, Property, PropertyT, property, forAll, (===),
  assert, eval, footnote, failure, withTests, assert, Gen, MonadTest, evalIO, classify)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import qualified System.IO.Temp as Temp
import Squeather (SQLData(SQLInteger), Database, Statement)
import qualified Squeather
import System.Directory (listDirectory, removeDirectoryRecursive)
import qualified Generators as TG
import qualified Squeather.Internal as Internal
import qualified Foreign

tests :: IO Bool
tests = checkSequential $$(discover)

mkTempDirectory :: (FilePath -> PropertyT IO ()) -> PropertyT IO ()
mkTempDirectory callback = do
  tmpdir <- liftIO $ Temp.getCanonicalTemporaryDirectory
  bracket
    (liftIO $ Temp.createTempDirectory tmpdir "squeather-test")
    (liftIO . removeDirectoryRecursive)
    callback


-- | open creates a file with the given name.
prop_openCreatesFile :: Property
prop_openCreatesFile = withTests 1 . property $ mkTempDirectory $ \tmpDir -> do
  let fn = "db"
  _ <- liftIO $ Squeather.open (X.pack $ tmpDir </> fn)
  dir <- liftIO $ listDirectory tmpDir
  dir === [fn]

-- | open does not create a file when memory is used.
prop_openNoCreateFileOnMemory :: Property
prop_openNoCreateFileOnMemory = withTests 1 . property $ mkTempDirectory $ \tmpDir -> do
  let flgs = Squeather.openFlags { Squeather.memory = True }
      fn = "db"
  _ <- liftIO $ (Squeather.openWithFlags flgs (X.pack $ tmpDir </> fn))
  dir <- liftIO $ listDirectory tmpDir
  dir === []

-- | open does not create a file when NoCreate is used.
prop_openNoCreateFileOnNoCreate :: Property
prop_openNoCreateFileOnNoCreate = withTests 1 . property $ mkTempDirectory $ \tmpDir -> do
  let fn = "db"
      flgs = Squeather.openFlags { Squeather.writeMode = Squeather.ReadWrite Squeather.NoCreate }
      create = liftIO (Squeather.openWithFlags flgs (X.pack $ tmpDir </> fn)) >> return ()
      pd e = Squeather.errorFlag e == Left Squeather.SQLITE_CANTOPEN
  liftIO $ catchJust (\e -> if pd e then Just () else Nothing) create (const (return ()))
  dir <- liftIO $ listDirectory tmpDir
  dir === []

-- | open does not create a file when ReadOnly is used.
prop_openNoCreateFileOnReadOnly :: Property
prop_openNoCreateFileOnReadOnly = withTests 1 . property $ mkTempDirectory $ \tmpDir -> do
  let fn = "db"
      flgs = Squeather.openFlags { Squeather.writeMode = Squeather.ReadOnly }
      create = liftIO (Squeather.openWithFlags flgs (X.pack $ tmpDir </> fn)) >> return ()
      pd e = Squeather.errorFlag e == Left Squeather.SQLITE_CANTOPEN
  liftIO $ catchJust (\e -> if pd e then Just () else Nothing) create (const (return ()))
  dir <- liftIO $ listDirectory tmpDir
  dir === []

-- | The library is compiled with support for threads.
prop_isThreadsafe :: Property
prop_isThreadsafe = withTests 1 . property $ do
  res <- liftIO $ Internal.sqlite3_threadsafe
  res === 1

inMemory :: (Squeather.Database -> IO a) -> IO a
inMemory cback =
  Squeather.openWithFlags (Squeather.openFlags { Squeather.memory = True }) "" >>= cback

-- Only the code after the last forAll is guaranteed to run every
-- test


-- | Insert with exec and then retrieve
prop_insertWithExec :: Property
prop_insertWithExec = property $ do
  sd <- forAll TG.sqlData
  r <- liftIO $ inMemory $ \db -> do
        Squeather.exec db "CREATE TABLE t(c1)"
        _ <- Squeather.executeNamed db "INSERT INTO t VALUES (:c)" [(":c", sd)]
        Squeather.execute db "SELECT c1 FROM t"
  r === [[sd]]

-- | lastInsertRowId works
prop_lastInsertRowId :: Property
prop_lastInsertRowId = property $ do
  nInserts <- forAll $ Gen.int (Range.exponential 1 1000)
  r <- liftIO $ inMemory $ \db -> do
        Squeather.exec db "CREATE TABLE t(c1)"
        replicateM_ nInserts (Squeather.exec db "INSERT INTO t(c1) VALUES (0)")
        Squeather.lastInsertRowId db
  r === fromIntegral nInserts

-- | reset works
prop_reset :: Property
prop_reset = property $ do
  sd <- forAll TG.sqlData
  r <- liftIO $ inMemory $ \db -> do
        Squeather.exec db "CREATE TABLE t(c1)"
        _ <- Squeather.executeNamed db "INSERT INTO t VALUES (:c)" [(":c", sd)]
        stmt <- Squeather.prepare db "SELECT c1 FROM t"
        _ <- Squeather.allRows stmt
        Squeather.reset stmt
        Squeather.allRows stmt
  r === [[sd]]

-- | clearBindings works
prop_clearBindings :: Property
prop_clearBindings = property $ do
  sd <- forAll TG.sqlData
  sd' <- forAll TG.sqlData
  r <- liftIO $ inMemory $ \db -> do
        Squeather.exec db "CREATE TABLE t(c1)"
        stmt <- Squeather.prepare db "INSERT INTO t VALUES (:c)"
        Squeather.bindParameters stmt [(":c", sd)]
        Squeather.clearBindings stmt
        Squeather.bindParameters stmt [(":c", sd')]
        _ <- Squeather.allRows stmt
        Squeather.execute db "SELECT c1 FROM t"
  r === [[sd']]

-- | executeNamed works with variable number of columns and rows
prop_executeNamedVariable :: Property
prop_executeNamedVariable = property $ do
  nCols <- forAll $ Gen.int (Range.exponential 1 20)
  rows <- forAll (Gen.list (Range.exponential 1 20) (Gen.list (Range.singleton nCols) TG.sqlData))
  rows' <- liftIO $ inMemory $ \db -> do
        Squeather.exec db (TG.createTableStatement nCols)
        Squeather.exec db "BEGIN;"
        mapM_ (Squeather.executeNamed db (TG.insertStatement nCols))
          . fmap TG.addColumnLabels $ rows
        Squeather.exec db "COMMIT;"
        Squeather.execute db "SELECT * FROM t ORDER BY rowid"
  rows === rows'

-- | Error messages are generated properly
prop_errorMessages :: Property
prop_errorMessages = withTests 1 . property $ do
  ei <- liftIO . try . inMemory $ \db -> Squeather.execute db "ERROR"
  case ei of
    Left e -> do
      assert $ X.length (Squeather.errorContext e) > 0
      case Squeather.errorFlag e of
        Left err -> () <$ eval err
        Right g -> () <$ eval g
      assert $ X.length (Squeather.errorText e) > 0
      fmap (const ()) . eval . Squeather.errorFilename $ e
    Right _ -> footnote "bad function returned successfully" >> failure

-- | Backup function works
prop_backup :: Property
prop_backup = property $ do
  nCols <- forAll $ Gen.int (Range.exponential 1 20)
  rows <- forAll (Gen.list (Range.exponential 1 20) (Gen.list (Range.singleton nCols) TG.sqlData))
  rows' <- liftIO $ do
        db1 <- Squeather.open ":memory:"
        db2 <- Squeather.open ":memory:"
        Squeather.exec db1 (TG.createTableStatement nCols)
        Squeather.exec db1 "BEGIN;"
        mapM_ (Squeather.executeNamed db1 (TG.insertStatement nCols))
          . fmap TG.addColumnLabels $ rows
        Squeather.exec db1 "COMMIT;"
        Squeather.backup (Squeather.Source db1 "main") (Squeather.Destination db2 "main")
        Squeather.execute db2 "SELECT * FROM t ORDER BY rowid"
  rows === rows'

-- | changes function works
prop_changes :: Property
prop_changes = withTests 1 . property $ do
  r <- liftIO $ inMemory $ \db ->  do
        Squeather.exec db "CREATE TABLE t(c1); INSERT INTO t VALUES (0), (1), (2);"
        Squeather.changes db
  r === 3

-- | columnNames works as it should
prop_columnNames :: Property
prop_columnNames = withTests 1 . property $ do
  r <- liftIO $ inMemory $ \db -> do
        stmt <- Squeather.prepare db "SELECT 1 AS One, 2 AS Two, 3 AS Three"
        Squeather.columnNames stmt
  r === ["One", "Two", "Three"]

-- | executeNamedWithColumns works as it should
prop_executeNamedWithColumns :: Property
prop_executeNamedWithColumns = withTests 1 . property $ do
  r <- liftIO $ inMemory $ \db -> do
        Squeather.exec db "CREATE TABLE t(c1, c2); INSERT INTO t VALUES (0, 5), (1, 6), (2, 7);"
        Squeather.executeNamedWithColumns db
          "SELECT c1 AS C1, c2 AS C2 FROM t WHERE c1 > :val" [(":val", SQLInteger 0)]
  r === (["C1", "C2"], [[SQLInteger 1, SQLInteger 6], [SQLInteger 2, SQLInteger 7]])

-- | finalizing databases doesn't wreak havoc
prop_finalizeDatabase :: Property
prop_finalizeDatabase = withTests 1 . property $ do
  db <- liftIO $ Squeather.open ":memory:"
  liftIO $ Foreign.finalizeForeignPtr (Internal.dbPointer db)

-- | finalizing statements doesn't wreak havoc
prop_finalizeStatement :: Property
prop_finalizeStatement = withTests 1 . property $ do
  db <- liftIO $ Squeather.open ":memory:"
  stmt <- liftIO $ Squeather.prepare db "CREATE TABLE t(c1);"
  liftIO $ Foreign.finalizeForeignPtr (Internal.stmtPointer stmt)

-- | double-quoted non-existent identifiers cause SQLite to fail and
-- causes Squeather to throw an exception.  This is to test that the
-- @-DSQLITE_DQS=0@ compile-time option is working.  Preparing the
-- statement (not even running it) should throw an exception.
prop_doubleQuotedIdentifier :: Property
prop_doubleQuotedIdentifier = withTests 1 . property $ do
  r <- liftIO $ do
    db <- Squeather.open ":memory:"
    Squeather.exec db "CREATE TABLE mytable(mycolumn);"
    let badName = "squeather_column_does_not_exist"
        run = Squeather.prepare db ("SELECT \"" <> badName <> "\" FROM mytable;")
          >> return False
        catcher e = return $ badName `X.isInfixOf` Squeather.errorText e
    catch run catcher
  assert r

-- | The version number is as expected.
prop_version :: Property
prop_version = withTests 1 . property $ Squeather.sqliteVersion === "3.35.5"

-- | parameterCount returns the expected number of parameters
prop_parameterCount :: Property
prop_parameterCount = withTests 1 . property $ do
  db <- liftIO $ Squeather.open ":memory:"
  stmt <- liftIO $ Squeather.prepare db "SELECT :param1, :param2, :param3;"
  count <- liftIO $ Squeather.parameterCount stmt
  count === 3

-- | parameterName behaves as expected with a parameter with an
-- in-range index
prop_parameterNameWithInRangeIndex :: Property
prop_parameterNameWithInRangeIndex = withTests 1 . property $ do
  db <- liftIO $ Squeather.open ":memory:"
  stmt <- liftIO $ Squeather.prepare db "SELECT :param1, :param2, :param3;"
  mayTxt <- liftIO $ Squeather.parameterName stmt 2
  mayTxt === Just ":param2"

-- | parameterName behaves as expected with a parameter with an
-- out-of-range index
prop_parameterNameWithOutOfRangeIndex :: Property
prop_parameterNameWithOutOfRangeIndex = withTests 1 . property $ do
  db <- liftIO $ Squeather.open ":memory:"
  stmt <- liftIO $ Squeather.prepare db "SELECT :param1, :param2, :param3;"
  mayTxt <- liftIO $ Squeather.parameterName stmt 4
  mayTxt === Nothing

-- | createPureScalarFunction fails if SQL function name is empty
prop_createPureScalarFailsOnEmptyName :: Property
prop_createPureScalarFailsOnEmptyName = withTests 1 . property $ do
  dir <- forAll TG.directOnly
  cnt <- forAll $ Gen.int (Range.linear (-1) 127)
  db <- liftIO $ Squeather.open ":memory:"
  ei <- liftIO . try $ Squeather.createPureScalarFunction db dir "" cnt undefined
  case ei of
    Left (Squeather.Error _ fl _ _)
      | fl == Right (Squeather.InvalidSQLFunctionName "") -> pure ()
      | otherwise -> failure
    _ -> failure
    
-- | createPureScalarFunction fails on name too long
prop_createPureScalarFailsOnNameTooLong :: Property
prop_createPureScalarFailsOnNameTooLong = property $ do
  dir <- forAll TG.directOnly
  cnt <- forAll $ Gen.int (Range.linear (-1) 127)
  nm <- forAll $ Gen.text (Range.linear 256 512) Gen.ascii
  db <- liftIO $ Squeather.open ":memory:"
  ei <- liftIO . try $ Squeather.createPureScalarFunction db dir nm cnt undefined
  case ei of
    Left (Squeather.Error _ fl _ _)
      | fl == Right (Squeather.InvalidSQLFunctionName nm) -> pure ()
      | otherwise -> footnote (show fl) >> failure
    _ -> failure

-- | createPureScalarFunction fails on nArgs too small
prop_createPureScalarFailsOnTooSmallNArgs :: Property
prop_createPureScalarFailsOnTooSmallNArgs = property $ do
  dir <- forAll TG.directOnly
  cnt <- forAll . fmap negate $ Gen.int (Range.linear 2 100)
  nm <- forAll $ Gen.text (Range.linear 1 20) Gen.ascii
  db <- liftIO $ Squeather.open ":memory:"
  ei <- liftIO . try $ Squeather.createPureScalarFunction db dir nm cnt undefined
  case ei of
    Left (Squeather.Error _ fl _ _)
      | fl == Right (Squeather.InvalidNumberOfArgs cnt) -> pure ()
      | otherwise -> footnote (show fl) >> failure
    _ -> failure

-- | createPureScalarFunction fails on nArgs too large
prop_createPureScalarFailsOnTooLargeNArgs :: Property
prop_createPureScalarFailsOnTooLargeNArgs = property $ do
  dir <- forAll TG.directOnly
  cnt <- forAll $ Gen.int (Range.linear 128 256)
  nm <- forAll $ Gen.text (Range.linear 1 20) Gen.ascii
  db <- liftIO $ Squeather.open ":memory:"
  ei <- liftIO . try $ Squeather.createPureScalarFunction db dir nm cnt undefined
  case ei of
    Left (Squeather.Error _ fl _ _)
      | fl == Right (Squeather.InvalidNumberOfArgs cnt) -> pure ()
      | otherwise -> footnote (show fl) >> failure
    _ -> failure

-- | Create a table with 5 columns of data.
createTestTable
  :: Database
  -> [SQLData]
  -- ^ Data to fill in.  Must be a list with each inner list 5
  -- long.
  -> IO ()
createTestTable db sqld = do
  let create = "CREATE TABLE t(c0, c1, c2, c3, c4)"
  Squeather.exec db create
  let insertSql = "INSERT INTO t (c0, c1, c2, c3, c4) VALUES (:c0, :c1, :c2, :c3, :c4)"
  insertStmt <- Squeather.prepare db insertSql
  let inserter (c0:c1:c2:c3:c4:[]) = do
        Squeather.bindParameters insertStmt
          [(":c0", c0), (":c1", c1), (":c2", c2), (":c3", c3), (":c4", c4)]
        _ <- Squeather.step insertStmt
        Squeather.reset insertStmt
      inserter _ = error "createTestTable: bad input data"
  inserter sqld

genTestData :: Gen [SQLData]
genTestData = Gen.list (Range.singleton 5) TG.sqlData

copyCol0 :: [SQLData] -> Either Text SQLData
copyCol0 (c0:_) = Right c0
copyCol0 _ = Left "copyCol0: pattern match failure"

copyCol1 :: [SQLData] -> Either Text SQLData
copyCol1 (_:c1:_) = Right c1
copyCol1 _ = Left "copyCol1: pattern match failure"

copyCol2 :: [SQLData] -> Either Text SQLData
copyCol2 (_:_:c2:_) = Right c2
copyCol2 _ = Left "copyCol2: pattern match failure"

copyCol3 :: [SQLData] -> Either Text SQLData
copyCol3 (_:_:_:c3:_) = Right c3
copyCol3 _ = Left "copyCol3: pattern match failure"

copyCol4 :: [SQLData] -> Either Text SQLData
copyCol4 (_:_:_:_:c4:[]) = Right c4
copyCol4 _ = Left "copyCol4: pattern match failure"

prop_copyCol0 :: Property
prop_copyCol0 = property $ do
  td <- forAll genTestData
  db <- liftIO $ Squeather.open ":memory:"
  liftIO $ createTestTable db td
  liftIO $ Squeather.createPureScalarFunction db Squeather.DirectOnly "copyCol" 5 copyCol0
  rslt <- liftIO $ Squeather.execute db "SELECT copyCol(c0, c1, c2, c3, c4) FROM t"
  td !! 0 === head rslt !! 0

prop_copyCol1 :: Property
prop_copyCol1 = property $ do
  td <- forAll genTestData
  db <- liftIO $ Squeather.open ":memory:"
  liftIO $ createTestTable db td
  liftIO $ Squeather.createPureScalarFunction db Squeather.DirectOnly "copyCol" 5 copyCol1
  rslt <- liftIO $ Squeather.execute db "SELECT copyCol(c0, c1, c2, c3, c4) FROM t"
  td !! 1 === head rslt !! 0

prop_copyCol2 :: Property
prop_copyCol2 = property $ do
  td <- forAll genTestData
  db <- liftIO $ Squeather.open ":memory:"
  liftIO $ createTestTable db td
  liftIO $ Squeather.createPureScalarFunction db Squeather.DirectOnly "copyCol" 5 copyCol2
  rslt <- liftIO $ Squeather.execute db "SELECT copyCol(c0, c1, c2, c3, c4) FROM t"
  td !! 2 === head rslt !! 0

prop_copyCol3 :: Property
prop_copyCol3 = property $ do
  td <- forAll genTestData
  db <- liftIO $ Squeather.open ":memory:"
  liftIO $ createTestTable db td
  liftIO $ Squeather.createPureScalarFunction db Squeather.DirectOnly "copyCol" 5 copyCol3
  rslt <- liftIO $ Squeather.execute db "SELECT copyCol(c0, c1, c2, c3, c4) FROM t"
  td !! 3 === head rslt !! 0

prop_copyCol4 :: Property
prop_copyCol4 = property $ do
  td <- forAll genTestData
  db <- liftIO $ Squeather.open ":memory:"
  liftIO $ createTestTable db td
  liftIO $ Squeather.createPureScalarFunction db Squeather.DirectOnly "copyCol" 5 copyCol4
  rslt <- liftIO $ Squeather.execute db "SELECT copyCol(c0, c1, c2, c3, c4) FROM t"
  td !! 4 === head rslt !! 0

prop_returnSQLNull :: Property
prop_returnSQLNull = property $ do
  db <- liftIO $ Squeather.open ":memory:"
  let custFunc _ = Right Squeather.SQLNull
  liftIO $ Squeather.createPureScalarFunction db Squeather.DirectOnly "custFunc" 0 custFunc
  rslt <- liftIO $ Squeather.execute db "SELECT custFunc()"
  rslt === [[Squeather.SQLNull]]

prop_returnFixedSQLInteger :: Property
prop_returnFixedSQLInteger = property $ do
  db <- liftIO $ Squeather.open ":memory:"
  let custFunc _ = Right $ Squeather.SQLInteger 64
  liftIO $ Squeather.createPureScalarFunction db Squeather.DirectOnly "custFunc" 0 custFunc
  rslt <- liftIO $ Squeather.execute db "SELECT custFunc()"
  rslt === [[Squeather.SQLInteger 64]]

prop_returnRandomSQLInteger :: Property
prop_returnRandomSQLInteger = property $ do
  i <- forAll $ Gen.integral Range.exponentialBounded
  db <- liftIO $ Squeather.open ":memory:"
  let custFunc _ = Right $ Squeather.SQLInteger i
  liftIO $ Squeather.createPureScalarFunction db Squeather.DirectOnly "custFunc" 0 custFunc
  rslt <- liftIO $ Squeather.execute db "SELECT custFunc()"
  rslt === [[Squeather.SQLInteger i]]

prop_returnEmptySQLText :: Property
prop_returnEmptySQLText = property $ do
  db <- liftIO $ Squeather.open ":memory:"
  let custFunc _ = Right $ Squeather.SQLText ""
  liftIO $ Squeather.createPureScalarFunction db Squeather.DirectOnly "custFunc" 0 custFunc
  rslt <- liftIO $ Squeather.execute db "SELECT custFunc()"
  rslt === [[Squeather.SQLText ""]]

prop_returnNonEmptySQLText :: Property
prop_returnNonEmptySQLText = property $ do
  db <- liftIO $ Squeather.open ":memory:"
  txt <- forAll $ Gen.text (Range.linear 1 20) Gen.ascii
  let custFunc _ = Right $ Squeather.SQLText txt
  liftIO $ Squeather.createPureScalarFunction db Squeather.DirectOnly "custFunc" 0 custFunc
  rslt <- liftIO $ Squeather.execute db "SELECT custFunc()"
  rslt === [[Squeather.SQLText txt]]

prop_returnZeroSQLFloat :: Property
prop_returnZeroSQLFloat = property $ do
  db <- liftIO $ Squeather.open ":memory:"
  let custFunc _ = Right $ Squeather.SQLFloat 0
  liftIO $ Squeather.createPureScalarFunction db Squeather.DirectOnly "custFunc" 0 custFunc
  rslt <- liftIO $ Squeather.execute db "SELECT custFunc()"
  rslt === [[Squeather.SQLFloat 0]]

prop_returnRandomSQLFloat :: Property
prop_returnRandomSQLFloat = property $ do
  db <- liftIO $ Squeather.open ":memory:"
  flt <- forAll $ Gen.double (Range.exponentialFloat 0 10)
  let custFunc _ = Right $ Squeather.SQLFloat flt
  liftIO $ Squeather.createPureScalarFunction db Squeather.DirectOnly "custFunc" 0 custFunc
  rslt <- liftIO $ Squeather.execute db "SELECT custFunc()"
  rslt === [[Squeather.SQLFloat flt]]

-- | Throwing an exception returns an SQLITE_ERROR.
prop_exceptionInCustomFunctionReturnsError :: Property
prop_exceptionInCustomFunctionReturnsError = property $ do
  db <- liftIO $ Squeather.open ":memory:"
  dir <- forAll TG.directOnly
  cnt <- forAll $ Gen.int (Range.linear (-1) 127)
  let custFunc _ = Right $ Squeather.SQLInteger undefined
  liftIO $ Squeather.createPureScalarFunction db dir "custFunc" cnt custFunc
  ei <- liftIO . try $ Squeather.execute db "SELECT custFunc()"
  case ei of
    Left e -> case Squeather.errorFlag e of
      Left Squeather.SQLITE_ERROR -> pure ()
      x -> footnote (show x) >> failure
    _ -> failure

-- | Returning a Left throws an SQLITE_ERROR.
prop_returningLeftInCustomFunctionThrowsError :: Property
prop_returningLeftInCustomFunctionThrowsError = property $ do
  db <- liftIO $ Squeather.open ":memory:"
  dir <- forAll TG.directOnly
  cnt <- forAll $ Gen.int (Range.linear (-1) 127)
  errStr <- forAll $ Gen.text (Range.linear 0 512) Gen.unicode
  let custFunc _ = Left errStr
  liftIO $ Squeather.createPureScalarFunction db dir "custFunc" cnt custFunc
  ei <- liftIO . try $ Squeather.execute db "SELECT custFunc()"
  case ei of
    Left e -> case Squeather.errorFlag e of
      Left Squeather.SQLITE_ERROR -> pure ()
      x -> footnote (show x) >> failure
    _ -> failure

-- | Gets a single value from a query.  First calls 'step' and fails
-- if 'step' returns Done.
getSingleValue
  :: (MonadIO m, MonadTest m, HasCallStack)
  => (Statement -> Int -> IO a)
  -> Statement
  -> m a
getSingleValue f s = do
  sr <- evalIO $ Squeather.step s
  case sr of
    Squeather.Done -> failure
    Squeather.Row -> evalIO $ f s 0


-- | columnInt64 works as expected.
prop_columnInt64 :: Property
prop_columnInt64 = property $ do
  val <- forAll TG.integer
  db <- evalIO $ Squeather.open ":memory:"
  stmt <- evalIO $ Squeather.prepare db "SELECT ?"
  evalIO $ Squeather.bindInt64 stmt 1 val
  r <- getSingleValue Squeather.columnInt64 stmt
  r === val

-- | columnDouble works as expected.
prop_columnDouble :: Property
prop_columnDouble = property $ do
  val <- forAll TG.double
  db <- evalIO $ Squeather.open ":memory:"
  stmt <- evalIO $ Squeather.prepare db "SELECT ?"
  evalIO $ Squeather.bindDouble stmt 1 val
  r <- getSingleValue Squeather.columnDouble stmt
  r === val

-- | columnText works as expected with non-NULL values.
prop_columnText :: Property
prop_columnText = property $ do
  val <- forAll TG.text
  classify "empty strings" $ X.null val
  db <- evalIO $ Squeather.open ":memory:"
  stmt <- evalIO $ Squeather.prepare db "SELECT ?"
  evalIO $ Squeather.bindText stmt 1 val
  r <- getSingleValue Squeather.columnText stmt
  r === Just val

-- | columnBlob works as expected with non-NULL values.
prop_columnBlob :: Property
prop_columnBlob = property $ do
  val <- forAll TG.blob
  classify "empty blobs" $ ByteString.null val
  db <- evalIO $ Squeather.open ":memory:"
  stmt <- evalIO $ Squeather.prepare db "SELECT :myval"
  evalIO $ Squeather.bindBlob stmt 1 val
  r <- getSingleValue Squeather.columnBlob stmt
  r === Just val

-- | columnText works as expected with NULL values.
prop_columnTextNull :: Property
prop_columnTextNull = property $ do
  db <- evalIO $ Squeather.open ":memory:"
  stmt <- evalIO $ Squeather.prepare db "SELECT ?"
  evalIO $ Squeather.bindNull stmt 1
  r <- getSingleValue Squeather.columnText stmt
  r === Nothing

-- | columnBlob works as expected with NULL values.
prop_columnBlobNull :: Property
prop_columnBlobNull = property $ do
  db <- evalIO $ Squeather.open ":memory:"
  stmt <- evalIO $ Squeather.prepare db "SELECT ?"
  evalIO $ Squeather.bindNull stmt 1
  r <- getSingleValue Squeather.columnBlob stmt
  r === Nothing