@@ -26,9 +26,12 @@ import Language.PureScript.Names
26import Language.PureScript.Pretty
26import Language.PureScript.Pretty
27import Language.PureScript.Traversals
27import Language.PureScript.Traversals
28import Language.PureScript.Types
28import Language.PureScript.Types
29+import Language.PureScript.Pretty.Common (endWith)
29import qualified Language.PureScript.Bundle as Bundle
30import qualified Language.PureScript.Bundle as Bundle
30import qualified Language.PureScript.Constants as C
31import qualified Language.PureScript.Constants as C
33+import qualified System.Console.ANSI as ANSI
32import qualified Text.Parsec as P
35import qualified Text.Parsec as P
33import qualified Text.Parsec.Error as PE
36import qualified Text.Parsec.Error as PE
34import qualified Text.PrettyPrint.Boxes as Box
37import qualified Text.PrettyPrint.Boxes as Box
@@ -457,15 +460,65 @@ showSuggestion suggestion = case errorSuggestion suggestion of
457 Just (ErrorSuggestion x) -> x
460 Just (ErrorSuggestion x) -> x
463+ansiColor :: (ANSI.ColorIntensity, ANSI.Color) -> String
464+ansiColor (intesity, color) =
465+ ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground intesity color]
467+ansiColorReset :: String
469+ ANSI.setSGRCode [ANSI.Reset]
471+colorCode :: Maybe (ANSI.ColorIntensity, ANSI.Color) -> String -> String
472+colorCode codeColor code = case codeColor of
474+ Just cc -> concat [ansiColor cc, code, ansiColorReset]
476+colorCodeBox :: Maybe (ANSI.ColorIntensity, ANSI.Color) -> Box.Box -> Box.Box
477+colorCodeBox codeColor b = case codeColor of
480+ | Box.rows b == 1 ->
481+ Box.text (ansiColor cc) Box.<> b `endWith` Box.text ansiColorReset
483+ | otherwise -> Box.hcat Box.left -- making two boxes, one for each side of the box so that it will set each row it's own color and will reset it afterwards
484+ [ Box.vcat Box.top $ replicate (Box.rows b) $ Box.text $ ansiColor cc
486+ , Box.vcat Box.top $ replicate (Box.rows b) $ Box.text ansiColorReset
490+-- | Default color intesity and color for code
491+defaultCodeColor :: (ANSI.ColorIntensity, ANSI.Color)
492+defaultCodeColor = (ANSI.Dull, ANSI.Yellow)
494+-- | `prettyPrintSingleError` Options
495+data PPEOptions = PPEOptions
496+ { ppeCodeColor :: Maybe (ANSI.ColorIntensity, ANSI.Color) -- ^ Color code with this color... or not
497+ , ppeFull :: Bool -- ^ Should write a full error message?
498+ , ppeLevel :: Level -- ^ Should this report an error or a warning?
499+ , ppeShowWiki :: Bool -- ^ Should show a link to error message's wiki page?
502+-- | Default options for PPEOptions
503+defaultPPEOptions :: PPEOptions
504+defaultPPEOptions = PPEOptions
505+ { ppeCodeColor = Just defaultCodeColor
508+ , ppeShowWiki = True
461-- Pretty print a single error, simplifying if necessary
513-- Pretty print a single error, simplifying if necessary
463−prettyPrintSingleError :: Bool -> Level -> Bool -> ErrorMessage -> Box.Box
515+prettyPrintSingleError :: PPEOptions -> ErrorMessage -> Box.Box
464−prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap $ do
516+prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalState defaultUnknownMap $ do
465 em <- onTypesInErrorMessageM replaceUnknowns (if full then e else simplifyErrorMessage e)
517 em <- onTypesInErrorMessageM replaceUnknowns (if full then e else simplifyErrorMessage e)
466 um <- get
518 um <- get
467 return (prettyPrintErrorMessage um em)
519 return (prettyPrintErrorMessage um em)
521+ (markCode, markCodeBox) = (colorCode &&& colorCodeBox) codeColor
470 -- Pretty print an ErrorMessage
523 -- Pretty print an ErrorMessage
471 prettyPrintErrorMessage :: TypeMap -> ErrorMessage -> Box.Box
524 prettyPrintErrorMessage :: TypeMap -> ErrorMessage -> Box.Box
@@ -474,9 +527,10 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
474 [ foldr renderHint (indent (renderSimpleErrorMessage simple)) hints
527 [ foldr renderHint (indent (renderSimpleErrorMessage simple)) hints
476 maybe [] (return . Box.moveDown 1) typeInformation ++
529 maybe [] (return . Box.moveDown 1) typeInformation ++
530+ [ Box.moveDown 1 $ paras
477− [ Box.moveDown 1 $ paras [ line $ "See " ++ wikiUri e ++ " for more information, "
531+ [ line $ "See " ++ wikiUri e ++ " for more information, "
478− , line $ "or to contribute content related to this " ++ levelText ++ "."
532+ , line $ "or to contribute content related to this " ++ levelText ++ "."
480 | showWiki
534 | showWiki
@@ -491,11 +545,11 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
491 skolemInfo :: (String, Int, Maybe SourceSpan) -> Box.Box
545 skolemInfo :: (String, Int, Maybe SourceSpan) -> Box.Box
492 skolemInfo (name, s, ss) =
546 skolemInfo (name, s, ss) =
494− line (name ++ show s ++ " is a rigid type variable")
548+ line (markCode (name ++ show s) ++ " is a rigid type variable")
495 : foldMap (return . line . (" bound at " ++) . displayStartEndPos) ss
549 : foldMap (return . line . (" bound at " ++) . displayStartEndPos) ss
497 unknownInfo :: Int -> Box.Box
551 unknownInfo :: Int -> Box.Box
498− unknownInfo u = line $ "t" ++ show u ++ " is an unknown type"
552+ unknownInfo u = line $ markCode ("t" ++ show u) ++ " is an unknown type"
500 renderSimpleErrorMessage :: SimpleErrorMessage -> Box.Box
554 renderSimpleErrorMessage :: SimpleErrorMessage -> Box.Box
501 renderSimpleErrorMessage (CannotGetFileInfo path) =
555 renderSimpleErrorMessage (CannotGetFileInfo path) =
@@ -520,29 +574,29 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
520 , prettyPrintParseError err
574 , prettyPrintParseError err
522 renderSimpleErrorMessage (MissingFFIModule mn) =
576 renderSimpleErrorMessage (MissingFFIModule mn) =
523− line $ "The foreign module implementation for module " ++ runModuleName mn ++ " is missing."
577+ line $ "The foreign module implementation for module " ++ markCode (runModuleName mn) ++ " is missing."
524 renderSimpleErrorMessage (UnnecessaryFFIModule mn path) =
578 renderSimpleErrorMessage (UnnecessaryFFIModule mn path) =
525− paras [ line $ "An unnecessary foreign module implementation was provided for module " ++ runModuleName mn ++ ": "
579+ paras [ line $ "An unnecessary foreign module implementation was provided for module " ++ markCode (runModuleName mn) ++ ": "
526 , indent . line $ path
580 , indent . line $ path
527− , line $ "Module " ++ runModuleName mn ++ " does not contain any foreign import declarations, so a foreign module is not necessary."
581+ , line $ "Module " ++ markCode (runModuleName mn) ++ " does not contain any foreign import declarations, so a foreign module is not necessary."
529 renderSimpleErrorMessage (MissingFFIImplementations mn idents) =
583 renderSimpleErrorMessage (MissingFFIImplementations mn idents) =
530− paras [ line $ "The following values are not defined in the foreign module for module " ++ runModuleName mn ++ ": "
584+ paras [ line $ "The following values are not defined in the foreign module for module " ++ markCode (runModuleName mn) ++ ": "
531 , indent . paras $ map (line . runIdent) idents
585 , indent . paras $ map (line . runIdent) idents
533 renderSimpleErrorMessage (UnusedFFIImplementations mn idents) =
587 renderSimpleErrorMessage (UnusedFFIImplementations mn idents) =
534− paras [ line $ "The following definitions in the foreign module for module " ++ runModuleName mn ++ " are unused: "
588+ paras [ line $ "The following definitions in the foreign module for module " ++ markCode (runModuleName mn) ++ " are unused: "
535 , indent . paras $ map (line . runIdent) idents
589 , indent . paras $ map (line . runIdent) idents
537 renderSimpleErrorMessage (InvalidFFIIdentifier mn ident) =
591 renderSimpleErrorMessage (InvalidFFIIdentifier mn ident) =
538− paras [ line $ "In the FFI module for " ++ runModuleName mn ++ ":"
592+ paras [ line $ "In the FFI module for " ++ markCode (runModuleName mn) ++ ":"
539 , indent . paras $
593 , indent . paras $
540− [ line $ "The identifier `" ++ ident ++ "` is not valid in PureScript."
594+ [ line $ "The identifier " ++ markCode ident ++ " is not valid in PureScript."
541 , line "Note that exported identifiers in FFI modules must be valid PureScript identifiers."
595 , line "Note that exported identifiers in FFI modules must be valid PureScript identifiers."
544 renderSimpleErrorMessage (MultipleFFIModules mn paths) =
598 renderSimpleErrorMessage (MultipleFFIModules mn paths) =
545− paras [ line $ "Multiple foreign module implementations have been provided for module " ++ runModuleName mn ++ ": "
599+ paras [ line $ "Multiple foreign module implementations have been provided for module " ++ markCode (runModuleName mn) ++ ": "
546 , indent . paras $ map line paths
600 , indent . paras $ map line paths
548 renderSimpleErrorMessage InvalidDoBind =
602 renderSimpleErrorMessage InvalidDoBind =
@@ -553,94 +607,94 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
553 line "The same name was used more than once in a let binding."
607 line "The same name was used more than once in a let binding."
554 renderSimpleErrorMessage (InfiniteType ty) =
608 renderSimpleErrorMessage (InfiniteType ty) =
555 paras [ line "An infinite type was inferred for an expression: "
609 paras [ line "An infinite type was inferred for an expression: "
556− , indent $ typeAsBox ty
610+ , markCodeBox $ indent $ typeAsBox ty
558 renderSimpleErrorMessage (InfiniteKind ki) =
612 renderSimpleErrorMessage (InfiniteKind ki) =
559 paras [ line "An infinite kind was inferred for a type: "
613 paras [ line "An infinite kind was inferred for a type: "
560− , indent $ line $ prettyPrintKind ki
614+ , indent $ line $ markCode $ prettyPrintKind ki
562 renderSimpleErrorMessage (MultipleValueOpFixities op) =
616 renderSimpleErrorMessage (MultipleValueOpFixities op) =
563− line $ "There are multiple fixity/precedence declarations for operator " ++ showOp op
617+ line $ "There are multiple fixity/precedence declarations for operator " ++ markCode (showOp op)
564 renderSimpleErrorMessage (MultipleTypeOpFixities op) =
618 renderSimpleErrorMessage (MultipleTypeOpFixities op) =
565− line $ "There are multiple fixity/precedence declarations for type operator " ++ showOp op
619+ line $ "There are multiple fixity/precedence declarations for type operator " ++ markCode (showOp op)
566 renderSimpleErrorMessage (OrphanTypeDeclaration nm) =
620 renderSimpleErrorMessage (OrphanTypeDeclaration nm) =
567− line $ "The type declaration for " ++ showIdent nm ++ " should be followed by its definition."
621+ line $ "The type declaration for " ++ markCode (showIdent nm) ++ " should be followed by its definition."
568 renderSimpleErrorMessage (RedefinedModule name filenames) =
622 renderSimpleErrorMessage (RedefinedModule name filenames) =
569− paras [ line ("The module " ++ runModuleName name ++ " has been defined multiple times:")
623+ paras [ line ("The module " ++ markCode (runModuleName name) ++ " has been defined multiple times:")
570 , indent . paras $ map (line . displaySourceSpan) filenames
624 , indent . paras $ map (line . displaySourceSpan) filenames
572 renderSimpleErrorMessage (RedefinedIdent name) =
626 renderSimpleErrorMessage (RedefinedIdent name) =
573− line $ "The value " ++ showIdent name ++ " has been defined multiple times"
627+ line $ "The value " ++ markCode (showIdent name) ++ " has been defined multiple times"
574 renderSimpleErrorMessage (UnknownName name) =
628 renderSimpleErrorMessage (UnknownName name) =
575 line $ "Unknown " ++ printName name
629 line $ "Unknown " ++ printName name
576 renderSimpleErrorMessage (UnknownImport mn name) =
630 renderSimpleErrorMessage (UnknownImport mn name) =
577− paras [ line $ "Cannot import " ++ printName (Qualified Nothing name) ++ " from module " ++ runModuleName mn
631+ paras [ line $ "Cannot import " ++ printName (Qualified Nothing name) ++ " from module " ++ markCode (runModuleName mn)
578 , line "It either does not exist or the module does not export it."
632 , line "It either does not exist or the module does not export it."
580 renderSimpleErrorMessage (UnknownImportDataConstructor mn tcon dcon) =
634 renderSimpleErrorMessage (UnknownImportDataConstructor mn tcon dcon) =
581− line $ "Module " ++ runModuleName mn ++ " does not export data constructor " ++ runProperName dcon ++ " for type " ++ runProperName tcon
635+ line $ "Module " ++ runModuleName mn ++ " does not export data constructor " ++ markCode (runProperName dcon) ++ " for type " ++ markCode (runProperName tcon)
582 renderSimpleErrorMessage (UnknownExport name) =
636 renderSimpleErrorMessage (UnknownExport name) =
583 line $ "Cannot export unknown " ++ printName (Qualified Nothing name)
637 line $ "Cannot export unknown " ++ printName (Qualified Nothing name)
584 renderSimpleErrorMessage (UnknownExportDataConstructor tcon dcon) =
638 renderSimpleErrorMessage (UnknownExportDataConstructor tcon dcon) =
585− line $ "Cannot export data constructor " ++ runProperName dcon ++ " for type " ++ runProperName tcon ++ ", as it has not been declared."
639+ line $ "Cannot export data constructor " ++ markCode (runProperName dcon) ++ " for type " ++ markCode (runProperName tcon) ++ ", as it has not been declared."
586 renderSimpleErrorMessage (ScopeConflict nm ms) =
640 renderSimpleErrorMessage (ScopeConflict nm ms) =
587 paras [ line $ "Conflicting definitions are in scope for " ++ printName (Qualified Nothing nm) ++ " from the following modules:"
641 paras [ line $ "Conflicting definitions are in scope for " ++ printName (Qualified Nothing nm) ++ " from the following modules:"
588− , indent $ paras $ map (line . runModuleName) ms
642+ , indent $ paras $ map (line . markCode . runModuleName) ms
590 renderSimpleErrorMessage (ScopeShadowing nm exmn ms) =
644 renderSimpleErrorMessage (ScopeShadowing nm exmn ms) =
591 paras [ line $ "Shadowed definitions are in scope for " ++ printName (Qualified Nothing nm) ++ " from the following open imports:"
645 paras [ line $ "Shadowed definitions are in scope for " ++ printName (Qualified Nothing nm) ++ " from the following open imports:"
592− , indent $ paras $ map (line . ("import " ++) . runModuleName) ms
646+ , indent $ paras $ map (line . markCode . ("import " ++) . runModuleName) ms
593 , line $ "These will be ignored and the " ++ case exmn of
647 , line $ "These will be ignored and the " ++ case exmn of
594− Just exmn' -> "declaration from " ++ runModuleName exmn' ++ " will be used."
648+ Just exmn' -> "declaration from " ++ markCode (runModuleName exmn') ++ " will be used."
595 Nothing -> "local declaration will be used."
649 Nothing -> "local declaration will be used."
597 renderSimpleErrorMessage (ConflictingTypeDecls nm) =
651 renderSimpleErrorMessage (ConflictingTypeDecls nm) =
598− line $ "Conflicting type declarations for " ++ runProperName nm
652+ line $ "Conflicting type declarations for " ++ markCode (runProperName nm)
599 renderSimpleErrorMessage (ConflictingCtorDecls nm) =
653 renderSimpleErrorMessage (ConflictingCtorDecls nm) =
600− line $ "Conflicting data constructor declarations for " ++ runProperName nm
654+ line $ "Conflicting data constructor declarations for " ++ markCode (runProperName nm)
601 renderSimpleErrorMessage (TypeConflictsWithClass nm) =
655 renderSimpleErrorMessage (TypeConflictsWithClass nm) =
602− line $ "Type " ++ runProperName nm ++ " conflicts with a type class declaration with the same name."
656+ line $ "Type " ++ markCode (runProperName nm) ++ " conflicts with a type class declaration with the same name."
603 renderSimpleErrorMessage (CtorConflictsWithClass nm) =
657 renderSimpleErrorMessage (CtorConflictsWithClass nm) =
604− line $ "Data constructor " ++ runProperName nm ++ " conflicts with a type class declaration with the same name."
658+ line $ "Data constructor " ++ markCode (runProperName nm) ++ " conflicts with a type class declaration with the same name."
605 renderSimpleErrorMessage (ClassConflictsWithType nm) =
659 renderSimpleErrorMessage (ClassConflictsWithType nm) =
606− line $ "Type class " ++ runProperName nm ++ " conflicts with a type declaration with the same name."
660+ line $ "Type class " ++ markCode (runProperName nm) ++ " conflicts with a type declaration with the same name."
607 renderSimpleErrorMessage (ClassConflictsWithCtor nm) =
661 renderSimpleErrorMessage (ClassConflictsWithCtor nm) =
608− line $ "Type class " ++ runProperName nm ++ " conflicts with a data constructor declaration with the same name."
662+ line $ "Type class " ++ markCode (runProperName nm) ++ " conflicts with a data constructor declaration with the same name."
609 renderSimpleErrorMessage (DuplicateModuleName mn) =
663 renderSimpleErrorMessage (DuplicateModuleName mn) =
610− line $ "Module " ++ runModuleName mn ++ " has been defined multiple times."
664+ line $ "Module " ++ markCode (runModuleName mn) ++ " has been defined multiple times."
611 renderSimpleErrorMessage (DuplicateClassExport nm) =
665 renderSimpleErrorMessage (DuplicateClassExport nm) =
612− line $ "Duplicate export declaration for type class " ++ runProperName nm
666+ line $ "Duplicate export declaration for type class " ++ markCode (runProperName nm)
613 renderSimpleErrorMessage (DuplicateValueExport nm) =
667 renderSimpleErrorMessage (DuplicateValueExport nm) =
614− line $ "Duplicate export declaration for value " ++ showIdent nm
668+ line $ "Duplicate export declaration for value " ++ markCode (showIdent nm)
615 renderSimpleErrorMessage (DuplicateValueOpExport op) =
669 renderSimpleErrorMessage (DuplicateValueOpExport op) =
616− line $ "Duplicate export declaration for operator " ++ showOp op
670+ line $ "Duplicate export declaration for operator " ++ markCode (showOp op)
617 renderSimpleErrorMessage (DuplicateTypeOpExport op) =
671 renderSimpleErrorMessage (DuplicateTypeOpExport op) =
618− line $ "Duplicate export declaration for type operator " ++ showOp op
672+ line $ "Duplicate export declaration for type operator " ++ markCode (showOp op)
619 renderSimpleErrorMessage (CycleInDeclaration nm) =
673 renderSimpleErrorMessage (CycleInDeclaration nm) =
620− line $ "The value of " ++ showIdent nm ++ " is undefined here, so this reference is not allowed."
674+ line $ "The value of " ++ markCode (showIdent nm) ++ " is undefined here, so this reference is not allowed."
621 renderSimpleErrorMessage (CycleInModules mns) =
675 renderSimpleErrorMessage (CycleInModules mns) =
622 paras [ line "There is a cycle in module dependencies in these modules: "
676 paras [ line "There is a cycle in module dependencies in these modules: "
623− , indent $ paras (map (line . runModuleName) mns)
677+ , indent $ paras (map (line . markCode . runModuleName) mns)
625 renderSimpleErrorMessage (CycleInTypeSynonym name) =
679 renderSimpleErrorMessage (CycleInTypeSynonym name) =
626 paras [ line $ case name of
680 paras [ line $ case name of
627− Just pn -> "A cycle appears in the definition of type synonym " ++ runProperName pn
681+ Just pn -> "A cycle appears in the definition of type synonym " ++ markCode (runProperName pn)
628 Nothing -> "A cycle appears in a set of type synonym definitions."
682 Nothing -> "A cycle appears in a set of type synonym definitions."
629 , line "Cycles are disallowed because they can lead to loops in the type checker."
683 , line "Cycles are disallowed because they can lead to loops in the type checker."
630 , line "Consider using a 'newtype' instead."
684 , line "Consider using a 'newtype' instead."
632 renderSimpleErrorMessage (NameIsUndefined ident) =
686 renderSimpleErrorMessage (NameIsUndefined ident) =
633− line $ "Value " ++ showIdent ident ++ " is undefined."
687+ line $ "Value " ++ markCode (showIdent ident) ++ " is undefined."
634 renderSimpleErrorMessage (UndefinedTypeVariable name) =
688 renderSimpleErrorMessage (UndefinedTypeVariable name) =
635− line $ "Type variable " ++ runProperName name ++ " is undefined."
689+ line $ "Type variable " ++ markCode (runProperName name) ++ " is undefined."
636 renderSimpleErrorMessage (PartiallyAppliedSynonym name) =
690 renderSimpleErrorMessage (PartiallyAppliedSynonym name) =
637− paras [ line $ "Type synonym " ++ showQualified runProperName name ++ " is partially applied."
691+ paras [ line $ "Type synonym " ++ markCode (showQualified runProperName name) ++ " is partially applied."
638 , line "Type synonyms must be applied to all of their type arguments."
692 , line "Type synonyms must be applied to all of their type arguments."
640 renderSimpleErrorMessage (EscapedSkolem binding) =
694 renderSimpleErrorMessage (EscapedSkolem binding) =
641 paras $ [ line "A type variable has escaped its scope." ]
695 paras $ [ line "A type variable has escaped its scope." ]
642 <> foldMap (\expr -> [ line "Relevant expression: "
696 <> foldMap (\expr -> [ line "Relevant expression: "
643− , indent $ prettyPrintValue valueDepth expr
697+ , markCodeBox $ indent $ prettyPrintValue valueDepth expr
644 ]) binding
698 ]) binding
645 renderSimpleErrorMessage (TypesDoNotUnify u1 u2)
699 renderSimpleErrorMessage (TypesDoNotUnify u1 u2)
646 = let (sorted1, sorted2) = sortRows u1 u2
700 = let (sorted1, sorted2) = sortRows u1 u2
@@ -662,28 +716,29 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
662 , rowFromList (sortBy (comparing fst) sd2 ++ map (fst &&& snd . snd) common, r2)
716 , rowFromList (sortBy (comparing fst) sd2 ++ map (fst &&& snd . snd) common, r2)
664 in paras [ line "Could not match type"
718 in paras [ line "Could not match type"
665− , indent $ typeAsBox sorted1
719+ , markCodeBox $ indent $ typeAsBox sorted1
666 , line "with type"
720 , line "with type"
667− , indent $ typeAsBox sorted2
721+ , markCodeBox $ indent $ typeAsBox sorted2
670 renderSimpleErrorMessage (KindsDoNotUnify k1 k2) =
724 renderSimpleErrorMessage (KindsDoNotUnify k1 k2) =
671 paras [ line "Could not match kind"
725 paras [ line "Could not match kind"
672− , indent $ line $ prettyPrintKind k1
726+ , indent $ line $ markCode $ prettyPrintKind k1
673 , line "with kind"
727 , line "with kind"
674− , indent $ line $ prettyPrintKind k2
728+ , indent $ line $ markCode $ prettyPrintKind k2
676 renderSimpleErrorMessage (ConstrainedTypeUnified t1 t2) =
730 renderSimpleErrorMessage (ConstrainedTypeUnified t1 t2) =
677 paras [ line "Could not match constrained type"
731 paras [ line "Could not match constrained type"
678− , indent $ typeAsBox t1
732+ , markCodeBox $ indent $ typeAsBox t1
679 , line "with type"
733 , line "with type"
680− , indent $ typeAsBox t2
734+ , markCodeBox $ indent $ typeAsBox t2
682 renderSimpleErrorMessage (OverlappingInstances nm ts (d : ds)) =
736 renderSimpleErrorMessage (OverlappingInstances nm ts (d : ds)) =
683 paras [ line "Overlapping type class instances found for"
737 paras [ line "Overlapping type class instances found for"
738+ , markCodeBox $ indent $ Box.hsep 1 Box.left
684− , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
739+ [ line (showQualified runProperName nm)
685− , Box.vcat Box.left (map typeAtomAsBox ts)
740+ , Box.vcat Box.left (map typeAtomAsBox ts)
687 , line "The following instances were found:"
742 , line "The following instances were found:"
688 , indent $ paras (line (showQualified showIdent d ++ " (chosen)") : map (line . showQualified showIdent) ds)
743 , indent $ paras (line (showQualified showIdent d ++ " (chosen)") : map (line . showQualified showIdent) ds)
689 , line "Overlapping type class instances can lead to different behavior based on the order of module imports, and for that reason are not recommended."
744 , line "Overlapping type class instances can lead to different behavior based on the order of module imports, and for that reason are not recommended."
@@ -697,15 +752,16 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
697 , line "The following additional cases are required to cover all inputs:\n"
752 , line "The following additional cases are required to cover all inputs:\n"
698 , indent $ paras $
753 , indent $ paras $
699 Box.hsep 1 Box.left
754 Box.hsep 1 Box.left
700− (map (paras . map line) (transpose bs))
755+ (map (paras . map (line . markCode)) (transpose bs))
701 : [line "..." | not b]
756 : [line "..." | not b]
702 , line "Alternatively, add a Partial constraint to the type of the enclosing value."
757 , line "Alternatively, add a Partial constraint to the type of the enclosing value."
704 renderSimpleErrorMessage (NoInstanceFound (Constraint nm ts _)) =
759 renderSimpleErrorMessage (NoInstanceFound (Constraint nm ts _)) =
705 paras [ line "No type class instance was found for"
760 paras [ line "No type class instance was found for"
761+ , markCodeBox $ indent $ Box.hsep 1 Box.left
706− , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
762+ [ line (showQualified runProperName nm)
707− , Box.vcat Box.left (map typeAtomAsBox ts)
763+ , Box.vcat Box.left (map typeAtomAsBox ts)
709 , paras [ line "The instance head contains unknown type variables. Consider adding a type annotation."
765 , paras [ line "The instance head contains unknown type variables. Consider adding a type annotation."
710 | any containsUnknowns ts
766 | any containsUnknowns ts
@@ -718,125 +774,128 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
718 go _ = False
774 go _ = False
719 renderSimpleErrorMessage (PossiblyInfiniteInstance nm ts) =
775 renderSimpleErrorMessage (PossiblyInfiniteInstance nm ts) =
720 paras [ line "Type class instance for"
776 paras [ line "Type class instance for"
777+ , markCodeBox $ indent $ Box.hsep 1 Box.left
721− , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
778+ [ line (showQualified runProperName nm)
722− , Box.vcat Box.left (map typeAtomAsBox ts)
779+ , Box.vcat Box.left (map typeAtomAsBox ts)
724 , line "is possibly infinite."
781 , line "is possibly infinite."
726 renderSimpleErrorMessage (CannotDerive nm ts) =
783 renderSimpleErrorMessage (CannotDerive nm ts) =
727 paras [ line "Cannot derive a type class instance for"
784 paras [ line "Cannot derive a type class instance for"
785+ , markCodeBox $ indent $ Box.hsep 1 Box.left
728− , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
786+ [ line (showQualified runProperName nm)
729− , Box.vcat Box.left (map typeAtomAsBox ts)
787+ , Box.vcat Box.left (map typeAtomAsBox ts)
732 renderSimpleErrorMessage (CannotFindDerivingType nm) =
790 renderSimpleErrorMessage (CannotFindDerivingType nm) =
733− line $ "Cannot derive a type class instance, because the type declaration for " ++ runProperName nm ++ " could not be found."
791+ line $ "Cannot derive a type class instance, because the type declaration for " ++ markCode (runProperName nm) ++ " could not be found."
734 renderSimpleErrorMessage (DuplicateLabel l expr) =
792 renderSimpleErrorMessage (DuplicateLabel l expr) =
735− paras $ [ line $ "Label " ++ show l ++ " appears more than once in a row type." ]
793+ paras $ [ line $ "Label " ++ markCode l ++ " appears more than once in a row type." ]
736 <> foldMap (\expr' -> [ line "Relevant expression: "
794 <> foldMap (\expr' -> [ line "Relevant expression: "
737− , indent $ prettyPrintValue valueDepth expr'
795+ , markCodeBox $ indent $ prettyPrintValue valueDepth expr'
739 renderSimpleErrorMessage (DuplicateTypeArgument name) =
797 renderSimpleErrorMessage (DuplicateTypeArgument name) =
740− line $ "Type argument " ++ show name ++ " appears more than once."
798+ line $ "Type argument " ++ markCode name ++ " appears more than once."
741 renderSimpleErrorMessage (DuplicateValueDeclaration nm) =
799 renderSimpleErrorMessage (DuplicateValueDeclaration nm) =
742− line $ "Multiple value declarations exist for " ++ showIdent nm ++ "."
800+ line $ "Multiple value declarations exist for " ++ markCode (showIdent nm) ++ "."
743 renderSimpleErrorMessage (ArgListLengthsDiffer ident) =
801 renderSimpleErrorMessage (ArgListLengthsDiffer ident) =
744− line $ "Argument list lengths differ in declaration " ++ showIdent ident
802+ line $ "Argument list lengths differ in declaration " ++ markCode (showIdent ident)
745 renderSimpleErrorMessage (OverlappingArgNames ident) =
803 renderSimpleErrorMessage (OverlappingArgNames ident) =
746 line $ "Overlapping names in function/binder" ++ foldMap ((" in declaration " ++) . showIdent) ident
804 line $ "Overlapping names in function/binder" ++ foldMap ((" in declaration " ++) . showIdent) ident
747 renderSimpleErrorMessage (MissingClassMember ident) =
805 renderSimpleErrorMessage (MissingClassMember ident) =
748− line $ "Type class member " ++ showIdent ident ++ " has not been implemented."
806+ line $ "Type class member " ++ markCode (showIdent ident) ++ " has not been implemented."
749 renderSimpleErrorMessage (ExtraneousClassMember ident className) =
807 renderSimpleErrorMessage (ExtraneousClassMember ident className) =
750− line $ showIdent ident ++ " is not a member of type class " ++ showQualified runProperName className
808+ line $ "" ++ markCode (showIdent ident) ++ " is not a member of type class " ++ markCode (showQualified runProperName className)
751 renderSimpleErrorMessage (ExpectedType ty kind) =
809 renderSimpleErrorMessage (ExpectedType ty kind) =
752− paras [ line "In a type-annotated expression x :: t, the type t must have kind *."
810+ paras [ line $ "In a type-annotated expression " ++ markCode "x :: t" ++ ", the type " ++ markCode "t" ++ " must have kind " ++ markCode "*" ++ "."
753 , line "The error arises from the type"
811 , line "The error arises from the type"
754− , indent $ typeAsBox ty
812+ , markCodeBox $ indent $ typeAsBox ty
755 , line "having the kind"
813 , line "having the kind"
756− , indent $ line $ prettyPrintKind kind
814+ , indent $ line $ markCode $ prettyPrintKind kind
757 , line "instead."
815 , line "instead."
759 renderSimpleErrorMessage (IncorrectConstructorArity nm) =
817 renderSimpleErrorMessage (IncorrectConstructorArity nm) =
760− line $ "Data constructor " ++ showQualified runProperName nm ++ " was given the wrong number of arguments in a case expression."
818+ line $ "Data constructor " ++ markCode (showQualified runProperName nm) ++ " was given the wrong number of arguments in a case expression."
761 renderSimpleErrorMessage (ExprDoesNotHaveType expr ty) =
819 renderSimpleErrorMessage (ExprDoesNotHaveType expr ty) =
762 paras [ line "Expression"
820 paras [ line "Expression"
763− , indent $ prettyPrintValue valueDepth expr
821+ , markCodeBox $ indent $ prettyPrintValue valueDepth expr
764 , line "does not have type"
822 , line "does not have type"
765− , indent $ typeAsBox ty
823+ , markCodeBox $ indent $ typeAsBox ty
767 renderSimpleErrorMessage (PropertyIsMissing prop) =
825 renderSimpleErrorMessage (PropertyIsMissing prop) =
768− line $ "Type of expression lacks required label " ++ show prop ++ "."
826+ line $ "Type of expression lacks required label " ++ markCode prop ++ "."
769 renderSimpleErrorMessage (AdditionalProperty prop) =
827 renderSimpleErrorMessage (AdditionalProperty prop) =
770− line $ "Type of expression contains additional label " ++ show prop ++ "."
828+ line $ "Type of expression contains additional label " ++ markCode prop ++ "."
771 renderSimpleErrorMessage (CannotApplyFunction fn arg) =
829 renderSimpleErrorMessage (CannotApplyFunction fn arg) =
772 paras [ line "A function of type"
830 paras [ line "A function of type"
773− , indent $ typeAsBox fn
831+ , markCodeBox $ indent $ typeAsBox fn
774 , line "can not be applied to the argument"
832 , line "can not be applied to the argument"
775− , indent $ prettyPrintValue valueDepth arg
833+ , markCodeBox $ indent $ prettyPrintValue valueDepth arg
777 renderSimpleErrorMessage TypeSynonymInstance =
835 renderSimpleErrorMessage TypeSynonymInstance =
778 line "Type class instances for type synonyms are disallowed."
836 line "Type class instances for type synonyms are disallowed."
779 renderSimpleErrorMessage (OrphanInstance nm cnm ts) =
837 renderSimpleErrorMessage (OrphanInstance nm cnm ts) =
780− paras [ line $ "Type class instance " ++ showIdent nm ++ " for "
838+ paras [ line $ "Type class instance " ++ markCode (showIdent nm) ++ " for "
839+ , markCodeBox $ indent $ Box.hsep 1 Box.left
781− , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName cnm)
840+ [ line (showQualified runProperName cnm)
782− , Box.vcat Box.left (map typeAtomAsBox ts)
841+ , Box.vcat Box.left (map typeAtomAsBox ts)
784 , line "is an orphan instance."
843 , line "is an orphan instance."
785 , line "An orphan instance is an instance which is defined in neither the class module nor the data type module."
844 , line "An orphan instance is an instance which is defined in neither the class module nor the data type module."
786 , line "Consider moving the instance, if possible, or using a newtype wrapper."
845 , line "Consider moving the instance, if possible, or using a newtype wrapper."
788 renderSimpleErrorMessage (InvalidNewtype name) =
847 renderSimpleErrorMessage (InvalidNewtype name) =
789− paras [ line $ "Newtype " ++ runProperName name ++ " is invalid."
848+ paras [ line $ "Newtype " ++ markCode (runProperName name) ++ " is invalid."
790 , line "Newtypes must define a single constructor with a single argument."
849 , line "Newtypes must define a single constructor with a single argument."
792 renderSimpleErrorMessage (InvalidInstanceHead ty) =
851 renderSimpleErrorMessage (InvalidInstanceHead ty) =
793 paras [ line "Type class instance head is invalid due to use of type"
852 paras [ line "Type class instance head is invalid due to use of type"
794− , indent $ typeAsBox ty
853+ , markCodeBox $ indent $ typeAsBox ty
795 , line "All types appearing in instance declarations must be of the form T a_1 .. a_n, where each type a_i is of the same form."
854 , line "All types appearing in instance declarations must be of the form T a_1 .. a_n, where each type a_i is of the same form."
797 renderSimpleErrorMessage (TransitiveExportError x ys) =
856 renderSimpleErrorMessage (TransitiveExportError x ys) =
798− paras [ line $ "An export for " ++ prettyPrintExport x ++ " requires the following to also be exported: "
857+ paras [ line $ "An export for " ++ markCode (prettyPrintExport x) ++ " requires the following to also be exported: "
799− , indent $ paras $ map (line . prettyPrintExport) ys
858+ , indent $ paras $ map (line . markCode . prettyPrintExport) ys
801 renderSimpleErrorMessage (TransitiveDctorExportError x ctor) =
860 renderSimpleErrorMessage (TransitiveDctorExportError x ctor) =
802− paras [ line $ "An export for " ++ prettyPrintExport x ++ " requires the following data constructor to also be exported: "
861+ paras [ line $ "An export for " ++ markCode (prettyPrintExport x) ++ " requires the following data constructor to also be exported: "
803− , indent $ line $ runProperName ctor
862+ , indent $ line $ markCode $ runProperName ctor
805 renderSimpleErrorMessage (ShadowedName nm) =
864 renderSimpleErrorMessage (ShadowedName nm) =
806− line $ "Name '" ++ showIdent nm ++ "' was shadowed."
865+ line $ "Name " ++ markCode (showIdent nm) ++ " was shadowed."
807 renderSimpleErrorMessage (ShadowedTypeVar tv) =
866 renderSimpleErrorMessage (ShadowedTypeVar tv) =
808− line $ "Type variable '" ++ tv ++ "' was shadowed."
867+ line $ "Type variable " ++ markCode tv ++ " was shadowed."
809 renderSimpleErrorMessage (UnusedTypeVar tv) =
868 renderSimpleErrorMessage (UnusedTypeVar tv) =
810− line $ "Type variable '" ++ tv ++ "' was declared but not used."
869+ line $ "Type variable " ++ markCode tv ++ " was declared but not used."
811 renderSimpleErrorMessage (MisleadingEmptyTypeImport mn name) =
870 renderSimpleErrorMessage (MisleadingEmptyTypeImport mn name) =
812− line $ "Importing type " ++ runProperName name ++ "(..) from " ++ runModuleName mn ++ " is misleading as it has no exported data constructors."
871+ line $ "Importing type " ++ markCode (runProperName name ++ "(..)") ++ " from " ++ markCode (runModuleName mn) ++ " is misleading as it has no exported data constructors."
813 renderSimpleErrorMessage (ImportHidingModule name) =
872 renderSimpleErrorMessage (ImportHidingModule name) =
814− paras [ line "'hiding' imports cannot be used to hide modules."
873+ paras [ line "hiding imports cannot be used to hide modules."
815− , line $ "An attempt was made to hide the import of " ++ runModuleName name
874+ , line $ "An attempt was made to hide the import of " ++ markCode (runModuleName name)
817 renderSimpleErrorMessage (WildcardInferredType ty) =
876 renderSimpleErrorMessage (WildcardInferredType ty) =
818 paras [ line "Wildcard type definition has the inferred type "
877 paras [ line "Wildcard type definition has the inferred type "
819− , indent $ typeAsBox ty
878+ , markCodeBox $ indent $ typeAsBox ty
821 renderSimpleErrorMessage (HoleInferredType name ty env) =
880 renderSimpleErrorMessage (HoleInferredType name ty env) =
822− paras $ [ line $ "Hole '" ++ name ++ "' has the inferred type "
881+ paras $ [ line $ "Hole '" ++ markCode name ++ "' has the inferred type "
823− , indent $ typeAsBox ty
882+ , markCodeBox $ indent $ typeAsBox ty
824 ] ++ if null env then [] else envInfo
883 ] ++ if null env then [] else envInfo
826 envInfo :: [Box.Box]
885 envInfo :: [Box.Box]
827 envInfo = [ line "in the following context:"
886 envInfo = [ line "in the following context:"
828 , indent $ paras
887 , indent $ paras
829 [ Box.hcat Box.left [ Box.text (showIdent ident <> " :: ")
888 [ Box.hcat Box.left [ Box.text (showIdent ident <> " :: ")
830− , typeAsBox ty'
889+ , markCodeBox $ typeAsBox ty'
832 | (ident, ty') <- take 5 env
891 | (ident, ty') <- take 5 env
835 renderSimpleErrorMessage (MissingTypeDeclaration ident ty) =
894 renderSimpleErrorMessage (MissingTypeDeclaration ident ty) =
836− paras [ line $ "No type declaration was provided for the top-level declaration of " ++ showIdent ident ++ "."
895+ paras [ line $ "No type declaration was provided for the top-level declaration of " ++ markCode (showIdent ident) ++ "."
837 , line "It is good practice to provide type declarations as a form of documentation."
896 , line "It is good practice to provide type declarations as a form of documentation."
838− , line $ "The inferred type of " ++ showIdent ident ++ " was:"
897+ , line $ "The inferred type of " ++ markCode (showIdent ident) ++ " was:"
839− , indent $ typeAsBox ty
898+ , markCodeBox $ indent $ typeAsBox ty
841 renderSimpleErrorMessage (OverlappingPattern bs b) =
900 renderSimpleErrorMessage (OverlappingPattern bs b) =
842 paras $ [ line "A case expression contains unreachable cases:\n"
901 paras $ [ line "A case expression contains unreachable cases:\n"
@@ -848,26 +907,26 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
848 , line "You may want to decompose your data types into smaller types."
907 , line "You may want to decompose your data types into smaller types."
850 renderSimpleErrorMessage (UnusedImport name) =
909 renderSimpleErrorMessage (UnusedImport name) =
851− line $ "The import of module " ++ runModuleName name ++ " is redundant"
910+ line $ "The import of module " ++ markCode (runModuleName name) ++ " is redundant"
853 renderSimpleErrorMessage msg@(UnusedExplicitImport mn names _ _) =
912 renderSimpleErrorMessage msg@(UnusedExplicitImport mn names _ _) =
854− paras [ line $ "The import of module " ++ runModuleName mn ++ " contains the following unused references:"
913+ paras [ line $ "The import of module " ++ markCode (runModuleName mn) ++ " contains the following unused references:"
855 , indent $ paras $ map line names
914 , indent $ paras $ map line names
856 , line "It could be replaced with:"
915 , line "It could be replaced with:"
857− , indent $ line $ showSuggestion msg ]
916+ , indent $ line $ markCode $ showSuggestion msg ]
859 renderSimpleErrorMessage (UnusedDctorImport name) =
918 renderSimpleErrorMessage (UnusedDctorImport name) =
860− line $ "The import of type " ++ runProperName name ++ " includes data constructors but only the type is used"
919+ line $ "The import of type " ++ markCode (runProperName name) ++ " includes data constructors but only the type is used"
862 renderSimpleErrorMessage (UnusedDctorExplicitImport name names) =
921 renderSimpleErrorMessage (UnusedDctorExplicitImport name names) =
863− paras [ line $ "The import of type " ++ runProperName name ++ " includes the following unused data constructors:"
922+ paras [ line $ "The import of type " ++ markCode (runProperName name) ++ " includes the following unused data constructors:"
864− , indent $ paras $ map (line .runProperName) names ]
923+ , indent $ paras $ map (line . markCode . runProperName) names ]
866 renderSimpleErrorMessage (DuplicateSelectiveImport name) =
925 renderSimpleErrorMessage (DuplicateSelectiveImport name) =
867− line $ "There is an existing import of " ++ runModuleName name ++ ", consider merging the import lists"
926+ line $ "There is an existing import of " ++ markCode (runModuleName name) ++ ", consider merging the import lists"
869 renderSimpleErrorMessage (DuplicateImport name imp qual) =
928 renderSimpleErrorMessage (DuplicateImport name imp qual) =
870− line $ "Duplicate import of " ++ prettyPrintImport name imp qual
929+ line $ "Duplicate import of " ++ markCode (prettyPrintImport name imp qual)
872 renderSimpleErrorMessage (DuplicateImportRef name) =
931 renderSimpleErrorMessage (DuplicateImportRef name) =
873 line $ "Import list contains multiple references to " ++ printName (Qualified Nothing name)
932 line $ "Import list contains multiple references to " ++ printName (Qualified Nothing name)
@@ -876,23 +935,23 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
876 line $ "Export list contains multiple references to " ++ printName (Qualified Nothing name)
935 line $ "Export list contains multiple references to " ++ printName (Qualified Nothing name)
878 renderSimpleErrorMessage (IntOutOfRange value backend lo hi) =
937 renderSimpleErrorMessage (IntOutOfRange value backend lo hi) =
879− paras [ line $ "Integer value " ++ show value ++ " is out of range for the " ++ backend ++ " backend."
938+ paras [ line $ "Integer value " ++ markCode (show value) ++ " is out of range for the " ++ backend ++ " backend."
880− , line $ "Acceptable values fall within the range " ++ show lo ++ " to " ++ show hi ++ " (inclusive)." ]
939+ , line $ "Acceptable values fall within the range " ++ markCode (show lo) ++ " to " ++ markCode (show hi) ++ " (inclusive)." ]
882 renderSimpleErrorMessage msg@(ImplicitQualifiedImport importedModule asModule _) =
941 renderSimpleErrorMessage msg@(ImplicitQualifiedImport importedModule asModule _) =
883− paras [ line $ "Module " ++ runModuleName importedModule ++ " was imported as " ++ runModuleName asModule ++ " with unspecified imports."
942+ paras [ line $ "Module " ++ markCode (runModuleName importedModule) ++ " was imported as " ++ markCode (runModuleName asModule) ++ " with unspecified imports."
884− , line $ "As there are multiple modules being imported as " ++ runModuleName asModule ++ ", consider using the explicit form:"
943+ , line $ "As there are multiple modules being imported as " ++ markCode (runModuleName asModule) ++ ", consider using the explicit form:"
885− , indent $ line $ showSuggestion msg
944+ , indent $ line $ markCode $ showSuggestion msg
888 renderSimpleErrorMessage msg@(ImplicitImport mn _) =
947 renderSimpleErrorMessage msg@(ImplicitImport mn _) =
889− paras [ line $ "Module " ++ runModuleName mn ++ " has unspecified imports, consider using the explicit form: "
948+ paras [ line $ "Module " ++ markCode (runModuleName mn) ++ " has unspecified imports, consider using the explicit form: "
890− , indent $ line $ showSuggestion msg
949+ , indent $ line $ markCode $ showSuggestion msg
893 renderSimpleErrorMessage msg@(HidingImport mn _) =
952 renderSimpleErrorMessage msg@(HidingImport mn _) =
894− paras [ line $ "Module " ++ runModuleName mn ++ " has unspecified imports, consider using the inclusive form: "
953+ paras [ line $ "Module " ++ markCode (runModuleName mn) ++ " has unspecified imports, consider using the inclusive form: "
895− , indent $ line $ showSuggestion msg
954+ , indent $ line $ markCode $ showSuggestion msg
898 renderSimpleErrorMessage (CaseBinderLengthDiffers l bs) =
957 renderSimpleErrorMessage (CaseBinderLengthDiffers l bs) =
@@ -905,7 +964,7 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
905 line "An anonymous function argument appears in an invalid context."
964 line "An anonymous function argument appears in an invalid context."
907 renderSimpleErrorMessage (InvalidOperatorInBinder op fn) =
966 renderSimpleErrorMessage (InvalidOperatorInBinder op fn) =
908− paras [ line $ "Operator " ++ showQualified showOp op ++ " cannot be used in a pattern as it is an alias for function " ++ showQualified showIdent fn ++ "."
967+ paras [ line $ "Operator " ++ markCode (showQualified showOp op) ++ " cannot be used in a pattern as it is an alias for function " ++ showQualified showIdent fn ++ "."
909 , line "Only aliases for data constructors may be used in patterns."
968 , line "Only aliases for data constructors may be used in patterns."
@@ -913,9 +972,9 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
913 line "The require-path option is deprecated and will be removed in PureScript 0.9."
972 line "The require-path option is deprecated and will be removed in PureScript 0.9."
915 renderSimpleErrorMessage (CannotGeneralizeRecursiveFunction ident ty) =
974 renderSimpleErrorMessage (CannotGeneralizeRecursiveFunction ident ty) =
916− paras [ line $ "Unable to generalize the type of the recursive function " ++ showIdent ident ++ "."
975+ paras [ line $ "Unable to generalize the type of the recursive function " ++ markCode (showIdent ident) ++ "."
917− , line $ "The inferred type of " ++ showIdent ident ++ " was:"
976+ , line $ "The inferred type of " ++ markCode (showIdent ident) ++ " was:"
918− , indent $ typeAsBox ty
977+ , markCodeBox $ indent $ typeAsBox ty
919 , line "Try adding a type signature."
978 , line "Try adding a type signature."
@@ -923,42 +982,43 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
923 renderHint (ErrorUnifyingTypes t1 t2) detail =
982 renderHint (ErrorUnifyingTypes t1 t2) detail =
924 paras [ detail
983 paras [ detail
925 , Box.hsep 1 Box.top [ line "while trying to match type"
984 , Box.hsep 1 Box.top [ line "while trying to match type"
926− , typeAsBox t1
985+ , markCodeBox $ typeAsBox t1
928 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "with type"
987 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "with type"
929− , typeAsBox t2
988+ , markCodeBox $ typeAsBox t2
932 renderHint (ErrorInExpression expr) detail =
991 renderHint (ErrorInExpression expr) detail =
933 paras [ detail
992 paras [ detail
934 , Box.hsep 1 Box.top [ Box.text "in the expression"
993 , Box.hsep 1 Box.top [ Box.text "in the expression"
935− , prettyPrintValue valueDepth expr
994+ , markCodeBox $ markCodeBox $ prettyPrintValue valueDepth expr
938 renderHint (ErrorInModule mn) detail =
997 renderHint (ErrorInModule mn) detail =
939− paras [ line $ "in module " ++ runModuleName mn
998+ paras [ line $ "in module " ++ markCode (runModuleName mn)
942 renderHint (ErrorInSubsumption t1 t2) detail =
1001 renderHint (ErrorInSubsumption t1 t2) detail =
943 paras [ detail
1002 paras [ detail
944 , Box.hsep 1 Box.top [ line "while checking that type"
1003 , Box.hsep 1 Box.top [ line "while checking that type"
945− , typeAsBox t1
1004+ , markCodeBox $ typeAsBox t1
947 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "is at least as general as type"
1006 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "is at least as general as type"
948− , typeAsBox t2
1007+ , markCodeBox $ typeAsBox t2
951 renderHint (ErrorInInstance nm ts) detail =
1010 renderHint (ErrorInInstance nm ts) detail =
952 paras [ detail
1011 paras [ detail
953− , Box.hsep 1 Box.top [ line "in type class instance"
1012+ , line "in type class instance"
1013+ , markCodeBox $ indent $ Box.hsep 1 Box.top
954− , line (showQualified runProperName nm)
1014+ [ line $ showQualified runProperName nm
955− , Box.vcat Box.left (map typeAtomAsBox ts)
1015+ , Box.vcat Box.left (map typeAtomAsBox ts)
958 renderHint (ErrorCheckingKind ty) detail =
1018 renderHint (ErrorCheckingKind ty) detail =
959 paras [ detail
1019 paras [ detail
960 , Box.hsep 1 Box.top [ line "while checking the kind of"
1020 , Box.hsep 1 Box.top [ line "while checking the kind of"
961− , typeAsBox ty
1021+ , markCodeBox $ typeAsBox ty
964 renderHint ErrorCheckingGuard detail =
1024 renderHint ErrorCheckingGuard detail =
@@ -968,43 +1028,43 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
968 renderHint (ErrorInferringType expr) detail =
1028 renderHint (ErrorInferringType expr) detail =
969 paras [ detail
1029 paras [ detail
970 , Box.hsep 1 Box.top [ line "while inferring the type of"
1030 , Box.hsep 1 Box.top [ line "while inferring the type of"
971− , prettyPrintValue valueDepth expr
1031+ , markCodeBox $ prettyPrintValue valueDepth expr
974 renderHint (ErrorCheckingType expr ty) detail =
1034 renderHint (ErrorCheckingType expr ty) detail =
975 paras [ detail
1035 paras [ detail
976 , Box.hsep 1 Box.top [ line "while checking that expression"
1036 , Box.hsep 1 Box.top [ line "while checking that expression"
977− , prettyPrintValue valueDepth expr
1037+ , markCodeBox $ prettyPrintValue valueDepth expr
979 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "has type"
1039 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "has type"
980− , typeAsBox ty
1040+ , markCodeBox $ typeAsBox ty
983 renderHint (ErrorCheckingAccessor expr prop) detail =
1043 renderHint (ErrorCheckingAccessor expr prop) detail =
984 paras [ detail
1044 paras [ detail
985 , Box.hsep 1 Box.top [ line "while checking type of property accessor"
1045 , Box.hsep 1 Box.top [ line "while checking type of property accessor"
986− , prettyPrintValue valueDepth (Accessor prop expr)
1046+ , markCodeBox $ prettyPrintValue valueDepth (Accessor prop expr)
989 renderHint (ErrorInApplication f t a) detail =
1049 renderHint (ErrorInApplication f t a) detail =
990 paras [ detail
1050 paras [ detail
991 , Box.hsep 1 Box.top [ line "while applying a function"
1051 , Box.hsep 1 Box.top [ line "while applying a function"
992− , prettyPrintValue valueDepth f
1052+ , markCodeBox $ prettyPrintValue valueDepth f
994 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "of type"
1054 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "of type"
995− , typeAsBox t
1055+ , markCodeBox $ typeAsBox t
997 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "to argument"
1057 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "to argument"
998− , prettyPrintValue valueDepth a
1058+ , markCodeBox $ prettyPrintValue valueDepth a
1001 renderHint (ErrorInDataConstructor nm) detail =
1061 renderHint (ErrorInDataConstructor nm) detail =
1002 paras [ detail
1062 paras [ detail
1003− , line $ "in data constructor " ++ runProperName nm
1063+ , line $ "in data constructor " ++ markCode (runProperName nm)
1005 renderHint (ErrorInTypeConstructor nm) detail =
1065 renderHint (ErrorInTypeConstructor nm) detail =
1006 paras [ detail
1066 paras [ detail
1007− , line $ "in type constructor " ++ runProperName nm
1067+ , line $ "in type constructor " ++ markCode (runProperName nm)
1009 renderHint (ErrorInBindingGroup nms) detail =
1069 renderHint (ErrorInBindingGroup nms) detail =
1010 paras [ detail
1070 paras [ detail
@@ -1016,19 +1076,19 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
1017 renderHint (ErrorInTypeSynonym name) detail =
1077 renderHint (ErrorInTypeSynonym name) detail =
1018 paras [ detail
1078 paras [ detail
1019− , line $ "in type synonym " ++ runProperName name
1079+ , line $ "in type synonym " ++ markCode (runProperName name)
1021 renderHint (ErrorInValueDeclaration n) detail =
1081 renderHint (ErrorInValueDeclaration n) detail =
1022 paras [ detail
1082 paras [ detail
1023− , line $ "in value declaration " ++ showIdent n
1083+ , line $ "in value declaration " ++ markCode (showIdent n)
1025 renderHint (ErrorInTypeDeclaration n) detail =
1085 renderHint (ErrorInTypeDeclaration n) detail =
1026 paras [ detail
1086 paras [ detail
1027− , line $ "in type declaration for " ++ showIdent n
1087+ , line $ "in type declaration for " ++ markCode (showIdent n)
1029 renderHint (ErrorInForeignImport nm) detail =
1089 renderHint (ErrorInForeignImport nm) detail =
1030 paras [ detail
1090 paras [ detail
1031− , line $ "in foreign import " ++ showIdent nm
1091+ , line $ "in foreign import " ++ markCode (showIdent nm)
1033 renderHint (PositionedError srcSpan) detail =
1093 renderHint (PositionedError srcSpan) detail =
1034 paras [ line $ "at " ++ displaySourceSpan srcSpan
1094 paras [ line $ "at " ++ displaySourceSpan srcSpan
@@ -1037,19 +1097,19 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
1038 printName :: Qualified Name -> String
1098 printName :: Qualified Name -> String
1039 printName (Qualified mn (IdentName name)) =
1099 printName (Qualified mn (IdentName name)) =
1040− "value " ++ showQualified showIdent (Qualified mn name)
1100+ "value " ++ markCode (showQualified showIdent (Qualified mn name))
1041 printName (Qualified mn (ValOpName op)) =
1101 printName (Qualified mn (ValOpName op)) =
1042− "operator " ++ showQualified showOp (Qualified mn op)
1102+ "operator " ++ markCode (showQualified showOp (Qualified mn op))
1043 printName (Qualified mn (TyName name)) =
1103 printName (Qualified mn (TyName name)) =
1044− "type " ++ showQualified runProperName (Qualified mn name)
1104+ "type " ++ markCode (showQualified runProperName (Qualified mn name))
1045 printName (Qualified mn (TyOpName op)) =
1105 printName (Qualified mn (TyOpName op)) =
1046− "type operator " ++ showQualified showOp (Qualified mn op)
1106+ "type operator " ++ markCode (showQualified showOp (Qualified mn op))
1047 printName (Qualified mn (DctorName name)) =
1107 printName (Qualified mn (DctorName name)) =
1048− "data constructor " ++ showQualified runProperName (Qualified mn name)
1108+ "data constructor " ++ markCode (showQualified runProperName (Qualified mn name))
1049 printName (Qualified mn (TyClassName name)) =
1109 printName (Qualified mn (TyClassName name)) =
1050− "type class " ++ showQualified runProperName (Qualified mn name)
1110+ "type class " ++ markCode (showQualified runProperName (Qualified mn name))
1051 printName (Qualified Nothing (ModName name)) =
1111 printName (Qualified Nothing (ModName name)) =
1052− "module " ++ runModuleName name
1112+ "module " ++ markCode (runModuleName name)
1053 printName (Qualified _ ModName{}) =
1113 printName (Qualified _ ModName{}) =
1054 internalError "qualified ModName in printName"
1114 internalError "qualified ModName in printName"
@@ -1144,32 +1204,32 @@ prettyPrintRef (PositionedDeclarationRef _ _ ref) = prettyPrintExport ref
1145-- Pretty print multiple errors
1205-- Pretty print multiple errors
1147−prettyPrintMultipleErrors :: Bool -> MultipleErrors -> String
1207+prettyPrintMultipleErrors :: PPEOptions -> MultipleErrors -> String
1148−prettyPrintMultipleErrors full = unlines . map renderBox . prettyPrintMultipleErrorsBox full
1208+prettyPrintMultipleErrors ppeOptions = unlines . map renderBox . prettyPrintMultipleErrorsBox ppeOptions
1151-- Pretty print multiple warnings
1211-- Pretty print multiple warnings
1153−prettyPrintMultipleWarnings :: Bool -> MultipleErrors -> String
1213+prettyPrintMultipleWarnings :: PPEOptions -> MultipleErrors -> String
1154−prettyPrintMultipleWarnings full = unlines . map renderBox . prettyPrintMultipleWarningsBox full
1214+prettyPrintMultipleWarnings ppeOptions = unlines . map renderBox . prettyPrintMultipleWarningsBox ppeOptions
1156-- | Pretty print warnings as a Box
1216-- | Pretty print warnings as a Box
1157−prettyPrintMultipleWarningsBox :: Bool -> MultipleErrors -> [Box.Box]
1217+prettyPrintMultipleWarningsBox :: PPEOptions -> MultipleErrors -> [Box.Box]
1158−prettyPrintMultipleWarningsBox = prettyPrintMultipleErrorsWith Warning "Warning found:" "Warning"
1218+prettyPrintMultipleWarningsBox ppeOptions = prettyPrintMultipleErrorsWith (ppeOptions { ppeLevel = Warning }) "Warning found:" "Warning"
1160-- | Pretty print errors as a Box
1220-- | Pretty print errors as a Box
1161−prettyPrintMultipleErrorsBox :: Bool -> MultipleErrors -> [Box.Box]
1221+prettyPrintMultipleErrorsBox :: PPEOptions -> MultipleErrors -> [Box.Box]
1162−prettyPrintMultipleErrorsBox = prettyPrintMultipleErrorsWith Error "Error found:" "Error"
1222+prettyPrintMultipleErrorsBox ppeOptions = prettyPrintMultipleErrorsWith (ppeOptions { ppeLevel = Error }) "Error found:" "Error"
1164−prettyPrintMultipleErrorsWith :: Level -> String -> String -> Bool -> MultipleErrors -> [Box.Box]
1224+prettyPrintMultipleErrorsWith :: PPEOptions -> String -> String -> MultipleErrors -> [Box.Box]
1165−prettyPrintMultipleErrorsWith level intro _ full (MultipleErrors [e]) =
1225+prettyPrintMultipleErrorsWith ppeOptions intro _ (MultipleErrors [e]) =
1166− let result = prettyPrintSingleError full level True e
1226+ let result = prettyPrintSingleError ppeOptions e
1167 in [ Box.vcat Box.left [ Box.text intro
1227 in [ Box.vcat Box.left [ Box.text intro
1168 , result
1228 , result
1171−prettyPrintMultipleErrorsWith level _ intro full (MultipleErrors es) =
1231+prettyPrintMultipleErrorsWith ppeOptions _ intro (MultipleErrors es) =
1172− let result = map (prettyPrintSingleError full level True) es
1232+ let result = map (prettyPrintSingleError ppeOptions) es
1173 in concat $ zipWith withIntro [1 :: Int ..] result
1233 in concat $ zipWith withIntro [1 :: Int ..] result
1175 withIntro i err = [ Box.text (intro ++ " " ++ show i ++ " of " ++ show (length es) ++ ":")
1235 withIntro i err = [ Box.text (intro ++ " " ++ show i ++ " of " ++ show (length es) ++ ":")