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

Removes EnvV from Types to simplify the code.

Browse Source
pull/1/head
Abhinav Sarkar 7 years ago
parent ade13f767b
commit 29bafea95b
9 changed files with 215 additions and 212 deletions
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Show Stats Download Patch File Download Diff File
  1. 23
      ringo-app/src/Main.hs
  2. 1
      ringo-app/src/Ringo/InputParser.hs
  3. 97
      ringo/src/Ringo/Extractor.hs
  4. 9
      ringo/src/Ringo/Extractor/Internal.hs
  5. 51
      ringo/src/Ringo/Generator/Create.hs
  6. 6
      ringo/src/Ringo/Generator/Populate/Dimension.hs
  7. 209
      ringo/src/Ringo/Generator/Populate/Fact.hs
  8. 6
      ringo/src/Ringo/Types.hs
  9. 25
      ringo/src/Ringo/Types/Internal.hs

23
ringo-app/src/Main.hs
Unescape View File

@ -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
ringo-app/src/Ringo/InputParser.hs
Unescape View File

@ -1,5 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}
module Ringo.InputParser (parseInput) where

97
ringo/src/Ringo/Extractor.hs
Unescape View File

@ -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

9
ringo/src/Ringo/Extractor/Internal.hs
Unescape View File

@ -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

51
ringo/src/Ringo/Generator/Create.hs
Unescape View File

@ -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
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
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 ] ]
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
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 ]
return [ CreateIndexTSQL ea (nmc "") (name tabName) (map nmc cols)
| cols <- factCols ++ dimCols ++ [ [cName, dimTimeColName dimTimeCol]
| cName <- maybeToList tenantIdCol ] ]

6
ringo/src/Ringo/Generator/Populate/Dimension.hs
Unescape View File

@ -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

209
ringo/src/Ringo/Generator/Populate/Fact.hs
Unescape View File

@ -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
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)
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)
]
_ -> []
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 ]
joinClauses =
map (tref &&& joinClausePreds fTable)
. filter (/= fTableName)
. nub
. map (factTableName . fst)
$ allDims
timeCol = eqi fTableName $ head [ cName | FactColumn cName DimTime <- factColumns fact ]
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
}
insertIntoStmt = insert extFactTableName (map fst3 colMap) populateSelectExpr
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 ]
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 ]
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 ]
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)
colMap = [ (cName, (expr, nmc $ groupByColPrefix <> cName), addToGroupBy)
| (cName, expr, addToGroupBy) <- factColMap ++ dimColMap ]
joinClauses =
map (tref &&& joinClausePreds fTable)
. filter (/= fTableName)
. nub
. map (factTableName . fst)
$ allDims
timeCol = eqi fTableName $ head [ cName | FactColumn cName DimTime <- factColumns fact ]
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
}
insertIntoStmt = insert extFactTableName (map fst3 colMap) populateSelectExpr
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 ]
factTablePopulateSQL :: TablePopulationMode -> Fact -> Reader Env [Text]
factTablePopulateSQL popMode fact = do

6
ringo/src/Ringo/Types.hs
Unescape View File

@ -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

25
ringo/src/Ringo/Types/Internal.hs
Unescape View File

@ -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
envFacts :: Env -> [Fact]
envFacts = _envFacts
envSettings :: Env -> Settings
envSettings = _envSettings
envView :: Env -> EnvV
envView (Env tables facts settings typeDefaults) = EnvV tables facts settings typeDefaults
envTypeDefaults :: Env -> TypeDefaults
envTypeDefaults = _envTypeDefaults
data TablePopulationMode = FullPopulation | IncrementalPopulation deriving (Eq, Show)

Write Preview
Loading…
Cancel
Save