Merge branch 'jcristovao-nullsFirst'

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

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
 

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"

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