Removes EnvV from Types to simplify the code.
parent
ade13f767b
commit
29bafea95b
|
|
@ -1,6 +1,5 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
module Main where
|
||||
|
||||
|
|
@ -27,14 +26,15 @@ main = do
|
|||
result <- parseInput progInputFile
|
||||
case result of
|
||||
Left err -> putStrLn err >> exitFailure
|
||||
Right (tables, facts, defaults) -> do
|
||||
Right (tables, facts, defaults) ->
|
||||
case makeEnv tables facts progSettings defaults of
|
||||
Left errors -> mapM_ print errors >> exitFailure
|
||||
Right env -> writeFiles progOutputDir env >> exitSuccess
|
||||
|
||||
writeFiles :: FilePath -> Env -> IO ()
|
||||
writeFiles outputDir env@(envView -> EnvV{..}) = do
|
||||
let Settings{..} = envSettings
|
||||
writeFiles outputDir env = do
|
||||
let Settings{..} = envSettings env
|
||||
|
||||
forM_ sqls $ \(sqlType, table, sql) -> do
|
||||
let dirName = outputDir </> map toLower (show sqlType)
|
||||
createDirectoryIfMissing True dirName
|
||||
|
|
@ -43,22 +43,25 @@ writeFiles outputDir env@(envView -> EnvV{..}) = do
|
|||
BS.writeFile (outputDir </> Text.unpack settingDependenciesJSONFileName)
|
||||
. encode
|
||||
. foldl (\acc -> Map.union acc . extractDependencies env) Map.empty
|
||||
$ envFacts
|
||||
$ facts
|
||||
|
||||
BS.writeFile (outputDir </> Text.unpack settingDimensionJSONFileName) . encode $
|
||||
[ tableName table | (_, tabs) <- dimTables, table <- tabs , table `notElem` envTables ]
|
||||
[ tableName table | (_, tabs) <- dimTables, table <- tabs , table `notElem` tables ]
|
||||
|
||||
BS.writeFile (outputDir </> Text.unpack settingFactsJSONFileName) . encode $
|
||||
[ tableName table | (_, table) <- factTables ]
|
||||
|
||||
where
|
||||
dimTables = [ (fact, extractDimensionTables env fact) | fact <- envFacts ]
|
||||
factTables = [ (fact, extractFactTable env fact) | fact <- envFacts, factTablePersistent fact ]
|
||||
facts = envFacts env
|
||||
tables = envTables env
|
||||
|
||||
dimTables = [ (fact, extractDimensionTables env fact) | fact <- facts ]
|
||||
factTables = [ (fact, extractFactTable env fact) | fact <- facts, factTablePersistent fact ]
|
||||
|
||||
dimTableDefnSQLs = [ (Create, tableName table, unlines . map sqlStr $ dimensionTableDefnSQL env table)
|
||||
| (_, tabs) <- dimTables
|
||||
, table <- tabs
|
||||
, table `notElem` envTables ]
|
||||
, table `notElem` tables ]
|
||||
|
||||
factTableDefnSQLs = [ (Create , tableName table, unlines . map sqlStr $ factTableDefnSQL env fact table)
|
||||
| (fact, table) <- factTables ]
|
||||
|
|
@ -67,7 +70,7 @@ writeFiles outputDir env@(envView -> EnvV{..}) = do
|
|||
[ (typ , tableName table, sqlStr $ gen env fact (tableName table))
|
||||
| (fact, tabs) <- dimTables
|
||||
, table <- tabs
|
||||
, table `notElem` envTables ]
|
||||
, table `notElem` tables ]
|
||||
|
||||
factTablePopulateSQLs typ gen = [ (typ, tableName table, unlines . map sqlStr $ gen env fact)
|
||||
| (fact, table) <- factTables ]
|
||||
|
|
|
|||
|
|
@ -1,5 +1,4 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Ringo.InputParser (parseInput) where
|
||||
|
|
|
|||
|
|
@ -11,75 +11,74 @@ module Ringo.Extractor
|
|||
import qualified Data.Map as Map
|
||||
import qualified Data.Tree as Tree
|
||||
|
||||
import Control.Monad.Reader (Reader, asks, withReader)
|
||||
import Control.Monad.Reader (Reader, asks)
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.Monoid ((<>))
|
||||
import Data.List (nub)
|
||||
|
||||
import Ringo.Extractor.Internal
|
||||
import Ringo.Types
|
||||
import Ringo.Types.Internal
|
||||
import Ringo.Utils
|
||||
|
||||
extractFactTable :: Fact -> Reader Env Table
|
||||
extractFactTable fact = do
|
||||
allDims <- extractAllDimensionTables fact
|
||||
withReader envView $ do
|
||||
Settings {..} <- asks envSettings
|
||||
tables <- asks envTables
|
||||
let table = fromJust . findTable (factTableName fact) $ tables
|
||||
allDims <- extractAllDimensionTables fact
|
||||
Settings {..} <- asks envSettings
|
||||
tables <- asks envTables
|
||||
let table = fromJust . findTable (factTableName fact) $ tables
|
||||
|
||||
let countColType = settingFactCountColumnType
|
||||
dimIdColName = settingDimTableIdColumnName
|
||||
sourceColumn cName = fromJust . findColumn cName . tableColumns $ table
|
||||
notNullSourceColumnCopy cName = (sourceColumn cName) { columnNullable = NotNull }
|
||||
notNullSourceColumnRename scName cName = (notNullSourceColumnCopy scName) { columnName = cName }
|
||||
let countColType = settingFactCountColumnType
|
||||
dimIdColName = settingDimTableIdColumnName
|
||||
sourceColumn cName = fromJust . findColumn cName . tableColumns $ table
|
||||
notNullSourceColumnCopy cName = (sourceColumn cName) { columnNullable = NotNull }
|
||||
notNullSourceColumnRename scName cName = (notNullSourceColumnCopy scName) { columnName = cName }
|
||||
|
||||
columns = concatFor (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
|
||||
case factColType of
|
||||
DimTime ->
|
||||
[ Column (timeUnitColumnName dimIdColName cName settingTimeUnit) "bigint" NotNull ]
|
||||
NoDimId -> [ notNullSourceColumnCopy cName ]
|
||||
TenantId -> [ notNullSourceColumnCopy cName ]
|
||||
FactCount {..} -> [ Column cName countColType NotNull ]
|
||||
FactCountDistinct {..} -> [ Column cName "json" NotNull ]
|
||||
FactSum {..} -> [ notNullSourceColumnRename factColSourceColumn cName ]
|
||||
FactMax {..} -> [ notNullSourceColumnRename factColSourceColumn cName ]
|
||||
FactMin {..} -> [ notNullSourceColumnRename factColSourceColumn cName ]
|
||||
FactAverage {..} ->
|
||||
[ Column (cName <> settingAvgCountColumSuffix) countColType NotNull
|
||||
, notNullSourceColumnRename factColSourceColumn (cName <> settingAvgSumColumnSuffix)
|
||||
]
|
||||
_ -> []
|
||||
columns = concatFor (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
|
||||
case factColType of
|
||||
DimTime ->
|
||||
[ Column (timeUnitColumnName dimIdColName cName settingTimeUnit) "bigint" NotNull ]
|
||||
NoDimId -> [ notNullSourceColumnCopy cName ]
|
||||
TenantId -> [ notNullSourceColumnCopy cName ]
|
||||
FactCount {..} -> [ Column cName countColType NotNull ]
|
||||
FactCountDistinct {..} -> [ Column cName "json" NotNull ]
|
||||
FactSum {..} -> [ notNullSourceColumnRename factColSourceColumn cName ]
|
||||
FactMax {..} -> [ notNullSourceColumnRename factColSourceColumn cName ]
|
||||
FactMin {..} -> [ notNullSourceColumnRename factColSourceColumn cName ]
|
||||
FactAverage {..} ->
|
||||
[ Column (cName <> settingAvgCountColumSuffix) countColType NotNull
|
||||
, notNullSourceColumnRename factColSourceColumn (cName <> settingAvgSumColumnSuffix)
|
||||
]
|
||||
_ -> []
|
||||
|
||||
fkColumns = for allDims $ \(dimFact, dimTable) ->
|
||||
let colName = factDimFKIdColumnName settingDimPrefix dimIdColName dimFact dimTable tables
|
||||
colType = idColTypeToFKIdColType settingDimTableIdColumnType
|
||||
in Column colName colType NotNull
|
||||
fkColumns = for allDims $ \(dimFact, dimTable) ->
|
||||
let colName = factDimFKIdColumnName settingDimPrefix dimIdColName dimFact dimTable tables
|
||||
colType = idColTypeToFKIdColType settingDimTableIdColumnType
|
||||
in Column colName colType NotNull
|
||||
|
||||
ukColNames =
|
||||
(++ map columnName fkColumns)
|
||||
. forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
|
||||
case factColType of
|
||||
DimTime -> Just $ timeUnitColumnName dimIdColName cName settingTimeUnit
|
||||
NoDimId -> Just cName
|
||||
TenantId -> Just cName
|
||||
_ -> Nothing
|
||||
ukColNames =
|
||||
(++ map columnName fkColumns)
|
||||
. forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
|
||||
case factColType of
|
||||
DimTime -> Just $ timeUnitColumnName dimIdColName cName settingTimeUnit
|
||||
NoDimId -> Just cName
|
||||
TenantId -> Just cName
|
||||
_ -> Nothing
|
||||
|
||||
return Table
|
||||
{ tableName =
|
||||
extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
|
||||
, tableColumns = columns ++ fkColumns
|
||||
, tableConstraints = [ UniqueKey ukColNames ]
|
||||
}
|
||||
return Table
|
||||
{ tableName =
|
||||
extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
|
||||
, tableColumns = columns ++ fkColumns
|
||||
, tableConstraints = [ UniqueKey ukColNames ]
|
||||
}
|
||||
|
||||
extractDependencies :: Fact -> Reader Env Dependencies
|
||||
extractDependencies fact = withReader envView $ do
|
||||
extractDependencies fact = do
|
||||
settings@Settings{..} <- asks envSettings
|
||||
facts <- asks envFacts
|
||||
let factSourceDeps =
|
||||
let factSourceDeps =
|
||||
nub . Tree.flatten . flip Tree.unfoldTree fact $ \fct ->
|
||||
(factTableName fct, parentFacts fct facts)
|
||||
factDimDeps =
|
||||
factDimDeps =
|
||||
nub . concat . Tree.flatten . flip Tree.unfoldTree fact $ \fct ->
|
||||
( forMaybe (factColumns fct) $ \FactColumn {..} -> case factColType of
|
||||
DimVal {..} -> Just $ settingDimPrefix <> factColTargetTable
|
||||
|
|
|
|||
|
|
@ -13,14 +13,14 @@ import qualified Data.Text as Text
|
|||
import Control.Applicative ((<$>))
|
||||
#endif
|
||||
|
||||
import Control.Monad.Reader (Reader, asks, withReader)
|
||||
import Control.Monad.Reader (Reader, asks)
|
||||
import Data.Function (on)
|
||||
import Data.Maybe (mapMaybe, fromMaybe, fromJust, catMaybes)
|
||||
import Data.Monoid ((<>))
|
||||
import Data.List (nub, nubBy, find)
|
||||
import Data.Text (Text)
|
||||
|
||||
import Ringo.Types
|
||||
import Ringo.Types.Internal
|
||||
|
||||
findTable :: TableName -> [Table] -> Maybe Table
|
||||
findTable tName = find ((== tName) . tableName)
|
||||
|
|
@ -59,7 +59,7 @@ idColTypeToFKIdColType typ = case Text.toLower typ of
|
|||
_ -> typ
|
||||
|
||||
extractDimensionTables :: Fact -> Reader Env [Table]
|
||||
extractDimensionTables fact = withReader envView $ do
|
||||
extractDimensionTables fact = do
|
||||
settings <- asks envSettings
|
||||
tables <- asks envTables
|
||||
let table = fromJust . findTable (factTableName fact) $ tables
|
||||
|
|
@ -99,5 +99,4 @@ extractAllDimensionTables fact = do
|
|||
parentDims <- concat <$> mapM extract (factParentNames fact)
|
||||
return . nubBy ((==) `on` snd) $ myDims ++ parentDims
|
||||
where
|
||||
extract fName =
|
||||
asks (envFacts . envView) >>= extractAllDimensionTables . fromJust . findFact fName
|
||||
extract fName = asks envFacts >>= extractAllDimensionTables . fromJust . findFact fName
|
||||
|
|
|
|||
|
|
@ -20,11 +20,11 @@ import Data.Text (Text)
|
|||
|
||||
import Ringo.Extractor.Internal
|
||||
import Ringo.Generator.Sql
|
||||
import Ringo.Types
|
||||
import Ringo.Types.Internal
|
||||
import Ringo.Utils
|
||||
|
||||
tableDefnStmts :: Table -> Reader Env [Statement]
|
||||
tableDefnStmts Table {..} = withReader envView $ do
|
||||
tableDefnStmts Table {..} = do
|
||||
Settings {..} <- asks envSettings
|
||||
let tabName = tableName <> settingTableNameSuffixTemplate
|
||||
|
||||
|
|
@ -58,7 +58,7 @@ dimensionTableDefnSQL :: Table -> Reader Env [Text]
|
|||
dimensionTableDefnSQL table = tableDefnSQL table dimensionTableIndexStmts
|
||||
|
||||
dimensionTableIndexStmts :: Table -> Reader Env [Statement]
|
||||
dimensionTableIndexStmts Table {..} = withReader envView $do
|
||||
dimensionTableIndexStmts Table {..} = do
|
||||
Settings {..} <- asks envSettings
|
||||
let tabName = tableName <> settingTableNameSuffixTemplate
|
||||
tablePKColName = head [ cName | PrimaryKey cName <- tableConstraints ]
|
||||
|
|
@ -72,26 +72,25 @@ factTableDefnSQL fact table = tableDefnSQL table (factTableIndexStmts fact)
|
|||
|
||||
factTableIndexStmts :: Fact -> Table -> Reader Env [Statement]
|
||||
factTableIndexStmts fact table = do
|
||||
allDims <- extractAllDimensionTables fact
|
||||
withReader envView $ do
|
||||
Settings {..} <- asks envSettings
|
||||
tables <- asks envTables
|
||||
allDims <- extractAllDimensionTables fact
|
||||
Settings {..} <- asks envSettings
|
||||
tables <- asks envTables
|
||||
|
||||
let dimTimeCol = head [ cName | FactColumn cName DimTime <- factColumns fact ]
|
||||
tenantIdCol = listToMaybe [ cName | FactColumn cName TenantId <- factColumns fact ]
|
||||
tabName = tableName table <> settingTableNameSuffixTemplate
|
||||
dimTimeColName cName = timeUnitColumnName settingDimTableIdColumnName cName settingTimeUnit
|
||||
let dimTimeCol = head [ cName | FactColumn cName DimTime <- factColumns fact ]
|
||||
tenantIdCol = listToMaybe [ cName | FactColumn cName TenantId <- factColumns fact ]
|
||||
tabName = tableName table <> settingTableNameSuffixTemplate
|
||||
dimTimeColName cName = timeUnitColumnName settingDimTableIdColumnName cName settingTimeUnit
|
||||
|
||||
factCols = forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
|
||||
case factColType of
|
||||
DimTime -> Just [dimTimeColName cName]
|
||||
NoDimId -> Just [cName]
|
||||
TenantId -> Just [cName]
|
||||
_ -> Nothing
|
||||
factCols = forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
|
||||
case factColType of
|
||||
DimTime -> Just [dimTimeColName cName]
|
||||
NoDimId -> Just [cName]
|
||||
TenantId -> Just [cName]
|
||||
_ -> Nothing
|
||||
|
||||
dimCols = [ [ factDimFKIdColumnName settingDimPrefix settingDimTableIdColumnName dimFact dimTable tables ]
|
||||
| (dimFact, dimTable) <- allDims ]
|
||||
dimCols = [ [ factDimFKIdColumnName settingDimPrefix settingDimTableIdColumnName dimFact dimTable tables ]
|
||||
| (dimFact, dimTable) <- allDims ]
|
||||
|
||||
return [ CreateIndexTSQL ea (nmc "") (name tabName) (map nmc cols)
|
||||
| cols <- factCols ++ dimCols ++ [ [cName, dimTimeColName dimTimeCol]
|
||||
| cName <- maybeToList tenantIdCol ] ]
|
||||
return [ CreateIndexTSQL ea (nmc "") (name tabName) (map nmc cols)
|
||||
| cols <- factCols ++ dimCols ++ [ [cName, dimTimeColName dimTimeCol]
|
||||
| cName <- maybeToList tenantIdCol ] ]
|
||||
|
|
|
|||
|
|
@ -10,7 +10,7 @@ module Ringo.Generator.Populate.Dimension (dimensionTablePopulateSQL) where
|
|||
import Control.Applicative ((<$>))
|
||||
#endif
|
||||
|
||||
import Control.Monad.Reader (Reader, asks, withReader)
|
||||
import Control.Monad.Reader (Reader, asks)
|
||||
import Database.HsSqlPpp.Syntax (Statement, QueryExpr(..), Distinct(..), makeSelect, JoinType(..))
|
||||
import Data.Maybe (fromJust)
|
||||
import Data.Text (Text)
|
||||
|
|
@ -18,14 +18,14 @@ import Data.Text (Text)
|
|||
import Ringo.Extractor.Internal
|
||||
import Ringo.Generator.Internal
|
||||
import Ringo.Generator.Sql
|
||||
import Ringo.Types
|
||||
import Ringo.Types.Internal
|
||||
|
||||
dimensionTablePopulateSQL :: TablePopulationMode -> Fact -> TableName -> Reader Env Text
|
||||
dimensionTablePopulateSQL popMode fact dimTableName =
|
||||
ppStatement <$> dimensionTablePopulateStmt popMode fact dimTableName
|
||||
|
||||
dimensionTablePopulateStmt :: TablePopulationMode -> Fact -> TableName -> Reader Env Statement
|
||||
dimensionTablePopulateStmt popMode fact dimTableName = withReader envView $ do
|
||||
dimensionTablePopulateStmt popMode fact dimTableName = do
|
||||
Settings {..} <- asks envSettings
|
||||
tables <- asks envTables
|
||||
defaults <- asks envTypeDefaults
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@ import qualified Data.Text as Text
|
|||
import Control.Applicative ((<$>))
|
||||
#endif
|
||||
|
||||
import Control.Monad.Reader (Reader, asks, withReader)
|
||||
import Control.Monad.Reader (Reader, asks)
|
||||
import Database.HsSqlPpp.Syntax ( QueryExpr(..), Statement, makeSelect
|
||||
, SelectList(..), SelectItem(..), JoinType(..) )
|
||||
import Data.List (nub)
|
||||
|
|
@ -27,7 +27,7 @@ import Text.RawString.QQ (r)
|
|||
import Ringo.Extractor.Internal
|
||||
import Ringo.Generator.Internal
|
||||
import Ringo.Generator.Sql
|
||||
import Ringo.Types
|
||||
import Ringo.Types.Internal
|
||||
import Ringo.Utils
|
||||
|
||||
ilog2FunctionString :: Text
|
||||
|
|
@ -56,7 +56,7 @@ $$
|
|||
LANGUAGE 'plpgsql' IMMUTABLE;
|
||||
|]
|
||||
|
||||
factCountDistinctUpdateStmts :: TablePopulationMode -> Fact -> Text -> QueryExpr -> Reader EnvV [Statement]
|
||||
factCountDistinctUpdateStmts :: TablePopulationMode -> Fact -> Text -> QueryExpr -> Reader Env [Statement]
|
||||
factCountDistinctUpdateStmts popMode fact groupByColPrefix expr = case expr of
|
||||
Select {selSelectList = SelectList _ origSelectItems, ..} -> do
|
||||
Settings {..} <- asks envSettings
|
||||
|
|
@ -125,108 +125,107 @@ factCountDistinctUpdateStmts popMode fact groupByColPrefix expr = case expr of
|
|||
|
||||
factTablePopulateStmts :: TablePopulationMode -> Fact -> Reader Env [Statement]
|
||||
factTablePopulateStmts popMode fact = do
|
||||
allDims <- extractAllDimensionTables fact
|
||||
withReader envView $ do
|
||||
Settings {..} <- asks envSettings
|
||||
tables <- asks envTables
|
||||
defaults <- asks envTypeDefaults
|
||||
let fTableName = factTableName fact
|
||||
fTable = fromJust . findTable fTableName $ tables
|
||||
dimIdColName = settingDimTableIdColumnName
|
||||
allDims <- extractAllDimensionTables fact
|
||||
Settings {..} <- asks envSettings
|
||||
tables <- asks envTables
|
||||
defaults <- asks envTypeDefaults
|
||||
let fTableName = factTableName fact
|
||||
fTable = fromJust . findTable fTableName $ tables
|
||||
dimIdColName = settingDimTableIdColumnName
|
||||
|
||||
coalesceFKId ex =
|
||||
app "coalesce" [ ex, num . Text.pack . show $ settingForeignKeyIdCoalesceValue ]
|
||||
coalesceFKId ex =
|
||||
app "coalesce" [ ex, num . Text.pack . show $ settingForeignKeyIdCoalesceValue ]
|
||||
|
||||
timeUnitColumnInsertSQL cName =
|
||||
let colName = timeUnitColumnName dimIdColName cName settingTimeUnit
|
||||
in ( colName
|
||||
, cast (app "floor" [ binop "/" (extEpoch (eqi fTableName cName))
|
||||
(num . Text.pack . show . timeUnitToSeconds $ settingTimeUnit) ])
|
||||
"bigint"
|
||||
, True
|
||||
)
|
||||
dimIdColumnInsertSQL cName =
|
||||
let sCol = fromJust . findColumn cName $ tableColumns fTable
|
||||
in (cName, coalesceColumn defaults fTableName sCol, True)
|
||||
timeUnitColumnInsertSQL cName =
|
||||
let colName = timeUnitColumnName dimIdColName cName settingTimeUnit
|
||||
in ( colName
|
||||
, cast (app "floor" [ binop "/" (extEpoch (eqi fTableName cName))
|
||||
(num . Text.pack . show . timeUnitToSeconds $ settingTimeUnit) ])
|
||||
"bigint"
|
||||
, True
|
||||
)
|
||||
dimIdColumnInsertSQL cName =
|
||||
let sCol = fromJust . findColumn cName $ tableColumns fTable
|
||||
in (cName, coalesceColumn defaults fTableName sCol, True)
|
||||
|
||||
app' f cName = app f [ eqi fTableName cName ]
|
||||
app' f cName = app f [ eqi fTableName cName ]
|
||||
|
||||
factColMap = concatFor (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
|
||||
case factColType of
|
||||
DimTime -> [ timeUnitColumnInsertSQL cName ]
|
||||
NoDimId -> [ dimIdColumnInsertSQL cName ]
|
||||
TenantId -> [ dimIdColumnInsertSQL cName ]
|
||||
FactCount {..} ->
|
||||
[ (cName, app "count" [ maybe star (eqi fTableName) factColMaybeSourceColumn ], False) ]
|
||||
FactCountDistinct {..} -> [ (cName, cast (str "{}") "json", False) ]
|
||||
FactSum {..} -> [ (cName, app' "sum" factColSourceColumn, False) ]
|
||||
FactMax {..} -> [ (cName, app' "max" factColSourceColumn, False) ]
|
||||
FactMin {..} -> [ (cName, app' "min" factColSourceColumn, False) ]
|
||||
FactAverage {..} ->
|
||||
[ ( cName <> settingAvgCountColumSuffix, app' "count" factColSourceColumn, False )
|
||||
, ( cName <> settingAvgSumColumnSuffix , app' "sum" factColSourceColumn , False)
|
||||
]
|
||||
_ -> []
|
||||
factColMap = concatFor (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
|
||||
case factColType of
|
||||
DimTime -> [ timeUnitColumnInsertSQL cName ]
|
||||
NoDimId -> [ dimIdColumnInsertSQL cName ]
|
||||
TenantId -> [ dimIdColumnInsertSQL cName ]
|
||||
FactCount {..} ->
|
||||
[ (cName, app "count" [ maybe star (eqi fTableName) factColMaybeSourceColumn ], False) ]
|
||||
FactCountDistinct {..} -> [ (cName, cast (str "{}") "json", False) ]
|
||||
FactSum {..} -> [ (cName, app' "sum" factColSourceColumn, False) ]
|
||||
FactMax {..} -> [ (cName, app' "max" factColSourceColumn, False) ]
|
||||
FactMin {..} -> [ (cName, app' "min" factColSourceColumn, False) ]
|
||||
FactAverage {..} ->
|
||||
[ ( cName <> settingAvgCountColumSuffix, app' "count" factColSourceColumn, False )
|
||||
, ( cName <> settingAvgSumColumnSuffix , app' "sum" factColSourceColumn , False)
|
||||
]
|
||||
_ -> []
|
||||
|
||||
dimColMap = for allDims $ \(dimFact, factTable@Table {tableName}) -> let
|
||||
dimFKIdColName =
|
||||
factDimFKIdColumnName settingDimPrefix dimIdColName dimFact factTable tables
|
||||
factSourceTableName = factTableName dimFact
|
||||
factSourceTable = fromJust . findTable factSourceTableName $ tables
|
||||
dimFKIdColumn = fromJust . findColumn dimFKIdColName $ tableColumns factSourceTable
|
||||
dimLookupWhereClauses = Just . foldBinop "and" $
|
||||
[ binop "=" (eqi tableName dimColName) (coalesceColumn defaults factSourceTableName sourceCol)
|
||||
| (dimColName, sourceColName) <- dimColumnMapping settingDimPrefix dimFact tableName
|
||||
, let sourceCol = fromJust . findColumn sourceColName $ tableColumns factSourceTable ]
|
||||
insertExpr = if factTable `elem` tables -- existing dimension table
|
||||
then (if columnNullable dimFKIdColumn == Null then coalesceFKId else id)
|
||||
$ eqi factSourceTableName dimFKIdColName
|
||||
else coalesceFKId . subQueryExp $
|
||||
makeSelect
|
||||
{ selSelectList = sl [ si $ ei dimIdColName ]
|
||||
, selTref =
|
||||
[ trefa (suffixTableName popMode settingTableNameSuffixTemplate tableName) tableName ]
|
||||
, selWhere = dimLookupWhereClauses
|
||||
}
|
||||
in (dimFKIdColName, insertExpr, True)
|
||||
dimColMap = for allDims $ \(dimFact, factTable@Table {tableName}) -> let
|
||||
dimFKIdColName =
|
||||
factDimFKIdColumnName settingDimPrefix dimIdColName dimFact factTable tables
|
||||
factSourceTableName = factTableName dimFact
|
||||
factSourceTable = fromJust . findTable factSourceTableName $ tables
|
||||
dimFKIdColumn = fromJust . findColumn dimFKIdColName $ tableColumns factSourceTable
|
||||
dimLookupWhereClauses = Just . foldBinop "and" $
|
||||
[ binop "=" (eqi tableName dimColName) (coalesceColumn defaults factSourceTableName sourceCol)
|
||||
| (dimColName, sourceColName) <- dimColumnMapping settingDimPrefix dimFact tableName
|
||||
, let sourceCol = fromJust . findColumn sourceColName $ tableColumns factSourceTable ]
|
||||
insertExpr = if factTable `elem` tables -- existing dimension table
|
||||
then (if columnNullable dimFKIdColumn == Null then coalesceFKId else id)
|
||||
$ eqi factSourceTableName dimFKIdColName
|
||||
else coalesceFKId . subQueryExp $
|
||||
makeSelect
|
||||
{ selSelectList = sl [ si $ ei dimIdColName ]
|
||||
, selTref =
|
||||
[ trefa (suffixTableName popMode settingTableNameSuffixTemplate tableName) tableName ]
|
||||
, selWhere = dimLookupWhereClauses
|
||||
}
|
||||
in (dimFKIdColName, insertExpr, True)
|
||||
|
||||
colMap = [ (cName, (expr, nmc $ groupByColPrefix <> cName), addToGroupBy)
|
||||
| (cName, expr, addToGroupBy) <- factColMap ++ dimColMap ]
|
||||
colMap = [ (cName, (expr, nmc $ groupByColPrefix <> cName), addToGroupBy)
|
||||
| (cName, expr, addToGroupBy) <- factColMap ++ dimColMap ]
|
||||
|
||||
joinClauses =
|
||||
map (tref &&& joinClausePreds fTable)
|
||||
. filter (/= fTableName)
|
||||
. nub
|
||||
. map (factTableName . fst)
|
||||
$ allDims
|
||||
joinClauses =
|
||||
map (tref &&& joinClausePreds fTable)
|
||||
. filter (/= fTableName)
|
||||
. nub
|
||||
. map (factTableName . fst)
|
||||
$ allDims
|
||||
|
||||
timeCol = eqi fTableName $ head [ cName | FactColumn cName DimTime <- factColumns fact ]
|
||||
timeCol = eqi fTableName $ head [ cName | FactColumn cName DimTime <- factColumns fact ]
|
||||
|
||||
extFactTableName = suffixTableName popMode settingTableNameSuffixTemplate
|
||||
$ extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
|
||||
extFactTableName = suffixTableName popMode settingTableNameSuffixTemplate
|
||||
$ extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
|
||||
|
||||
populateSelectExpr =
|
||||
makeSelect
|
||||
{ selSelectList = sl . map (uncurry sia . snd3) $ colMap
|
||||
, selTref = [ foldl (\tf (t, oc) -> tjoin tf LeftOuter t oc) (tref fTableName) joinClauses ]
|
||||
, selWhere = Just . foldBinop "and" $
|
||||
binop "<" timeCol placeholder :
|
||||
[ binop ">=" timeCol placeholder | popMode == IncrementalPopulation ]
|
||||
, selGroupBy = map (ei . (groupByColPrefix <>) . fst3) . filter thd3 $ colMap
|
||||
}
|
||||
populateSelectExpr =
|
||||
makeSelect
|
||||
{ selSelectList = sl . map (uncurry sia . snd3) $ colMap
|
||||
, selTref = [ foldl (\tf (t, oc) -> tjoin tf LeftOuter t oc) (tref fTableName) joinClauses ]
|
||||
, selWhere = Just . foldBinop "and" $
|
||||
binop "<" timeCol placeholder :
|
||||
[ binop ">=" timeCol placeholder | popMode == IncrementalPopulation ]
|
||||
, selGroupBy = map (ei . (groupByColPrefix <>) . fst3) . filter thd3 $ colMap
|
||||
}
|
||||
|
||||
insertIntoStmt = insert extFactTableName (map fst3 colMap) populateSelectExpr
|
||||
insertIntoStmt = insert extFactTableName (map fst3 colMap) populateSelectExpr
|
||||
|
||||
updateStmts <- factCountDistinctUpdateStmts popMode fact groupByColPrefix populateSelectExpr
|
||||
return $ insertIntoStmt : updateStmts
|
||||
where
|
||||
groupByColPrefix = "xxff_"
|
||||
updateStmts <- factCountDistinctUpdateStmts popMode fact groupByColPrefix populateSelectExpr
|
||||
return $ insertIntoStmt : updateStmts
|
||||
where
|
||||
groupByColPrefix = "xxff_"
|
||||
|
||||
joinClausePreds table oTableName =
|
||||
foldBinop "and"
|
||||
. map (\(c1, c2) -> binop "=" (eqi (tableName table) c1) (eqi oTableName c2))
|
||||
<$> listToMaybe [ colPairs | ForeignKey tName colPairs <- tableConstraints table
|
||||
, tName == oTableName ]
|
||||
joinClausePreds table oTableName =
|
||||
foldBinop "and"
|
||||
. map (\(c1, c2) -> binop "=" (eqi (tableName table) c1) (eqi oTableName c2))
|
||||
<$> listToMaybe [ colPairs | ForeignKey tName colPairs <- tableConstraints table
|
||||
, tName == oTableName ]
|
||||
|
||||
factTablePopulateSQL :: TablePopulationMode -> Fact -> Reader Env [Text]
|
||||
factTablePopulateSQL popMode fact = do
|
||||
|
|
|
|||
|
|
@ -1,8 +1,6 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE Rank2Types #-}
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
|
||||
module Ringo.Types
|
||||
( ColumnName, ColumnType, TableName
|
||||
|
|
@ -11,7 +9,7 @@ module Ringo.Types
|
|||
, Fact(..), FactColumnType(..), FactColumn(..), factSourceColumnName
|
||||
, Settings(..), defSettings
|
||||
, ValidationError(..), TypeDefaults
|
||||
, Env, EnvV(..), envView
|
||||
, TablePopulationMode(..), Dependencies) where
|
||||
, Env, envTables, envFacts, envSettings, envTypeDefaults,
|
||||
TablePopulationMode(..), Dependencies) where
|
||||
|
||||
import Ringo.Types.Internal
|
||||
|
|
|
|||
|
|
@ -168,17 +168,24 @@ data ValidationError = MissingTable !TableName
|
|||
|
||||
type TypeDefaults = Map Text Text
|
||||
|
||||
data Env = Env ![Table] ![Fact] !Settings !TypeDefaults
|
||||
data Env = Env
|
||||
{ _envTables :: ![Table]
|
||||
, _envFacts :: ![Fact]
|
||||
, _envSettings :: !Settings
|
||||
, _envTypeDefaults :: !TypeDefaults
|
||||
} deriving (Show)
|
||||
|
||||
data EnvV = EnvV
|
||||
{ envTables :: ![Table]
|
||||
, envFacts :: ![Fact]
|
||||
, envSettings :: !Settings
|
||||
, envTypeDefaults :: !TypeDefaults
|
||||
} deriving (Show)
|
||||
envTables :: Env -> [Table]
|
||||
envTables = _envTables
|
||||
|
||||
envView :: Env -> EnvV
|
||||
envView (Env tables facts settings typeDefaults) = EnvV tables facts settings typeDefaults
|
||||
envFacts :: Env -> [Fact]
|
||||
envFacts = _envFacts
|
||||
|
||||
envSettings :: Env -> Settings
|
||||
envSettings = _envSettings
|
||||
|
||||
envTypeDefaults :: Env -> TypeDefaults
|
||||
envTypeDefaults = _envTypeDefaults
|
||||
|
||||
data TablePopulationMode = FullPopulation | IncrementalPopulation deriving (Eq, Show)
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue