Create test fixtures

test/Feature/RangeSpec.hs

@@ -11,7 +11,7 @@ import Network.HTTP.Types
 import Dbapi (app)
 
 spec :: Spec
-spec = with (prepareAppDb "schema" $ app cfg) $ do
+spec = around appWithFixture $ do
   describe "GET /" $ do
     it "responds with 200" $ do
       get "/" `shouldRespondWith` 200
@@ -22,7 +22,7 @@ spec = with (prepareAppDb "schema" $ app cfg) $ do
       |]
 
   describe "Table info" $ do
-    it "available with OPTIONS verb" $ do
+    it "is available with OPTIONS verb" $ do
       -- {{{ big json object
       request methodOptions "/auto_incrementing_pk" "" `shouldRespondWith` [json|
       {
@@ -67,3 +67,14 @@ spec = with (prepareAppDb "schema" $ app cfg) $ do
       }
       |]
       -- }}}
+
+  describe "GET /view" $ do
+    context "without range headers" $ do
+      context "with response under server size limit" $ do
+        it "returns whole range with status 200" $ do
+          get "/auto_incrementing_pk" `shouldRespondWith` 206
+
+  -- describe "Posting new record" $ do
+  --   context "into a table with auto-incrementing pk" $ do
+  --     it "does not require pk in the payload" $ do
+  --       undefined

test/SpecHelper.hs

@@ -1,23 +1,43 @@
 module SpecHelper where
 
 import Network.Wai
+import Test.Hspec
 
 import Database.HDBC
 import Database.HDBC.PostgreSQL
 
-import Dbapi (AppConfig(..))
+import Control.Exception.Base (bracket)
+
+import Dbapi (app, AppConfig(..))
+
+import Debug.Trace
 
 cfg :: AppConfig
 cfg = AppConfig "postgres://postgres:@localhost:5432/dbapi_test" 9000
 
-loadFixture :: String -> IO Connection
-loadFixture name = do
-  conn <- connectPostgreSQL $ configDbUri cfg
-  sql <- readFile $ "test/fixtures/" ++ name ++ ".sql"
-  runRaw conn "drop schema if exists \"1\" cascade"
-  runRaw conn sql
-  commit conn
-  return conn
+openConnection :: IO Connection
+openConnection = connectPostgreSQL' $ configDbUri cfg
 
-prepareAppDb :: String -> Application -> IO Application
-prepareAppDb = (. return) . (>>) . loadFixture
+withDatabaseConnection :: (Connection -> IO ()) -> IO ()
+withDatabaseConnection = bracket openConnection disconnect
+
+loadFixture :: String -> Connection -> IO ()
+loadFixture name conn = do
+  runRaw conn "begin;"
+  sql <- readFile $ "test/fixtures/" ++ name ++ ".sql"
+  runRaw conn sql
+
+rollbackFixture :: Connection -> IO ()
+rollbackFixture = flip runRaw "rollback;"
+
+dbWithSchema :: ActionWith Connection -> IO ()
+dbWithSchema action = withDatabaseConnection $ \c -> do
+  trace "Load fixture" loadFixture "schema" c
+  trace "act" action (c)
+  trace "rollback" rollbackFixture c
+
+appWithFixture :: ActionWith Application -> IO ()
+appWithFixture action = withDatabaseConnection $ \c -> do
+  loadFixture "schema" c
+  action (app cfg)
+  rollbackFixture c

test/Unit/PgQuerySpec.hs

@@ -12,7 +12,7 @@ import Types (SqlRow(..))
 import SpecHelper
 
 spec :: Spec
-spec = beforeAll (loadFixture "schema") $ do
+spec = around dbWithSchema $ do
   describe "insert" $
     it "can insert into an empty table" $ \conn -> do
       _ <- insert 1 "auto_incrementing_pk" (SqlRow [