Refactors to move validation logic to its own namespace

src/Ringo.hs

@@ -1,4 +1,8 @@
-module Ringo where
+module Ringo
+       ( module Ringo.Types
+       , module Ringo.Extractor
+       , module Ringo.Generator
+       ) where
 
 import Ringo.Types
 import Ringo.Extractor

src/Ringo/Extractor.hs

@@ -1,7 +1,5 @@
 module Ringo.Extractor
-       ( validateTable
+       ( extractDimensions
-       , validateFact
-       , extractDimensions
        , extractFactTable
        ) where
 
@@ -13,88 +11,42 @@ import Data.Monoid          ((<>))
 
 import Ringo.Extractor.Internal
 import Ringo.Types
+import Ringo.Utils
 
-validateTable :: Table -> Reader ExtractorEnv [ValidationError]
+extractFactTable ::  Fact -> Table -> Reader Env Table
-validateTable table = do
+extractFactTable fact table = do
-  tables <- asks eeTables
+  Settings {..} <- asks envSettings
-  return . concatMap (checkConstraint tables) . tableConstraints $ table
+  allDims       <- extractAllDimensions fact table
-  where
-    checkConstraint _ (PrimaryKey colName)    = checkTableForCol table colName
-    checkConstraint _ (UniqueKey columnNames) = checkTableForColRefs table columnNames
-    checkConstraint tables (ForeignKey oTableName columnNames) =
-      case findTable oTableName tables of
-        Just oTable -> checkTableForColRefs table (map fst columnNames)
-                         ++ checkTableForColRefs oTable (map snd columnNames)
-        Nothing     -> [ MissingTable oTableName ]
 
-    checkTableForColRefs tab = concatMap (checkTableForCol tab)
+  let intType                  = "integer"
+      sourceColumnType colName = columnType . fromJust . findColumn colName . tableColumns $ table
 
-validateFact :: Fact -> Reader ExtractorEnv [ValidationError]
+      columns = flip concatMap (factColumns fact) $ \col -> case col of
-validateFact Fact {..} = do
+        DimTime cName            -> [ Column (timeUnitColName cName settingTimeUnit) intType NotNull ]
-  tables <- asks eeTables
+        NoDimId cName            -> [ fromJust . findColumn cName . tableColumns $ table]
-  case findTable factTableName tables of
+        FactCount cName          -> [ Column cName intType NotNull ]
-    Nothing    -> return [ MissingTable factTableName ]
+        FactSum scName cName     -> [ Column cName (sourceColumnType scName) NotNull ]
-    Just table -> do
+        FactAverage scName cName -> [ Column (cName <> "_count") intType NotNull
-      tableVs   <- validateTable table
+                                    , Column (cName <> "_sum") (sourceColumnType scName) NotNull
-      parentVs  <- concat <$> mapM checkFactParents factParentNames
+                                    ]
-      let colVs = concatMap (checkColumn table) factColumns
+        FactCountDistinct cName  -> [ Column (cName <> "_hll") (intType <> "[]") NotNull ]
-      return $ tableVs ++ parentVs ++ colVs
+        _                        -> []
-  where
-    checkFactParents fName = do
-      facts  <- asks eeFacts
-      case findFact fName facts of
-        Nothing    -> return [ MissingFact fName ]
-        Just pFact -> validateFact pFact
 
-    checkColumn table = maybe [] (checkTableForCol table) . factColumnName
+      fks = flip map allDims $ \Table { .. } ->
+        let colName     = fromMaybe tableName (Text.stripPrefix settingDimPrefix tableName) <> "_id"
+            colNullable = if any ((== Null) . columnNullable) tableColumns then Null else NotNull
+        in (Column colName intType colNullable, ForeignKey tableName [(colName, "id")])
 
-withFactValidation :: Fact -> (Table -> Reader ExtractorEnv a)
+      ukColNames =
-                   -> Reader ExtractorEnv (Either [ValidationError] a)
+        (++ map (columnName . fst) fks)
-withFactValidation fact func = do
+        . flip mapMaybe (factColumns fact) $ \col -> case col of
-  tables <- asks eeTables
+            DimTime cName -> Just (timeUnitColName cName settingTimeUnit)
-  errors <- validateFact fact
+            NoDimId cName -> Just cName
-  if not $ null errors
+            _             -> Nothing
-    then return $ Left errors
-    else fmap Right . func . fromJust . findTable (factTableName fact) $ tables
 
-extractDimensions :: Fact -> Reader ExtractorEnv (Either [ValidationError] [Table])
+  return Table { tableName        = settingFactPrefix <> factName fact
-extractDimensions fact = withFactValidation fact $ extractDimensions' fact
+               , tableColumns     = columns ++ map fst fks
-
+               , tableConstraints = UniqueKey ukColNames : map snd fks
-extractFactTable ::  Fact -> Reader ExtractorEnv (Either [ValidationError] Table)
+               }
-extractFactTable fact  =
-  withFactValidation fact $ \table -> do
-    Settings {..} <- asks eeSettings
-    allDims       <- extractAllDimensions' fact table
-
-    let intType                  = "integer"
-        sourceColumnType colName = columnType . fromJust . findColumn colName . tableColumns $ table
-
-        columns = flip concatMap (factColumns fact) $ \col -> case col of
-          DimTime cName            -> [ Column (timeUnitColName cName settingTimeUnit) intType NotNull ]
-          NoDimId cName            -> [ fromJust . findColumn cName . tableColumns $ table]
-          FactCount cName          -> [ Column cName intType NotNull ]
-          FactSum scName cName     -> [ Column cName (sourceColumnType scName) NotNull ]
-          FactAverage scName cName -> [ Column (cName <> "_count") intType NotNull
-                                      , Column (cName <> "_sum") (sourceColumnType scName) NotNull
-                                      ]
-          FactCountDistinct cName  -> [ Column (cName <> "_hll") (intType <> "[]") NotNull ]
-          _                        -> []
-
-        fks = flip map allDims $ \Table { .. } ->
-          let colName     = fromMaybe tableName (Text.stripPrefix settingDimPrefix tableName) <> "_id"
-              colNullable = if any ((== Null) . columnNullable) tableColumns then Null else NotNull
-          in (Column colName intType colNullable, ForeignKey tableName [(colName, "id")])
-
-        ukColNames =
-          (++ map (columnName . fst) fks)
-          . flip mapMaybe (factColumns fact) $ \col -> case col of
-              DimTime cName -> Just (timeUnitColName cName settingTimeUnit)
-              NoDimId cName -> Just cName
-              _             -> Nothing
-
-    return Table { tableName        = settingFactPrefix <> factName fact
-                 , tableColumns     = columns ++ map fst fks
-                 , tableConstraints = UniqueKey ukColNames : map snd fks
-                 }
   where
     timeUnitColName colName timeUnit = colName <> "_" <> timeUnitName timeUnit <> "_id"

src/Ringo/Extractor/Internal.hs

@@ -6,28 +6,15 @@ import qualified Data.Text as Text
 import Control.Monad.Reader (Reader, asks)
 import Data.Maybe           (mapMaybe, fromMaybe, fromJust)
 import Data.Monoid          ((<>))
-import Data.List            (nub, find)
+import Data.List            (nub)
 
 import Ringo.Types
+import Ringo.Utils
 
-findTable :: TableName -> [Table] -> Maybe Table
+extractDimensions :: Fact -> Table -> Reader Env [Table]
-findTable tName = find ((== tName) . tableName)
+extractDimensions fact Table {..} = do
-
+  tables <- asks envTables
-findFact :: TableName -> [Fact] -> Maybe Fact
+  prefix <- settingDimPrefix <$> asks envSettings
-findFact fName = find ((== fName) . factName)
-
-findColumn :: ColumnName -> [Column] -> Maybe Column
-findColumn cName = find ((== cName) . columnName)
-
-checkTableForCol :: Table -> ColumnName -> [ValidationError]
-checkTableForCol tab colName =
-  [ MissingColumn (tableName tab) colName |
-      not . any ((colName ==) . columnName) . tableColumns $ tab ]
-
-extractDimensions' :: Fact -> Table -> Reader ExtractorEnv [Table]
-extractDimensions' fact Table {..} = do
-  tables <- asks eeTables
-  prefix <- settingDimPrefix <$> asks eeSettings
   return $ dimsFromIds tables ++ dimsFromVals prefix
   where
     dimsFromIds tables =
@@ -59,15 +46,15 @@ dimColumnName :: Text.Text -> ColumnName -> ColumnName
 dimColumnName dimName columnName =
   fromMaybe columnName . Text.stripPrefix (dimName <> "_") $ columnName
 
-extractAllDimensions' :: Fact -> Table -> Reader ExtractorEnv [Table]
+extractAllDimensions :: Fact -> Table -> Reader Env [Table]
-extractAllDimensions' fact table = do
+extractAllDimensions fact table = do
-  myDims     <- extractDimensions' fact table
+  myDims     <- extractDimensions fact table
   parentDims <- concat <$> mapM extract (factParentNames fact)
   return . nub $ myDims ++ parentDims
   where
     extract fName = do
-      tables <- asks eeTables
+      tables <- asks envTables
-      facts  <- asks eeFacts
+      facts  <- asks envFacts
       let pFact      = fromJust . findFact fName $ facts
           pFactTable = fromJust . findTable (factTableName pFact) $ tables
-      extractAllDimensions' pFact pFactTable
+      extractAllDimensions pFact pFactTable

src/Ringo/Generator.hs

@@ -48,7 +48,7 @@ dimensionTableInsertSQL dimPrefix fact dimTableName = let
     DimVal dName cName | dimPrefix <> dName == dimTableName -> Just (dimColumnName dName cName, cName)
     _ -> Nothing
   in "INSERT INTO " <> dimTableName <> " (\n"
-        <> colNamesString (map fst colMapping)
+       <> colNamesString (map fst colMapping)
-        <> "\n) SELECT DISTINCT \n"
+       <> "\n) SELECT DISTINCT \n"
-        <> colNamesString (map snd colMapping)
+       <> colNamesString (map snd colMapping)
-        <> "\nFROM " <> factTableName fact
+       <> "\nFROM " <> factTableName fact

src/Ringo/Types.hs

@@ -79,8 +79,8 @@ data ValidationError = MissingTable TableName
                      | MissingColumn TableName ColumnName
                      deriving (Eq, Show)
 
-data ExtractorEnv = ExtractorEnv
+data Env = Env
-                    { eeTables   :: [Table]
+           { envTables   :: [Table]
-                    , eeFacts    :: [Fact]
+           , envFacts    :: [Fact]
-                    , eeSettings :: Settings
+           , envSettings :: Settings
-                    } deriving (Eq, Show)
+           } deriving (Eq, Show)

src/Ringo/Utils.hs

@@ -0,0 +1,14 @@
+module Ringo.Utils where
+
+import Data.List (find)
+
+import Ringo.Types
+
+findTable :: TableName -> [Table] -> Maybe Table
+findTable tName = find ((== tName) . tableName)
+
+findFact :: TableName -> [Fact] -> Maybe Fact
+findFact fName = find ((== fName) . factName)
+
+findColumn :: ColumnName -> [Column] -> Maybe Column
+findColumn cName = find ((== cName) . columnName)

src/Ringo/Validator.hs

@@ -0,0 +1,56 @@
+module Ringo.Validator where
+
+import Control.Monad.Reader (Reader, asks)
+import Data.Maybe           (mapMaybe, fromMaybe, fromJust)
+import Data.Monoid          ((<>))
+
+import Ringo.Types
+import Ringo.Utils
+
+checkTableForCol :: Table -> ColumnName -> [ValidationError]
+checkTableForCol tab colName =
+  [ MissingColumn (tableName tab) colName |
+      not . any ((colName ==) . columnName) . tableColumns $ tab ]
+
+validateTable :: Table -> Reader Env [ValidationError]
+validateTable table = do
+  tables <- asks envTables
+  return . concatMap (checkConstraint tables) . tableConstraints $ table
+  where
+    checkConstraint _ (PrimaryKey colName)    = checkTableForCol table colName
+    checkConstraint _ (UniqueKey columnNames) = checkTableForColRefs table columnNames
+    checkConstraint tables (ForeignKey oTableName columnNames) =
+      case findTable oTableName tables of
+        Just oTable -> checkTableForColRefs table (map fst columnNames)
+                         ++ checkTableForColRefs oTable (map snd columnNames)
+        Nothing     -> [ MissingTable oTableName ]
+
+    checkTableForColRefs tab = concatMap (checkTableForCol tab)
+
+validateFact :: Fact -> Reader Env [ValidationError]
+validateFact Fact {..} = do
+  tables <- asks envTables
+  case findTable factTableName tables of
+    Nothing    -> return [ MissingTable factTableName ]
+    Just table -> do
+      tableVs   <- validateTable table
+      parentVs  <- concat <$> mapM checkFactParents factParentNames
+      let colVs = concatMap (checkColumn table) factColumns
+      return $ tableVs ++ parentVs ++ colVs
+  where
+    checkFactParents fName = do
+      facts  <- asks envFacts
+      case findFact fName facts of
+        Nothing    -> return [ MissingFact fName ]
+        Just pFact -> validateFact pFact
+
+    checkColumn table = maybe [] (checkTableForCol table) . factColumnName
+
+withFactValidation :: Fact -> (Table -> 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