diff --git a/app/Main.hs b/app/Main.hs index f2b050a..d88520a 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -39,12 +39,13 @@ writeSQLFiles outputDir env@Env{..} = forM_ sqls $ \(sqlType, table, sql) -> do dimTables = map (\fact -> (fact, extractDimensionTables 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 , table <- tabs , table `notElem` envTables ] - factTableDefnSQLs = [ (Create, tableName table, tabDefnSQL table) - | (_, table) <- factTables ] + factTableDefnSQLs = [ (Create + , tableName table, unlines . map sqlStr $ factTableDefnSQL env fact table) + | (fact, table) <- factTables ] dimTableInsertSQLs = [ (Populate , tableName table @@ -63,4 +64,3 @@ writeSQLFiles outputDir env@Env{..} = forM_ sqls $ \(sqlType, table, sql) -> do ] sqlStr s = Text.unpack $ s <> ";\n" - tabDefnSQL = unlines . map sqlStr . tableDefnSQL diff --git a/src/Ringo.hs b/src/Ringo.hs index cdd53c0..673879f 100644 --- a/src/Ringo.hs +++ b/src/Ringo.hs @@ -3,6 +3,7 @@ module Ringo , extractFactTable , extractDimensionTables , G.tableDefnSQL + , factTableDefnSQL , dimensionTableInsertSQL , factTableInsertSQL , validateTable @@ -23,6 +24,9 @@ extractFactTable env = flip runReader env . E.extractFactTable extractDimensionTables :: Env -> Fact -> [Table] 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 = flip runReader env . G.dimensionTableInsertSQL fact diff --git a/src/Ringo/Generator.hs b/src/Ringo/Generator.hs index 115f60d..2bad100 100644 --- a/src/Ringo/Generator.hs +++ b/src/Ringo/Generator.hs @@ -1,5 +1,6 @@ module Ringo.Generator ( tableDefnSQL + , factTableDefnSQL , dimensionTableInsertSQL , factTableInsertSQL ) where @@ -45,6 +46,23 @@ tableDefnSQL Table {..} = <> (Text.concat . intersperse ",\n" . map columnDefnSQL $ tableColumns) <> "\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 dimPrefix fact dimTableName = flip mapMaybe (factColumns fact) $ \fCol -> case fCol of @@ -64,7 +82,7 @@ dimensionTableInsertSQL fact dimTableName = do <> "\nFROM " <> factTableName fact factTableInsertSQL :: Fact -> Reader Env Text -factTableInsertSQL fact= do +factTableInsertSQL fact = do let fTableName = factTableName fact Settings {..} <- asks envSettings allDims <- extractAllDimensionTables fact