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

110 lines
5.0 KiB

{-# 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)
import Data.Maybe (isJust, fromJust)
import Data.List (nub, group, groupBy, sort)
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
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 =
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