From 5cc77709ba49154d9267798df06a270437106a89 Mon Sep 17 00:00:00 2001 From: "Adam C. Baker" Date: Fri, 13 Feb 2015 17:09:56 -0800 Subject: [PATCH 1/7] Add like/ilike --- src/PgQuery.hs | 63 +++++++++++++++++++++------------------ test/Feature/QuerySpec.hs | 57 +++++++++++++++++++++++++++-------- 2 files changed, 78 insertions(+), 42 deletions(-) diff --git a/src/PgQuery.hs b/src/PgQuery.hs index d43b4694c..01972b8a8 100644 --- a/src/PgQuery.hs +++ b/src/PgQuery.hs @@ -9,7 +9,7 @@ import qualified Hasql as H import qualified Hasql.Postgres as P import qualified Hasql.Backend as B -import Data.Text hiding (map, empty) +import qualified Data.Text as T import Text.Regex.TDFA ( (=~) ) import Text.Regex.TDFA.Text () import qualified Network.HTTP.Types.URI as Net @@ -32,12 +32,12 @@ instance Monoid PStmt where type StatementT = PStmt -> PStmt data QualifiedTable = QualifiedTable { - qtSchema :: Text -, qtName :: Text + qtSchema :: T.Text +, qtName :: T.Text } deriving (Show) data OrderTerm = OrderTerm { - otTerm :: Text + otTerm :: T.Text , otDirection :: BS.ByteString } @@ -106,33 +106,33 @@ returningStarT s = s { B.stmtTemplate = B.stmtTemplate s <> " RETURNING *" } deleteFrom :: QualifiedTable -> PStmt deleteFrom t = B.Stmt ("delete from " <> fromQt t) empty True -insertInto :: QualifiedTable -> [Text] -> [JSON.Value] -> PStmt +insertInto :: QualifiedTable -> [T.Text] -> [JSON.Value] -> PStmt insertInto t [] _ = B.Stmt ("insert into " <> fromQt t <> " default values returning *") empty True insertInto t cols vals = B.Stmt ("insert into " <> fromQt t <> " (" <> - intercalate ", " (map pgFmtIdent cols) <> + T.intercalate ", " (map pgFmtIdent cols) <> ") values (" - <> intercalate ", " (map ((<> "::unknown") . pgFmtLit . unquoted) vals) + <> T.intercalate ", " (map ((<> "::unknown") . pgFmtLit . unquoted) vals) <> ") returning row_to_json(" <> fromQt t <> ".*)") empty True -insertSelect :: QualifiedTable -> [Text] -> [JSON.Value] -> PStmt +insertSelect :: QualifiedTable -> [T.Text] -> [JSON.Value] -> PStmt insertSelect t [] _ = B.Stmt ("insert into " <> fromQt t <> " default values returning *") empty True insertSelect t cols vals = B.Stmt ("insert into " <> fromQt t <> " (" - <> intercalate ", " (map pgFmtIdent cols) + <> T.intercalate ", " (map pgFmtIdent cols) <> ") select " - <> intercalate ", " (map ((<> "::unknown") . pgFmtLit . unquoted) vals)) + <> T.intercalate ", " (map ((<> "::unknown") . pgFmtLit . unquoted) vals)) empty True -update :: QualifiedTable -> [Text] -> [JSON.Value] -> PStmt +update :: QualifiedTable -> [T.Text] -> [JSON.Value] -> PStmt update t cols vals = B.Stmt ("update " <> fromQt t <> " set (" - <> intercalate ", " (map pgFmtIdent cols) + <> T.intercalate ", " (map pgFmtIdent cols) <> ") = (" - <> intercalate ", " (map ((<> "::unknown") . pgFmtLit . unquoted) vals) + <> T.intercalate ", " (map ((<> "::unknown") . pgFmtLit . unquoted) vals) <> ")") empty True @@ -142,8 +142,11 @@ wherePred (col, predicate) = B.Stmt empty True where - opCode:rest = split (=='.') $ cs $ fromMaybe "." predicate - value = intercalate "." rest + opCode:rest = T.split (=='.') $ cs $ fromMaybe "." predicate + unStarredVal = T.intercalate "." rest + star c = if c == '*' then '%' else c + value = if opCode == "like" || opCode == "ilike" + then T.map star unStarredVal else unStarredVal op = case opCode of "eq" -> "=" "gt" -> ">" @@ -151,17 +154,19 @@ wherePred (col, predicate) = B.Stmt "gte" -> ">=" "lte" -> "<=" "neq" -> "<>" + "like"-> "like" + "ilike"-> "ilike" _ -> "=" orderParse :: Net.Query -> [OrderTerm] orderParse q = - mapMaybe orderParseTerm . split (==',') $ cs order + mapMaybe orderParseTerm . T.split (==',') $ cs order where order = fromMaybe "" $ join (lookup "order" q) -orderParseTerm :: Text -> Maybe OrderTerm +orderParseTerm :: T.Text -> Maybe OrderTerm orderParseTerm s = - case split (=='.') s of + case T.split (=='.') s of [c,d] -> if d `elem` ["asc", "desc"] then Just $ OrderTerm c $ @@ -175,31 +180,31 @@ commaq = B.Stmt ", " empty True andq :: PStmt andq = B.Stmt " and " empty True -pgFmtIdent :: Text -> Text +pgFmtIdent :: T.Text -> T.Text pgFmtIdent x = - let escaped = replace "\"" "\"\"" (trimNullChars $ cs x) in + let escaped = T.replace "\"" "\"\"" (trimNullChars $ cs x) in if escaped =~ danger then "\"" <> escaped <> "\"" else escaped - where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: Text + where danger = "^$|^[^a-z_]|[^a-z_0-9]" :: T.Text -pgFmtLit :: Text -> Text +pgFmtLit :: T.Text -> T.Text pgFmtLit x = let trimmed = trimNullChars x - escaped = "'" <> replace "'" "''" trimmed <> "'" - slashed = replace "\\" "\\\\" escaped in - cs $ if escaped =~ ("\\\\" :: Text) + escaped = "'" <> T.replace "'" "''" trimmed <> "'" + slashed = T.replace "\\" "\\\\" escaped in + cs $ if escaped =~ ("\\\\" :: T.Text) then "E" <> slashed else slashed -trimNullChars :: Text -> Text -trimNullChars = Data.Text.takeWhile (/= '\x0') +trimNullChars :: T.Text -> T.Text +trimNullChars = T.takeWhile (/= '\x0') -fromQt :: QualifiedTable -> Text +fromQt :: QualifiedTable -> T.Text fromQt t = pgFmtIdent (qtSchema t) <> "." <> pgFmtIdent (qtName t) -unquoted :: JSON.Value -> Text +unquoted :: JSON.Value -> T.Text unquoted (JSON.String t) = t unquoted (JSON.Number n) = cs $ formatScientific Fixed (if isInteger n then Just 0 else Nothing) n diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs index 37eb234d9..a54ab374c 100644 --- a/test/Feature/QuerySpec.hs +++ b/test/Feature/QuerySpec.hs @@ -1,27 +1,58 @@ +{-# LANGUAGE QuasiQuotes, NoMonomorphismRestriction #-} module Feature.QuerySpec where import Test.Hspec import Test.Hspec.Wai +import Test.Hspec.Wai.JSON +import Hasql as H +import Hasql.Postgres as H +import Control.Monad (void) +import Data.Text(Text) import SpecHelper +testSet :: IO () +testSet = do { + clearTable "items" >> clearTable "no_pk"; + createItems 15; + pool :: H.Pool H.Postgres <- H.acquirePool pgSettings testPoolOpts; + void . liftIO $ H.session pool $ H.tx Nothing $ do + H.unitEx $ + ([H.stmt|insert into "1".no_pk (a, b) values (?,?), (?,?), (?,?), (?,?)|] + :: Text->Text->Text->Text->Text->Text->Text->Text-> H.Stmt H.Postgres) + "lick" "Fun" + "trick" "funky" + "barb" "foo" + "BARD" "FOOD" +} spec :: Spec -spec = beforeAll (clearTable "items" >> createItems 15) - . afterAll_ (clearTable "items") . around withApp $ do +spec = beforeAll testSet . afterAll_ (clearTable "items") . around withApp $ do describe "Querying a nonexistent table" $ it "causes a 404" $ get "/faketable" `shouldRespondWith` 404 - describe "Filtering response" $ - context "column equality" $ + describe "Filtering response" $ do + it "matches with equality" $ + get "/items?id=eq.5" + `shouldRespondWith` ResponseMatcher { + matchBody = Just "[{\"id\":5}]" + , matchStatus = 200 + , matchHeaders = ["Content-Range" <:> "0-0/1"] + } - it "matches the predicate" $ - get "/items?id=eq.5" - `shouldRespondWith` ResponseMatcher { - matchBody = Just "[{\"id\":5}]" - , matchStatus = 200 - , matchHeaders = ["Content-Range" <:> "0-0/1"] - } + it "matches with like" $ do + get "/no_pk?a=like.*ick&order=asc.a" `shouldRespondWith` [json|[ + {"a":"lick","b":"Fun"},{"a":"trick","b":"funky"}]|] + get "/no_pk?b=like.f*&order=asc.a" `shouldRespondWith` [json|[ + {"a":"barb","b":"foo"},{"a":"trick","b":"funky"}]|] + get "/no_pk?a=like.*AR*&order=asc.a" `shouldRespondWith` [json|[ + {"a":"BARD","b":"FOOD"}]|] + + it "matches with ilike" $ do + get "/no_pk?b=ilike.fun*&order=asc.a" `shouldRespondWith` [json|[ + {"a":"lick","b":"Fun"},{"a":"trick","b":"funky"}]|] + get "/no_pk?a=ilike.*AR*&order=asc.a" `shouldRespondWith` [json|[ + {"a":"barb","b":"foo"},{"a":"BARD","b":"FOOD"}]|] describe "ordering response" $ do it "by a column asc" $ @@ -52,9 +83,9 @@ spec = beforeAll (clearTable "items" >> createItems 15) } it "Omits question mark when there are no params" $ - get "/no_pk" + get "/simple_pk" `shouldRespondWith` ResponseMatcher { matchBody = Just "[]" , matchStatus = 200 - , matchHeaders = ["Content-Location" <:> "/no_pk"] + , matchHeaders = ["Content-Location" <:> "/simple_pk"] } From e37d5d9b25951f5d917033e97ea6efb7485d09ab Mon Sep 17 00:00:00 2001 From: Joe Nelson Date: Sun, 15 Feb 2015 15:58:00 -0800 Subject: [PATCH 2/7] Style tweak --- postgrest.cabal | 6 ++---- test/Feature/AuthSpec.hs | 1 - test/Feature/InsertSpec.hs | 1 - test/Feature/QuerySpec.hs | 28 +++++++++++++++------------- test/Feature/StructureSpec.hs | 1 - test/Main.hs | 1 - test/SpecHelper.hs | 2 -- 7 files changed, 17 insertions(+), 23 deletions(-) diff --git a/postgrest.cabal b/postgrest.cabal index b2fcc58c4..2f365c6d0 100644 --- a/postgrest.cabal +++ b/postgrest.cabal @@ -17,8 +17,7 @@ executable postgrest main-is: Main.hs ghc-options: -Wall -W -O2 default-language: Haskell2010 - default-extensions: OverloadedStrings, ScopedTypeVariables - other-extensions: QuasiQuotes + default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes build-depends: base >=4.6 && <5 , hasql == 0.7.*, hasql-backend , hasql-postgres == 0.10.* @@ -57,8 +56,7 @@ executable postgrest Test-Suite spec Type: exitcode-stdio-1.0 Default-Language: Haskell2010 - default-extensions: OverloadedStrings, ScopedTypeVariables - other-extensions: QuasiQuotes + default-extensions: OverloadedStrings, ScopedTypeVariables, QuasiQuotes Hs-Source-Dirs: test, src ghc-options: -Wall -W -Werror Main-Is: Main.hs diff --git a/test/Feature/AuthSpec.hs b/test/Feature/AuthSpec.hs index 4c5f208a0..4af66137c 100644 --- a/test/Feature/AuthSpec.hs +++ b/test/Feature/AuthSpec.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE QuasiQuotes #-} module Feature.AuthSpec where -- {{{ Imports diff --git a/test/Feature/InsertSpec.hs b/test/Feature/InsertSpec.hs index 4c50c023d..4196fcb00 100644 --- a/test/Feature/InsertSpec.hs +++ b/test/Feature/InsertSpec.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE QuasiQuotes #-} module Feature.InsertSpec where import Test.Hspec diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs index a54ab374c..9a008df28 100644 --- a/test/Feature/QuerySpec.hs +++ b/test/Feature/QuerySpec.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE QuasiQuotes, NoMonomorphismRestriction #-} module Feature.QuerySpec where import Test.Hspec @@ -12,19 +11,22 @@ import Data.Text(Text) import SpecHelper testSet :: IO () -testSet = do { - clearTable "items" >> clearTable "no_pk"; - createItems 15; - pool :: H.Pool H.Postgres <- H.acquirePool pgSettings testPoolOpts; +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 $ - ([H.stmt|insert into "1".no_pk (a, b) values (?,?), (?,?), (?,?), (?,?)|] - :: Text->Text->Text->Text->Text->Text->Text->Text-> H.Stmt H.Postgres) - "lick" "Fun" - "trick" "funky" - "barb" "foo" - "BARD" "FOOD" -} + mapM_ H.unitEx $ map (uncurry insertNoPk) [ + ("lick", "Fun") + , ("trick", "funky") + , ("barb", "foo") + , ("BARD", "FOOD") + ] + + where + insertNoPk :: Text -> Text -> H.Stmt H.Postgres + insertNoPk = [H.stmt|insert into "1".no_pk (a, b) values (?,?)|] + spec :: Spec spec = beforeAll testSet . afterAll_ (clearTable "items") . around withApp $ do describe "Querying a nonexistent table" $ diff --git a/test/Feature/StructureSpec.hs b/test/Feature/StructureSpec.hs index 98adf05c6..a9001dcd6 100644 --- a/test/Feature/StructureSpec.hs +++ b/test/Feature/StructureSpec.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedStrings, QuasiQuotes #-} module Feature.StructureSpec where import Test.Hspec hiding (pendingWith) diff --git a/test/Main.hs b/test/Main.hs index ccd6171c1..ab3a1f17f 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE QuasiQuotes #-} module Main where import Test.Hspec diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index 1de74ea76..e12c7f76b 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE QuasiQuotes, OverloadedStrings #-} - module SpecHelper where import Network.Wai From eea1bc0cac3242952b78b592b9458fb3479e1cd6 Mon Sep 17 00:00:00 2001 From: Joe Nelson Date: Sun, 15 Feb 2015 16:03:31 -0800 Subject: [PATCH 3/7] Quasiquote json to fix vim syntax highlighting --- test/Feature/QuerySpec.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs index 9a008df28..d6b65be5e 100644 --- a/test/Feature/QuerySpec.hs +++ b/test/Feature/QuerySpec.hs @@ -37,7 +37,7 @@ spec = beforeAll testSet . afterAll_ (clearTable "items") . around withApp $ do it "matches with equality" $ get "/items?id=eq.5" `shouldRespondWith` ResponseMatcher { - matchBody = Just "[{\"id\":5}]" + matchBody = Just [json| [{"id":5}] |] , matchStatus = 200 , matchHeaders = ["Content-Range" <:> "0-0/1"] } @@ -60,14 +60,14 @@ spec = beforeAll testSet . afterAll_ (clearTable "items") . around withApp $ do it "by a column asc" $ get "/items?id=lte.2&order=id.asc" `shouldRespondWith` ResponseMatcher { - matchBody = Just "[{\"id\":1},{\"id\":2}]" + matchBody = Just [json| [{"id":1},{"id":2}] |] , matchStatus = 200 , matchHeaders = ["Content-Range" <:> "0-1/2"] } it "by a column desc" $ get "/items?id=lte.2&order=id.desc" `shouldRespondWith` ResponseMatcher { - matchBody = Just "[{\"id\":2},{\"id\":1}]" + matchBody = Just [json| [{"id":2},{"id":1}] |] , matchStatus = 200 , matchHeaders = ["Content-Range" <:> "0-1/2"] } From 58f18181c22b377274793fac2ec3db33a1fc778a Mon Sep 17 00:00:00 2001 From: Joe Nelson Date: Sun, 15 Feb 2015 16:13:06 -0800 Subject: [PATCH 4/7] Update order by params to new style introduced from master --- test/Feature/QuerySpec.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs index d6b65be5e..c1c630ac7 100644 --- a/test/Feature/QuerySpec.hs +++ b/test/Feature/QuerySpec.hs @@ -43,18 +43,18 @@ spec = beforeAll testSet . afterAll_ (clearTable "items") . around withApp $ do } it "matches with like" $ do - get "/no_pk?a=like.*ick&order=asc.a" `shouldRespondWith` [json|[ + get "/no_pk?a=like.*ick&order=a.asc" `shouldRespondWith` [json|[ {"a":"lick","b":"Fun"},{"a":"trick","b":"funky"}]|] - get "/no_pk?b=like.f*&order=asc.a" `shouldRespondWith` [json|[ + get "/no_pk?b=like.f*&order=a.asc" `shouldRespondWith` [json|[ {"a":"barb","b":"foo"},{"a":"trick","b":"funky"}]|] - get "/no_pk?a=like.*AR*&order=asc.a" `shouldRespondWith` [json|[ + get "/no_pk?a=like.*AR*&order=a.asc" `shouldRespondWith` [json|[ {"a":"BARD","b":"FOOD"}]|] it "matches with ilike" $ do - get "/no_pk?b=ilike.fun*&order=asc.a" `shouldRespondWith` [json|[ + get "/no_pk?b=ilike.fun*&order=a.asc" `shouldRespondWith` [json|[ {"a":"lick","b":"Fun"},{"a":"trick","b":"funky"}]|] - get "/no_pk?a=ilike.*AR*&order=asc.a" `shouldRespondWith` [json|[ - {"a":"barb","b":"foo"},{"a":"BARD","b":"FOOD"}]|] + get "/no_pk?a=ilike.*AR*&order=a.asc" `shouldRespondWith` [json|[ + {"a":"BARD","b":"FOOD"},{"a":"barb","b":"foo"}]|] describe "ordering response" $ do it "by a column asc" $ From 5a1ae934b9091345088db851301966eee9e7bf94 Mon Sep 17 00:00:00 2001 From: Joe Nelson Date: Sun, 15 Feb 2015 16:14:25 -0800 Subject: [PATCH 5/7] Put array open bracket nearer to the json --- test/Feature/QuerySpec.hs | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs index c1c630ac7..625a07c14 100644 --- a/test/Feature/QuerySpec.hs +++ b/test/Feature/QuerySpec.hs @@ -43,18 +43,18 @@ spec = beforeAll testSet . afterAll_ (clearTable "items") . around withApp $ do } it "matches with like" $ do - get "/no_pk?a=like.*ick&order=a.asc" `shouldRespondWith` [json|[ - {"a":"lick","b":"Fun"},{"a":"trick","b":"funky"}]|] - get "/no_pk?b=like.f*&order=a.asc" `shouldRespondWith` [json|[ - {"a":"barb","b":"foo"},{"a":"trick","b":"funky"}]|] - get "/no_pk?a=like.*AR*&order=a.asc" `shouldRespondWith` [json|[ - {"a":"BARD","b":"FOOD"}]|] + get "/no_pk?a=like.*ick&order=a.asc" `shouldRespondWith` [json| + [{"a":"lick","b":"Fun"},{"a":"trick","b":"funky"}]|] + get "/no_pk?b=like.f*&order=a.asc" `shouldRespondWith` [json| + [{"a":"barb","b":"foo"},{"a":"trick","b":"funky"}]|] + get "/no_pk?a=like.*AR*&order=a.asc" `shouldRespondWith` [json| + [{"a":"BARD","b":"FOOD"}]|] it "matches with ilike" $ do - get "/no_pk?b=ilike.fun*&order=a.asc" `shouldRespondWith` [json|[ - {"a":"lick","b":"Fun"},{"a":"trick","b":"funky"}]|] - get "/no_pk?a=ilike.*AR*&order=a.asc" `shouldRespondWith` [json|[ - {"a":"BARD","b":"FOOD"},{"a":"barb","b":"foo"}]|] + get "/no_pk?b=ilike.fun*&order=a.asc" `shouldRespondWith` [json| + [{"a":"lick","b":"Fun"},{"a":"trick","b":"funky"}]|] + get "/no_pk?a=ilike.*AR*&order=a.asc" `shouldRespondWith` [json| + [{"a":"BARD","b":"FOOD"},{"a":"barb","b":"foo"}]|] describe "ordering response" $ do it "by a column asc" $ From b88192f95a137b79a718338ca245ab05d58f8d38 Mon Sep 17 00:00:00 2001 From: Joe Nelson Date: Sun, 15 Feb 2015 16:31:53 -0800 Subject: [PATCH 6/7] Remove lint --- circle.yml | 2 +- test/Feature/QuerySpec.hs | 10 ++++------ 2 files changed, 5 insertions(+), 7 deletions(-) diff --git a/circle.yml b/circle.yml index 66200b110..4ba35a9a5 100644 --- a/circle.yml +++ b/circle.yml @@ -6,5 +6,5 @@ machine: version: 7.8.3 test: post: - - cabal exec hlint src/*.hs test/**/*.hs + - cabal exec hlint -- -X QuasiQuotes src/*.hs test/**/*.hs - cabal exec packdeps postgrest.cabal diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs index 625a07c14..6a4f658af 100644 --- a/test/Feature/QuerySpec.hs +++ b/test/Feature/QuerySpec.hs @@ -15,12 +15,10 @@ testSet = do clearTable "items" >> clearTable "no_pk" createItems 15 pool <- H.acquirePool pgSettings testPoolOpts - void . liftIO $ H.session pool $ H.tx Nothing $ do - mapM_ H.unitEx $ map (uncurry insertNoPk) [ - ("lick", "Fun") - , ("trick", "funky") - , ("barb", "foo") - , ("BARD", "FOOD") + void . liftIO $ H.session pool $ H.tx Nothing $ + mapM_ (H.unitEx . uncurry insertNoPk) [ + ("lick", "Fun"), ("trick", "funky") + , ("barb", "foo"), ("BARD", "FOOD") ] where From fa48c86195249a23291d8d4a777b85c5df5b0f29 Mon Sep 17 00:00:00 2001 From: Joe Nelson Date: Sun, 15 Feb 2015 16:49:32 -0800 Subject: [PATCH 7/7] Logically simplify (i)like test cases --- test/Feature/QuerySpec.hs | 28 +++++++++++++--------------- 1 file changed, 13 insertions(+), 15 deletions(-) diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs index 6a4f658af..9de45f565 100644 --- a/test/Feature/QuerySpec.hs +++ b/test/Feature/QuerySpec.hs @@ -15,11 +15,9 @@ testSet = do clearTable "items" >> clearTable "no_pk" createItems 15 pool <- H.acquirePool pgSettings testPoolOpts - void . liftIO $ H.session pool $ H.tx Nothing $ - mapM_ (H.unitEx . uncurry insertNoPk) [ - ("lick", "Fun"), ("trick", "funky") - , ("barb", "foo"), ("BARD", "FOOD") - ] + 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 @@ -41,18 +39,18 @@ spec = beforeAll testSet . afterAll_ (clearTable "items") . around withApp $ do } it "matches with like" $ do - get "/no_pk?a=like.*ick&order=a.asc" `shouldRespondWith` [json| - [{"a":"lick","b":"Fun"},{"a":"trick","b":"funky"}]|] - get "/no_pk?b=like.f*&order=a.asc" `shouldRespondWith` [json| - [{"a":"barb","b":"foo"},{"a":"trick","b":"funky"}]|] - get "/no_pk?a=like.*AR*&order=a.asc" `shouldRespondWith` [json| - [{"a":"BARD","b":"FOOD"}]|] + get "/no_pk?a=like.*yx" `shouldRespondWith` [json| + [{"a":"xyyx","b":"u"}]|] + get "/no_pk?a=like.xy*" `shouldRespondWith` [json| + [{"a":"xyyx","b":"u"}]|] + get "/no_pk?a=like.*YY*" `shouldRespondWith` [json| + [{"a":"xYYx","b":"v"}]|] it "matches with ilike" $ do - get "/no_pk?b=ilike.fun*&order=a.asc" `shouldRespondWith` [json| - [{"a":"lick","b":"Fun"},{"a":"trick","b":"funky"}]|] - get "/no_pk?a=ilike.*AR*&order=a.asc" `shouldRespondWith` [json| - [{"a":"BARD","b":"FOOD"},{"a":"barb","b":"foo"}]|] + get "/no_pk?a=ilike.xy*&order=b.asc" `shouldRespondWith` [json| + [{"a":"xyyx","b":"u"},{"a":"xYYx","b":"v"}]|] + get "/no_pk?a=ilike.*YY*&order=b.asc" `shouldRespondWith` [json| + [{"a":"xyyx","b":"u"},{"a":"xYYx","b":"v"}]|] describe "ordering response" $ do it "by a column asc" $