Removes unnecessary Env like type from Validator.
parent
18dde15427
commit
e70c7f1174
|
@ -16,20 +16,17 @@ import Data.Maybe (isJust, fromJust)
|
||||||
import Data.List (nub, group, groupBy, sort)
|
import Data.List (nub, group, groupBy, sort)
|
||||||
|
|
||||||
import Ringo.Extractor.Internal
|
import Ringo.Extractor.Internal
|
||||||
import Ringo.Types
|
|
||||||
import Ringo.Types.Internal
|
import Ringo.Types.Internal
|
||||||
import Ringo.Utils
|
import Ringo.Utils
|
||||||
|
|
||||||
data RawEnv = RawEnv ![Table] ![Fact] !Settings !TypeDefaults deriving (Show)
|
|
||||||
|
|
||||||
checkTableForCol :: Table -> ColumnName -> [ValidationError]
|
checkTableForCol :: Table -> ColumnName -> [ValidationError]
|
||||||
checkTableForCol tab colName =
|
checkTableForCol tab colName =
|
||||||
[ MissingColumn (tableName tab) colName |
|
[ MissingColumn (tableName tab) colName |
|
||||||
not . any ((colName ==) . columnName) . tableColumns $ tab ]
|
not . any ((colName ==) . columnName) . tableColumns $ tab ]
|
||||||
|
|
||||||
validateTable :: Table -> Reader RawEnv [ValidationError]
|
validateTable :: Table -> Reader Env [ValidationError]
|
||||||
validateTable table = do
|
validateTable table = do
|
||||||
RawEnv tables _ _ _ <- ask
|
Env tables _ _ _ <- ask
|
||||||
return . concatMap (checkConstraint tables) . tableConstraints $ table
|
return . concatMap (checkConstraint tables) . tableConstraints $ table
|
||||||
where
|
where
|
||||||
checkConstraint _ (PrimaryKey colName) = checkTableForCol table colName
|
checkConstraint _ (PrimaryKey colName) = checkTableForCol table colName
|
||||||
|
@ -42,9 +39,9 @@ validateTable table = do
|
||||||
|
|
||||||
checkTableForColRefs tab = concatMap (checkTableForCol tab)
|
checkTableForColRefs tab = concatMap (checkTableForCol tab)
|
||||||
|
|
||||||
validateFact :: Fact -> Reader RawEnv [ValidationError]
|
validateFact :: Fact -> Reader Env [ValidationError]
|
||||||
validateFact Fact {..} = do
|
validateFact Fact {..} = do
|
||||||
RawEnv tables _ _ typeDefaults <- ask
|
Env tables _ _ typeDefaults <- ask
|
||||||
let defaults = Map.keys typeDefaults
|
let defaults = Map.keys typeDefaults
|
||||||
case findTable factTableName tables of
|
case findTable factTableName tables of
|
||||||
Nothing -> return [ MissingTable factTableName ]
|
Nothing -> return [ MissingTable factTableName ]
|
||||||
|
@ -73,7 +70,7 @@ validateFact Fact {..} = do
|
||||||
return $ tableVs ++ parentVs ++ colVs ++ timeVs ++ notNullVs ++ typeDefaultVs
|
return $ tableVs ++ parentVs ++ colVs ++ timeVs ++ notNullVs ++ typeDefaultVs
|
||||||
where
|
where
|
||||||
checkFactParents fName = do
|
checkFactParents fName = do
|
||||||
RawEnv _ facts _ _ <- ask
|
Env _ facts _ _ <- ask
|
||||||
case findFact fName facts of
|
case findFact fName facts of
|
||||||
Nothing -> return [ MissingFact fName ]
|
Nothing -> return [ MissingFact fName ]
|
||||||
Just pFact -> validateFact pFact
|
Just pFact -> validateFact pFact
|
||||||
|
@ -88,25 +85,26 @@ validateFact Fact {..} = do
|
||||||
_ -> []
|
_ -> []
|
||||||
|
|
||||||
validateEnv :: [Table] -> [Fact] -> Settings -> TypeDefaults -> Either [ValidationError] Env
|
validateEnv :: [Table] -> [Fact] -> Settings -> TypeDefaults -> Either [ValidationError] Env
|
||||||
validateEnv tables facts settings@Settings {..} typeDefaults =
|
validateEnv tables facts settings@Settings {..} typeDefaults = let
|
||||||
flip runReader (RawEnv tables facts settings typeDefaults) $ do
|
env = Env tables facts settings typeDefaults
|
||||||
tableVs <- concat <$> mapM validateTable tables
|
in flip runReader env $ do
|
||||||
factVs <- concat <$> mapM validateFact facts
|
tableVs <- concat <$> mapM validateTable tables
|
||||||
let dupTableVs = [ DuplicateTable table | table <- findDups . map tableName $ tables ]
|
factVs <- concat <$> mapM validateFact facts
|
||||||
let dupFactVs = [ DuplicateFact fact | fact <- findDups . map factName $ facts ]
|
let dupTableVs = [ DuplicateTable table | table <- findDups . map tableName $ tables ]
|
||||||
let dupColVs = [ DuplicateColumn tableName col
|
let dupFactVs = [ DuplicateFact fact | fact <- findDups . map factName $ facts ]
|
||||||
| Table{..} <- tables
|
let dupColVs = [ DuplicateColumn tableName col
|
||||||
, col <- findDups . map columnName $ tableColumns ]
|
| Table{..} <- tables
|
||||||
let dupDimVs = facts
|
, col <- findDups . map columnName $ tableColumns ]
|
||||||
>>- concatMap (dimColumnMappings settingDimPrefix)
|
let dupDimVs = facts
|
||||||
>>> sort
|
>>- concatMap (dimColumnMappings settingDimPrefix)
|
||||||
>>> groupBy ((==) `on` fst)
|
>>> sort
|
||||||
>>> filter (map snd >>> nub >>> length >>> (/= 1))
|
>>> groupBy ((==) `on` fst)
|
||||||
>>> map (head >>> fst >>> DuplicateDimension)
|
>>> filter (map snd >>> nub >>> length >>> (/= 1))
|
||||||
vs = nub $ tableVs ++ factVs ++ dupTableVs ++ dupFactVs ++ dupColVs ++ dupDimVs
|
>>> map (head >>> fst >>> DuplicateDimension)
|
||||||
if null vs
|
errors = nub $ tableVs ++ factVs ++ dupTableVs ++ dupFactVs ++ dupColVs ++ dupDimVs
|
||||||
then return . Right $ Env tables facts settings typeDefaults
|
return $ if null errors
|
||||||
else return . Left $ vs
|
then Right env
|
||||||
|
else Left errors
|
||||||
where
|
where
|
||||||
findDups =
|
findDups =
|
||||||
sort >>> group >>> map (head &&& length) >>> filter (snd >>> (> 1)) >>> map fst
|
sort >>> group >>> map (head &&& length) >>> filter (snd >>> (> 1)) >>> map fst
|
||||||
|
|
Loading…
Reference in New Issue