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
|
|
|
|
|
2015-12-15 17:22:45 +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
|
2015-12-15 17:22:45 +05:30
|
|
|
import Ringo.Types
|
2015-12-16 02:05:36 +05:30
|
|
|
import Ringo.Utils
|
|
|
|
|
2015-12-16 03:03:47 +05:30
|
|
|
extractFactTable :: Fact -> Reader Env Table
|
|
|
|
extractFactTable fact = do
|
2015-12-16 02:05:36 +05:30
|
|
|
Settings {..} <- asks envSettings
|
2015-12-16 03:03:47 +05:30
|
|
|
allDims <- extractAllDimensionTables fact
|
2015-12-18 17:00:46 +05:30
|
|
|
tables <- asks envTables
|
|
|
|
let table = fromJust . findTable (factTableName fact) $ tables
|
2015-12-16 02:05:36 +05:30
|
|
|
|
2015-12-18 01:00:32 +05:30
|
|
|
let countColType = settingFactCountColumnType
|
|
|
|
dimIdColName = settingDimTableIdColumnName
|
2015-12-16 02:05:36 +05:30
|
|
|
sourceColumnType colName = columnType . fromJust . findColumn colName . tableColumns $ table
|
|
|
|
|
2015-12-18 13:20:35 +05:30
|
|
|
columns = concatFor (factColumns fact) $ \col -> case col of
|
2015-12-21 22:19:54 +05:30
|
|
|
DimTime cName ->
|
2015-12-28 18:09:02 +05:30
|
|
|
[ Column (timeUnitColumnName dimIdColName cName settingTimeUnit) "bigint" NotNull ]
|
2015-12-29 16:21:52 +05:30
|
|
|
NoDimId cName -> let
|
|
|
|
col' = fromJust . findColumn cName . tableColumns $ table
|
|
|
|
in [ col' { columnNullable = NotNull } ]
|
2015-12-21 22:19:54 +05:30
|
|
|
FactCount _ cName -> [ Column cName countColType NotNull ]
|
|
|
|
FactSum scName cName -> [ Column cName (sourceColumnType scName) NotNull ]
|
|
|
|
FactAverage scName cName ->
|
2015-12-18 01:00:32 +05:30
|
|
|
[ Column (cName <> settingAvgCountColumSuffix) countColType NotNull
|
|
|
|
, Column (cName <> settingAvgSumColumnSuffix) (sourceColumnType scName) NotNull
|
|
|
|
]
|
2015-12-22 19:46:37 +05:30
|
|
|
FactCountDistinct _ cName -> [ Column cName "json" NotNull ]
|
2015-12-21 22:19:54 +05:30
|
|
|
_ -> []
|
2015-12-16 02:05:36 +05:30
|
|
|
|
2015-12-29 15:19:17 +05:30
|
|
|
fkColumns = for allDims $ \(_, Table {..}) ->
|
2015-12-18 01:00:32 +05:30
|
|
|
let colName = factDimFKIdColumnName settingDimPrefix dimIdColName tableName
|
2015-12-18 13:20:35 +05:30
|
|
|
colType = idColTypeToFKIdColType settingDimTableIdColumnType
|
2015-12-28 18:09:02 +05:30
|
|
|
in Column colName colType NotNull
|
2015-12-16 02:05:36 +05:30
|
|
|
|
|
|
|
ukColNames =
|
2015-12-29 15:19:17 +05:30
|
|
|
(++ map columnName fkColumns)
|
2015-12-18 13:20:35 +05:30
|
|
|
. forMaybe (factColumns fact) $ \col -> case col of
|
2015-12-18 01:00:32 +05:30
|
|
|
DimTime cName -> Just (timeUnitColumnName dimIdColName cName settingTimeUnit)
|
2015-12-16 02:05:36 +05:30
|
|
|
NoDimId cName -> Just cName
|
|
|
|
_ -> Nothing
|
|
|
|
|
2015-12-18 13:20:35 +05:30
|
|
|
return Table
|
|
|
|
{ tableName =
|
|
|
|
extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
|
2015-12-29 15:19:17 +05:30
|
|
|
, tableColumns = columns ++ fkColumns
|
2015-12-28 18:09:02 +05:30
|
|
|
, tableConstraints = [ UniqueKey ukColNames ]
|
2015-12-18 13:20:35 +05:30
|
|
|
}
|
2015-12-21 15:30:23 +05:30
|
|
|
|
|
|
|
extractDependencies :: Fact -> Reader Env Dependencies
|
|
|
|
extractDependencies fact = do
|
|
|
|
settings@Settings{..} <- asks envSettings
|
|
|
|
facts <- asks envFacts
|
|
|
|
let 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) $ \col -> case col of
|
|
|
|
DimVal table _ -> Just $ settingDimPrefix <> table
|
|
|
|
DimId table _ -> Just table
|
|
|
|
_ -> Nothing
|
|
|
|
, parentFacts fct facts
|
|
|
|
)
|
|
|
|
|
|
|
|
dimDeps = Map.fromList [ (settingDimPrefix <> table, [factTableName fact])
|
|
|
|
| DimVal table _ <- factColumns fact ]
|
|
|
|
|
|
|
|
factDeps = Map.singleton (extractedTable settings) (factSourceDeps ++ factDimDeps)
|
|
|
|
return $ Map.union dimDeps factDeps
|
|
|
|
where
|
|
|
|
extractedTable Settings {..} =
|
|
|
|
extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
|
|
|
|
|
|
|
|
parentFacts fct facts = [ fromJust $ findFact pf facts | pf <- factParentNames fct ]
|