Merge branch 'hspec_migration'

Author: zohl

default.nix

@@ -1,6 +1,6 @@
 { mkDerivation, attoparsec, base, bytestring, case-conversion
-, heredoc, HUnit, postgresql-simple, stdenv, template-haskell, text
-, time
+, heredoc, hspec, HUnit, postgresql-simple, stdenv
+, template-haskell, text, time
 }:
 mkDerivation {
   pname = "postgresql-simple-bind";
@@ -11,8 +11,8 @@ mkDerivation {
     template-haskell text time
   ];
   testHaskellDepends = [
-    attoparsec base bytestring case-conversion HUnit postgresql-simple
-    text
+    attoparsec base bytestring case-conversion hspec HUnit
+    postgresql-simple text
   ];
   description = "A FFI-like bindings for PostgreSQL stored functions";
   license = stdenv.lib.licenses.gpl3;

examples/Common.hs

@@ -1,34 +1,27 @@
 module Common (
-    TestEnv(..)
-  , mkTest
+    withDB
+  , withRollback
   , include
   , bindOptions
   ) where
 
-import Test.HUnit
-import Control.Exception.Base
-import Text.CaseConversion
-import Database.PostgreSQL.Simple
+import Control.Exception.Base (bracket)
+import Database.PostgreSQL.Simple (Connection, ConnectInfo, connect, begin, rollback, close, execute_)
 import Database.PostgreSQL.Simple.Bind (Options(..), defaultOptions)
-import Database.PostgreSQL.Simple.Types
+import Database.PostgreSQL.Simple.Types (Query(..))
+import Text.CaseConversion (convertCase, WordCase(..))
 import qualified Data.ByteString.Char8 as BS
 
-
-data TestEnv = TestEnv {
-    envConnectInfo :: ConnectInfo
-  }
-
 bindOptions :: Options
 bindOptions = defaultOptions {
     nameModifier = convertCase Snake Camel . ("sql_" ++)
   }
 
-withConn :: ConnectInfo -> (Connection -> IO a) -> IO a
-withConn connectInfo = bracket (connect connectInfo) close
+withDB :: ConnectInfo -> (Connection -> IO a) -> IO a
+withDB connectInfo = bracket (connect connectInfo) close
 
-mkTest :: (Connection -> IO ()) -> (Connection -> IO()) -> TestEnv -> Test
-mkTest setup run env = TestCase $ withConn (envConnectInfo env)
-  (\conn -> mapM_ ($ conn) [begin, setup, run, rollback])
+withRollback :: (Connection -> IO ()) -> (Connection -> IO ())
+withRollback action = \conn -> mapM_ ($ conn) [begin, action, rollback]
 
 include :: Connection -> String -> IO ()
 include conn fn = readFile fn >>= (execute_ conn . Query . BS.pack) >> return ()

examples/ExMessages.hs

@@ -14,15 +14,15 @@
 
 
 module ExMessages (
-    messages
+    specMessages
   ) where
 
-import Test.HUnit
+import Common (bindOptions, include)
+import Database.PostgreSQL.Simple (Connection)
 import Database.PostgreSQL.Simple.Bind (bindFunction)
 import Database.PostgreSQL.Simple.Bind.Types()
-import Database.PostgreSQL.Simple (Connection)
 import Prelude hiding (getContents)
-import Common (bindOptions, TestEnv, mkTest, include)
+import Test.Hspec (Spec, describe, it, shouldBe)
 
 concat <$> mapM (bindFunction bindOptions) [
     "function send_message(p_receiver varchar, p_contents varchar) returns bigint"
@@ -31,35 +31,28 @@ concat <$> mapM (bindFunction bindOptions) [
   ]
 
 
-runTests :: Int -> Connection -> IO ()
-runTests n conn = do
-  let getId (x, _, _) = x
-
-  msg1 <- sqlSendMessage conn "mr_foo" "hello!"
-  msg2 <- sqlSendMessage conn "mr_bar" "hello!"
-  msg3 <- sqlSendMessage conn "mr_bar" "hello again!"
-
-  sqlGetNewMessages conn "mr_foo" >>= \xs ->
-    assertEqual ("check get_new_messages " ++ (show n) ++ ".1") [msg1] (map getId xs)
+specMessages :: Connection -> Spec
+specMessages conn = describe "Messages example" $ it "works" $ mapM_ runTests [
+    "./examples/sql/messages.sql"
+  , "./examples/sql/messages-patch-1.sql"
+  , "./examples/sql/messages-patch-2.sql"
+  ] where
 
-  sqlGetNewMessages conn "mr_bar" >>= \xs ->
-    assertEqual ("check get_new_messages " ++ (show n) ++ ".2") [msg2, msg3] (map getId xs)
+  getId (x, _, _) = x
 
-  sqlMarkAsRead conn "mr_bar" msg2
+  runTests fn = do
+    include conn fn
 
-  sqlGetNewMessages conn "mr_bar" >>= \xs ->
-    assertEqual ("check get_new_messages " ++ (show n) ++ ".3") [msg3] (map getId xs)
+    msg1 <- sqlSendMessage conn "mr_foo" "hello!"
+    msg2 <- sqlSendMessage conn "mr_bar" "hello!"
+    msg3 <- sqlSendMessage conn "mr_bar" "hello again!"
 
-  sqlMarkAsRead conn "mr_foo" msg1
-  sqlMarkAsRead conn "mr_bar" msg3
+    sqlGetNewMessages conn "mr_foo" >>= shouldBe [msg1] . map getId
+    sqlGetNewMessages conn "mr_bar" >>= shouldBe [msg2, msg3] . map getId
 
+    sqlMarkAsRead conn "mr_bar" msg2
 
-messages :: TestEnv -> Test
-messages = mkTest (flip include "./examples/sql/messages.sql")
-  (\conn -> do
-     runTests 1 conn
-     include conn "./examples/sql/messages-patch-1.sql"
-     runTests 2 conn
-     include conn "./examples/sql/messages-patch-2.sql"
-     runTests 3 conn)
+    sqlGetNewMessages conn "mr_bar" >>= shouldBe [msg3] . map getId
 
+    sqlMarkAsRead conn "mr_foo" msg1
+    sqlMarkAsRead conn "mr_bar" msg3

examples/ExNumDumpster.hs

@@ -12,16 +12,14 @@
 
 
 module ExNumDumpster (
-    numDumpster
+    specNumDumpster
   ) where
 
-import Test.HUnit
-import Database.PostgreSQL.Simple
-
+import Common (bindOptions, include)
+import Database.PostgreSQL.Simple (Connection)
 import Database.PostgreSQL.Simple.Bind (bindFunction)
 import Database.PostgreSQL.Simple.Bind.Types()
-
-import Common (bindOptions, TestEnv, mkTest, include)
+import Test.Hspec (Spec, describe, it, shouldBe)
 
 
 concat <$> mapM (bindFunction bindOptions) [
@@ -34,7 +32,7 @@ concat <$> mapM (bindFunction bindOptions) [
 
 
 addManyNums :: Connection -> [Int] -> IO ()
-addManyNums conn xs = sequence_ $ map (sqlAddNum conn) xs
+addManyNums conn xs = mapM_ (sqlAddNum conn) xs
 
 getSum :: Connection -> IO Int
 getSum conn = sum <$> (sqlGetAllNums conn)
@@ -47,24 +45,22 @@ iterFib conn = do
   addManyNums conn [x, x']
   return x'
 
+specNumDumpster :: Connection -> Spec
+specNumDumpster conn = describe "NumDumpster example" $ it "works" $ do
+  include conn "./examples/sql/numdumpster.sql"
 
-numDumpster :: TestEnv -> Test
-numDumpster = mkTest (flip include "./examples/sql/numdumpster.sql")
-  (\conn -> do
-      sqlAddNum conn 1
-      sqlGetLastNum conn >>= \x -> assertEqual "check get_last_num" 1 x
-
-      sqlClear conn
-      addManyNums conn [1, 2, 3, 4]
-      sqlGetAllNums conn >>= \xs -> assertEqual "check get_all_nums" [1, 2, 3, 4] xs
+  sqlAddNum conn 1
+  sqlGetLastNum conn >>= shouldBe 1
 
-      sqlGetRange conn Nothing Nothing   >>= \xs -> assertEqual "check get_range" [1, 2, 3, 4] xs
-      sqlGetRange conn (Just 2) (Just 3) >>= \xs -> assertEqual "check get_range" [2, 3] xs
-      sqlGetRange conn Nothing (Just 3)  >>= \xs -> assertEqual "check get_range" [1, 2, 3] xs
-      sqlGetRange conn (Just 2) Nothing  >>= \xs -> assertEqual "check get_range" [2, 3, 4] xs
+  sqlClear conn
+  addManyNums conn [1, 2, 3, 4]
+  sqlGetAllNums conn >>= shouldBe [1, 2, 3, 4]
 
-      sqlClear conn
-      addManyNums conn [0, 1]
-      ((head . reverse) <$> (sequence $ replicate 11 (iterFib conn))) >>=
-         \x -> assertEqual "check 11th fibonacci number" 144 x)
+  sqlGetRange conn Nothing Nothing   >>= shouldBe [1, 2, 3, 4]
+  sqlGetRange conn (Just 2) (Just 3) >>= shouldBe [2, 3]
+  sqlGetRange conn Nothing (Just 3)  >>= shouldBe [1, 2, 3]
+  sqlGetRange conn (Just 2) Nothing  >>= shouldBe [2, 3, 4]
 
+  sqlClear conn
+  addManyNums conn [0, 1]
+  ((head . reverse) <$> (sequence $ replicate 11 (iterFib conn))) >>= shouldBe 144

examples/ExUsers.hs

@@ -12,19 +12,17 @@
 
 
 module ExUsers (
-    users
+    specUsers
   ) where
 
-import Test.HUnit
-import Database.PostgreSQL.Simple.Bind (bindFunction, PostgresType)
-import Database.PostgreSQL.Simple.Bind.Types()
-
+import Common (bindOptions, include)
 import Data.Attoparsec.ByteString.Char8 (parseOnly, decimal, char, notChar, many')
-import Database.PostgreSQL.Simple.FromField
-
 import Data.Text (Text)
-import Common (bindOptions, TestEnv, mkTest, include)
-
+import Database.PostgreSQL.Simple (Connection)
+import Database.PostgreSQL.Simple.Bind (bindFunction, PostgresType)
+import Database.PostgreSQL.Simple.Bind.Types()
+import Database.PostgreSQL.Simple.FromField (FromField(..), ResultError(..), typename, returnError)
+import Test.Hspec (Spec, describe, it, shouldBe)
 
 concat <$> mapM (bindFunction bindOptions) [
     "function get_users(p_filter varchar2 default '') returns setof t_user"
@@ -64,21 +62,17 @@ instance FromField User where
       return $ User { userId = userId', userName = userName', userAge = userAge' }
 
 
-users :: TestEnv -> Test
-users = mkTest (flip include "./examples/sql/users.sql")
-  (\conn -> do
-      mrFooId <- sqlAddUser conn "Mr. Foo" 42
-      mrBarId <- sqlAddUser conn "Mr. Bar" 53
-      mrBazId <- sqlAddUser conn "Mr. Baz" 64
-
-      sqlGetUsers conn Nothing >>=
-        \xs -> assertEqual "check get_users" [mrFooId, mrBarId, mrBazId] (map userId xs)
+specUsers :: Connection -> Spec
+specUsers conn = describe "Users example" $ it "works" $ do
+  include conn "./examples/sql/users.sql"
 
-      sqlGetUsers conn (Just "Mr. Ba_") >>=
-        \xs -> assertEqual "check get_users 2" [mrBarId, mrBazId] (map userId xs)
+  mrFooId <- sqlAddUser conn "Mr. Foo" 42
+  mrBarId <- sqlAddUser conn "Mr. Bar" 53
+  mrBazId <- sqlAddUser conn "Mr. Baz" 64
 
-      sqlDelUser conn mrBarId
+  sqlGetUsers conn Nothing >>= shouldBe [mrFooId, mrBarId, mrBazId] . map userId
+  sqlGetUsers conn (Just "Mr. Ba_") >>= shouldBe [mrBarId, mrBazId] . map userId
+  sqlDelUser conn mrBarId
 
-      sqlGetUsers conn Nothing >>=
-        \xs -> assertEqual "check get_users 3" [mrFooId, mrBazId] (map userId xs))
+  sqlGetUsers conn Nothing >>= shouldBe [mrFooId, mrBazId] . map userId
 

examples/Main.hs

@@ -1,38 +1,26 @@
-{-# LANGUAGE NamedFieldPuns #-}
+import Common (withDB, withRollback)
+import Data.Text ()
+import Database.PostgreSQL.Simple (Connection, ConnectInfo(..))
+import ExMessages (specMessages)
+import ExNumDumpster (specNumDumpster)
+import ExUsers (specUsers)
+import Test.Hspec (Spec, hspec)
 
-import Test.HUnit
-import Control.Monad
-import System.IO
-import System.Exit
-import Database.PostgreSQL.Simple
-
-import Common          (TestEnv(..))
-import ExNumDumpster
-import ExUsers
-import ExMessages
-
-testEnv :: TestEnv
-testEnv = TestEnv {
-    envConnectInfo = ConnectInfo {
-        connectHost     = "localhost"
-      , connectPort     = 5432
-      , connectDatabase = "test_db"
-      , connectUser     = "test_role"
-      , connectPassword = "TEST"
-      }
-  }
-
-tests :: [TestEnv -> Test]
-tests = [
-      TestLabel "NumDumpster" . numDumpster
-    , TestLabel "Users"       . users
-    , TestLabel "Messages"    . messages
-    ]
+connectInfo :: ConnectInfo
+connectInfo = ConnectInfo {
+      connectHost     = "localhost"
+    , connectPort     = 5432
+    , connectDatabase = "test_db"
+    , connectUser     = "test_role"
+    , connectPassword = "TEST"
+    }
 
 main :: IO ()
-main = do
-  mapM_ (`hSetBuffering` LineBuffering) [stdout, stderr]
-
-  Counts {cases, tried, errors, failures} <- runTestTT $ TestList $ map ($ testEnv) tests
-  when (cases /= tried || errors /= 0 || failures /= 0) $ exitFailure
+main = withDB connectInfo $ withRollback $ hspec . spec
 
+spec :: Connection -> Spec
+spec conn = mapM_ ($ conn) [
+    specNumDumpster
+  , specUsers
+  , specMessages
+  ]

postgresql-simple-bind.cabal

@@ -59,7 +59,7 @@ test-suite tests
 
   build-depends: base >= 4.7 && < 5.0
                , bytestring >= 0.10.8 && < 0.11
-               , HUnit
+               , hspec
                , postgresql-simple >= 0.5.2 && < 0.6
                , postgresql-simple-bind
                , text >= 1.2.2 && < 1.3
@@ -84,7 +84,7 @@ test-suite examples
                , attoparsec >= 0.13.0 && < 0.14
                , bytestring >= 0.10.8 && < 0.11
                , case-conversion
-               , HUnit
+               , hspec
                , postgresql-simple >= 0.5.2 && < 0.6
                , postgresql-simple-bind
                , text >= 1.2.2 && < 1.3