Refactors to move validation logic to its own namespace
parent
6e1341b52a
commit
041d55f9dd
|
|
@ -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
|
||||
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"
|
||||
|
|
|
|||
|
|
@ -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…
Reference in New Issue