2016-01-01 20:57:54 +05:30
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
{-# LANGUAGE RecordWildCards #-}
|
2016-02-03 16:00:39 +05:30
|
|
|
{-# LANGUAGE GADTs #-}
|
2016-07-05 21:59:20 +05:30
|
|
|
{-# LANGUAGE NoImplicitPrelude #-}
|
2016-02-03 16:00:39 +05:30
|
|
|
|
2016-01-06 19:00:27 +05:30
|
|
|
module Ringo.Generator.Create (dimensionTableDefnSQL, factTableDefnSQL) where
|
2015-12-29 17:11:15 +05:30
|
|
|
|
2016-07-05 21:59:20 +05:30
|
|
|
import Prelude.Compat
|
2016-07-05 21:00:20 +05:30
|
|
|
import Control.Monad.Reader (Reader, asks)
|
2016-01-01 17:15:22 +05:30
|
|
|
import Database.HsSqlPpp.Syntax ( Statement(..), RowConstraint(..), AlterTableAction(..)
|
2016-04-24 16:47:53 +05:30
|
|
|
, AlterTableOperation(..), Constraint(..), Cascade(..)
|
|
|
|
, Replace(..) )
|
2016-01-15 14:43:11 +05:30
|
|
|
import Data.Maybe (listToMaybe, maybeToList)
|
2016-01-01 17:15:22 +05:30
|
|
|
import Data.Monoid ((<>))
|
|
|
|
import Data.Text (Text)
|
2015-12-29 17:11:15 +05:30
|
|
|
|
|
|
|
import Ringo.Extractor.Internal
|
2016-01-01 17:15:22 +05:30
|
|
|
import Ringo.Generator.Sql
|
2016-06-22 17:10:14 +05:30
|
|
|
import Ringo.Types.Internal
|
2015-12-29 17:11:15 +05:30
|
|
|
import Ringo.Utils
|
|
|
|
|
2016-01-15 14:43:11 +05:30
|
|
|
tableDefnStmts :: Table -> Reader Env [Statement]
|
2016-06-22 17:10:14 +05:30
|
|
|
tableDefnStmts Table {..} = do
|
2015-12-30 19:57:38 +05:30
|
|
|
Settings {..} <- asks envSettings
|
2016-01-06 19:08:38 +05:30
|
|
|
let tabName = tableName <> settingTableNameSuffixTemplate
|
2015-12-30 19:57:38 +05:30
|
|
|
|
2016-04-24 16:47:53 +05:30
|
|
|
tableSQL = CreateTable ea (name tabName) (map columnDefnSQL tableColumns) [] Nothing NoReplace
|
2015-12-30 12:21:41 +05:30
|
|
|
|
2015-12-30 19:57:38 +05:30
|
|
|
columnDefnSQL Column {..} =
|
2016-01-04 01:32:36 +05:30
|
|
|
attDef columnName columnType $ nullableDefnSQL columnNullable
|
2015-12-29 17:11:15 +05:30
|
|
|
|
2016-01-01 17:15:22 +05:30
|
|
|
nullableDefnSQL Null = NullConstraint ea ""
|
|
|
|
nullableDefnSQL NotNull = NotNullConstraint ea ""
|
2015-12-29 17:11:15 +05:30
|
|
|
|
2015-12-30 19:57:38 +05:30
|
|
|
constraintDefnSQL constraint =
|
2016-01-01 17:15:22 +05:30
|
|
|
let constr = case constraint of
|
|
|
|
PrimaryKey cName -> PrimaryKeyConstraint ea "" [nmc cName]
|
|
|
|
ForeignKey oTableName cNamePairs ->
|
|
|
|
ReferenceConstraint ea "" (map (nmc . fst) cNamePairs)
|
|
|
|
(name oTableName) (map (nmc . snd) cNamePairs) Restrict Restrict
|
|
|
|
UniqueKey cNames -> UniqueConstraint ea "" $ map nmc cNames
|
|
|
|
|
|
|
|
in AlterTable ea (name tabName) $ AlterTableActions ea [AddConstraint ea constr]
|
2015-12-29 17:11:15 +05:30
|
|
|
|
2016-01-01 17:15:22 +05:30
|
|
|
return $ tableSQL : map constraintDefnSQL tableConstraints
|
2015-12-29 17:11:15 +05:30
|
|
|
|
2016-01-15 14:43:11 +05:30
|
|
|
tableDefnSQL :: Table -> (Table -> Reader Env [Statement]) -> Reader Env [Text]
|
|
|
|
tableDefnSQL table indexFn = do
|
2016-01-25 22:13:47 +05:30
|
|
|
ds <- map ppStatement <$> tableDefnStmts table
|
|
|
|
is <- map (\st -> ppStatement st <> ";\n") <$> indexFn table
|
2016-01-01 17:15:22 +05:30
|
|
|
return $ ds ++ is
|
|
|
|
|
2016-01-06 19:00:27 +05:30
|
|
|
dimensionTableDefnSQL :: Table -> Reader Env [Text]
|
2016-01-15 14:43:11 +05:30
|
|
|
dimensionTableDefnSQL table = tableDefnSQL table dimensionTableIndexStmts
|
|
|
|
|
|
|
|
dimensionTableIndexStmts :: Table -> Reader Env [Statement]
|
2016-06-22 17:10:14 +05:30
|
|
|
dimensionTableIndexStmts Table {..} = do
|
2016-01-06 19:00:27 +05:30
|
|
|
Settings {..} <- asks envSettings
|
|
|
|
let tabName = tableName <> settingTableNameSuffixTemplate
|
|
|
|
tablePKColName = head [ cName | PrimaryKey cName <- tableConstraints ]
|
|
|
|
nonPKColNames = [ cName | Column cName _ _ <- tableColumns, cName /= tablePKColName ]
|
2016-01-15 14:43:11 +05:30
|
|
|
|
|
|
|
return [ CreateIndexTSQL ea (nmc "") (name tabName) [nmc cName]
|
|
|
|
| cName <- nonPKColNames, length nonPKColNames > 1 ]
|
2016-01-06 19:00:27 +05:30
|
|
|
|
2015-12-29 17:11:15 +05:30
|
|
|
factTableDefnSQL :: Fact -> Table -> Reader Env [Text]
|
2016-01-15 14:43:11 +05:30
|
|
|
factTableDefnSQL fact table = tableDefnSQL table (factTableIndexStmts fact)
|
|
|
|
|
|
|
|
factTableIndexStmts :: Fact -> Table -> Reader Env [Statement]
|
|
|
|
factTableIndexStmts fact table = do
|
2016-06-22 17:10:14 +05:30
|
|
|
allDims <- extractAllDimensionTables fact
|
|
|
|
Settings {..} <- asks envSettings
|
|
|
|
tables <- asks envTables
|
|
|
|
|
|
|
|
let dimTimeCol = head [ cName | FactColumn cName DimTime <- factColumns fact ]
|
|
|
|
tenantIdCol = listToMaybe [ cName | FactColumn cName TenantId <- factColumns fact ]
|
|
|
|
tabName = tableName table <> settingTableNameSuffixTemplate
|
|
|
|
dimTimeColName cName = timeUnitColumnName settingDimTableIdColumnName cName settingTimeUnit
|
|
|
|
|
|
|
|
factCols = forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
|
|
|
|
case factColType of
|
|
|
|
DimTime -> Just [dimTimeColName cName]
|
|
|
|
NoDimId -> Just [cName]
|
|
|
|
TenantId -> Just [cName]
|
|
|
|
_ -> Nothing
|
|
|
|
|
|
|
|
dimCols = [ [ factDimFKIdColumnName settingDimPrefix settingDimTableIdColumnName dimFact dimTable tables ]
|
|
|
|
| (dimFact, dimTable) <- allDims ]
|
|
|
|
|
|
|
|
return [ CreateIndexTSQL ea (nmc "") (name tabName) (map nmc cols)
|
|
|
|
| cols <- factCols ++ dimCols ++ [ [cName, dimTimeColName dimTimeCol]
|
|
|
|
| cName <- maybeToList tenantIdCol ] ]
|