abhin4v
/
ringo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Removes EnvV from Types to simplify the code.

pull/1/head
Abhinav Sarkar 2016-06-22 17:10:14 +05:30
parent ade13f767b
commit 29bafea95b
9 changed files with 198 additions and 195 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
ringo-app/src/Main.hs
View File

@ -1,6 +1,5 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Main where module Main where
@ -27,14 +26,15 @@ main = do
result <- parseInput progInputFile result <- parseInput progInputFile
case result of case result of
Left err -> putStrLn err >> exitFailure Left err -> putStrLn err >> exitFailure
Right (tables, facts, defaults) -> do Right (tables, facts, defaults) ->
case makeEnv tables facts progSettings defaults of case makeEnv tables facts progSettings defaults of
Left errors -> mapM_ print errors >> exitFailure Left errors -> mapM_ print errors >> exitFailure
Right env -> writeFiles progOutputDir env >> exitSuccess Right env -> writeFiles progOutputDir env >> exitSuccess
writeFiles :: FilePath -> Env -> IO () writeFiles :: FilePath -> Env -> IO ()
writeFiles outputDir env@(envView -> EnvV{..}) = do writeFiles outputDir env = do
let Settings{..} = envSettings let Settings{..} = envSettings env
forM_ sqls $ \(sqlType, table, sql) -> do forM_ sqls $ \(sqlType, table, sql) -> do
let dirName = outputDir </> map toLower (show sqlType) let dirName = outputDir </> map toLower (show sqlType)
createDirectoryIfMissing True dirName createDirectoryIfMissing True dirName
@ -43,22 +43,25 @@ writeFiles outputDir env@(envView -> EnvV{..}) = do
BS.writeFile (outputDir </> Text.unpack settingDependenciesJSONFileName) BS.writeFile (outputDir </> Text.unpack settingDependenciesJSONFileName)
. encode . encode
. foldl (\acc -> Map.union acc . extractDependencies env) Map.empty . foldl (\acc -> Map.union acc . extractDependencies env) Map.empty
$ envFacts $ facts
BS.writeFile (outputDir </> Text.unpack settingDimensionJSONFileName) . encode $ BS.writeFile (outputDir </> Text.unpack settingDimensionJSONFileName) . encode $
[ tableName table | (_, tabs) <- dimTables, table <- tabs , table `notElem` envTables ] [ tableName table | (_, tabs) <- dimTables, table <- tabs , table `notElem` tables ]
BS.writeFile (outputDir </> Text.unpack settingFactsJSONFileName) . encode $ BS.writeFile (outputDir </> Text.unpack settingFactsJSONFileName) . encode $
[ tableName table | (_, table) <- factTables ] [ tableName table | (_, table) <- factTables ]
where where
dimTables = [ (fact, extractDimensionTables env fact) | fact <- envFacts ] facts = envFacts env
factTables = [ (fact, extractFactTable env fact) | fact <- envFacts, factTablePersistent fact ] tables = envTables env
dimTables = [ (fact, extractDimensionTables env fact) | fact <- facts ]
factTables = [ (fact, extractFactTable env fact) | fact <- facts, factTablePersistent fact ]
dimTableDefnSQLs = [ (Create, tableName table, unlines . map sqlStr $ dimensionTableDefnSQL env table) dimTableDefnSQLs = [ (Create, tableName table, unlines . map sqlStr $ dimensionTableDefnSQL env table)
| (_, tabs) <- dimTables | (_, tabs) <- dimTables
, table <- tabs , table <- tabs
, table `notElem` envTables ] , table `notElem` tables ]
factTableDefnSQLs = [ (Create , tableName table, unlines . map sqlStr $ factTableDefnSQL env fact table) factTableDefnSQLs = [ (Create , tableName table, unlines . map sqlStr $ factTableDefnSQL env fact table)
| (fact, table) <- factTables ] | (fact, table) <- factTables ]
@ -67,7 +70,7 @@ writeFiles outputDir env@(envView -> EnvV{..}) = do
[ (typ , tableName table, sqlStr $ gen env fact (tableName table)) [ (typ , tableName table, sqlStr $ gen env fact (tableName table))
| (fact, tabs) <- dimTables | (fact, tabs) <- dimTables
, table <- tabs , table <- tabs
, table `notElem` envTables ] , table `notElem` tables ]
factTablePopulateSQLs typ gen = [ (typ, tableName table, unlines . map sqlStr $ gen env fact) factTablePopulateSQLs typ gen = [ (typ, tableName table, unlines . map sqlStr $ gen env fact)
| (fact, table) <- factTables ] | (fact, table) <- factTables ]

1
ringo-app/src/Ringo/InputParser.hs
View File

@ -1,5 +1,4 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
module Ringo.InputParser (parseInput) where module Ringo.InputParser (parseInput) where

97
ringo/src/Ringo/Extractor.hs
View File

@ -11,75 +11,74 @@ module Ringo.Extractor
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Tree as Tree import qualified Data.Tree as Tree
import Control.Monad.Reader (Reader, asks, withReader) import Control.Monad.Reader (Reader, asks)
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import Data.List (nub) import Data.List (nub)
import Ringo.Extractor.Internal import Ringo.Extractor.Internal
import Ringo.Types import Ringo.Types.Internal
import Ringo.Utils import Ringo.Utils
extractFactTable :: Fact -> Reader Env Table extractFactTable :: Fact -> Reader Env Table
extractFactTable fact = do extractFactTable fact = do
allDims <- extractAllDimensionTables fact allDims <- extractAllDimensionTables fact
withReader envView $ do Settings {..} <- asks envSettings
Settings {..} <- asks envSettings tables <- asks envTables
tables <- asks envTables let table = fromJust . findTable (factTableName fact) $ tables
let table = fromJust . findTable (factTableName fact) $ tables
let countColType = settingFactCountColumnType let countColType = settingFactCountColumnType
dimIdColName = settingDimTableIdColumnName dimIdColName = settingDimTableIdColumnName
sourceColumn cName = fromJust . findColumn cName . tableColumns $ table sourceColumn cName = fromJust . findColumn cName . tableColumns $ table
notNullSourceColumnCopy cName = (sourceColumn cName) { columnNullable = NotNull } notNullSourceColumnCopy cName = (sourceColumn cName) { columnNullable = NotNull }
notNullSourceColumnRename scName cName = (notNullSourceColumnCopy scName) { columnName = cName } notNullSourceColumnRename scName cName = (notNullSourceColumnCopy scName) { columnName = cName }
columns = concatFor (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} -> columns = concatFor (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
case factColType of case factColType of
DimTime -> DimTime ->
[ Column (timeUnitColumnName dimIdColName cName settingTimeUnit) "bigint" NotNull ] [ Column (timeUnitColumnName dimIdColName cName settingTimeUnit) "bigint" NotNull ]
NoDimId -> [ notNullSourceColumnCopy cName ] NoDimId -> [ notNullSourceColumnCopy cName ]
TenantId -> [ notNullSourceColumnCopy cName ] TenantId -> [ notNullSourceColumnCopy cName ]
FactCount {..} -> [ Column cName countColType NotNull ] FactCount {..} -> [ Column cName countColType NotNull ]
FactCountDistinct {..} -> [ Column cName "json" NotNull ] FactCountDistinct {..} -> [ Column cName "json" NotNull ]
FactSum {..} -> [ notNullSourceColumnRename factColSourceColumn cName ] FactSum {..} -> [ notNullSourceColumnRename factColSourceColumn cName ]
FactMax {..} -> [ notNullSourceColumnRename factColSourceColumn cName ] FactMax {..} -> [ notNullSourceColumnRename factColSourceColumn cName ]
FactMin {..} -> [ notNullSourceColumnRename factColSourceColumn cName ] FactMin {..} -> [ notNullSourceColumnRename factColSourceColumn cName ]
FactAverage {..} -> FactAverage {..} ->
[ Column (cName <> settingAvgCountColumSuffix) countColType NotNull [ Column (cName <> settingAvgCountColumSuffix) countColType NotNull
, notNullSourceColumnRename factColSourceColumn (cName <> settingAvgSumColumnSuffix) , notNullSourceColumnRename factColSourceColumn (cName <> settingAvgSumColumnSuffix)
] ]
_ -> [] _ -> []
fkColumns = for allDims $ \(dimFact, dimTable) -> fkColumns = for allDims $ \(dimFact, dimTable) ->
let colName = factDimFKIdColumnName settingDimPrefix dimIdColName dimFact dimTable tables let colName = factDimFKIdColumnName settingDimPrefix dimIdColName dimFact dimTable tables
colType = idColTypeToFKIdColType settingDimTableIdColumnType colType = idColTypeToFKIdColType settingDimTableIdColumnType
in Column colName colType NotNull in Column colName colType NotNull
ukColNames = ukColNames =
(++ map columnName fkColumns) (++ map columnName fkColumns)
. forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} -> . forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
case factColType of case factColType of
DimTime -> Just $ timeUnitColumnName dimIdColName cName settingTimeUnit DimTime -> Just $ timeUnitColumnName dimIdColName cName settingTimeUnit
NoDimId -> Just cName NoDimId -> Just cName
TenantId -> Just cName TenantId -> Just cName
_ -> Nothing _ -> Nothing
return Table return Table
{ tableName = { tableName =
extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
, tableColumns = columns ++ fkColumns , tableColumns = columns ++ fkColumns
, tableConstraints = [ UniqueKey ukColNames ] , tableConstraints = [ UniqueKey ukColNames ]
} }
extractDependencies :: Fact -> Reader Env Dependencies extractDependencies :: Fact -> Reader Env Dependencies
extractDependencies fact = withReader envView $ do extractDependencies fact = do
settings@Settings{..} <- asks envSettings settings@Settings{..} <- asks envSettings
facts <- asks envFacts facts <- asks envFacts
let factSourceDeps = let factSourceDeps =
nub . Tree.flatten . flip Tree.unfoldTree fact $ \fct -> nub . Tree.flatten . flip Tree.unfoldTree fact $ \fct ->
(factTableName fct, parentFacts fct facts) (factTableName fct, parentFacts fct facts)
factDimDeps = factDimDeps =
nub . concat . Tree.flatten . flip Tree.unfoldTree fact $ \fct -> nub . concat . Tree.flatten . flip Tree.unfoldTree fact $ \fct ->
( forMaybe (factColumns fct) $ \FactColumn {..} -> case factColType of ( forMaybe (factColumns fct) $ \FactColumn {..} -> case factColType of
DimVal {..} -> Just $ settingDimPrefix <> factColTargetTable DimVal {..} -> Just $ settingDimPrefix <> factColTargetTable

9
ringo/src/Ringo/Extractor/Internal.hs
View File

@ -13,14 +13,14 @@ import qualified Data.Text as Text
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
#endif #endif
import Control.Monad.Reader (Reader, asks, withReader) import Control.Monad.Reader (Reader, asks)
import Data.Function (on) import Data.Function (on)
import Data.Maybe (mapMaybe, fromMaybe, fromJust, catMaybes) import Data.Maybe (mapMaybe, fromMaybe, fromJust, catMaybes)
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import Data.List (nub, nubBy, find) import Data.List (nub, nubBy, find)
import Data.Text (Text) import Data.Text (Text)
import Ringo.Types import Ringo.Types.Internal
findTable :: TableName -> [Table] -> Maybe Table findTable :: TableName -> [Table] -> Maybe Table
findTable tName = find ((== tName) . tableName) findTable tName = find ((== tName) . tableName)
@ -59,7 +59,7 @@ idColTypeToFKIdColType typ = case Text.toLower typ of
_ -> typ _ -> typ
extractDimensionTables :: Fact -> Reader Env [Table] extractDimensionTables :: Fact -> Reader Env [Table]
extractDimensionTables fact = withReader envView $ do extractDimensionTables fact = do
settings <- asks envSettings settings <- asks envSettings
tables <- asks envTables tables <- asks envTables
let table = fromJust . findTable (factTableName fact) $ tables let table = fromJust . findTable (factTableName fact) $ tables
@ -99,5 +99,4 @@ extractAllDimensionTables fact = do
parentDims <- concat <$> mapM extract (factParentNames fact) parentDims <- concat <$> mapM extract (factParentNames fact)
return . nubBy ((==) `on` snd) $ myDims ++ parentDims return . nubBy ((==) `on` snd) $ myDims ++ parentDims
where where
extract fName = extract fName = asks envFacts >>= extractAllDimensionTables . fromJust . findFact fName
asks (envFacts . envView) >>= extractAllDimensionTables . fromJust . findFact fName

43
ringo/src/Ringo/Generator/Create.hs
View File

@ -20,11 +20,11 @@ import Data.Text (Text)
import Ringo.Extractor.Internal import Ringo.Extractor.Internal
import Ringo.Generator.Sql import Ringo.Generator.Sql
import Ringo.Types import Ringo.Types.Internal
import Ringo.Utils import Ringo.Utils
tableDefnStmts :: Table -> Reader Env [Statement] tableDefnStmts :: Table -> Reader Env [Statement]
tableDefnStmts Table {..} = withReader envView $ do tableDefnStmts Table {..} = do
Settings {..} <- asks envSettings Settings {..} <- asks envSettings
let tabName = tableName <> settingTableNameSuffixTemplate let tabName = tableName <> settingTableNameSuffixTemplate
@ -58,7 +58,7 @@ dimensionTableDefnSQL :: Table -> Reader Env [Text]
dimensionTableDefnSQL table = tableDefnSQL table dimensionTableIndexStmts dimensionTableDefnSQL table = tableDefnSQL table dimensionTableIndexStmts
dimensionTableIndexStmts :: Table -> Reader Env [Statement] dimensionTableIndexStmts :: Table -> Reader Env [Statement]
dimensionTableIndexStmts Table {..} = withReader envView $do dimensionTableIndexStmts Table {..} = do
Settings {..} <- asks envSettings Settings {..} <- asks envSettings
let tabName = tableName <> settingTableNameSuffixTemplate let tabName = tableName <> settingTableNameSuffixTemplate
tablePKColName = head [ cName | PrimaryKey cName <- tableConstraints ] tablePKColName = head [ cName | PrimaryKey cName <- tableConstraints ]
@ -72,26 +72,25 @@ factTableDefnSQL fact table = tableDefnSQL table (factTableIndexStmts fact)
factTableIndexStmts :: Fact -> Table -> Reader Env [Statement] factTableIndexStmts :: Fact -> Table -> Reader Env [Statement]
factTableIndexStmts fact table = do factTableIndexStmts fact table = do
allDims <- extractAllDimensionTables fact allDims <- extractAllDimensionTables fact
withReader envView $ do Settings {..} <- asks envSettings
Settings {..} <- asks envSettings tables <- asks envTables
tables <- asks envTables
let dimTimeCol = head [ cName | FactColumn cName DimTime <- factColumns fact ] let dimTimeCol = head [ cName | FactColumn cName DimTime <- factColumns fact ]
tenantIdCol = listToMaybe [ cName | FactColumn cName TenantId <- factColumns fact ] tenantIdCol = listToMaybe [ cName | FactColumn cName TenantId <- factColumns fact ]
tabName = tableName table <> settingTableNameSuffixTemplate tabName = tableName table <> settingTableNameSuffixTemplate
dimTimeColName cName = timeUnitColumnName settingDimTableIdColumnName cName settingTimeUnit dimTimeColName cName = timeUnitColumnName settingDimTableIdColumnName cName settingTimeUnit
factCols = forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} -> factCols = forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
case factColType of case factColType of
DimTime -> Just [dimTimeColName cName] DimTime -> Just [dimTimeColName cName]
NoDimId -> Just [cName] NoDimId -> Just [cName]
TenantId -> Just [cName] TenantId -> Just [cName]
_ -> Nothing _ -> Nothing
dimCols = [ [ factDimFKIdColumnName settingDimPrefix settingDimTableIdColumnName dimFact dimTable tables ] dimCols = [ [ factDimFKIdColumnName settingDimPrefix settingDimTableIdColumnName dimFact dimTable tables ]
| (dimFact, dimTable) <- allDims ] | (dimFact, dimTable) <- allDims ]
return [ CreateIndexTSQL ea (nmc "") (name tabName) (map nmc cols) return [ CreateIndexTSQL ea (nmc "") (name tabName) (map nmc cols)
| cols <- factCols ++ dimCols ++ [ [cName, dimTimeColName dimTimeCol] | cols <- factCols ++ dimCols ++ [ [cName, dimTimeColName dimTimeCol]
| cName <- maybeToList tenantIdCol ] ] | cName <- maybeToList tenantIdCol ] ]

6
ringo/src/Ringo/Generator/Populate/Dimension.hs
View File

@ -10,7 +10,7 @@ module Ringo.Generator.Populate.Dimension (dimensionTablePopulateSQL) where
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
#endif #endif
import Control.Monad.Reader (Reader, asks, withReader) import Control.Monad.Reader (Reader, asks)
import Database.HsSqlPpp.Syntax (Statement, QueryExpr(..), Distinct(..), makeSelect, JoinType(..)) import Database.HsSqlPpp.Syntax (Statement, QueryExpr(..), Distinct(..), makeSelect, JoinType(..))
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Data.Text (Text) import Data.Text (Text)
@ -18,14 +18,14 @@ import Data.Text (Text)
import Ringo.Extractor.Internal import Ringo.Extractor.Internal
import Ringo.Generator.Internal import Ringo.Generator.Internal
import Ringo.Generator.Sql import Ringo.Generator.Sql
import Ringo.Types import Ringo.Types.Internal
dimensionTablePopulateSQL :: TablePopulationMode -> Fact -> TableName -> Reader Env Text dimensionTablePopulateSQL :: TablePopulationMode -> Fact -> TableName -> Reader Env Text
dimensionTablePopulateSQL popMode fact dimTableName = dimensionTablePopulateSQL popMode fact dimTableName =
ppStatement <$> dimensionTablePopulateStmt popMode fact dimTableName ppStatement <$> dimensionTablePopulateStmt popMode fact dimTableName
dimensionTablePopulateStmt :: TablePopulationMode -> Fact -> TableName -> Reader Env Statement dimensionTablePopulateStmt :: TablePopulationMode -> Fact -> TableName -> Reader Env Statement
dimensionTablePopulateStmt popMode fact dimTableName = withReader envView $ do dimensionTablePopulateStmt popMode fact dimTableName = do
Settings {..} <- asks envSettings Settings {..} <- asks envSettings
tables <- asks envTables tables <- asks envTables
defaults <- asks envTypeDefaults defaults <- asks envTypeDefaults

183
ringo/src/Ringo/Generator/Populate/Fact.hs
View File

@ -15,7 +15,7 @@ import qualified Data.Text as Text
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
#endif #endif
import Control.Monad.Reader (Reader, asks, withReader) import Control.Monad.Reader (Reader, asks)
import Database.HsSqlPpp.Syntax ( QueryExpr(..), Statement, makeSelect import Database.HsSqlPpp.Syntax ( QueryExpr(..), Statement, makeSelect
, SelectList(..), SelectItem(..), JoinType(..) ) , SelectList(..), SelectItem(..), JoinType(..) )
import Data.List (nub) import Data.List (nub)
@ -27,7 +27,7 @@ import Text.RawString.QQ (r)
import Ringo.Extractor.Internal import Ringo.Extractor.Internal
import Ringo.Generator.Internal import Ringo.Generator.Internal
import Ringo.Generator.Sql import Ringo.Generator.Sql
import Ringo.Types import Ringo.Types.Internal
import Ringo.Utils import Ringo.Utils
ilog2FunctionString :: Text ilog2FunctionString :: Text
@ -56,7 +56,7 @@ $$
LANGUAGE 'plpgsql' IMMUTABLE; LANGUAGE 'plpgsql' IMMUTABLE;
|] |]
factCountDistinctUpdateStmts :: TablePopulationMode -> Fact -> Text -> QueryExpr -> Reader EnvV [Statement] factCountDistinctUpdateStmts :: TablePopulationMode -> Fact -> Text -> QueryExpr -> Reader Env [Statement]
factCountDistinctUpdateStmts popMode fact groupByColPrefix expr = case expr of factCountDistinctUpdateStmts popMode fact groupByColPrefix expr = case expr of
Select {selSelectList = SelectList _ origSelectItems, ..} -> do Select {selSelectList = SelectList _ origSelectItems, ..} -> do
Settings {..} <- asks envSettings Settings {..} <- asks envSettings
@ -125,108 +125,107 @@ factCountDistinctUpdateStmts popMode fact groupByColPrefix expr = case expr of
factTablePopulateStmts :: TablePopulationMode -> Fact -> Reader Env [Statement] factTablePopulateStmts :: TablePopulationMode -> Fact -> Reader Env [Statement]
factTablePopulateStmts popMode fact = do factTablePopulateStmts popMode fact = do
allDims <- extractAllDimensionTables fact allDims <- extractAllDimensionTables fact
withReader envView $ do Settings {..} <- asks envSettings
Settings {..} <- asks envSettings tables <- asks envTables
tables <- asks envTables defaults <- asks envTypeDefaults
defaults <- asks envTypeDefaults let fTableName = factTableName fact
let fTableName = factTableName fact fTable = fromJust . findTable fTableName $ tables
fTable = fromJust . findTable fTableName $ tables dimIdColName = settingDimTableIdColumnName
dimIdColName = settingDimTableIdColumnName
coalesceFKId ex = coalesceFKId ex =
app "coalesce" [ ex, num . Text.pack . show $ settingForeignKeyIdCoalesceValue ] app "coalesce" [ ex, num . Text.pack . show $ settingForeignKeyIdCoalesceValue ]
timeUnitColumnInsertSQL cName = timeUnitColumnInsertSQL cName =
let colName = timeUnitColumnName dimIdColName cName settingTimeUnit let colName = timeUnitColumnName dimIdColName cName settingTimeUnit
in ( colName in ( colName
, cast (app "floor" [ binop "/" (extEpoch (eqi fTableName cName)) , cast (app "floor" [ binop "/" (extEpoch (eqi fTableName cName))
(num . Text.pack . show . timeUnitToSeconds $ settingTimeUnit) ]) (num . Text.pack . show . timeUnitToSeconds $ settingTimeUnit) ])
"bigint" "bigint"
, True , True
) )
dimIdColumnInsertSQL cName = dimIdColumnInsertSQL cName =
let sCol = fromJust . findColumn cName $ tableColumns fTable let sCol = fromJust . findColumn cName $ tableColumns fTable
in (cName, coalesceColumn defaults fTableName sCol, True) in (cName, coalesceColumn defaults fTableName sCol, True)
app' f cName = app f [ eqi fTableName cName ] app' f cName = app f [ eqi fTableName cName ]
factColMap = concatFor (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} -> factColMap = concatFor (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
case factColType of case factColType of
DimTime -> [ timeUnitColumnInsertSQL cName ] DimTime -> [ timeUnitColumnInsertSQL cName ]
NoDimId -> [ dimIdColumnInsertSQL cName ] NoDimId -> [ dimIdColumnInsertSQL cName ]
TenantId -> [ dimIdColumnInsertSQL cName ] TenantId -> [ dimIdColumnInsertSQL cName ]
FactCount {..} -> FactCount {..} ->
[ (cName, app "count" [ maybe star (eqi fTableName) factColMaybeSourceColumn ], False) ] [ (cName, app "count" [ maybe star (eqi fTableName) factColMaybeSourceColumn ], False) ]
FactCountDistinct {..} -> [ (cName, cast (str "{}") "json", False) ] FactCountDistinct {..} -> [ (cName, cast (str "{}") "json", False) ]
FactSum {..} -> [ (cName, app' "sum" factColSourceColumn, False) ] FactSum {..} -> [ (cName, app' "sum" factColSourceColumn, False) ]
FactMax {..} -> [ (cName, app' "max" factColSourceColumn, False) ] FactMax {..} -> [ (cName, app' "max" factColSourceColumn, False) ]
FactMin {..} -> [ (cName, app' "min" factColSourceColumn, False) ] FactMin {..} -> [ (cName, app' "min" factColSourceColumn, False) ]
FactAverage {..} -> FactAverage {..} ->
[ ( cName <> settingAvgCountColumSuffix, app' "count" factColSourceColumn, False ) [ ( cName <> settingAvgCountColumSuffix, app' "count" factColSourceColumn, False )
, ( cName <> settingAvgSumColumnSuffix , app' "sum" factColSourceColumn , False) , ( cName <> settingAvgSumColumnSuffix , app' "sum" factColSourceColumn , False)
] ]
_ -> [] _ -> []
dimColMap = for allDims $ \(dimFact, factTable@Table {tableName}) -> let dimColMap = for allDims $ \(dimFact, factTable@Table {tableName}) -> let
dimFKIdColName = dimFKIdColName =
factDimFKIdColumnName settingDimPrefix dimIdColName dimFact factTable tables factDimFKIdColumnName settingDimPrefix dimIdColName dimFact factTable tables
factSourceTableName = factTableName dimFact factSourceTableName = factTableName dimFact
factSourceTable = fromJust . findTable factSourceTableName $ tables factSourceTable = fromJust . findTable factSourceTableName $ tables
dimFKIdColumn = fromJust . findColumn dimFKIdColName $ tableColumns factSourceTable dimFKIdColumn = fromJust . findColumn dimFKIdColName $ tableColumns factSourceTable
dimLookupWhereClauses = Just . foldBinop "and" $ dimLookupWhereClauses = Just . foldBinop "and" $
[ binop "=" (eqi tableName dimColName) (coalesceColumn defaults factSourceTableName sourceCol) [ binop "=" (eqi tableName dimColName) (coalesceColumn defaults factSourceTableName sourceCol)
| (dimColName, sourceColName) <- dimColumnMapping settingDimPrefix dimFact tableName | (dimColName, sourceColName) <- dimColumnMapping settingDimPrefix dimFact tableName
, let sourceCol = fromJust . findColumn sourceColName $ tableColumns factSourceTable ] , let sourceCol = fromJust . findColumn sourceColName $ tableColumns factSourceTable ]
insertExpr = if factTable `elem` tables -- existing dimension table insertExpr = if factTable `elem` tables -- existing dimension table
then (if columnNullable dimFKIdColumn == Null then coalesceFKId else id) then (if columnNullable dimFKIdColumn == Null then coalesceFKId else id)
$ eqi factSourceTableName dimFKIdColName $ eqi factSourceTableName dimFKIdColName
else coalesceFKId . subQueryExp $ else coalesceFKId . subQueryExp $
makeSelect makeSelect
{ selSelectList = sl [ si $ ei dimIdColName ] { selSelectList = sl [ si $ ei dimIdColName ]
, selTref = , selTref =
[ trefa (suffixTableName popMode settingTableNameSuffixTemplate tableName) tableName ] [ trefa (suffixTableName popMode settingTableNameSuffixTemplate tableName) tableName ]
, selWhere = dimLookupWhereClauses , selWhere = dimLookupWhereClauses
} }
in (dimFKIdColName, insertExpr, True) in (dimFKIdColName, insertExpr, True)
colMap = [ (cName, (expr, nmc $ groupByColPrefix <> cName), addToGroupBy) colMap = [ (cName, (expr, nmc $ groupByColPrefix <> cName), addToGroupBy)
| (cName, expr, addToGroupBy) <- factColMap ++ dimColMap ] | (cName, expr, addToGroupBy) <- factColMap ++ dimColMap ]
joinClauses = joinClauses =
map (tref &&& joinClausePreds fTable) map (tref &&& joinClausePreds fTable)
. filter (/= fTableName) . filter (/= fTableName)
. nub . nub
. map (factTableName . fst) . map (factTableName . fst)
$ allDims $ allDims
timeCol = eqi fTableName $ head [ cName | FactColumn cName DimTime <- factColumns fact ] timeCol = eqi fTableName $ head [ cName | FactColumn cName DimTime <- factColumns fact ]
extFactTableName = suffixTableName popMode settingTableNameSuffixTemplate extFactTableName = suffixTableName popMode settingTableNameSuffixTemplate
$ extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit $ extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
populateSelectExpr = populateSelectExpr =
makeSelect makeSelect
{ selSelectList = sl . map (uncurry sia . snd3) $ colMap { selSelectList = sl . map (uncurry sia . snd3) $ colMap
, selTref = [ foldl (\tf (t, oc) -> tjoin tf LeftOuter t oc) (tref fTableName) joinClauses ] , selTref = [ foldl (\tf (t, oc) -> tjoin tf LeftOuter t oc) (tref fTableName) joinClauses ]
, selWhere = Just . foldBinop "and" $ , selWhere = Just . foldBinop "and" $
binop "<" timeCol placeholder : binop "<" timeCol placeholder :
[ binop ">=" timeCol placeholder | popMode == IncrementalPopulation ] [ binop ">=" timeCol placeholder | popMode == IncrementalPopulation ]
, selGroupBy = map (ei . (groupByColPrefix <>) . fst3) . filter thd3 $ colMap , selGroupBy = map (ei . (groupByColPrefix <>) . fst3) . filter thd3 $ colMap
} }
insertIntoStmt = insert extFactTableName (map fst3 colMap) populateSelectExpr insertIntoStmt = insert extFactTableName (map fst3 colMap) populateSelectExpr
updateStmts <- factCountDistinctUpdateStmts popMode fact groupByColPrefix populateSelectExpr updateStmts <- factCountDistinctUpdateStmts popMode fact groupByColPrefix populateSelectExpr
return $ insertIntoStmt : updateStmts return $ insertIntoStmt : updateStmts
where where
groupByColPrefix = "xxff_" groupByColPrefix = "xxff_"
joinClausePreds table oTableName = joinClausePreds table oTableName =
foldBinop "and" foldBinop "and"
. map (\(c1, c2) -> binop "=" (eqi (tableName table) c1) (eqi oTableName c2)) . map (\(c1, c2) -> binop "=" (eqi (tableName table) c1) (eqi oTableName c2))
<$> listToMaybe [ colPairs | ForeignKey tName colPairs <- tableConstraints table <$> listToMaybe [ colPairs | ForeignKey tName colPairs <- tableConstraints table
, tName == oTableName ] , tName == oTableName ]
factTablePopulateSQL :: TablePopulationMode -> Fact -> Reader Env [Text] factTablePopulateSQL :: TablePopulationMode -> Fact -> Reader Env [Text]
factTablePopulateSQL popMode fact = do factTablePopulateSQL popMode fact = do

6
ringo/src/Ringo/Types.hs
View File

@ -1,8 +1,6 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE GADTs #-} {-# LANGUAGE GADTs #-}
{-# LANGUAGE Rank2Types #-} {-# LANGUAGE Rank2Types #-}
{-# LANGUAGE StandaloneDeriving #-}
module Ringo.Types module Ringo.Types
( ColumnName, ColumnType, TableName ( ColumnName, ColumnType, TableName
@ -11,7 +9,7 @@ module Ringo.Types
, Fact(..), FactColumnType(..), FactColumn(..), factSourceColumnName , Fact(..), FactColumnType(..), FactColumn(..), factSourceColumnName
, Settings(..), defSettings , Settings(..), defSettings
, ValidationError(..), TypeDefaults , ValidationError(..), TypeDefaults
, Env, EnvV(..), envView , Env, envTables, envFacts, envSettings, envTypeDefaults,
, TablePopulationMode(..), Dependencies) where TablePopulationMode(..), Dependencies) where
import Ringo.Types.Internal import Ringo.Types.Internal

25
ringo/src/Ringo/Types/Internal.hs
View File

@ -168,17 +168,24 @@ data ValidationError = MissingTable !TableName
type TypeDefaults = Map Text Text type TypeDefaults = Map Text Text
data Env = Env ![Table] ![Fact] !Settings !TypeDefaults data Env = Env
{ _envTables :: ![Table]
, _envFacts :: ![Fact]
, _envSettings :: !Settings
, _envTypeDefaults :: !TypeDefaults
} deriving (Show)
data EnvV = EnvV envTables :: Env -> [Table]
{ envTables :: ![Table] envTables = _envTables
, envFacts :: ![Fact]
, envSettings :: !Settings
, envTypeDefaults :: !TypeDefaults
} deriving (Show)
envView :: Env -> EnvV envFacts :: Env -> [Fact]
envView (Env tables facts settings typeDefaults) = EnvV tables facts settings typeDefaults envFacts = _envFacts
envSettings :: Env -> Settings
envSettings = _envSettings
envTypeDefaults :: Env -> TypeDefaults
envTypeDefaults = _envTypeDefaults
data TablePopulationMode = FullPopulation | IncrementalPopulation deriving (Eq, Show) data TablePopulationMode = FullPopulation | IncrementalPopulation deriving (Eq, Show)