migrated numdumpster

Author: zohl

examples/Common.hs

@@ -1,34 +1,28 @@
 module Common (
-    TestEnv(..)
-  , mkTest
+    withDB
+  , withRollback
   , include
   , bindOptions
   ) where
 
-import Test.HUnit
 import Control.Exception.Base
 import Text.CaseConversion
+import Test.Hspec
 import Database.PostgreSQL.Simple
 import Database.PostgreSQL.Simple.Bind (Options(..), defaultOptions)
 import Database.PostgreSQL.Simple.Types
 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/ExNumDumpster.hs

@@ -12,16 +12,14 @@
 
 
 module ExNumDumpster (
-    numDumpster
+    specNumDumpster
   ) where
 
-import Test.HUnit
+import Test.Hspec
 import Database.PostgreSQL.Simple
-
 import Database.PostgreSQL.Simple.Bind (bindFunction)
 import Database.PostgreSQL.Simple.Bind.Types()
-
-import Common (bindOptions, TestEnv, mkTest, include)
+import Common
 
 
 concat <$> mapM (bindFunction bindOptions) [
@@ -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/Main.hs

@@ -1,38 +1,27 @@
-{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NamedFieldPuns    #-}
 
-import Test.HUnit
-import Control.Monad
-import System.IO
-import System.Exit
+import Test.Hspec
+import Database.PostgreSQL.Simple.Bind.Representation
+import Data.Text ()
 import Database.PostgreSQL.Simple
-
-import Common          (TestEnv(..))
+import Common
 import ExNumDumpster
-import ExUsers
-import ExMessages
-
-testEnv :: TestEnv
-testEnv = TestEnv {
-    envConnectInfo = ConnectInfo {
-        connectHost     = "localhost"
-      , connectPort     = 5432
-      , connectDatabase = "test_db"
-      , connectUser     = "test_role"
-      , connectPassword = "TEST"
-      }
-  }
+-- import ExUsers
+-- import ExMessages
 
-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 = do
+  specNumDumpster conn

postgresql-simple-bind.cabal

@@ -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