Renames Env to Config.

master
Abhinav Sarkar 2016-07-12 12:57:41 +05:30
parent 80bd3fdd9b
commit f968612f36
No known key found for this signature in database
GPG Key ID: 7C9166A6F5465AD5
12 changed files with 180 additions and 180 deletions

1
.gitignore vendored
View File

@ -19,3 +19,4 @@ cabal.sandbox.config
*.prof *.prof
*.aux *.aux
*.hp *.hp
tags

View File

@ -27,22 +27,22 @@ main = do
case result of case result of
Left err -> putStrLn err >> exitFailure Left err -> putStrLn err >> exitFailure
Right (tables, facts, defaults) -> Right (tables, facts, defaults) ->
case makeEnv tables facts progSettings defaults of case makeConfig tables facts progSettings defaults of
Left errors -> mapM_ print errors >> exitFailure Left errors -> mapM_ print errors >> exitFailure
Right env -> writeFiles progOutputDir env >> exitSuccess Right config -> writeFiles progOutputDir config >> exitSuccess
writeFiles :: FilePath -> Env -> IO () writeFiles :: FilePath -> Config -> IO ()
writeFiles outputDir env = do writeFiles outputDir config = do
let Settings{..} = envSettings env let Settings{..} = configSettings config
forM_ (makeSQLs env dimTables factTables) $ \(sqlType, table, sql) -> do forM_ (makeSQLs config dimTables factTables) $ \(sqlType, table, sql) -> do
let dirName = outputDir </> map toLower (show sqlType) let dirName = outputDir </> map toLower (show sqlType)
createDirectoryIfMissing True dirName createDirectoryIfMissing True dirName
writeFile (dirName </> Text.unpack table <.> "sql") sql writeFile (dirName </> Text.unpack table <.> "sql") sql
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 config) Map.empty
$ facts $ facts
BS.writeFile (outputDir </> Text.unpack settingDimensionsJSONFileName) . encode $ BS.writeFile (outputDir </> Text.unpack settingDimensionsJSONFileName) . encode $
@ -51,31 +51,33 @@ writeFiles outputDir env = do
BS.writeFile (outputDir </> Text.unpack settingFactsJSONFileName) . encode $ BS.writeFile (outputDir </> Text.unpack settingFactsJSONFileName) . encode $
[ tableName table | (_, table) <- factTables ] [ tableName table | (_, table) <- factTables ]
where where
facts = envFacts env facts = configFacts config
tables = envTables env tables = configTables config
dimTables = [ (fact, extractDimensionTables env fact) | fact <- facts ] dimTables = [ (fact, extractDimensionTables config fact) | fact <- facts ]
factTables = [ (fact, extractFactTable env fact) | fact <- facts, factTablePersistent fact ] factTables = [ (fact, extractFactTable config fact) | fact <- facts, factTablePersistent fact ]
makeSQLs :: Config -> [(Fact, [Table])] -> [(Fact, Table)] -> [(SQLType, TableName, String)]
makeSQLs config dimTables factTables = let
tables = configTables config
makeSQLs :: Env -> [(Fact, [Table])] -> [(Fact, Table)] -> [(SQLType, TableName, String)]
makeSQLs env dimTables factTables = let
dimTableDefinitionSQLs = dimTableDefinitionSQLs =
[ (Create, tableName table, unlines . map sqlStr $ dimensionTableDefinitionSQL env table) [ (Create, tableName table, unlines . map Text.unpack $ dimensionTableDefinitionSQL config table)
| (_, tabs) <- dimTables | (_, tabs) <- dimTables
, table <- tabs , table <- tabs
, table `notElem` tables ] , table `notElem` tables ]
factTableDefinitionSQLs = factTableDefinitionSQLs =
[ (Create , tableName table, unlines . map sqlStr $ factTableDefinitionSQL env fact table) [ (Create , tableName table, unlines . map Text.unpack $ factTableDefinitionSQL config fact table)
| (fact, table) <- factTables ] | (fact, table) <- factTables ]
dimTablePopulationSQLs typ gen = dimTablePopulationSQLs typ gen =
[ (typ , tableName table, sqlStr $ gen env fact (tableName table)) [ (typ , tableName table, Text.unpack $ gen config fact (tableName table))
| (fact, tabs) <- dimTables | (fact, tabs) <- dimTables
, table <- tabs , table <- tabs
, table `notElem` tables ] , table `notElem` tables ]
factTablePopulationSQLs typ gen = [ (typ, tableName table, unlines . map sqlStr $ gen env fact) factTablePopulationSQLs typ gen = [ (typ, tableName table, unlines . map Text.unpack $ gen config fact)
| (fact, table) <- factTables ] | (fact, table) <- factTables ]
in concat [ dimTableDefinitionSQLs in concat [ dimTableDefinitionSQLs
, factTableDefinitionSQLs , factTableDefinitionSQLs
@ -84,6 +86,3 @@ makeSQLs env dimTables factTables = let
, factTablePopulationSQLs FullRefresh $ factTablePopulationSQL FullPopulation , factTablePopulationSQLs FullRefresh $ factTablePopulationSQL FullPopulation
, factTablePopulationSQLs IncRefresh $ factTablePopulationSQL IncrementalPopulation , factTablePopulationSQLs IncRefresh $ factTablePopulationSQL IncrementalPopulation
] ]
where
tables = envTables env
sqlStr = Text.unpack

View File

@ -5,7 +5,7 @@ module Ringo
-- $setup -- $setup
module Ringo.Types module Ringo.Types
, makeEnv , makeConfig
, extractFactTable , extractFactTable
, extractDimensionTables , extractDimensionTables
, extractDependencies , extractDependencies
@ -139,17 +139,17 @@ import qualified Ringo.Validator as V
-- , ("text", "'__UNKNOWN_VAL__'") -- , ("text", "'__UNKNOWN_VAL__'")
-- ] -- ]
-- settings = defSettings { settingTableNameSuffixTemplate = "" } -- settings = defSettings { settingTableNameSuffixTemplate = "" }
-- env = case makeEnv tables facts settings typeDefaults of -- config = case makeConfig tables facts settings typeDefaults of
-- Left errors -> error . unlines . map show $ errors -- Left errors -> error . unlines . map show $ errors
-- Right env -> env -- Right config -> config
-- :} -- :}
makeEnv :: [Table] -> [Fact] -> Settings -> TypeDefaults -> Either [ValidationError] Env makeConfig :: [Table] -> [Fact] -> Settings -> TypeDefaults -> Either [ValidationError] Config
makeEnv = V.validateEnv makeConfig = V.validateConfig
-- | -- |
-- --
-- >>> print $ extractFactTable env sessionFact -- >>> print $ extractFactTable config sessionFact
-- Table fact_session_by_minute -- Table fact_session_by_minute
-- Column created_at_minute_id bigint NOT NULL -- Column created_at_minute_id bigint NOT NULL
-- Column publisher_id integer NOT NULL -- Column publisher_id integer NOT NULL
@ -158,7 +158,7 @@ makeEnv = V.validateEnv
-- Column user_agent_id integer NOT NULL -- Column user_agent_id integer NOT NULL
-- UniqueKey (created_at_minute_id, publisher_id, geo_id, user_agent_id) -- UniqueKey (created_at_minute_id, publisher_id, geo_id, user_agent_id)
-- <BLANKLINE> -- <BLANKLINE>
-- >>> print $ extractFactTable env pageViewFact -- >>> print $ extractFactTable config pageViewFact
-- Table fact_page_view_by_minute -- Table fact_page_view_by_minute
-- Column created_at_minute_id bigint NOT NULL -- Column created_at_minute_id bigint NOT NULL
-- Column publisher_id integer NOT NULL -- Column publisher_id integer NOT NULL
@ -169,12 +169,12 @@ makeEnv = V.validateEnv
-- Column user_agent_id integer NOT NULL -- Column user_agent_id integer NOT NULL
-- UniqueKey (created_at_minute_id, publisher_id, referrer_id, page_type_id, geo_id, user_agent_id) -- UniqueKey (created_at_minute_id, publisher_id, referrer_id, page_type_id, geo_id, user_agent_id)
-- <BLANKLINE> -- <BLANKLINE>
extractFactTable :: Env -> Fact -> Table extractFactTable :: Config -> Fact -> Table
extractFactTable env = flip runReader env . E.extractFactTable extractFactTable config = flip runReader config . E.extractFactTable
-- | -- |
-- --
-- >>> mapM_ print $ extractDimensionTables env sessionFact -- >>> mapM_ print $ extractDimensionTables config sessionFact
-- Table dim_geo -- Table dim_geo
-- Column id serial NOT NULL -- Column id serial NOT NULL
-- Column country_name character varying(50) NOT NULL -- Column country_name character varying(50) NOT NULL
@ -191,20 +191,20 @@ extractFactTable env = flip runReader env . E.extractFactTable
-- PrimaryKey id -- PrimaryKey id
-- UniqueKey (browser_name, os, name) -- UniqueKey (browser_name, os, name)
-- <BLANKLINE> -- <BLANKLINE>
-- >>> mapM_ print . filter (`notElem` tables) $ extractDimensionTables env pageViewFact -- >>> mapM_ print . filter (`notElem` tables) $ extractDimensionTables config pageViewFact
-- Table dim_page_type -- Table dim_page_type
-- Column id serial NOT NULL -- Column id serial NOT NULL
-- Column page_type character varying(20) NOT NULL -- Column page_type character varying(20) NOT NULL
-- PrimaryKey id -- PrimaryKey id
-- UniqueKey (page_type) -- UniqueKey (page_type)
-- <BLANKLINE> -- <BLANKLINE>
extractDimensionTables :: Env -> Fact -> [Table] extractDimensionTables :: Config -> Fact -> [Table]
extractDimensionTables env = flip runReader env . E.extractDimensionTables extractDimensionTables config = flip runReader config . E.extractDimensionTables
-- | -- |
-- --
-- >>> let depsToStr = map ((\(k, vs) -> Text.unpack $ k <> ":\n - " <> Text.intercalate "\n - " vs)) . Map.toList -- >>> let depsToStr = map ((\(k, vs) -> Text.unpack $ k <> ":\n - " <> Text.intercalate "\n - " vs)) . Map.toList
-- >>> mapM_ putStrLn . depsToStr $ extractDependencies env sessionFact -- >>> mapM_ putStrLn . depsToStr $ extractDependencies config sessionFact
-- dim_geo: -- dim_geo:
-- - session_events -- - session_events
-- dim_user_agent: -- dim_user_agent:
@ -213,7 +213,7 @@ extractDimensionTables env = flip runReader env . E.extractDimensionTables
-- - session_events -- - session_events
-- - dim_user_agent -- - dim_user_agent
-- - dim_geo -- - dim_geo
-- >>> mapM_ putStrLn . depsToStr $ extractDependencies env pageViewFact -- >>> mapM_ putStrLn . depsToStr $ extractDependencies config pageViewFact
-- dim_page_type: -- dim_page_type:
-- - page_view_events -- - page_view_events
-- fact_page_view_by_minute: -- fact_page_view_by_minute:
@ -223,13 +223,13 @@ extractDimensionTables env = flip runReader env . E.extractDimensionTables
-- - referrers -- - referrers
-- - dim_user_agent -- - dim_user_agent
-- - dim_geo -- - dim_geo
extractDependencies :: Env -> Fact -> Dependencies extractDependencies :: Config -> Fact -> Dependencies
extractDependencies env = flip runReader env . E.extractDependencies extractDependencies config = flip runReader config . E.extractDependencies
-- | -- |
-- --
-- >>> let dimTables = filter (`notElem` tables) . nub . concatMap (extractDimensionTables env) $ facts -- >>> let dimTables = filter (`notElem` tables) . nub . concatMap (extractDimensionTables config) $ facts
-- >>> let sqls = map (dimensionTableDefinitionSQL env) dimTables -- >>> let sqls = map (dimensionTableDefinitionSQL config) dimTables
-- >>> mapM_ (\sqls -> mapM_ (putStr . Text.unpack) sqls >> putStrLn "--------" ) sqls -- >>> mapM_ (\sqls -> mapM_ (putStr . Text.unpack) sqls >> putStrLn "--------" ) sqls
-- create table dim_geo ( -- create table dim_geo (
-- id serial not null, -- id serial not null,
@ -282,16 +282,16 @@ extractDependencies env = flip runReader env . E.extractDependencies
-- alter table dim_page_type add unique (page_type); -- alter table dim_page_type add unique (page_type);
-- <BLANKLINE> -- <BLANKLINE>
-- -------- -- --------
dimensionTableDefinitionSQL :: Env -> Table -> [Text] dimensionTableDefinitionSQL :: Config -> Table -> [Text]
dimensionTableDefinitionSQL env = flip runReader env . G.dimensionTableDefinitionSQL dimensionTableDefinitionSQL config = flip runReader config . G.dimensionTableDefinitionSQL
dimensionTableDefinitionStatements :: Env -> Table -> [Statement] dimensionTableDefinitionStatements :: Config -> Table -> [Statement]
dimensionTableDefinitionStatements env = flip runReader env . G.dimensionTableDefinitionStatements dimensionTableDefinitionStatements config = flip runReader config . G.dimensionTableDefinitionStatements
-- | -- |
-- --
-- >>> let storySessionFactTable = extractFactTable env sessionFact -- >>> let storySessionFactTable = extractFactTable config sessionFact
-- >>> let sqls = factTableDefinitionSQL env sessionFact storySessionFactTable -- >>> let sqls = factTableDefinitionSQL config sessionFact storySessionFactTable
-- >>> mapM_ (putStr . Text.unpack) sqls -- >>> mapM_ (putStr . Text.unpack) sqls
-- create table fact_session_by_minute ( -- create table fact_session_by_minute (
-- created_at_minute_id bigint not null, -- created_at_minute_id bigint not null,
@ -315,8 +315,8 @@ dimensionTableDefinitionStatements env = flip runReader env . G.dimensionTableDe
-- ; -- ;
-- create index on fact_session_by_minute (user_agent_id) -- create index on fact_session_by_minute (user_agent_id)
-- ; -- ;
-- >>> let pageViewFactTable = extractFactTable env pageViewFact -- >>> let pageViewFactTable = extractFactTable config pageViewFact
-- >>> let sqls = factTableDefinitionSQL env pageViewFact pageViewFactTable -- >>> let sqls = factTableDefinitionSQL config pageViewFact pageViewFactTable
-- >>> mapM_ (putStr . Text.unpack) sqls -- >>> mapM_ (putStr . Text.unpack) sqls
-- create table fact_page_view_by_minute ( -- create table fact_page_view_by_minute (
-- created_at_minute_id bigint not null, -- created_at_minute_id bigint not null,
@ -348,16 +348,16 @@ dimensionTableDefinitionStatements env = flip runReader env . G.dimensionTableDe
-- ; -- ;
-- create index on fact_page_view_by_minute (user_agent_id) -- create index on fact_page_view_by_minute (user_agent_id)
-- ; -- ;
factTableDefinitionSQL :: Env -> Fact -> Table -> [Text] factTableDefinitionSQL :: Config -> Fact -> Table -> [Text]
factTableDefinitionSQL env fact = flip runReader env . G.factTableDefinitionSQL fact factTableDefinitionSQL config fact = flip runReader config . G.factTableDefinitionSQL fact
factTableDefinitionStatements :: Env -> Fact -> Table -> [Statement] factTableDefinitionStatements :: Config -> Fact -> Table -> [Statement]
factTableDefinitionStatements env fact = flip runReader env . G.factTableDefinitionStatements fact factTableDefinitionStatements config fact = flip runReader config . G.factTableDefinitionStatements fact
-- | -- |
-- --
-- >>> let storySessionDimTableNames = map tableName $ extractDimensionTables env sessionFact -- >>> let storySessionDimTableNames = map tableName $ extractDimensionTables config sessionFact
-- >>> let sqls = map (dimensionTablePopulationSQL FullPopulation env sessionFact) storySessionDimTableNames -- >>> let sqls = map (dimensionTablePopulationSQL FullPopulation config sessionFact) storySessionDimTableNames
-- >>> mapM_ (putStr . Text.unpack) sqls -- >>> mapM_ (putStr . Text.unpack) sqls
-- insert into dim_geo (country_name, city_name, continent_name) -- insert into dim_geo (country_name, city_name, continent_name)
-- select distinct -- select distinct
@ -385,7 +385,7 @@ factTableDefinitionStatements env fact = flip runReader env . G.factTableDefinit
-- created_at < ? -- created_at < ?
-- ; -- ;
-- <BLANKLINE> -- <BLANKLINE>
-- >>> let sqls = map (dimensionTablePopulationSQL IncrementalPopulation env sessionFact) storySessionDimTableNames -- >>> let sqls = map (dimensionTablePopulationSQL IncrementalPopulation config sessionFact) storySessionDimTableNames
-- >>> mapM_ (putStr . Text.unpack) sqls -- >>> mapM_ (putStr . Text.unpack) sqls
-- insert into dim_geo (country_name, city_name, continent_name) -- insert into dim_geo (country_name, city_name, continent_name)
-- select -- select
@ -445,8 +445,8 @@ factTableDefinitionStatements env fact = flip runReader env . G.factTableDefinit
-- dim_user_agent.name is null -- dim_user_agent.name is null
-- ; -- ;
-- <BLANKLINE> -- <BLANKLINE>
-- >>> let pageViewDimTableNames = map tableName . filter (`notElem` tables) $ extractDimensionTables env pageViewFact -- >>> let pageViewDimTableNames = map tableName . filter (`notElem` tables) $ extractDimensionTables config pageViewFact
-- >>> let sqls = map (dimensionTablePopulationSQL FullPopulation env pageViewFact) pageViewDimTableNames -- >>> let sqls = map (dimensionTablePopulationSQL FullPopulation config pageViewFact) pageViewDimTableNames
-- >>> mapM_ (putStr . Text.unpack) sqls -- >>> mapM_ (putStr . Text.unpack) sqls
-- insert into dim_page_type (page_type) -- insert into dim_page_type (page_type)
-- select distinct -- select distinct
@ -457,7 +457,7 @@ factTableDefinitionStatements env fact = flip runReader env . G.factTableDefinit
-- (page_type is not null) and created_at < ? -- (page_type is not null) and created_at < ?
-- ; -- ;
-- <BLANKLINE> -- <BLANKLINE>
-- >>> let sqls = map (dimensionTablePopulationSQL IncrementalPopulation env pageViewFact) pageViewDimTableNames -- >>> let sqls = map (dimensionTablePopulationSQL IncrementalPopulation config pageViewFact) pageViewDimTableNames
-- >>> mapM_ (putStr . Text.unpack) sqls -- >>> mapM_ (putStr . Text.unpack) sqls
-- insert into dim_page_type (page_type) -- insert into dim_page_type (page_type)
-- select -- select
@ -478,17 +478,17 @@ factTableDefinitionStatements env fact = flip runReader env . G.factTableDefinit
-- dim_page_type.page_type is null -- dim_page_type.page_type is null
-- ; -- ;
-- <BLANKLINE> -- <BLANKLINE>
dimensionTablePopulationSQL :: TablePopulationMode -> Env -> Fact -> TableName -> Text dimensionTablePopulationSQL :: TablePopulationMode -> Config -> Fact -> TableName -> Text
dimensionTablePopulationSQL popMode env fact = dimensionTablePopulationSQL popMode config fact =
flip runReader env . G.dimensionTablePopulationSQL popMode fact flip runReader config . G.dimensionTablePopulationSQL popMode fact
dimensionTablePopulationStatement :: TablePopulationMode -> Env -> Fact -> TableName -> Statement dimensionTablePopulationStatement :: TablePopulationMode -> Config -> Fact -> TableName -> Statement
dimensionTablePopulationStatement popMode env fact = dimensionTablePopulationStatement popMode config fact =
flip runReader env . G.dimensionTablePopulationStatement popMode fact flip runReader config . G.dimensionTablePopulationStatement popMode fact
-- | -- |
-- --
-- >>> let sqls = factTablePopulationSQL FullPopulation env sessionFact -- >>> let sqls = factTablePopulationSQL FullPopulation config sessionFact
-- >>> mapM_ (putStr . Text.unpack) sqls -- >>> mapM_ (putStr . Text.unpack) sqls
-- insert into fact_session_by_minute (created_at_minute_id, -- insert into fact_session_by_minute (created_at_minute_id,
-- publisher_id, -- publisher_id,
@ -530,7 +530,7 @@ dimensionTablePopulationStatement popMode env fact =
-- xxff_user_agent_id -- xxff_user_agent_id
-- ; -- ;
-- <BLANKLINE> -- <BLANKLINE>
-- >>> let sqls = factTablePopulationSQL IncrementalPopulation env sessionFact -- >>> let sqls = factTablePopulationSQL IncrementalPopulation config sessionFact
-- >>> mapM_ (putStr . Text.unpack) sqls -- >>> mapM_ (putStr . Text.unpack) sqls
-- insert into fact_session_by_minute (created_at_minute_id, -- insert into fact_session_by_minute (created_at_minute_id,
-- publisher_id, -- publisher_id,
@ -572,7 +572,7 @@ dimensionTablePopulationStatement popMode env fact =
-- xxff_user_agent_id -- xxff_user_agent_id
-- ; -- ;
-- <BLANKLINE> -- <BLANKLINE>
-- >>> let sqls = factTablePopulationSQL FullPopulation env pageViewFact -- >>> let sqls = factTablePopulationSQL FullPopulation config pageViewFact
-- >>> mapM_ (putStr . Text.unpack) sqls -- >>> mapM_ (putStr . Text.unpack) sqls
-- insert into fact_page_view_by_minute (created_at_minute_id, -- insert into fact_page_view_by_minute (created_at_minute_id,
-- publisher_id, -- publisher_id,
@ -630,10 +630,10 @@ dimensionTablePopulationStatement popMode env fact =
-- xxff_user_agent_id -- xxff_user_agent_id
-- ; -- ;
-- <BLANKLINE> -- <BLANKLINE>
factTablePopulationSQL :: TablePopulationMode -> Env -> Fact -> [Text] factTablePopulationSQL :: TablePopulationMode -> Config -> Fact -> [Text]
factTablePopulationSQL popMode env = factTablePopulationSQL popMode config =
flip runReader env . G.factTablePopulationSQL popMode flip runReader config . G.factTablePopulationSQL popMode
factTablePopulationStatements :: TablePopulationMode -> Env -> Fact -> [Statement] factTablePopulationStatements :: TablePopulationMode -> Config -> Fact -> [Statement]
factTablePopulationStatements popMode env = factTablePopulationStatements popMode config =
flip runReader env . G.factTablePopulationStatements popMode flip runReader config . G.factTablePopulationStatements popMode

View File

@ -23,8 +23,8 @@ import Ringo.Extractor.Internal
import Ringo.Types.Internal import Ringo.Types.Internal
import Ringo.Utils import Ringo.Utils
extractFactTable :: Fact -> Reader Env Table extractFactTable :: Fact -> Reader Config Table
extractFactTable fact = mkTable <$> asks envSettings extractFactTable fact = mkTable <$> asks configSettings
<*> extractColumns fact <*> extractColumns fact
<*> extractFKColumns fact <*> extractFKColumns fact
<*> extractUKColumnNames fact <*> extractUKColumnNames fact
@ -36,10 +36,10 @@ extractFactTable fact = mkTable <$> asks envSettings
, tableConstraints = [ UniqueKey $ ukColNames ++ map columnName fkColumns ] , tableConstraints = [ UniqueKey $ ukColNames ++ map columnName fkColumns ]
} }
extractColumns :: Fact -> Reader Env [Column] extractColumns :: Fact -> Reader Config [Column]
extractColumns fact = do extractColumns fact = do
Settings {..} <- asks envSettings Settings {..} <- asks configSettings
tables <- asks envTables tables <- asks configTables
let table = fromJust . findTable (factTableName fact) $ tables let table = fromJust . findTable (factTableName fact) $ tables
let sourceColumn cName = fromJust . findColumn cName . tableColumns $ table let sourceColumn cName = fromJust . findColumn cName . tableColumns $ table
@ -63,20 +63,20 @@ extractColumns fact = do
] ]
_ -> [] _ -> []
extractFKColumns :: Fact -> Reader Env [Column] extractFKColumns :: Fact -> Reader Config [Column]
extractFKColumns fact = do extractFKColumns fact = do
allDims <- extractAllDimensionTables fact allDims <- extractAllDimensionTables fact
Settings {..} <- asks envSettings Settings {..} <- asks configSettings
tables <- asks envTables tables <- asks configTables
return $ for allDims $ \(dimFact, dimTable) -> return $ for allDims $ \(dimFact, dimTable) ->
let colName = factDimFKIdColumnName settingDimPrefix settingDimTableIdColumnName dimFact dimTable tables let colName = factDimFKIdColumnName settingDimPrefix settingDimTableIdColumnName dimFact dimTable tables
colType = idColTypeToFKIdColType settingDimTableIdColumnType colType = idColTypeToFKIdColType settingDimTableIdColumnType
in Column colName colType NotNull in Column colName colType NotNull
extractUKColumnNames :: Fact -> Reader Env [ColumnName] extractUKColumnNames :: Fact -> Reader Config [ColumnName]
extractUKColumnNames fact = do extractUKColumnNames fact = do
Settings {..} <- asks envSettings Settings {..} <- asks configSettings
return $ forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} -> return $ forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
case factColType of case factColType of
DimTime -> Just $ timeUnitColumnName settingDimTableIdColumnName cName settingTimeUnit DimTime -> Just $ timeUnitColumnName settingDimTableIdColumnName cName settingTimeUnit
@ -84,13 +84,13 @@ extractUKColumnNames fact = do
TenantId -> Just cName TenantId -> Just cName
_ -> Nothing _ -> Nothing
extractDependencies :: Fact -> Reader Env Dependencies extractDependencies :: Fact -> Reader Config Dependencies
extractDependencies fact = Map.union <$> extractFactDeps fact <*> extractDimensionDeps fact extractDependencies fact = Map.union <$> extractFactDeps fact <*> extractDimensionDeps fact
extractFactDeps :: Fact -> Reader Env Dependencies extractFactDeps :: Fact -> Reader Config Dependencies
extractFactDeps fact = do extractFactDeps fact = do
Settings{..} <- asks envSettings Settings{..} <- asks configSettings
facts <- asks envFacts facts <- asks configFacts
let extractedTable = let extractedTable =
extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
@ -112,8 +112,8 @@ extractFactDeps fact = do
where where
parentFacts fct facts = [ fromJust $ findFact pf facts | pf <- factParentNames fct ] parentFacts fct facts = [ fromJust $ findFact pf facts | pf <- factParentNames fct ]
extractDimensionDeps :: Fact -> Reader Env Dependencies extractDimensionDeps :: Fact -> Reader Config Dependencies
extractDimensionDeps fact = do extractDimensionDeps fact = do
Settings{..} <- asks envSettings Settings{..} <- asks configSettings
return $ Map.fromList [ (settingDimPrefix <> table, [factTableName fact]) return $ Map.fromList [ (settingDimPrefix <> table, [factTableName fact])
| FactColumn {factColType = DimVal table} <- factColumns fact ] | FactColumn {factColType = DimVal table} <- factColumns fact ]

View File

@ -68,10 +68,10 @@ idColTypeToFKIdColType typ = case Text.toLower typ of
"bigserial" -> "bigint" "bigserial" -> "bigint"
_ -> typ _ -> typ
extractDimensionTables :: Fact -> Reader Env [Table] extractDimensionTables :: Fact -> Reader Config [Table]
extractDimensionTables fact = do extractDimensionTables fact = do
settings <- asks envSettings settings <- asks configSettings
tables <- asks envTables tables <- asks configTables
return $ dimTablesFromIds tables fact ++ dimTablesFromVals settings tables fact return $ dimTablesFromIds tables fact ++ dimTablesFromVals settings tables fact
dimTablesFromIds :: [Table] -> Fact -> [Table] dimTablesFromIds :: [Table] -> Fact -> [Table]
@ -112,10 +112,10 @@ dimTablesFromVals Settings {..} tables fact =
column <- findColumn factColTargetColumn tableColumns column <- findColumn factColTargetColumn tableColumns
return (factColTargetTable, [column]) return (factColTargetTable, [column])
extractAllDimensionTables :: Fact -> Reader Env [(Fact, Table)] extractAllDimensionTables :: Fact -> Reader Config [(Fact, Table)]
extractAllDimensionTables fact = do extractAllDimensionTables fact = do
myDims <- map (fact,) <$> extractDimensionTables fact myDims <- map (fact,) <$> extractDimensionTables fact
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 = asks envFacts >>= extractAllDimensionTables . fromJust . findFact fName extract fName = asks configFacts >>= extractAllDimensionTables . fromJust . findFact fName

View File

@ -23,9 +23,9 @@ import Ringo.Generator.Sql
import Ringo.Types.Internal import Ringo.Types.Internal
import Ringo.Utils import Ringo.Utils
tableDefinitionStatements :: Table -> Reader Env [Statement] tableDefinitionStatements :: Table -> Reader Config [Statement]
tableDefinitionStatements Table {..} = do tableDefinitionStatements Table {..} = do
Settings {..} <- asks envSettings Settings {..} <- asks configSettings
let tabName = tableName <> settingTableNameSuffixTemplate let tabName = tableName <> settingTableNameSuffixTemplate
tableSQL = CreateTable ea (name tabName) (map columnDefnSQL tableColumns) [] Nothing NoReplace tableSQL = CreateTable ea (name tabName) (map columnDefnSQL tableColumns) [] Nothing NoReplace
@ -48,22 +48,22 @@ tableDefinitionStatements Table {..} = do
return $ tableSQL : map constraintDefnSQL tableConstraints return $ tableSQL : map constraintDefnSQL tableConstraints
tableDefinitionSQL :: Table -> (Table -> Reader Env [Statement]) -> Reader Env [Text] tableDefinitionSQL :: Table -> (Table -> Reader Config [Statement]) -> Reader Config [Text]
tableDefinitionSQL table indexFn = do tableDefinitionSQL table indexFn = do
ds <- map ppStatement <$> tableDefinitionStatements table ds <- map ppStatement <$> tableDefinitionStatements table
is <- map (\st -> ppStatement st <> ";\n") <$> indexFn table is <- map (\st -> ppStatement st <> ";\n") <$> indexFn table
return $ ds ++ is return $ ds ++ is
dimensionTableDefinitionSQL :: Table -> Reader Env [Text] dimensionTableDefinitionSQL :: Table -> Reader Config [Text]
dimensionTableDefinitionSQL table = tableDefinitionSQL table dimensionTableIndexStatements dimensionTableDefinitionSQL table = tableDefinitionSQL table dimensionTableIndexStatements
dimensionTableDefinitionStatements :: Table -> Reader Env [Statement] dimensionTableDefinitionStatements :: Table -> Reader Config [Statement]
dimensionTableDefinitionStatements table = dimensionTableDefinitionStatements table =
(++) <$> tableDefinitionStatements table <*> dimensionTableIndexStatements table (++) <$> tableDefinitionStatements table <*> dimensionTableIndexStatements table
dimensionTableIndexStatements :: Table -> Reader Env [Statement] dimensionTableIndexStatements :: Table -> Reader Config [Statement]
dimensionTableIndexStatements Table {..} = do dimensionTableIndexStatements Table {..} = do
Settings {..} <- asks envSettings Settings {..} <- asks configSettings
let tabName = tableName <> settingTableNameSuffixTemplate let tabName = tableName <> settingTableNameSuffixTemplate
tablePKColName = head [ cName | PrimaryKey cName <- tableConstraints ] tablePKColName = head [ cName | PrimaryKey cName <- tableConstraints ]
nonPKColNames = [ cName | Column cName _ _ <- tableColumns, cName /= tablePKColName ] nonPKColNames = [ cName | Column cName _ _ <- tableColumns, cName /= tablePKColName ]
@ -71,18 +71,18 @@ dimensionTableIndexStatements Table {..} = do
return [ CreateIndexTSQL ea (nmc "") (name tabName) [nmc cName] return [ CreateIndexTSQL ea (nmc "") (name tabName) [nmc cName]
| cName <- nonPKColNames, length nonPKColNames > 1 ] | cName <- nonPKColNames, length nonPKColNames > 1 ]
factTableDefinitionSQL :: Fact -> Table -> Reader Env [Text] factTableDefinitionSQL :: Fact -> Table -> Reader Config [Text]
factTableDefinitionSQL fact table = tableDefinitionSQL table (factTableIndexStatements fact) factTableDefinitionSQL fact table = tableDefinitionSQL table (factTableIndexStatements fact)
factTableDefinitionStatements :: Fact -> Table -> Reader Env [Statement] factTableDefinitionStatements :: Fact -> Table -> Reader Config [Statement]
factTableDefinitionStatements fact table = factTableDefinitionStatements fact table =
(++) <$> tableDefinitionStatements table <*> factTableIndexStatements fact table (++) <$> tableDefinitionStatements table <*> factTableIndexStatements fact table
factTableIndexStatements :: Fact -> Table -> Reader Env [Statement] factTableIndexStatements :: Fact -> Table -> Reader Config [Statement]
factTableIndexStatements fact table = do factTableIndexStatements fact table = do
allDims <- extractAllDimensionTables fact allDims <- extractAllDimensionTables fact
Settings {..} <- asks envSettings Settings {..} <- asks configSettings
tables <- asks envTables tables <- asks configTables
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 ]

View File

@ -20,19 +20,19 @@ import Ringo.Generator.Internal
import Ringo.Generator.Sql import Ringo.Generator.Sql
import Ringo.Types.Internal import Ringo.Types.Internal
dimensionTablePopulationSQL :: TablePopulationMode -> Fact -> TableName -> Reader Env Text dimensionTablePopulationSQL :: TablePopulationMode -> Fact -> TableName -> Reader Config Text
dimensionTablePopulationSQL popMode fact dimTableName = dimensionTablePopulationSQL popMode fact dimTableName =
ppStatement <$> dimensionTablePopulationStatement popMode fact dimTableName ppStatement <$> dimensionTablePopulationStatement popMode fact dimTableName
dimensionTablePopulationStatement :: TablePopulationMode -> Fact -> TableName -> Reader Env Statement dimensionTablePopulationStatement :: TablePopulationMode -> Fact -> TableName -> Reader Config Statement
dimensionTablePopulationStatement popMode fact dimTableName = do dimensionTablePopulationStatement popMode fact dimTableName = do
Settings {..} <- asks envSettings Settings {..} <- asks configSettings
let colMapping = dimColumnMapping settingDimPrefix fact dimTableName let colMapping = dimColumnMapping settingDimPrefix fact dimTableName
let insertTable = suffixTableName popMode settingTableNameSuffixTemplate dimTableName let insertTable = suffixTableName popMode settingTableNameSuffixTemplate dimTableName
selectQ <- makeSelectQuery popMode fact dimTableName colMapping selectQ <- makeSelectQuery popMode fact dimTableName colMapping
return $ insert insertTable (map fst colMapping) selectQ return $ insert insertTable (map fst colMapping) selectQ
makeSelectQuery :: TablePopulationMode -> Fact -> TableName -> [(ColumnName, ColumnName)] -> Reader Env QueryExpr makeSelectQuery :: TablePopulationMode -> Fact -> TableName -> [(ColumnName, ColumnName)] -> Reader Config QueryExpr
makeSelectQuery popMode fact dimTableName colMapping = do makeSelectQuery popMode fact dimTableName colMapping = do
selectList <- makeSelectList fact colMapping selectList <- makeSelectList fact colMapping
let selectQ = makeSelect let selectQ = makeSelect
@ -46,10 +46,10 @@ makeSelectQuery popMode fact dimTableName colMapping = do
FullPopulation -> selectQ FullPopulation -> selectQ
IncrementalPopulation -> makeIncSelectQuery selectQ dimTableName colMapping IncrementalPopulation -> makeIncSelectQuery selectQ dimTableName colMapping
makeSelectList :: Fact -> [(ColumnName, ColumnName)] -> Reader Env SelectList makeSelectList :: Fact -> [(ColumnName, ColumnName)] -> Reader Config SelectList
makeSelectList fact colMapping = do makeSelectList fact colMapping = do
tables <- asks envTables tables <- asks configTables
defaults <- asks envTypeDefaults defaults <- asks configTypeDefaults
let factTable = fromJust $ findTable (factTableName fact) tables let factTable = fromJust $ findTable (factTableName fact) tables
return $ sl [ flip sia (nmc cName) $ coalesceColumn defaults (factTableName fact) col return $ sl [ flip sia (nmc cName) $ coalesceColumn defaults (factTableName fact) col
| (_, cName) <- colMapping | (_, cName) <- colMapping

View File

@ -57,7 +57,7 @@ $$
LANGUAGE 'plpgsql' IMMUTABLE; LANGUAGE 'plpgsql' IMMUTABLE;
|] |]
factTablePopulationSQL :: TablePopulationMode -> Fact -> Reader Env [Text] factTablePopulationSQL :: TablePopulationMode -> Fact -> Reader Config [Text]
factTablePopulationSQL popMode fact = do factTablePopulationSQL popMode fact = do
stmts <- factTablePopulationStatements popMode fact stmts <- factTablePopulationStatements popMode fact
return $ case stmts of return $ case stmts of
@ -65,9 +65,9 @@ factTablePopulationSQL popMode fact = do
[i] -> [ ppStatement i ] [i] -> [ ppStatement i ]
i:us -> [ ppStatement i, ilog2FunctionString ] ++ map ppStatement us i:us -> [ ppStatement i, ilog2FunctionString ] ++ map ppStatement us
factTablePopulationStatements :: TablePopulationMode -> Fact -> Reader Env [Statement] factTablePopulationStatements :: TablePopulationMode -> Fact -> Reader Config [Statement]
factTablePopulationStatements popMode fact = do factTablePopulationStatements popMode fact = do
Settings {..} <- asks envSettings Settings {..} <- asks configSettings
allDims <- extractAllDimensionTables fact allDims <- extractAllDimensionTables fact
selExprs <- selectExprs popMode fact allDims groupByColPrefix selExprs <- selectExprs popMode fact allDims groupByColPrefix
popQueryExpr <- populateQueryExpr popMode fact allDims selExprs groupByColPrefix popQueryExpr <- populateQueryExpr popMode fact allDims selExprs groupByColPrefix
@ -85,7 +85,7 @@ selectExprs :: TablePopulationMode
-> Fact -> Fact
-> [(Fact, Table)] -> [(Fact, Table)]
-> Text -> Text
-> Reader Env [(ColumnName, (ScalarExpr, NameComponent), Bool)] -> Reader Config [(ColumnName, (ScalarExpr, NameComponent), Bool)]
selectExprs popMode fact allDims groupByColPrefix = do selectExprs popMode fact allDims groupByColPrefix = do
factSelExprs <- factColumnSelectExprs fact factSelExprs <- factColumnSelectExprs fact
dimSelExprs <- dimColumnSelectExprs popMode allDims dimSelExprs <- dimColumnSelectExprs popMode allDims
@ -93,11 +93,11 @@ selectExprs popMode fact allDims groupByColPrefix = do
return [ (cName, (expr, nmc $ groupByColPrefix <> cName), addToGroupBy) return [ (cName, (expr, nmc $ groupByColPrefix <> cName), addToGroupBy)
| (cName, expr, addToGroupBy) <- factSelExprs ++ dimSelExprs ] | (cName, expr, addToGroupBy) <- factSelExprs ++ dimSelExprs ]
factColumnSelectExprs :: Fact -> Reader Env [(ColumnName, ScalarExpr, Bool)] factColumnSelectExprs :: Fact -> Reader Config [(ColumnName, ScalarExpr, Bool)]
factColumnSelectExprs fact = do factColumnSelectExprs fact = do
Settings {..} <- asks envSettings Settings {..} <- asks configSettings
tables <- asks envTables tables <- asks configTables
typeDefaults <- asks envTypeDefaults typeDefaults <- asks configTypeDefaults
let fTableName = factTableName fact let fTableName = factTableName fact
fTable = fromJust . findTable fTableName $ tables fTable = fromJust . findTable fTableName $ tables
dimIdColName = settingDimTableIdColumnName dimIdColName = settingDimTableIdColumnName
@ -135,11 +135,11 @@ dimIdColumnSelectExpr fTableName fTable typeDefaults cName =
let sCol = fromJust . findColumn cName $ tableColumns fTable let sCol = fromJust . findColumn cName $ tableColumns fTable
in (cName, coalesceColumn typeDefaults fTableName sCol, True) in (cName, coalesceColumn typeDefaults fTableName sCol, True)
dimColumnSelectExprs :: TablePopulationMode -> [(Fact, Table)] -> Reader Env [(ColumnName, ScalarExpr, Bool)] dimColumnSelectExprs :: TablePopulationMode -> [(Fact, Table)] -> Reader Config [(ColumnName, ScalarExpr, Bool)]
dimColumnSelectExprs popMode allDims = do dimColumnSelectExprs popMode allDims = do
settings@Settings {..} <- asks envSettings settings@Settings {..} <- asks configSettings
tables <- asks envTables tables <- asks configTables
typeDefaults <- asks envTypeDefaults typeDefaults <- asks configTypeDefaults
let dimIdColName = settingDimTableIdColumnName let dimIdColName = settingDimTableIdColumnName
return $ for allDims $ \(dimFact, factTable@Table {tableName}) -> let return $ for allDims $ \(dimFact, factTable@Table {tableName}) -> let
@ -172,10 +172,10 @@ populateQueryExpr :: TablePopulationMode
-> [(Fact, Table)] -> [(Fact, Table)]
-> [(ColumnName, (ScalarExpr, NameComponent), Bool)] -> [(ColumnName, (ScalarExpr, NameComponent), Bool)]
-> Text -> Text
-> Reader Env QueryExpr -> Reader Config QueryExpr
populateQueryExpr popMode fact allDims selExprs groupByColPrefix = do populateQueryExpr popMode fact allDims selExprs groupByColPrefix = do
Settings {..} <- asks envSettings Settings {..} <- asks configSettings
tables <- asks envTables tables <- asks configTables
let fTableName = factTableName fact let fTableName = factTableName fact
fTable = fromJust . findTable fTableName $ tables fTable = fromJust . findTable fTableName $ tables
joinClauses = joinClauses =

View File

@ -23,10 +23,10 @@ import Ringo.Generator.Internal
import Ringo.Generator.Sql import Ringo.Generator.Sql
import Ringo.Types.Internal import Ringo.Types.Internal
factCountDistinctUpdateStatements :: TablePopulationMode -> Fact -> Text -> QueryExpr -> Reader Env [Statement] factCountDistinctUpdateStatements :: TablePopulationMode -> Fact -> Text -> QueryExpr -> Reader Config [Statement]
factCountDistinctUpdateStatements popMode fact groupByColPrefix expr = case expr of factCountDistinctUpdateStatements popMode fact groupByColPrefix expr = case expr of
select@Select {..} -> do select@Select {..} -> do
Settings {..} <- asks envSettings Settings {..} <- asks configSettings
let extFactTableName = let extFactTableName =
suffixTableName popMode settingTableNameSuffixTemplate suffixTableName popMode settingTableNameSuffixTemplate
$ extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit $ extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
@ -56,11 +56,11 @@ factCountDistinctUpdateStatements popMode fact groupByColPrefix expr = case expr
_ -> return [] _ -> return []
queryExpr :: Fact -> ColumnName -> Maybe ColumnName -> [ColumnName] -> QueryExpr -> Reader Env QueryExpr queryExpr :: Fact -> ColumnName -> Maybe ColumnName -> [ColumnName] -> QueryExpr -> Reader Config QueryExpr
queryExpr fact targetCol sourceCol groupByCols select = case select of queryExpr fact targetCol sourceCol groupByCols select = case select of
Select {selSelectList = SelectList _ origSelectItems, ..} -> do Select {selSelectList = SelectList _ origSelectItems, ..} -> do
Settings {..} <- asks envSettings Settings {..} <- asks configSettings
tables <- asks envTables tables <- asks configTables
let fTableName = factTableName fact let fTableName = factTableName fact
fTable = fromJust . findTable fTableName $ tables fTable = fromJust . findTable fTableName $ tables
@ -78,9 +78,9 @@ queryExpr fact targetCol sourceCol groupByCols select = case select of
_ -> error "Must be a Select" _ -> error "Must be a Select"
bucketSelectItems :: ColumnName -> ScalarExpr -> Reader Env [SelectItem] bucketSelectItems :: ColumnName -> ScalarExpr -> Reader Config [SelectItem]
bucketSelectItems targetCol unqCol = do bucketSelectItems targetCol unqCol = do
Settings {..} <- asks envSettings Settings {..} <- asks configSettings
return [ sia (binop "&" (app "hashtext" [ unqCol ]) return [ sia (binop "&" (app "hashtext" [ unqCol ])
(num . Text.pack . show $ bucketCount settingFactCountDistinctErrorRate - 1)) (num . Text.pack . show $ bucketCount settingFactCountDistinctErrorRate - 1))

View File

@ -18,11 +18,11 @@ module Ringo.Types
, TimeUnit(..) , TimeUnit(..)
, timeUnitName , timeUnitName
, timeUnitToSeconds , timeUnitToSeconds
, Env , Config
, envTables , configTables
, envFacts , configFacts
, envSettings , configSettings
, envTypeDefaults , configTypeDefaults
, Settings(..) , Settings(..)
, defSettings , defSettings
, TypeDefaults , TypeDefaults

View File

@ -403,27 +403,27 @@ defSettings = Settings
, settingTableNameSuffixTemplate = "{{suff}}" , settingTableNameSuffixTemplate = "{{suff}}"
} }
-- | Errors possible while validating the environment -- | Errors possible while validating the config
data ValidationError = data ValidationError =
-- | When referencing a table which is missing from the env -- | When referencing a table which is missing from the config
MissingTable !TableName MissingTable !TableName
-- | When referencing a fact which is missing from the env -- | When referencing a fact which is missing from the config
| MissingFact !TableName | MissingFact !TableName
-- | When referencing a column which is missing from the env -- | When referencing a column which is missing from the config
| MissingColumn !TableName !ColumnName | MissingColumn !TableName !ColumnName
-- | When a fact has no 'DimTime' columns -- | When a fact has no 'DimTime' columns
| MissingTimeColumn !TableName | MissingTimeColumn !TableName
-- | When a 'DimTime' fact column of a fact is nullable -- | When a 'DimTime' fact column of a fact is nullable
| MissingNotNullConstraint !TableName !ColumnName | MissingNotNullConstraint !TableName !ColumnName
-- | When the default value of a type is missing from the env -- | When the default value of a type is missing from the config
| MissingTypeDefault !Text | MissingTypeDefault !Text
-- | When there are multiple tables with the same name in the env -- | When there are multiple tables with the same name in the config
| DuplicateTable !TableName | DuplicateTable !TableName
-- | When there are multiple facts with the same name in the env -- | When there are multiple facts with the same name in the config
| DuplicateFact !TableName | DuplicateFact !TableName
-- | When there are multiple columns with the same name in a table in the env -- | When there are multiple columns with the same name in a table in the config
| DuplicateColumn !TableName !ColumnName | DuplicateColumn !TableName !ColumnName
-- | When there are multiple dimensions with the same name in the env -- | When there are multiple dimensions with the same name in the config
| DuplicateDimension !TableName | DuplicateDimension !TableName
deriving (Eq, Show) deriving (Eq, Show)
@ -431,29 +431,29 @@ data ValidationError =
-- the generated dimension and fact tables -- the generated dimension and fact tables
type TypeDefaults = Map Text Text type TypeDefaults = Map Text Text
-- | The environment for the library to compute in -- | The config for the library
data Env = Env data Config = Config
{ _envTables :: ![Table] { _configTables :: ![Table]
, _envFacts :: ![Fact] , _configFacts :: ![Fact]
, _envSettings :: !Settings , _configSettings :: !Settings
, _envTypeDefaults :: !TypeDefaults , _configTypeDefaults :: !TypeDefaults
} deriving (Show) } deriving (Show)
-- | Return the list of source tables from the env -- | Return the list of source tables from the config
envTables :: Env -> [Table] configTables :: Config -> [Table]
envTables = _envTables configTables = _configTables
-- | Return the list of facts to be generated from the env -- | Return the list of facts to be generated from the config
envFacts :: Env -> [Fact] configFacts :: Config -> [Fact]
envFacts = _envFacts configFacts = _configFacts
-- | Return the settings from the env -- | Return the settings from the config
envSettings :: Env -> Settings configSettings :: Config -> Settings
envSettings = _envSettings configSettings = _configSettings
-- | Return the defaults for the SQL types from the env -- | Return the defaults for the SQL types from the config
envTypeDefaults :: Env -> TypeDefaults configTypeDefaults :: Config -> TypeDefaults
envTypeDefaults = _envTypeDefaults configTypeDefaults = _configTypeDefaults
-- | The mode for population of the generated tables; used to switch the SQL for table population -- | The mode for population of the generated tables; used to switch the SQL for table population
data TablePopulationMode = FullPopulation -- ^ Populating the tables fully, starting with empty ones data TablePopulationMode = FullPopulation -- ^ Populating the tables fully, starting with empty ones

View File

@ -4,7 +4,7 @@
{-# LANGUAGE GADTs #-} {-# LANGUAGE GADTs #-}
{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PatternSynonyms #-}
module Ringo.Validator (validateEnv) where module Ringo.Validator (validateConfig) where
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Text as Text import qualified Data.Text as Text
@ -24,9 +24,9 @@ checkTableForCol tab colName =
[ MissingColumn (tableName tab) colName | [ MissingColumn (tableName tab) colName |
not . any ((colName ==) . columnName) . tableColumns $ tab ] not . any ((colName ==) . columnName) . tableColumns $ tab ]
validateTable :: Table -> Reader Env [ValidationError] validateTable :: Table -> Reader Config [ValidationError]
validateTable table = do validateTable table = do
Env tables _ _ _ <- ask Config tables _ _ _ <- ask
return . concatMap (checkConstraint tables) . tableConstraints $ table return . concatMap (checkConstraint tables) . tableConstraints $ table
where where
checkConstraint _ (PrimaryKey colName) = checkTableForCol table colName checkConstraint _ (PrimaryKey colName) = checkTableForCol table colName
@ -39,9 +39,9 @@ validateTable table = do
checkTableForColRefs tab = concatMap (checkTableForCol tab) checkTableForColRefs tab = concatMap (checkTableForCol tab)
validateFact :: Fact -> Reader Env [ValidationError] validateFact :: Fact -> Reader Config [ValidationError]
validateFact Fact {..} = do validateFact Fact {..} = do
Env tables _ _ typeDefaults <- ask Config tables _ _ typeDefaults <- ask
let defaults = Map.keys typeDefaults let defaults = Map.keys typeDefaults
case findTable factTableName tables of case findTable factTableName tables of
Nothing -> return [ MissingTable factTableName ] Nothing -> return [ MissingTable factTableName ]
@ -70,7 +70,7 @@ validateFact Fact {..} = do
return $ tableVs ++ parentVs ++ colVs ++ timeVs ++ notNullVs ++ typeDefaultVs return $ tableVs ++ parentVs ++ colVs ++ timeVs ++ notNullVs ++ typeDefaultVs
where where
checkFactParents fName = do checkFactParents fName = do
Env _ facts _ _ <- ask Config _ facts _ _ <- ask
case findFact fName facts of case findFact fName facts of
Nothing -> return [ MissingFact fName ] Nothing -> return [ MissingFact fName ]
Just pFact -> validateFact pFact Just pFact -> validateFact pFact
@ -84,10 +84,10 @@ validateFact Fact {..} = do
DimId {factColTargetTable = tName} -> maybe [ MissingTable tName ] (const []) $ findTable tName tables DimId {factColTargetTable = tName} -> maybe [ MissingTable tName ] (const []) $ findTable tName tables
_ -> [] _ -> []
validateEnv :: [Table] -> [Fact] -> Settings -> TypeDefaults -> Either [ValidationError] Env validateConfig :: [Table] -> [Fact] -> Settings -> TypeDefaults -> Either [ValidationError] Config
validateEnv tables facts settings@Settings {..} typeDefaults = let validateConfig tables facts settings@Settings {..} typeDefaults = let
env = Env tables facts settings typeDefaults config = Config tables facts settings typeDefaults
in flip runReader env $ do in flip runReader config $ do
tableVs <- concat <$> mapM validateTable tables tableVs <- concat <$> mapM validateTable tables
factVs <- concat <$> mapM validateFact facts factVs <- concat <$> mapM validateFact facts
let dupTableVs = [ DuplicateTable table | table <- findDups . map tableName $ tables ] let dupTableVs = [ DuplicateTable table | table <- findDups . map tableName $ tables ]
@ -103,7 +103,7 @@ validateEnv tables facts settings@Settings {..} typeDefaults = let
>>> map (head >>> fst >>> DuplicateDimension) >>> map (head >>> fst >>> DuplicateDimension)
errors = nub $ tableVs ++ factVs ++ dupTableVs ++ dupFactVs ++ dupColVs ++ dupDimVs errors = nub $ tableVs ++ factVs ++ dupTableVs ++ dupFactVs ++ dupColVs ++ dupDimVs
return $ if null errors return $ if null errors
then Right env then Right config
else Left errors else Left errors
where where
findDups = findDups =