From 29bafea95ba44ec0965c7693fc0adf9f0e526530 Mon Sep 17 00:00:00 2001 From: Abhinav Sarkar Date: Wed, 22 Jun 2016 17:10:14 +0530 Subject: [PATCH] Removes EnvV from Types to simplify the code. --- ringo-app/src/Main.hs | 23 ++- ringo-app/src/Ringo/InputParser.hs | 1 - ringo/src/Ringo/Extractor.hs | 97 +++++----- ringo/src/Ringo/Extractor/Internal.hs | 9 +- ringo/src/Ringo/Generator/Create.hs | 43 ++-- .../src/Ringo/Generator/Populate/Dimension.hs | 6 +- ringo/src/Ringo/Generator/Populate/Fact.hs | 183 +++++++++--------- ringo/src/Ringo/Types.hs | 6 +- ringo/src/Ringo/Types/Internal.hs | 25 ++- 9 files changed, 198 insertions(+), 195 deletions(-) diff --git a/ringo-app/src/Main.hs b/ringo-app/src/Main.hs index 38f856f..f1d3e91 100644 --- a/ringo-app/src/Main.hs +++ b/ringo-app/src/Main.hs @@ -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 ] diff --git a/ringo-app/src/Ringo/InputParser.hs b/ringo-app/src/Ringo/InputParser.hs index 8c8c183..790a6c6 100644 --- a/ringo-app/src/Ringo/InputParser.hs +++ b/ringo-app/src/Ringo/InputParser.hs @@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE CPP #-} module Ringo.InputParser (parseInput) where diff --git a/ringo/src/Ringo/Extractor.hs b/ringo/src/Ringo/Extractor.hs index 0382797..9afccea 100644 --- a/ringo/src/Ringo/Extractor.hs +++ b/ringo/src/Ringo/Extractor.hs @@ -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 diff --git a/ringo/src/Ringo/Extractor/Internal.hs b/ringo/src/Ringo/Extractor/Internal.hs index 264c0ba..c301efc 100644 --- a/ringo/src/Ringo/Extractor/Internal.hs +++ b/ringo/src/Ringo/Extractor/Internal.hs @@ -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 diff --git a/ringo/src/Ringo/Generator/Create.hs b/ringo/src/Ringo/Generator/Create.hs index 85d78f0..e84484c 100644 --- a/ringo/src/Ringo/Generator/Create.hs +++ b/ringo/src/Ringo/Generator/Create.hs @@ -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 ] ] diff --git a/ringo/src/Ringo/Generator/Populate/Dimension.hs b/ringo/src/Ringo/Generator/Populate/Dimension.hs index a9f746b..ddfef78 100644 --- a/ringo/src/Ringo/Generator/Populate/Dimension.hs +++ b/ringo/src/Ringo/Generator/Populate/Dimension.hs @@ -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 diff --git a/ringo/src/Ringo/Generator/Populate/Fact.hs b/ringo/src/Ringo/Generator/Populate/Fact.hs index ccc7425..078a267 100644 --- a/ringo/src/Ringo/Generator/Populate/Fact.hs +++ b/ringo/src/Ringo/Generator/Populate/Fact.hs @@ -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 diff --git a/ringo/src/Ringo/Types.hs b/ringo/src/Ringo/Types.hs index 610189d..4b2b56e 100644 --- a/ringo/src/Ringo/Types.hs +++ b/ringo/src/Ringo/Types.hs @@ -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 diff --git a/ringo/src/Ringo/Types/Internal.hs b/ringo/src/Ringo/Types/Internal.hs index ad6ef00..c3b0bfe 100644 --- a/ringo/src/Ringo/Types/Internal.hs +++ b/ringo/src/Ringo/Types/Internal.hs @@ -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)