diff --git a/CHANGELOG.md b/CHANGELOG.md index 0be731a04..22062fcae 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,10 @@ All notable changes to this project will be documented in this file. This project adheres to [Semantic Versioning](http://semver.org/). +## Unreleased +### Added +- Option to specify nulls first or last, eg /people?order=age.desc.nullsfirst + ## [0.2.7.0] - 2015-03-03 ### Added - Server response logging diff --git a/src/PgQuery.hs b/src/PgQuery.hs index 48aeecb04..bcec5c114 100644 --- a/src/PgQuery.hs +++ b/src/PgQuery.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, MultiWayIf #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module PgQuery where @@ -39,6 +39,7 @@ data QualifiedTable = QualifiedTable { data OrderTerm = OrderTerm { otTerm :: T.Text , otDirection :: BS.ByteString +, otNullOrder :: Maybe BS.ByteString } limitT :: Maybe NonnegRange -> StatementT @@ -67,7 +68,8 @@ orderT ts q = queryTerm :: OrderTerm -> PStmt queryTerm t = B.Stmt (" " <> cs (pgFmtIdent $ otTerm t) <> " " - <> cs (otDirection t) <> " ") + <> cs (otDirection t) <> " " + <> maybe "" cs (otNullOrder t) <> " ") empty True parentheticT :: StatementT @@ -175,10 +177,16 @@ orderParse q = orderParseTerm :: T.Text -> Maybe OrderTerm orderParseTerm s = case T.split (=='.') s of - [c,d] -> + (c:d:nls) -> if d `elem` ["asc", "desc"] - then Just $ OrderTerm c $ - if d == "asc" then "asc" else "desc" + then Just $ OrderTerm c + ( if d == "asc" then "asc" else "desc" ) + ( case nls of + [n] -> if | n == "nullsfirst" -> Just "nulls first" + | n == "nullslast" -> Just "nulls last" + | otherwise -> Nothing + _ -> Nothing + ) else Nothing _ -> Nothing diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs index 0bfc1dcd7..2029be092 100644 --- a/test/Feature/QuerySpec.hs +++ b/test/Feature/QuerySpec.hs @@ -3,28 +3,16 @@ 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 Network.Wai.Test (SResponse(simpleHeaders)) import SpecHelper -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 = beforeAll testSet . afterAll_ (clearTable "items") . around withApp $ do +spec = + beforeAll (clearTable "items" >> createItems 15) + . beforeAll (clearTable "no_pk" >> createNulls 2 >> createLikableStrings) + . afterAll_ (clearTable "items" >> clearTable "no_pk" >> clearTable "simple_pk") + . around withApp $ do describe "Querying a nonexistent table" $ it "causes a 404" $ get "/faketable" `shouldRespondWith` 404 @@ -47,18 +35,18 @@ spec = beforeAll testSet . afterAll_ (clearTable "items") . around withApp $ do } it "matches with like" $ do - 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"}]|] + get "/simple_pk?k=like.*yx" `shouldRespondWith` + "[{\"k\":\"xyyx\",\"extra\":\"u\"}]" + get "/simple_pk?k=like.xy*" `shouldRespondWith` + "[{\"k\":\"xyyx\",\"extra\":\"u\"}]" + get "/simple_pk?k=like.*YY*" `shouldRespondWith` + "[{\"k\":\"xYYx\",\"extra\":\"v\"}]" it "matches with ilike" $ do - 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"}]|] + get "/simple_pk?k=ilike.xy*&order=extra.asc" `shouldRespondWith` + "[{\"k\":\"xyyx\",\"extra\":\"u\"},{\"k\":\"xYYx\",\"extra\":\"v\"}]" + get "/simple_pk?k=ilike.*YY*&order=extra.asc" `shouldRespondWith` + "[{\"k\":\"xyyx\",\"extra\":\"u\"},{\"k\":\"xYYx\",\"extra\":\"v\"}]" describe "ordering response" $ do it "by a column asc" $ @@ -76,6 +64,36 @@ spec = beforeAll testSet . afterAll_ (clearTable "items") . around withApp $ do , matchHeaders = ["Content-Range" <:> "0-1/2"] } + it "by a column asc with nulls last" $ + get "/no_pk?order=a.asc.nullslast" + `shouldRespondWith` ResponseMatcher { + matchBody = Just [json| [{"a":"1","b":"0"}, + {"a":"2","b":"0"}, + {"a":null,"b":null}] |] + , matchStatus = 200 + , matchHeaders = ["Content-Range" <:> "0-2/3"] + } + + it "by a column desc with nulls first" $ + get "/no_pk?order=a.desc.nullsfirst" + `shouldRespondWith` ResponseMatcher { + matchBody = Just [json| [{"a":null,"b":null}, + {"a":"2","b":"0"}, + {"a":"1","b":"0"}] |] + , matchStatus = 200 + , matchHeaders = ["Content-Range" <:> "0-2/3"] + } + + it "by a column desc with nulls last" $ + get "/no_pk?order=a.desc.nullslast" + `shouldRespondWith` ResponseMatcher { + matchBody = Just [json| [{"a":"2","b":"0"}, + {"a":"1","b":"0"}, + {"a":null,"b":null}] |] + , matchStatus = 200 + , matchHeaders = ["Content-Range" <:> "0-2/3"] + } + it "without other constraints" $ get "/items?order=asc.id" `shouldRespondWith` 200 @@ -88,10 +106,9 @@ spec = beforeAll testSet . afterAll_ (clearTable "items") . around withApp $ do , matchHeaders = ["Content-Location" <:> "/no_pk?a=eq.1&b=eq.1"] } - it "Omits question mark when there are no params" $ - get "/simple_pk" - `shouldRespondWith` ResponseMatcher { - matchBody = Just "[]" - , matchStatus = 200 - , matchHeaders = ["Content-Location" <:> "/simple_pk"] - } + it "Omits question mark when there are no params" $ do + r <- get "/simple_pk" + liftIO $ do + let respHeaders = simpleHeaders r + respHeaders `shouldSatisfy` matchHeader + "Content-Location" "/simple_pk" diff --git a/test/SpecHelper.hs b/test/SpecHelper.hs index 29c08d417..fd46e9d2c 100644 --- a/test/SpecHelper.hs +++ b/test/SpecHelper.hs @@ -109,9 +109,30 @@ createItems n = do <- H.acquirePool pgSettings testPoolOpts void . liftIO $ H.session pool $ H.tx Nothing txn where - txn = sequence_ $ map H.unitEx stmts + txn = mapM_ H.unitEx stmts stmts = map [H.stmt|insert into "1".items (id) values (?)|] [1..n] +createNulls :: Int -> IO () +createNulls n = do + pool :: H.Pool H.Postgres + <- H.acquirePool pgSettings testPoolOpts + void . liftIO $ H.session pool $ H.tx Nothing txn + where + txn = mapM_ H.unitEx (stmt':stmts) + 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 pending_ :: WaiSession () pending_ = liftIO Test.Hspec.pending