Tool to transform OLTP database schemas to OLAP database schemas automatically
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
ringo/ringo/src/Ringo/Validator.hs

111 lines
5.0 KiB

7 years ago
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PatternSynonyms #-}
module Ringo.Validator (validateConfig) where
import qualified Data.Map as Map
import qualified Data.Text as Text
import Prelude.Compat
import Control.Monad.Reader (Reader, ask, runReader)
import Data.Function (on)
7 years ago
import Data.Maybe (isJust, fromJust)
import Data.List (nub, group, groupBy, sort)
7 years ago
import Ringo.Extractor.Internal
import Ringo.Types.Internal
import Ringo.Utils
checkTableForCol :: Table -> ColumnName -> [ValidationError]
checkTableForCol tab colName =
[ MissingColumn (tableName tab) colName |
not . any ((colName ==) . columnName) . tableColumns $ tab ]
validateTable :: Table -> Reader Config [ValidationError]
validateTable table = do
Config tables _ _ _ <- ask
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 Config [ValidationError]
validateFact Fact {..} = do
Config tables _ _ typeDefaults <- ask
let defaults = Map.keys typeDefaults
case findTable factTableName tables of
Nothing -> return [ MissingTable factTableName ]
Just table -> do
7 years ago
tableVs <- validateTable table
parentVs <- concat <$> mapM checkFactParents factParentNames
let colVs = concatMap (checkColumn tables table) factColumns
timeVs = [ MissingTimeColumn factTableName
| null ([ cName | FactColumn cName DimTime <- factColumns ] :: [ColumnName]) ]
notNullVs = [ MissingNotNullConstraint factTableName cName
| FactColumn cName DimTime <- factColumns
, let col = findColumn cName (tableColumns table)
, isJust col
, columnNullable (fromJust col) == Null ]
typeDefaultVs =
[ MissingTypeDefault cType
| cName <- [ c | FactColumn c DimVal {..} <- factColumns ]
++ [ c | FactColumn c NoDimId <- factColumns ]
++ [ c | FactColumn c TenantId <- factColumns ]
++ [ c | FactColumn c DimId {..} <- factColumns ]
, let col = findColumn cName (tableColumns table)
, isJust col
, let cType = columnType $ fromJust col
, not . any (`Text.isPrefixOf` cType) $ defaults ]
return $ tableVs ++ parentVs ++ colVs ++ timeVs ++ notNullVs ++ typeDefaultVs
where
checkFactParents fName = do
Config _ facts _ _ <- ask
case findFact fName facts of
Nothing -> return [ MissingFact fName ]
Just pFact -> validateFact pFact
checkColumn tables table factCol =
7 years ago
maybe [] (checkTableForCol table) (factSourceColumnName factCol)
++ checkColumnTable tables factCol
checkColumnTable :: [Table] -> FactColumn -> [ValidationError]
checkColumnTable tables FactColumn {..} = case factColType of
DimId {factColTargetTable = tName} -> maybe [ MissingTable tName ] (const []) $ findTable tName tables
_ -> []
validateConfig :: [Table] -> [Fact] -> Settings -> TypeDefaults -> Either [ValidationError] Config
validateConfig tables facts settings@Settings {..} typeDefaults = let
config = Config tables facts settings typeDefaults
in flip runReader config $ do
tableVs <- concat <$> mapM validateTable tables
factVs <- concat <$> mapM validateFact facts
let dupTableVs = [ DuplicateTable table | table <- findDups . map tableName $ tables ]
dupFactVs = [ DuplicateFact fact | fact <- findDups . map factName $ facts ]
dupColVs = [ DuplicateColumn tableName col
| Table{..} <- tables
, col <- findDups . map columnName $ tableColumns ]
dupDimVs = facts
>>- concatMap (dimColumnMappings settingDimPrefix)
>>> sort
>>> groupBy ((==) `on` fst)
>>> filter (map snd >>> nub >>> length >>> (/= 1))
>>> map (head >>> fst >>> DuplicateDimension)
errors = nub $ tableVs ++ factVs ++ dupTableVs ++ dupFactVs ++ dupColVs ++ dupDimVs
return $ if null errors
then Right config
else Left errors
where
findDups =
sort >>> group >>> map (head &&& length) >>> filter (snd >>> (> 1)) >>> map fst