diff --git a/ringo/src/Ringo/Extractor.hs b/ringo/src/Ringo/Extractor.hs index da1f182..622a4ce 100644 --- a/ringo/src/Ringo/Extractor.hs +++ b/ringo/src/Ringo/Extractor.hs @@ -1,6 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE NoImplicitPrelude #-} + module Ringo.Extractor ( extractDimensionTables , extractAllDimensionTables @@ -11,6 +13,7 @@ module Ringo.Extractor import qualified Data.Map as Map import qualified Data.Tree as Tree +import Prelude.Compat import Control.Monad.Reader (Reader, asks) import Data.Maybe (fromJust) import Data.Monoid ((<>)) @@ -21,63 +24,81 @@ import Ringo.Types.Internal import Ringo.Utils extractFactTable :: Fact -> Reader Env Table -extractFactTable fact = do - allDims <- extractAllDimensionTables fact +extractFactTable fact = mkTable <$> asks envSettings + <*> extractColumns fact + <*> extractFKColumns fact + <*> extractUKColumnNames fact + where + mkTable Settings {..} columns fkColumns ukColNames = + Table { tableName = + extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit + , tableColumns = columns ++ fkColumns + , tableConstraints = [ UniqueKey $ ukColNames ++ map columnName fkColumns ] + } + +extractColumns :: Fact -> Reader Env [Column] +extractColumns fact = do 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 + let 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 <> settingAvgCountColumnSuffix) countColType NotNull - , notNullSourceColumnRename factColSourceColumn (cName <> settingAvgSumColumnSuffix) - ] - _ -> [] + return $ concatFor (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} -> + case factColType of + DimTime -> + [ Column (timeUnitColumnName settingDimTableIdColumnName cName settingTimeUnit) "bigint" NotNull ] + NoDimId -> [ notNullSourceColumnCopy cName ] + TenantId -> [ notNullSourceColumnCopy cName ] + FactCount {..} -> [ Column cName settingFactCountColumnType NotNull ] + FactCountDistinct {..} -> [ Column cName "json" NotNull ] + FactSum {..} -> [ notNullSourceColumnRename factColSourceColumn cName ] + FactMax {..} -> [ notNullSourceColumnRename factColSourceColumn cName ] + FactMin {..} -> [ notNullSourceColumnRename factColSourceColumn cName ] + FactAverage {..} -> + [ Column (cName <> settingAvgCountColumnSuffix) settingFactCountColumnType 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 +extractFKColumns :: Fact -> Reader Env [Column] +extractFKColumns fact = do + allDims <- extractAllDimensionTables fact + Settings {..} <- asks envSettings + tables <- asks envTables - 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 $ for allDims $ \(dimFact, dimTable) -> + let colName = factDimFKIdColumnName settingDimPrefix settingDimTableIdColumnName dimFact dimTable tables + colType = idColTypeToFKIdColType settingDimTableIdColumnType + in Column colName colType NotNull - return Table - { tableName = - extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit - , tableColumns = columns ++ fkColumns - , tableConstraints = [ UniqueKey ukColNames ] - } +extractUKColumnNames :: Fact -> Reader Env [ColumnName] +extractUKColumnNames fact = do + Settings {..} <- asks envSettings + return $ forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} -> + case factColType of + DimTime -> Just $ timeUnitColumnName settingDimTableIdColumnName cName settingTimeUnit + NoDimId -> Just cName + TenantId -> Just cName + _ -> Nothing extractDependencies :: Fact -> Reader Env Dependencies -extractDependencies fact = do - settings@Settings{..} <- asks envSettings - facts <- asks envFacts - let factSourceDeps = +extractDependencies fact = Map.union <$> extractFactDeps fact <*> extractDimensionDeps fact + +extractFactDeps :: Fact -> Reader Env Dependencies +extractFactDeps fact = do + Settings{..} <- asks envSettings + facts <- asks envFacts + + let extractedTable = + extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit + + factSourceDeps = nub . Tree.flatten . flip Tree.unfoldTree fact $ \fct -> (factTableName fct, parentFacts fct facts) + factDimDeps = nub . concat . Tree.flatten . flip Tree.unfoldTree fact $ \fct -> ( forMaybe (factColumns fct) $ \FactColumn {..} -> case factColType of @@ -87,13 +108,12 @@ extractDependencies fact = do , parentFacts fct facts ) - dimDeps = Map.fromList [ (settingDimPrefix <> table, [factTableName fact]) - | FactColumn {factColType = DimVal table} <- factColumns fact ] - - factDeps = Map.singleton (extractedTable settings) (factSourceDeps ++ factDimDeps) - return $ Map.union dimDeps factDeps + return $ Map.singleton extractedTable (factSourceDeps ++ factDimDeps) where - extractedTable Settings {..} = - extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit - parentFacts fct facts = [ fromJust $ findFact pf facts | pf <- factParentNames fct ] + +extractDimensionDeps :: Fact -> Reader Env Dependencies +extractDimensionDeps fact = do + Settings{..} <- asks envSettings + return $ Map.fromList [ (settingDimPrefix <> table, [factTableName fact]) + | FactColumn {factColType = DimVal table} <- factColumns fact ]