+This variable shows the maximum number of lines of output generated for warnings.
+It will limit the number of patterns/equations displayed to@ maximum_output@.
+
+(ToDo: add command-line option?)
+
+\begin{code}
+maximum_output = 4
+\end{code}
+
+The next two functions create the warning message.
+
+\begin{code}
+dsShadowWarn :: DsMatchContext -> [EquationInfo] -> DsM ()
+dsShadowWarn ctx@(DsMatchContext kind _ _) qs = dsWarn warn
+ where
+ warn | length qs > maximum_output
+ = pp_context ctx (ptext SLIT("are overlapped"))
+ (\ f -> vcat (map (ppr_eqn f kind) (take maximum_output qs)) $$
+ ptext SLIT("..."))
+ | otherwise
+ = pp_context ctx (ptext SLIT("are overlapped"))
+ (\ f -> vcat $ map (ppr_eqn f kind) qs)
+
+
+dsIncompleteWarn :: DsMatchContext -> [ExhaustivePat] -> DsM ()
+dsIncompleteWarn ctx@(DsMatchContext kind _ _) pats = dsWarn warn
+ where
+ warn = pp_context ctx (ptext SLIT("are non-exhaustive"))
+ (\f -> hang (ptext SLIT("Patterns not matched:"))
+ 4 ((vcat $ map (ppr_incomplete_pats kind)
+ (take maximum_output pats))
+ $$ dots))
+
+ dots | length pats > maximum_output = ptext SLIT("...")
+ | otherwise = empty
+
+pp_context NoMatchContext msg rest_of_msg_fun
+ = dontAddErrLoc (ptext SLIT("Some match(es)") <+> hang msg 8 (rest_of_msg_fun id))
+
+pp_context (DsMatchContext kind pats loc) msg rest_of_msg_fun
+ = addWarnLocHdrLine loc message (nest 8 (rest_of_msg_fun pref))
+ where
+ (ppr_match, pref)
+ = case kind of
+ FunRhs fun -> (pprMatchContext kind, \ pp -> ppr fun <+> pp)
+ other -> (pprMatchContext kind <+> ppr_pats pats, \ pp -> pp)
+
+ message = ptext SLIT("Pattern match(es)") <+> msg <+> ppr_match <> char ':'
+
+ppr_pats pats = sep (map ppr pats)
+
+ppr_shadow_pats kind pats
+ = sep [ppr_pats pats, ptext (matchSeparator kind), ptext SLIT("...")]
+
+ppr_incomplete_pats kind (pats,[]) = ppr_pats pats
+ppr_incomplete_pats kind (pats,constraints) =
+ sep [ppr_pats pats, ptext SLIT("with"),
+ sep (map ppr_constraint constraints)]
+
+
+ppr_constraint (var,pats) = sep [ppr var, ptext SLIT("`notElem`"), ppr pats]
+
+ppr_eqn prefixF kind (EqnInfo _ _ pats _) = prefixF (ppr_shadow_pats kind pats)
+\end{code}
+
+