diff --git a/Main.hs b/Main.hs index fd76569a4..3fadc6e20 100644 --- a/Main.hs +++ b/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 diff --git a/PgStructure.hs b/PgStructure.hs index b25077d80..bc9d39552 100644 --- a/PgStructure.hs +++ b/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 -selectAll table conn = do - statement <- prepareDynamic conn - "select array_to_json(array_agg(row_to_json(t)))\ - \ from (select * from %I.%I) t" [toSql (T.pack "base"), toSql table] +traceThis :: (Show a) => a -> a +traceThis x = trace (show x) x + +selectWhere :: T.Text -> Query -> Connection -> IO BL.ByteString +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")