fixes for failing tests (only 2 failing, yay! :))

src/PostgREST/App.hs

@@ -82,10 +82,22 @@ app dbstructure conf reqBody role req =
       if range == Just emptyRange
       then return $ responseLBS status416 [] "HTTP Range error"
       else
-        case query of
+        case queries of
           Left e -> return $ responseLBS status200 [("Content-Type", "text/plain")] $ cs e
-          Right qs -> do
+          Right (qs, cqs) -> do
-            let q = B.Stmt qs V.empty True
+            let qt = qualify table
+                q = B.Stmt "select " V.empty True <>
+                    parentheticT (
+                      cqs
+                    ) <> commaq <> (
+                    bodyForAccept contentType qt
+                    . limitT range
+                    -- . orderT (orderParse qq)
+                    -- . whereT qt qq
+                    -- $ select qt qq
+                    $ qs
+                  )
+            -- return $ responseLBS status200 [contentTypeH] (cs $ show $ B.stmtTemplate q)
             row <- H.maybeEx q
             let (tableTotal, queryTotal, body) = fromMaybe (0::Int, 0::Int, Just "" :: Maybe Text) row
                 to = from+queryTotal-1
@@ -115,6 +127,8 @@ app dbstructure conf reqBody role req =
                 >>= addJoinConditions allColumns
                 where formatParserError = pack.show
             query = dbRequestToQuery <$> dbRequest
+            countQuery = dbRequestToCountQuery <$> dbRequest
+            queries = (,) <$> query <*> countQuery
 
 
         --

src/PostgREST/Functions.hs

@@ -8,7 +8,12 @@ import Data.List (find)
 import Data.Tree
 import Data.Text hiding (find, foldr, map, null, last, head)
 import Data.Monoid
-import PostgREST.PgQuery (pgFmtOperator, pgFmtValue, pgFmtIdent, pgFmtLit, fromQi, whiteList, QualifiedIdentifier(..))
+import PostgREST.PgQuery (orderT, pgFmtOperator, pgFmtValue, pgFmtIdent, pgFmtLit, fromQi, whiteList, QualifiedIdentifier(..), StatementT, PStmt)
+import qualified Hasql as H
+import qualified Hasql.Postgres as P
+import qualified Hasql.Backend as B
+import qualified Data.Vector as V (empty)
+
 
 
 findColumn :: [Column] -> Text -> Text -> Text -> Either Text Column
@@ -33,8 +38,8 @@ filterToCondition schema allColumns table (Filter fld op val) =
 
 
 requestNodeToQuery ::Text -> [Table] -> [Column] -> RequestNode -> Either Text Query
-requestNodeToQuery schema allTables allColumns (RequestNode tblNameS flds fltrs) =
+requestNodeToQuery schema allTables allColumns (RequestNode tblNameS flds fltrs ord) =
-    Select <$> mainTable <*> select <*> joinTables <*> qwhere <*> rel
+    Select <$> mainTable <*> select <*> joinTables <*> qwhere <*> rel <*> pure ord
     where
         tblName = pack tblNameS
         mainTable = findTable allTables schema tblName
@@ -95,31 +100,37 @@ addJoinConditions allColumns (Node query@(Select{qRelation=relation}) forest) =
         addCond q con = q{qWhere=con:qWhere q}
 
 
-dbRequestToCountQuery :: DbRequest -> Text
+dbRequestToCountQuery :: DbRequest -> PStmt
-dbRequestToCountQuery (Node (Select mainTable columns tables conditions relation) forest) =
+dbRequestToCountQuery (Node (Select mainTable _ _ conditions _ _) forest) =
-    Data.Text.unwords [
+    B.Stmt query V.empty True
+    where
+      query = Data.Text.unwords [
           "SELECT pg_catalog.count(1)",
           "FROM ", pgFmtTable mainTable,
           ("WHERE " <> intercalate " AND " ( map pgFmtCondition conditions )) `emptyOnNull` conditions
         ]
-    where emptyOnNull val x = if null x then "" else val
+      emptyOnNull val x = if null x then "" else val
 
-dbRequestToQuery :: DbRequest -> Text
+dbRequestToQuery :: DbRequest -> PStmt
-dbRequestToQuery r@(Node (Select mainTable columns tables conditions relation) forest) =
+dbRequestToQuery r@(Node (Select mainTable columns tables conditions relation ord) forest) =
-    case relation of
+    orderT (fromMaybe [] ord) $ query
-        Nothing -> "SELECT "
+    -- case relation of
-                  <> "("
+    --     Nothing ->B.Stmt ("SELECT "
-                  <> dbRequestToCountQuery r
+    --               <> "("
-                  <> "),"
+    --               <> dbRequestToCountQuery r
-                  <> "pg_catalog.count(t),"
+    --               <> "),"
-                  <> "array_to_json(array_agg(row_to_json(t)))::CHARACTER VARYING AS json "
+    --               <> "pg_catalog.count(t),"
-                  <> "FROM ("
+    --               <> "array_to_json(array_agg(row_to_json(t)))::CHARACTER VARYING AS json "
-                  <> query
+    --               <> "FROM ("
-                  <> ") t;"
+    --               <> query
-
+    --               <> ") t;"
-        _         -> query
+    --               ) V.empty True
+    --
+    --     _         -> B.Stmt query V.empty True
     where
-        query = Data.Text.unwords [
+
+        query = B.Stmt q V.empty True
+        q = Data.Text.unwords [
             ("WITH " <> intercalate ", " withs) `emptyOnNull` withs,
             "SELECT ", intercalate ", " (map selectItemToStr columns ++ selects),
             "FROM ", intercalate ", " (map pgFmtTable (mainTable:tables)),
@@ -134,12 +145,15 @@ dbRequestToQuery r@(Node (Select mainTable columns tables conditions relation) f
             where name = tableName table
                   sel = "("
                      <> "SELECT array_to_json(array_agg(row_to_json("<>name<>"))) "
-                     <> "FROM (" <> dbRequestToQuery (Node q forst) <> ") " <> name
+                     <> "FROM (" <> subquery <> ") " <> name
                      <> ") AS " <> name
+                     where (B.Stmt subquery _ _) = dbRequestToQuery (Node q forst)
+
         getQueryParts (Node q@(Select{qMainTable=table, qRelation=(Just (Relation{relType="parent"}))}) forst) (w,s) = (wit:w,sel:s)
             where name = tableName table
                   sel = "row_to_json(" <> name <> ".*) AS "<>name --TODO must be singular
-                  wit = name <> " AS ( " <> dbRequestToQuery (Node q forst) <> " )"
+                  wit = name <> " AS ( " <> subquery <> " )"
+                    where (B.Stmt subquery _ _) = dbRequestToQuery (Node q forst)
         -- getQueryParts (Node q@(Select{qMainTable=table, qRelation=(Just (Many _ _))}) forst) (w,s) = (w,sel:s)
         --     where name = tableName table
         --           sel = "("

src/PostgREST/Parsers.hs

@@ -23,30 +23,35 @@ import           PostgREST.Types
 import           Data.List                     (delete, find)
 import           Data.Maybe
 import           Data.String.Conversions       (cs)
+import  Control.Monad (join)
+
 --import qualified Data.ByteString.Char8 as C
 
 --buildRequest :: String -> String -> [(String, String)] -> Either P.ParseError Request
 parseGetRequest :: Request -> Either ParseError ApiRequest
 parseGetRequest httpRequest =
-    foldr addFilter <$> apiRequest <*> flts
+    foldr addFilter <$> (addOrder <$> apiRequest <*> ord) <*> flts
     where
         apiRequest = parse (pRequestSelect rootTableName) ("failed to parse select ("++selectStr++")") $ cs selectStr
+        addOrder (Node r f) o = Node r{order=o} f
         flts = mapM pRequestFilter whereFilters
         rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head
         qString = [(cs k, cs <$> v)|(k,v) <- queryString httpRequest]
+        orderStr = join $ lookup "order" qString
+        ord = traverse (parse pOrder ("failed to parse order ()")) orderStr
         selectStr = fromMaybe "*" $ fromMaybe (Just "*") $ lookup "select" qString --in case the parametre is missing or empty we default to *
         whereFilters = [ (k, fromJust v) | (k,v) <- qString, k `notElem` ["select", "order"], isJust v ]
 
 pRequestSelect :: String -> Parser ApiRequest
 pRequestSelect rootNodeName = do
     fieldTree <- pFieldForest
-    return $ foldr treeEntry (Node (RequestNode rootNodeName [] []) []) fieldTree
+    return $ foldr treeEntry (Node (RequestNode rootNodeName [] [] Nothing) []) fieldTree
     where
         treeEntry :: Tree SelectItem -> Tree RequestNode -> Tree RequestNode
         treeEntry (Node fld@((fn, _),_) fldForest) (Node rNode rForest) =
             case fldForest of
                 [] -> Node (rNode {fields=fld:fields rNode}) rForest
-                _  -> Node rNode (foldr treeEntry (Node (RequestNode fn [] []) []) fldForest:rForest)
+                _  -> Node rNode (foldr treeEntry (Node (RequestNode fn [] [] Nothing) []) fldForest:rForest)
 
 pRequestFilter :: (String, String) -> Either ParseError (Path, Filter)
 pRequestFilter (k, v) = (,) <$> path <*> (Filter <$> fld <*> op <*> val)
@@ -133,14 +138,12 @@ pSelect = lexeme $
         return ((s, Nothing), Nothing)
 
 pOperator :: Parser Operator
-pOperator =  try (string "eq")
+pOperator =  try (string "lte") -- has to be before lt
-         <|> try (string "gt")
          <|> try (string "lt")
          <|> try (string "eq")
+         <|> try (string "gte") -- has to be before gh
          <|> try (string "gt")
          <|> try (string "lt")
-         <|> try (string "gte")
-         <|> try (string "lte")
          <|> try (string "neq")
          <|> try (string "like")
          <|> try (string "ilike")
@@ -169,3 +172,14 @@ pOpValueExp = do
   pDelimiter
   v <- pValue
   return (o, v)
+
+pOrder :: Parser ([OrderTerm])
+pOrder = lexeme pOrderTerm `sepBy` char ','
+
+pOrderTerm :: Parser OrderTerm
+pOrderTerm =  do
+  c <- pFieldName
+  pDelimiter
+  d <- string "asc" <|> string "desc"
+  nls <- optionMaybe (pDelimiter *> ( try(string "nullslast" *> pure ("nulls last"::String)) <|> try(string "nullsfirst" *> pure ("nulls first"::String))))
+  return $ OrderTerm (cs c) (cs d) (cs <$> nls)

src/PostgREST/PgQuery.hs

@@ -4,7 +4,7 @@
 module PostgREST.PgQuery where
 
 import PostgREST.RangeQuery
-
+import PostgREST.Types (OrderTerm(..))
 import qualified Hasql as H
 import qualified Hasql.Postgres as P
 import qualified Hasql.Backend as B
@@ -39,11 +39,6 @@ data QualifiedIdentifier = QualifiedIdentifier {
 , qiName   :: T.Text
 } deriving (Show)
 
-data OrderTerm = OrderTerm {
-  otTerm :: T.Text
-, otDirection :: BS.ByteString
-, otNullOrder :: Maybe BS.ByteString
-}
 
 limitT :: Maybe NonnegRange -> StatementT
 limitT r q =

src/PostgREST/RangeQuery.hs

@@ -6,6 +6,7 @@ module PostgREST.RangeQuery (
 , NonnegRange
 ) where
 
+import PostgREST.Types (OrderTerm(..))
 import Control.Applicative
 import Network.HTTP.Types.Header
 

src/PostgREST/Types.hs

@@ -1,6 +1,7 @@
 module PostgREST.Types where
 import Data.Text
 import Data.Tree
+import qualified Data.ByteString.Char8 as BS
 
 data DbStructure = DbStructure {
   tables :: [Table]
@@ -41,6 +42,13 @@ data PrimaryKey = PrimaryKey {
   pkSchema::Text, pkTable::Text, pkName::Text
 }
 
+data OrderTerm = OrderTerm {
+  otTerm :: Text
+, otDirection :: BS.ByteString
+, otNullOrder :: Maybe BS.ByteString
+} deriving (Show, Eq)
+
+
 data Relation = Relation {
   relSchema  :: Text
 , relTable   :: Text
@@ -62,7 +70,12 @@ type Field = (FieldName, Maybe JsonPath)
 type Cast = String
 type SelectItem = (Field, Maybe Cast)
 type Path = [String]
-data RequestNode = RequestNode {nodeName::String, fields::[SelectItem], filters::[Filter]} deriving (Show, Eq)
+data RequestNode = RequestNode {
+  nodeName::String
+, fields::[SelectItem]
+, filters::[Filter]
+, order::Maybe [OrderTerm]
+} deriving (Show, Eq)
 data Filter = Filter {field::Field, operator::Operator, value::FValue} deriving (Show, Eq)
 
 -- Db Request Types
@@ -70,5 +83,12 @@ type DbField = (Column, Maybe JsonPath)
 type DbSelectItem = (DbField, Maybe Cast)
 data DbValue = VText Text | VForeignKey Relation deriving (Show)
 data Condition = Condition {conColumn::DbField, conOperator::Operator, conValue::DbValue} deriving (Show)
-data Query = Select {qMainTable::Table, qSelect::[DbSelectItem], qJoinTables::[Table], qWhere::[Condition], qRelation::Maybe Relation} deriving (Show)
+data Query = Select {
+  qMainTable::Table
+, qSelect::[DbSelectItem]
+, qJoinTables::[Table]
+, qWhere::[Condition]
+, qRelation::Maybe Relation
+, qOrder::Maybe [OrderTerm]
+} deriving (Show)
 type DbRequest = Tree Query