Refactors to move validation logic to its own namespace

pull/1/head
Abhinav Sarkar 7 years ago
parent 6e1341b52a
commit 041d55f9dd
  1. 6
      src/Ringo.hs
  2. 124
      src/Ringo/Extractor.hs
  3. 37
      src/Ringo/Extractor/Internal.hs
  4. 8
      src/Ringo/Generator.hs
  5. 10
      src/Ringo/Types.hs
  6. 14
      src/Ringo/Utils.hs
  7. 56
      src/Ringo/Validator.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

@ -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
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 ]
checkTableForColRefs tab = concatMap (checkTableForCol tab)
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
checkColumn table = maybe [] (checkTableForCol table) . factColumnName
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
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
}
import Ringo.Utils
extractFactTable :: Fact -> Table -> Reader Env Table
extractFactTable fact table = do
Settings {..} <- asks envSettings
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"

@ -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

@ -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

@ -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)

@ -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)

@ -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
Loading…
Cancel
Save