Refactoring

src/Ringo/Extractor.hs

@@ -1,5 +1,6 @@
 module Ringo.Extractor
-       ( extractDimensions
+       ( extractDimensionTables
+       , extractAllDimensionTables
        , extractFactTable
        ) where
 
@@ -13,10 +14,11 @@ import Ringo.Extractor.Internal
 import Ringo.Types
 import Ringo.Utils
 
-extractFactTable ::  Fact -> Table -> Reader Env Table
-extractFactTable fact table = do
+extractFactTable ::  Fact -> Reader Env Table
+extractFactTable fact = do
   Settings {..} <- asks envSettings
-  allDims       <- extractAllDimensions fact table
+  allDims       <- extractAllDimensionTables fact
+  table         <- asks $ fromJust . findTable (factTableName fact) . envTables
 
   let intType                  = "integer"
       sourceColumnType colName = columnType . fromJust . findColumn colName . tableColumns $ table

src/Ringo/Extractor/Internal.hs

@@ -11,18 +11,23 @@ import Data.List            (nub)
 import Ringo.Types
 import Ringo.Utils
 
-extractDimensions :: Fact -> Table -> Reader Env [Table]
-extractDimensions fact Table {..} = do
-  tables <- asks envTables
-  prefix <- settingDimPrefix <$> asks envSettings
-  return $ dimsFromIds tables ++ dimsFromVals prefix
+dimColumnName :: Text.Text -> ColumnName -> ColumnName
+dimColumnName dimName columnName =
+  fromMaybe columnName . Text.stripPrefix (dimName <> "_") $ columnName
+
+extractDimensionTables :: Fact -> Reader Env [Table]
+extractDimensionTables fact = do
+  tables    <- asks envTables
+  prefix    <- settingDimPrefix <$> asks envSettings
+  let table = fromJust . findTable (factTableName fact) $ tables
+  return $ dimsFromIds tables ++ dimsFromVals prefix (tableColumns table)
   where
     dimsFromIds tables =
       flip mapMaybe (factColumns fact) $ \fcol -> case fcol of
         DimId d _ -> findTable d tables
         _         -> Nothing
 
-    dimsFromVals prefix =
+    dimsFromVals prefix tableColumns =
       map (\(dim, cols) -> Table { tableName        = prefix <> dim
                                  , tableColumns     = Column "id" "serial" NotNull : cols
                                  , tableConstraints = [ PrimaryKey "id"
@@ -42,19 +47,12 @@ extractDimensions fact Table {..} = do
       . factColumns
       $ fact
 
-dimColumnName :: Text.Text -> ColumnName -> ColumnName
-dimColumnName dimName columnName =
-  fromMaybe columnName . Text.stripPrefix (dimName <> "_") $ columnName
-
-extractAllDimensions :: Fact -> Table -> Reader Env [Table]
-extractAllDimensions fact table = do
-  myDims     <- extractDimensions fact table
+extractAllDimensionTables :: Fact -> Reader Env [Table]
+extractAllDimensionTables fact = do
+  myDims     <- extractDimensionTables fact
   parentDims <- concat <$> mapM extract (factParentNames fact)
   return . nub $ myDims ++ parentDims
   where
     extract fName = do
-      tables <- asks envTables
       facts  <- asks envFacts
-      let pFact      = fromJust . findFact fName $ facts
-          pFactTable = fromJust . findTable (factTableName pFact) $ tables
-      extractAllDimensions pFact pFactTable
+      extractAllDimensionTables . fromJust . findFact fName $ facts

src/Ringo/Generator.hs

@@ -5,10 +5,11 @@ module Ringo.Generator
 
 import qualified Data.Text as Text
 
-import Data.List   (intersperse)
-import Data.Maybe  (mapMaybe)
-import Data.Monoid ((<>))
-import Data.Text   (Text)
+import Control.Monad.Reader (Reader, asks)
+import Data.List            (intersperse)
+import Data.Maybe           (mapMaybe)
+import Data.Monoid          ((<>))
+import Data.Text            (Text)
 
 import Ringo.Extractor.Internal
 import Ringo.Types
@@ -42,13 +43,16 @@ tableDefnSQL Table {..} =
                  <> (Text.concat . intersperse ",\n" . map columnDefnSQL $ tableColumns)
                  <> "\n)"
 
-dimensionTableInsertSQL :: Text -> Fact -> TableName -> Text
-dimensionTableInsertSQL dimPrefix fact dimTableName = let
-  colMapping = flip mapMaybe (factColumns fact) $ \fCol -> case fCol of
-    DimVal dName cName | dimPrefix <> dName == dimTableName -> Just (dimColumnName dName cName, cName)
-    _ -> Nothing
-  in "INSERT INTO " <> dimTableName <> " (\n"
-       <> colNamesString (map fst colMapping)
-       <> "\n) SELECT DISTINCT \n"
-       <> colNamesString (map snd colMapping)
-       <> "\nFROM " <> factTableName fact
+dimensionTableInsertSQL :: Fact -> TableName -> Reader Env Text
+dimensionTableInsertSQL fact dimTableName = do
+  dimPrefix      <- settingDimPrefix <$> asks envSettings
+  let colMapping = flip mapMaybe (factColumns fact) $ \fCol -> case fCol of
+        DimVal dName cName | dimPrefix <> dName == dimTableName ->
+          Just (dimColumnName dName cName, cName)
+        _ -> Nothing
+
+  return $ "INSERT INTO " <> dimTableName <> " (\n"
+             <> colNamesString (map fst colMapping)
+             <> "\n) SELECT DISTINCT \n"
+             <> colNamesString (map snd colMapping)
+             <> "\nFROM " <> factTableName fact

src/Ringo/Validator.hs

@@ -1,8 +1,10 @@
-module Ringo.Validator where
+module Ringo.Validator
+       ( validateTable
+       , validateFact
+       , withFactValidation
+       ) where
 
 import Control.Monad.Reader (Reader, asks)
-import Data.Maybe           (mapMaybe, fromMaybe, fromJust)
-import Data.Monoid          ((<>))
 
 import Ringo.Types
 import Ringo.Utils
@@ -46,11 +48,9 @@ validateFact Fact {..} = do
 
     checkColumn table = maybe [] (checkTableForCol table) . factColumnName
 
-withFactValidation :: Fact -> (Table -> Reader Env a)
-                   -> Reader Env (Either [ValidationError] a)
+withFactValidation :: Fact -> Reader Env a -> Reader Env (Either [ValidationError] a)
 withFactValidation fact func = do
-  tables <- asks envTables
   errors <- validateFact fact
   if not $ null errors
     then return $ Left errors
-    else fmap Right . func . fromJust . findTable (factTableName fact) $ tables
+    else fmap Right func