Removes unnecessary Env like type from Validator.

master
Abhinav Sarkar 2016-07-11 17:49:56 +05:30
parent 18dde15427
commit e70c7f1174
No known key found for this signature in database
GPG Key ID: 7C9166A6F5465AD5
1 changed files with 25 additions and 27 deletions

View File

@ -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,8 +85,9 @@ 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
in flip runReader env $ do
tableVs <- concat <$> mapM validateTable tables tableVs <- concat <$> mapM validateTable tables
factVs <- concat <$> mapM validateFact facts factVs <- concat <$> mapM validateFact facts
let dupTableVs = [ DuplicateTable table | table <- findDups . map tableName $ tables ] let dupTableVs = [ DuplicateTable table | table <- findDups . map tableName $ tables ]
@ -103,10 +101,10 @@ validateEnv tables facts settings@Settings {..} typeDefaults =
>>> groupBy ((==) `on` fst) >>> groupBy ((==) `on` fst)
>>> filter (map snd >>> nub >>> length >>> (/= 1)) >>> filter (map snd >>> nub >>> length >>> (/= 1))
>>> map (head >>> fst >>> DuplicateDimension) >>> map (head >>> fst >>> DuplicateDimension)
vs = nub $ tableVs ++ factVs ++ dupTableVs ++ dupFactVs ++ dupColVs ++ dupDimVs errors = nub $ tableVs ++ factVs ++ dupTableVs ++ dupFactVs ++ dupColVs ++ dupDimVs
if null vs return $ if null errors
then return . Right $ Env tables facts settings typeDefaults then Right env
else return . Left $ vs 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