From d106a19d22ccc308f9fd2eedaa4662ba49248a45 Mon Sep 17 00:00:00 2001 From: Abhinav Sarkar Date: Wed, 6 Jul 2016 20:53:49 +0530 Subject: [PATCH] Refactors ringo app to simplify the code. --- .../Distribution/CurrentPackageDescription.hs | 11 +++--- ringo-app/src/Main.hs | 37 +++++++++--------- ringo-app/src/Ringo/ArgParser.hs | 1 + ringo-app/src/Ringo/InputParser.hs | 38 +++++++++---------- 4 files changed, 45 insertions(+), 42 deletions(-) diff --git a/ringo-app/src/Distribution/CurrentPackageDescription.hs b/ringo-app/src/Distribution/CurrentPackageDescription.hs index 08263aa..be17f0b 100644 --- a/ringo-app/src/Distribution/CurrentPackageDescription.hs +++ b/ringo-app/src/Distribution/CurrentPackageDescription.hs @@ -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 diff --git a/ringo-app/src/Main.hs b/ringo-app/src/Main.hs index 20336d8..21921e9 100644 --- a/ringo-app/src/Main.hs +++ b/ringo-app/src/Main.hs @@ -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 diff --git a/ringo-app/src/Ringo/ArgParser.hs b/ringo-app/src/Ringo/ArgParser.hs index a6c80d7..b82162c 100644 --- a/ringo-app/src/Ringo/ArgParser.hs +++ b/ringo-app/src/Ringo/ArgParser.hs @@ -1,6 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} + module Ringo.ArgParser (ProgArgs(..), parseArgs) where import qualified Data.Text as Text diff --git a/ringo-app/src/Ringo/InputParser.hs b/ringo-app/src/Ringo/InputParser.hs index aa43d90..549e8d0 100644 --- a/ringo-app/src/Ringo/InputParser.hs +++ b/ringo-app/src/Ringo/InputParser.hs @@ -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