@@ -17,11 +17,11 @@ mistakes :: (Data t, Data v) => [Declaration t v] -> [Doc]
1717mistakes decls =
1818 concat [ infiniteTypeAliases decls
1919 , illFormedTypes decls
20+ , map P.text (duplicateConstructors decls)
2021 , map P.text (concatMap findErrors (getLets decls)) ]
2122 where
2223 findErrors defs = duplicates defs ++ badOrder defs
2324
24−
2525getLets :: (Data t, Data v) => [Declaration t v] -> [[Def t v]]
2626getLets decls = defs : concatMap getSubLets defs
2727 where
@@ -32,6 +32,12 @@ getLets decls = defs : concatMap getSubLets defs
3232 Def pattern expr -> [ defs | Let defs _ <- universeBi expr ]
3333 TypeAnnotation _ _ -> []
3434
35+dups :: Eq a => [a] -> [a]
36+dups = map head . filter ((>1) . length) . List.group
37+
38+dupErr :: String -> String -> String
39+dupErr err x =
40+ "Syntax Error: There can only be one " ++ err ++ " '" ++ x ++ "'."
3541
3642duplicates :: [Def t v] -> [String]
3743duplicates defs =
@@ -39,13 +45,18 @@ duplicates defs =
3945 where
4046 annotations = List.sort [ name | TypeAnnotation name _ <- defs ]
4147 definitions = List.sort $ concatMap Set.toList [ boundVars pattern | Def pattern _ <- defs ]
48+ defMsg = dupErr "definition of"
49+ annMsg = dupErr "type annotation for"
4250
43− dups = map head . filter ((>1) . length) . List.group
44−
45− msg = "Syntax Error: There can only be one "
46− defMsg x = msg ++ "definition of '" ++ x ++ "'."
47− annMsg x = msg ++ "type annotation for '" ++ x ++ "'."
48−
51+duplicateConstructors :: [Declaration t v] -> [String]
52+duplicateConstructors decls =
53+ map typeMsg (dups typeCtors) ++ map dataMsg (dups dataCtors)
54+ where
55+ typeCtors = List.sort [ name | Datatype name _ _ <- decls ]
56+ dataCtors = List.sort . concat $
57+ [ map fst patterns | Datatype _ _ patterns <- decls ]
58+ dataMsg = dupErr "definition of data constructor"
59+ typeMsg = dupErr "definition of type constructor"
4960
5061badOrder :: [Def t v] -> [String]
5162badOrder defs = go defs