From d7a36850023b80adf057e2964048e794a434106a Mon Sep 17 00:00:00 2001 From: Joe Nelson Date: Sat, 12 Jul 2014 16:18:03 -0700 Subject: [PATCH] Split into another module --- Main.hs | 3 +- PgQuery.hs | 74 ++++++++++++++++++++++++++++++++++++++++++++++++++ PgStructure.hs | 69 +--------------------------------------------- dbapi.cabal | 1 + 4 files changed, 78 insertions(+), 69 deletions(-) create mode 100644 PgQuery.hs diff --git a/Main.hs b/Main.hs index 0cd9c4bf0..3e9742d8d 100644 --- a/Main.hs +++ b/Main.hs @@ -14,7 +14,8 @@ import Network.HTTP.Types.Method import Options.Applicative hiding (columns) -import PgStructure (printTables, printColumns, selectWhere) +import PgStructure (printTables, printColumns) +import PgQuery (selectWhere) import Debug.Trace diff --git a/PgQuery.hs b/PgQuery.hs new file mode 100644 index 000000000..599c22b29 --- /dev/null +++ b/PgQuery.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE OverloadedStrings #-} + +module PgQuery where + +import Data.Functor ( (<$>) ) +import Data.Maybe (fromMaybe) +import Data.List (intercalate) +import Data.Monoid ((<>)) + +import qualified Data.Text as T +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Char8 as BS + +import Database.HDBC hiding (colType, colNullable) +import Database.HDBC.PostgreSQL + +import Network.HTTP.Types.URI + +selectWhere :: T.Text -> Query -> Connection -> IO BL.ByteString +selectWhere table qq conn = do + s <- selectSql + w <- whereClause conn qq + r <- quickQuery conn (BS.unpack $ s <> w) [] + return $ case r of + [[json]] -> fromSql json + _ -> "" :: BL.ByteString + + where + 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 :: 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 + return $ fromSql escaped + + where + q = concat [ "select format('", sql, "', ", placeholders args, ")" ] + + placeholders :: [a] -> String + placeholders = intercalate ", " . map (const "?::varchar") diff --git a/PgStructure.hs b/PgStructure.hs index 53c33eb0f..c5f8b1eb2 100644 --- a/PgStructure.hs +++ b/PgStructure.hs @@ -3,15 +3,12 @@ module PgStructure where import Data.Functor ( (<$>) ) -import Data.Maybe (mapMaybe, fromMaybe) -import Data.List (intercalate) -import Data.Monoid ((<>)) +import Data.Maybe (mapMaybe) 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 @@ -19,9 +16,6 @@ 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 @@ -108,64 +102,3 @@ printTables conn = JSON.encode <$> tables "base" conn printColumns :: T.Text -> Connection -> IO BL.ByteString 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 - s <- selectSql - w <- whereClause conn qq - r <- quickQuery conn (BS.unpack $ s <> w) [] - return $ case r of - [[json]] -> fromSql json - _ -> "" :: BL.ByteString - - where - 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 :: 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 - return $ fromSql escaped - - where - q = concat [ "select format('", sql, "', ", placeholders args, ")" ] - - placeholders :: [a] -> String - placeholders = intercalate ", " . map (const "?::varchar") diff --git a/dbapi.cabal b/dbapi.cabal index db369edd7..44f017be2 100644 --- a/dbapi.cabal +++ b/dbapi.cabal @@ -14,6 +14,7 @@ executable dbapi main-is: Main.hs ghc-options: -Wall other-modules: PgStructure + , PgQuery other-extensions: OverloadedStrings build-depends: base >=4.6 && <5 , HDBC, HDBC-postgresql