Merge pull request #381 from bcdarwin/master
Add check for duplicate constructors within the same unit
This commit is contained in:
commit
32d162732b
1 changed files with 18 additions and 7 deletions
|
@ -17,11 +17,11 @@ mistakes :: (Data t, Data v) => [Declaration t v] -> [Doc]
|
|||
mistakes decls =
|
||||
concat [ infiniteTypeAliases decls
|
||||
, illFormedTypes decls
|
||||
, map P.text (duplicateConstructors decls)
|
||||
, map P.text (concatMap findErrors (getLets decls)) ]
|
||||
where
|
||||
findErrors defs = duplicates defs ++ badOrder defs
|
||||
|
||||
|
||||
getLets :: (Data t, Data v) => [Declaration t v] -> [[Def t v]]
|
||||
getLets decls = defs : concatMap getSubLets defs
|
||||
where
|
||||
|
@ -32,6 +32,12 @@ getLets decls = defs : concatMap getSubLets defs
|
|||
Def pattern expr -> [ defs | Let defs _ <- universeBi expr ]
|
||||
TypeAnnotation _ _ -> []
|
||||
|
||||
dups :: Eq a => [a] -> [a]
|
||||
dups = map head . filter ((>1) . length) . List.group
|
||||
|
||||
dupErr :: String -> String -> String
|
||||
dupErr err x =
|
||||
"Syntax Error: There can only be one " ++ err ++ " '" ++ x ++ "'."
|
||||
|
||||
duplicates :: [Def t v] -> [String]
|
||||
duplicates defs =
|
||||
|
@ -39,13 +45,18 @@ duplicates defs =
|
|||
where
|
||||
annotations = List.sort [ name | TypeAnnotation name _ <- defs ]
|
||||
definitions = List.sort $ concatMap Set.toList [ boundVars pattern | Def pattern _ <- defs ]
|
||||
defMsg = dupErr "definition of"
|
||||
annMsg = dupErr "type annotation for"
|
||||
|
||||
dups = map head . filter ((>1) . length) . List.group
|
||||
|
||||
msg = "Syntax Error: There can only be one "
|
||||
defMsg x = msg ++ "definition of '" ++ x ++ "'."
|
||||
annMsg x = msg ++ "type annotation for '" ++ x ++ "'."
|
||||
|
||||
duplicateConstructors :: [Declaration t v] -> [String]
|
||||
duplicateConstructors decls =
|
||||
map typeMsg (dups typeCtors) ++ map dataMsg (dups dataCtors)
|
||||
where
|
||||
typeCtors = List.sort [ name | Datatype name _ _ <- decls ]
|
||||
dataCtors = List.sort . concat $
|
||||
[ map fst patterns | Datatype _ _ patterns <- decls ]
|
||||
dataMsg = dupErr "definition of data constructor"
|
||||
typeMsg = dupErr "definition of type constructor"
|
||||
|
||||
badOrder :: [Def t v] -> [String]
|
||||
badOrder defs = go defs
|
||||
|
|
Loading…
Reference in a new issue