diff --git a/app/Main.hs b/app/Main.hs index 3da0f37..d475181 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -55,7 +55,7 @@ writeFiles outputDir env@Env{..} = do dimTables = [ (fact, extractDimensionTables env fact) | fact <- envFacts ] factTables = [ (fact, extractFactTable env fact) | fact <- envFacts ] - dimTableDefnSQLs = [ (Create, tableName table, unlines . map sqlStr . tableDefnSQL $ table) + dimTableDefnSQLs = [ (Create, tableName table, unlines . map sqlStr $ tableDefnSQL env table) | (_, tabs) <- dimTables , table <- tabs , table `notElem` envTables ] diff --git a/app/Ringo/ArgParser.hs b/app/Ringo/ArgParser.hs index c7fa4be..fe7726a 100644 --- a/app/Ringo/ArgParser.hs +++ b/app/Ringo/ArgParser.hs @@ -71,6 +71,9 @@ settingsParser = let Settings {..} = defSettings <> value settingForeignKeyIdCoalesceValue <> showDefault <> help "Value to coalease missing foriegn key ids to, in fact tables") + <*> minorOption "tablename-suffix-template" + settingTableNameSuffixTemplate + "Suffix template for table names in SQL" where minorOption longDesc defValue helpTxt = Text.pack <$> strOption (long longDesc diff --git a/src/Ringo.hs b/src/Ringo.hs index 7a17df3..9306bf7 100644 --- a/src/Ringo.hs +++ b/src/Ringo.hs @@ -3,7 +3,7 @@ module Ringo , extractFactTable , extractDimensionTables , extractDependencies - , G.tableDefnSQL + , tableDefnSQL , factTableDefnSQL , dimensionTablePopulateSQL , factTablePopulateSQL @@ -28,6 +28,9 @@ extractDimensionTables env = flip runReader env . E.extractDimensionTables extractDependencies :: Env -> Fact -> Dependencies extractDependencies env = flip runReader env . E.extractDependencies +tableDefnSQL :: Env -> Table -> [Text] +tableDefnSQL env = flip runReader env . G.tableDefnSQL + factTableDefnSQL :: Env -> Fact -> Table -> [Text] factTableDefnSQL env fact = flip runReader env . G.factTableDefnSQL fact diff --git a/src/Ringo/Generator/Create.hs b/src/Ringo/Generator/Create.hs index 02f4452..cd8abf1 100644 --- a/src/Ringo/Generator/Create.hs +++ b/src/Ringo/Generator/Create.hs @@ -1,5 +1,10 @@ module Ringo.Generator.Create (tableDefnSQL, factTableDefnSQL) where +#if MIN_VERSION_base(4,8,0) +#else +import Control.Applicative ((<$>)) +#endif + import Control.Monad.Reader (Reader, asks) import Data.Monoid ((<>)) import Data.Text (Text) @@ -9,29 +14,31 @@ import Ringo.Generator.Internal import Ringo.Types import Ringo.Utils -tableDefnSQL :: Table -> [Text] -tableDefnSQL Table {..} = - tableSQL : concatMap constraintDefnSQL tableConstraints - where - tableSQL = "CREATE TABLE " <> tableName <> " (\n" - <> (joinColumnNames . map columnDefnSQL $ tableColumns) - <> "\n)" +tableDefnSQL :: Table -> Reader Env [Text] +tableDefnSQL Table {..} = do + Settings {..} <- asks envSettings + let tabName = tableName <> settingTableNameSuffixTemplate - columnDefnSQL Column {..} = - columnName <> " " <> columnType <> " " <> nullableDefnSQL columnNullable + tableSQL = "CREATE TABLE " <> tabName <> " (\n" + <> (joinColumnNames . map columnDefnSQL $ tableColumns) + <> "\n)" - nullableDefnSQL Null = "NULL" - nullableDefnSQL NotNull = "NOT NULL" + columnDefnSQL Column {..} = + columnName <> " " <> columnType <> " " <> nullableDefnSQL columnNullable - constraintDefnSQL constraint = - let alterTableSQL = "ALTER TABLE ONLY " <> tableName <> " ADD " - in case constraint of - PrimaryKey cName -> [ alterTableSQL <> "PRIMARY KEY (" <> cName <> ")" ] - ForeignKey oTableName cNamePairs -> - [ alterTableSQL <> "FOREIGN KEY (" <> joinColumnNames (map fst cNamePairs) <> ") REFERENCES " - <> oTableName <> " (" <> joinColumnNames (map snd cNamePairs) <> ")" ] - UniqueKey cNames -> ["CREATE UNIQUE INDEX ON " <> tableName <> " (" <> joinColumnNames cNames <> ")"] + nullableDefnSQL Null = "NULL" + nullableDefnSQL NotNull = "NOT NULL" + constraintDefnSQL constraint = + let alterTableSQL = "ALTER TABLE ONLY " <> tabName <> " ADD " + in case constraint of + PrimaryKey cName -> [ alterTableSQL <> "PRIMARY KEY (" <> cName <> ")" ] + ForeignKey oTableName cNamePairs -> + [ alterTableSQL <> "FOREIGN KEY (" <> joinColumnNames (map fst cNamePairs) <> ") REFERENCES " + <> oTableName <> " (" <> joinColumnNames (map snd cNamePairs) <> ")" ] + UniqueKey cNames -> ["CREATE UNIQUE INDEX ON " <> tabName <> " (" <> joinColumnNames cNames <> ")"] + + return $ tableSQL : concatMap constraintDefnSQL tableConstraints factTableDefnSQL :: Fact -> Table -> Reader Env [Text] factTableDefnSQL fact table = do @@ -46,7 +53,8 @@ factTableDefnSQL fact table = do dimCols = [ factDimFKIdColumnName settingDimPrefix settingDimTableIdColumnName tableName | (_, Table {..}) <- allDims ] - indexSQLs = [ "CREATE INDEX ON " <> tableName table <> " USING btree (" <> col <> ")" + indexSQLs = [ "CREATE INDEX ON " <> tableName table <> settingTableNameSuffixTemplate + <> " USING btree (" <> col <> ")" | col <- factCols ++ dimCols ] - return $ tableDefnSQL table ++ indexSQLs + (++ indexSQLs) <$> tableDefnSQL table diff --git a/src/Ringo/Generator/Internal.hs b/src/Ringo/Generator/Internal.hs index 5deb821..fd8e77c 100644 --- a/src/Ringo/Generator/Internal.hs +++ b/src/Ringo/Generator/Internal.hs @@ -35,3 +35,8 @@ coalesceColumn defaults tName Column{..} = . find (\(k, _) -> k `Text.isPrefixOf` colType) . Map.toList $ defaults + +suffixTableName :: TablePopulationMode -> Text -> TableName -> TableName +suffixTableName popMode suffix tableName = case popMode of + FullPopulation -> tableName <> suffix + IncrementalPopulation -> tableName diff --git a/src/Ringo/Generator/Populate/Dimension.hs b/src/Ringo/Generator/Populate/Dimension.hs index ac46f94..a5cc5f7 100644 --- a/src/Ringo/Generator/Populate/Dimension.hs +++ b/src/Ringo/Generator/Populate/Dimension.hs @@ -18,30 +18,35 @@ import Ringo.Types dimensionTablePopulateSQL :: TablePopulationMode -> Fact -> TableName -> Reader Env Text dimensionTablePopulateSQL popMode fact dimTableName = do - dimPrefix <- settingDimPrefix <$> asks envSettings - tables <- asks envTables - defaults <- asks envTypeDefaults - let factTable = fromJust $ findTable (factTableName fact) tables - colMapping = dimColumnMapping dimPrefix fact dimTableName - selectCols = [ coalesceColumn defaults (factTableName fact) col <> " AS " <> cName - | (_, cName) <- colMapping - , let col = fromJust . findColumn cName $ tableColumns factTable ] - baseSelectC = "SELECT DISTINCT\n" <> joinColumnNames selectCols - <> "\nFROM " <> factTableName fact - baseWhereC = "(\n" - <> Text.intercalate "\nOR " [ c <> " IS NOT NULL" | (_, c) <- colMapping ] - <> "\n)" + Settings {..} <- asks envSettings + tables <- asks envTables + defaults <- asks envTypeDefaults + let factTable = fromJust $ findTable (factTableName fact) tables + colMapping = dimColumnMapping settingDimPrefix fact dimTableName + selectCols = [ coalesceColumn defaults (factTableName fact) col <> " AS " <> cName + | (_, cName) <- colMapping + , let col = fromJust . findColumn cName $ tableColumns factTable ] + timeCol = head [ cName | DimTime cName <- factColumns fact ] + baseSelectC = "SELECT DISTINCT\n" <> joinColumnNames selectCols + <> "\nFROM " <> factTableName fact + baseWhereCs = [ "(\n" + <> Text.intercalate "\nOR " [ c <> " IS NOT NULL" | (_, c) <- colMapping ] + <> "\n)" + , timeCol <> " <= ?" + ] + insertC selectC whereCs = - "INSERT INTO " <> dimTableName + "INSERT INTO " + <> suffixTableName popMode settingTableNameSuffixTemplate dimTableName <> " (\n" <> joinColumnNames (map fst colMapping) <> "\n) " <> "SELECT x.* FROM (\n" <> selectC <> "\nWHERE " <> Text.intercalate " AND\n" whereCs <> ") x" - timeCol = head [ cName | DimTime cName <- factColumns fact ] + return $ case popMode of - FullPopulation -> insertC baseSelectC [baseWhereC] + FullPopulation -> insertC baseSelectC baseWhereCs IncrementalPopulation -> - insertC baseSelectC [baseWhereC, timeCol <> " > ?", timeCol <> " <= ?"] + insertC baseSelectC (baseWhereCs ++ [ timeCol <> " > ?" ]) <> "\nLEFT JOIN " <> dimTableName <> " ON\n" <> Text.intercalate " \nAND " [ fullColumnName dimTableName c1 <> " = " <> fullColumnName "x" c2 diff --git a/src/Ringo/Generator/Populate/Fact.hs b/src/Ringo/Generator/Populate/Fact.hs index 324f0c1..fe3901b 100644 --- a/src/Ringo/Generator/Populate/Fact.hs +++ b/src/Ringo/Generator/Populate/Fact.hs @@ -53,8 +53,8 @@ data FactTablePopulateSelectSQL = FactTablePopulateSelectSQL , ftpsGroupByCols :: ![Text] } deriving (Show, Eq) -factTableUpdateSQL :: Fact -> Text -> FactTablePopulateSelectSQL -> Reader Env [Text] -factTableUpdateSQL fact groupByColPrefix populateSelectSQL@FactTablePopulateSelectSQL {..} = do +factTableUpdateSQL :: TablePopulationMode -> Fact -> Text -> FactTablePopulateSelectSQL -> Reader Env [Text] +factTableUpdateSQL popMode fact groupByColPrefix populateSelectSQL@FactTablePopulateSelectSQL {..} = do Settings {..} <- asks envSettings tables <- asks envTables let countDistinctCols = [ col | col@(FactCountDistinct _ _) <- factColumns fact] @@ -62,7 +62,8 @@ factTableUpdateSQL fact groupByColPrefix populateSelectSQL@FactTablePopulateSele fTable = fromJust . findTable fTableName $ tables tablePKColName = head [ cName | PrimaryKey cName <- tableConstraints fTable ] extFactTableName = - extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit + suffixTableName popMode settingTableNameSuffixTemplate + $ extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit return . (\xs -> if null xs then xs else ilog2FunctionString : xs) $ for countDistinctCols $ \(FactCountDistinct scName cName) -> @@ -163,8 +164,9 @@ factTablePopulateSQL popMode fact = do insertSQL = if factTable `elem` tables -- existing dimension table then (if columnNullable dimFKIdColumn == Null then coalesceFKId else id) $ fullColumnName factSourceTableName dimFKIdColName - else "SELECT " <> dimIdColName <> " FROM " <> tableName <> "\nWHERE " - <> Text.intercalate "\n AND " dimLookupWhereClauses + else "SELECT " <> dimIdColName <> " FROM " + <> suffixTableName popMode settingTableNameSuffixTemplate tableName <> " " <> tableName + <> "\nWHERE " <> Text.intercalate "\n AND " dimLookupWhereClauses in (dimFKIdColName, coalesceFKId insertSQL, True) colMap = [ (cName, (sql, groupByColPrefix <> cName), addToGroupBy) @@ -178,17 +180,16 @@ factTablePopulateSQL popMode fact = do timeCol = fullColumnName fTableName $ head [ cName | DimTime cName <- factColumns fact ] - extFactTableName = - extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit + extFactTableName = suffixTableName popMode settingTableNameSuffixTemplate + $ extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit populateSelectSQL = FactTablePopulateSelectSQL { ftpsSelectCols = map snd3 colMap , ftpsSelectTable = fTableName , ftpsJoinClauses = joinClauses - , ftpsWhereClauses = if popMode == IncrementalPopulation - then [ timeCol <> " > ?", timeCol <> " <= ?" ] - else [] + , ftpsWhereClauses = + timeCol <> " <= ?" : [ timeCol <> " > ?" | popMode == IncrementalPopulation ] , ftpsGroupByCols = map ((groupByColPrefix <>) . fst3) . filter thd3 $ colMap } @@ -196,7 +197,7 @@ factTablePopulateSQL popMode fact = do <> " (\n" <> Text.intercalate ",\n " (map fst3 colMap) <> "\n)\n" <> toSelectSQL populateSelectSQL - updateSQLs <- factTableUpdateSQL fact groupByColPrefix populateSelectSQL + updateSQLs <- factTableUpdateSQL popMode fact groupByColPrefix populateSelectSQL return $ insertIntoSQL : updateSQLs where diff --git a/src/Ringo/Types.hs b/src/Ringo/Types.hs index 5f55f8f..e2e09b6 100644 --- a/src/Ringo/Types.hs +++ b/src/Ringo/Types.hs @@ -83,6 +83,7 @@ data Settings = Settings , settingFactsJSONFileName :: !Text , settingDimensionJSONFileName :: !Text , settingForeignKeyIdCoalesceValue :: !Int + , settingTableNameSuffixTemplate :: !Text } deriving (Eq, Show) defSettings :: Settings @@ -101,6 +102,7 @@ defSettings = Settings , settingFactsJSONFileName = "facts.json" , settingDimensionJSONFileName = "dimensions.json" , settingForeignKeyIdCoalesceValue = -1 + , settingTableNameSuffixTemplate = "{{suff}}" } data ValidationError = MissingTable !TableName