git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Print five exhaustivity checking warnings for each definition instead the whole set.
f73a5ffnicodelpiano
src/Language/PureScript/Errors.hs+6−6
compare with golang
unifiedsplit
@@ -120,7 +120,7 @@ data SimpleErrorMessage
120 | TransitiveExportError DeclarationRef [DeclarationRef]
120 | TransitiveExportError DeclarationRef [DeclarationRef]
121 | ShadowedName Ident
121 | ShadowedName Ident
122 | WildcardInferredType Type
122 | WildcardInferredType Type
123− | NotExhaustivePattern [[Binder]]
123+ | NotExhaustivePattern [[Binder]] Bool
124 | ClassOperator ProperName Ident
124 | ClassOperator ProperName Ident
125 deriving (Show)
125 deriving (Show)
126
126
@@ -230,7 +230,7 @@ errorCode em = case unwrapErrorMessage em of
230 (TransitiveExportError _ _) -> "TransitiveExportError"
230 (TransitiveExportError _ _) -> "TransitiveExportError"
231 (ShadowedName _) -> "ShadowedName"
231 (ShadowedName _) -> "ShadowedName"
232 (WildcardInferredType _) -> "WildcardInferredType"
232 (WildcardInferredType _) -> "WildcardInferredType"
233− (NotExhaustivePattern _) -> "NotExhaustivePattern"
233+ (NotExhaustivePattern _ _) -> "NotExhaustivePattern"
234 (ClassOperator _ _) -> "ClassOperator"
234 (ClassOperator _ _) -> "ClassOperator"
235
235
236-- |
236-- |
@@ -561,11 +561,11 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError
561 ]
561 ]
562 goSimple (WildcardInferredType ty) =
562 goSimple (WildcardInferredType ty) =
563 line $ "The wildcard type definition has the inferred type " ++ prettyPrintType ty
563 line $ "The wildcard type definition has the inferred type " ++ prettyPrintType ty
564− goSimple (NotExhaustivePattern bs) =
564+ goSimple (NotExhaustivePattern bs b) =
565− paras $ [ line "Pattern could not be determined to cover all cases."
565+ indent $ paras $ [ line "Pattern could not be determined to cover all cases."
566 , line $ "The definition has the following uncovered cases:\n"
566 , line $ "The definition has the following uncovered cases:\n"
567− , indent $ Box.hsep 1 Box.left (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs))
567+ , Box.hsep 1 Box.left (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs))
568− ]
568+ ] ++ if not b then [line "..."] else []
569 go (NotYetDefined names err) =
569 go (NotYetDefined names err) =
570 paras [ line $ "The following are not yet defined here: " ++ intercalate ", " (map show names) ++ ":"
570 paras [ line $ "The following are not yet defined here: " ++ intercalate ", " (map show names) ++ ":"
571 , indent $ go err
571 , indent $ go err
src/Language/PureScript/Linter/Exhaustive.hs+2−1
@@ -31,6 +31,7 @@ import Data.Function (on)
31
31
32import Control.Monad (unless)
32import Control.Monad (unless)
33import Control.Applicative
33import Control.Applicative
34+import Control.Arrow (second)
34import Control.Monad.Writer.Class
35import Control.Monad.Writer.Class
35
36
36import Language.PureScript.AST.Binders
37import Language.PureScript.AST.Binders
@@ -241,7 +242,7 @@ checkExhaustive env mn cas = makeResult . nub $ foldl' step [initial] cas
241 makeResult :: [[Binder]] -> m ()
242 makeResult :: [[Binder]] -> m ()
242 makeResult bss = unless (null bss) tellWarning
243 makeResult bss = unless (null bss) tellWarning
243 where
244 where
244− tellWarning = tell . errorMessage $ NotExhaustivePattern bss
245+ tellWarning = tell . errorMessage . uncurry NotExhaustivePattern . second null . splitAt 5 $ bss
245
246
246-- |
247-- |
247-- Exhaustivity checking over a list of declarations
248-- Exhaustivity checking over a list of declarations