migrated the rest of examples

Author: zohl

examples/Common.hs

@@ -5,12 +5,11 @@ module Common (
   , bindOptions
   ) where
 
-import Control.Exception.Base
-import Text.CaseConversion
-import Test.Hspec
-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
 
 bindOptions :: Options

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

@@ -15,11 +15,11 @@ module ExNumDumpster (
     specNumDumpster
   ) where
 
-import Test.Hspec
-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
+import Test.Hspec (Spec, describe, it, shouldBe)
 
 
 concat <$> mapM (bindFunction bindOptions) [
@@ -32,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)

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,14 +1,10 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE NamedFieldPuns    #-}
-
-import Test.Hspec
-import Database.PostgreSQL.Simple.Bind.Representation
+import Common (withDB, withRollback)
 import Data.Text ()
-import Database.PostgreSQL.Simple
-import Common
-import ExNumDumpster
--- import ExUsers
--- import ExMessages
+import Database.PostgreSQL.Simple (Connection, ConnectInfo(..))
+import ExMessages (specMessages)
+import ExNumDumpster (specNumDumpster)
+import ExUsers (specUsers)
+import Test.Hspec (Spec, hspec)
 
 connectInfo :: ConnectInfo
 connectInfo = ConnectInfo {
@@ -23,5 +19,8 @@ main :: IO ()
 main = withDB connectInfo $ withRollback $ hspec . spec
 
 spec :: Connection -> Spec
-spec conn = do
-  specNumDumpster conn
+spec conn = mapM_ ($ conn) [
+    specNumDumpster
+  , specUsers
+  , specMessages
+  ]