Removes EnvV from Types to simplify the code.

pull/1/head
Abhinav Sarkar 2016-06-22 17:10:14 +05:30
parent ade13f767b
commit 29bafea95b
9 changed files with 198 additions and 195 deletions

View File

@ -1,6 +1,5 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Main where
@ -27,14 +26,15 @@ main = do
result <- parseInput progInputFile
case result of
Left err -> putStrLn err >> exitFailure
Right (tables, facts, defaults) -> do
Right (tables, facts, defaults) ->
case makeEnv tables facts progSettings defaults of
Left errors -> mapM_ print errors >> exitFailure
Right env -> writeFiles progOutputDir env >> exitSuccess
writeFiles :: FilePath -> Env -> IO ()
writeFiles outputDir env@(envView -> EnvV{..}) = do
let Settings{..} = envSettings
writeFiles outputDir env = do
let Settings{..} = envSettings env
forM_ sqls $ \(sqlType, table, sql) -> do
let dirName = outputDir </> map toLower (show sqlType)
createDirectoryIfMissing True dirName
@ -43,22 +43,25 @@ writeFiles outputDir env@(envView -> EnvV{..}) = do
BS.writeFile (outputDir </> Text.unpack settingDependenciesJSONFileName)
. encode
. foldl (\acc -> Map.union acc . extractDependencies env) Map.empty
$ envFacts
$ facts
BS.writeFile (outputDir </> Text.unpack settingDimensionJSONFileName) . encode $
[ tableName table | (_, tabs) <- dimTables, table <- tabs , table `notElem` envTables ]
[ tableName table | (_, tabs) <- dimTables, table <- tabs , table `notElem` tables ]
BS.writeFile (outputDir </> Text.unpack settingFactsJSONFileName) . encode $
[ tableName table | (_, table) <- factTables ]
where
dimTables = [ (fact, extractDimensionTables env fact) | fact <- envFacts ]
factTables = [ (fact, extractFactTable env fact) | fact <- envFacts, factTablePersistent fact ]
facts = envFacts env
tables = envTables env
dimTables = [ (fact, extractDimensionTables env fact) | fact <- facts ]
factTables = [ (fact, extractFactTable env fact) | fact <- facts, factTablePersistent fact ]
dimTableDefnSQLs = [ (Create, tableName table, unlines . map sqlStr $ dimensionTableDefnSQL env table)
| (_, tabs) <- dimTables
, table <- tabs
, table `notElem` envTables ]
, table `notElem` tables ]
factTableDefnSQLs = [ (Create , tableName table, unlines . map sqlStr $ factTableDefnSQL env fact table)
| (fact, table) <- factTables ]
@ -67,7 +70,7 @@ writeFiles outputDir env@(envView -> EnvV{..}) = do
[ (typ , tableName table, sqlStr $ gen env fact (tableName table))
| (fact, tabs) <- dimTables
, table <- tabs
, table `notElem` envTables ]
, table `notElem` tables ]
factTablePopulateSQLs typ gen = [ (typ, tableName table, unlines . map sqlStr $ gen env fact)
| (fact, table) <- factTables ]

View File

@ -1,5 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}
module Ringo.InputParser (parseInput) where

View File

@ -11,19 +11,18 @@ module Ringo.Extractor
import qualified Data.Map as Map
import qualified Data.Tree as Tree
import Control.Monad.Reader (Reader, asks, withReader)
import Control.Monad.Reader (Reader, asks)
import Data.Maybe (fromJust)
import Data.Monoid ((<>))
import Data.List (nub)
import Ringo.Extractor.Internal
import Ringo.Types
import Ringo.Types.Internal
import Ringo.Utils
extractFactTable :: Fact -> Reader Env Table
extractFactTable fact = do
allDims <- extractAllDimensionTables fact
withReader envView $ do
Settings {..} <- asks envSettings
tables <- asks envTables
let table = fromJust . findTable (factTableName fact) $ tables
@ -73,7 +72,7 @@ extractFactTable fact = do
}
extractDependencies :: Fact -> Reader Env Dependencies
extractDependencies fact = withReader envView $ do
extractDependencies fact = do
settings@Settings{..} <- asks envSettings
facts <- asks envFacts
let factSourceDeps =

View File

@ -13,14 +13,14 @@ import qualified Data.Text as Text
import Control.Applicative ((<$>))
#endif
import Control.Monad.Reader (Reader, asks, withReader)
import Control.Monad.Reader (Reader, asks)
import Data.Function (on)
import Data.Maybe (mapMaybe, fromMaybe, fromJust, catMaybes)
import Data.Monoid ((<>))
import Data.List (nub, nubBy, find)
import Data.Text (Text)
import Ringo.Types
import Ringo.Types.Internal
findTable :: TableName -> [Table] -> Maybe Table
findTable tName = find ((== tName) . tableName)
@ -59,7 +59,7 @@ idColTypeToFKIdColType typ = case Text.toLower typ of
_ -> typ
extractDimensionTables :: Fact -> Reader Env [Table]
extractDimensionTables fact = withReader envView $ do
extractDimensionTables fact = do
settings <- asks envSettings
tables <- asks envTables
let table = fromJust . findTable (factTableName fact) $ tables
@ -99,5 +99,4 @@ extractAllDimensionTables fact = do
parentDims <- concat <$> mapM extract (factParentNames fact)
return . nubBy ((==) `on` snd) $ myDims ++ parentDims
where
extract fName =
asks (envFacts . envView) >>= extractAllDimensionTables . fromJust . findFact fName
extract fName = asks envFacts >>= extractAllDimensionTables . fromJust . findFact fName

View File

@ -20,11 +20,11 @@ import Data.Text (Text)
import Ringo.Extractor.Internal
import Ringo.Generator.Sql
import Ringo.Types
import Ringo.Types.Internal
import Ringo.Utils
tableDefnStmts :: Table -> Reader Env [Statement]
tableDefnStmts Table {..} = withReader envView $ do
tableDefnStmts Table {..} = do
Settings {..} <- asks envSettings
let tabName = tableName <> settingTableNameSuffixTemplate
@ -58,7 +58,7 @@ dimensionTableDefnSQL :: Table -> Reader Env [Text]
dimensionTableDefnSQL table = tableDefnSQL table dimensionTableIndexStmts
dimensionTableIndexStmts :: Table -> Reader Env [Statement]
dimensionTableIndexStmts Table {..} = withReader envView $do
dimensionTableIndexStmts Table {..} = do
Settings {..} <- asks envSettings
let tabName = tableName <> settingTableNameSuffixTemplate
tablePKColName = head [ cName | PrimaryKey cName <- tableConstraints ]
@ -73,7 +73,6 @@ factTableDefnSQL fact table = tableDefnSQL table (factTableIndexStmts fact)
factTableIndexStmts :: Fact -> Table -> Reader Env [Statement]
factTableIndexStmts fact table = do
allDims <- extractAllDimensionTables fact
withReader envView $ do
Settings {..} <- asks envSettings
tables <- asks envTables

View File

@ -10,7 +10,7 @@ module Ringo.Generator.Populate.Dimension (dimensionTablePopulateSQL) where
import Control.Applicative ((<$>))
#endif
import Control.Monad.Reader (Reader, asks, withReader)
import Control.Monad.Reader (Reader, asks)
import Database.HsSqlPpp.Syntax (Statement, QueryExpr(..), Distinct(..), makeSelect, JoinType(..))
import Data.Maybe (fromJust)
import Data.Text (Text)
@ -18,14 +18,14 @@ import Data.Text (Text)
import Ringo.Extractor.Internal
import Ringo.Generator.Internal
import Ringo.Generator.Sql
import Ringo.Types
import Ringo.Types.Internal
dimensionTablePopulateSQL :: TablePopulationMode -> Fact -> TableName -> Reader Env Text
dimensionTablePopulateSQL popMode fact dimTableName =
ppStatement <$> dimensionTablePopulateStmt popMode fact dimTableName
dimensionTablePopulateStmt :: TablePopulationMode -> Fact -> TableName -> Reader Env Statement
dimensionTablePopulateStmt popMode fact dimTableName = withReader envView $ do
dimensionTablePopulateStmt popMode fact dimTableName = do
Settings {..} <- asks envSettings
tables <- asks envTables
defaults <- asks envTypeDefaults

View File

@ -15,7 +15,7 @@ import qualified Data.Text as Text
import Control.Applicative ((<$>))
#endif
import Control.Monad.Reader (Reader, asks, withReader)
import Control.Monad.Reader (Reader, asks)
import Database.HsSqlPpp.Syntax ( QueryExpr(..), Statement, makeSelect
, SelectList(..), SelectItem(..), JoinType(..) )
import Data.List (nub)
@ -27,7 +27,7 @@ import Text.RawString.QQ (r)
import Ringo.Extractor.Internal
import Ringo.Generator.Internal
import Ringo.Generator.Sql
import Ringo.Types
import Ringo.Types.Internal
import Ringo.Utils
ilog2FunctionString :: Text
@ -56,7 +56,7 @@ $$
LANGUAGE 'plpgsql' IMMUTABLE;
|]
factCountDistinctUpdateStmts :: TablePopulationMode -> Fact -> Text -> QueryExpr -> Reader EnvV [Statement]
factCountDistinctUpdateStmts :: TablePopulationMode -> Fact -> Text -> QueryExpr -> Reader Env [Statement]
factCountDistinctUpdateStmts popMode fact groupByColPrefix expr = case expr of
Select {selSelectList = SelectList _ origSelectItems, ..} -> do
Settings {..} <- asks envSettings
@ -126,7 +126,6 @@ factCountDistinctUpdateStmts popMode fact groupByColPrefix expr = case expr of
factTablePopulateStmts :: TablePopulationMode -> Fact -> Reader Env [Statement]
factTablePopulateStmts popMode fact = do
allDims <- extractAllDimensionTables fact
withReader envView $ do
Settings {..} <- asks envSettings
tables <- asks envTables
defaults <- asks envTypeDefaults

View File

@ -1,8 +1,6 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE StandaloneDeriving #-}
module Ringo.Types
( ColumnName, ColumnType, TableName
@ -11,7 +9,7 @@ module Ringo.Types
, Fact(..), FactColumnType(..), FactColumn(..), factSourceColumnName
, Settings(..), defSettings
, ValidationError(..), TypeDefaults
, Env, EnvV(..), envView
, TablePopulationMode(..), Dependencies) where
, Env, envTables, envFacts, envSettings, envTypeDefaults,
TablePopulationMode(..), Dependencies) where
import Ringo.Types.Internal

View File

@ -168,17 +168,24 @@ data ValidationError = MissingTable !TableName
type TypeDefaults = Map Text Text
data Env = Env ![Table] ![Fact] !Settings !TypeDefaults
data EnvV = EnvV
{ envTables :: ![Table]
, envFacts :: ![Fact]
, envSettings :: !Settings
, envTypeDefaults :: !TypeDefaults
data Env = Env
{ _envTables :: ![Table]
, _envFacts :: ![Fact]
, _envSettings :: !Settings
, _envTypeDefaults :: !TypeDefaults
} deriving (Show)
envView :: Env -> EnvV
envView (Env tables facts settings typeDefaults) = EnvV tables facts settings typeDefaults
envTables :: Env -> [Table]
envTables = _envTables
envFacts :: Env -> [Fact]
envFacts = _envFacts
envSettings :: Env -> Settings
envSettings = _envSettings
envTypeDefaults :: Env -> TypeDefaults
envTypeDefaults = _envTypeDefaults
data TablePopulationMode = FullPopulation | IncrementalPopulation deriving (Eq, Show)