f73a5ff · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Print five exhaustivity checking warnings for each definition instead the whole set.

commitf73a5ff715051efa3bc56292f49ca05e6fd37da6 authornicodelpiano <ndel314@gmail.com> dateFri 17 Jul 2015, 18:23 (11 years ago) parent08ab297

2 files changed+8−7

compare with golang

unifiedsplit

src/Language/PureScript/Errors.hs+6−6 src/Language/PureScript/Linter/Exhaustive.hs+2−1

src/Language/PureScript/Errors.hs+6−6

@@ -120,7 +120,7 @@ data SimpleErrorMessage

120120 | TransitiveExportError DeclarationRef [DeclarationRef]

121121 | ShadowedName Ident

122122 | WildcardInferredType Type

123− | NotExhaustivePattern [[Binder]]

123+ | NotExhaustivePattern [[Binder]] Bool

124124 | ClassOperator ProperName Ident

125125 deriving (Show)

126126

@@ -230,7 +230,7 @@ errorCode em = case unwrapErrorMessage em of

230230 (TransitiveExportError _ _) -> "TransitiveExportError"

231231 (ShadowedName _) -> "ShadowedName"

232232 (WildcardInferredType _) -> "WildcardInferredType"

233− (NotExhaustivePattern _) -> "NotExhaustivePattern"

233+ (NotExhaustivePattern _ _) -> "NotExhaustivePattern"

234234 (ClassOperator _ _) -> "ClassOperator"

235235

236236-- |

@@ -561,11 +561,11 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError

561561 ]

562562 goSimple (WildcardInferredType ty) =

563563 line $ "The wildcard type definition has the inferred type " ++ prettyPrintType ty

564− goSimple (NotExhaustivePattern bs) =

565− paras $ [ line "Pattern could not be determined to cover all cases."

564+ goSimple (NotExhaustivePattern bs b) =

565+ indent $ paras $ [ line "Pattern could not be determined to cover all cases."

566566 , line $ "The definition has the following uncovered cases:\n"

567− , indent $ Box.hsep 1 Box.left (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs))

568− ]

567+ , Box.hsep 1 Box.left (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs))

568+ ] ++ if not b then [line "..."] else []

569569 go (NotYetDefined names err) =

570570 paras [ line $ "The following are not yet defined here: " ++ intercalate ", " (map show names) ++ ":"

571571 , indent $ go err

src/Language/PureScript/Linter/Exhaustive.hs+2−1

@@ -31,6 +31,7 @@ import Data.Function (on)

3131

3232import Control.Monad (unless)

3333import Control.Applicative

34+import Control.Arrow (second)

3435import Control.Monad.Writer.Class

3536

3637import Language.PureScript.AST.Binders

@@ -241,7 +242,7 @@ checkExhaustive env mn cas = makeResult . nub $ foldl' step [initial] cas

241242 makeResult :: [[Binder]] -> m ()

242243 makeResult bss = unless (null bss) tellWarning

243244 where

244− tellWarning = tell . errorMessage $ NotExhaustivePattern bss

245+ tellWarning = tell . errorMessage . uncurry NotExhaustivePattern . second null . splitAt 5 $ bss

245246

246247-- |

247248-- Exhaustivity checking over a list of declarations