@@ -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 (duplicateDataConstructors 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,11 @@ getLets decls = defs : concatMap getSubLets defs
3232 Def pattern expr -> [ defs | Let defs _ <- universeBi expr ]
3333 TypeAnnotation _ _ -> []
3434
35+msg :: String
36+msg = "Syntax Error: There can only be one "
37+
38+dups :: Eq a => [a] -> [a]
39+dups = map head . filter ((>1) . length) . List.group
3540
3641duplicates :: [Def t v] -> [String]
3742duplicates defs =
@@ -39,13 +44,15 @@ duplicates defs =
3944 where
4045 annotations = List.sort [ name | TypeAnnotation name _ <- defs ]
4146 definitions = List.sort $ concatMap Set.toList [ boundVars pattern | Def pattern _ <- defs ]
42−
43− dups = map head . filter ((>1) . length) . List.group
44−
45− msg = "Syntax Error: There can only be one "
4647 defMsg x = msg ++ "definition of '" ++ x ++ "'."
4748 annMsg x = msg ++ "type annotation for '" ++ x ++ "'."
4849
50+duplicateDataConstructors :: [Declaration t v] -> [String]
51+duplicateDataConstructors decls = map ctorMsg . dups $ constructors
52+ where
53+ constructors = List.sort . concat $
54+ [ map fst patterns | Datatype _ _ patterns <- decls ]
55+ ctorMsg x = msg ++ "definition of '" ++ x ++ "'."
4956
5057badOrder :: [Def t v] -> [String]
5158badOrder defs = go defs