Fix problems caused by my rebase

test/Feature/QuerySpec.hs

@@ -3,32 +3,15 @@ module Feature.QuerySpec where
 import Test.Hspec
 import Test.Hspec.Wai
 import Test.Hspec.Wai.JSON
-import Hasql as H
+import Network.Wai.Test (SResponse(simpleHeaders))
-import Hasql.Postgres as H
-import Control.Monad (void)
-import Data.Text(Text)
 
 import SpecHelper
-import Data.Monoid
-
-testSet :: IO ()
-testSet = do
-  clearTable "items" >> clearTable "no_pk"
-  createItems 15
-  pool <- H.acquirePool pgSettings testPoolOpts
-  void . liftIO $ H.session pool $ H.tx Nothing $ do
-    H.unitEx $ insertNoPk "xyyx" "u"
-    H.unitEx $ insertNoPk "xYYx" "v"
-
-  where
-    insertNoPk :: Text -> Text -> H.Stmt H.Postgres
-    insertNoPk = [H.stmt|insert into "1".no_pk (a, b) values (?,?)|]
 
 spec :: Spec
-spec = do
+spec =
   beforeAll (clearTable "items" >> createItems 15)
-   . beforeAll (clearTable "no_pk" >> createNulls 2)
+   . beforeAll (clearTable "no_pk" >> createNulls 2 >> createLikableStrings)
-   . afterAll_ (clearTable "items" >> clearTable "no_pk")
+   . afterAll_ (clearTable "items" >> clearTable "no_pk" >> clearTable "simple_pk")
    . around withApp $ do
   describe "Querying a nonexistent table" $
     it "causes a 404" $
@@ -52,18 +35,18 @@ spec = do
         }
 
     it "matches with like" $ do
-      get "/no_pk?a=like.*yx" `shouldRespondWith` [json|
+      get "/simple_pk?k=like.*yx" `shouldRespondWith`
-        [{"a":"xyyx","b":"u"}]|]
+        "[{\"k\":\"xyyx\",\"extra\":\"u\"}]"
-      get "/no_pk?a=like.xy*" `shouldRespondWith` [json|
+      get "/simple_pk?k=like.xy*" `shouldRespondWith`
-        [{"a":"xyyx","b":"u"}]|]
+        "[{\"k\":\"xyyx\",\"extra\":\"u\"}]"
-      get "/no_pk?a=like.*YY*" `shouldRespondWith` [json|
+      get "/simple_pk?k=like.*YY*" `shouldRespondWith`
-        [{"a":"xYYx","b":"v"}]|]
+        "[{\"k\":\"xYYx\",\"extra\":\"v\"}]"
 
     it "matches with ilike" $ do
-      get "/no_pk?a=ilike.xy*&order=b.asc" `shouldRespondWith` [json|
+      get "/simple_pk?k=ilike.xy*&order=extra.asc" `shouldRespondWith`
-        [{"a":"xyyx","b":"u"},{"a":"xYYx","b":"v"}]|]
+        "[{\"k\":\"xyyx\",\"extra\":\"u\"},{\"k\":\"xYYx\",\"extra\":\"v\"}]"
-      get "/no_pk?a=ilike.*YY*&order=b.asc" `shouldRespondWith` [json|
+      get "/simple_pk?k=ilike.*YY*&order=extra.asc" `shouldRespondWith`
-        [{"a":"xyyx","b":"u"},{"a":"xYYx","b":"v"}]|]
+        "[{\"k\":\"xyyx\",\"extra\":\"u\"},{\"k\":\"xYYx\",\"extra\":\"v\"}]"
 
   describe "ordering response" $ do
     it "by a column asc" $
@@ -84,10 +67,9 @@ spec = do
     it "by a column asc with nulls last" $
       get "/no_pk?order=a.asc.nullslast"
         `shouldRespondWith` ResponseMatcher {
-          matchBody = Just $ "[{\"a\":\"1\",\"b\":\"0\"}"
+          matchBody = Just [json| [{"a":"1","b":"0"},
-                          <> ",{\"a\":\"2\",\"b\":\"0\"}"
+                              {"a":"2","b":"0"},
-                          <> ",{\"a\":null,\"b\":null}]"
+                              {"a":null,"b":null}] |]
-
         , matchStatus = 200
         , matchHeaders = ["Content-Range" <:> "0-2/3"]
         }
@@ -95,9 +77,9 @@ spec = do
     it "by a column desc with nulls first" $
       get "/no_pk?order=a.desc.nullsfirst"
         `shouldRespondWith` ResponseMatcher {
-          matchBody = Just $ "[{\"a\":null,\"b\":null}"
+          matchBody = Just [json| [{"a":null,"b":null},
-                          <> ",{\"a\":\"2\",\"b\":\"0\"}"
+                              {"a":"2","b":"0"},
-                          <> ",{\"a\":\"1\",\"b\":\"0\"}]"
+                              {"a":"1","b":"0"}] |]
         , matchStatus = 200
         , matchHeaders = ["Content-Range" <:> "0-2/3"]
         }
@@ -105,10 +87,9 @@ spec = do
     it "by a column desc with nulls last" $
       get "/no_pk?order=a.desc.nullslast"
         `shouldRespondWith` ResponseMatcher {
-          matchBody = Just $ "[{\"a\":\"2\",\"b\":\"0\"}"
+          matchBody = Just [json| [{"a":"2","b":"0"},
-                          <> ",{\"a\":\"1\",\"b\":\"0\"}"
+                              {"a":"1","b":"0"},
-                          <> ",{\"a\":null,\"b\":null}]"
+                              {"a":null,"b":null}] |]
-
         , matchStatus = 200
         , matchHeaders = ["Content-Range" <:> "0-2/3"]
         }
@@ -125,10 +106,9 @@ spec = do
         , matchHeaders = ["Content-Location" <:> "/no_pk?a=eq.1&b=eq.1"]
         }
 
-    it "Omits question mark when there are no params" $
+    it "Omits question mark when there are no params" $ do
-      get "/simple_pk"
+      r <- get "/simple_pk"
-        `shouldRespondWith` ResponseMatcher {
+      liftIO $ do
-          matchBody    = Just "[]"
+        let respHeaders = simpleHeaders r
-        , matchStatus  = 200
+        respHeaders `shouldSatisfy` matchHeader
-        , matchHeaders = ["Content-Location" <:> "/simple_pk"]
+          "Content-Location" "/simple_pk"
-        }

test/SpecHelper.hs

@@ -122,6 +122,15 @@ createNulls n = do
     stmt' = [H.stmt|insert into "1".no_pk (a,b) values (null,null)|]
     stmts = map [H.stmt|insert into "1".no_pk (a,b) values (?,0)|] [1..n]
 
+createLikableStrings :: IO ()
+createLikableStrings = do
+  pool <- H.acquirePool pgSettings testPoolOpts
+  void . liftIO $ H.session pool $ H.tx Nothing $ do
+    H.unitEx $ insertSimplePk "xyyx" "u"
+    H.unitEx $ insertSimplePk "xYYx" "v"
+  where
+    insertSimplePk :: Text -> Text -> H.Stmt H.Postgres
+    insertSimplePk = [H.stmt|insert into "1".simple_pk (k, extra) values (?,?)|]
 
 
 -- for hspec-wai