2015-11-10 21:19:41 +03:00
|
|
|
module Main where
|
|
|
|
|
2015-11-15 12:13:45 +03:00
|
|
|
import Main.Prelude hiding (assert, isRight, isLeft)
|
2015-11-10 21:19:41 +03:00
|
|
|
import Test.QuickCheck.Instances
|
|
|
|
import Test.Tasty
|
2015-11-15 12:13:45 +03:00
|
|
|
import qualified Main.Queries as Queries
|
2015-11-10 21:19:41 +03:00
|
|
|
import qualified Test.Tasty.HUnit as HUnit
|
|
|
|
import qualified Test.Tasty.SmallCheck as SmallCheck
|
|
|
|
import qualified Test.Tasty.QuickCheck as QuickCheck
|
|
|
|
import qualified Test.QuickCheck as QuickCheck
|
2015-11-15 12:13:45 +03:00
|
|
|
import qualified Main.DSL as DSL
|
2015-11-22 10:10:21 +03:00
|
|
|
import qualified Hasql.Query as Query
|
|
|
|
import qualified Hasql.Encoding as Encoding
|
|
|
|
import qualified Hasql.Decoding as Decoding
|
2015-11-10 21:19:41 +03:00
|
|
|
|
|
|
|
main =
|
|
|
|
defaultMain tree
|
|
|
|
|
|
|
|
tree =
|
2015-11-15 12:13:45 +03:00
|
|
|
testGroup "All tests"
|
2015-11-10 21:19:41 +03:00
|
|
|
[
|
2015-11-15 12:13:45 +03:00
|
|
|
HUnit.testCase "Enum" $
|
|
|
|
HUnit.assertEqual "" (Right "ok") $
|
|
|
|
let
|
|
|
|
actual =
|
|
|
|
unsafePerformIO $
|
|
|
|
DSL.session $ do
|
|
|
|
let
|
|
|
|
query =
|
2015-11-22 10:10:21 +03:00
|
|
|
Query.Query sql mempty Decoding.unit True
|
2015-11-15 12:13:45 +03:00
|
|
|
where
|
|
|
|
sql =
|
|
|
|
"drop type if exists mood"
|
|
|
|
in DSL.query () query
|
|
|
|
let
|
|
|
|
query =
|
2015-11-22 10:10:21 +03:00
|
|
|
Query.Query sql mempty Decoding.unit True
|
2015-11-15 12:13:45 +03:00
|
|
|
where
|
|
|
|
sql =
|
|
|
|
"create type mood as enum ('sad', 'ok', 'happy')"
|
|
|
|
in DSL.query () query
|
|
|
|
let
|
|
|
|
query =
|
2015-11-22 10:10:21 +03:00
|
|
|
Query.Query sql encoder decoder True
|
2015-11-15 12:13:45 +03:00
|
|
|
where
|
|
|
|
sql =
|
|
|
|
"select ($1 :: mood)"
|
2015-11-21 13:36:01 +03:00
|
|
|
decoder =
|
2015-11-22 10:10:21 +03:00
|
|
|
(Decoding.singleRow (Decoding.value (Decoding.enum (Just . id))))
|
2015-11-21 13:36:01 +03:00
|
|
|
encoder =
|
2015-11-22 10:10:21 +03:00
|
|
|
Encoding.value (Encoding.enum id)
|
2015-11-15 12:13:45 +03:00
|
|
|
in DSL.query "ok" query
|
|
|
|
in actual
|
|
|
|
,
|
|
|
|
HUnit.testCase "The same prepared statement used on different types" $
|
|
|
|
HUnit.assertEqual "" (Right ("ok", 1)) $
|
|
|
|
let
|
|
|
|
actual =
|
|
|
|
unsafePerformIO $
|
|
|
|
DSL.session $ do
|
|
|
|
let
|
|
|
|
effect1 =
|
|
|
|
DSL.query "ok" query
|
|
|
|
where
|
|
|
|
query =
|
2015-11-22 10:10:21 +03:00
|
|
|
Query.Query sql encoder decoder True
|
2015-11-15 12:13:45 +03:00
|
|
|
where
|
|
|
|
sql =
|
|
|
|
"select $1"
|
2015-11-21 13:36:01 +03:00
|
|
|
encoder =
|
2015-11-22 10:10:21 +03:00
|
|
|
Encoding.value Encoding.text
|
2015-11-21 13:36:01 +03:00
|
|
|
decoder =
|
2015-11-22 10:10:21 +03:00
|
|
|
(Decoding.singleRow (Decoding.value (Decoding.text)))
|
2015-11-15 12:13:45 +03:00
|
|
|
effect2 =
|
|
|
|
DSL.query 1 query
|
|
|
|
where
|
|
|
|
query =
|
2015-11-22 10:10:21 +03:00
|
|
|
Query.Query sql encoder decoder True
|
2015-11-15 12:13:45 +03:00
|
|
|
where
|
|
|
|
sql =
|
|
|
|
"select $1"
|
2015-11-21 13:36:01 +03:00
|
|
|
encoder =
|
2015-11-22 10:10:21 +03:00
|
|
|
Encoding.value Encoding.int8
|
2015-11-21 13:36:01 +03:00
|
|
|
decoder =
|
2015-11-22 10:10:21 +03:00
|
|
|
(Decoding.singleRow (Decoding.value Decoding.int8))
|
2015-11-15 12:13:45 +03:00
|
|
|
in (,) <$> effect1 <*> effect2
|
|
|
|
in actual
|
|
|
|
,
|
|
|
|
HUnit.testCase "Affected rows counting" $
|
|
|
|
HUnit.assertEqual "" (Right 100) $
|
|
|
|
let
|
|
|
|
actual =
|
|
|
|
unsafePerformIO $
|
|
|
|
DSL.session $ do
|
|
|
|
dropTable
|
|
|
|
createTable
|
|
|
|
replicateM_ 100 insertRow
|
|
|
|
deleteRows <* dropTable
|
|
|
|
where
|
|
|
|
dropTable =
|
|
|
|
DSL.query () $ Queries.plain $
|
|
|
|
"drop table if exists a"
|
|
|
|
createTable =
|
|
|
|
DSL.query () $ Queries.plain $
|
|
|
|
"create table a (id bigserial not null, name varchar not null, primary key (id))"
|
|
|
|
insertRow =
|
|
|
|
DSL.query () $ Queries.plain $
|
|
|
|
"insert into a (name) values ('a')"
|
|
|
|
deleteRows =
|
2015-11-22 10:10:21 +03:00
|
|
|
DSL.query () $ Query.Query sql def decoder False
|
2015-11-15 12:13:45 +03:00
|
|
|
where
|
|
|
|
sql =
|
|
|
|
"delete from a"
|
2015-11-21 13:36:01 +03:00
|
|
|
decoder =
|
2015-11-22 10:10:21 +03:00
|
|
|
Decoding.rowsAffected
|
2015-11-15 12:13:45 +03:00
|
|
|
in actual
|
|
|
|
,
|
|
|
|
HUnit.testCase "Result of an auto-incremented column" $
|
|
|
|
let
|
|
|
|
actualIO =
|
|
|
|
DSL.session $ do
|
|
|
|
DSL.query () $ Queries.plain $ "drop table if exists a"
|
|
|
|
DSL.query () $ Queries.plain $ "create table a (id serial not null, v char not null, primary key (id))"
|
2015-11-22 10:10:21 +03:00
|
|
|
id1 <- DSL.query () $ Query.Query "insert into a (v) values ('a') returning id" def (Decoding.singleRow (Decoding.value Decoding.int4)) False
|
|
|
|
id2 <- DSL.query () $ Query.Query "insert into a (v) values ('b') returning id" def (Decoding.singleRow (Decoding.value Decoding.int4)) False
|
2015-11-15 12:13:45 +03:00
|
|
|
DSL.query () $ Queries.plain $ "drop table if exists a"
|
|
|
|
pure (id1, id2)
|
|
|
|
in HUnit.assertEqual "" (Right (1, 2)) =<< actualIO
|
2015-11-18 22:56:36 +03:00
|
|
|
,
|
|
|
|
HUnit.testCase "List decoding" $
|
|
|
|
let
|
|
|
|
actualIO =
|
|
|
|
DSL.session $ DSL.query () $ Queries.selectList
|
|
|
|
in HUnit.assertEqual "" (Right [(1, 2), (3, 4), (5, 6)]) =<< actualIO
|
2015-11-10 21:19:41 +03:00
|
|
|
]
|
2015-11-15 12:13:45 +03:00
|
|
|
|