Refactors ringo app to simplify the code.
parent
57e76321a1
commit
d106a19d22
|
@ -1,8 +1,11 @@
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
|
||||||
module Distribution.CurrentPackageDescription
|
module Distribution.CurrentPackageDescription
|
||||||
( currentPackageDescription
|
( currentPackageDescription
|
||||||
, getField
|
, getField
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Prelude.Compat
|
||||||
import Distribution.PackageDescription
|
import Distribution.PackageDescription
|
||||||
import Distribution.PackageDescription.Parse
|
import Distribution.PackageDescription.Parse
|
||||||
import Distribution.Verbosity
|
import Distribution.Verbosity
|
||||||
|
@ -18,12 +21,10 @@ getField f = runIO currentPackageDescription >>= stringE . f
|
||||||
currentPackageDescription :: IO PackageDescription
|
currentPackageDescription :: IO PackageDescription
|
||||||
currentPackageDescription = fmap packageDescription $ do
|
currentPackageDescription = fmap packageDescription $ do
|
||||||
dir <- getCurrentDirectory
|
dir <- getCurrentDirectory
|
||||||
cs <- cabalFiles dir
|
cs <- cabalFiles dir
|
||||||
case cs of
|
case cs of
|
||||||
(c:_) -> readPackageDescription silent c
|
(c:_) -> readPackageDescription silent c
|
||||||
[] -> error $ "Couldn't find a cabal file in the current working directory (" ++ dir ++ ")"
|
[] -> error $ "Couldn't find a cabal file in the current working directory (" ++ dir ++ ")"
|
||||||
|
|
||||||
cabalFiles :: FilePath -> IO [FilePath]
|
cabalFiles :: FilePath -> IO [FilePath]
|
||||||
cabalFiles dir = do
|
cabalFiles dir = filter (".cabal" `isSuffixOf`) <$> getDirectoryContents dir
|
||||||
files <- getDirectoryContents dir
|
|
||||||
return $ filter (".cabal" `isSuffixOf`) files
|
|
||||||
|
|
|
@ -35,7 +35,7 @@ writeFiles :: FilePath -> Env -> IO ()
|
||||||
writeFiles outputDir env = do
|
writeFiles outputDir env = do
|
||||||
let Settings{..} = envSettings env
|
let Settings{..} = envSettings env
|
||||||
|
|
||||||
forM_ sqls $ \(sqlType, table, sql) -> do
|
forM_ (makeSQLs env 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
|
||||||
|
@ -50,7 +50,6 @@ 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 = envFacts env
|
||||||
tables = envTables env
|
tables = envTables env
|
||||||
|
@ -58,13 +57,17 @@ writeFiles outputDir env = do
|
||||||
dimTables = [ (fact, extractDimensionTables env fact) | fact <- facts ]
|
dimTables = [ (fact, extractDimensionTables env fact) | fact <- facts ]
|
||||||
factTables = [ (fact, extractFactTable env fact) | fact <- facts, factTablePersistent fact ]
|
factTables = [ (fact, extractFactTable env fact) | fact <- facts, factTablePersistent fact ]
|
||||||
|
|
||||||
dimTableDefinitionSQLs = [ (Create, tableName table, unlines . map sqlStr $ dimensionTableDefinitionSQL env table)
|
makeSQLs :: Env -> [(Fact, [Table])] -> [(Fact, Table)] -> [(SQLType, TableName, String)]
|
||||||
| (_, tabs) <- dimTables
|
makeSQLs env dimTables factTables = let
|
||||||
, table <- tabs
|
dimTableDefinitionSQLs =
|
||||||
, table `notElem` tables ]
|
[ (Create, tableName table, unlines . map sqlStr $ dimensionTableDefinitionSQL env table)
|
||||||
|
| (_, tabs) <- dimTables
|
||||||
|
, table <- tabs
|
||||||
|
, table `notElem` tables ]
|
||||||
|
|
||||||
factTableDefinitionSQLs = [ (Create , tableName table, unlines . map sqlStr $ factTableDefinitionSQL env fact table)
|
factTableDefinitionSQLs =
|
||||||
| (fact, table) <- factTables ]
|
[ (Create , tableName table, unlines . map sqlStr $ factTableDefinitionSQL env fact table)
|
||||||
|
| (fact, table) <- factTables ]
|
||||||
|
|
||||||
dimTablePopulationSQLs typ gen =
|
dimTablePopulationSQLs typ gen =
|
||||||
[ (typ , tableName table, sqlStr $ gen env fact (tableName table))
|
[ (typ , tableName table, sqlStr $ gen env fact (tableName table))
|
||||||
|
@ -74,13 +77,13 @@ writeFiles outputDir env = do
|
||||||
|
|
||||||
factTablePopulationSQLs typ gen = [ (typ, tableName table, unlines . map sqlStr $ gen env fact)
|
factTablePopulationSQLs typ gen = [ (typ, tableName table, unlines . map sqlStr $ gen env fact)
|
||||||
| (fact, table) <- factTables ]
|
| (fact, table) <- factTables ]
|
||||||
|
in concat [ dimTableDefinitionSQLs
|
||||||
sqls = concat [ dimTableDefinitionSQLs
|
, factTableDefinitionSQLs
|
||||||
, factTableDefinitionSQLs
|
, dimTablePopulationSQLs FullRefresh $ dimensionTablePopulationSQL FullPopulation
|
||||||
, dimTablePopulationSQLs FullRefresh $ dimensionTablePopulationSQL FullPopulation
|
, dimTablePopulationSQLs IncRefresh $ dimensionTablePopulationSQL IncrementalPopulation
|
||||||
, dimTablePopulationSQLs IncRefresh $ dimensionTablePopulationSQL IncrementalPopulation
|
, factTablePopulationSQLs FullRefresh $ factTablePopulationSQL FullPopulation
|
||||||
, factTablePopulationSQLs FullRefresh $ factTablePopulationSQL FullPopulation
|
, factTablePopulationSQLs IncRefresh $ factTablePopulationSQL IncrementalPopulation
|
||||||
, factTablePopulationSQLs IncRefresh $ factTablePopulationSQL IncrementalPopulation
|
]
|
||||||
]
|
where
|
||||||
|
tables = envTables env
|
||||||
sqlStr = Text.unpack
|
sqlStr = Text.unpack
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
|
||||||
module Ringo.ArgParser (ProgArgs(..), parseArgs) where
|
module Ringo.ArgParser (ProgArgs(..), parseArgs) where
|
||||||
|
|
||||||
import qualified Data.Text as Text
|
import qualified Data.Text as Text
|
||||||
|
|
|
@ -21,14 +21,11 @@ instance FromJSON Nullable where
|
||||||
parseJSON o = fail $ "Cannot parse nullable: " ++ show o
|
parseJSON o = fail $ "Cannot parse nullable: " ++ show o
|
||||||
|
|
||||||
instance FromJSON Column where
|
instance FromJSON Column where
|
||||||
parseJSON (Array a) = if V.length a < 2
|
parseJSON (Array a)
|
||||||
then fail "Column needs at least two elements: name and type"
|
| V.length a >= 2 = Column <$> parseJSON (a ! 0)
|
||||||
else do
|
<*> parseJSON (a ! 1)
|
||||||
cName <- parseJSON $ a ! 0
|
<*> parseJSON (fromMaybe "null" (a !? 2))
|
||||||
cType <- parseJSON $ a ! 1
|
| otherwise = fail "Column needs at least two elements: name and type"
|
||||||
cNull <- parseJSON $ fromMaybe "null" (a !? 2)
|
|
||||||
return $ Column cName cType cNull
|
|
||||||
|
|
||||||
parseJSON o = fail $ "Cannot parse column: " ++ show o
|
parseJSON o = fail $ "Cannot parse column: " ++ show o
|
||||||
|
|
||||||
instance FromJSON TableConstraint where
|
instance FromJSON TableConstraint where
|
||||||
|
@ -47,19 +44,20 @@ instance FromJSON Table where
|
||||||
|
|
||||||
instance FromJSON FactColumn where
|
instance FromJSON FactColumn where
|
||||||
parseJSON (Object o) = do
|
parseJSON (Object o) = do
|
||||||
cType <- o .: "type"
|
cType <- o .: "type"
|
||||||
|
let cName = o .: "column"
|
||||||
case cType of
|
case cType of
|
||||||
"dimtime" -> FactColumn <$> o .: "column" <*> pure DimTime
|
"dimtime" -> FactColumn <$> cName <*> pure DimTime
|
||||||
"nodimid" -> FactColumn <$> o .: "column" <*> pure NoDimId
|
"nodimid" -> FactColumn <$> cName <*> pure NoDimId
|
||||||
"tenantid" -> FactColumn <$> o .: "column" <*> pure TenantId
|
"tenantid" -> FactColumn <$> cName <*> pure TenantId
|
||||||
"dimid" -> FactColumn <$> o .: "column" <*> (DimId <$> o .: "table")
|
"dimid" -> FactColumn <$> cName <*> (DimId <$> o .: "table")
|
||||||
"dimval" -> FactColumn <$> o .: "column" <*> (DimVal <$> o .: "table")
|
"dimval" -> FactColumn <$> cName <*> (DimVal <$> o .: "table")
|
||||||
"factcount" -> FactColumn <$> o .: "column" <*> (FactCount <$> o .:? "sourcecolumn")
|
"factcount" -> FactColumn <$> cName <*> (FactCount <$> o .:? "sourcecolumn")
|
||||||
"factcountdistinct" -> FactColumn <$> o .: "column" <*> (FactCountDistinct <$> o .:? "sourcecolumn")
|
"factcountdistinct" -> FactColumn <$> cName <*> (FactCountDistinct <$> o .:? "sourcecolumn")
|
||||||
"factsum" -> FactColumn <$> o .: "column" <*> (FactSum <$> o .: "sourcecolumn")
|
"factsum" -> FactColumn <$> cName <*> (FactSum <$> o .: "sourcecolumn")
|
||||||
"factaverage" -> FactColumn <$> o .: "column" <*> (FactAverage <$> o .: "sourcecolumn")
|
"factaverage" -> FactColumn <$> cName <*> (FactAverage <$> o .: "sourcecolumn")
|
||||||
"factmax" -> FactColumn <$> o .: "column" <*> (FactMax <$> o .: "sourcecolumn")
|
"factmax" -> FactColumn <$> cName <*> (FactMax <$> o .: "sourcecolumn")
|
||||||
"factmin" -> FactColumn <$> o .: "column" <*> (FactMin <$> o .: "sourcecolumn")
|
"factmin" -> FactColumn <$> cName <*> (FactMin <$> o .: "sourcecolumn")
|
||||||
_ -> fail $ "Invalid fact column type: " ++ cType
|
_ -> fail $ "Invalid fact column type: " ++ cType
|
||||||
parseJSON o = fail $ "Cannot parse fact column: " ++ show o
|
parseJSON o = fail $ "Cannot parse fact column: " ++ show o
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue