Tool to transform OLTP database schemas to OLAP database schemas automatically
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
ringo/ringo/src/Ringo/Extractor/Internal.hs

112 lines
4.5 KiB

7 years ago
{-# 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 ((<>))
7 years ago
import Data.List (nub, nubBy, find)
import Data.Text (Text)
import Ringo.Types.Internal
7 years ago
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
7 years ago
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
7 years ago
extractDimensionTables :: Fact -> Reader Env [Table]
extractDimensionTables fact = do
settings <- asks envSettings
7 years ago
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
7 years ago
. 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)]
7 years ago
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