From 5cc77709ba49154d9267798df06a270437106a89 Mon Sep 17 00:00:00 2001 From: "Adam C. Baker" Date: Fri, 13 Feb 2015 17:09:56 -0800 Subject: [PATCH] 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"] }