@@ -20,10 +20,11 @@
2020module Language.PureScript.Errors where
2121
2222import Data.Either (lefts, rights)
23−import Data.List (intercalate, transpose, nub)
23+import Data.List (intercalate, transpose, nub, nubBy, partition)
2424import Data.Function (on)
2525#if __GLASGOW_HASKELL__ < 710
2626import Data.Foldable (fold, foldMap)
27+import Data.Traversable (traverse)
2728#else
2829import Data.Foldable (fold)
2930#endif
@@ -53,9 +54,7 @@ import qualified Text.Parsec as P
5354import qualified Text.Parsec.Error as PE
5455import Text.Parsec.Error (Message(..))
5556
56−-- |
57−-- A type of error messages
58−--
57+-- | A type of error messages
5958data SimpleErrorMessage
6059 = ErrorParsingExterns P.ParseError
6160 | ErrorParsingFFIModule FilePath
@@ -142,45 +141,54 @@ data SimpleErrorMessage
142141 | ShadowedTypeVar String
143142 | UnusedTypeVar String
144143 | WildcardInferredType Type
144+ | MissingTypeDeclaration Ident
145145 | NotExhaustivePattern [[Binder]] Bool
146146 | OverlappingPattern [[Binder]] Bool
147147 | IncompleteExhaustivityCheck
148148 | ClassOperator ProperName Ident
149149 | MisleadingEmptyTypeImport ModuleName ProperName
150150 | ImportHidingModule ModuleName
151− deriving (Show)
152−
153−-- |
154−-- Wrapper of simpler errors
155−--
156−data ErrorMessage
157− = NotYetDefined [Ident] ErrorMessage
158− | ErrorUnifyingTypes Type Type ErrorMessage
159− | ErrorInExpression Expr ErrorMessage
160− | ErrorInModule ModuleName ErrorMessage
161− | ErrorInInstance (Qualified ProperName) [Type] ErrorMessage
162− | ErrorInSubsumption Type Type ErrorMessage
163− | ErrorCheckingType Expr Type ErrorMessage
164− | ErrorCheckingKind Type ErrorMessage
165− | ErrorInferringType Expr ErrorMessage
166− | ErrorInApplication Expr Type Expr ErrorMessage
167− | ErrorInDataConstructor ProperName ErrorMessage
168− | ErrorInTypeConstructor ProperName ErrorMessage
169− | ErrorInBindingGroup [Ident] ErrorMessage
170− | ErrorInDataBindingGroup ErrorMessage
171− | ErrorInTypeSynonym ProperName ErrorMessage
172− | ErrorInValueDeclaration Ident ErrorMessage
173− | ErrorInTypeDeclaration Ident ErrorMessage
174− | ErrorInForeignImport Ident ErrorMessage
175− | PositionedError SourceSpan ErrorMessage
176− | SimpleErrorWrapper SimpleErrorMessage
177− deriving (Show)
151+ deriving Show
152+
153+-- | Error message hints, providing more detailed information about failure.
154+data ErrorMessageHint
155+ = NotYetDefined [Ident]
156+ | ErrorUnifyingTypes Type Type
157+ | ErrorInExpression Expr
158+ | ErrorInModule ModuleName
159+ | ErrorInInstance (Qualified ProperName) [Type]
160+ | ErrorInSubsumption Type Type
161+ | ErrorCheckingType Expr Type
162+ | ErrorCheckingKind Type
163+ | ErrorInferringType Expr
164+ | ErrorInApplication Expr Type Expr
165+ | ErrorInDataConstructor ProperName
166+ | ErrorInTypeConstructor ProperName
167+ | ErrorInBindingGroup [Ident]
168+ | ErrorInDataBindingGroup
169+ | ErrorInTypeSynonym ProperName
170+ | ErrorInValueDeclaration Ident
171+ | ErrorInTypeDeclaration Ident
172+ | ErrorInForeignImport Ident
173+ | PositionedError SourceSpan
174+ deriving Show
175+
176+-- | Categories of hints
177+data HintCategory
178+ = ExprHint
179+ | KindHint
180+ | CheckHint
181+ | PositionHint
182+ | OtherHint
183+ deriving (Show, Eq)
184+
185+data ErrorMessage = ErrorMessage [ErrorMessageHint] SimpleErrorMessage deriving (Show)
178186
179187instance UnificationError Type ErrorMessage where
180− occursCheckFailed t = SimpleErrorWrapper $ InfiniteType t
188+ occursCheckFailed t = ErrorMessage [] $ InfiniteType t
181189
182190instance UnificationError Kind ErrorMessage where
183− occursCheckFailed k = SimpleErrorWrapper $ InfiniteKind k
191+ occursCheckFailed k = ErrorMessage [] $ InfiniteKind k
184192
185193-- |
186194-- Get the error code for a particular error type
@@ -272,6 +280,7 @@ errorCode em = case unwrapErrorMessage em of
272280 ShadowedTypeVar{} -> "ShadowedTypeVar"
273281 UnusedTypeVar{} -> "UnusedTypeVar"
274282 WildcardInferredType{} -> "WildcardInferredType"
283+ MissingTypeDeclaration{} -> "MissingTypeDeclaration"
275284 NotExhaustivePattern{} -> "NotExhaustivePattern"
276285 OverlappingPattern{} -> "OverlappingPattern"
277286 IncompleteExhaustivityCheck{} -> "IncompleteExhaustivityCheck"
@@ -299,7 +308,7 @@ nonEmpty = not . null . runMultipleErrors
299308-- Create an error set from a single simple error message
300309--
301310errorMessage :: SimpleErrorMessage -> MultipleErrors
302−errorMessage err = MultipleErrors [SimpleErrorWrapper err]
311+errorMessage err = MultipleErrors [ErrorMessage [] err]
303312
304313
305314-- |
@@ -308,12 +317,14 @@ errorMessage err = MultipleErrors [SimpleErrorWrapper err]
308317singleError :: ErrorMessage -> MultipleErrors
309318singleError = MultipleErrors . pure
310319
311−-- |
312−-- Lift a function on ErrorMessage to a function on MultipleErrors
313−--
320+-- | Lift a function on ErrorMessage to a function on MultipleErrors
314321onErrorMessages :: (ErrorMessage -> ErrorMessage) -> MultipleErrors -> MultipleErrors
315322onErrorMessages f = MultipleErrors . map f . runMultipleErrors
316323
324+-- | Add a hint to an error message
325+addHint :: ErrorMessageHint -> MultipleErrors -> MultipleErrors
326+addHint hint = onErrorMessages $ \(ErrorMessage hints se) -> ErrorMessage (hint : hints) se
327+
317328-- | The various types of things which might need to be relabelled in errors messages.
318329data LabelType = TypeLabel | SkolemLabel String deriving (Show, Read, Eq, Ord)
319330
@@ -327,27 +338,7 @@ data Level = Error | Warning deriving Show
327338-- Extract nested error messages from wrapper errors
328339--
329340unwrapErrorMessage :: ErrorMessage -> SimpleErrorMessage
330−unwrapErrorMessage em = case em of
331− (ErrorCheckingKind _ err) -> unwrapErrorMessage err
332− (ErrorCheckingType _ _ err) -> unwrapErrorMessage err
333− (ErrorInApplication _ _ _ err) -> unwrapErrorMessage err
334− (ErrorInBindingGroup _ err) -> unwrapErrorMessage err
335− (ErrorInDataBindingGroup err) -> unwrapErrorMessage err
336− (ErrorInDataConstructor _ err) -> unwrapErrorMessage err
337− (ErrorInExpression _ err) -> unwrapErrorMessage err
338− (ErrorInForeignImport _ err) -> unwrapErrorMessage err
339− (ErrorInInstance _ _ err) -> unwrapErrorMessage err
340− (ErrorInModule _ err) -> unwrapErrorMessage err
341− (ErrorInSubsumption _ _ err) -> unwrapErrorMessage err
342− (ErrorInTypeConstructor _ err) -> unwrapErrorMessage err
343− (ErrorInTypeSynonym _ err) -> unwrapErrorMessage err
344− (ErrorInValueDeclaration _ err) -> unwrapErrorMessage err
345− (ErrorInTypeDeclaration _ err) -> unwrapErrorMessage err
346− (ErrorInferringType _ err) -> unwrapErrorMessage err
347− (ErrorUnifyingTypes _ _ err) -> unwrapErrorMessage err
348− (NotYetDefined _ err) -> unwrapErrorMessage err
349− (PositionedError _ err) -> unwrapErrorMessage err
350− (SimpleErrorWrapper sem) -> sem
341+unwrapErrorMessage (ErrorMessage _ se) = se
351342
352343replaceUnknowns :: Type -> State UnknownMap Type
353344replaceUnknowns = everywhereOnTypesM replaceTypes
@@ -363,7 +354,7 @@ replaceUnknowns = everywhereOnTypesM replaceTypes
363354 replaceTypes other = return other
364355
365356onTypesInErrorMessageM :: (Applicative m) => (Type -> m Type) -> ErrorMessage -> m ErrorMessage
366−onTypesInErrorMessageM f = g
357+onTypesInErrorMessageM f (ErrorMessage hints simple) = ErrorMessage <$> traverse gHint hints <*> gSimple simple
367358 where
368359 gSimple (InfiniteType t) = InfiniteType <$> f t
369360 gSimple (TypesDoNotUnify t1 t2) = TypesDoNotUnify <$> f t1 <*> f t2
@@ -373,204 +364,191 @@ onTypesInErrorMessageM f = g
373364 gSimple (CannotApplyFunction t e) = CannotApplyFunction <$> f t <*> pure e
374365 gSimple (InvalidInstanceHead t) = InvalidInstanceHead <$> f t
375366 gSimple other = pure other
376− g (ErrorInSubsumption t1 t2 em) = ErrorInSubsumption <$> f t1 <*> f t2 <*> g em
377− g (ErrorUnifyingTypes t1 t2 e) = ErrorUnifyingTypes <$> f t1 <*> f t2 <*> g e
378− g (ErrorCheckingType e t em) = ErrorCheckingType e <$> f t <*> g em
379− g (ErrorCheckingKind t em) = ErrorCheckingKind <$> f t <*> g em
380− g (ErrorInApplication e1 t1 e2 em) = ErrorInApplication e1 <$> f t1 <*> pure e2 <*> g em
381− g (NotYetDefined x e) = NotYetDefined x <$> g e
382− g (ErrorInExpression x e) = ErrorInExpression x <$> g e
383− g (ErrorInModule x e) = ErrorInModule x <$> g e
384− g (ErrorInInstance x y e) = ErrorInInstance x y <$> g e
385− g (ErrorInferringType x e) = ErrorInferringType x <$> g e
386− g (ErrorInDataConstructor x e) = ErrorInDataConstructor x <$> g e
387− g (ErrorInTypeConstructor x e) = ErrorInTypeConstructor x <$> g e
388− g (ErrorInBindingGroup x e) = ErrorInBindingGroup x <$> g e
389− g (ErrorInDataBindingGroup e) = ErrorInDataBindingGroup <$> g e
390− g (ErrorInTypeSynonym x e) = ErrorInTypeSynonym x <$> g e
391− g (ErrorInValueDeclaration x e) = ErrorInValueDeclaration x <$> g e
392− g (ErrorInTypeDeclaration x e) = ErrorInTypeDeclaration x <$> g e
393− g (ErrorInForeignImport x e) = ErrorInForeignImport x <$> g e
394− g (PositionedError x e) = PositionedError x <$> g e
395− g (SimpleErrorWrapper sem) = SimpleErrorWrapper <$> gSimple sem
367+ gHint (ErrorInSubsumption t1 t2) = ErrorInSubsumption <$> f t1 <*> f t2
368+ gHint (ErrorUnifyingTypes t1 t2) = ErrorUnifyingTypes <$> f t1 <*> f t2
369+ gHint (ErrorCheckingType e t) = ErrorCheckingType e <$> f t
370+ gHint (ErrorCheckingKind t) = ErrorCheckingKind <$> f t
371+ gHint (ErrorInApplication e1 t1 e2) = ErrorInApplication e1 <$> f t1 <*> pure e2
372+ gHint other = pure other
396373
397374-- |
398375-- Pretty print a single error, simplifying if necessary
399376--
400377prettyPrintSingleError :: Bool -> Level -> ErrorMessage -> State UnknownMap Box.Box
401−prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInErrorMessageM replaceUnknowns (if full then e else simplifyErrorMessage e)
378+prettyPrintSingleError full level e = prettyPrintErrorMessage . positionHintsFirst . reverseHints <$> onTypesInErrorMessageM replaceUnknowns (if full then e else simplifyErrorMessage e)
402379 where
403− -- |
380+
404381 -- Pretty print an ErrorMessage
405− --
406382 prettyPrintErrorMessage :: ErrorMessage -> Box.Box
407− prettyPrintErrorMessage em =
383+ prettyPrintErrorMessage (ErrorMessage hints simple) =
408384 paras $
409− go em:suggestions em ++
385+ map renderHint hints ++
386+ renderSimpleErrorMessage simple :
387+ suggestions simple ++
410388 [line $ "See " ++ wikiUri ++ " for more information, or to contribute content related to this " ++ levelText ++ "."]
411389 where
412390 wikiUri :: String
413391 wikiUri = "https://github.com/purescript/purescript/wiki/Error-Code-" ++ errorCode e
414392
415− go :: ErrorMessage -> Box.Box
416− goSimple (CannotGetFileInfo path) =
393+ renderSimpleErrorMessage :: SimpleErrorMessage -> Box.Box
394+ renderSimpleErrorMessage (CannotGetFileInfo path) =
417395 paras [ line "Unable to read file info: "
418396 , indent . line $ path
419397 ]
420− goSimple (CannotReadFile path) =
398+ renderSimpleErrorMessage (CannotReadFile path) =
421399 paras [ line "Unable to read file: "
422400 , indent . line $ path
423401 ]
424− goSimple (CannotWriteFile path) =
402+ renderSimpleErrorMessage (CannotWriteFile path) =
425403 paras [ line "Unable to write file: "
426404 , indent . line $ path
427405 ]
428− goSimple (ErrorParsingExterns err) =
406+ renderSimpleErrorMessage (ErrorParsingExterns err) =
429407 paras [ lineWithLevel "parsing externs files: "
430408 , prettyPrintParseError err
431409 ]
432− goSimple (ErrorParsingFFIModule path) =
410+ renderSimpleErrorMessage (ErrorParsingFFIModule path) =
433411 paras [ line "Unable to parse module from FFI file: "
434412 , indent . line $ path
435413 ]
436− goSimple (ErrorParsingModule err) =
414+ renderSimpleErrorMessage (ErrorParsingModule err) =
437415 paras [ line "Unable to parse module: "
438416 , prettyPrintParseError err
439417 ]
440− goSimple (MissingFFIModule mn) =
418+ renderSimpleErrorMessage (MissingFFIModule mn) =
441419 line $ "Missing FFI implementations for module " ++ runModuleName mn
442− goSimple (UnnecessaryFFIModule mn path) =
420+ renderSimpleErrorMessage (UnnecessaryFFIModule mn path) =
443421 paras [ line $ "Unnecessary FFI implementations have been provided for module " ++ runModuleName mn ++ ": "
444422 , indent . line $ path
445423 ]
446− goSimple (MultipleFFIModules mn paths) =
424+ renderSimpleErrorMessage (MultipleFFIModules mn paths) =
447425 paras [ line $ "Multiple FFI implementations have been provided for module " ++ runModuleName mn ++ ": "
448426 , indent . paras $ map line paths
449427 ]
450− goSimple (InvalidExternsFile path) =
428+ renderSimpleErrorMessage (InvalidExternsFile path) =
451429 paras [ line "Externs file is invalid: "
452430 , indent . line $ path
453431 ]
454− goSimple InvalidDoBind =
432+ renderSimpleErrorMessage InvalidDoBind =
455433 line "Bind statement cannot be the last statement in a do block. The last statement must be an expression."
456− goSimple InvalidDoLet =
434+ renderSimpleErrorMessage InvalidDoLet =
457435 line "Let statement cannot be the last statement in a do block. The last statement must be an expression."
458− goSimple CannotReorderOperators =
436+ renderSimpleErrorMessage CannotReorderOperators =
459437 line "Unable to reorder operators"
460− goSimple UnspecifiedSkolemScope =
438+ renderSimpleErrorMessage UnspecifiedSkolemScope =
461439 line "Skolem variable scope is unspecified"
462− goSimple OverlappingNamesInLet =
440+ renderSimpleErrorMessage OverlappingNamesInLet =
463441 line "Overlapping names in let binding."
464− goSimple (InfiniteType ty) =
442+ renderSimpleErrorMessage (InfiniteType ty) =
465443 paras [ line "An infinite type was inferred for an expression: "
466444 , indent $ typeAsBox ty
467445 ]
468− goSimple (InfiniteKind ki) =
446+ renderSimpleErrorMessage (InfiniteKind ki) =
469447 paras [ line "An infinite kind was inferred for a type: "
470448 , indent $ kindAsBox ki
471449 ]
472− goSimple (MultipleFixities name) =
450+ renderSimpleErrorMessage (MultipleFixities name) =
473451 line $ "Multiple fixity declarations for " ++ showIdent name
474− goSimple (OrphanTypeDeclaration nm) =
452+ renderSimpleErrorMessage (OrphanTypeDeclaration nm) =
475453 line $ "Orphan type declaration for " ++ showIdent nm
476− goSimple (OrphanFixityDeclaration op) =
454+ renderSimpleErrorMessage (OrphanFixityDeclaration op) =
477455 line $ "Orphan fixity declaration for " ++ show op
478− goSimple (RedefinedModule name filenames) =
456+ renderSimpleErrorMessage (RedefinedModule name filenames) =
479457 paras [ line ("Module " ++ runModuleName name ++ " has been defined multiple times:")
480458 , indent . paras $ map (line . displaySourceSpan) filenames
481459 ]
482− goSimple (RedefinedIdent name) =
460+ renderSimpleErrorMessage (RedefinedIdent name) =
483461 line $ "Name " ++ showIdent name ++ " has been defined multiple times"
484− goSimple (UnknownModule mn) =
462+ renderSimpleErrorMessage (UnknownModule mn) =
485463 line $ "Unknown module " ++ runModuleName mn
486− goSimple (UnknownType name) =
464+ renderSimpleErrorMessage (UnknownType name) =
487465 line $ "Unknown type " ++ showQualified runProperName name
488− goSimple (UnknownTypeClass name) =
466+ renderSimpleErrorMessage (UnknownTypeClass name) =
489467 line $ "Unknown type class " ++ showQualified runProperName name
490− goSimple (UnknownValue name) =
468+ renderSimpleErrorMessage (UnknownValue name) =
491469 line $ "Unknown value " ++ showQualified showIdent name
492− goSimple (UnknownTypeConstructor name) =
470+ renderSimpleErrorMessage (UnknownTypeConstructor name) =
493471 line $ "Unknown type constructor " ++ showQualified runProperName name
494− goSimple (UnknownDataConstructor dc tc) =
472+ renderSimpleErrorMessage (UnknownDataConstructor dc tc) =
495473 line $ "Unknown data constructor " ++ showQualified runProperName dc ++ foldMap ((" for type constructor " ++) . showQualified runProperName) tc
496− goSimple (UnknownImportType mn name) =
474+ renderSimpleErrorMessage (UnknownImportType mn name) =
497475 line $ "Module " ++ runModuleName mn ++ " does not export type " ++ runProperName name
498− goSimple (UnknownExportType name) =
476+ renderSimpleErrorMessage (UnknownExportType name) =
499477 line $ "Cannot export unknown type " ++ runProperName name
500− goSimple (UnknownImportTypeClass mn name) =
478+ renderSimpleErrorMessage (UnknownImportTypeClass mn name) =
501479 line $ "Module " ++ runModuleName mn ++ " does not export type class " ++ runProperName name
502− goSimple (UnknownExportTypeClass name) =
480+ renderSimpleErrorMessage (UnknownExportTypeClass name) =
503481 line $ "Cannot export unknown type class " ++ runProperName name
504− goSimple (UnknownImportValue mn name) =
482+ renderSimpleErrorMessage (UnknownImportValue mn name) =
505483 line $ "Module " ++ runModuleName mn ++ " does not export value " ++ showIdent name
506− goSimple (UnknownExportValue name) =
484+ renderSimpleErrorMessage (UnknownExportValue name) =
507485 line $ "Cannot export unknown value " ++ showIdent name
508− goSimple (UnknownExportModule name) =
486+ renderSimpleErrorMessage (UnknownExportModule name) =
509487 line $ "Cannot export unknown module " ++ runModuleName name ++ ", it either does not exist or has not been imported by the current module"
510− goSimple (UnknownImportDataConstructor mn tcon dcon) =
488+ renderSimpleErrorMessage (UnknownImportDataConstructor mn tcon dcon) =
511489 line $ "Module " ++ runModuleName mn ++ " does not export data constructor " ++ runProperName dcon ++ " for type " ++ runProperName tcon
512− goSimple (UnknownExportDataConstructor tcon dcon) =
490+ renderSimpleErrorMessage (UnknownExportDataConstructor tcon dcon) =
513491 line $ "Cannot export data constructor " ++ runProperName dcon ++ " for type " ++ runProperName tcon ++ " as it has not been declared"
514− goSimple (ConflictingImport nm mn) =
492+ renderSimpleErrorMessage (ConflictingImport nm mn) =
515493 line $ "Cannot declare " ++ show nm ++ " since another declaration of that name was imported from " ++ runModuleName mn
516− goSimple (ConflictingImports nm m1 m2) =
494+ renderSimpleErrorMessage (ConflictingImports nm m1 m2) =
517495 line $ "Conflicting imports for " ++ nm ++ " from modules " ++ runModuleName m1 ++ " and " ++ runModuleName m2
518− goSimple (ConflictingTypeDecls nm) =
496+ renderSimpleErrorMessage (ConflictingTypeDecls nm) =
519497 line $ "Conflicting type declarations for " ++ runProperName nm
520− goSimple (ConflictingCtorDecls nm) =
498+ renderSimpleErrorMessage (ConflictingCtorDecls nm) =
521499 line $ "Conflicting data constructor declarations for " ++ runProperName nm
522− goSimple (TypeConflictsWithClass nm) =
500+ renderSimpleErrorMessage (TypeConflictsWithClass nm) =
523501 line $ "Type " ++ runProperName nm ++ " conflicts with type class declaration of the same name"
524− goSimple (CtorConflictsWithClass nm) =
502+ renderSimpleErrorMessage (CtorConflictsWithClass nm) =
525503 line $ "Data constructor " ++ runProperName nm ++ " conflicts with type class declaration of the same name"
526− goSimple (ClassConflictsWithType nm) =
504+ renderSimpleErrorMessage (ClassConflictsWithType nm) =
527505 line $ "Type class " ++ runProperName nm ++ " conflicts with type declaration of the same name"
528− goSimple (ClassConflictsWithCtor nm) =
506+ renderSimpleErrorMessage (ClassConflictsWithCtor nm) =
529507 line $ "Type class " ++ runProperName nm ++ " conflicts with data constructor declaration of the same name"
530− goSimple (DuplicateClassExport nm) =
508+ renderSimpleErrorMessage (DuplicateClassExport nm) =
531509 line $ "Duplicate export declaration for type class " ++ runProperName nm
532− goSimple (DuplicateValueExport nm) =
510+ renderSimpleErrorMessage (DuplicateValueExport nm) =
533511 line $ "Duplicate export declaration for value " ++ showIdent nm
534− goSimple (CycleInDeclaration nm) =
512+ renderSimpleErrorMessage (CycleInDeclaration nm) =
535513 line $ "Cycle in declaration of " ++ showIdent nm
536− goSimple (CycleInModules mns) =
514+ renderSimpleErrorMessage (CycleInModules mns) =
537515 line $ "Cycle in module dependencies: " ++ intercalate ", " (map runModuleName mns)
538− goSimple (CycleInTypeSynonym pn) =
516+ renderSimpleErrorMessage (CycleInTypeSynonym pn) =
539517 line $ "Cycle in type synonym" ++ foldMap ((" " ++) . runProperName) pn
540− goSimple (NameIsUndefined ident) =
518+ renderSimpleErrorMessage (NameIsUndefined ident) =
541519 line $ showIdent ident ++ " is undefined"
542− goSimple (NameNotInScope ident) =
520+ renderSimpleErrorMessage (NameNotInScope ident) =
543521 line $ showIdent ident ++ " may not be defined in the current scope"
544− goSimple (UndefinedTypeVariable name) =
522+ renderSimpleErrorMessage (UndefinedTypeVariable name) =
545523 line $ "Type variable " ++ runProperName name ++ " is undefined"
546− goSimple (PartiallyAppliedSynonym name) =
524+ renderSimpleErrorMessage (PartiallyAppliedSynonym name) =
547525 paras [ line $ "Partially applied type synonym " ++ showQualified runProperName name
548526 , line "Type synonyms must be applied to all of their type arguments."
549527 ]
550− goSimple (EscapedSkolem binding) =
528+ renderSimpleErrorMessage (EscapedSkolem binding) =
551529 paras $ [ line "A type variable has escaped its scope." ]
552530 <> foldMap (\expr -> [ line "Relevant expression: "
553531 , indent $ prettyPrintValue expr
554532 ]) binding
555− goSimple (TypesDoNotUnify t1 t2)
533+ renderSimpleErrorMessage (TypesDoNotUnify t1 t2)
556534 = paras [ line "Cannot unify type"
557535 , indent $ typeAsBox t1
558536 , line "with type"
559537 , indent $ typeAsBox t2
560538 ]
561− goSimple (KindsDoNotUnify k1 k2) =
539+ renderSimpleErrorMessage (KindsDoNotUnify k1 k2) =
562540 paras [ line "Cannot unify kind"
563541 , indent $ kindAsBox k1
564542 , line "with kind"
565543 , indent $ kindAsBox k2
566544 ]
567− goSimple (ConstrainedTypeUnified t1 t2) =
545+ renderSimpleErrorMessage (ConstrainedTypeUnified t1 t2) =
568546 paras [ line "Cannot unify constrained type"
569547 , indent $ typeAsBox t1
570548 , line "with type"
571549 , indent $ typeAsBox t2
572550 ]
573− goSimple (OverlappingInstances nm ts (d : ds)) =
551+ renderSimpleErrorMessage (OverlappingInstances nm ts (d : ds)) =
574552 paras [ line "Overlapping instances found for"
575553 , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
576554 , Box.vcat Box.left (map typeAtomAsBox ts)
@@ -578,46 +556,46 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError
578556 , line "The following instances were found:"
579557 , indent $ paras (line (showQualified showIdent d ++ " (chosen)") : map (line . showQualified showIdent) ds)
580558 ]
581− goSimple OverlappingInstances{} = error "OverlappingInstances: empty instance list"
582− goSimple (NoInstanceFound nm ts) =
559+ renderSimpleErrorMessage OverlappingInstances{} = error "OverlappingInstances: empty instance list"
560+ renderSimpleErrorMessage (NoInstanceFound nm ts) =
583561 paras [ line "No instance found for"
584562 , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
585563 , Box.vcat Box.left (map typeAtomAsBox ts)
586564 ]
587565 ]
588− goSimple (PossiblyInfiniteInstance nm ts) =
566+ renderSimpleErrorMessage (PossiblyInfiniteInstance nm ts) =
589567 paras [ line "Instance for"
590568 , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
591569 , Box.vcat Box.left (map typeAtomAsBox ts)
592570 ]
593571 , line "is possibly infinite."
594572 ]
595− goSimple (CannotDerive nm ts) =
573+ renderSimpleErrorMessage (CannotDerive nm ts) =
596574 paras [ line "Cannot derive an instance for"
597575 , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
598576 , Box.vcat Box.left (map typeAtomAsBox ts)
599577 ]
600578 ]
601− goSimple (CannotFindDerivingType nm) =
579+ renderSimpleErrorMessage (CannotFindDerivingType nm) =
602580 line $ "Cannot derive instance, because the type declaration for " ++ runProperName nm ++ " could not be found."
603− goSimple (DuplicateLabel l expr) =
581+ renderSimpleErrorMessage (DuplicateLabel l expr) =
604582 paras $ [ line $ "Duplicate label " ++ show l ++ " in row." ]
605583 <> foldMap (\expr' -> [ line "Relevant expression: "
606584 , indent $ prettyPrintValue expr'
607585 ]) expr
608− goSimple (DuplicateTypeArgument name) =
586+ renderSimpleErrorMessage (DuplicateTypeArgument name) =
609587 line $ "Duplicate type argument " ++ show name
610− goSimple (DuplicateValueDeclaration nm) =
588+ renderSimpleErrorMessage (DuplicateValueDeclaration nm) =
611589 line $ "Duplicate value declaration for " ++ showIdent nm
612− goSimple (ArgListLengthsDiffer ident) =
590+ renderSimpleErrorMessage (ArgListLengthsDiffer ident) =
613591 line $ "Argument list lengths differ in declaration " ++ showIdent ident
614− goSimple (OverlappingArgNames ident) =
592+ renderSimpleErrorMessage (OverlappingArgNames ident) =
615593 line $ "Overlapping names in function/binder" ++ foldMap ((" in declaration" ++) . showIdent) ident
616− goSimple (MissingClassMember ident) =
594+ renderSimpleErrorMessage (MissingClassMember ident) =
617595 line $ "Member " ++ showIdent ident ++ " has not been implemented"
618− goSimple (ExtraneousClassMember ident) =
596+ renderSimpleErrorMessage (ExtraneousClassMember ident) =
619597 line $ "Member " ++ showIdent ident ++ " is not a member of the class being instantiated"
620− goSimple (ExpectedType ty kind) =
598+ renderSimpleErrorMessage (ExpectedType ty kind) =
621599 paras [ line "In a type-annotated expression x :: t, the type t must have kind *."
622600 , line "The error arises from the type"
623601 , indent $ typeAsBox ty
@@ -625,29 +603,29 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError
625603 , indent $ kindAsBox kind
626604 , line "instead."
627605 ]
628− goSimple (IncorrectConstructorArity nm) =
606+ renderSimpleErrorMessage (IncorrectConstructorArity nm) =
629607 line $ "Wrong number of arguments to constructor " ++ showQualified runProperName nm
630− goSimple SubsumptionCheckFailed = line "Unable to check type subsumption"
631− goSimple (ExprDoesNotHaveType expr ty) =
608+ renderSimpleErrorMessage SubsumptionCheckFailed = line "Unable to check type subsumption"
609+ renderSimpleErrorMessage (ExprDoesNotHaveType expr ty) =
632610 paras [ line "Expression"
633611 , indent $ prettyPrintValue expr
634612 , line "does not have type"
635613 , indent $ typeAsBox ty
636614 ]
637− goSimple (PropertyIsMissing prop row) =
615+ renderSimpleErrorMessage (PropertyIsMissing prop row) =
638616 paras [ line "Row"
639617 , indent $ prettyPrintRowWith '(' ')' row
640618 , line $ "lacks required property " ++ show prop
641619 ]
642− goSimple (CannotApplyFunction fn arg) =
620+ renderSimpleErrorMessage (CannotApplyFunction fn arg) =
643621 paras [ line "Cannot apply function of type"
644622 , indent $ typeAsBox fn
645623 , line "to argument"
646624 , indent $ prettyPrintValue arg
647625 ]
648− goSimple TypeSynonymInstance =
626+ renderSimpleErrorMessage TypeSynonymInstance =
649627 line "Type synonym instances are disallowed"
650− goSimple (OrphanInstance nm cnm ts) =
628+ renderSimpleErrorMessage (OrphanInstance nm cnm ts) =
651629 paras [ line $ "Instance " ++ showIdent nm ++ " for "
652630 , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName cnm)
653631 , Box.vcat Box.left (map typeAtomAsBox ts)
@@ -656,146 +634,124 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError
656634 , line "An orphan instance is an instance which is defined in neither the class module nor the data type module."
657635 , line "Consider moving the instance, if possible, or using a newtype wrapper."
658636 ]
659− goSimple InvalidNewtype =
637+ renderSimpleErrorMessage InvalidNewtype =
660638 line "Newtypes must define a single constructor with a single argument"
661− goSimple (InvalidInstanceHead ty) =
639+ renderSimpleErrorMessage (InvalidInstanceHead ty) =
662640 paras [ line "Invalid type in class instance head:"
663641 , indent $ typeAsBox ty
664642 ]
665− goSimple (TransitiveExportError x ys) =
643+ renderSimpleErrorMessage (TransitiveExportError x ys) =
666644 paras $ line ("An export for " ++ prettyPrintExport x ++ " requires the following to also be exported: ")
667645 : map (line . prettyPrintExport) ys
668− goSimple (ShadowedName nm) =
646+ renderSimpleErrorMessage (ShadowedName nm) =
669647 line $ "Name '" ++ showIdent nm ++ "' was shadowed"
670− goSimple (ShadowedTypeVar tv) =
648+ renderSimpleErrorMessage (ShadowedTypeVar tv) =
671649 line $ "Type variable '" ++ tv ++ "' was shadowed"
672− goSimple (UnusedTypeVar tv) =
650+ renderSimpleErrorMessage (UnusedTypeVar tv) =
673651 line $ "Type variable '" ++ tv ++ "' was declared but not used"
674− goSimple (ClassOperator className opName) =
652+ renderSimpleErrorMessage (ClassOperator className opName) =
675653 paras [ line $ "Class '" ++ runProperName className ++ "' declares operator " ++ showIdent opName ++ "."
676654 , line "This may be disallowed in the future - consider declaring a named member in the class and making the operator an alias:"
677655 , indent . line $ showIdent opName ++ " = someMember"
678656 ]
679− goSimple (MisleadingEmptyTypeImport mn name) =
657+ renderSimpleErrorMessage (MisleadingEmptyTypeImport mn name) =
680658 line $ "Importing type " ++ runProperName name ++ "(..) from " ++ runModuleName mn ++ " is misleading as it has no exported data constructors"
681− goSimple (ImportHidingModule name) =
659+ renderSimpleErrorMessage (ImportHidingModule name) =
682660 line $ "Attempted to hide module " ++ runModuleName name ++ " in import expression, this is not permitted"
683− goSimple (WildcardInferredType ty) =
661+ renderSimpleErrorMessage (WildcardInferredType ty) =
684662 paras [ line "The wildcard type definition has the inferred type "
685663 , indent $ typeAsBox ty
686664 ]
687− goSimple (NotExhaustivePattern bs b) =
665+ renderSimpleErrorMessage (MissingTypeDeclaration ident) =
666+ paras [ line $ "No type declaration was provided for the top-level declaration of " ++ showIdent ident ++ "."
667+ , line "It is good practice to provide type declarations as a form of documentation."
668+ , line "Consider using a type wildcard to display the inferred type:"
669+ , indent $ line $ showIdent ident ++ " :: _"
670+ ]
671+ renderSimpleErrorMessage (NotExhaustivePattern bs b) =
688672 paras $ [ line "A case expression could not be determined to cover all inputs."
689673 , line "The following additional cases are required to cover all inputs:\n"
690674 , Box.hsep 1 Box.left (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs))
691675 ] ++
692676 [ line "..." | not b ]
693− goSimple (OverlappingPattern bs b) =
677+ renderSimpleErrorMessage (OverlappingPattern bs b) =
694678 paras $ [ line "A case expression contains unreachable cases:\n"
695679 , Box.hsep 1 Box.left (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs))
696680 ] ++
697681 [ line "..." | not b ]
698− goSimple IncompleteExhaustivityCheck =
682+ renderSimpleErrorMessage IncompleteExhaustivityCheck =
699683 paras [ line "An exhaustivity check was abandoned due to too many possible cases."
700684 , line "You may want to decomposing your data types into smaller types."
701685 ]
702− go (NotYetDefined names err) =
703− paras [ line $ "The following are not yet defined here: " ++ intercalate ", " (map showIdent names) ++ ":"
704− , go err
705− ]
706− go (ErrorUnifyingTypes t1 t2 err) =
686+
687+ renderHint :: ErrorMessageHint -> Box.Box
688+ renderHint (NotYetDefined names) =
689+ line $ "The following are not yet defined here: " ++ intercalate ", " (map showIdent names) ++ ":"
690+ renderHint (ErrorUnifyingTypes t1 t2) =
707691 paras [ lineWithLevel "unifying type "
708692 , indent $ typeAsBox t1
709693 , line "with type"
710694 , indent $ typeAsBox t2
711− , go err
712695 ]
713− go (ErrorInExpression expr err) =
696+ renderHint (ErrorInExpression expr) =
714697 paras [ lineWithLevel "in expression:"
715698 , indent $ prettyPrintValue expr
716− , go err
717699 ]
718− go (ErrorInModule mn err) =
700+ renderHint (ErrorInModule mn) =
719701 paras [ lineWithLevel $ "in module " ++ runModuleName mn ++ ":"
720− , go err
721702 ]
722− go (ErrorInSubsumption t1 t2 err) =
703+ renderHint (ErrorInSubsumption t1 t2) =
723704 paras [ lineWithLevel "checking that type "
724705 , indent $ typeAsBox t1
725706 , line "subsumes type"
726707 , indent $ typeAsBox t2
727− , go err
728708 ]
729− go (ErrorInInstance nm ts err) =
709+ renderHint (ErrorInInstance nm ts) =
730710 paras [ lineWithLevel "in type class instance"
731711 , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
732712 , Box.vcat Box.left (map typeAtomAsBox ts)
733713 ]
734− , go err
735714 ]
736− go (ErrorCheckingKind ty err) =
715+ renderHint (ErrorCheckingKind ty) =
737716 paras [ lineWithLevel "checking kind of type "
738717 , indent $ typeAsBox ty
739− , go err
740718 ]
741− go (ErrorInferringType expr err) =
719+ renderHint (ErrorInferringType expr) =
742720 paras [ lineWithLevel "inferring type of value "
743721 , indent $ prettyPrintValue expr
744− , go err
745722 ]
746− go (ErrorCheckingType expr ty err) =
723+ renderHint (ErrorCheckingType expr ty) =
747724 paras [ lineWithLevel "checking that value "
748725 , indent $ prettyPrintValue expr
749726 , line "has type"
750727 , indent $ typeAsBox ty
751− , go err
752728 ]
753− go (ErrorInApplication f t a err) =
729+ renderHint (ErrorInApplication f t a) =
754730 paras [ lineWithLevel "applying function"
755731 , indent $ prettyPrintValue f
756732 , line "of type"
757733 , indent $ typeAsBox t
758734 , line "to argument"
759735 , indent $ prettyPrintValue a
760− , go err
761− ]
762− go (ErrorInDataConstructor nm err) =
763− paras [ lineWithLevel $ "in data constructor " ++ runProperName nm ++ ":"
764− , go err
765736 ]
766− go (ErrorInTypeConstructor nm err) =
767− paras [ lineWithLevel $ "in type constructor " ++ runProperName nm ++ ":"
768− , go err
769− ]
770− go (ErrorInBindingGroup nms err) =
771− paras [ lineWithLevel $ "in binding group " ++ intercalate ", " (map showIdent nms) ++ ":"
772− , go err
773− ]
774− go (ErrorInDataBindingGroup err) =
775− paras [ lineWithLevel "in data binding group:"
776− , go err
777− ]
778− go (ErrorInTypeSynonym name err) =
779− paras [ lineWithLevel $ "in type synonym " ++ runProperName name ++ ":"
780− , go err
781− ]
782− go (ErrorInValueDeclaration n err) =
783− paras [ lineWithLevel $ "in value declaration " ++ showIdent n ++ ":"
784− , go err
785− ]
786− go (ErrorInTypeDeclaration n err) =
787− paras [ lineWithLevel $ "in type declaration for " ++ showIdent n ++ ":"
788− , go err
789− ]
790− go (ErrorInForeignImport nm err) =
791− paras [ lineWithLevel $ "in foreign import " ++ showIdent nm ++ ":"
792− , go err
793− ]
794− go (PositionedError srcSpan err) =
795− paras [ lineWithLevel $ "at " ++ displaySourceSpan srcSpan ++ ":"
796− , go err
797− ]
798− go (SimpleErrorWrapper sem) = goSimple sem
737+ renderHint (ErrorInDataConstructor nm) =
738+ lineWithLevel $ "in data constructor " ++ runProperName nm ++ ":"
739+ renderHint (ErrorInTypeConstructor nm) =
740+ lineWithLevel $ "in type constructor " ++ runProperName nm ++ ":"
741+ renderHint (ErrorInBindingGroup nms) =
742+ lineWithLevel $ "in binding group " ++ intercalate ", " (map showIdent nms) ++ ":"
743+ renderHint ErrorInDataBindingGroup =
744+ lineWithLevel "in data binding group:"
745+ renderHint (ErrorInTypeSynonym name) =
746+ lineWithLevel $ "in type synonym " ++ runProperName name ++ ":"
747+ renderHint (ErrorInValueDeclaration n) =
748+ lineWithLevel $ "in value declaration " ++ showIdent n ++ ":"
749+ renderHint (ErrorInTypeDeclaration n) =
750+ lineWithLevel $ "in type declaration for " ++ showIdent n ++ ":"
751+ renderHint (ErrorInForeignImport nm) =
752+ lineWithLevel $ "in foreign import " ++ showIdent nm ++ ":"
753+ renderHint (PositionedError srcSpan) =
754+ lineWithLevel $ "at " ++ displaySourceSpan srcSpan ++ ":"
799755
800756 lineWithLevel :: String -> Box.Box
801757 lineWithLevel text = line $ show level ++ " " ++ text
@@ -805,23 +761,19 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError
805761 Error -> "error"
806762 Warning -> "warning"
807763
808− suggestions :: ErrorMessage -> [Box.Box]
809− suggestions = suggestions' . unwrapErrorMessage
810− where
811− suggestions' (ConflictingImport nm im) = [ line $ "Possible fix: hide " ++ show nm ++ " when importing " ++ runModuleName im ++ ":"
764+ suggestions :: SimpleErrorMessage -> [Box.Box]
765+ suggestions (ConflictingImport nm im) = [ line $ "Possible fix: hide " ++ show nm ++ " when importing " ++ runModuleName im ++ ":"
812766 , indent . line $ "import " ++ runModuleName im ++ " hiding (" ++ nm ++ ")"
813767 ]
814− suggestions' (TypesDoNotUnify t1 t2)
815− | isObject t1 && isFunction t2 = [line "Note that function composition in PureScript is defined using (<<<)"]
816− | otherwise = []
817− suggestions' _ = []
768+ suggestions (TypesDoNotUnify t1 t2)
769+ | isObject t1 && isFunction t2 = [line "Note that function composition in PureScript is defined using (<<<)"]
770+ | otherwise = []
771+ suggestions _ = []
818772
819773 paras :: [Box.Box] -> Box.Box
820774 paras = Box.vcat Box.left
821775
822− -- |
823776 -- Pretty print and export declaration
824− --
825777 prettyPrintExport :: DeclarationRef -> String
826778 prettyPrintExport (TypeRef pn _) = runProperName pn
827779 prettyPrintExport (ValueRef ident) = showIdent ident
@@ -830,38 +782,44 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError
830782 prettyPrintExport (ModuleRef name) = "module " ++ runModuleName name
831783 prettyPrintExport (PositionedDeclarationRef _ _ ref) = prettyPrintExport ref
832784
833− -- |
834− -- Simplify an error message
835− --
836− simplifyErrorMessage :: ErrorMessage -> ErrorMessage
837− simplifyErrorMessage = unwrap Nothing
785+ -- Hints get added at the front, so we need to reverse them before rendering
786+ reverseHints :: ErrorMessage -> ErrorMessage
787+ reverseHints (ErrorMessage hints simple) = ErrorMessage (reverse hints) simple
788+
789+ -- | Put positional hints at the front of the list
790+ positionHintsFirst :: ErrorMessage -> ErrorMessage
791+ positionHintsFirst (ErrorMessage hints simple) = ErrorMessage (uncurry (++) $ partition (isPositionHint . hintCategory) hints) simple
838792 where
839− unwrap :: Maybe SourceSpan -> ErrorMessage -> ErrorMessage
840− unwrap pos (ErrorInExpression _ err) = unwrap pos err
841− unwrap pos (ErrorInInstance name ts err) = ErrorInInstance name ts (unwrap pos err)
842− unwrap pos (ErrorInSubsumption t1 t2 err) = ErrorInSubsumption t1 t2 (unwrap pos err)
843− unwrap pos (ErrorUnifyingTypes _ _ err) = unwrap pos err
844− unwrap pos (ErrorInferringType _ err) = unwrap pos err
845− unwrap pos (ErrorCheckingType _ _ err) = unwrap pos err
846− unwrap pos (ErrorCheckingKind ty err) = ErrorCheckingKind ty (unwrap pos err)
847− unwrap pos (ErrorInModule mn err) = ErrorInModule mn (unwrap pos err)
848− unwrap pos (ErrorInApplication _ _ _ err) = unwrap pos err
849− unwrap pos (ErrorInDataConstructor nm err) = ErrorInDataConstructor nm (unwrap pos err)
850− unwrap pos (ErrorInTypeConstructor nm err) = ErrorInTypeConstructor nm (unwrap pos err)
851− unwrap pos (ErrorInBindingGroup nms err) = ErrorInBindingGroup nms (unwrap pos err)
852− unwrap pos (ErrorInDataBindingGroup err) = ErrorInDataBindingGroup (unwrap pos err)
853− unwrap pos (ErrorInTypeSynonym nm err) = ErrorInTypeSynonym nm (unwrap pos err)
854− unwrap pos (ErrorInValueDeclaration nm err) = ErrorInValueDeclaration nm (unwrap pos err)
855− unwrap pos (ErrorInTypeDeclaration nm err) = ErrorInTypeDeclaration nm (unwrap pos err)
856− unwrap pos (ErrorInForeignImport nm err) = ErrorInForeignImport nm (unwrap pos err)
857− unwrap pos (NotYetDefined ns err) = NotYetDefined ns (unwrap pos err)
858− unwrap _ (PositionedError pos err) = unwrap (Just pos) err
859− unwrap pos other = wrap pos other
860−
861− wrap :: Maybe SourceSpan -> ErrorMessage -> ErrorMessage
862− wrap Nothing = id
863− wrap (Just pos) = PositionedError pos
793+ isPositionHint :: HintCategory -> Bool
794+ isPositionHint PositionHint = True
795+ isPositionHint OtherHint = True
796+ isPositionHint _ = False
864797
798+ -- | Simplify an error message
799+ simplifyErrorMessage :: ErrorMessage -> ErrorMessage
800+ simplifyErrorMessage (ErrorMessage hints simple) = ErrorMessage (simplifyHints hints) simple
801+ where
802+ -- Take the last instance of each "hint category"
803+ simplifyHints :: [ErrorMessageHint] -> [ErrorMessageHint]
804+ simplifyHints = reverse . nubBy categoriesEqual . reverse
805+
806+ -- Don't remove hints in the "other" category
807+ categoriesEqual :: ErrorMessageHint -> ErrorMessageHint -> Bool
808+ categoriesEqual x y =
809+ case (hintCategory x, hintCategory y) of
810+ (OtherHint, _) -> False
811+ (_, OtherHint) -> False
812+ (c1, c2) -> c1 == c2
813+
814+ hintCategory :: ErrorMessageHint -> HintCategory
815+ hintCategory ErrorCheckingType{} = ExprHint
816+ hintCategory ErrorInferringType{} = ExprHint
817+ hintCategory ErrorInExpression{} = ExprHint
818+ hintCategory ErrorUnifyingTypes{} = CheckHint
819+ hintCategory ErrorInSubsumption{} = CheckHint
820+ hintCategory ErrorInApplication{} = CheckHint
821+ hintCategory PositionedError{} = PositionHint
822+ hintCategory _ = OtherHint
865823
866824-- |
867825-- Pretty print multiple errors
@@ -988,8 +946,7 @@ warnAndRethrowWithPosition :: (MonadError MultipleErrors m, MonadWriter Multiple
988946warnAndRethrowWithPosition pos = rethrowWithPosition pos . warnWithPosition pos
989947
990948withPosition :: SourceSpan -> ErrorMessage -> ErrorMessage
991−withPosition _ (PositionedError pos err) = withPosition pos err
992−withPosition pos err = PositionedError pos err
949+withPosition pos (ErrorMessage hints se) = ErrorMessage (PositionedError pos : hints) se
993950
994951-- |
995952-- Collect errors in in parallel