abhin4v
/
ringo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Changes fact populatation generator to use hssqlppp internally.

pull/1/head
Abhinav Sarkar 2016-01-25 22:13:47 +05:30
parent d33dcbe33c
commit 46e5e43856
5 changed files with 149 additions and 154 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/Ringo/Generator/Create.hs
View File

@ -47,8 +47,8 @@ tableDefnStmts Table {..} = do
tableDefnSQL :: Table -> (Table -> Reader Env [Statement]) -> Reader Env [Text] tableDefnSQL :: Table -> (Table -> Reader Env [Statement]) -> Reader Env [Text]
tableDefnSQL table indexFn = do tableDefnSQL table indexFn = do
ds <- map ppSQL <$> tableDefnStmts table ds <- map ppStatement <$> tableDefnStmts table
is <- map (\st -> ppSQL st <> ";\n") <$> indexFn table is <- map (\st -> ppStatement st <> ";\n") <$> indexFn table
return $ ds ++ is return $ ds ++ is
dimensionTableDefnSQL :: Table -> Reader Env [Text] dimensionTableDefnSQL :: Table -> Reader Env [Text]

19
src/Ringo/Generator/Internal.hs
View File

@ -6,31 +6,22 @@ import qualified Data.Map as Map
import qualified Data.Text as Text import qualified Data.Text as Text
import Database.HsSqlPpp.Syntax (ScalarExpr) import Database.HsSqlPpp.Syntax (ScalarExpr)
import Data.List (find) import Data.List (find)
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import Data.Text (Text) import Data.Text (Text)
import Ringo.Extractor.Internal import Ringo.Extractor.Internal
import Ringo.Generator.Sql import Ringo.Generator.Sql
import Ringo.Types import Ringo.Types
joinColumnNames :: [ColumnName] -> Text
joinColumnNames = Text.intercalate ",\n"
fullColumnName :: TableName -> ColumnName -> ColumnName
fullColumnName tName cName = tName <> "." <> cName
dimColumnMapping :: Text -> Fact -> TableName -> [(ColumnName, ColumnName)] dimColumnMapping :: Text -> Fact -> TableName -> [(ColumnName, ColumnName)]
dimColumnMapping dimPrefix fact dimTableName = dimColumnMapping dimPrefix fact dimTableName =
[ (dimColumnName dName cName, cName) [ (dimColumnName dName cName, cName)
| DimVal dName cName <- factColumns fact | DimVal dName cName <- factColumns fact
, dimPrefix <> dName == dimTableName ] , dimPrefix <> dName == dimTableName ]
coalesceColumn :: TypeDefaults -> TableName -> Column -> Text coalesceColumn :: TypeDefaults -> TableName -> Column -> ScalarExpr
coalesceColumn defaults tName = ppScalarExpr . coalesceColumn' defaults tName coalesceColumn defaults tName Column{..} =
coalesceColumn' :: TypeDefaults -> TableName -> Column -> ScalarExpr
coalesceColumn' defaults tName Column{..} =
if columnNullable == Null if columnNullable == Null
then app "coalesce" [fqColName, num $ defVal columnType] then app "coalesce" [fqColName, num $ defVal columnType]
else fqColName else fqColName

8
src/Ringo/Generator/Populate/Dimension.hs
View File

@ -20,16 +20,16 @@ import Ringo.Types
dimensionTablePopulateSQL :: TablePopulationMode -> Fact -> TableName -> Reader Env Text dimensionTablePopulateSQL :: TablePopulationMode -> Fact -> TableName -> Reader Env Text
dimensionTablePopulateSQL popMode fact dimTableName = dimensionTablePopulateSQL popMode fact dimTableName =
ppSQL <$> dimensionTablePopulateSQL' popMode fact dimTableName ppStatement <$> dimensionTablePopulateStmt popMode fact dimTableName
dimensionTablePopulateSQL' :: TablePopulationMode -> Fact -> TableName -> Reader Env Statement dimensionTablePopulateStmt :: TablePopulationMode -> Fact -> TableName -> Reader Env Statement
dimensionTablePopulateSQL' popMode fact dimTableName = do dimensionTablePopulateStmt popMode fact dimTableName = do
Settings {..} <- asks envSettings Settings {..} <- asks envSettings
tables <- asks envTables tables <- asks envTables
defaults <- asks envTypeDefaults defaults <- asks envTypeDefaults
let factTable = fromJust $ findTable (factTableName fact) tables let factTable = fromJust $ findTable (factTableName fact) tables
colMapping = dimColumnMapping settingDimPrefix fact dimTableName colMapping = dimColumnMapping settingDimPrefix fact dimTableName
selectCols = [ flip sia (nmc cName) $ coalesceColumn' defaults (factTableName fact) col selectCols = [ flip sia (nmc cName) $ coalesceColumn defaults (factTableName fact) col
| (_, cName) <- colMapping | (_, cName) <- colMapping
, let col = fromJust . findColumn cName $ tableColumns factTable ] , let col = fromJust . findColumn cName $ tableColumns factTable ]
timeCol = head [ cName | DimTime cName <- factColumns fact ] timeCol = head [ cName | DimTime cName <- factColumns fact ]

218
src/Ringo/Generator/Populate/Fact.hs
View File

@ -10,18 +10,21 @@ import qualified Data.Text as Text
#if MIN_VERSION_base(4,8,0) #if MIN_VERSION_base(4,8,0)
#else #else
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
#endif #endif
import Control.Monad.Reader (Reader, asks) import Control.Monad.Reader (Reader, asks)
import Data.List (nub) import Database.HsSqlPpp.Syntax ( QueryExpr(..), Statement, makeSelect
import Data.Maybe (fromJust, fromMaybe, mapMaybe, listToMaybe) , SelectList(..), SelectItem(..), JoinType(..) )
import Data.Monoid ((<>)) import Data.List (nub)
import Data.Text (Text) import Data.Maybe (fromJust, fromMaybe, listToMaybe)
import Text.RawString.QQ (r) import Data.Monoid ((<>))
import Data.Text (Text)
import Text.RawString.QQ (r)
import Ringo.Extractor.Internal import Ringo.Extractor.Internal
import Ringo.Generator.Internal import Ringo.Generator.Internal
import Ringo.Generator.Sql
import Ringo.Types import Ringo.Types
import Ringo.Utils import Ringo.Utils
@ -48,18 +51,12 @@ BEGIN
RETURN r; RETURN r;
END; END;
$$ $$
LANGUAGE 'plpgsql' IMMUTABLE|] LANGUAGE 'plpgsql' IMMUTABLE;
|]
data FactTablePopulateSelectSQL = FactTablePopulateSelectSQL factCountDistinctUpdateStmts :: TablePopulationMode -> Fact -> Text -> QueryExpr -> Reader Env [Statement]
{ ftpsSelectCols :: ![(Text, Text)] factCountDistinctUpdateStmts
, ftpsSelectTable :: !Text popMode fact groupByColPrefix ~Select {selSelectList = SelectList _ origSelectItems, ..} = do
, ftpsJoinClauses :: ![Text]
, ftpsWhereClauses :: ![Text]
, ftpsGroupByCols :: ![Text]
} deriving (Show, Eq)
factTableUpdateSQL :: TablePopulationMode -> Fact -> Text -> FactTablePopulateSelectSQL -> Reader Env [Text]
factTableUpdateSQL popMode fact groupByColPrefix populateSelectSQL@FactTablePopulateSelectSQL {..} = do
Settings {..} <- asks envSettings Settings {..} <- asks envSettings
tables <- asks envTables tables <- asks envTables
let countDistinctCols = [ col | col@(FactCountDistinct _ _) <- factColumns fact] let countDistinctCols = [ col | col@(FactCountDistinct _ _) <- factColumns fact]
@ -70,50 +67,57 @@ factTableUpdateSQL popMode fact groupByColPrefix populateSelectSQL@FactTablePopu
suffixTableName popMode settingTableNameSuffixTemplate suffixTableName popMode settingTableNameSuffixTemplate
$ extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit $ extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
return . (\xs -> if null xs then xs else ilog2FunctionString : xs) return $ for countDistinctCols $ \(FactCountDistinct scName cName) ->
$ for countDistinctCols $ \(FactCountDistinct scName cName) -> let unqCol = cast (eqi fTableName (fromMaybe tablePKColName scName)) "text"
let unqCol = fullColumnName fTableName (fromMaybe tablePKColName scName) <> "::text"
bucketSelectCols = bucketSelectCols =
[ ( "hashtext(" <> unqCol <> ") & " [ sia (binop "&" (app "hashtext" [ unqCol ])
<> Text.pack (show $ bucketCount settingFactCountDistinctErrorRate - 1) (num . Text.pack . show $ bucketCount settingFactCountDistinctErrorRate - 1))
, cName <> "_bnum" (nmc $ cName <> "_bnum")
) , sia (binop "-"
, ( "31 - ilog2(min(hashtext(" <> unqCol <> ") & ~(1 << 31)))" (num "31")
, cName <> "_bhash" (app "ilog2"
) [ app "min" [ binop "&"
(app "hashtext" [ unqCol ])
(prefop "~" (parens (binop "<<" (num "1") (num "31"))))]]))
(nmc $ cName <> "_bhash")
] ]
selectSQL = toSelectSQL $ groupByCols = map ppScalarExpr selGroupBy
populateSelectSQL selectList =
{ ftpsSelectCols = filter ((`elem` ftpsGroupByCols) . snd) ftpsSelectCols ++ bucketSelectCols [ i | i@(SelectItem _ _ a) <- origSelectItems , a `elem` map nmc groupByCols ]
, ftpsGroupByCols = ftpsGroupByCols ++ [ cName <> "_bnum" ]
, ftpsWhereClauses = ftpsWhereClauses ++ [ unqCol <> " IS NOT NULL" ] selectStmt =
makeSelect
{ selSelectList = sl $ selectList ++ bucketSelectCols
, selTref = selTref
, selWhere = binop "and" (postop "isnotnull" unqCol) <$> selWhere
, selGroupBy = selGroupBy ++ [ ei $ cName <> "_bnum" ]
} }
aggSelectClause = aggSelectClause =
"json_object_agg(" <> cName <> "_bnum, " <> cName <> "_bhash) AS " <> cName sia (app "json_object_agg" [ ei (cName <> "_bnum"), ei (cName <> "_bhash") ]) (nmc cName)
in "UPDATE " <> extFactTableName in update extFactTableName
<> "\nSET " <> cName <> " = " <> fullColumnName "xyz" cName [ (cName, eqi "xyz" cName) ]
<> "\nFROM (" [ subtrefa "xyz"
<> "\nSELECT " <> joinColumnNames (ftpsGroupByCols ++ [aggSelectClause]) makeSelect
<> "\nFROM (\n" <> selectSQL <> "\n) zyx" { selSelectList = sl $ map (si . ei) groupByCols ++ [ aggSelectClause ]
<> "\nGROUP BY \n" <> joinColumnNames ftpsGroupByCols , selTref = [ subtrefa "zyx" selectStmt ]
<> "\n) xyz" , selGroupBy = selGroupBy
<> "\n WHERE\n" } ] $
<> Text.intercalate "\nAND " foldBinop "and"
[ fullColumnName extFactTableName .fromJust . Text.stripPrefix groupByColPrefix $ col [ binop "=" (eqi extFactTableName . fromJust . Text.stripPrefix groupByColPrefix $ col)
<> " = " <> fullColumnName "xyz" col (eqi "xyz" col)
| col <- ftpsGroupByCols ] | col <- groupByCols ]
where where
bucketCount :: Double -> Integer bucketCount :: Double -> Integer
bucketCount errorRate = bucketCount errorRate =
let power :: Double = fromIntegral (ceiling . logBase 2 $ (1.04 / errorRate) ** 2 :: Integer) let power :: Double = fromIntegral (ceiling . logBase 2 $ (1.04 / errorRate) ** 2 :: Integer)
in ceiling $ 2 ** power in ceiling $ 2 ** power
factTablePopulateSQL :: TablePopulationMode -> Fact -> Reader Env [Text] factTablePopulateStmts :: TablePopulationMode -> Fact -> Reader Env [Statement]
factTablePopulateSQL popMode fact = do factTablePopulateStmts popMode fact = do
Settings {..} <- asks envSettings Settings {..} <- asks envSettings
allDims <- extractAllDimensionTables fact allDims <- extractAllDimensionTables fact
tables <- asks envTables tables <- asks envTables
@ -122,116 +126,102 @@ factTablePopulateSQL popMode fact = do
fTable = fromJust . findTable fTableName $ tables fTable = fromJust . findTable fTableName $ tables
dimIdColName = settingDimTableIdColumnName dimIdColName = settingDimTableIdColumnName
coalesceFKId col = coalesceFKId ex =
if "coalesce" `Text.isPrefixOf` col app "coalesce" [ ex, num . Text.pack . show $ settingForeignKeyIdCoalesceValue ]
then col
else "coalesce((" <> col <> "), " <> Text.pack (show settingForeignKeyIdCoalesceValue) <> ")"
timeUnitColumnInsertSQL cName = timeUnitColumnInsertSQL cName =
let colName = timeUnitColumnName dimIdColName cName settingTimeUnit let colName = timeUnitColumnName dimIdColName cName settingTimeUnit
in ( colName in ( colName
, "floor(extract(epoch from " <> fullColumnName fTableName cName <> ")/" , cast (app "floor" [ binop "/" (extEpoch (eqi fTableName cName))
<> Text.pack (show $ timeUnitToSeconds settingTimeUnit) <> ")::bigint" (num . Text.pack . show . timeUnitToSeconds $ settingTimeUnit) ])
"bigint"
, True , True
) )
dimIdColumnInsertSQL cName = dimIdColumnInsertSQL cName =
let sCol = fromJust . findColumn cName $ tableColumns fTable let sCol = fromJust . findColumn cName $ tableColumns fTable
in (cName, coalesceColumn defaults fTableName sCol, True) in (cName, coalesceColumn defaults fTableName sCol, True)
app' f cName = app f [ eqi fTableName cName ]
factColMap = concatFor (factColumns fact) $ \col -> case col of factColMap = concatFor (factColumns fact) $ \col -> case col of
DimTime cName -> [ timeUnitColumnInsertSQL cName ] DimTime cName -> [ timeUnitColumnInsertSQL cName ]
NoDimId cName -> [ dimIdColumnInsertSQL cName ] NoDimId cName -> [ dimIdColumnInsertSQL cName ]
TenantId cName -> [ dimIdColumnInsertSQL cName ] TenantId cName -> [ dimIdColumnInsertSQL cName ]
FactCount scName cName -> FactCount scName cName ->
[ (cName, "count(" <> maybe "*" (fullColumnName fTableName) scName <> ")", False) ] [ (cName, app "count" [ maybe star (eqi fTableName) scName ], False) ]
FactSum scName cName -> FactSum scName cName -> [ (cName, app' "sum" scName, False) ]
[ (cName, "sum(" <> fullColumnName fTableName scName <> ")", False) ] FactMax scName cName -> [ (cName, app' "max" scName, False) ]
FactMax scName cName -> FactMin scName cName -> [ (cName, app' "min" scName, False) ]
[ (cName, "max(" <> fullColumnName fTableName scName <> ")", False) ]
FactMin scName cName ->
[ (cName, "min(" <> fullColumnName fTableName scName <> ")", False) ]
FactAverage scName cName -> FactAverage scName cName ->
[ ( cName <> settingAvgCountColumSuffix [ ( cName <> settingAvgCountColumSuffix, app' "count" scName, False )
, "count(" <> fullColumnName fTableName scName <> ")" , ( cName <> settingAvgSumColumnSuffix , app' "sum" scName , False)
, False
)
, ( cName <> settingAvgSumColumnSuffix
, "sum(" <> fullColumnName fTableName scName <> ")"
, False
)
] ]
FactCountDistinct _ cName -> [ (cName, "'{}'::json", False)] FactCountDistinct _ cName -> [ (cName, cast (str "{}") "json", False) ]
_ -> [] _ -> []
dimColMap = for allDims $ \(dimFact, factTable@Table {tableName}) -> let dimColMap = for allDims $ \(dimFact, factTable@Table {tableName}) -> let
dimFKIdColName = factDimFKIdColumnName settingDimPrefix dimIdColName tableName dimFKIdColName = factDimFKIdColumnName settingDimPrefix dimIdColName tableName
factSourceTableName = factTableName dimFact factSourceTableName = factTableName dimFact
factSourceTable = fromJust . findTable factSourceTableName $ tables factSourceTable = fromJust . findTable factSourceTableName $ tables
dimFKIdColumn = fromJust . findColumn dimFKIdColName $ tableColumns factSourceTable dimFKIdColumn = fromJust . findColumn dimFKIdColName $ tableColumns factSourceTable
dimLookupWhereClauses = dimLookupWhereClauses = Just . foldBinop "and" $
[ fullColumnName tableName dimColName <> " = " <> coalesceColumn defaults factSourceTableName sourceCol [ binop "=" (eqi tableName dimColName) (coalesceColumn defaults factSourceTableName sourceCol)
| (dimColName, sourceColName) <- dimColumnMapping settingDimPrefix dimFact tableName | (dimColName, sourceColName) <- dimColumnMapping settingDimPrefix dimFact tableName
, let sourceCol = fromJust . findColumn sourceColName $ tableColumns factSourceTable ] , let sourceCol = fromJust . findColumn sourceColName $ tableColumns factSourceTable ]
insertSQL = if factTable `elem` tables -- existing dimension table insertExpr = if factTable `elem` tables -- existing dimension table
then (if columnNullable dimFKIdColumn == Null then coalesceFKId else id) then (if columnNullable dimFKIdColumn == Null then coalesceFKId else id)
$ fullColumnName factSourceTableName dimFKIdColName $ eqi factSourceTableName dimFKIdColName
else "SELECT " <> dimIdColName <> " FROM " else coalesceFKId . subQueryExp $
<> suffixTableName popMode settingTableNameSuffixTemplate tableName <> " " <> tableName makeSelect
<> "\nWHERE " <> Text.intercalate "\n AND " dimLookupWhereClauses { selSelectList = sl [ si $ ei dimIdColName ]
in (dimFKIdColName, coalesceFKId insertSQL, True) , selTref =
[ trefa (suffixTableName popMode settingTableNameSuffixTemplate tableName) tableName ]
, selWhere = dimLookupWhereClauses
}
in (dimFKIdColName, insertExpr, True)
colMap = [ (cName, (sql, groupByColPrefix <> cName), addToGroupBy) colMap = [ (cName, (expr, nmc $ groupByColPrefix <> cName), addToGroupBy)
| (cName, sql, addToGroupBy) <- factColMap ++ dimColMap ] | (cName, expr, addToGroupBy) <- factColMap ++ dimColMap ]
joinClauses = joinClauses =
mapMaybe (\tName -> (\p -> "LEFT JOIN " <> tName <> "\nON "<> p) <$> joinClausePreds fTable tName) map (tref &&& joinClausePreds fTable)
. filter (/= fTableName)
. nub . nub
. map (factTableName . fst) . map (factTableName . fst)
$ allDims $ allDims
timeCol = fullColumnName fTableName $ head [ cName | DimTime cName <- factColumns fact ] timeCol = eqi fTableName $ head [ cName | DimTime cName <- factColumns fact ]
extFactTableName = suffixTableName popMode settingTableNameSuffixTemplate extFactTableName = suffixTableName popMode settingTableNameSuffixTemplate
$ extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit $ extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
populateSelectSQL = populateSelectExpr =
FactTablePopulateSelectSQL makeSelect
{ ftpsSelectCols = map snd3 colMap { selSelectList = sl . map (uncurry sia . snd3) $ colMap
, ftpsSelectTable = fTableName , selTref = [ foldl (\tf (t, oc) -> tjoin tf LeftOuter t oc) (tref fTableName) joinClauses ]
, ftpsJoinClauses = joinClauses , selWhere = Just . foldBinop "and" $
, ftpsWhereClauses = binop "<" timeCol placeholder :
timeCol <> " < ?" : [ timeCol <> " >= ?" | popMode == IncrementalPopulation ] [ binop ">=" timeCol placeholder | popMode == IncrementalPopulation ]
, ftpsGroupByCols = map ((groupByColPrefix <>) . fst3) . filter thd3 $ colMap , selGroupBy = map (ei . (groupByColPrefix <>) . fst3) . filter thd3 $ colMap
} }
insertIntoSQL = "INSERT INTO " <> extFactTableName insertIntoStmt = insert extFactTableName (map fst3 colMap) populateSelectExpr
<> " (\n" <> Text.intercalate ",\n " (map fst3 colMap) <> "\n)\n"
<> toSelectSQL populateSelectSQL
updateSQLs <- factTableUpdateSQL popMode fact groupByColPrefix populateSelectSQL updateStmts <- factCountDistinctUpdateStmts popMode fact groupByColPrefix populateSelectExpr
return $ insertIntoStmt : updateStmts
return $ insertIntoSQL : updateSQLs
where where
groupByColPrefix = "xxff_" groupByColPrefix = "xxff_"
joinClausePreds table oTableName = joinClausePreds table oTableName =
Text.intercalate " AND " foldBinop "and"
. map (\(c1, c2) -> fullColumnName (tableName table) c1 <> " = " <> fullColumnName oTableName c2) . map (\(c1, c2) -> binop "=" (eqi (tableName table) c1) (eqi oTableName c2))
<$> listToMaybe [ colPairs | ForeignKey tName colPairs <- tableConstraints table <$> listToMaybe [ colPairs | ForeignKey tName colPairs <- tableConstraints table
, tName == oTableName ] , tName == oTableName ]
toSelectSQL :: FactTablePopulateSelectSQL -> Text factTablePopulateSQL :: TablePopulationMode -> Fact -> Reader Env [Text]
toSelectSQL FactTablePopulateSelectSQL {..} = factTablePopulateSQL popMode fact = do
"SELECT \n" <> joinColumnNames (map (uncurry asName) ftpsSelectCols) stmts <- factTablePopulateStmts popMode fact
<> "\nFROM " <> ftpsSelectTable return $ case stmts of
<> (if not . null $ ftpsJoinClauses [] -> []
then "\n" <> Text.intercalate "\n" ftpsJoinClauses [i] -> [ ppStatement i ]
else "") i:us -> [ ppStatement i, ilog2FunctionString ] ++ map ppStatement us
<> (if not . null $ ftpsWhereClauses
then "\nWHERE " <> Text.intercalate "\nAND " ftpsWhereClauses
else "")
<> "\nGROUP BY \n"
<> joinColumnNames ftpsGroupByCols
where
asName sql alias = "(" <> sql <> ")" <> " as " <> alias

54
src/Ringo/Generator/Sql.hs
View File

@ -1,14 +1,14 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
module Ringo.Generator.Sql where module Ringo.Generator.Sql where
import qualified Data.Text as Text import qualified Data.Text as Text
import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy as TL
import Database.HsSqlPpp.Annotation import Database.HsSqlPpp.Annotation
import Database.HsSqlPpp.Dialect (postgresDialect) import Database.HsSqlPpp.Dialect
import Database.HsSqlPpp.Pretty import Database.HsSqlPpp.Pretty
import Database.HsSqlPpp.Syntax import Database.HsSqlPpp.Syntax
import Data.Text (Text) import Data.Text (Text)
ea :: Annotation ea :: Annotation
ea = emptyAnnotation ea = emptyAnnotation
@ -24,28 +24,31 @@ attDef nam typ constr =
AttributeDef ea (nmc nam) (SimpleTypeName ea $ name typ) Nothing [constr] AttributeDef ea (nmc nam) (SimpleTypeName ea $ name typ) Nothing [constr]
member :: ScalarExpr -> ScalarExpr -> ScalarExpr member :: ScalarExpr -> ScalarExpr -> ScalarExpr
member a b = BinaryOp ea (name ".") a b member = BinaryOp ea (name ".")
num :: Text -> ScalarExpr num :: Text -> ScalarExpr
num n = NumberLit ea $ Text.unpack n num = NumberLit ea . Text.unpack
str :: Text -> ScalarExpr str :: Text -> ScalarExpr
str = StringLit ea . Text.unpack str = StringLit ea . Text.unpack
app :: Text -> [ScalarExpr] -> ScalarExpr extEpoch :: ScalarExpr -> ScalarExpr
app n as = App ea (name n) as extEpoch = Extract ea ExtractEpoch
specop :: Text -> [ScalarExpr] -> ScalarExpr app :: Text -> [ScalarExpr] -> ScalarExpr
specop n as = SpecialOp ea (name n) as app n = App ea (name n)
cast :: ScalarExpr -> Text -> ScalarExpr
cast ex = Cast ea ex . SimpleTypeName ea . name
prefop :: Text -> ScalarExpr -> ScalarExpr prefop :: Text -> ScalarExpr -> ScalarExpr
prefop n a = PrefixOp ea (name n) a prefop n = PrefixOp ea (name n)
postop :: Text -> ScalarExpr -> ScalarExpr postop :: Text -> ScalarExpr -> ScalarExpr
postop n a = PostfixOp ea (name n) a postop n = PostfixOp ea (name n)
binop :: Text -> ScalarExpr -> ScalarExpr -> ScalarExpr binop :: Text -> ScalarExpr -> ScalarExpr -> ScalarExpr
binop n a0 a1 = BinaryOp ea (name n) a0 a1 binop n = BinaryOp ea (name n)
foldBinop :: Text -> [ScalarExpr] -> ScalarExpr foldBinop :: Text -> [ScalarExpr] -> ScalarExpr
foldBinop _ [] = error "List must be non empty" foldBinop _ [] = error "List must be non empty"
@ -60,9 +63,15 @@ parens = Parens ea
qstar :: Text -> ScalarExpr qstar :: Text -> ScalarExpr
qstar = QStar ea . nmc qstar = QStar ea . nmc
star :: ScalarExpr
star = Star ea
subQueryExp :: QueryExpr -> ScalarExpr
subQueryExp = ScalarSubQuery ea
-- Table ref -- Table ref
tref :: Text -> TableRef tref :: Text -> TableRef
tref s = Tref ea (name s) tref = Tref ea . name
-- Table ref alias -- Table ref alias
trefa :: Text -> Text -> TableRef trefa :: Text -> Text -> TableRef
@ -82,11 +91,11 @@ si = SelExp ea
-- Select item alias -- Select item alias
sia :: ScalarExpr -> NameComponent -> SelectItem sia :: ScalarExpr -> NameComponent -> SelectItem
sia e a = SelectItem ea e a sia = SelectItem ea
-- Expression qualified identifier -- Expression qualified identifier
eqi :: Text -> Text -> ScalarExpr eqi :: Text -> Text -> ScalarExpr
eqi c x = Identifier ea $ qn c x eqi c = Identifier ea . qn c
-- Expression identifier -- Expression identifier
ei :: Text -> ScalarExpr ei :: Text -> ScalarExpr
@ -100,15 +109,20 @@ qn c n = Name ea [nmc c, nmc n]
sl :: [SelectItem] -> SelectList sl :: [SelectItem] -> SelectList
sl = SelectList ea sl = SelectList ea
-- Insert statement
insert :: Text -> [Text] -> QueryExpr -> Statement insert :: Text -> [Text] -> QueryExpr -> Statement
insert tName cNames selectExp = insert tName cNames selectExp =
Insert ea (name tName) (map nmc cNames) selectExp Nothing Insert ea (name tName) (map nmc cNames) selectExp Nothing
ppSQL :: Statement -> Text -- Update statement
ppSQL st = TL.toStrict $ prettyStatements (PrettyFlags postgresDialect) [st] update :: Text -> [(Text, ScalarExpr)] -> [TableRef] -> ScalarExpr -> Statement
update tName setClauseList fromList whr =
Update ea (name tName) (map (uncurry (SetClause ea . nmc)) setClauseList) fromList (Just whr) Nothing
-- Pretty print statement
ppStatement :: Statement -> Text
ppStatement st = TL.toStrict $ prettyStatements (PrettyFlags postgresDialect) [st]
-- Pretty print scalar expression
ppScalarExpr :: ScalarExpr -> Text ppScalarExpr :: ScalarExpr -> Text
ppScalarExpr = TL.toStrict . prettyScalarExpr (PrettyFlags postgresDialect) ppScalarExpr = TL.toStrict . prettyScalarExpr (PrettyFlags postgresDialect)
ppQueryExpr :: QueryExpr -> Text
ppQueryExpr = TL.toStrict . prettyQueryExpr (PrettyFlags postgresDialect)