Adds index SQL in fact table create SQL.

pull/1/head
Abhinav Sarkar 2015-12-17 23:40:56 +05:30
parent c3d3019cd3
commit 21497269ee
3 changed files with 27 additions and 5 deletions

View File

@ -39,12 +39,13 @@ writeSQLFiles outputDir env@Env{..} = forM_ sqls $ \(sqlType, table, sql) -> do
dimTables = map (\fact -> (fact, extractDimensionTables env fact)) envFacts dimTables = map (\fact -> (fact, extractDimensionTables env fact)) envFacts
factTables = map (\fact -> (fact, extractFactTable env fact)) envFacts factTables = map (\fact -> (fact, extractFactTable env fact)) envFacts
dimTableDefnSQLs = [ (Create, tableName table, tabDefnSQL table) dimTableDefnSQLs = [ (Create, tableName table, unlines . map sqlStr . tableDefnSQL $ table)
| (_, tabs) <- dimTables | (_, tabs) <- dimTables
, table <- tabs , table <- tabs
, table `notElem` envTables ] , table `notElem` envTables ]
factTableDefnSQLs = [ (Create, tableName table, tabDefnSQL table) factTableDefnSQLs = [ (Create
| (_, table) <- factTables ] , tableName table, unlines . map sqlStr $ factTableDefnSQL env fact table)
| (fact, table) <- factTables ]
dimTableInsertSQLs = [ (Populate dimTableInsertSQLs = [ (Populate
, tableName table , tableName table
@ -63,4 +64,3 @@ writeSQLFiles outputDir env@Env{..} = forM_ sqls $ \(sqlType, table, sql) -> do
] ]
sqlStr s = Text.unpack $ s <> ";\n" sqlStr s = Text.unpack $ s <> ";\n"
tabDefnSQL = unlines . map sqlStr . tableDefnSQL

View File

@ -3,6 +3,7 @@ module Ringo
, extractFactTable , extractFactTable
, extractDimensionTables , extractDimensionTables
, G.tableDefnSQL , G.tableDefnSQL
, factTableDefnSQL
, dimensionTableInsertSQL , dimensionTableInsertSQL
, factTableInsertSQL , factTableInsertSQL
, validateTable , validateTable
@ -23,6 +24,9 @@ extractFactTable env = flip runReader env . E.extractFactTable
extractDimensionTables :: Env -> Fact -> [Table] extractDimensionTables :: Env -> Fact -> [Table]
extractDimensionTables env = flip runReader env . E.extractDimensionTables extractDimensionTables env = flip runReader env . E.extractDimensionTables
factTableDefnSQL :: Env -> Fact -> Table -> [Text]
factTableDefnSQL env fact = flip runReader env . G.factTableDefnSQL fact
dimensionTableInsertSQL :: Env -> Fact -> TableName -> Text dimensionTableInsertSQL :: Env -> Fact -> TableName -> Text
dimensionTableInsertSQL env fact = flip runReader env . G.dimensionTableInsertSQL fact dimensionTableInsertSQL env fact = flip runReader env . G.dimensionTableInsertSQL fact

View File

@ -1,5 +1,6 @@
module Ringo.Generator module Ringo.Generator
( tableDefnSQL ( tableDefnSQL
, factTableDefnSQL
, dimensionTableInsertSQL , dimensionTableInsertSQL
, factTableInsertSQL , factTableInsertSQL
) where ) where
@ -45,6 +46,23 @@ tableDefnSQL Table {..} =
<> (Text.concat . intersperse ",\n" . map columnDefnSQL $ tableColumns) <> (Text.concat . intersperse ",\n" . map columnDefnSQL $ tableColumns)
<> "\n)" <> "\n)"
factTableDefnSQL :: Fact -> Table -> Reader Env [Text]
factTableDefnSQL fact table = do
Settings {..} <- asks envSettings
allDims <- extractAllDimensionTables fact
let factCols = flip mapMaybe (factColumns fact) $ \col -> case col of
DimTime cName -> Just $ timeUnitColumnName cName settingTimeUnit
NoDimId cName -> Just cName
_ -> Nothing
dimCols = flip map allDims $ \(_, Table {..}) ->
factDimFKIdColumnName settingDimPrefix tableName
indexSQLs = flip map (factCols ++ dimCols) $ \col ->
"CREATE INDEX ON " <> tableName table <> " USING btree (" <> col <> ")"
return $ tableDefnSQL table ++ indexSQLs
dimColumnMapping :: Text -> Fact -> TableName -> [(ColumnName, ColumnName)] dimColumnMapping :: Text -> Fact -> TableName -> [(ColumnName, ColumnName)]
dimColumnMapping dimPrefix fact dimTableName = dimColumnMapping dimPrefix fact dimTableName =
flip mapMaybe (factColumns fact) $ \fCol -> case fCol of flip mapMaybe (factColumns fact) $ \fCol -> case fCol of
@ -64,7 +82,7 @@ dimensionTableInsertSQL fact dimTableName = do
<> "\nFROM " <> factTableName fact <> "\nFROM " <> factTableName fact
factTableInsertSQL :: Fact -> Reader Env Text factTableInsertSQL :: Fact -> Reader Env Text
factTableInsertSQL fact= do factTableInsertSQL fact = do
let fTableName = factTableName fact let fTableName = factTableName fact
Settings {..} <- asks envSettings Settings {..} <- asks envSettings
allDims <- extractAllDimensionTables fact allDims <- extractAllDimensionTables fact