{-# LANGUAGE
OverloadedStrings
, ScopedTypeVariables
, FlexibleInstances
, FlexibleContexts
#-}
module Runtests where
import Control.Exception (bracket)
import Data.Int
import Data.List (genericLength)
import Database.HDBI
import Database.HDBI.PostgreSQL
import Database.HDBI.Tests
import System.Environment
import System.Exit
import Test.Framework
import Test.Framework.Providers.HUnit
import Test.Framework.Providers.QuickCheck2
import Test.HUnit ((@?=))
import Test.QuickCheck
import Test.QuickCheck.Assertions
import qualified Data.Text.Lazy as TL
import qualified Test.QuickCheck.Monadic as QM
testAffectedRows :: PostgreConnection -> [Int32] -> Property
testAffectedRows c is = QM.monadicIO $ do
res <- QM.run $ withTransaction c $ do
runRaw c "drop table if exists table2"
runRaw c "create table table2 (val bigint)"
runMany c "insert into table2(val) values (?)" $ map ((:[]) . toSql) is
withStatement c "update table2 set val=10" $ \s -> do
execute s ()
pgAffectedRows s
QM.stop $ res ?== (genericLength is)
pgTests :: PostgreConnection -> Test
pgTests c = testGroup "Auxiliary functions"
[ testProperty "affectedRows" $ testAffectedRows c
, testCase "Check driver name" $ hdbiDriverName c @?= "postgresql"
, testCase "Check transaction support" $ dbTransactionSupport c @?= True
]
fields :: TestFieldTypes
fields = TestFieldTypes
{ tfDecimal = "decimal(600,300)"
, tfInteger = "decimal(300,0)"
, tfDouble = "double precision"
, tfText = "text"
, tfBlob = "bytea"
, tfBool = "boolean"
, tfBitField = "varbit"
, tfUUID = "uuid"
, tfUTCTime = "timestamp with time zone"
, tfLocalDate = "date"
, tfLocalTimeOfDay = "time"
, tfLocalTime = "timestamp without time zone"
}
main :: IO ()
main = do
a <- getArgs
case a of
(conn:args) -> bracket
(connectPostgreSQL $ TL.pack conn)
disconnect
$ \c -> (flip defaultMainWithArgs) args [ allTests fields c
,pgTests c
]
_ -> do
mapM_ putStrLn [ "Need at least one argument as connection string"
, "the rest will be passed as arguments to test-framework"]
exitWith $ ExitFailure 1