From 5900475460e2a1792d53b832a1a725a749daa41f Mon Sep 17 00:00:00 2001
From: Joe Nelson <cred+github@begriffs.com>
Date: Sat, 29 Nov 2014 13:26:26 -0800
Subject: [PATCH] Reset db between tests rather than using transactions to
 accomodate Hasql limitation

---
 dbapi.cabal                |  2 +-
 test/Feature/InsertSpec.hs |  5 +----
 test/Main.hs               | 26 --------------------------
 test/Spec.hs               |  2 +-
 test/SpecHelper.hs         | 23 ++++++++++++++++++++++-
 5 files changed, 25 insertions(+), 33 deletions(-)
 delete mode 100644 test/Main.hs

diff --git a/dbapi.cabal b/dbapi.cabal
index a1d446709..5f8ec1a63 100644
--- a/dbapi.cabal
+++ b/dbapi.cabal
@@ -54,7 +54,7 @@ Test-Suite spec
   other-extensions:    QuasiQuotes
   Hs-Source-Dirs:      test, src
   ghc-options:         -Wall -W -Werror
-  Main-Is:             Main.hs
+  Main-Is:             Spec.hs
   Other-Modules:       App, Auth, Config, Spec, SpecHelper
   Build-Depends:       base, hspec >= 2.0, QuickCheck
                      , hspec-wai >= 0.5.0, hspec-wai-json
diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs
index a70e565f6..f0d1133fc 100644
--- a/test/Feature/InsertSpec.hs
+++ b/test/Feature/InsertSpec.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE QuasiQuotes #-}
 module Feature.InsertSpec where
 
--- {{{ Imports
 import Test.Hspec
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
@@ -17,10 +16,8 @@ import Control.Monad (replicateM_)
 
 import TestTypes(IncPK(..), CompoundPK(..))
 
--- }}}
-
 spec :: Spec
-spec = around withApp $ do
+spec = before resetDb $ around withApp $ do
   describe "Posting new record" $ do
     it "accepts disparate json types" $
       post "/menagerie"
diff --git a/test/Main.hs b/test/Main.hs
deleted file mode 100644
index ac0a2cf82..000000000
--- a/test/Main.hs
+++ /dev/null
@@ -1,26 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-module Main where
-
-import Control.Monad (void)
-import qualified Hasql as H
-import System.Process
-import Test.Hspec
-import SpecHelper
-import Spec
-
-main :: IO ()
-main = do
-  H.session pgSettings testSettings $
-    H.tx Nothing $ do
-      H.unit [H.q| drop schema if exists "1" cascade |]
-      H.unit [H.q| drop schema if exists private cascade |]
-      H.unit [H.q| drop schema if exists dbapi cascade |]
-
-  loadFixture "roles"
-  loadFixture "schema"
-
-  hspec spec
-
-loadFixture :: FilePath -> IO()
-loadFixture name =
-  void $ readProcess "psql" ["-U", "dbapi_test", "-d", "dbapi_test", "-a", "-f", "test/fixtures/" ++ name ++ ".sql"] []
diff --git a/test/Spec.hs b/test/Spec.hs
index b4e92e756..a824f8c30 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -1 +1 @@
-{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --no-main #-}
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs
index 6be7d9157..88331e21f 100644
--- a/test/SpecHelper.hs
+++ b/test/SpecHelper.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE QuasiQuotes #-}
+
 module SpecHelper where
 
 import Network.Wai
@@ -10,7 +12,7 @@ import Hasql.Postgres as H
 import Data.String.Conversions (cs)
 -- import Control.Exception.Base (bracket, finally)
 import Control.Monad.Reader (runReaderT, ask)
--- import Control.Monad (void)
+import Control.Monad (void)
 import Control.Applicative ( (<$>) )
 import Control.Exception
 
@@ -22,6 +24,7 @@ import Data.Maybe (fromMaybe)
 import Text.Regex.TDFA ((=~))
 import qualified Data.ByteString.Char8 as BS
 import Network.Wai.Middleware.Cors (cors)
+import System.Process (readProcess)
 
 import App (app, sqlErrHandler, isSqlError)
 import Config (corsPolicy)
@@ -50,6 +53,24 @@ withApp perform =
 
   where middle = cors corsPolicy
 
+
+resetDb :: IO ()
+resetDb = do
+  H.session pgSettings testSettings $
+    H.tx Nothing $ do
+      H.unit [H.q| drop schema if exists "1" cascade |]
+      H.unit [H.q| drop schema if exists private cascade |]
+      H.unit [H.q| drop schema if exists dbapi cascade |]
+
+  loadFixture "roles"
+  loadFixture "schema"
+
+
+loadFixture :: FilePath -> IO()
+loadFixture name =
+  void $ readProcess "psql" ["-U", "dbapi_test", "-d", "dbapi_test", "-a", "-f", "test/fixtures/" ++ name ++ ".sql"] []
+
+
 rangeHdrs :: ByteRange -> [Header]
 rangeHdrs r = [rangeUnit, (hRange, renderByteRange r)]