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
+extractFactTable fact = mkTable <$> asks envSettings
-  allDims       <- extractAllDimensionTables fact
+                                <*> 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
+  let sourceColumn cName                     = fromJust . findColumn cName . tableColumns $ table
-      dimIdColName       = settingDimTableIdColumnName
-      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, ..} ->
+  return $ concatFor (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
     case factColType of
       DimTime                ->
-            [ Column (timeUnitColumnName dimIdColName cName settingTimeUnit) "bigint" NotNull ]
+        [ Column (timeUnitColumnName settingDimTableIdColumnName cName settingTimeUnit) "bigint" NotNull ]
       NoDimId                -> [ notNullSourceColumnCopy cName ]
       TenantId               -> [ notNullSourceColumnCopy cName ]
-          FactCount {..}         -> [ Column cName countColType NotNull ]
+      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) countColType NotNull
+        [ Column (cName <> settingAvgCountColumnSuffix) settingFactCountColumnType NotNull
         , notNullSourceColumnRename factColSourceColumn (cName <> settingAvgSumColumnSuffix)
         ]
       _                      -> []
 
-      fkColumns = for allDims $ \(dimFact, dimTable) ->
+extractFKColumns :: Fact -> Reader Env [Column]
-        let colName = factDimFKIdColumnName settingDimPrefix dimIdColName dimFact dimTable tables
+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
 
-      ukColNames =
+extractUKColumnNames :: Fact -> Reader Env [ColumnName]
-        (++ map columnName fkColumns)
+extractUKColumnNames fact = do
-        . forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
+  Settings {..} <- asks envSettings
+  return $ forMaybe (factColumns fact) $ \FactColumn {factColTargetColumn = cName, ..} ->
       case factColType of
-                DimTime  -> Just $ timeUnitColumnName dimIdColName cName settingTimeUnit
+          DimTime  -> Just $ timeUnitColumnName settingDimTableIdColumnName cName settingTimeUnit
           NoDimId  -> Just cName
           TenantId -> Just cName
           _        -> Nothing
 
-  return Table
-         { tableName        =
-             extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
-         , tableColumns     = columns ++ fkColumns
-         , tableConstraints = [ UniqueKey ukColNames ]
-         }
-
 extractDependencies :: Fact -> Reader Env Dependencies
-extractDependencies fact = do
+extractDependencies fact = Map.union <$> extractFactDeps fact <*> extractDimensionDeps fact
-  settings@Settings{..} <- asks envSettings
+
+extractFactDeps :: Fact -> Reader Env Dependencies
+extractFactDeps fact = do
+  Settings{..} <- asks envSettings
   facts        <- asks envFacts
-  let factSourceDeps    =
+
+  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])
+  return $ Map.singleton extractedTable (factSourceDeps ++ factDimDeps)
-                                | FactColumn {factColType = DimVal table} <- factColumns fact ]
-
-      factDeps = Map.singleton (extractedTable settings) (factSourceDeps ++ factDimDeps)
-  return $ Map.union dimDeps factDeps
   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 ]