From 041d55f9dd7d8f8f15511d7ca44558d21eb9fe50 Mon Sep 17 00:00:00 2001 From: Abhinav Sarkar Date: Wed, 16 Dec 2015 02:05:36 +0530 Subject: [PATCH] Refactors to move validation logic to its own namespace --- src/Ringo.hs | 6 +- src/Ringo/Extractor.hs | 112 +++++++++----------------------- src/Ringo/Extractor/Internal.hs | 37 ++++------- src/Ringo/Generator.hs | 8 +-- src/Ringo/Types.hs | 10 +-- src/Ringo/Utils.hs | 14 ++++ src/Ringo/Validator.hs | 56 ++++++++++++++++ 7 files changed, 128 insertions(+), 115 deletions(-) create mode 100644 src/Ringo/Utils.hs create mode 100644 src/Ringo/Validator.hs diff --git a/src/Ringo.hs b/src/Ringo.hs index 751c872..357f4cc 100644 --- a/src/Ringo.hs +++ b/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 diff --git a/src/Ringo/Extractor.hs b/src/Ringo/Extractor.hs index 6462837..3498c1b 100644 --- a/src/Ringo/Extractor.hs +++ b/src/Ringo/Extractor.hs @@ -1,7 +1,5 @@ module Ringo.Extractor - ( validateTable - , validateFact - , extractDimensions + ( 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] -validateTable table = do - tables <- asks eeTables - 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 ] +extractFactTable :: Fact -> Table -> Reader Env Table +extractFactTable fact table = do + Settings {..} <- asks envSettings + allDims <- extractAllDimensions fact table - checkTableForColRefs tab = concatMap (checkTableForCol tab) + let intType = "integer" + sourceColumnType colName = columnType . fromJust . findColumn colName . tableColumns $ table -validateFact :: Fact -> Reader ExtractorEnv [ValidationError] -validateFact Fact {..} = do - tables <- asks eeTables - 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 eeFacts - case findFact fName facts of - Nothing -> return [ MissingFact fName ] - Just pFact -> validateFact pFact + 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 ] + _ -> [] - 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) - -> Reader ExtractorEnv (Either [ValidationError] a) -withFactValidation fact func = do - tables <- asks eeTables - errors <- validateFact fact - if not $ null errors - then return $ Left errors - else fmap Right . func . fromJust . findTable (factTableName fact) $ tables + ukColNames = + (++ map (columnName . fst) fks) + . flip mapMaybe (factColumns fact) $ \col -> case col of + DimTime cName -> Just (timeUnitColName cName settingTimeUnit) + NoDimId cName -> Just cName + _ -> Nothing -extractDimensions :: Fact -> Reader ExtractorEnv (Either [ValidationError] [Table]) -extractDimensions fact = withFactValidation fact $ extractDimensions' fact - -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 - } + 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" diff --git a/src/Ringo/Extractor/Internal.hs b/src/Ringo/Extractor/Internal.hs index 191c6ab..d485717 100644 --- a/src/Ringo/Extractor/Internal.hs +++ b/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 -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) - -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 +extractDimensions :: Fact -> Table -> Reader Env [Table] +extractDimensions fact Table {..} = do + tables <- asks envTables + prefix <- settingDimPrefix <$> asks envSettings 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 = do - myDims <- extractDimensions' fact table +extractAllDimensions :: Fact -> Table -> Reader Env [Table] +extractAllDimensions fact table = do + myDims <- extractDimensions fact table parentDims <- concat <$> mapM extract (factParentNames fact) return . nub $ myDims ++ parentDims where extract fName = do - tables <- asks eeTables - facts <- asks eeFacts + tables <- asks envTables + facts <- asks envFacts let pFact = fromJust . findFact fName $ facts pFactTable = fromJust . findTable (factTableName pFact) $ tables - extractAllDimensions' pFact pFactTable + extractAllDimensions pFact pFactTable diff --git a/src/Ringo/Generator.hs b/src/Ringo/Generator.hs index 541f695..b166184 100644 --- a/src/Ringo/Generator.hs +++ b/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) - <> "\n) SELECT DISTINCT \n" - <> colNamesString (map snd colMapping) - <> "\nFROM " <> factTableName fact + <> colNamesString (map fst colMapping) + <> "\n) SELECT DISTINCT \n" + <> colNamesString (map snd colMapping) + <> "\nFROM " <> factTableName fact diff --git a/src/Ringo/Types.hs b/src/Ringo/Types.hs index 9071f50..4017ef7 100644 --- a/src/Ringo/Types.hs +++ b/src/Ringo/Types.hs @@ -79,8 +79,8 @@ data ValidationError = MissingTable TableName | MissingColumn TableName ColumnName deriving (Eq, Show) -data ExtractorEnv = ExtractorEnv - { eeTables :: [Table] - , eeFacts :: [Fact] - , eeSettings :: Settings - } deriving (Eq, Show) +data Env = Env + { envTables :: [Table] + , envFacts :: [Fact] + , envSettings :: Settings + } deriving (Eq, Show) diff --git a/src/Ringo/Utils.hs b/src/Ringo/Utils.hs new file mode 100644 index 0000000..ebe831b --- /dev/null +++ b/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) diff --git a/src/Ringo/Validator.hs b/src/Ringo/Validator.hs new file mode 100644 index 0000000..4e4c4a0 --- /dev/null +++ b/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