113 lines
5.1 KiB
Haskell
113 lines
5.1 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
{-# LANGUAGE NoImplicitPrelude #-}
|
|
{-# LANGUAGE GADTs #-}
|
|
{-# LANGUAGE PatternSynonyms #-}
|
|
|
|
module Ringo.Validator (validateEnv) 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
|
|
import Ringo.Types.Internal
|
|
import Ringo.Utils
|
|
|
|
data RawEnv = RawEnv ![Table] ![Fact] !Settings !TypeDefaults deriving (Show)
|
|
|
|
checkTableForCol :: Table -> ColumnName -> [ValidationError]
|
|
checkTableForCol tab colName =
|
|
[ MissingColumn (tableName tab) colName |
|
|
not . any ((colName ==) . columnName) . tableColumns $ tab ]
|
|
|
|
validateTable :: Table -> Reader RawEnv [ValidationError]
|
|
validateTable table = do
|
|
RawEnv 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 RawEnv [ValidationError]
|
|
validateFact Fact {..} = do
|
|
RawEnv 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
|
|
RawEnv _ 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
|
|
_ -> []
|
|
|
|
validateEnv :: [Table] -> [Fact] -> Settings -> TypeDefaults -> Either [ValidationError] Env
|
|
validateEnv tables facts settings@Settings {..} typeDefaults =
|
|
flip runReader (RawEnv tables facts settings typeDefaults) $ do
|
|
tableVs <- concat <$> mapM validateTable tables
|
|
factVs <- concat <$> mapM validateFact facts
|
|
let dupTableVs = [ DuplicateTable table | table <- findDups . map tableName $ tables ]
|
|
let dupFactVs = [ DuplicateFact fact | fact <- findDups . map factName $ facts ]
|
|
let dupColVs = [ DuplicateColumn tableName col
|
|
| Table{..} <- tables
|
|
, col <- findDups . map columnName $ tableColumns ]
|
|
let dupDimVs = facts
|
|
>>- concatMap (dimColumnMappings settingDimPrefix)
|
|
>>> sort
|
|
>>> groupBy ((==) `on` fst)
|
|
>>> filter (map snd >>> nub >>> length >>> (/= 1))
|
|
>>> map (head >>> fst >>> DuplicateDimension)
|
|
vs = nub $ tableVs ++ factVs ++ dupTableVs ++ dupFactVs ++ dupColVs ++ dupDimVs
|
|
if null vs
|
|
then return . Right $ Env tables facts settings typeDefaults
|
|
else return . Left $ vs
|
|
where
|
|
findDups =
|
|
sort >>> group >>> map (head &&& length) >>> filter (snd >>> (> 1)) >>> map fst
|