diff --git a/Main.hs b/Main.hs index 3fadc6e20..0cd9c4bf0 100644 --- a/Main.hs +++ b/Main.hs @@ -3,18 +3,14 @@ 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) @@ -59,5 +55,4 @@ app config req respond = 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 bc9d39552..53c33eb0f 100644 --- a/PgStructure.hs +++ b/PgStructure.hs @@ -112,43 +112,57 @@ printColumns table conn = JSON.encode . namedColumnHash <$> columns table conn 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 + s <- selectSql + w <- whereClause conn qq + r <- quickQuery conn (BS.unpack $ s <> w) [] 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] + selectSql = pgFormat conn + "select array_to_json(array_agg(row_to_json(t)))\ + \ from (select * from %I.%I) t" + [toSql (T.pack "base"), toSql table] - 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 +whereClause :: Connection -> Query -> IO BS.ByteString +whereClause _ [] = return "" +whereClause conn qs = + (" where " <>) <$> clause + + where + clause :: IO BS.ByteString + clause = BS.intercalate " and " <$> preds + + preds :: IO [BS.ByteString] + preds = sequence $ map (wherePred conn) qs + + +wherePred :: Connection -> QueryItem -> IO BS.ByteString +wherePred conn (column, predicate) = + pgFormat conn ("t.%I " <> op <> "%L") $ map toSql [column, value] + + where + opCode:rest = BS.split ':' $ fromMaybe "" predicate + value = BS.intercalate ":" rest + op = case opCode of + "eq" -> "=" + "gt" -> ">" + "lt" -> "<" + "gte" -> ">=" + "lte" -> "<=" + "neq" -> "<>" + _ -> "=" + + +pgFormat :: Connection -> String -> [SqlValue] -> IO BS.ByteString +pgFormat conn sql args = do [[escaped]] <- quickQuery conn q args - - prepare conn $ fromSql escaped + return $ fromSql escaped where q = concat [ "select format('", sql, "', ", placeholders args, ")" ]