first fully functioning build, some tests are failing (limit,order,csv not implemented yet)

src/PostgREST/App.hs

@@ -81,49 +81,74 @@ app dbstructure conf reqBody role req =
     ([table], "GET") ->
       if range == Just emptyRange
       then return $ responseLBS status416 [] "HTTP Range error"
-      else do
+      else
-        let apiRequest = parseGetRequest req
+        case query of
+          Left e -> return $ responseLBS status200 [("Content-Type", "text/plain")] $ cs e
+          Right qs -> do
+            let q = B.Stmt qs V.empty True
+            row <- H.maybeEx q
+            let (tableTotal, queryTotal, body) = fromMaybe (0::Int, 0::Int, Just "" :: Maybe Text) row
+                to = from+queryTotal-1
+                contentRange = contentRangeH from to tableTotal
+                status = rangeStatus from to tableTotal
+                canonical = urlEncodeVars
+                  . sortBy (comparing fst)
+                  . map (join (***) cs)
+                  . parseSimpleQuery
+                  $ rawQueryString req
+
+
+            return $ responseLBS status
+              [contentTypeH, contentRange,
+                ("Content-Location",
+                  "/" <> cs table <>
+                    if Prelude.null canonical then "" else "?" <> cs canonical
+                )
+              ] (cs $ fromMaybe "[]" body)
+
+        where
+            from = fromMaybe 0 $ rangeOffset <$> range
+            apiRequest = parseGetRequest req
             dbRequest = first formatParserError apiRequest
                 >>= traverse (requestNodeToQuery schema allTables allColumns)
                 >>= addRelations allRelations Nothing
                 >>= addJoinConditions allColumns
                 where formatParserError = pack.show
             query = dbRequestToQuery <$> dbRequest
-            body = show query
-        return $ responseLBS status200 [] $ cs body
 
-      {--
+
-        let qt = qualify table
+        --
-            from = fromMaybe 0 $ rangeOffset <$> range
+        -- let qt = qualify table
-            query = B.Stmt "select " V.empty True <>
+        --     from = fromMaybe 0 $ rangeOffset <$> range
-                parentheticT (
+        --     query = B.Stmt "select " V.empty True <>
-                  whereT qt qq $ countRows qt
+        --         parentheticT (
-                ) <> commaq <> (
+        --           whereT qt qq $ countRows qt
-                bodyForAccept contentType qt
+        --         ) <> commaq <> (
-                . limitT range
+        --         bodyForAccept contentType qt
-                . orderT (orderParse qq)
+        --         . limitT range
-                . whereT qt qq
+        --         . orderT (orderParse qq)
-                $ select qt qq
+        --         . whereT qt qq
-              )
+        --         $ select qt qq
-        row <- H.maybeEx query
+        --       )
-        let (tableTotal, queryTotal, body) =
+        -- row <- H.maybeEx query
-              fromMaybe (0, 0, Just "" :: Maybe Text) row
+        -- let (tableTotal, queryTotal, body) =
-            to = from+queryTotal-1
+        --       fromMaybe (0, 0, Just "" :: Maybe Text) row
-            contentRange = contentRangeH from to tableTotal
+        --     to = from+queryTotal-1
-            status = rangeStatus from to tableTotal
+        --     contentRange = contentRangeH from to tableTotal
-            canonical = urlEncodeVars
+        --     status = rangeStatus from to tableTotal
-              . sortBy (comparing fst)
+        --     canonical = urlEncodeVars
-              . map (join (***) cs)
+        --       . sortBy (comparing fst)
-              . parseSimpleQuery
+        --       . map (join (***) cs)
-              $ rawQueryString req
+        --       . parseSimpleQuery
-        return $ responseLBS status
+        --       $ rawQueryString req
-          [contentTypeH, contentRange,
+        -- return $ responseLBS status
-            ("Content-Location",
+        --   [contentTypeH, contentRange,
-              "/" <> cs table <>
+        --     ("Content-Location",
-                if Prelude.null canonical then "" else "?" <> cs canonical
+        --       "/" <> cs table <>
-            )
+        --         if Prelude.null canonical then "" else "?" <> cs canonical
-          ] (cs $ fromMaybe "[]" body)
+        --     )
-      --}
+        --   ] (cs $ fromMaybe "[]" body)
+
 
     (["postgrest", "users"], "POST") -> do
       let user = decode reqBody :: Maybe AuthUser

src/PostgREST/Functions.hs

@@ -6,9 +6,9 @@ import PostgREST.Types
 import           Control.Error
 import Data.List (find)
 import Data.Tree
-import Data.Text hiding (find, foldr, map, null, last)
+import Data.Text hiding (find, foldr, map, null, last, head)
 import Data.Monoid
-import PostgREST.PgQuery (pgFmtOperator, pgFmtValue, pgFmtIdent, pgFmtLit, fromQi, QualifiedIdentifier(..))
+import PostgREST.PgQuery (pgFmtOperator, pgFmtValue, pgFmtIdent, pgFmtLit, fromQi, whiteList, QualifiedIdentifier(..))
 
 
 findColumn :: [Column] -> Text -> Text -> Text -> Either Text Column
@@ -95,10 +95,22 @@ addJoinConditions allColumns (Node query@(Select{qRelation=relation}) forest) =
         addCond q con = q{qWhere=con:qWhere q}
 
 
+dbRequestToCountQuery :: DbRequest -> Text
+dbRequestToCountQuery (Node (Select mainTable columns tables conditions relation) forest) =
+    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
+
 dbRequestToQuery :: DbRequest -> Text
-dbRequestToQuery (Node (Select mainTable columns tables conditions relation) forest) =
+dbRequestToQuery r@(Node (Select mainTable columns tables conditions relation) forest) =
     case relation of
         Nothing -> "SELECT "
+                  <> "("
+                  <> dbRequestToCountQuery r
+                  <> "),"
                   <> "pg_catalog.count(t),"
                   <> "array_to_json(array_agg(row_to_json(t)))::CHARACTER VARYING AS json "
                   <> "FROM ("
@@ -139,12 +151,20 @@ dbRequestToQuery (Node (Select mainTable columns tables conditions relation) for
         getQueryParts (Node (Select{qRelation=(Just (Relation {relType=_}))}) _) _ = undefined
 
 pgFmtCondition :: Condition -> Text
-pgFmtCondition (Condition (col,jp) ops val) = pgFmtColumn col <> pgFmtJsonPath jp  <> opToStr op <> valToStr val
+pgFmtCondition (Condition (col,jp) ops val) =
+    notOp <> " " <> pgFmtColumn col <> pgFmtJsonPath jp  <> " " <> pgFmtOperator opCode <> " " <>
+      if opCode `elem` ["is","isnot"] then whiteList (getInner val) else sqlValue
     where
-        op = pack ops
+        headPredicate:rest = split (=='.') $ pack ops
-        opToStr o = pgFmtOperator o
+        hasNot caseTrue caseFalse = if headPredicate == "not" then caseTrue else caseFalse
+        opCode        = hasNot (head rest) headPredicate
+        notOp         = hasNot headPredicate ""
+        sqlValue = valToStr val
+        getInner v = case v of
+            VText s -> s
+            _       -> ""
         valToStr v = case v of
-            VText s -> pgFmtValue op s
+            VText s -> pgFmtValue opCode s
             VForeignKey (Relation{relFTable=table, relFColumn=column}) -> table <> "." <> column
 
 pgFmtColumn :: Column -> Text

src/PostgREST/Parsers.hs

@@ -35,7 +35,7 @@ parseGetRequest httpRequest =
         rootTableName = cs $ head $ pathInfo httpRequest -- TODO unsafe head
         qString = [(cs k, cs <$> v)|(k,v) <- queryString httpRequest]
         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"], isJust v ]
+        whereFilters = [ (k, fromJust v) | (k,v) <- qString, k `notElem` ["select", "order"], isJust v ]
 
 pRequestSelect :: String -> Parser ApiRequest
 pRequestSelect rootNodeName = do
@@ -136,6 +136,19 @@ pOperator :: Parser Operator
 pOperator =  try (string "eq")
          <|> try (string "gt")
          <|> try (string "lt")
+         <|> try (string "eq")
+         <|> try (string "gt")
+         <|> try (string "lt")
+         <|> try (string "gte")
+         <|> try (string "lte")
+         <|> try (string "neq")
+         <|> try (string "like")
+         <|> try (string "ilike")
+         <|> try (string "in")
+         <|> try (string "notin")
+         <|> try (string "is" )
+         <|> try (string "isnot")
+         <|> try (string "@@")
          <?> "operator (eq, gt, ...)"
 
 pInt :: Parser Int
@@ -151,4 +164,8 @@ pDelimiter :: Parser Char
 pDelimiter = char '.' <?> "delimiter (.)"
 
 pOpValueExp :: Parser (Operator, FValue)
-pOpValueExp = liftA2 (,) pOperator (pDelimiter *> pValue)
+pOpValueExp = do
+  o <- ( try ( liftA2 (++) (string "not.")  pOperator) <|> pOperator )
+  pDelimiter
+  v <- pValue
+  return (o, v)