122 lines
4.8 KiB
Haskell
122 lines
4.8 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
{-# LANGUAGE TupleSections #-}
|
|
{-# LANGUAGE GADTs #-}
|
|
{-# LANGUAGE NoImplicitPrelude #-}
|
|
|
|
module Ringo.Extractor.Internal where
|
|
|
|
import qualified Data.Map as Map
|
|
import qualified Data.Text as Text
|
|
|
|
import Prelude.Compat
|
|
import Control.Monad.Reader (Reader, asks)
|
|
import Data.Function (on)
|
|
import Data.Maybe (mapMaybe, fromMaybe, fromJust, catMaybes)
|
|
import Data.Monoid ((<>))
|
|
import Data.List (nub, nubBy, find)
|
|
import Data.Text (Text)
|
|
|
|
import Ringo.Types.Internal
|
|
import Ringo.Utils
|
|
|
|
findTable :: TableName -> [Table] -> Maybe Table
|
|
findTable tName = find ((== tName) . tableName)
|
|
|
|
findFact :: TableName -> [Fact] -> Maybe Fact
|
|
findFact fName = find ((== fName) . factName)
|
|
|
|
findColumn :: ColumnName -> [Column] -> Maybe Column
|
|
findColumn cName = find ((== cName) . columnName)
|
|
|
|
dimColumnName :: Text -> ColumnName -> ColumnName
|
|
dimColumnName dimName columnName =
|
|
fromMaybe columnName . Text.stripPrefix (dimName <> "_") $ columnName
|
|
|
|
dimColumnMapping :: Text -> Fact -> TableName -> [(ColumnName, ColumnName)]
|
|
dimColumnMapping dimPrefix fact dimTableName =
|
|
[ (dimColumnName factColTargetTable factColTargetColumn, factColTargetColumn)
|
|
| FactColumn { factColType = DimVal {..}, ..} <- factColumns fact
|
|
, dimPrefix <> factColTargetTable == dimTableName ]
|
|
|
|
dimColumnMappings :: Text -> Fact -> [(TableName, [(ColumnName, ColumnName)])]
|
|
dimColumnMappings dimPrefix fact =
|
|
nub [ (dimTableName, dimColumnMapping dimPrefix fact dimTableName)
|
|
| FactColumn { factColType = DimVal {..}, ..} <- factColumns fact
|
|
, let dimTableName = dimPrefix <> factColTargetTable ]
|
|
|
|
timeUnitColumnName :: Text -> ColumnName -> TimeUnit -> ColumnName
|
|
timeUnitColumnName dimIdColName colName timeUnit =
|
|
colName <> "_" <> timeUnitName timeUnit <> "_" <> dimIdColName
|
|
|
|
factDimFKIdColumnName :: Text -> Text -> Fact -> Table -> [Table] -> ColumnName
|
|
factDimFKIdColumnName dimPrefix dimIdColName dimFact dimTable@Table { .. } tables =
|
|
if dimTable `elem` tables
|
|
then head [ factColTargetColumn
|
|
| FactColumn {factColType = DimId {..}, ..} <- factColumns dimFact
|
|
, factColTargetTable == tableName ]
|
|
else fromMaybe tableName (Text.stripPrefix dimPrefix tableName) <> "_" <> dimIdColName
|
|
|
|
extractedFactTableName :: Text -> Text -> TableName -> TimeUnit -> TableName
|
|
extractedFactTableName factPrefix factInfix factName timeUnit =
|
|
factPrefix <> factName <> factInfix <> timeUnitName timeUnit
|
|
|
|
idColTypeToFKIdColType :: Text -> Text
|
|
idColTypeToFKIdColType typ = case Text.toLower typ of
|
|
"serial" -> "integer"
|
|
"smallserial" -> "smallint"
|
|
"bigserial" -> "bigint"
|
|
_ -> typ
|
|
|
|
extractDimensionTables :: Fact -> Reader Config [Table]
|
|
extractDimensionTables fact = do
|
|
settings <- asks configSettings
|
|
tables <- asks configTables
|
|
return $ dimTablesFromIds tables fact ++ dimTablesFromVals settings tables fact
|
|
|
|
dimTablesFromIds :: [Table] -> Fact -> [Table]
|
|
dimTablesFromIds tables fact =
|
|
catMaybes [ findTable factColTargetTable tables
|
|
| FactColumn { factColType = DimId {..} } <- factColumns fact ]
|
|
|
|
dimTablesFromVals :: Settings -> [Table] -> Fact -> [Table]
|
|
dimTablesFromVals Settings {..} tables fact =
|
|
fact
|
|
>>- factColumns
|
|
>>> mapMaybe (findDimValColumn . Just)
|
|
>>> Map.fromListWith (flip (++))
|
|
>>> Map.mapWithKey makeDimColumns
|
|
>>> Map.toList
|
|
>>> map (uncurry makeDimTable)
|
|
where
|
|
Table {..} = fromJust . findTable (factTableName fact) $ tables
|
|
|
|
makeDimTable dim cols =
|
|
Table { tableName = settingDimPrefix <> dim
|
|
, tableColumns =
|
|
Column settingDimTableIdColumnName settingDimTableIdColumnType NotNull : cols
|
|
, tableConstraints = [ PrimaryKey settingDimTableIdColumnName
|
|
, UniqueKey (map columnName cols)
|
|
]
|
|
}
|
|
|
|
makeDimColumns dim cols = [ col { columnName = dimColumnName dim (columnName col)
|
|
, columnNullable = NotNull
|
|
}
|
|
| col <- nub cols
|
|
]
|
|
|
|
findDimValColumn :: Maybe FactColumn -> Maybe (TableName, [Column])
|
|
findDimValColumn fcol = do
|
|
FactColumn { factColType = DimVal {..}, .. } <- fcol
|
|
column <- findColumn factColTargetColumn tableColumns
|
|
return (factColTargetTable, [column])
|
|
|
|
extractAllDimensionTables :: Fact -> Reader Config [(Fact, Table)]
|
|
extractAllDimensionTables fact = do
|
|
myDims <- map (fact,) <$> extractDimensionTables fact
|
|
parentDims <- concat <$> mapM extract (factParentNames fact)
|
|
return . nubBy ((==) `on` snd) $ myDims ++ parentDims
|
|
where
|
|
extract fName = asks configFacts >>= extractAllDimensionTables . fromJust . findFact fName
|