Removes EnvV from Types to simplify the code.
parent
ade13f767b
commit
29bafea95b
|
@ -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 ]
|
||||
|
|
|
@ -1,5 +1,4 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Ringo.InputParser (parseInput) where
|
||||
|
|
|
@ -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 =
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
Loading…
Reference in New Issue