From fbb13f4ab30a86218b33c5f08d6dcbf8130bf9d5 Mon Sep 17 00:00:00 2001
From: Joe Nelson <cred+github@begriffs.com>
Date: Mon, 13 Oct 2014 22:29:28 -0700
Subject: [PATCH] Accept order query param

Fixes #66
---
 dbapi.cabal               |  2 +-
 src/PgQuery.hs            | 40 +++++++++++++++++++++++++++++++++++++--
 test/Feature/QuerySpec.hs | 16 ++++++++++++++++
 3 files changed, 55 insertions(+), 3 deletions(-)

diff --git a/dbapi.cabal b/dbapi.cabal
index 44bb15f24..adfbbba1e 100644
--- a/dbapi.cabal
+++ b/dbapi.cabal
@@ -1,5 +1,5 @@
 name:                  dbapi
-version:               0.2.0.0
+version:               0.2.1.0
 synopsis:              The database is your api
 license:               MIT
 license-file:          LICENSE
diff --git a/src/PgQuery.hs b/src/PgQuery.hs
index 98b7a8aef..5282b30f0 100644
--- a/src/PgQuery.hs
+++ b/src/PgQuery.hs
@@ -19,8 +19,9 @@ module PgQuery (
 import Data.Text (Text)
 import Data.String.Conversions (cs)
 import Data.Functor ( (<$>) )
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, mapMaybe)
 import Data.List (intersperse, intercalate)
+import Data.List.Split (splitOn)
 import Data.Monoid ((<>), mconcat)
 import qualified Data.Map as M
 
@@ -65,6 +66,7 @@ getRows schema table qq range conn = do
       jsonArrayRows
       (selectStarClause schema table
         <> whereClause qq
+        <> orderClause qq
         <> limitClause range)
   r <- quickQuery conn query []
 
@@ -78,12 +80,46 @@ getRows schema table qq range conn = do
   where
     offset = fromMaybe 0 $ R.offset <$> range
 
+
 whereClause :: Net.Query -> QuotedSql
 whereClause qs =
   if null qs then ("", []) else (" where ", []) <> conjunction
 
   where
-    conjunction = mconcat $ intersperse (" and ", []) (map wherePred qs)
+    cols = [ col | col <- qs, fst col `notElem` ["order"] ]
+    conjunction = mconcat $ intersperse (" and ", []) (map wherePred cols)
+
+
+orderClause :: Net.Query -> QuotedSql
+orderClause qs = do
+  let order = fromMaybe "" $ join $ lookup "order" qs
+      terms = mapMaybe parseOrderTerm $ splitOn "," $ cs order
+      termPred = mconcat $ intersperse (", ", []) (map orderTermSql terms)
+
+  if null terms
+     then ("", [])
+     else (" order by ", []) <> termPred
+
+  where
+    parseOrderTerm :: String -> Maybe OrderTerm
+    parseOrderTerm s =
+      case splitOn "." s of
+           [d,c] ->
+             if d `elem` ["asc", "desc"]
+                then Just $ OrderTerm d c
+                else Nothing
+           _ -> Nothing
+
+    orderTermSql :: OrderTerm -> QuotedSql
+    orderTermSql t =
+      ("%I " <> otDirection t, [toSql $ otColumn t])
+
+
+data OrderTerm = OrderTerm {
+  otDirection :: String
+, otColumn :: String
+}
+
 
 wherePred :: Net.QueryItem -> QuotedSql
 wherePred (column, predicate) =
diff --git a/test/Feature/QuerySpec.hs b/test/Feature/QuerySpec.hs
index 0d8fed652..e71bed4a6 100644
--- a/test/Feature/QuerySpec.hs
+++ b/test/Feature/QuerySpec.hs
@@ -20,6 +20,22 @@ spec = around appWithFixture $ do
           , matchHeaders = ["Content-Range" <:> "0-0/1"]
           }
 
+  describe "ordering response" $ do
+    it "by a column asc" $
+      get "/items?id=lte.2&order=asc.id"
+        `shouldRespondWith` ResponseMatcher {
+          matchBody    = Just "[{\"id\":1},{\"id\":2}]"
+        , matchStatus  = 200
+        , matchHeaders = ["Content-Range" <:> "0-1/2"]
+        }
+    it "by a column desc" $
+      get "/items?id=lte.2&order=desc.id"
+        `shouldRespondWith` ResponseMatcher {
+          matchBody    = Just "[{\"id\":2},{\"id\":1}]"
+        , matchStatus  = 200
+        , matchHeaders = ["Content-Range" <:> "0-1/2"]
+        }
+
   describe "Canonical location" $
     it "Sets Content-Location with alphabetized params" $
       get "/no_pk?b=eq.1&a=eq.1"