Split into another module
This commit is contained in:
@@ -14,7 +14,8 @@ import Network.HTTP.Types.Method
|
|||||||
|
|
||||||
import Options.Applicative hiding (columns)
|
import Options.Applicative hiding (columns)
|
||||||
|
|
||||||
import PgStructure (printTables, printColumns, selectWhere)
|
import PgStructure (printTables, printColumns)
|
||||||
|
import PgQuery (selectWhere)
|
||||||
|
|
||||||
import Debug.Trace
|
import Debug.Trace
|
||||||
|
|
||||||
|
|||||||
+74
@@ -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")
|
||||||
+1
-68
@@ -3,15 +3,12 @@
|
|||||||
module PgStructure where
|
module PgStructure where
|
||||||
|
|
||||||
import Data.Functor ( (<$>) )
|
import Data.Functor ( (<$>) )
|
||||||
import Data.Maybe (mapMaybe, fromMaybe)
|
import Data.Maybe (mapMaybe)
|
||||||
import Data.List (intercalate)
|
|
||||||
import Data.Monoid ((<>))
|
|
||||||
|
|
||||||
import Data.HashMap.Strict hiding (map)
|
import Data.HashMap.Strict hiding (map)
|
||||||
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.ByteString.Lazy as BL
|
import qualified Data.ByteString.Lazy as BL
|
||||||
import qualified Data.ByteString.Char8 as BS
|
|
||||||
|
|
||||||
import qualified Data.Aeson as JSON
|
import qualified Data.Aeson as JSON
|
||||||
|
|
||||||
@@ -19,9 +16,6 @@ import Database.HDBC hiding (colType, colNullable)
|
|||||||
import Database.HDBC.PostgreSQL
|
import Database.HDBC.PostgreSQL
|
||||||
|
|
||||||
import Data.Aeson ((.=))
|
import Data.Aeson ((.=))
|
||||||
import Network.HTTP.Types.URI
|
|
||||||
|
|
||||||
import Debug.Trace
|
|
||||||
|
|
||||||
data Table = Table {
|
data Table = Table {
|
||||||
tableSchema :: String
|
tableSchema :: String
|
||||||
@@ -108,64 +102,3 @@ printTables conn = JSON.encode <$> tables "base" conn
|
|||||||
|
|
||||||
printColumns :: T.Text -> Connection -> IO BL.ByteString
|
printColumns :: T.Text -> Connection -> IO BL.ByteString
|
||||||
printColumns table conn = JSON.encode . namedColumnHash <$> columns table conn
|
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")
|
|
||||||
|
|||||||
@@ -14,6 +14,7 @@ executable dbapi
|
|||||||
main-is: Main.hs
|
main-is: Main.hs
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
other-modules: PgStructure
|
other-modules: PgStructure
|
||||||
|
, PgQuery
|
||||||
other-extensions: OverloadedStrings
|
other-extensions: OverloadedStrings
|
||||||
build-depends: base >=4.6 && <5
|
build-depends: base >=4.6 && <5
|
||||||
, HDBC, HDBC-postgresql
|
, HDBC, HDBC-postgresql
|
||||||
|
|||||||
Reference in New Issue
Block a user