WIP Improperly quoted where predicates

Main.hs

@@ -3,18 +3,27 @@
 module Main where
 
 import Control.Applicative
+import Data.Maybe (fromMaybe)
+import qualified Data.ByteString.Char8 as BS
 
 import Database.HDBC.PostgreSQL (connectPostgreSQL)
 
 import Network.Wai
+import Network.URI (uriQuery, parseURI)
 import Network.Wai.Handler.Warp hiding (Connection)
 import Network.HTTP.Types.Status
 import Network.HTTP.Types.Header
 import Network.HTTP.Types.Method
+import Network.HTTP.Types.URI (parseSimpleQuery)
 
 import Options.Applicative hiding (columns)
 
-import PgStructure (printTables, printColumns, selectAll)
+import PgStructure (printTables, printColumns, selectWhere)
+
+import Debug.Trace
+
+traceThis :: (Show a) => a -> a
+traceThis x = trace (show x) x
 
 data AppConfig = AppConfig {
     configDbUri :: String
@@ -43,10 +52,12 @@ app config req respond =
     []      -> respond =<< responseLBS status200 [json] <$> (printTables =<< conn)
     [table] -> respond =<< if verb == methodOptions
                               then responseLBS status200 [json] <$> (printColumns table =<< conn)
-                              else responseLBS status200 [json] <$> (selectAll table =<< conn)
+                              else responseLBS status200 [json] <$> (selectWhere table qq =<< conn)
     _       -> respond $ responseLBS status404 [] ""
   where
     path = pathInfo req
     verb = requestMethod req
     json = (hContentType, "application/json")
     conn = connectPostgreSQL $ configDbUri config
+    --qq   = fromMaybe [] $ parseSimpleQuery . BS.pack . uriQuery <$> traceThis (parseURI . BS.unpack $ traceThis $ rawPathInfo req)
+    qq   = queryString req

PgStructure.hs

@@ -3,13 +3,15 @@
 module PgStructure where
 
 import Data.Functor ( (<$>) )
-import Data.Maybe (mapMaybe)
+import Data.Maybe (mapMaybe, fromMaybe)
 import Data.List (intercalate)
+import Data.Monoid ((<>))
 
 import Data.HashMap.Strict hiding (map)
 
 import qualified Data.Text as T
 import qualified Data.ByteString.Lazy as BL
+import qualified Data.ByteString.Char8 as BS
 
 import qualified Data.Aeson as JSON
 
@@ -17,6 +19,9 @@ import Database.HDBC hiding (colType, colNullable)
 import Database.HDBC.PostgreSQL
 
 import Data.Aeson ((.=))
+import Network.HTTP.Types.URI
+
+import Debug.Trace
 
 data Table = Table {
   tableSchema :: String
@@ -104,17 +109,41 @@ printTables conn = JSON.encode <$> tables "base" conn
 printColumns :: T.Text -> Connection -> IO BL.ByteString
 printColumns table conn = JSON.encode . namedColumnHash <$> columns table conn
 
-selectAll :: T.Text -> Connection -> IO BL.ByteString
+traceThis :: (Show a) => a -> a
-selectAll table conn = do
+traceThis x = trace (show x) x
-  statement <- prepareDynamic conn
+
-    "select array_to_json(array_agg(row_to_json(t)))\
+selectWhere :: T.Text -> Query -> Connection -> IO BL.ByteString
-    \  from (select * from %I.%I) t" [toSql (T.pack "base"), toSql table]
+selectWhere table qq conn = do
+  let sql = unwords [
+        "select array_to_json(array_agg(row_to_json(t)))\
+        \  from (select * from %I.%I) t", whereClause qq ]
+  statement <- prepareDynamic conn sql
+     [toSql (T.pack "base"), toSql table]
   _ <- execute statement []
   r <- fetchAllRows statement
   return $ case r of
                 [[json]] -> fromSql json
                 _        -> "" :: BL.ByteString
 
+  where
+    wherePred :: QueryItem -> BS.ByteString
+    wherePred (column, predicate) =
+      let opCode:rest = BS.split ':' $ fromMaybe "" predicate
+          value = BS.intercalate ":" rest
+          op = case opCode of
+                    "eq"  -> "="
+                    "gt"  -> ">"
+                    "lt"  -> "<"
+                    "gte" -> ">="
+                    "lte" -> "<="
+                    "neq" -> "<>"
+                    _     -> "="
+       in BS.intercalate " " ["t." <> column, op, value]
+
+    whereClause :: Query -> String
+    whereClause [] = ""
+    whereClause qs = BS.unpack $ "where " <> BS.intercalate " and " (map wherePred qs)
+
 prepareDynamic :: Connection -> String -> [SqlValue] -> IO Statement
 prepareDynamic conn sql args = do
   [[escaped]] <- quickQuery conn q args
@@ -124,5 +153,5 @@ prepareDynamic conn sql args = do
   where
     q = concat [ "select format('", sql, "', ", placeholders args, ")" ]
 
-    placeholders :: [a] -> [Char]
+    placeholders :: [a] -> String
     placeholders = intercalate ", " . map (const "?::varchar")