mirror of
https://github.com/nikita-volkov/hasql.git
synced 2024-11-26 23:33:02 +03:00
Switch to the "hspec" testing framework
This commit is contained in:
parent
499d162cf9
commit
82e6d56eed
29
hasql.cabal
29
hasql.cabal
@ -120,11 +120,11 @@ library
|
||||
base >= 4.5 && < 4.8
|
||||
|
||||
|
||||
test-suite tests
|
||||
test-suite hspec
|
||||
type:
|
||||
exitcode-stdio-1.0
|
||||
hs-source-dirs:
|
||||
tests
|
||||
hspec
|
||||
main-is:
|
||||
Main.hs
|
||||
ghc-options:
|
||||
@ -136,18 +136,22 @@ test-suite tests
|
||||
default-language:
|
||||
Haskell2010
|
||||
build-depends:
|
||||
--
|
||||
hasql,
|
||||
hasql-backend == 0.2.*,
|
||||
base-prelude == 0.1.*,
|
||||
HTF == 0.12.*,
|
||||
base >= 4.5 && < 4.8
|
||||
--
|
||||
hspec == 2.1.*,
|
||||
--
|
||||
mtl-prelude < 3,
|
||||
base-prelude,
|
||||
base
|
||||
|
||||
|
||||
test-suite postgres-tests
|
||||
test-suite hspec-postgres
|
||||
type:
|
||||
exitcode-stdio-1.0
|
||||
hs-source-dirs:
|
||||
postgres-tests
|
||||
hspec-postgres
|
||||
main-is:
|
||||
Main.hs
|
||||
ghc-options:
|
||||
@ -159,12 +163,15 @@ test-suite postgres-tests
|
||||
default-language:
|
||||
Haskell2010
|
||||
build-depends:
|
||||
--
|
||||
hasql,
|
||||
hasql-postgres == 0.7.*,
|
||||
hasql-postgres == 0.8.*,
|
||||
--
|
||||
hspec == 2.1.*,
|
||||
--
|
||||
mtl-prelude < 3,
|
||||
base-prelude == 0.1.*,
|
||||
HTF == 0.12.*,
|
||||
base >= 4.5 && < 4.8
|
||||
base-prelude,
|
||||
base
|
||||
|
||||
|
||||
-- Well, it's not a benchmark actually,
|
||||
|
35
hspec-postgres/Main.hs
Normal file
35
hspec-postgres/Main.hs
Normal file
@ -0,0 +1,35 @@
|
||||
import BasePrelude
|
||||
import MTLPrelude
|
||||
import Test.Hspec
|
||||
import qualified Hasql as H
|
||||
import qualified Hasql.Postgres as HP
|
||||
|
||||
|
||||
main =
|
||||
hspec $ do
|
||||
|
||||
context "RowParser" $ do
|
||||
|
||||
it "should fail on incorrect arity" $ do
|
||||
flip shouldThrow (\case H.UnparsableRow _ -> True; _ -> False) $
|
||||
session $ do
|
||||
H.tx Nothing $ do
|
||||
H.unit [H.q|DROP TABLE IF EXISTS data|]
|
||||
H.unit [H.q|CREATE TABLE data (
|
||||
field1 DECIMAL NOT NULL,
|
||||
field2 BIGINT NOT NULL,
|
||||
PRIMARY KEY (field1)
|
||||
)|]
|
||||
H.unit [H.q|INSERT INTO data (field1, field2) VALUES (0, 0)|]
|
||||
mrow :: Maybe (Double, Int64, String) <-
|
||||
H.tx Nothing $
|
||||
H.single $ [H.q|SELECT * FROM data|]
|
||||
return ()
|
||||
|
||||
|
||||
session :: (forall s. H.Session HP.Postgres s IO r) -> IO r
|
||||
session =
|
||||
H.session backendSettings poolSettings
|
||||
where
|
||||
backendSettings = HP.ParamSettings "localhost" 5432 "postgres" "" "postgres"
|
||||
poolSettings = fromJust $ H.sessionSettings 6 30
|
@ -1,11 +1,8 @@
|
||||
{-# OPTIONS_GHC -F -pgmF htfpp #-}
|
||||
import BasePrelude
|
||||
import Test.Framework
|
||||
import Test.Hspec
|
||||
import qualified Hasql as H
|
||||
import qualified Hasql.Backend as HB
|
||||
|
||||
main =
|
||||
htfMain $ htf_thisModulesTests
|
||||
|
||||
data X
|
||||
instance HB.Backend X where
|
||||
@ -16,7 +13,10 @@ instance HB.Mapping X Char where
|
||||
renderValue = StatementArgument . show
|
||||
|
||||
|
||||
test_quasiQuoterGeneratesAProperStatement =
|
||||
assertEqual
|
||||
main =
|
||||
hspec $ do
|
||||
context "Quasi quoter" $ do
|
||||
it "generates a proper statement" $ do
|
||||
(flip shouldBe)
|
||||
(" SELECT ? ", [HB.renderValue 'a'], True)
|
||||
([H.q| SELECT ? |] 'a' :: HB.Statement X)
|
@ -1,34 +0,0 @@
|
||||
{-# OPTIONS_GHC -F -pgmF htfpp #-}
|
||||
import BasePrelude
|
||||
import MTLPrelude
|
||||
import Test.Framework
|
||||
import qualified Hasql as H
|
||||
import qualified Hasql.Postgres as HP
|
||||
|
||||
|
||||
main =
|
||||
htfMain $ htf_thisModulesTests
|
||||
|
||||
test_wrongRowParserArity =
|
||||
flip assertThrowsIO (\case H.UnparsableRow _ -> True; _ -> False) $
|
||||
session $ do
|
||||
H.tx Nothing $ do
|
||||
H.unit [H.q|DROP TABLE IF EXISTS data|]
|
||||
H.unit [H.q|CREATE TABLE data (
|
||||
field1 DECIMAL NOT NULL,
|
||||
field2 BIGINT NOT NULL,
|
||||
PRIMARY KEY (field1)
|
||||
)|]
|
||||
H.unit [H.q|INSERT INTO data (field1, field2) VALUES (0, 0)|]
|
||||
mrow :: Maybe (Double, Int64, String) <-
|
||||
H.tx Nothing $
|
||||
H.single $ [H.q|SELECT * FROM data|]
|
||||
return ()
|
||||
|
||||
|
||||
session :: (forall s. H.Session HP.Postgres s IO r) -> IO r
|
||||
session =
|
||||
H.session backendSettings poolSettings
|
||||
where
|
||||
backendSettings = HP.Postgres "localhost" 5432 "postgres" "" "postgres"
|
||||
poolSettings = fromJust $ H.sessionSettings 6 30
|
Loading…
Reference in New Issue
Block a user