2016-01-01 20:57:54 +05:30
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
{-# LANGUAGE RecordWildCards #-}
|
2016-02-03 16:00:39 +05:30
|
|
|
{-# LANGUAGE GADTs #-}
|
2016-07-11 23:36:12 +05:30
|
|
|
{-# LANGUAGE NoImplicitPrelude #-}
|
|
|
|
|
2015-12-15 17:22:45 +05:30
|
|
|
module Ringo.Extractor
|
2015-12-16 03:03:47 +05:30
|
|
|
( extractDimensionTables
|
|
|
|
, extractAllDimensionTables
|
2015-12-15 17:22:45 +05:30
|
|
|
, extractFactTable
|
2015-12-21 15:30:23 +05:30
|
|
|
, extractDependencies
|
2015-12-15 17:22:45 +05:30
|
|
|
) where
|
|
|
|
|
2015-12-21 15:30:23 +05:30
|
|
|
import qualified Data.Map as Map
|
|
|
|
import qualified Data.Tree as Tree
|
|
|
|
|
2016-07-11 23:36:12 +05:30
|
|
|
import Prelude.Compat
|
2016-06-22 17:10:14 +05:30
|
|
|
import Control.Monad.Reader (Reader, asks)
|
2015-12-18 13:20:35 +05:30
|
|
|
import Data.Maybe (fromJust)
|
2015-12-15 17:22:45 +05:30
|
|
|
import Data.Monoid ((<>))
|
2015-12-21 15:30:23 +05:30
|
|
|
import Data.List (nub)
|
2015-12-15 17:22:45 +05:30
|
|
|
|
2015-12-15 18:22:51 +05:30
|
|
|
import Ringo.Extractor.Internal
|
2016-06-22 17:10:14 +05:30
|
|
|
import Ringo.Types.Internal
|
2015-12-16 02:05:36 +05:30
|
|
|
import Ringo.Utils
|
|
|
|
|
2016-07-12 12:57:41 +05:30
|
|
|
extractFactTable :: Fact -> Reader Config Table
|
|
|
|
extractFactTable fact = mkTable <$> asks configSettings
|
2016-07-11 23:36:12 +05:30
|
|
|
<*> 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 ]
|
|
|
|
}
|
|
|
|
|
2016-07-12 12:57:41 +05:30
|
|
|
extractColumns :: Fact -> Reader Config [Column]
|
2016-07-11 23:36:12 +05:30
|
|
|
extractColumns fact = do
|
2016-07-12 12:57:41 +05:30
|
|
|
Settings {..} <- asks configSettings
|
|
|
|
tables <- asks configTables
|
2016-06-22 17:10:14 +05:30
|
|
|
let table = fromJust . findTable (factTableName fact) $ tables
|
2015-12-16 02:05:36 +05:30
|
|
|
|
2016-07-11 23:36:12 +05:30
|
|
|
let sourceColumn cName = fromJust . findColumn cName . tableColumns $ table
|
2016-06-22 17:10:14 +05:30
|
|
|
notNullSourceColumnCopy cName = (sourceColumn cName) { columnNullable = NotNull }
|
|
|
|
notNullSourceColumnRename scName cName = (notNullSourceColumnCopy scName) { columnName = cName }
|
2015-12-16 02:05:36 +05:30
|
|
|
|
2016-07-11 23:36:12 +05:30
|
|
|
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)
|
|
|
|
]
|
|
|
|
_ -> []
|
|
|
|
|
2016-07-12 12:57:41 +05:30
|
|
|
extractFKColumns :: Fact -> Reader Config [Column]
|
2016-07-11 23:36:12 +05:30
|
|
|
extractFKColumns fact = do
|
|
|
|
allDims <- extractAllDimensionTables fact
|
2016-07-12 12:57:41 +05:30
|
|
|
Settings {..} <- asks configSettings
|
|
|
|
tables <- asks configTables
|
2016-07-11 23:36:12 +05:30
|
|
|
|
|
|
|
return $ for allDims $ \(dimFact, dimTable) ->
|
|
|
|
let colName = factDimFKIdColumnName settingDimPrefix settingDimTableIdColumnName dimFact dimTable tables
|
|
|
|
colType = idColTypeToFKIdColType settingDimTableIdColumnType
|
|
|
|
in Column colName colType NotNull
|
|
|
|
|
2016-07-12 12:57:41 +05:30
|
|
|
extractUKColumnNames :: Fact -> Reader Config [ColumnName]
|
2016-07-11 23:36:12 +05:30
|
|
|
extractUKColumnNames fact = do
|
2016-07-12 12:57:41 +05:30
|
|
|
Settings {..} <- asks configSettings
|
2016-07-11 23:36:12 +05:30
|
|
|
return $ forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
|
|
|
|
case factColType of
|
|
|
|
DimTime -> Just $ timeUnitColumnName settingDimTableIdColumnName cName settingTimeUnit
|
|
|
|
NoDimId -> Just cName
|
|
|
|
TenantId -> Just cName
|
|
|
|
_ -> Nothing
|
2015-12-21 15:30:23 +05:30
|
|
|
|
2016-07-12 12:57:41 +05:30
|
|
|
extractDependencies :: Fact -> Reader Config Dependencies
|
2016-07-11 23:36:12 +05:30
|
|
|
extractDependencies fact = Map.union <$> extractFactDeps fact <*> extractDimensionDeps fact
|
|
|
|
|
2016-07-12 12:57:41 +05:30
|
|
|
extractFactDeps :: Fact -> Reader Config Dependencies
|
2016-07-11 23:36:12 +05:30
|
|
|
extractFactDeps fact = do
|
2016-07-12 12:57:41 +05:30
|
|
|
Settings{..} <- asks configSettings
|
|
|
|
facts <- asks configFacts
|
2016-07-11 23:36:12 +05:30
|
|
|
|
|
|
|
let extractedTable =
|
|
|
|
extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
|
|
|
|
|
|
|
|
factSourceDeps =
|
2015-12-21 15:30:23 +05:30
|
|
|
nub . Tree.flatten . flip Tree.unfoldTree fact $ \fct ->
|
|
|
|
(factTableName fct, parentFacts fct facts)
|
2016-07-11 23:36:12 +05:30
|
|
|
|
2016-06-22 17:10:14 +05:30
|
|
|
factDimDeps =
|
2015-12-21 15:30:23 +05:30
|
|
|
nub . concat . Tree.flatten . flip Tree.unfoldTree fact $ \fct ->
|
2016-02-03 16:00:39 +05:30
|
|
|
( forMaybe (factColumns fct) $ \FactColumn {..} -> case factColType of
|
|
|
|
DimVal {..} -> Just $ settingDimPrefix <> factColTargetTable
|
|
|
|
DimId {..} -> Just factColTargetTable
|
|
|
|
_ -> Nothing
|
2015-12-21 15:30:23 +05:30
|
|
|
, parentFacts fct facts
|
|
|
|
)
|
|
|
|
|
2016-07-11 23:36:12 +05:30
|
|
|
return $ Map.singleton extractedTable (factSourceDeps ++ factDimDeps)
|
2015-12-21 15:30:23 +05:30
|
|
|
where
|
|
|
|
parentFacts fct facts = [ fromJust $ findFact pf facts | pf <- factParentNames fct ]
|
2016-07-11 23:36:12 +05:30
|
|
|
|
2016-07-12 12:57:41 +05:30
|
|
|
extractDimensionDeps :: Fact -> Reader Config Dependencies
|
2016-07-11 23:36:12 +05:30
|
|
|
extractDimensionDeps fact = do
|
2016-07-12 12:57:41 +05:30
|
|
|
Settings{..} <- asks configSettings
|
2016-07-11 23:36:12 +05:30
|
|
|
return $ Map.fromList [ (settingDimPrefix <> table, [factTableName fact])
|
|
|
|
| FactColumn {factColType = DimVal table} <- factColumns fact ]
|