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,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