112 lines
4.5 KiB
Haskell
112 lines
4.5 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
|
|
|
|
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 Env [Table]
|
|
extractDimensionTables fact = do
|
|
settings <- asks envSettings
|
|
tables <- asks envTables
|
|
let table = fromJust . findTable (factTableName fact) $ tables
|
|
return $ dimsFromIds tables ++ dimsFromVals settings (tableColumns table)
|
|
where
|
|
dimsFromIds tables =
|
|
catMaybes [ findTable factColTargetTable tables
|
|
| FactColumn {factColType = DimId {..}} <- factColumns fact ]
|
|
|
|
dimsFromVals Settings {..} tableColumns =
|
|
map (\(dim, cols) ->
|
|
Table { tableName = settingDimPrefix <> dim
|
|
, tableColumns =
|
|
Column settingDimTableIdColumnName settingDimTableIdColumnType NotNull : cols
|
|
, tableConstraints = [ PrimaryKey settingDimTableIdColumnName
|
|
, UniqueKey (map columnName cols)
|
|
]
|
|
})
|
|
. Map.toList
|
|
. Map.mapWithKey
|
|
(\dim -> map (\col -> col { columnName = dimColumnName dim (columnName col)
|
|
, columnNullable = NotNull
|
|
})
|
|
. nub)
|
|
. Map.fromListWith (flip (++))
|
|
. mapMaybe (\fcol -> do
|
|
FactColumn {factColType = DimVal {..}, ..} <- fcol
|
|
column <- findColumn factColTargetColumn tableColumns
|
|
return (factColTargetTable, [ column ]))
|
|
. map Just
|
|
. factColumns
|
|
$ fact
|
|
|
|
extractAllDimensionTables :: Fact -> Reader Env [(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 envFacts >>= extractAllDimensionTables . fromJust . findFact fName
|