Refactors extractor to simplify the code.

ringo/src/Ringo/Extractor.hs

@@ -1,6 +1,8 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
 module Ringo.Extractor
        ( extractDimensionTables
        , extractAllDimensionTables
@@ -11,6 +13,7 @@ module Ringo.Extractor
 import qualified Data.Map  as Map
 import qualified Data.Tree as Tree
 
+import Prelude.Compat
 import Control.Monad.Reader (Reader, asks)
 import Data.Maybe           (fromJust)
 import Data.Monoid          ((<>))
@@ -21,63 +24,81 @@ import Ringo.Types.Internal
 import Ringo.Utils
 
 extractFactTable ::  Fact -> Reader Env Table
-extractFactTable fact = do
-  allDims       <- extractAllDimensionTables fact
+extractFactTable fact = mkTable <$> asks envSettings
+                                <*> extractColumns       fact
+                                <*> extractFKColumns     fact
+                                <*> extractUKColumnNames fact
+  where
+    mkTable Settings {..} columns fkColumns ukColNames =
+      Table { tableName        =
+               extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
+            , tableColumns     = columns ++ fkColumns
+            , tableConstraints = [ UniqueKey $ ukColNames ++ map columnName fkColumns ]
+            }
+
+extractColumns :: Fact -> Reader Env [Column]
+extractColumns fact = do
   Settings {..} <- asks envSettings
   tables        <- asks envTables
   let table     =  fromJust . findTable (factTableName fact) $ tables
 
-  let countColType       = settingFactCountColumnType
-      dimIdColName       = settingDimTableIdColumnName
-      sourceColumn cName = fromJust . findColumn cName . tableColumns $ table
+  let sourceColumn cName                     = fromJust . findColumn cName . tableColumns $ table
       notNullSourceColumnCopy cName          = (sourceColumn cName) { columnNullable = NotNull }
       notNullSourceColumnRename scName cName = (notNullSourceColumnCopy scName) { columnName = cName }
 
-      columns = concatFor (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
-        case factColType of
-          DimTime                ->
-            [ Column (timeUnitColumnName dimIdColName cName settingTimeUnit) "bigint" NotNull ]
-          NoDimId                -> [ notNullSourceColumnCopy cName ]
-          TenantId               -> [ notNullSourceColumnCopy cName ]
-          FactCount {..}         -> [ Column cName countColType NotNull ]
-          FactCountDistinct {..} -> [ Column cName "json" NotNull ]
-          FactSum {..}           -> [ notNullSourceColumnRename factColSourceColumn cName ]
-          FactMax {..}           -> [ notNullSourceColumnRename factColSourceColumn cName ]
-          FactMin {..}           -> [ notNullSourceColumnRename factColSourceColumn cName ]
-          FactAverage {..}       ->
-            [ Column (cName <> settingAvgCountColumnSuffix) countColType NotNull
-            , notNullSourceColumnRename factColSourceColumn (cName <> settingAvgSumColumnSuffix)
-            ]
-          _                      -> []
-
-      fkColumns = for allDims $ \(dimFact, dimTable) ->
-        let colName = factDimFKIdColumnName settingDimPrefix dimIdColName dimFact dimTable tables
-            colType = idColTypeToFKIdColType settingDimTableIdColumnType
-        in Column colName colType NotNull
-
-      ukColNames =
-        (++ map columnName fkColumns)
-        . forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
-            case factColType of
-                DimTime  -> Just $ timeUnitColumnName dimIdColName cName settingTimeUnit
-                NoDimId  -> Just cName
-                TenantId -> Just cName
-                _        -> Nothing
-
-  return Table
-         { tableName        =
-             extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
-         , tableColumns     = columns ++ fkColumns
-         , tableConstraints = [ UniqueKey ukColNames ]
-         }
+  return $ concatFor (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
+    case factColType of
+      DimTime                ->
+        [ Column (timeUnitColumnName settingDimTableIdColumnName cName settingTimeUnit) "bigint" NotNull ]
+      NoDimId                -> [ notNullSourceColumnCopy cName ]
+      TenantId               -> [ notNullSourceColumnCopy cName ]
+      FactCount {..}         -> [ Column cName settingFactCountColumnType NotNull ]
+      FactCountDistinct {..} -> [ Column cName "json" NotNull ]
+      FactSum {..}           -> [ notNullSourceColumnRename factColSourceColumn cName ]
+      FactMax {..}           -> [ notNullSourceColumnRename factColSourceColumn cName ]
+      FactMin {..}           -> [ notNullSourceColumnRename factColSourceColumn cName ]
+      FactAverage {..}       ->
+        [ Column (cName <> settingAvgCountColumnSuffix) settingFactCountColumnType NotNull
+        , notNullSourceColumnRename factColSourceColumn (cName <> settingAvgSumColumnSuffix)
+        ]
+      _                      -> []
+
+extractFKColumns :: Fact -> Reader Env [Column]
+extractFKColumns fact = do
+  allDims       <- extractAllDimensionTables fact
+  Settings {..} <- asks envSettings
+  tables        <- asks envTables
+
+  return $ for allDims $ \(dimFact, dimTable) ->
+    let colName = factDimFKIdColumnName settingDimPrefix settingDimTableIdColumnName dimFact dimTable tables
+        colType = idColTypeToFKIdColType settingDimTableIdColumnType
+    in Column colName colType NotNull
+
+extractUKColumnNames :: Fact -> Reader Env [ColumnName]
+extractUKColumnNames fact = do
+  Settings {..} <- asks envSettings
+  return $ forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
+      case factColType of
+          DimTime  -> Just $ timeUnitColumnName settingDimTableIdColumnName cName settingTimeUnit
+          NoDimId  -> Just cName
+          TenantId -> Just cName
+          _        -> Nothing
 
 extractDependencies :: Fact -> Reader Env Dependencies
-extractDependencies fact = do
-  settings@Settings{..} <- asks envSettings
-  facts                 <- asks envFacts
-  let factSourceDeps    =
+extractDependencies fact = Map.union <$> extractFactDeps fact <*> extractDimensionDeps fact
+
+extractFactDeps :: Fact -> Reader Env Dependencies
+extractFactDeps fact = do
+  Settings{..} <- asks envSettings
+  facts        <- asks envFacts
+
+  let extractedTable =
+        extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
+
+      factSourceDeps    =
         nub . Tree.flatten . flip Tree.unfoldTree fact $ \fct ->
           (factTableName fct, parentFacts fct facts)
+
       factDimDeps       =
         nub . concat . Tree.flatten . flip Tree.unfoldTree fact $ \fct ->
           ( forMaybe (factColumns fct) $ \FactColumn {..} -> case factColType of
@@ -87,13 +108,12 @@ extractDependencies fact = do
           , parentFacts fct facts
           )
 
-      dimDeps  = Map.fromList [ (settingDimPrefix <> table, [factTableName fact])
-                                | FactColumn {factColType = DimVal table} <- factColumns fact ]
-
-      factDeps = Map.singleton (extractedTable settings) (factSourceDeps ++ factDimDeps)
-  return $ Map.union dimDeps factDeps
+  return $ Map.singleton extractedTable (factSourceDeps ++ factDimDeps)
   where
-    extractedTable Settings {..} =
-      extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
-
     parentFacts fct facts = [ fromJust $ findFact pf facts | pf <- factParentNames fct ]
+
+extractDimensionDeps :: Fact -> Reader Env Dependencies
+extractDimensionDeps fact = do
+  Settings{..} <- asks envSettings
+  return $ Map.fromList [ (settingDimPrefix <> table, [factTableName fact])
+                          | FactColumn {factColType = DimVal table} <- factColumns fact ]