|
|
|
@ -2,13 +2,20 @@ module Main where |
|
|
|
|
|
|
|
|
|
import qualified Data.Text as Text |
|
|
|
|
|
|
|
|
|
import Data.List (nub) |
|
|
|
|
import System.Exit (exitFailure, exitSuccess) |
|
|
|
|
import Data.Char (toLower) |
|
|
|
|
import Data.List (nub) |
|
|
|
|
import Data.Monoid ((<>)) |
|
|
|
|
import Control.Monad (forM_) |
|
|
|
|
import System.Directory (createDirectoryIfMissing) |
|
|
|
|
import System.FilePath ((</>), (<.>)) |
|
|
|
|
import System.Exit (exitFailure, exitSuccess) |
|
|
|
|
|
|
|
|
|
import Ringo |
|
|
|
|
import Ringo.ArgParser |
|
|
|
|
import Ringo.InputParser |
|
|
|
|
|
|
|
|
|
data SQLType = Create | Populate | Update deriving (Eq, Show) |
|
|
|
|
|
|
|
|
|
main :: IO () |
|
|
|
|
main = do |
|
|
|
|
ProgArgs {..} <- parseArgs |
|
|
|
@ -19,21 +26,41 @@ main = do |
|
|
|
|
let env = Env tables facts progSettings |
|
|
|
|
let errors = nub $ concatMap (validateTable env) tables ++ concatMap (validateFact env) facts |
|
|
|
|
if not $ null errors |
|
|
|
|
then mapM print errors >> exitFailure |
|
|
|
|
else do |
|
|
|
|
let dimTables = map (\fact -> (fact, extractDimensionTables env fact)) facts |
|
|
|
|
factTables = map (\fact -> (fact, extractFactTable env fact)) facts |
|
|
|
|
then mapM_ print errors >> exitFailure |
|
|
|
|
else writeSQLFiles progOutputDir env >> exitSuccess |
|
|
|
|
|
|
|
|
|
dimTableDefnSQLs = [ tabDefnSQL table | (fact, tabs) <- dimTables |
|
|
|
|
, table <- tabs |
|
|
|
|
, table `notElem` tables ] |
|
|
|
|
factTableDefnSQLs = [ tabDefnSQL table | (fact, table) <- factTables ] |
|
|
|
|
writeSQLFiles :: FilePath -> Env -> IO () |
|
|
|
|
writeSQLFiles outputDir env@Env{..} = forM_ sqls $ \(sqlType, table, sql) -> do |
|
|
|
|
let dirName = outputDir </> map toLower (show sqlType) |
|
|
|
|
fileName = dirName </> Text.unpack table <.> "sql" |
|
|
|
|
createDirectoryIfMissing True dirName |
|
|
|
|
writeFile fileName sql |
|
|
|
|
where |
|
|
|
|
dimTables = map (\fact -> (fact, extractDimensionTables env fact)) envFacts |
|
|
|
|
factTables = map (\fact -> (fact, extractFactTable env fact)) envFacts |
|
|
|
|
|
|
|
|
|
mapM_ putStrLn dimTableDefnSQLs |
|
|
|
|
mapM_ putStrLn factTableDefnSQLs |
|
|
|
|
dimTableDefnSQLs = [ (Create, tableName table, tabDefnSQL table) |
|
|
|
|
| (_, tabs) <- dimTables |
|
|
|
|
, table <- tabs |
|
|
|
|
, table `notElem` envTables ] |
|
|
|
|
factTableDefnSQLs = [ (Create, tableName table, tabDefnSQL table) |
|
|
|
|
| (_, table) <- factTables ] |
|
|
|
|
|
|
|
|
|
exitSuccess |
|
|
|
|
where |
|
|
|
|
toSQL = Text.unpack . flip Text.snoc ';' |
|
|
|
|
tabDefnSQL = unlines . map toSQL . tableDefnSQL |
|
|
|
|
dimTableInsertSQLs = [ (Populate |
|
|
|
|
, tableName table |
|
|
|
|
, sqlStr $ dimensionTableInsertSQL env fact (tableName table)) |
|
|
|
|
| (fact, tabs) <- dimTables |
|
|
|
|
, table <- tabs |
|
|
|
|
, table `notElem` envTables ] |
|
|
|
|
|
|
|
|
|
fctTableInsertSQLs = [ (Populate, tableName table, sqlStr $ factTableInsertSQL env fact) |
|
|
|
|
| (fact, table) <- factTables ] |
|
|
|
|
|
|
|
|
|
sqls = concat [ dimTableDefnSQLs |
|
|
|
|
, factTableDefnSQLs |
|
|
|
|
, dimTableInsertSQLs |
|
|
|
|
, fctTableInsertSQLs |
|
|
|
|
] |
|
|
|
|
|
|
|
|
|
sqlStr s = Text.unpack $ s <> ";\n" |
|
|
|
|
tabDefnSQL = unlines . map sqlStr . tableDefnSQL |
|
|
|
|