Renames Env to Config.
parent
80bd3fdd9b
commit
f968612f36
|
@ -19,3 +19,4 @@ cabal.sandbox.config
|
||||||
*.prof
|
*.prof
|
||||||
*.aux
|
*.aux
|
||||||
*.hp
|
*.hp
|
||||||
|
tags
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 ]
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 ]
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 =
|
||||||
|
|
|
@ -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))
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 =
|
||||||
|
|
Loading…
Reference in New Issue