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