Removes EnvV from Types to simplify the code.

ringo-app/src/Main.hs

@@ -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
+writeFiles outputDir env = do
-  let Settings{..} = envSettings
+  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 ]
+    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)
                             | (_, 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 ]

ringo-app/src/Ringo/InputParser.hs

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

ringo/src/Ringo/Extractor.hs

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

ringo/src/Ringo/Extractor/Internal.hs

@@ -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 =
+    extract fName = asks envFacts >>= extractAllDimensionTables . fromJust . findFact fName
-      asks (envFacts . envView) >>= extractAllDimensionTables . fromJust . findFact fName

ringo/src/Ringo/Generator/Create.hs

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

ringo/src/Ringo/Generator/Populate/Dimension.hs

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

ringo/src/Ringo/Generator/Populate/Fact.hs

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

ringo/src/Ringo/Types.hs

@@ -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
+  , Env, envTables, envFacts, envSettings, envTypeDefaults,
-  , TablePopulationMode(..), Dependencies) where
+  TablePopulationMode(..), Dependencies) where
 
 import Ringo.Types.Internal

ringo/src/Ringo/Types/Internal.hs

@@ -168,17 +168,24 @@ data ValidationError = MissingTable             !TableName
 
 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)
 
-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)