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