@@ -20,10 +20,11 @@
20module Language.PureScript.Errors where
20module Language.PureScript.Errors where
22import Data.Either (lefts, rights)
22import Data.Either (lefts, rights)
23−import Data.List (intercalate, transpose)
23+import Data.List (intercalate, transpose, nub, nubBy, partition)
24import Data.Function (on)
24import Data.Function (on)
25#if __GLASGOW_HASKELL__ < 710
25#if __GLASGOW_HASKELL__ < 710
26import Data.Foldable (fold, foldMap)
26import Data.Foldable (fold, foldMap)
27+import Data.Traversable (traverse)
28import Data.Foldable (fold)
29import Data.Foldable (fold)
@@ -52,11 +53,8 @@ import qualified Text.PrettyPrint.Boxes as Box
52import qualified Text.Parsec as P
53import qualified Text.Parsec as P
53import qualified Text.Parsec.Error as PE
54import qualified Text.Parsec.Error as PE
54import Text.Parsec.Error (Message(..))
55import Text.Parsec.Error (Message(..))
55−import Data.List (nub)
58−-- A type of error messages
57+-- | A type of error messages
60data SimpleErrorMessage
58data SimpleErrorMessage
61 = ErrorParsingExterns P.ParseError
59 = ErrorParsingExterns P.ParseError
62 | ErrorParsingFFIModule FilePath
60 | ErrorParsingFFIModule FilePath
@@ -100,6 +98,7 @@ data SimpleErrorMessage
100 | CtorConflictsWithClass ProperName
98 | CtorConflictsWithClass ProperName
101 | ClassConflictsWithType ProperName
99 | ClassConflictsWithType ProperName
102 | ClassConflictsWithCtor ProperName
100 | ClassConflictsWithCtor ProperName
101+ | DuplicateModuleName ModuleName
103 | DuplicateClassExport ProperName
102 | DuplicateClassExport ProperName
104 | DuplicateValueExport Ident
103 | DuplicateValueExport Ident
105 | DuplicateTypeArgument String
104 | DuplicateTypeArgument String
@@ -143,44 +142,54 @@ data SimpleErrorMessage
143 | ShadowedTypeVar String
142 | ShadowedTypeVar String
144 | UnusedTypeVar String
143 | UnusedTypeVar String
145 | WildcardInferredType Type
144 | WildcardInferredType Type
145+ | MissingTypeDeclaration Ident
146 | NotExhaustivePattern [[Binder]] Bool
146 | NotExhaustivePattern [[Binder]] Bool
147 | OverlappingPattern [[Binder]] Bool
147 | OverlappingPattern [[Binder]] Bool
148+ | IncompleteExhaustivityCheck
148 | ClassOperator ProperName Ident
149 | ClassOperator ProperName Ident
149 | MisleadingEmptyTypeImport ModuleName ProperName
150 | MisleadingEmptyTypeImport ModuleName ProperName
150 | ImportHidingModule ModuleName
151 | ImportHidingModule ModuleName
151− deriving (Show)
152+ deriving Show
153−-- |
154+-- | Error message hints, providing more detailed information about failure.
154−-- Wrapper of simpler errors
155+data ErrorMessageHint
157− = NotYetDefined [Ident] ErrorMessage
156+ = NotYetDefined [Ident]
158− | ErrorUnifyingTypes Type Type ErrorMessage
157+ | ErrorUnifyingTypes Type Type
159− | ErrorInExpression Expr ErrorMessage
158+ | ErrorInExpression Expr
160− | ErrorInModule ModuleName ErrorMessage
159+ | ErrorInModule ModuleName
161− | ErrorInInstance (Qualified ProperName) [Type] ErrorMessage
160+ | ErrorInInstance (Qualified ProperName) [Type]
162− | ErrorInSubsumption Type Type ErrorMessage
161+ | ErrorInSubsumption Type Type
163− | ErrorCheckingType Expr Type ErrorMessage
162+ | ErrorCheckingType Expr Type
164− | ErrorCheckingKind Type ErrorMessage
163+ | ErrorCheckingKind Type
165− | ErrorInferringType Expr ErrorMessage
164+ | ErrorInferringType Expr
166− | ErrorInApplication Expr Type Expr ErrorMessage
165+ | ErrorInApplication Expr Type Expr
167− | ErrorInDataConstructor ProperName ErrorMessage
166+ | ErrorInDataConstructor ProperName
168− | ErrorInTypeConstructor ProperName ErrorMessage
167+ | ErrorInTypeConstructor ProperName
169− | ErrorInBindingGroup [Ident] ErrorMessage
168+ | ErrorInBindingGroup [Ident]
170− | ErrorInDataBindingGroup ErrorMessage
169+ | ErrorInDataBindingGroup
171− | ErrorInTypeSynonym ProperName ErrorMessage
170+ | ErrorInTypeSynonym ProperName
172− | ErrorInValueDeclaration Ident ErrorMessage
171+ | ErrorInValueDeclaration Ident
173− | ErrorInTypeDeclaration Ident ErrorMessage
172+ | ErrorInTypeDeclaration Ident
174− | ErrorInForeignImport Ident ErrorMessage
173+ | ErrorInForeignImport Ident
175− | PositionedError SourceSpan ErrorMessage
174+ | PositionedError SourceSpan
176− | SimpleErrorWrapper SimpleErrorMessage
175+ deriving Show
177+-- | Categories of hints
186+data ErrorMessage = ErrorMessage [ErrorMessageHint] SimpleErrorMessage deriving (Show)
179instance UnificationError Type ErrorMessage where
188instance UnificationError Type ErrorMessage where
180− occursCheckFailed t = SimpleErrorWrapper $ InfiniteType t
189+ occursCheckFailed t = ErrorMessage [] $ InfiniteType t
182instance UnificationError Kind ErrorMessage where
191instance UnificationError Kind ErrorMessage where
183− occursCheckFailed k = SimpleErrorWrapper $ InfiniteKind k
192+ occursCheckFailed k = ErrorMessage [] $ InfiniteKind k
186-- Get the error code for a particular error type
195-- Get the error code for a particular error type
@@ -229,6 +238,7 @@ errorCode em = case unwrapErrorMessage em of
229 CtorConflictsWithClass{} -> "CtorConflictsWithClass"
238 CtorConflictsWithClass{} -> "CtorConflictsWithClass"
230 ClassConflictsWithType{} -> "ClassConflictsWithType"
239 ClassConflictsWithType{} -> "ClassConflictsWithType"
231 ClassConflictsWithCtor{} -> "ClassConflictsWithCtor"
240 ClassConflictsWithCtor{} -> "ClassConflictsWithCtor"
241+ DuplicateModuleName{} -> "DuplicateModuleName"
232 DuplicateClassExport{} -> "DuplicateClassExport"
242 DuplicateClassExport{} -> "DuplicateClassExport"
233 DuplicateValueExport{} -> "DuplicateValueExport"
243 DuplicateValueExport{} -> "DuplicateValueExport"
234 DuplicateTypeArgument{} -> "DuplicateTypeArgument"
244 DuplicateTypeArgument{} -> "DuplicateTypeArgument"
@@ -272,8 +282,10 @@ errorCode em = case unwrapErrorMessage em of
272 ShadowedTypeVar{} -> "ShadowedTypeVar"
282 ShadowedTypeVar{} -> "ShadowedTypeVar"
273 UnusedTypeVar{} -> "UnusedTypeVar"
283 UnusedTypeVar{} -> "UnusedTypeVar"
274 WildcardInferredType{} -> "WildcardInferredType"
284 WildcardInferredType{} -> "WildcardInferredType"
285+ MissingTypeDeclaration{} -> "MissingTypeDeclaration"
275 NotExhaustivePattern{} -> "NotExhaustivePattern"
286 NotExhaustivePattern{} -> "NotExhaustivePattern"
276 OverlappingPattern{} -> "OverlappingPattern"
287 OverlappingPattern{} -> "OverlappingPattern"
288+ IncompleteExhaustivityCheck{} -> "IncompleteExhaustivityCheck"
277 ClassOperator{} -> "ClassOperator"
289 ClassOperator{} -> "ClassOperator"
278 MisleadingEmptyTypeImport{} -> "MisleadingEmptyTypeImport"
290 MisleadingEmptyTypeImport{} -> "MisleadingEmptyTypeImport"
279 ImportHidingModule{} -> "ImportHidingModule"
291 ImportHidingModule{} -> "ImportHidingModule"
@@ -298,7 +310,7 @@ nonEmpty = not . null . runMultipleErrors
298-- Create an error set from a single simple error message
310-- Create an error set from a single simple error message
300errorMessage :: SimpleErrorMessage -> MultipleErrors
312errorMessage :: SimpleErrorMessage -> MultipleErrors
301−errorMessage err = MultipleErrors [SimpleErrorWrapper err]
313+errorMessage err = MultipleErrors [ErrorMessage [] err]
@@ -307,12 +319,14 @@ errorMessage err = MultipleErrors [SimpleErrorWrapper err]
307singleError :: ErrorMessage -> MultipleErrors
319singleError :: ErrorMessage -> MultipleErrors
308singleError = MultipleErrors . pure
320singleError = MultipleErrors . pure
311−-- Lift a function on ErrorMessage to a function on MultipleErrors
322+-- | Lift a function on ErrorMessage to a function on MultipleErrors
313onErrorMessages :: (ErrorMessage -> ErrorMessage) -> MultipleErrors -> MultipleErrors
323onErrorMessages :: (ErrorMessage -> ErrorMessage) -> MultipleErrors -> MultipleErrors
314onErrorMessages f = MultipleErrors . map f . runMultipleErrors
324onErrorMessages f = MultipleErrors . map f . runMultipleErrors
326+-- | Add a hint to an error message
327+addHint :: ErrorMessageHint -> MultipleErrors -> MultipleErrors
328+addHint hint = onErrorMessages $ \(ErrorMessage hints se) -> ErrorMessage (hint : hints) se
316-- | The various types of things which might need to be relabelled in errors messages.
330-- | The various types of things which might need to be relabelled in errors messages.
317data LabelType = TypeLabel | SkolemLabel String deriving (Show, Read, Eq, Ord)
331data LabelType = TypeLabel | SkolemLabel String deriving (Show, Read, Eq, Ord)
@@ -326,27 +340,7 @@ data Level = Error | Warning deriving Show
326-- Extract nested error messages from wrapper errors
340-- Extract nested error messages from wrapper errors
328unwrapErrorMessage :: ErrorMessage -> SimpleErrorMessage
342unwrapErrorMessage :: ErrorMessage -> SimpleErrorMessage
329−unwrapErrorMessage em = case em of
343+unwrapErrorMessage (ErrorMessage _ se) = se
330− (ErrorCheckingKind _ err) -> unwrapErrorMessage err
331− (ErrorCheckingType _ _ err) -> unwrapErrorMessage err
332− (ErrorInApplication _ _ _ err) -> unwrapErrorMessage err
333− (ErrorInBindingGroup _ err) -> unwrapErrorMessage err
334− (ErrorInDataBindingGroup err) -> unwrapErrorMessage err
335− (ErrorInDataConstructor _ err) -> unwrapErrorMessage err
336− (ErrorInExpression _ err) -> unwrapErrorMessage err
337− (ErrorInForeignImport _ err) -> unwrapErrorMessage err
338− (ErrorInInstance _ _ err) -> unwrapErrorMessage err
339− (ErrorInModule _ err) -> unwrapErrorMessage err
340− (ErrorInSubsumption _ _ err) -> unwrapErrorMessage err
341− (ErrorInTypeConstructor _ err) -> unwrapErrorMessage err
342− (ErrorInTypeSynonym _ err) -> unwrapErrorMessage err
343− (ErrorInValueDeclaration _ err) -> unwrapErrorMessage err
344− (ErrorInTypeDeclaration _ err) -> unwrapErrorMessage err
345− (ErrorInferringType _ err) -> unwrapErrorMessage err
346− (ErrorUnifyingTypes _ _ err) -> unwrapErrorMessage err
347− (NotYetDefined _ err) -> unwrapErrorMessage err
348− (PositionedError _ err) -> unwrapErrorMessage err
349− (SimpleErrorWrapper sem) -> sem
351replaceUnknowns :: Type -> State UnknownMap Type
345replaceUnknowns :: Type -> State UnknownMap Type
352replaceUnknowns = everywhereOnTypesM replaceTypes
346replaceUnknowns = everywhereOnTypesM replaceTypes
@@ -362,400 +356,406 @@ replaceUnknowns = everywhereOnTypesM replaceTypes
362 replaceTypes other = return other
356 replaceTypes other = return other
364onTypesInErrorMessageM :: (Applicative m) => (Type -> m Type) -> ErrorMessage -> m ErrorMessage
358onTypesInErrorMessageM :: (Applicative m) => (Type -> m Type) -> ErrorMessage -> m ErrorMessage
365−onTypesInErrorMessageM f = g
359+onTypesInErrorMessageM f (ErrorMessage hints simple) = ErrorMessage <$> traverse gHint hints <*> gSimple simple
367− gSimple (InfiniteType t) = InfiniteType <$> (f t)
361+ gSimple (InfiniteType t) = InfiniteType <$> f t
368− gSimple (TypesDoNotUnify t1 t2) = TypesDoNotUnify <$> (f t1) <*> (f t2)
362+ gSimple (TypesDoNotUnify t1 t2) = TypesDoNotUnify <$> f t1 <*> f t2
369− gSimple (ConstrainedTypeUnified t1 t2) = ConstrainedTypeUnified <$> (f t1) <*> (f t2)
363+ gSimple (ConstrainedTypeUnified t1 t2) = ConstrainedTypeUnified <$> f t1 <*> f t2
370− gSimple (ExprDoesNotHaveType e t) = ExprDoesNotHaveType e <$> (f t)
364+ gSimple (ExprDoesNotHaveType e t) = ExprDoesNotHaveType e <$> f t
371− gSimple (PropertyIsMissing s t) = PropertyIsMissing s <$> (f t)
365+ gSimple (PropertyIsMissing s t) = PropertyIsMissing s <$> f t
372− gSimple (CannotApplyFunction t e) = CannotApplyFunction <$> f t <*> (pure e)
366+ gSimple (CannotApplyFunction t e) = CannotApplyFunction <$> f t <*> pure e
373 gSimple (InvalidInstanceHead t) = InvalidInstanceHead <$> f t
367 gSimple (InvalidInstanceHead t) = InvalidInstanceHead <$> f t
374 gSimple other = pure other
368 gSimple other = pure other
375− g (ErrorInSubsumption t1 t2 em) = ErrorInSubsumption <$> (f t1) <*> (f t2) <*> (g em)
369+ gHint (ErrorInSubsumption t1 t2) = ErrorInSubsumption <$> f t1 <*> f t2
376− g (ErrorUnifyingTypes t1 t2 e) = ErrorUnifyingTypes <$> (f t1) <*> (f t2) <*> (g e)
370+ gHint (ErrorUnifyingTypes t1 t2) = ErrorUnifyingTypes <$> f t1 <*> f t2
377− g (ErrorCheckingType e t em) = ErrorCheckingType e <$> (f t) <*> (g em)
371+ gHint (ErrorCheckingType e t) = ErrorCheckingType e <$> f t
378− g (ErrorCheckingKind t em) = ErrorCheckingKind <$> (f t) <*> g em
372+ gHint (ErrorCheckingKind t) = ErrorCheckingKind <$> f t
379− g (ErrorInApplication e1 t1 e2 em) = ErrorInApplication e1 <$> (f t1) <*> (pure e2) <*> (g em)
373+ gHint (ErrorInApplication e1 t1 e2) = ErrorInApplication e1 <$> f t1 <*> pure e2
380− g (NotYetDefined x e) = NotYetDefined x <$> (g e)
374+ gHint other = pure other
381− g (ErrorInExpression x e) = ErrorInExpression x <$> (g e)
382− g (ErrorInModule x e) = ErrorInModule x <$> (g e)
383− g (ErrorInInstance x y e) = ErrorInInstance x y <$> (g e)
384− g (ErrorInferringType x e) = ErrorInferringType x <$> (g e)
385− g (ErrorInDataConstructor x e) = ErrorInDataConstructor x <$> (g e)
386− g (ErrorInTypeConstructor x e) = ErrorInTypeConstructor x <$> (g e)
387− g (ErrorInBindingGroup x e) = ErrorInBindingGroup x <$> (g e)
388− g (ErrorInDataBindingGroup e) = ErrorInDataBindingGroup <$> (g e)
389− g (ErrorInTypeSynonym x e) = ErrorInTypeSynonym x <$> (g e)
390− g (ErrorInValueDeclaration x e) = ErrorInValueDeclaration x <$> (g e)
391− g (ErrorInTypeDeclaration x e) = ErrorInTypeDeclaration x <$> (g e)
392− g (ErrorInForeignImport x e) = ErrorInForeignImport x <$> (g e)
393− g (PositionedError x e) = PositionedError x <$> (g e)
394− g (SimpleErrorWrapper sem) = SimpleErrorWrapper <$> gSimple sem
397-- Pretty print a single error, simplifying if necessary
377-- Pretty print a single error, simplifying if necessary
399prettyPrintSingleError :: Bool -> Level -> ErrorMessage -> State UnknownMap Box.Box
379prettyPrintSingleError :: Bool -> Level -> ErrorMessage -> State UnknownMap Box.Box
400−prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInErrorMessageM replaceUnknowns (if full then e else simplifyErrorMessage e)
380+prettyPrintSingleError full level e = prettyPrintErrorMessage . positionHintsFirst . reverseHints <$> onTypesInErrorMessageM replaceUnknowns (if full then e else simplifyErrorMessage e)
403 -- Pretty print an ErrorMessage
383 -- Pretty print an ErrorMessage
405 prettyPrintErrorMessage :: ErrorMessage -> Box.Box
384 prettyPrintErrorMessage :: ErrorMessage -> Box.Box
406− prettyPrintErrorMessage em =
385+ prettyPrintErrorMessage (ErrorMessage hints simple) =
387+ map renderHint hints ++
388+ renderSimpleErrorMessage simple :
408− go em:suggestions em ++
389+ suggestions simple ++
409 [line $ "See " ++ wikiUri ++ " for more information, or to contribute content related to this " ++ levelText ++ "."]
390 [line $ "See " ++ wikiUri ++ " for more information, or to contribute content related to this " ++ levelText ++ "."]
411 wikiUri :: String
392 wikiUri :: String
412 wikiUri = "https://github.com/purescript/purescript/wiki/Error-Code-" ++ errorCode e
393 wikiUri = "https://github.com/purescript/purescript/wiki/Error-Code-" ++ errorCode e
414− go :: ErrorMessage -> Box.Box
395+ renderSimpleErrorMessage :: SimpleErrorMessage -> Box.Box
415− goSimple (CannotGetFileInfo path) =
396+ renderSimpleErrorMessage (CannotGetFileInfo path) =
416 paras [ line "Unable to read file info: "
397 paras [ line "Unable to read file info: "
417 , indent . line $ path
398 , indent . line $ path
419− goSimple (CannotReadFile path) =
400+ renderSimpleErrorMessage (CannotReadFile path) =
420 paras [ line "Unable to read file: "
401 paras [ line "Unable to read file: "
421 , indent . line $ path
402 , indent . line $ path
423− goSimple (CannotWriteFile path) =
404+ renderSimpleErrorMessage (CannotWriteFile path) =
424 paras [ line "Unable to write file: "
405 paras [ line "Unable to write file: "
425 , indent . line $ path
406 , indent . line $ path
427− goSimple (ErrorParsingExterns err) =
408+ renderSimpleErrorMessage (ErrorParsingExterns err) =
428 paras [ lineWithLevel "parsing externs files: "
409 paras [ lineWithLevel "parsing externs files: "
429− , indent . prettyPrintParseError $ err
410+ , prettyPrintParseError err
431− goSimple (ErrorParsingFFIModule path) =
412+ renderSimpleErrorMessage (ErrorParsingFFIModule path) =
432 paras [ line "Unable to parse module from FFI file: "
413 paras [ line "Unable to parse module from FFI file: "
433 , indent . line $ path
414 , indent . line $ path
435− goSimple (ErrorParsingModule err) =
416+ renderSimpleErrorMessage (ErrorParsingModule err) =
436 paras [ line "Unable to parse module: "
417 paras [ line "Unable to parse module: "
437− , indent . prettyPrintParseError $ err
418+ , prettyPrintParseError err
439− goSimple (MissingFFIModule mn) =
420+ renderSimpleErrorMessage (MissingFFIModule mn) =
440 line $ "Missing FFI implementations for module " ++ runModuleName mn
421 line $ "Missing FFI implementations for module " ++ runModuleName mn
441− goSimple (UnnecessaryFFIModule mn path) =
422+ renderSimpleErrorMessage (UnnecessaryFFIModule mn path) =
442 paras [ line $ "Unnecessary FFI implementations have been provided for module " ++ runModuleName mn ++ ": "
423 paras [ line $ "Unnecessary FFI implementations have been provided for module " ++ runModuleName mn ++ ": "
443 , indent . line $ path
424 , indent . line $ path
445− goSimple (MultipleFFIModules mn paths) =
426+ renderSimpleErrorMessage (MultipleFFIModules mn paths) =
446− paras $ [ line $ "Multiple FFI implementations have been provided for module " ++ runModuleName mn ++ ": " ]
427+ paras [ line $ "Multiple FFI implementations have been provided for module " ++ runModuleName mn ++ ": "
447− ++ map (indent . line) paths
428+ , indent . paras $ map line paths
448− goSimple (InvalidExternsFile path) =
430+ renderSimpleErrorMessage (InvalidExternsFile path) =
449 paras [ line "Externs file is invalid: "
431 paras [ line "Externs file is invalid: "
450 , indent . line $ path
432 , indent . line $ path
452− goSimple InvalidDoBind =
434+ renderSimpleErrorMessage InvalidDoBind =
453 line "Bind statement cannot be the last statement in a do block. The last statement must be an expression."
435 line "Bind statement cannot be the last statement in a do block. The last statement must be an expression."
454− goSimple InvalidDoLet =
436+ renderSimpleErrorMessage InvalidDoLet =
455 line "Let statement cannot be the last statement in a do block. The last statement must be an expression."
437 line "Let statement cannot be the last statement in a do block. The last statement must be an expression."
456− goSimple CannotReorderOperators =
438+ renderSimpleErrorMessage CannotReorderOperators =
457 line "Unable to reorder operators"
439 line "Unable to reorder operators"
458− goSimple UnspecifiedSkolemScope =
440+ renderSimpleErrorMessage UnspecifiedSkolemScope =
459 line "Skolem variable scope is unspecified"
441 line "Skolem variable scope is unspecified"
460− goSimple OverlappingNamesInLet =
442+ renderSimpleErrorMessage OverlappingNamesInLet =
461 line "Overlapping names in let binding."
443 line "Overlapping names in let binding."
462− goSimple (InfiniteType ty) =
444+ renderSimpleErrorMessage (InfiniteType ty) =
463 paras [ line "An infinite type was inferred for an expression: "
445 paras [ line "An infinite type was inferred for an expression: "
464− , indent $ line $ prettyPrintType ty
446+ , indent $ typeAsBox ty
466− goSimple (InfiniteKind ki) =
448+ renderSimpleErrorMessage (InfiniteKind ki) =
467 paras [ line "An infinite kind was inferred for a type: "
449 paras [ line "An infinite kind was inferred for a type: "
468− , indent $ line $ prettyPrintKind ki
450+ , indent $ kindAsBox ki
470− goSimple (MultipleFixities name) =
452+ renderSimpleErrorMessage (MultipleFixities name) =
471 line $ "Multiple fixity declarations for " ++ showIdent name
453 line $ "Multiple fixity declarations for " ++ showIdent name
472− goSimple (OrphanTypeDeclaration nm) =
454+ renderSimpleErrorMessage (OrphanTypeDeclaration nm) =
473 line $ "Orphan type declaration for " ++ showIdent nm
455 line $ "Orphan type declaration for " ++ showIdent nm
474− goSimple (OrphanFixityDeclaration op) =
456+ renderSimpleErrorMessage (OrphanFixityDeclaration op) =
475 line $ "Orphan fixity declaration for " ++ show op
457 line $ "Orphan fixity declaration for " ++ show op
476− goSimple (RedefinedModule name filenames) =
458+ renderSimpleErrorMessage (RedefinedModule name filenames) =
477− paras $ line ("Module " ++ runModuleName name ++ " has been defined multiple times:")
459+ paras [ line ("Module " ++ runModuleName name ++ " has been defined multiple times:")
478− : map (indent . line . displaySourceSpan) filenames
460+ , indent . paras $ map (line . displaySourceSpan) filenames
479− goSimple (RedefinedIdent name) =
462+ renderSimpleErrorMessage (RedefinedIdent name) =
480 line $ "Name " ++ showIdent name ++ " has been defined multiple times"
463 line $ "Name " ++ showIdent name ++ " has been defined multiple times"
481− goSimple (UnknownModule mn) =
464+ renderSimpleErrorMessage (UnknownModule mn) =
482 line $ "Unknown module " ++ runModuleName mn
465 line $ "Unknown module " ++ runModuleName mn
483− goSimple (UnknownType name) =
466+ renderSimpleErrorMessage (UnknownType name) =
484 line $ "Unknown type " ++ showQualified runProperName name
467 line $ "Unknown type " ++ showQualified runProperName name
485− goSimple (UnknownTypeClass name) =
468+ renderSimpleErrorMessage (UnknownTypeClass name) =
486 line $ "Unknown type class " ++ showQualified runProperName name
469 line $ "Unknown type class " ++ showQualified runProperName name
487− goSimple (UnknownValue name) =
470+ renderSimpleErrorMessage (UnknownValue name) =
488 line $ "Unknown value " ++ showQualified showIdent name
471 line $ "Unknown value " ++ showQualified showIdent name
489− goSimple (UnknownTypeConstructor name) =
472+ renderSimpleErrorMessage (UnknownTypeConstructor name) =
490 line $ "Unknown type constructor " ++ showQualified runProperName name
473 line $ "Unknown type constructor " ++ showQualified runProperName name
491− goSimple (UnknownDataConstructor dc tc) =
474+ renderSimpleErrorMessage (UnknownDataConstructor dc tc) =
492 line $ "Unknown data constructor " ++ showQualified runProperName dc ++ foldMap ((" for type constructor " ++) . showQualified runProperName) tc
475 line $ "Unknown data constructor " ++ showQualified runProperName dc ++ foldMap ((" for type constructor " ++) . showQualified runProperName) tc
493− goSimple (UnknownImportType mn name) =
476+ renderSimpleErrorMessage (UnknownImportType mn name) =
494 line $ "Module " ++ runModuleName mn ++ " does not export type " ++ runProperName name
477 line $ "Module " ++ runModuleName mn ++ " does not export type " ++ runProperName name
495− goSimple (UnknownExportType name) =
478+ renderSimpleErrorMessage (UnknownExportType name) =
496 line $ "Cannot export unknown type " ++ runProperName name
479 line $ "Cannot export unknown type " ++ runProperName name
497− goSimple (UnknownImportTypeClass mn name) =
480+ renderSimpleErrorMessage (UnknownImportTypeClass mn name) =
498 line $ "Module " ++ runModuleName mn ++ " does not export type class " ++ runProperName name
481 line $ "Module " ++ runModuleName mn ++ " does not export type class " ++ runProperName name
499− goSimple (UnknownExportTypeClass name) =
482+ renderSimpleErrorMessage (UnknownExportTypeClass name) =
500 line $ "Cannot export unknown type class " ++ runProperName name
483 line $ "Cannot export unknown type class " ++ runProperName name
501− goSimple (UnknownImportValue mn name) =
484+ renderSimpleErrorMessage (UnknownImportValue mn name) =
502 line $ "Module " ++ runModuleName mn ++ " does not export value " ++ showIdent name
485 line $ "Module " ++ runModuleName mn ++ " does not export value " ++ showIdent name
503− goSimple (UnknownExportValue name) =
486+ renderSimpleErrorMessage (UnknownExportValue name) =
504 line $ "Cannot export unknown value " ++ showIdent name
487 line $ "Cannot export unknown value " ++ showIdent name
505− goSimple (UnknownExportModule name) =
488+ renderSimpleErrorMessage (UnknownExportModule name) =
506 line $ "Cannot export unknown module " ++ runModuleName name ++ ", it either does not exist or has not been imported by the current module"
489 line $ "Cannot export unknown module " ++ runModuleName name ++ ", it either does not exist or has not been imported by the current module"
507− goSimple (UnknownImportDataConstructor mn tcon dcon) =
490+ renderSimpleErrorMessage (UnknownImportDataConstructor mn tcon dcon) =
508 line $ "Module " ++ runModuleName mn ++ " does not export data constructor " ++ runProperName dcon ++ " for type " ++ runProperName tcon
491 line $ "Module " ++ runModuleName mn ++ " does not export data constructor " ++ runProperName dcon ++ " for type " ++ runProperName tcon
509− goSimple (UnknownExportDataConstructor tcon dcon) =
492+ renderSimpleErrorMessage (UnknownExportDataConstructor tcon dcon) =
510 line $ "Cannot export data constructor " ++ runProperName dcon ++ " for type " ++ runProperName tcon ++ " as it has not been declared"
493 line $ "Cannot export data constructor " ++ runProperName dcon ++ " for type " ++ runProperName tcon ++ " as it has not been declared"
511− goSimple (ConflictingImport nm mn) =
494+ renderSimpleErrorMessage (ConflictingImport nm mn) =
512 line $ "Cannot declare " ++ show nm ++ " since another declaration of that name was imported from " ++ runModuleName mn
495 line $ "Cannot declare " ++ show nm ++ " since another declaration of that name was imported from " ++ runModuleName mn
513− goSimple (ConflictingImports nm m1 m2) =
496+ renderSimpleErrorMessage (ConflictingImports nm m1 m2) =
514 line $ "Conflicting imports for " ++ nm ++ " from modules " ++ runModuleName m1 ++ " and " ++ runModuleName m2
497 line $ "Conflicting imports for " ++ nm ++ " from modules " ++ runModuleName m1 ++ " and " ++ runModuleName m2
515− goSimple (ConflictingTypeDecls nm) =
498+ renderSimpleErrorMessage (ConflictingTypeDecls nm) =
516 line $ "Conflicting type declarations for " ++ runProperName nm
499 line $ "Conflicting type declarations for " ++ runProperName nm
517− goSimple (ConflictingCtorDecls nm) =
500+ renderSimpleErrorMessage (ConflictingCtorDecls nm) =
518 line $ "Conflicting data constructor declarations for " ++ runProperName nm
501 line $ "Conflicting data constructor declarations for " ++ runProperName nm
519− goSimple (TypeConflictsWithClass nm) =
502+ renderSimpleErrorMessage (TypeConflictsWithClass nm) =
520 line $ "Type " ++ runProperName nm ++ " conflicts with type class declaration of the same name"
503 line $ "Type " ++ runProperName nm ++ " conflicts with type class declaration of the same name"
521− goSimple (CtorConflictsWithClass nm) =
504+ renderSimpleErrorMessage (CtorConflictsWithClass nm) =
522 line $ "Data constructor " ++ runProperName nm ++ " conflicts with type class declaration of the same name"
505 line $ "Data constructor " ++ runProperName nm ++ " conflicts with type class declaration of the same name"
523− goSimple (ClassConflictsWithType nm) =
506+ renderSimpleErrorMessage (ClassConflictsWithType nm) =
524 line $ "Type class " ++ runProperName nm ++ " conflicts with type declaration of the same name"
507 line $ "Type class " ++ runProperName nm ++ " conflicts with type declaration of the same name"
525− goSimple (ClassConflictsWithCtor nm) =
508+ renderSimpleErrorMessage (ClassConflictsWithCtor nm) =
526 line $ "Type class " ++ runProperName nm ++ " conflicts with data constructor declaration of the same name"
509 line $ "Type class " ++ runProperName nm ++ " conflicts with data constructor declaration of the same name"
510+ renderSimpleErrorMessage (DuplicateModuleName mn) =
511+ line $ "Module " ++ runModuleName mn ++ " has been defined multiple times."
527− goSimple (DuplicateClassExport nm) =
512+ renderSimpleErrorMessage (DuplicateClassExport nm) =
528 line $ "Duplicate export declaration for type class " ++ runProperName nm
513 line $ "Duplicate export declaration for type class " ++ runProperName nm
529− goSimple (DuplicateValueExport nm) =
514+ renderSimpleErrorMessage (DuplicateValueExport nm) =
530 line $ "Duplicate export declaration for value " ++ showIdent nm
515 line $ "Duplicate export declaration for value " ++ showIdent nm
531− goSimple (CycleInDeclaration nm) =
516+ renderSimpleErrorMessage (CycleInDeclaration nm) =
532 line $ "Cycle in declaration of " ++ showIdent nm
517 line $ "Cycle in declaration of " ++ showIdent nm
533− goSimple (CycleInModules mns) =
518+ renderSimpleErrorMessage (CycleInModules mns) =
534 line $ "Cycle in module dependencies: " ++ intercalate ", " (map runModuleName mns)
519 line $ "Cycle in module dependencies: " ++ intercalate ", " (map runModuleName mns)
535− goSimple (CycleInTypeSynonym pn) =
520+ renderSimpleErrorMessage (CycleInTypeSynonym pn) =
536 line $ "Cycle in type synonym" ++ foldMap ((" " ++) . runProperName) pn
521 line $ "Cycle in type synonym" ++ foldMap ((" " ++) . runProperName) pn
537− goSimple (NameIsUndefined ident) =
522+ renderSimpleErrorMessage (NameIsUndefined ident) =
538 line $ showIdent ident ++ " is undefined"
523 line $ showIdent ident ++ " is undefined"
539− goSimple (NameNotInScope ident) =
524+ renderSimpleErrorMessage (NameNotInScope ident) =
540 line $ showIdent ident ++ " may not be defined in the current scope"
525 line $ showIdent ident ++ " may not be defined in the current scope"
541− goSimple (UndefinedTypeVariable name) =
526+ renderSimpleErrorMessage (UndefinedTypeVariable name) =
542 line $ "Type variable " ++ runProperName name ++ " is undefined"
527 line $ "Type variable " ++ runProperName name ++ " is undefined"
543− goSimple (PartiallyAppliedSynonym name) =
528+ renderSimpleErrorMessage (PartiallyAppliedSynonym name) =
544 paras [ line $ "Partially applied type synonym " ++ showQualified runProperName name
529 paras [ line $ "Partially applied type synonym " ++ showQualified runProperName name
545 , line "Type synonyms must be applied to all of their type arguments."
530 , line "Type synonyms must be applied to all of their type arguments."
547− goSimple (EscapedSkolem binding) =
532+ renderSimpleErrorMessage (EscapedSkolem binding) =
548 paras $ [ line "A type variable has escaped its scope." ]
533 paras $ [ line "A type variable has escaped its scope." ]
549 <> foldMap (\expr -> [ line "Relevant expression: "
534 <> foldMap (\expr -> [ line "Relevant expression: "
550− , indent $ line $ prettyPrintValue expr
535+ , indent $ prettyPrintValue expr
551 ]) binding
536 ]) binding
552− goSimple (TypesDoNotUnify t1 t2)
537+ renderSimpleErrorMessage (TypesDoNotUnify t1 t2)
553 = paras [ line "Cannot unify type"
538 = paras [ line "Cannot unify type"
554− , indent $ line $ prettyPrintType t1
539+ , indent $ typeAsBox t1
555 , line "with type"
540 , line "with type"
556− , indent $ line $ prettyPrintType t2
541+ , indent $ typeAsBox t2
558− goSimple (KindsDoNotUnify k1 k2) =
543+ renderSimpleErrorMessage (KindsDoNotUnify k1 k2) =
559 paras [ line "Cannot unify kind"
544 paras [ line "Cannot unify kind"
560− , indent $ line $ prettyPrintKind k1
545+ , indent $ kindAsBox k1
561 , line "with kind"
546 , line "with kind"
562− , indent $ line $ prettyPrintKind k2
547+ , indent $ kindAsBox k2
564− goSimple (ConstrainedTypeUnified t1 t2) =
549+ renderSimpleErrorMessage (ConstrainedTypeUnified t1 t2) =
565 paras [ line "Cannot unify constrained type"
550 paras [ line "Cannot unify constrained type"
566− , indent $ line $ prettyPrintType t1
551+ , indent $ typeAsBox t1
567 , line "with type"
552 , line "with type"
568− , indent $ line $ prettyPrintType t2
553+ , indent $ typeAsBox t2
570− goSimple (OverlappingInstances nm ts (d : ds)) =
555+ renderSimpleErrorMessage (OverlappingInstances nm ts (d : ds)) =
571− paras [ line $ "Overlapping instances found for " ++ showQualified runProperName nm ++ " " ++ unwords (map prettyPrintTypeAtom ts) ++ ":"
556+ paras [ line "Overlapping instances found for"
557+ , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
558+ , Box.vcat Box.left (map typeAtomAsBox ts)
560+ , line "The following instances were found:"
572 , indent $ paras (line (showQualified showIdent d ++ " (chosen)") : map (line . showQualified showIdent) ds)
561 , indent $ paras (line (showQualified showIdent d ++ " (chosen)") : map (line . showQualified showIdent) ds)
574− goSimple OverlappingInstances{} = error "OverlappingInstances: empty instance list"
563+ renderSimpleErrorMessage OverlappingInstances{} = error "OverlappingInstances: empty instance list"
575− goSimple (NoInstanceFound nm ts) =
564+ renderSimpleErrorMessage (NoInstanceFound nm ts) =
576− line $ "No instance found for " ++ showQualified runProperName nm ++ " " ++ unwords (map prettyPrintTypeAtom ts)
565+ paras [ line "No instance found for"
566+ , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
567+ , Box.vcat Box.left (map typeAtomAsBox ts)
577− goSimple (PossiblyInfiniteInstance nm ts) =
570+ renderSimpleErrorMessage (PossiblyInfiniteInstance nm ts) =
578− line $ "Instance for " ++ showQualified runProperName nm ++ " " ++ unwords (map prettyPrintTypeAtom ts) ++ " is possibly infinite."
571+ paras [ line "Instance for"
572+ , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
573+ , Box.vcat Box.left (map typeAtomAsBox ts)
575+ , line "is possibly infinite."
579− goSimple (CannotDerive nm ts) =
577+ renderSimpleErrorMessage (CannotDerive nm ts) =
580− line $ "Cannot derive " ++ showQualified runProperName nm ++ " instance for " ++ unwords (map prettyPrintTypeAtom ts)
578+ paras [ line "Cannot derive an instance for"
579+ , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
580+ , Box.vcat Box.left (map typeAtomAsBox ts)
581− goSimple (CannotFindDerivingType nm) =
583+ renderSimpleErrorMessage (CannotFindDerivingType nm) =
582 line $ "Cannot derive instance, because the type declaration for " ++ runProperName nm ++ " could not be found."
584 line $ "Cannot derive instance, because the type declaration for " ++ runProperName nm ++ " could not be found."
583− goSimple (DuplicateLabel l expr) =
585+ renderSimpleErrorMessage (DuplicateLabel l expr) =
584 paras $ [ line $ "Duplicate label " ++ show l ++ " in row." ]
586 paras $ [ line $ "Duplicate label " ++ show l ++ " in row." ]
585 <> foldMap (\expr' -> [ line "Relevant expression: "
587 <> foldMap (\expr' -> [ line "Relevant expression: "
586− , indent $ line $ prettyPrintValue expr'
588+ , indent $ prettyPrintValue expr'
588− goSimple (DuplicateTypeArgument name) =
590+ renderSimpleErrorMessage (DuplicateTypeArgument name) =
589 line $ "Duplicate type argument " ++ show name
591 line $ "Duplicate type argument " ++ show name
590− goSimple (DuplicateValueDeclaration nm) =
592+ renderSimpleErrorMessage (DuplicateValueDeclaration nm) =
591 line $ "Duplicate value declaration for " ++ showIdent nm
593 line $ "Duplicate value declaration for " ++ showIdent nm
592− goSimple (ArgListLengthsDiffer ident) =
594+ renderSimpleErrorMessage (ArgListLengthsDiffer ident) =
593 line $ "Argument list lengths differ in declaration " ++ showIdent ident
595 line $ "Argument list lengths differ in declaration " ++ showIdent ident
594− goSimple (OverlappingArgNames ident) =
596+ renderSimpleErrorMessage (OverlappingArgNames ident) =
595 line $ "Overlapping names in function/binder" ++ foldMap ((" in declaration" ++) . showIdent) ident
597 line $ "Overlapping names in function/binder" ++ foldMap ((" in declaration" ++) . showIdent) ident
596− goSimple (MissingClassMember ident) =
598+ renderSimpleErrorMessage (MissingClassMember ident) =
597 line $ "Member " ++ showIdent ident ++ " has not been implemented"
599 line $ "Member " ++ showIdent ident ++ " has not been implemented"
598− goSimple (ExtraneousClassMember ident) =
600+ renderSimpleErrorMessage (ExtraneousClassMember ident) =
599 line $ "Member " ++ showIdent ident ++ " is not a member of the class being instantiated"
601 line $ "Member " ++ showIdent ident ++ " is not a member of the class being instantiated"
600− goSimple (ExpectedType ty kind) =
602+ renderSimpleErrorMessage (ExpectedType ty kind) =
601 paras [ line "In a type-annotated expression x :: t, the type t must have kind *."
603 paras [ line "In a type-annotated expression x :: t, the type t must have kind *."
602− , line $ "The error arises from the type " ++ prettyPrintType ty ++ " having the kind " ++ prettyPrintKind kind ++ " instead."
604+ , line "The error arises from the type"
605+ , indent $ typeAsBox ty
606+ , line "having the kind"
607+ , indent $ kindAsBox kind
604− goSimple (IncorrectConstructorArity nm) =
610+ renderSimpleErrorMessage (IncorrectConstructorArity nm) =
605 line $ "Wrong number of arguments to constructor " ++ showQualified runProperName nm
611 line $ "Wrong number of arguments to constructor " ++ showQualified runProperName nm
606− goSimple SubsumptionCheckFailed = line "Unable to check type subsumption"
612+ renderSimpleErrorMessage SubsumptionCheckFailed = line "Unable to check type subsumption"
607− goSimple (ExprDoesNotHaveType expr ty) =
613+ renderSimpleErrorMessage (ExprDoesNotHaveType expr ty) =
608 paras [ line "Expression"
614 paras [ line "Expression"
609− , indent $ line $ prettyPrintValue expr
615+ , indent $ prettyPrintValue expr
610 , line "does not have type"
616 , line "does not have type"
611− , indent $ line $ prettyPrintType ty
617+ , indent $ typeAsBox ty
613− goSimple (PropertyIsMissing prop row) =
619+ renderSimpleErrorMessage (PropertyIsMissing prop row) =
621+ , indent $ prettyPrintRowWith '(' ')' row
614− line $ "Row " ++ prettyPrintRow row ++ " lacks required property " ++ show prop
622+ , line $ "lacks required property " ++ show prop
615− goSimple (CannotApplyFunction fn arg) =
624+ renderSimpleErrorMessage (CannotApplyFunction fn arg) =
616 paras [ line "Cannot apply function of type"
625 paras [ line "Cannot apply function of type"
617− , indent $ line $ prettyPrintType fn
626+ , indent $ typeAsBox fn
618 , line "to argument"
627 , line "to argument"
619− , indent $ line $ prettyPrintValue arg
628+ , indent $ prettyPrintValue arg
621− goSimple TypeSynonymInstance =
630+ renderSimpleErrorMessage TypeSynonymInstance =
622 line "Type synonym instances are disallowed"
631 line "Type synonym instances are disallowed"
623− goSimple (OrphanInstance nm cnm ts) =
632+ renderSimpleErrorMessage (OrphanInstance nm cnm ts) =
624− paras [ line $ "Instance " ++ showIdent nm ++ " for " ++ showQualified runProperName cnm ++ " " ++ unwords (map prettyPrintTypeAtom ts) ++ " is an orphan instance."
633+ paras [ line $ "Instance " ++ showIdent nm ++ " for "
634+ , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName cnm)
635+ , Box.vcat Box.left (map typeAtomAsBox ts)
637+ , line "is an orphan instance."
625 , line "An orphan instance is an instance which is defined in neither the class module nor the data type module."
638 , line "An orphan instance is an instance which is defined in neither the class module nor the data type module."
626 , line "Consider moving the instance, if possible, or using a newtype wrapper."
639 , line "Consider moving the instance, if possible, or using a newtype wrapper."
628− goSimple InvalidNewtype =
641+ renderSimpleErrorMessage InvalidNewtype =
629 line "Newtypes must define a single constructor with a single argument"
642 line "Newtypes must define a single constructor with a single argument"
630− goSimple (InvalidInstanceHead ty) =
643+ renderSimpleErrorMessage (InvalidInstanceHead ty) =
631 paras [ line "Invalid type in class instance head:"
644 paras [ line "Invalid type in class instance head:"
632− , indent $ line $ prettyPrintType ty
645+ , indent $ typeAsBox ty
634− goSimple (TransitiveExportError x ys) =
647+ renderSimpleErrorMessage (TransitiveExportError x ys) =
635 paras $ line ("An export for " ++ prettyPrintExport x ++ " requires the following to also be exported: ")
648 paras $ line ("An export for " ++ prettyPrintExport x ++ " requires the following to also be exported: ")
636 : map (line . prettyPrintExport) ys
649 : map (line . prettyPrintExport) ys
637− goSimple (ShadowedName nm) =
650+ renderSimpleErrorMessage (ShadowedName nm) =
638 line $ "Name '" ++ showIdent nm ++ "' was shadowed"
651 line $ "Name '" ++ showIdent nm ++ "' was shadowed"
639− goSimple (ShadowedTypeVar tv) =
652+ renderSimpleErrorMessage (ShadowedTypeVar tv) =
640 line $ "Type variable '" ++ tv ++ "' was shadowed"
653 line $ "Type variable '" ++ tv ++ "' was shadowed"
641− goSimple (UnusedTypeVar tv) =
654+ renderSimpleErrorMessage (UnusedTypeVar tv) =
642 line $ "Type variable '" ++ tv ++ "' was declared but not used"
655 line $ "Type variable '" ++ tv ++ "' was declared but not used"
643− goSimple (ClassOperator className opName) =
656+ renderSimpleErrorMessage (ClassOperator className opName) =
644 paras [ line $ "Class '" ++ runProperName className ++ "' declares operator " ++ showIdent opName ++ "."
657 paras [ line $ "Class '" ++ runProperName className ++ "' declares operator " ++ showIdent opName ++ "."
645− , indent $ line "This may be disallowed in the future - consider declaring a named member in the class and making the operator an alias:"
658+ , line "This may be disallowed in the future - consider declaring a named member in the class and making the operator an alias:"
646− , indent $ line $ showIdent opName ++ " = someMember"
659+ , indent . line $ showIdent opName ++ " = someMember"
648− goSimple (MisleadingEmptyTypeImport mn name) =
661+ renderSimpleErrorMessage (MisleadingEmptyTypeImport mn name) =
649 line $ "Importing type " ++ runProperName name ++ "(..) from " ++ runModuleName mn ++ " is misleading as it has no exported data constructors"
662 line $ "Importing type " ++ runProperName name ++ "(..) from " ++ runModuleName mn ++ " is misleading as it has no exported data constructors"
650− goSimple (ImportHidingModule name) =
663+ renderSimpleErrorMessage (ImportHidingModule name) =
651 line $ "Attempted to hide module " ++ runModuleName name ++ " in import expression, this is not permitted"
664 line $ "Attempted to hide module " ++ runModuleName name ++ " in import expression, this is not permitted"
652− goSimple (WildcardInferredType ty) =
665+ renderSimpleErrorMessage (WildcardInferredType ty) =
653− line $ "The wildcard type definition has the inferred type " ++ prettyPrintType ty
666+ paras [ line "The wildcard type definition has the inferred type "
667+ , indent $ typeAsBox ty
669+ renderSimpleErrorMessage (MissingTypeDeclaration ident) =
670+ paras [ line $ "No type declaration was provided for the top-level declaration of " ++ showIdent ident ++ "."
671+ , line "It is good practice to provide type declarations as a form of documentation."
672+ , line "Consider using a type wildcard to display the inferred type:"
673+ , indent $ line $ showIdent ident ++ " :: _"
654− goSimple (NotExhaustivePattern bs b) =
675+ renderSimpleErrorMessage (NotExhaustivePattern bs b) =
655 paras $ [ line "A case expression could not be determined to cover all inputs."
676 paras $ [ line "A case expression could not be determined to cover all inputs."
656 , line "The following additional cases are required to cover all inputs:\n"
677 , line "The following additional cases are required to cover all inputs:\n"
657 , Box.hsep 1 Box.left (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs))
678 , Box.hsep 1 Box.left (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs))
659 [ line "..." | not b ]
680 [ line "..." | not b ]
660− goSimple (OverlappingPattern bs b) =
681+ renderSimpleErrorMessage (OverlappingPattern bs b) =
661 paras $ [ line "A case expression contains unreachable cases:\n"
682 paras $ [ line "A case expression contains unreachable cases:\n"
662 , Box.hsep 1 Box.left (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs))
683 , Box.hsep 1 Box.left (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs))
664 [ line "..." | not b ]
685 [ line "..." | not b ]
665− go (NotYetDefined names err) =
686+ renderSimpleErrorMessage IncompleteExhaustivityCheck =
666− paras [ line $ "The following are not yet defined here: " ++ intercalate ", " (map showIdent names) ++ ":"
687+ paras [ line "An exhaustivity check was abandoned due to too many possible cases."
667− , indent $ go err
688+ , line "You may want to decomposing your data types into smaller types."
691+ renderHint :: ErrorMessageHint -> Box.Box
692+ renderHint (NotYetDefined names) =
693+ line $ "The following are not yet defined here: " ++ intercalate ", " (map showIdent names) ++ ":"
669− go (ErrorUnifyingTypes t1 t2 err) =
694+ renderHint (ErrorUnifyingTypes t1 t2) =
670 paras [ lineWithLevel "unifying type "
695 paras [ lineWithLevel "unifying type "
671− , indent $ line $ prettyPrintType t1
696+ , indent $ typeAsBox t1
672 , line "with type"
697 , line "with type"
673− , indent $ line $ prettyPrintType t2
698+ , indent $ typeAsBox t2
676− go (ErrorInExpression expr err) =
700+ renderHint (ErrorInExpression expr) =
677 paras [ lineWithLevel "in expression:"
701 paras [ lineWithLevel "in expression:"
678− , indent $ line $ prettyPrintValue expr
702+ , indent $ prettyPrintValue expr
681− go (ErrorInModule mn err) =
704+ renderHint (ErrorInModule mn) =
682 paras [ lineWithLevel $ "in module " ++ runModuleName mn ++ ":"
705 paras [ lineWithLevel $ "in module " ++ runModuleName mn ++ ":"
685− go (ErrorInSubsumption t1 t2 err) =
707+ renderHint (ErrorInSubsumption t1 t2) =
686 paras [ lineWithLevel "checking that type "
708 paras [ lineWithLevel "checking that type "
687− , indent $ line $ prettyPrintType t1
709+ , indent $ typeAsBox t1
688 , line "subsumes type"
710 , line "subsumes type"
689− , indent $ line $ prettyPrintType t2
711+ , indent $ typeAsBox t2
692− go (ErrorInInstance name ts err) =
713+ renderHint (ErrorInInstance nm ts) =
693− paras [ lineWithLevel $ "in type class instance " ++ showQualified runProperName name ++ " " ++ unwords (map prettyPrintTypeAtom ts) ++ ":"
714+ paras [ lineWithLevel "in type class instance"
694− , go err
715+ , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
716+ , Box.vcat Box.left (map typeAtomAsBox ts)
696− go (ErrorCheckingKind ty err) =
719+ renderHint (ErrorCheckingKind ty) =
697 paras [ lineWithLevel "checking kind of type "
720 paras [ lineWithLevel "checking kind of type "
698− , indent $ line $ prettyPrintType ty
721+ , indent $ typeAsBox ty
701− go (ErrorInferringType expr err) =
723+ renderHint (ErrorInferringType expr) =
702 paras [ lineWithLevel "inferring type of value "
724 paras [ lineWithLevel "inferring type of value "
703− , indent $ line $ prettyPrintValue expr
725+ , indent $ prettyPrintValue expr
706− go (ErrorCheckingType expr ty err) =
727+ renderHint (ErrorCheckingType expr ty) =
707 paras [ lineWithLevel "checking that value "
728 paras [ lineWithLevel "checking that value "
708− , indent $ line $ prettyPrintValue expr
729+ , indent $ prettyPrintValue expr
709 , line "has type"
730 , line "has type"
710− , indent $ line $ prettyPrintType ty
731+ , indent $ typeAsBox ty
713− go (ErrorInApplication f t a err) =
733+ renderHint (ErrorInApplication f t a) =
714 paras [ lineWithLevel "applying function"
734 paras [ lineWithLevel "applying function"
715− , indent $ line $ prettyPrintValue f
735+ , indent $ prettyPrintValue f
716 , line "of type"
736 , line "of type"
717− , indent $ line $ prettyPrintType t
737+ , indent $ typeAsBox t
718 , line "to argument"
738 , line "to argument"
719− , indent $ line $ prettyPrintValue a
739+ , indent $ prettyPrintValue a
722− go (ErrorInDataConstructor nm err) =
741+ renderHint (ErrorInDataConstructor nm) =
723− paras [ lineWithLevel $ "in data constructor " ++ runProperName nm ++ ":"
742+ lineWithLevel $ "in data constructor " ++ runProperName nm ++ ":"
726− go (ErrorInTypeConstructor nm err) =
743+ renderHint (ErrorInTypeConstructor nm) =
727− paras [ lineWithLevel $ "in type constructor " ++ runProperName nm ++ ":"
744+ lineWithLevel $ "in type constructor " ++ runProperName nm ++ ":"
730− go (ErrorInBindingGroup nms err) =
745+ renderHint (ErrorInBindingGroup nms) =
731− paras [ lineWithLevel $ "in binding group " ++ intercalate ", " (map showIdent nms) ++ ":"
746+ lineWithLevel $ "in binding group " ++ intercalate ", " (map showIdent nms) ++ ":"
734− go (ErrorInDataBindingGroup err) =
747+ renderHint ErrorInDataBindingGroup =
735− paras [ lineWithLevel $ "in data binding group:"
748+ lineWithLevel "in data binding group:"
738− go (ErrorInTypeSynonym name err) =
749+ renderHint (ErrorInTypeSynonym name) =
739− paras [ lineWithLevel $ "in type synonym " ++ runProperName name ++ ":"
750+ lineWithLevel $ "in type synonym " ++ runProperName name ++ ":"
742− go (ErrorInValueDeclaration n err) =
751+ renderHint (ErrorInValueDeclaration n) =
743− paras [ lineWithLevel $ "in value declaration " ++ showIdent n ++ ":"
752+ lineWithLevel $ "in value declaration " ++ showIdent n ++ ":"
746− go (ErrorInTypeDeclaration n err) =
753+ renderHint (ErrorInTypeDeclaration n) =
747− paras [ lineWithLevel $ "in type declaration for " ++ showIdent n ++ ":"
754+ lineWithLevel $ "in type declaration for " ++ showIdent n ++ ":"
750− go (ErrorInForeignImport nm err) =
755+ renderHint (ErrorInForeignImport nm) =
751− paras [ lineWithLevel $ "in foreign import " ++ showIdent nm ++ ":"
756+ lineWithLevel $ "in foreign import " ++ showIdent nm ++ ":"
754− go (PositionedError srcSpan err) =
757+ renderHint (PositionedError srcSpan) =
755− paras [ lineWithLevel $ "at " ++ displaySourceSpan srcSpan ++ ":"
758+ lineWithLevel $ "at " ++ displaySourceSpan srcSpan ++ ":"
758− go (SimpleErrorWrapper sem) = goSimple sem
760 lineWithLevel :: String -> Box.Box
760 lineWithLevel :: String -> Box.Box
761 lineWithLevel text = line $ show level ++ " " ++ text
761 lineWithLevel text = line $ show level ++ " " ++ text
@@ -765,23 +765,19 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError
765 Error -> "error"
765 Error -> "error"
766 Warning -> "warning"
766 Warning -> "warning"
768− suggestions :: ErrorMessage -> [Box.Box]
768+ suggestions :: SimpleErrorMessage -> [Box.Box]
769− suggestions = suggestions' . unwrapErrorMessage
771− suggestions' (ConflictingImport nm im) = [ line $ "Possible fix: hide " ++ show nm ++ " when importing " ++ runModuleName im ++ ":"
769+ suggestions (ConflictingImport nm im) = [ line $ "Possible fix: hide " ++ show nm ++ " when importing " ++ runModuleName im ++ ":"
772 , indent . line $ "import " ++ runModuleName im ++ " hiding (" ++ nm ++ ")"
770 , indent . line $ "import " ++ runModuleName im ++ " hiding (" ++ nm ++ ")"
774− suggestions' (TypesDoNotUnify t1 t2)
772+ suggestions (TypesDoNotUnify t1 t2)
775− | isObject t1 && isFunction t2 = [line "Note that function composition in PureScript is defined using (<<<)"]
773+ | isObject t1 && isFunction t2 = [line "Note that function composition in PureScript is defined using (<<<)"]
776− | otherwise = []
774+ | otherwise = []
777− suggestions' _ = []
775+ suggestions _ = []
779 paras :: [Box.Box] -> Box.Box
777 paras :: [Box.Box] -> Box.Box
780 paras = Box.vcat Box.left
778 paras = Box.vcat Box.left
783 -- Pretty print and export declaration
780 -- Pretty print and export declaration
785 prettyPrintExport :: DeclarationRef -> String
781 prettyPrintExport :: DeclarationRef -> String
786 prettyPrintExport (TypeRef pn _) = runProperName pn
782 prettyPrintExport (TypeRef pn _) = runProperName pn
787 prettyPrintExport (ValueRef ident) = showIdent ident
783 prettyPrintExport (ValueRef ident) = showIdent ident
@@ -790,38 +786,44 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError
790 prettyPrintExport (ModuleRef name) = "module " ++ runModuleName name
786 prettyPrintExport (ModuleRef name) = "module " ++ runModuleName name
791 prettyPrintExport (PositionedDeclarationRef _ _ ref) = prettyPrintExport ref
787 prettyPrintExport (PositionedDeclarationRef _ _ ref) = prettyPrintExport ref
793− -- |
789+ -- Hints get added at the front, so we need to reverse them before rendering
794− -- Simplify an error message
790+ reverseHints :: ErrorMessage -> ErrorMessage
795− --
791+ reverseHints (ErrorMessage hints simple) = ErrorMessage (reverse hints) simple
793+ -- | Put positional hints at the front of the list
796− simplifyErrorMessage :: ErrorMessage -> ErrorMessage
794+ positionHintsFirst :: ErrorMessage -> ErrorMessage
797− simplifyErrorMessage = unwrap Nothing
795+ positionHintsFirst (ErrorMessage hints simple) = ErrorMessage (uncurry (++) $ partition (isPositionHint . hintCategory) hints) simple
799− unwrap :: Maybe SourceSpan -> ErrorMessage -> ErrorMessage
797+ isPositionHint :: HintCategory -> Bool
800− unwrap pos (ErrorInExpression _ err) = unwrap pos err
798+ isPositionHint PositionHint = True
801− unwrap pos (ErrorInInstance name ts err) = ErrorInInstance name ts (unwrap pos err)
799+ isPositionHint OtherHint = True
802− unwrap pos (ErrorInSubsumption t1 t2 err) = ErrorInSubsumption t1 t2 (unwrap pos err)
800+ isPositionHint _ = False
803− unwrap pos (ErrorUnifyingTypes _ _ err) = unwrap pos err
804− unwrap pos (ErrorInferringType _ err) = unwrap pos err
805− unwrap pos (ErrorCheckingType _ _ err) = unwrap pos err
806− unwrap pos (ErrorCheckingKind ty err) = ErrorCheckingKind ty (unwrap pos err)
807− unwrap pos (ErrorInModule mn err) = ErrorInModule mn (unwrap pos err)
808− unwrap pos (ErrorInApplication _ _ _ err) = unwrap pos err
809− unwrap pos (ErrorInDataConstructor nm err) = ErrorInDataConstructor nm (unwrap pos err)
810− unwrap pos (ErrorInTypeConstructor nm err) = ErrorInTypeConstructor nm (unwrap pos err)
811− unwrap pos (ErrorInBindingGroup nms err) = ErrorInBindingGroup nms (unwrap pos err)
812− unwrap pos (ErrorInDataBindingGroup err) = ErrorInDataBindingGroup (unwrap pos err)
813− unwrap pos (ErrorInTypeSynonym nm err) = ErrorInTypeSynonym nm (unwrap pos err)
814− unwrap pos (ErrorInValueDeclaration nm err) = ErrorInValueDeclaration nm (unwrap pos err)
815− unwrap pos (ErrorInTypeDeclaration nm err) = ErrorInTypeDeclaration nm (unwrap pos err)
816− unwrap pos (ErrorInForeignImport nm err) = ErrorInForeignImport nm (unwrap pos err)
817− unwrap pos (NotYetDefined ns err) = NotYetDefined ns (unwrap pos err)
818− unwrap _ (PositionedError pos err) = unwrap (Just pos) err
819− unwrap pos other = wrap pos other
821− wrap :: Maybe SourceSpan -> ErrorMessage -> ErrorMessage
823− wrap (Just pos) = PositionedError pos
802+ -- | Simplify an error message
803+ simplifyErrorMessage :: ErrorMessage -> ErrorMessage
804+ simplifyErrorMessage (ErrorMessage hints simple) = ErrorMessage (simplifyHints hints) simple
806+ -- Take the last instance of each "hint category"
807+ simplifyHints :: [ErrorMessageHint] -> [ErrorMessageHint]
808+ simplifyHints = reverse . nubBy categoriesEqual . reverse
810+ -- Don't remove hints in the "other" category
811+ categoriesEqual :: ErrorMessageHint -> ErrorMessageHint -> Bool
812+ categoriesEqual x y =
813+ case (hintCategory x, hintCategory y) of
814+ (OtherHint, _) -> False
815+ (_, OtherHint) -> False
816+ (c1, c2) -> c1 == c2
818+ hintCategory :: ErrorMessageHint -> HintCategory
819+ hintCategory ErrorCheckingType{} = ExprHint
820+ hintCategory ErrorInferringType{} = ExprHint
821+ hintCategory ErrorInExpression{} = ExprHint
822+ hintCategory ErrorUnifyingTypes{} = CheckHint
823+ hintCategory ErrorInSubsumption{} = CheckHint
824+ hintCategory ErrorInApplication{} = CheckHint
825+ hintCategory PositionedError{} = PositionHint
826+ hintCategory _ = OtherHint
827-- Pretty print multiple errors
829-- Pretty print multiple errors
@@ -837,11 +839,11 @@ prettyPrintMultipleWarnings full = renderBox . prettyPrintMultipleWarningsBox fu
838-- | Pretty print warnings as a Box
840-- | Pretty print warnings as a Box
839prettyPrintMultipleWarningsBox :: Bool -> MultipleErrors -> Box.Box
841prettyPrintMultipleWarningsBox :: Bool -> MultipleErrors -> Box.Box
840−prettyPrintMultipleWarningsBox full = flip evalState M.empty . prettyPrintMultipleErrorsWith Warning "Warning found:" "Multiple warnings found:" full
842+prettyPrintMultipleWarningsBox full = flip evalState M.empty . prettyPrintMultipleErrorsWith Warning "Warning found:" "Warning" full
842-- | Pretty print errors as a Box
844-- | Pretty print errors as a Box
843prettyPrintMultipleErrorsBox :: Bool -> MultipleErrors -> Box.Box
845prettyPrintMultipleErrorsBox :: Bool -> MultipleErrors -> Box.Box
844−prettyPrintMultipleErrorsBox full = flip evalState M.empty . prettyPrintMultipleErrorsWith Error "Error found:" "Multiple errors found:" full
846+prettyPrintMultipleErrorsBox full = flip evalState M.empty . prettyPrintMultipleErrorsWith Error "Error found:" "Error" full
846prettyPrintMultipleErrorsWith :: Level -> String -> String -> Bool -> MultipleErrors -> State UnknownMap Box.Box
848prettyPrintMultipleErrorsWith :: Level -> String -> String -> Bool -> MultipleErrors -> State UnknownMap Box.Box
847prettyPrintMultipleErrorsWith level intro _ full (MultipleErrors [e]) = do
849prettyPrintMultipleErrorsWith level intro _ full (MultipleErrors [e]) = do
@@ -851,15 +853,16 @@ prettyPrintMultipleErrorsWith level intro _ full (MultipleErrors [e]) = do
853prettyPrintMultipleErrorsWith level _ intro full (MultipleErrors es) = do
855prettyPrintMultipleErrorsWith level _ intro full (MultipleErrors es) = do
854− result <- forM es $ (liftM $ Box.moveRight 2) . prettyPrintSingleError full level
856+ result <- forM es $ prettyPrintSingleError full level
855− return $
857+ return $ Box.vsep 1 Box.left $ concat $ zipWith withIntro [1 :: Int ..] result
856− Box.vcat Box.left [ Box.text intro
858+ where
857− , Box.vsep 1 Box.left result
859+ withIntro i err = [ Box.text (intro ++ " " ++ show i ++ " of " ++ show (length es) ++ ":")
860+ , Box.moveRight 2 err
860-- | Pretty print a Parsec ParseError as a Box
863-- | Pretty print a Parsec ParseError as a Box
861prettyPrintParseError :: P.ParseError -> Box.Box
864prettyPrintParseError :: P.ParseError -> Box.Box
862−prettyPrintParseError = (prettyPrintParseErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input") . PE.errorMessages
865+prettyPrintParseError = prettyPrintParseErrorMessages "or" "unknown parse error" "expecting" "unexpected" "end of input" . PE.errorMessages
865-- Pretty print ParseError detail messages.
868-- Pretty print ParseError detail messages.
@@ -872,9 +875,9 @@ prettyPrintParseErrorMessages msgOr msgUnknown msgExpecting msgUnExpected msgEnd
872 | otherwise = Box.vcat Box.left $ map Box.text $ clean [showSysUnExpect,showUnExpect,showExpect,showMessages]
875 | otherwise = Box.vcat Box.left $ map Box.text $ clean [showSysUnExpect,showUnExpect,showExpect,showMessages]
875− (sysUnExpect,msgs1) = span ((SysUnExpect "") ==) msgs
878+ (sysUnExpect,msgs1) = span (SysUnExpect "" ==) msgs
876− (unExpect,msgs2) = span ((UnExpect "") ==) msgs1
879+ (unExpect,msgs2) = span (UnExpect "" ==) msgs1
877− (expect,messages) = span ((Expect "") ==) msgs2
880+ (expect,messages) = span (Expect "" ==) msgs2
879 showExpect = showMany msgExpecting expect
882 showExpect = showMany msgExpecting expect
880 showUnExpect = showMany msgUnExpected unExpect
883 showUnExpect = showMany msgUnExpected unExpect
@@ -905,8 +908,9 @@ prettyPrintParseErrorMessages msgOr msgUnknown msgExpecting msgUnExpected msgEnd
906 clean = nub . filter (not . null)
909 clean = nub . filter (not . null)
911+-- | Indent to the right, and pad on top and bottom.
908indent :: Box.Box -> Box.Box
912indent :: Box.Box -> Box.Box
909−indent = Box.moveRight 2
913+indent = Box.moveUp 1 . Box.moveDown 1 . Box.moveRight 2
911line :: String -> Box.Box
915line :: String -> Box.Box
912line = Box.text
916line = Box.text
@@ -922,7 +926,7 @@ renderBox = unlines . map trimEnd . lines . Box.render
922interpretMultipleErrorsAndWarnings :: (MonadError MultipleErrors m, MonadWriter MultipleErrors m) => (Either MultipleErrors a, MultipleErrors) -> m a
926interpretMultipleErrorsAndWarnings :: (MonadError MultipleErrors m, MonadWriter MultipleErrors m) => (Either MultipleErrors a, MultipleErrors) -> m a
923interpretMultipleErrorsAndWarnings (err, ws) = do
927interpretMultipleErrorsAndWarnings (err, ws) = do
925− either throwError return $ err
929+ either throwError return err
928-- Rethrow an error with a more detailed error message in the case of failure
932-- Rethrow an error with a more detailed error message in the case of failure
@@ -946,8 +950,7 @@ warnAndRethrowWithPosition :: (MonadError MultipleErrors m, MonadWriter Multiple
946warnAndRethrowWithPosition pos = rethrowWithPosition pos . warnWithPosition pos
950warnAndRethrowWithPosition pos = rethrowWithPosition pos . warnWithPosition pos
948withPosition :: SourceSpan -> ErrorMessage -> ErrorMessage
952withPosition :: SourceSpan -> ErrorMessage -> ErrorMessage
949−withPosition _ (PositionedError pos err) = withPosition pos err
953+withPosition pos (ErrorMessage hints se) = ErrorMessage (PositionedError pos : hints) se
950−withPosition pos err = PositionedError pos err
953-- Collect errors in in parallel
956-- Collect errors in in parallel