Removes EnvV from Types to simplify the code.
parent
ade13f767b
commit
29bafea95b
|
@ -1,6 +1,5 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
{-# LANGUAGE ViewPatterns #-}
|
|
||||||
|
|
||||||
module Main where
|
module Main where
|
||||||
|
|
||||||
|
@ -27,14 +26,15 @@ main = do
|
||||||
result <- parseInput progInputFile
|
result <- parseInput progInputFile
|
||||||
case result of
|
case result of
|
||||||
Left err -> putStrLn err >> exitFailure
|
Left err -> putStrLn err >> exitFailure
|
||||||
Right (tables, facts, defaults) -> do
|
Right (tables, facts, defaults) ->
|
||||||
case makeEnv tables facts progSettings defaults of
|
case makeEnv tables facts progSettings defaults of
|
||||||
Left errors -> mapM_ print errors >> exitFailure
|
Left errors -> mapM_ print errors >> exitFailure
|
||||||
Right env -> writeFiles progOutputDir env >> exitSuccess
|
Right env -> writeFiles progOutputDir env >> exitSuccess
|
||||||
|
|
||||||
writeFiles :: FilePath -> Env -> IO ()
|
writeFiles :: FilePath -> Env -> IO ()
|
||||||
writeFiles outputDir env@(envView -> EnvV{..}) = do
|
writeFiles outputDir env = do
|
||||||
let Settings{..} = envSettings
|
let Settings{..} = envSettings env
|
||||||
|
|
||||||
forM_ sqls $ \(sqlType, table, sql) -> do
|
forM_ sqls $ \(sqlType, table, sql) -> do
|
||||||
let dirName = outputDir </> map toLower (show sqlType)
|
let dirName = outputDir </> map toLower (show sqlType)
|
||||||
createDirectoryIfMissing True dirName
|
createDirectoryIfMissing True dirName
|
||||||
|
@ -43,22 +43,25 @@ writeFiles outputDir env@(envView -> EnvV{..}) = do
|
||||||
BS.writeFile (outputDir </> Text.unpack settingDependenciesJSONFileName)
|
BS.writeFile (outputDir </> Text.unpack settingDependenciesJSONFileName)
|
||||||
. encode
|
. encode
|
||||||
. foldl (\acc -> Map.union acc . extractDependencies env) Map.empty
|
. foldl (\acc -> Map.union acc . extractDependencies env) Map.empty
|
||||||
$ envFacts
|
$ facts
|
||||||
|
|
||||||
BS.writeFile (outputDir </> Text.unpack settingDimensionJSONFileName) . encode $
|
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 $
|
BS.writeFile (outputDir </> Text.unpack settingFactsJSONFileName) . encode $
|
||||||
[ tableName table | (_, table) <- factTables ]
|
[ tableName table | (_, table) <- factTables ]
|
||||||
|
|
||||||
where
|
where
|
||||||
dimTables = [ (fact, extractDimensionTables env fact) | fact <- envFacts ]
|
facts = envFacts env
|
||||||
factTables = [ (fact, extractFactTable env fact) | fact <- envFacts, factTablePersistent fact ]
|
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)
|
dimTableDefnSQLs = [ (Create, tableName table, unlines . map sqlStr $ dimensionTableDefnSQL env table)
|
||||||
| (_, tabs) <- dimTables
|
| (_, tabs) <- dimTables
|
||||||
, table <- tabs
|
, table <- tabs
|
||||||
, table `notElem` envTables ]
|
, table `notElem` tables ]
|
||||||
|
|
||||||
factTableDefnSQLs = [ (Create , tableName table, unlines . map sqlStr $ factTableDefnSQL env fact table)
|
factTableDefnSQLs = [ (Create , tableName table, unlines . map sqlStr $ factTableDefnSQL env fact table)
|
||||||
| (fact, table) <- factTables ]
|
| (fact, table) <- factTables ]
|
||||||
|
@ -67,7 +70,7 @@ writeFiles outputDir env@(envView -> EnvV{..}) = do
|
||||||
[ (typ , tableName table, sqlStr $ gen env fact (tableName table))
|
[ (typ , tableName table, sqlStr $ gen env fact (tableName table))
|
||||||
| (fact, tabs) <- dimTables
|
| (fact, tabs) <- dimTables
|
||||||
, table <- tabs
|
, table <- tabs
|
||||||
, table `notElem` envTables ]
|
, table `notElem` tables ]
|
||||||
|
|
||||||
factTablePopulateSQLs typ gen = [ (typ, tableName table, unlines . map sqlStr $ gen env fact)
|
factTablePopulateSQLs typ gen = [ (typ, tableName table, unlines . map sqlStr $ gen env fact)
|
||||||
| (fact, table) <- factTables ]
|
| (fact, table) <- factTables ]
|
||||||
|
|
|
@ -1,5 +1,4 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
|
||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
|
|
||||||
module Ringo.InputParser (parseInput) where
|
module Ringo.InputParser (parseInput) where
|
||||||
|
|
|
@ -11,19 +11,18 @@ module Ringo.Extractor
|
||||||
import qualified Data.Map as Map
|
import qualified Data.Map as Map
|
||||||
import qualified Data.Tree as Tree
|
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.Maybe (fromJust)
|
||||||
import Data.Monoid ((<>))
|
import Data.Monoid ((<>))
|
||||||
import Data.List (nub)
|
import Data.List (nub)
|
||||||
|
|
||||||
import Ringo.Extractor.Internal
|
import Ringo.Extractor.Internal
|
||||||
import Ringo.Types
|
import Ringo.Types.Internal
|
||||||
import Ringo.Utils
|
import Ringo.Utils
|
||||||
|
|
||||||
extractFactTable :: Fact -> Reader Env Table
|
extractFactTable :: Fact -> Reader Env Table
|
||||||
extractFactTable fact = do
|
extractFactTable fact = do
|
||||||
allDims <- extractAllDimensionTables fact
|
allDims <- extractAllDimensionTables fact
|
||||||
withReader envView $ do
|
|
||||||
Settings {..} <- asks envSettings
|
Settings {..} <- asks envSettings
|
||||||
tables <- asks envTables
|
tables <- asks envTables
|
||||||
let table = fromJust . findTable (factTableName fact) $ tables
|
let table = fromJust . findTable (factTableName fact) $ tables
|
||||||
|
@ -73,7 +72,7 @@ extractFactTable fact = do
|
||||||
}
|
}
|
||||||
|
|
||||||
extractDependencies :: Fact -> Reader Env Dependencies
|
extractDependencies :: Fact -> Reader Env Dependencies
|
||||||
extractDependencies fact = withReader envView $ do
|
extractDependencies fact = do
|
||||||
settings@Settings{..} <- asks envSettings
|
settings@Settings{..} <- asks envSettings
|
||||||
facts <- asks envFacts
|
facts <- asks envFacts
|
||||||
let factSourceDeps =
|
let factSourceDeps =
|
||||||
|
|
|
@ -13,14 +13,14 @@ import qualified Data.Text as Text
|
||||||
import Control.Applicative ((<$>))
|
import Control.Applicative ((<$>))
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
import Control.Monad.Reader (Reader, asks, withReader)
|
import Control.Monad.Reader (Reader, asks)
|
||||||
import Data.Function (on)
|
import Data.Function (on)
|
||||||
import Data.Maybe (mapMaybe, fromMaybe, fromJust, catMaybes)
|
import Data.Maybe (mapMaybe, fromMaybe, fromJust, catMaybes)
|
||||||
import Data.Monoid ((<>))
|
import Data.Monoid ((<>))
|
||||||
import Data.List (nub, nubBy, find)
|
import Data.List (nub, nubBy, find)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
|
|
||||||
import Ringo.Types
|
import Ringo.Types.Internal
|
||||||
|
|
||||||
findTable :: TableName -> [Table] -> Maybe Table
|
findTable :: TableName -> [Table] -> Maybe Table
|
||||||
findTable tName = find ((== tName) . tableName)
|
findTable tName = find ((== tName) . tableName)
|
||||||
|
@ -59,7 +59,7 @@ idColTypeToFKIdColType typ = case Text.toLower typ of
|
||||||
_ -> typ
|
_ -> typ
|
||||||
|
|
||||||
extractDimensionTables :: Fact -> Reader Env [Table]
|
extractDimensionTables :: Fact -> Reader Env [Table]
|
||||||
extractDimensionTables fact = withReader envView $ do
|
extractDimensionTables fact = do
|
||||||
settings <- asks envSettings
|
settings <- asks envSettings
|
||||||
tables <- asks envTables
|
tables <- asks envTables
|
||||||
let table = fromJust . findTable (factTableName fact) $ tables
|
let table = fromJust . findTable (factTableName fact) $ tables
|
||||||
|
@ -99,5 +99,4 @@ extractAllDimensionTables fact = do
|
||||||
parentDims <- concat <$> mapM extract (factParentNames fact)
|
parentDims <- concat <$> mapM extract (factParentNames fact)
|
||||||
return . nubBy ((==) `on` snd) $ myDims ++ parentDims
|
return . nubBy ((==) `on` snd) $ myDims ++ parentDims
|
||||||
where
|
where
|
||||||
extract fName =
|
extract fName = asks envFacts >>= extractAllDimensionTables . fromJust . findFact fName
|
||||||
asks (envFacts . envView) >>= extractAllDimensionTables . fromJust . findFact fName
|
|
||||||
|
|
|
@ -20,11 +20,11 @@ import Data.Text (Text)
|
||||||
|
|
||||||
import Ringo.Extractor.Internal
|
import Ringo.Extractor.Internal
|
||||||
import Ringo.Generator.Sql
|
import Ringo.Generator.Sql
|
||||||
import Ringo.Types
|
import Ringo.Types.Internal
|
||||||
import Ringo.Utils
|
import Ringo.Utils
|
||||||
|
|
||||||
tableDefnStmts :: Table -> Reader Env [Statement]
|
tableDefnStmts :: Table -> Reader Env [Statement]
|
||||||
tableDefnStmts Table {..} = withReader envView $ do
|
tableDefnStmts Table {..} = do
|
||||||
Settings {..} <- asks envSettings
|
Settings {..} <- asks envSettings
|
||||||
let tabName = tableName <> settingTableNameSuffixTemplate
|
let tabName = tableName <> settingTableNameSuffixTemplate
|
||||||
|
|
||||||
|
@ -58,7 +58,7 @@ dimensionTableDefnSQL :: Table -> Reader Env [Text]
|
||||||
dimensionTableDefnSQL table = tableDefnSQL table dimensionTableIndexStmts
|
dimensionTableDefnSQL table = tableDefnSQL table dimensionTableIndexStmts
|
||||||
|
|
||||||
dimensionTableIndexStmts :: Table -> Reader Env [Statement]
|
dimensionTableIndexStmts :: Table -> Reader Env [Statement]
|
||||||
dimensionTableIndexStmts Table {..} = withReader envView $do
|
dimensionTableIndexStmts Table {..} = do
|
||||||
Settings {..} <- asks envSettings
|
Settings {..} <- asks envSettings
|
||||||
let tabName = tableName <> settingTableNameSuffixTemplate
|
let tabName = tableName <> settingTableNameSuffixTemplate
|
||||||
tablePKColName = head [ cName | PrimaryKey cName <- tableConstraints ]
|
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 -> Reader Env [Statement]
|
||||||
factTableIndexStmts fact table = do
|
factTableIndexStmts fact table = do
|
||||||
allDims <- extractAllDimensionTables fact
|
allDims <- extractAllDimensionTables fact
|
||||||
withReader envView $ do
|
|
||||||
Settings {..} <- asks envSettings
|
Settings {..} <- asks envSettings
|
||||||
tables <- asks envTables
|
tables <- asks envTables
|
||||||
|
|
||||||
|
|
|
@ -10,7 +10,7 @@ module Ringo.Generator.Populate.Dimension (dimensionTablePopulateSQL) where
|
||||||
import Control.Applicative ((<$>))
|
import Control.Applicative ((<$>))
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
import Control.Monad.Reader (Reader, asks, withReader)
|
import Control.Monad.Reader (Reader, asks)
|
||||||
import Database.HsSqlPpp.Syntax (Statement, QueryExpr(..), Distinct(..), makeSelect, JoinType(..))
|
import Database.HsSqlPpp.Syntax (Statement, QueryExpr(..), Distinct(..), makeSelect, JoinType(..))
|
||||||
import Data.Maybe (fromJust)
|
import Data.Maybe (fromJust)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
|
@ -18,14 +18,14 @@ import Data.Text (Text)
|
||||||
import Ringo.Extractor.Internal
|
import Ringo.Extractor.Internal
|
||||||
import Ringo.Generator.Internal
|
import Ringo.Generator.Internal
|
||||||
import Ringo.Generator.Sql
|
import Ringo.Generator.Sql
|
||||||
import Ringo.Types
|
import Ringo.Types.Internal
|
||||||
|
|
||||||
dimensionTablePopulateSQL :: TablePopulationMode -> Fact -> TableName -> Reader Env Text
|
dimensionTablePopulateSQL :: TablePopulationMode -> Fact -> TableName -> Reader Env Text
|
||||||
dimensionTablePopulateSQL popMode fact dimTableName =
|
dimensionTablePopulateSQL popMode fact dimTableName =
|
||||||
ppStatement <$> dimensionTablePopulateStmt popMode fact dimTableName
|
ppStatement <$> dimensionTablePopulateStmt popMode fact dimTableName
|
||||||
|
|
||||||
dimensionTablePopulateStmt :: TablePopulationMode -> Fact -> TableName -> Reader Env Statement
|
dimensionTablePopulateStmt :: TablePopulationMode -> Fact -> TableName -> Reader Env Statement
|
||||||
dimensionTablePopulateStmt popMode fact dimTableName = withReader envView $ do
|
dimensionTablePopulateStmt popMode fact dimTableName = do
|
||||||
Settings {..} <- asks envSettings
|
Settings {..} <- asks envSettings
|
||||||
tables <- asks envTables
|
tables <- asks envTables
|
||||||
defaults <- asks envTypeDefaults
|
defaults <- asks envTypeDefaults
|
||||||
|
|
|
@ -15,7 +15,7 @@ import qualified Data.Text as Text
|
||||||
import Control.Applicative ((<$>))
|
import Control.Applicative ((<$>))
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
import Control.Monad.Reader (Reader, asks, withReader)
|
import Control.Monad.Reader (Reader, asks)
|
||||||
import Database.HsSqlPpp.Syntax ( QueryExpr(..), Statement, makeSelect
|
import Database.HsSqlPpp.Syntax ( QueryExpr(..), Statement, makeSelect
|
||||||
, SelectList(..), SelectItem(..), JoinType(..) )
|
, SelectList(..), SelectItem(..), JoinType(..) )
|
||||||
import Data.List (nub)
|
import Data.List (nub)
|
||||||
|
@ -27,7 +27,7 @@ import Text.RawString.QQ (r)
|
||||||
import Ringo.Extractor.Internal
|
import Ringo.Extractor.Internal
|
||||||
import Ringo.Generator.Internal
|
import Ringo.Generator.Internal
|
||||||
import Ringo.Generator.Sql
|
import Ringo.Generator.Sql
|
||||||
import Ringo.Types
|
import Ringo.Types.Internal
|
||||||
import Ringo.Utils
|
import Ringo.Utils
|
||||||
|
|
||||||
ilog2FunctionString :: Text
|
ilog2FunctionString :: Text
|
||||||
|
@ -56,7 +56,7 @@ $$
|
||||||
LANGUAGE 'plpgsql' IMMUTABLE;
|
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
|
factCountDistinctUpdateStmts popMode fact groupByColPrefix expr = case expr of
|
||||||
Select {selSelectList = SelectList _ origSelectItems, ..} -> do
|
Select {selSelectList = SelectList _ origSelectItems, ..} -> do
|
||||||
Settings {..} <- asks envSettings
|
Settings {..} <- asks envSettings
|
||||||
|
@ -126,7 +126,6 @@ factCountDistinctUpdateStmts popMode fact groupByColPrefix expr = case expr of
|
||||||
factTablePopulateStmts :: TablePopulationMode -> Fact -> Reader Env [Statement]
|
factTablePopulateStmts :: TablePopulationMode -> Fact -> Reader Env [Statement]
|
||||||
factTablePopulateStmts popMode fact = do
|
factTablePopulateStmts popMode fact = do
|
||||||
allDims <- extractAllDimensionTables fact
|
allDims <- extractAllDimensionTables fact
|
||||||
withReader envView $ do
|
|
||||||
Settings {..} <- asks envSettings
|
Settings {..} <- asks envSettings
|
||||||
tables <- asks envTables
|
tables <- asks envTables
|
||||||
defaults <- asks envTypeDefaults
|
defaults <- asks envTypeDefaults
|
||||||
|
|
|
@ -1,8 +1,6 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE RecordWildCards #-}
|
|
||||||
{-# LANGUAGE GADTs #-}
|
{-# LANGUAGE GADTs #-}
|
||||||
{-# LANGUAGE Rank2Types #-}
|
{-# LANGUAGE Rank2Types #-}
|
||||||
{-# LANGUAGE StandaloneDeriving #-}
|
|
||||||
|
|
||||||
module Ringo.Types
|
module Ringo.Types
|
||||||
( ColumnName, ColumnType, TableName
|
( ColumnName, ColumnType, TableName
|
||||||
|
@ -11,7 +9,7 @@ module Ringo.Types
|
||||||
, Fact(..), FactColumnType(..), FactColumn(..), factSourceColumnName
|
, Fact(..), FactColumnType(..), FactColumn(..), factSourceColumnName
|
||||||
, Settings(..), defSettings
|
, Settings(..), defSettings
|
||||||
, ValidationError(..), TypeDefaults
|
, ValidationError(..), TypeDefaults
|
||||||
, Env, EnvV(..), envView
|
, Env, envTables, envFacts, envSettings, envTypeDefaults,
|
||||||
, TablePopulationMode(..), Dependencies) where
|
TablePopulationMode(..), Dependencies) where
|
||||||
|
|
||||||
import Ringo.Types.Internal
|
import Ringo.Types.Internal
|
||||||
|
|
|
@ -168,17 +168,24 @@ data ValidationError = MissingTable !TableName
|
||||||
|
|
||||||
type TypeDefaults = Map Text Text
|
type TypeDefaults = Map Text Text
|
||||||
|
|
||||||
data Env = Env ![Table] ![Fact] !Settings !TypeDefaults
|
data Env = Env
|
||||||
|
{ _envTables :: ![Table]
|
||||||
data EnvV = EnvV
|
, _envFacts :: ![Fact]
|
||||||
{ envTables :: ![Table]
|
, _envSettings :: !Settings
|
||||||
, envFacts :: ![Fact]
|
, _envTypeDefaults :: !TypeDefaults
|
||||||
, envSettings :: !Settings
|
|
||||||
, envTypeDefaults :: !TypeDefaults
|
|
||||||
} deriving (Show)
|
} deriving (Show)
|
||||||
|
|
||||||
envView :: Env -> EnvV
|
envTables :: Env -> [Table]
|
||||||
envView (Env tables facts settings typeDefaults) = EnvV tables facts settings typeDefaults
|
envTables = _envTables
|
||||||
|
|
||||||
|
envFacts :: Env -> [Fact]
|
||||||
|
envFacts = _envFacts
|
||||||
|
|
||||||
|
envSettings :: Env -> Settings
|
||||||
|
envSettings = _envSettings
|
||||||
|
|
||||||
|
envTypeDefaults :: Env -> TypeDefaults
|
||||||
|
envTypeDefaults = _envTypeDefaults
|
||||||
|
|
||||||
data TablePopulationMode = FullPopulation | IncrementalPopulation deriving (Eq, Show)
|
data TablePopulationMode = FullPopulation | IncrementalPopulation deriving (Eq, Show)
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue