Refactoring.

src/Ringo/Extractor.hs

@@ -5,7 +5,7 @@ module Ringo.Extractor
        ) where
 
 import Control.Monad.Reader (Reader, asks)
-import Data.Maybe           (mapMaybe, fromJust)
+import Data.Maybe           (fromJust)
 import Data.Monoid          ((<>))
 
 import Ringo.Extractor.Internal
@@ -22,8 +22,9 @@ extractFactTable fact = do
       dimIdColName             = settingDimTableIdColumnName
       sourceColumnType colName = columnType . fromJust . findColumn colName . tableColumns $ table
 
-      columns = flip concatMap (factColumns fact) $ \col -> case col of
-        DimTime cName            -> [ Column (timeUnitColumnName dimIdColName cName settingTimeUnit) "integer" NotNull ]
+      columns = concatFor (factColumns fact) $ \col -> case col of
+        DimTime cName            ->
+          [ Column (timeUnitColumnName dimIdColName cName settingTimeUnit) "integer" NotNull ]
         NoDimId cName            -> [ fromJust . findColumn cName . tableColumns $ table]
         FactCount cName          -> [ Column cName countColType NotNull ]
         FactSum scName cName     -> [ Column cName (sourceColumnType scName) NotNull ]
@@ -35,22 +36,22 @@ extractFactTable fact = do
           [ Column (cName <> settingCountDistinctColumSuffix) (countColType <> "[]") NotNull ]
         _                        -> []
 
-      fks = flip map allDims $ \(_, Table {..}) ->
+      fks = for allDims $ \(_, Table {..}) ->
         let colName     = factDimFKIdColumnName settingDimPrefix dimIdColName tableName
+            colType     = idColTypeToFKIdColType settingDimTableIdColumnType
             colNullable = if any ((== Null) . columnNullable) tableColumns then Null else NotNull
-        in ( Column colName (idColTypeToFKIdColType settingDimTableIdColumnType) colNullable
-           , ForeignKey tableName [(colName, dimIdColName)]
-           )
+        in ( Column colName colType colNullable , ForeignKey tableName [(colName, dimIdColName)] )
 
       ukColNames =
         (++ map (columnName . fst) fks)
-        . flip mapMaybe (factColumns fact) $ \col -> case col of
+        . forMaybe (factColumns fact) $ \col -> case col of
             DimTime cName -> Just (timeUnitColumnName dimIdColName cName settingTimeUnit)
             NoDimId cName -> Just cName
             _             -> Nothing
 
-  return Table { tableName        =
-                   extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
-               , tableColumns     = columns ++ map fst fks
-               , tableConstraints = UniqueKey ukColNames : map snd fks
-               }
+  return Table
+         { tableName        =
+             extractedFactTableName settingFactPrefix settingFactInfix (factName fact) settingTimeUnit
+         , tableColumns     = columns ++ map fst fks
+         , tableConstraints = UniqueKey ukColNames : map snd fks
+         }

src/Ringo/Extractor/Internal.hs

@@ -49,7 +49,7 @@ extractDimensionTables fact = do
   return $ dimsFromIds tables ++ dimsFromVals settings (tableColumns table)
   where
     dimsFromIds tables =
-      flip mapMaybe (factColumns fact) $ \fcol -> case fcol of
+      forMaybe (factColumns fact) $ \fcol -> case fcol of
         DimId d _ -> findTable d tables
         _         -> Nothing
 
@@ -63,9 +63,8 @@ extractDimensionTables fact = do
                                        ]
                   })
       . Map.toList
-      . Map.mapWithKey (\dim ->
-                          map (\col@Column {..} -> col { columnName = dimColumnName dim columnName })
-                          . nub)
+      . Map.mapWithKey
+          (\dim ->  map (\col -> col { columnName = dimColumnName dim (columnName col) }) . nub)
       . Map.fromListWith (flip (++))
       . mapMaybe (\fcol -> do
                     DimVal d col <- fcol

src/Ringo/Generator.hs

@@ -56,21 +56,22 @@ factTableDefnSQL fact table = do
   Settings {..} <- asks envSettings
   allDims       <- extractAllDimensionTables fact
 
-  let factCols  = flip mapMaybe (factColumns fact) $ \col -> case col of
+  let factCols  = forMaybe (factColumns fact) $ \col -> case col of
         DimTime cName -> Just $ timeUnitColumnName settingDimTableIdColumnName cName settingTimeUnit
         NoDimId cName -> Just cName
         _             -> Nothing
 
-      dimCols   = flip map allDims $ \(_, Table {..}) ->
-        factDimFKIdColumnName settingDimPrefix settingDimTableIdColumnName tableName
+      dimCols   = [ factDimFKIdColumnName settingDimPrefix settingDimTableIdColumnName tableName
+                    | (_, Table {..}) <- allDims ]
+
+      indexSQLs = [ "CREATE INDEX ON " <> tableName table <> " USING btree (" <> col <> ")"
+                    | col <- factCols ++ dimCols ]
 
-      indexSQLs = flip map (factCols ++ dimCols) $ \col ->
-        "CREATE INDEX ON " <> tableName table <> " USING btree (" <> col <> ")"
   return $ tableDefnSQL table ++ indexSQLs
 
 dimColumnMapping :: Text -> Fact -> TableName -> [(ColumnName, ColumnName)]
 dimColumnMapping dimPrefix fact dimTableName =
-  flip mapMaybe (factColumns fact) $ \fCol -> case fCol of
+  forMaybe (factColumns fact) $ \fCol -> case fCol of
     DimVal dName cName | dimPrefix <> dName == dimTableName ->
       Just (dimColumnName dName cName, cName)
     _ -> Nothing
@@ -88,19 +89,19 @@ dimensionTableInsertSQL fact dimTableName = do
 
 factTableInsertSQL :: Fact -> Reader Env Text
 factTableInsertSQL fact = do
-  let fTableName   = factTableName fact
   Settings {..}    <- asks envSettings
   allDims          <- extractAllDimensionTables fact
   tables           <- asks envTables
-  let table        =  fromJust . findTable fTableName $ tables
+  let fTableName   = factTableName fact
+      table        = fromJust . findTable fTableName $ tables
       dimIdColName = settingDimTableIdColumnName
 
-  let timeUnitColumnInsertSQL cName =
+      timeUnitColumnInsertSQL cName =
         let colName = timeUnitColumnName dimIdColName cName settingTimeUnit
         in (colName, "floor(extract(epoch from " <> fullColName fTableName cName <> ")/"
                         <> Text.pack (show $ timeUnitToSeconds settingTimeUnit) <> ")")
 
-      factColMap = flip concatMap (factColumns fact) $ \col -> case col of
+      factColMap = concatFor (factColumns fact) $ \col -> case col of
         DimTime cName            -> [ timeUnitColumnInsertSQL cName ]
         NoDimId cName            -> [ (cName, fullColName fTableName cName) ]
         FactCount cName          -> [ (cName, "count(*)") ]
@@ -111,22 +112,20 @@ factTableInsertSQL fact = do
                                       , "sum(" <> fullColName fTableName scName <> ")") ]
         _                        -> []
 
-      dimColMap = flip map allDims $ \(dimFact, factTable@Table {..}) ->
+      dimColMap = for allDims $ \(dimFact, factTable@Table {..}) ->
         let colName             = factDimFKIdColumnName settingDimPrefix dimIdColName tableName
             factSourceTableName = factTableName dimFact
-            insertSQL           =
-              if factTable `elem` tables
-               then fullColName factSourceTableName colName
-               else
-                let dimLookupWhereClauses =
-                      map (\(c1, c2) ->
-                            fullColName tableName c1 <> " = " <> fullColName factSourceTableName c2)
-                      $ dimColumnMapping settingDimPrefix dimFact tableName
+            insertSQL           = if factTable `elem` tables
+              then fullColName factSourceTableName colName
+              else let
+                  dimLookupWhereClauses =
+                    [ fullColName tableName c1 <> " = " <> fullColName factSourceTableName c2
+                      | (c1, c2) <- dimColumnMapping settingDimPrefix dimFact tableName ]
                 in "SELECT " <> dimIdColName <> " FROM " <> tableName <> "\nWHERE "
                      <> (Text.concat . intersperse "\n AND " $ dimLookupWhereClauses)
         in (colName, insertSQL)
 
-      colMap = map (\(cName, sql) -> (cName, asName cName sql)) $ factColMap ++ dimColMap
+      colMap = [ (cName, asName cName sql) | (cName, sql) <- factColMap ++ dimColMap ]
 
       joinClauses =
         mapMaybe (\tName -> (\p -> "LEFT JOIN " <> tName <> " ON "<> p) <$> joinClausePreds table tName)

src/Ringo/Utils.hs

@@ -1,6 +1,7 @@
 module Ringo.Utils where
 
-import Data.List (find)
+import Data.Maybe (mapMaybe)
+import Data.List  (find)
 
 import Ringo.Types
 
@@ -12,3 +13,17 @@ findFact fName = find ((== fName) . factName)
 
 findColumn :: ColumnName -> [Column] -> Maybe Column
 findColumn cName = find ((== cName) . columnName)
+
+for :: [a] -> (a -> b) -> [b]
+for = flip map
+
+forMaybe :: [a] -> (a -> Maybe b) -> [b]
+forMaybe = flip mapMaybe
+
+#if MIN_VERSION_base(4,8,0)
+concatFor :: (Foldable t) => t a -> (a -> [b]) -> [b]
+concatFor = flip concatMap
+#else
+concatFor :: [a] -> (a -> [b]) -> [b]
+concatFor = flip concatMap
+#endif

src/Ringo/Validator.hs

@@ -46,7 +46,7 @@ validateFact Fact {..} = do
       return $ tableVs ++ parentVs ++ colVs
   where
     checkFactParents fName = do
-      facts  <- asks envFacts
+      facts <- asks envFacts
       case findFact fName facts of
         Nothing    -> return [ MissingFact fName ]
         Just pFact -> validateFact pFact
@@ -56,12 +56,8 @@ validateFact Fact {..} = do
         ++ checkColumnTable tables factCol
 
     checkColumnTable tables factCol = case factCol of
-      DimId tName _  -> go tName
+      DimId tName _  -> maybe [ MissingTable tName ] (const []) $ findTable tName tables
       _              -> []
-      where
-        go tName = case findTable tName tables of
-          Nothing -> [ MissingTable tName ]
-          Just _  -> []
 
 withFactValidation :: Fact -> Reader Env a -> Reader Env (Either [ValidationError] a)
 withFactValidation fact func = do