2016-01-01 20:57:54 +05:30
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
{-# LANGUAGE RecordWildCards #-}
|
2016-02-05 16:17:57 +05:30
|
|
|
|
2015-12-09 17:11:57 +05:30
|
|
|
module Main where
|
|
|
|
|
2015-12-21 15:30:23 +05:30
|
|
|
import qualified Data.ByteString.Lazy as BS
|
|
|
|
import qualified Data.Map as Map
|
|
|
|
import qualified Data.Text as Text
|
2015-12-17 20:02:13 +05:30
|
|
|
|
2015-12-21 15:30:23 +05:30
|
|
|
import Data.Aeson (encode)
|
2015-12-17 23:17:00 +05:30
|
|
|
import Data.Char (toLower)
|
|
|
|
import Control.Monad (forM_)
|
|
|
|
import System.Directory (createDirectoryIfMissing)
|
|
|
|
import System.FilePath ((</>), (<.>))
|
|
|
|
import System.Exit (exitFailure, exitSuccess)
|
2015-12-17 20:02:13 +05:30
|
|
|
|
2015-12-09 17:11:57 +05:30
|
|
|
import Ringo
|
2015-12-17 20:02:13 +05:30
|
|
|
import Ringo.ArgParser
|
|
|
|
import Ringo.InputParser
|
2015-12-09 17:11:57 +05:30
|
|
|
|
2015-12-19 11:55:08 +05:30
|
|
|
data SQLType = Create | FullRefresh | IncRefresh deriving (Eq, Show)
|
2015-12-17 23:17:00 +05:30
|
|
|
|
2015-12-09 17:11:57 +05:30
|
|
|
main :: IO ()
|
2015-12-17 20:02:13 +05:30
|
|
|
main = do
|
|
|
|
ProgArgs {..} <- parseArgs
|
|
|
|
result <- parseInput progInputFile
|
|
|
|
case result of
|
2015-12-28 19:28:35 +05:30
|
|
|
Left err -> putStrLn err >> exitFailure
|
2016-06-22 17:10:14 +05:30
|
|
|
Right (tables, facts, defaults) ->
|
2016-02-05 16:17:57 +05:30
|
|
|
case makeEnv tables facts progSettings defaults of
|
|
|
|
Left errors -> mapM_ print errors >> exitFailure
|
|
|
|
Right env -> writeFiles progOutputDir env >> exitSuccess
|
2015-12-21 15:30:23 +05:30
|
|
|
|
|
|
|
writeFiles :: FilePath -> Env -> IO ()
|
2016-06-22 17:10:14 +05:30
|
|
|
writeFiles outputDir env = do
|
|
|
|
let Settings{..} = envSettings env
|
|
|
|
|
2016-07-06 20:53:49 +05:30
|
|
|
forM_ (makeSQLs env dimTables factTables) $ \(sqlType, table, sql) -> do
|
2015-12-21 15:30:23 +05:30
|
|
|
let dirName = outputDir </> map toLower (show sqlType)
|
|
|
|
createDirectoryIfMissing True dirName
|
|
|
|
writeFile (dirName </> Text.unpack table <.> "sql") sql
|
|
|
|
|
|
|
|
BS.writeFile (outputDir </> Text.unpack settingDependenciesJSONFileName)
|
|
|
|
. encode
|
|
|
|
. foldl (\acc -> Map.union acc . extractDependencies env) Map.empty
|
2016-06-22 17:10:14 +05:30
|
|
|
$ facts
|
2015-12-21 15:30:23 +05:30
|
|
|
|
2015-12-29 15:19:55 +05:30
|
|
|
BS.writeFile (outputDir </> Text.unpack settingDimensionJSONFileName) . encode $
|
2016-06-22 17:10:14 +05:30
|
|
|
[ tableName table | (_, tabs) <- dimTables, table <- tabs , table `notElem` tables ]
|
2015-12-21 15:30:23 +05:30
|
|
|
|
2015-12-29 15:19:55 +05:30
|
|
|
BS.writeFile (outputDir </> Text.unpack settingFactsJSONFileName) . encode $
|
2015-12-21 15:30:23 +05:30
|
|
|
[ tableName table | (_, table) <- factTables ]
|
2015-12-17 23:17:00 +05:30
|
|
|
where
|
2016-06-22 17:10:14 +05:30
|
|
|
facts = envFacts env
|
|
|
|
tables = envTables env
|
|
|
|
|
|
|
|
dimTables = [ (fact, extractDimensionTables env fact) | fact <- facts ]
|
|
|
|
factTables = [ (fact, extractFactTable env fact) | fact <- facts, factTablePersistent fact ]
|
2015-12-17 20:02:13 +05:30
|
|
|
|
2016-07-06 20:53:49 +05:30
|
|
|
makeSQLs :: Env -> [(Fact, [Table])] -> [(Fact, Table)] -> [(SQLType, TableName, String)]
|
|
|
|
makeSQLs env dimTables factTables = let
|
|
|
|
dimTableDefinitionSQLs =
|
|
|
|
[ (Create, tableName table, unlines . map sqlStr $ dimensionTableDefinitionSQL env table)
|
|
|
|
| (_, tabs) <- dimTables
|
|
|
|
, table <- tabs
|
|
|
|
, table `notElem` tables ]
|
2015-12-19 11:55:08 +05:30
|
|
|
|
2016-07-06 20:53:49 +05:30
|
|
|
factTableDefinitionSQLs =
|
|
|
|
[ (Create , tableName table, unlines . map sqlStr $ factTableDefinitionSQL env fact table)
|
|
|
|
| (fact, table) <- factTables ]
|
2015-12-17 20:02:13 +05:30
|
|
|
|
2016-07-05 23:09:42 +05:30
|
|
|
dimTablePopulationSQLs typ gen =
|
2015-12-20 18:25:14 +05:30
|
|
|
[ (typ , tableName table, sqlStr $ gen env fact (tableName table))
|
|
|
|
| (fact, tabs) <- dimTables
|
|
|
|
, table <- tabs
|
2016-06-22 17:10:14 +05:30
|
|
|
, table `notElem` tables ]
|
2015-12-17 23:17:00 +05:30
|
|
|
|
2016-07-05 23:09:42 +05:30
|
|
|
factTablePopulationSQLs typ gen = [ (typ, tableName table, unlines . map sqlStr $ gen env fact)
|
|
|
|
| (fact, table) <- factTables ]
|
2016-07-06 20:53:49 +05:30
|
|
|
in concat [ dimTableDefinitionSQLs
|
|
|
|
, factTableDefinitionSQLs
|
|
|
|
, dimTablePopulationSQLs FullRefresh $ dimensionTablePopulationSQL FullPopulation
|
|
|
|
, dimTablePopulationSQLs IncRefresh $ dimensionTablePopulationSQL IncrementalPopulation
|
|
|
|
, factTablePopulationSQLs FullRefresh $ factTablePopulationSQL FullPopulation
|
|
|
|
, factTablePopulationSQLs IncRefresh $ factTablePopulationSQL IncrementalPopulation
|
|
|
|
]
|
|
|
|
where
|
|
|
|
tables = envTables env
|
2016-01-01 17:15:22 +05:30
|
|
|
sqlStr = Text.unpack
|