abhin4v
/
ringo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Refactors ringo app to simplify the code.

Browse Source
master
Abhinav Sarkar 7 years ago
parent 57e76321a1
commit d106a19d22
No known key found for this signature in database
GPG Key ID: 7C9166A6F5465AD5
4 changed files with 45 additions and 42 deletions
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Show Stats Download Patch File Download Diff File
  1. 11
      ringo-app/src/Distribution/CurrentPackageDescription.hs
  2. 37
      ringo-app/src/Main.hs
  3. 1
      ringo-app/src/Ringo/ArgParser.hs
  4. 38
      ringo-app/src/Ringo/InputParser.hs

11
ringo-app/src/Distribution/CurrentPackageDescription.hs
Unescape View File

@ -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

37
ringo-app/src/Main.hs
Unescape View File

@ -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
ringo-app/src/Ringo/ArgParser.hs
Unescape View File

@ -1,6 +1,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
module Ringo.ArgParser (ProgArgs(..), parseArgs) where
import qualified Data.Text as Text

38
ringo-app/src/Ringo/InputParser.hs
Unescape View File

@ -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

Write Preview
Loading…
Cancel
Save