@@ -26,9 +26,12 @@ import Language.PureScript.Names
2626import Language.PureScript.Pretty
2727import Language.PureScript.Traversals
2828import Language.PureScript.Types
29+import Language.PureScript.Pretty.Common (endWith)
2930import qualified Language.PureScript.Bundle as Bundle
3031import qualified Language.PureScript.Constants as C
3132
33+import qualified System.Console.ANSI as ANSI
34+
3235import qualified Text.Parsec as P
3336import qualified Text.Parsec.Error as PE
3437import qualified Text.PrettyPrint.Boxes as Box
@@ -457,15 +460,65 @@ showSuggestion suggestion = case errorSuggestion suggestion of
457460 Just (ErrorSuggestion x) -> x
458461 _ -> ""
459462
463+ansiColor :: (ANSI.ColorIntensity, ANSI.Color) -> String
464+ansiColor (intesity, color) =
465+ ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground intesity color]
466+
467+ansiColorReset :: String
468+ansiColorReset =
469+ ANSI.setSGRCode [ANSI.Reset]
470+
471+colorCode :: Maybe (ANSI.ColorIntensity, ANSI.Color) -> String -> String
472+colorCode codeColor code = case codeColor of
473+ Nothing -> code
474+ Just cc -> concat [ansiColor cc, code, ansiColorReset]
475+
476+colorCodeBox :: Maybe (ANSI.ColorIntensity, ANSI.Color) -> Box.Box -> Box.Box
477+colorCodeBox codeColor b = case codeColor of
478+ Nothing -> b
479+ Just cc
480+ | Box.rows b == 1 ->
481+ Box.text (ansiColor cc) Box.<> b `endWith` Box.text ansiColorReset
482+
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
485+ , b
486+ , Box.vcat Box.top $ replicate (Box.rows b) $ Box.text ansiColorReset
487+ ]
488+
489+
490+-- | Default color intesity and color for code
491+defaultCodeColor :: (ANSI.ColorIntensity, ANSI.Color)
492+defaultCodeColor = (ANSI.Dull, ANSI.Yellow)
493+
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?
500+ }
501+
502+-- | Default options for PPEOptions
503+defaultPPEOptions :: PPEOptions
504+defaultPPEOptions = PPEOptions
505+ { ppeCodeColor = Just defaultCodeColor
506+ , ppeFull = False
507+ , ppeLevel = Error
508+ , ppeShowWiki = True
509+ }
510+
511+
460512-- |
461513-- Pretty print a single error, simplifying if necessary
462514--
463−prettyPrintSingleError :: Bool -> Level -> Bool -> ErrorMessage -> Box.Box
464−prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap $ do
515+prettyPrintSingleError :: PPEOptions -> ErrorMessage -> Box.Box
516+prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalState defaultUnknownMap $ do
465517 em <- onTypesInErrorMessageM replaceUnknowns (if full then e else simplifyErrorMessage e)
466518 um <- get
467519 return (prettyPrintErrorMessage um em)
468520 where
521+ (markCode, markCodeBox) = (colorCode &&& colorCodeBox) codeColor
469522
470523 -- Pretty print an ErrorMessage
471524 prettyPrintErrorMessage :: TypeMap -> ErrorMessage -> Box.Box
@@ -474,9 +527,10 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
474527 [ foldr renderHint (indent (renderSimpleErrorMessage simple)) hints
475528 ] ++
476529 maybe [] (return . Box.moveDown 1) typeInformation ++
477− [ Box.moveDown 1 $ paras [ line $ "See " ++ wikiUri e ++ " for more information, "
478− , line $ "or to contribute content related to this " ++ levelText ++ "."
479− ]
530+ [ Box.moveDown 1 $ paras
531+ [ line $ "See " ++ wikiUri e ++ " for more information, "
532+ , line $ "or to contribute content related to this " ++ levelText ++ "."
533+ ]
480534 | showWiki
481535 ]
482536 where
@@ -491,11 +545,11 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
491545 skolemInfo :: (String, Int, Maybe SourceSpan) -> Box.Box
492546 skolemInfo (name, s, ss) =
493547 paras $
494− line (name ++ show s ++ " is a rigid type variable")
548+ line (markCode (name ++ show s) ++ " is a rigid type variable")
495549 : foldMap (return . line . (" bound at " ++) . displayStartEndPos) ss
496550
497551 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"
499553
500554 renderSimpleErrorMessage :: SimpleErrorMessage -> Box.Box
501555 renderSimpleErrorMessage (CannotGetFileInfo path) =
@@ -520,29 +574,29 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
520574 , prettyPrintParseError err
521575 ]
522576 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."
524578 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) ++ ": "
526580 , 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."
528582 ]
529583 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) ++ ": "
531585 , indent . paras $ map (line . runIdent) idents
532586 ]
533587 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: "
535589 , indent . paras $ map (line . runIdent) idents
536590 ]
537591 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) ++ ":"
539593 , indent . paras $
540− [ line $ "The identifier `" ++ ident ++ "` is not valid in PureScript."
594+ [ line $ "The identifier " ++ markCode ident ++ " is not valid in PureScript."
541595 , line "Note that exported identifiers in FFI modules must be valid PureScript identifiers."
542596 ]
543597 ]
544598 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) ++ ": "
546600 , indent . paras $ map line paths
547601 ]
548602 renderSimpleErrorMessage InvalidDoBind =
@@ -553,94 +607,94 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
553607 line "The same name was used more than once in a let binding."
554608 renderSimpleErrorMessage (InfiniteType ty) =
555609 paras [ line "An infinite type was inferred for an expression: "
556− , indent $ typeAsBox ty
610+ , markCodeBox $ indent $ typeAsBox ty
557611 ]
558612 renderSimpleErrorMessage (InfiniteKind ki) =
559613 paras [ line "An infinite kind was inferred for a type: "
560− , indent $ line $ prettyPrintKind ki
614+ , indent $ line $ markCode $ prettyPrintKind ki
561615 ]
562616 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)
564618 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)
566620 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."
568622 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:")
570624 , indent . paras $ map (line . displaySourceSpan) filenames
571625 ]
572626 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"
574628 renderSimpleErrorMessage (UnknownName name) =
575629 line $ "Unknown " ++ printName name
576630 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)
578632 , line "It either does not exist or the module does not export it."
579633 ]
580634 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)
582636 renderSimpleErrorMessage (UnknownExport name) =
583637 line $ "Cannot export unknown " ++ printName (Qualified Nothing name)
584638 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."
586640 renderSimpleErrorMessage (ScopeConflict nm ms) =
587641 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
589643 ]
590644 renderSimpleErrorMessage (ScopeShadowing nm exmn ms) =
591645 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
593647 , 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."
595649 Nothing -> "local declaration will be used."
596650 ]
597651 renderSimpleErrorMessage (ConflictingTypeDecls nm) =
598− line $ "Conflicting type declarations for " ++ runProperName nm
652+ line $ "Conflicting type declarations for " ++ markCode (runProperName nm)
599653 renderSimpleErrorMessage (ConflictingCtorDecls nm) =
600− line $ "Conflicting data constructor declarations for " ++ runProperName nm
654+ line $ "Conflicting data constructor declarations for " ++ markCode (runProperName nm)
601655 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."
603657 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."
605659 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."
607661 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."
609663 renderSimpleErrorMessage (DuplicateModuleName mn) =
610− line $ "Module " ++ runModuleName mn ++ " has been defined multiple times."
664+ line $ "Module " ++ markCode (runModuleName mn) ++ " has been defined multiple times."
611665 renderSimpleErrorMessage (DuplicateClassExport nm) =
612− line $ "Duplicate export declaration for type class " ++ runProperName nm
666+ line $ "Duplicate export declaration for type class " ++ markCode (runProperName nm)
613667 renderSimpleErrorMessage (DuplicateValueExport nm) =
614− line $ "Duplicate export declaration for value " ++ showIdent nm
668+ line $ "Duplicate export declaration for value " ++ markCode (showIdent nm)
615669 renderSimpleErrorMessage (DuplicateValueOpExport op) =
616− line $ "Duplicate export declaration for operator " ++ showOp op
670+ line $ "Duplicate export declaration for operator " ++ markCode (showOp op)
617671 renderSimpleErrorMessage (DuplicateTypeOpExport op) =
618− line $ "Duplicate export declaration for type operator " ++ showOp op
672+ line $ "Duplicate export declaration for type operator " ++ markCode (showOp op)
619673 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."
621675 renderSimpleErrorMessage (CycleInModules mns) =
622676 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)
624678 ]
625679 renderSimpleErrorMessage (CycleInTypeSynonym name) =
626680 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)
628682 Nothing -> "A cycle appears in a set of type synonym definitions."
629683 , line "Cycles are disallowed because they can lead to loops in the type checker."
630684 , line "Consider using a 'newtype' instead."
631685 ]
632686 renderSimpleErrorMessage (NameIsUndefined ident) =
633− line $ "Value " ++ showIdent ident ++ " is undefined."
687+ line $ "Value " ++ markCode (showIdent ident) ++ " is undefined."
634688 renderSimpleErrorMessage (UndefinedTypeVariable name) =
635− line $ "Type variable " ++ runProperName name ++ " is undefined."
689+ line $ "Type variable " ++ markCode (runProperName name) ++ " is undefined."
636690 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."
638692 , line "Type synonyms must be applied to all of their type arguments."
639693 ]
640694 renderSimpleErrorMessage (EscapedSkolem binding) =
641695 paras $ [ line "A type variable has escaped its scope." ]
642696 <> foldMap (\expr -> [ line "Relevant expression: "
643− , indent $ prettyPrintValue valueDepth expr
697+ , markCodeBox $ indent $ prettyPrintValue valueDepth expr
644698 ]) binding
645699 renderSimpleErrorMessage (TypesDoNotUnify u1 u2)
646700 = let (sorted1, sorted2) = sortRows u1 u2
@@ -662,28 +716,29 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
662716 , rowFromList (sortBy (comparing fst) sd2 ++ map (fst &&& snd . snd) common, r2)
663717 )
664718 in paras [ line "Could not match type"
665− , indent $ typeAsBox sorted1
719+ , markCodeBox $ indent $ typeAsBox sorted1
666720 , line "with type"
667− , indent $ typeAsBox sorted2
721+ , markCodeBox $ indent $ typeAsBox sorted2
668722 ]
669723
670724 renderSimpleErrorMessage (KindsDoNotUnify k1 k2) =
671725 paras [ line "Could not match kind"
672− , indent $ line $ prettyPrintKind k1
726+ , indent $ line $ markCode $ prettyPrintKind k1
673727 , line "with kind"
674− , indent $ line $ prettyPrintKind k2
728+ , indent $ line $ markCode $ prettyPrintKind k2
675729 ]
676730 renderSimpleErrorMessage (ConstrainedTypeUnified t1 t2) =
677731 paras [ line "Could not match constrained type"
678− , indent $ typeAsBox t1
732+ , markCodeBox $ indent $ typeAsBox t1
679733 , line "with type"
680− , indent $ typeAsBox t2
734+ , markCodeBox $ indent $ typeAsBox t2
681735 ]
682736 renderSimpleErrorMessage (OverlappingInstances nm ts (d : ds)) =
683737 paras [ line "Overlapping type class instances found for"
684− , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
685− , Box.vcat Box.left (map typeAtomAsBox ts)
686− ]
738+ , markCodeBox $ indent $ Box.hsep 1 Box.left
739+ [ line (showQualified runProperName nm)
740+ , Box.vcat Box.left (map typeAtomAsBox ts)
741+ ]
687742 , line "The following instances were found:"
688743 , indent $ paras (line (showQualified showIdent d ++ " (chosen)") : map (line . showQualified showIdent) ds)
689744 , 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
697752 , line "The following additional cases are required to cover all inputs:\n"
698753 , indent $ paras $
699754 Box.hsep 1 Box.left
700− (map (paras . map line) (transpose bs))
755+ (map (paras . map (line . markCode)) (transpose bs))
701756 : [line "..." | not b]
702757 , line "Alternatively, add a Partial constraint to the type of the enclosing value."
703758 ]
704759 renderSimpleErrorMessage (NoInstanceFound (Constraint nm ts _)) =
705760 paras [ line "No type class instance was found for"
706− , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
707− , Box.vcat Box.left (map typeAtomAsBox ts)
708− ]
761+ , markCodeBox $ indent $ Box.hsep 1 Box.left
762+ [ line (showQualified runProperName nm)
763+ , Box.vcat Box.left (map typeAtomAsBox ts)
764+ ]
709765 , paras [ line "The instance head contains unknown type variables. Consider adding a type annotation."
710766 | any containsUnknowns ts
711767 ]
@@ -718,125 +774,128 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
718774 go _ = False
719775 renderSimpleErrorMessage (PossiblyInfiniteInstance nm ts) =
720776 paras [ line "Type class instance for"
721− , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
722− , Box.vcat Box.left (map typeAtomAsBox ts)
723− ]
777+ , markCodeBox $ indent $ Box.hsep 1 Box.left
778+ [ line (showQualified runProperName nm)
779+ , Box.vcat Box.left (map typeAtomAsBox ts)
780+ ]
724781 , line "is possibly infinite."
725782 ]
726783 renderSimpleErrorMessage (CannotDerive nm ts) =
727784 paras [ line "Cannot derive a type class instance for"
728− , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
729− , Box.vcat Box.left (map typeAtomAsBox ts)
730− ]
785+ , markCodeBox $ indent $ Box.hsep 1 Box.left
786+ [ line (showQualified runProperName nm)
787+ , Box.vcat Box.left (map typeAtomAsBox ts)
788+ ]
731789 ]
732790 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."
734792 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." ]
736794 <> foldMap (\expr' -> [ line "Relevant expression: "
737− , indent $ prettyPrintValue valueDepth expr'
795+ , markCodeBox $ indent $ prettyPrintValue valueDepth expr'
738796 ]) expr
739797 renderSimpleErrorMessage (DuplicateTypeArgument name) =
740− line $ "Type argument " ++ show name ++ " appears more than once."
798+ line $ "Type argument " ++ markCode name ++ " appears more than once."
741799 renderSimpleErrorMessage (DuplicateValueDeclaration nm) =
742− line $ "Multiple value declarations exist for " ++ showIdent nm ++ "."
800+ line $ "Multiple value declarations exist for " ++ markCode (showIdent nm) ++ "."
743801 renderSimpleErrorMessage (ArgListLengthsDiffer ident) =
744− line $ "Argument list lengths differ in declaration " ++ showIdent ident
802+ line $ "Argument list lengths differ in declaration " ++ markCode (showIdent ident)
745803 renderSimpleErrorMessage (OverlappingArgNames ident) =
746804 line $ "Overlapping names in function/binder" ++ foldMap ((" in declaration " ++) . showIdent) ident
747805 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."
749807 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)
751809 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 "*" ++ "."
753811 , line "The error arises from the type"
754− , indent $ typeAsBox ty
812+ , markCodeBox $ indent $ typeAsBox ty
755813 , line "having the kind"
756− , indent $ line $ prettyPrintKind kind
814+ , indent $ line $ markCode $ prettyPrintKind kind
757815 , line "instead."
758816 ]
759817 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."
761819 renderSimpleErrorMessage (ExprDoesNotHaveType expr ty) =
762820 paras [ line "Expression"
763− , indent $ prettyPrintValue valueDepth expr
821+ , markCodeBox $ indent $ prettyPrintValue valueDepth expr
764822 , line "does not have type"
765− , indent $ typeAsBox ty
823+ , markCodeBox $ indent $ typeAsBox ty
766824 ]
767825 renderSimpleErrorMessage (PropertyIsMissing prop) =
768− line $ "Type of expression lacks required label " ++ show prop ++ "."
826+ line $ "Type of expression lacks required label " ++ markCode prop ++ "."
769827 renderSimpleErrorMessage (AdditionalProperty prop) =
770− line $ "Type of expression contains additional label " ++ show prop ++ "."
828+ line $ "Type of expression contains additional label " ++ markCode prop ++ "."
771829 renderSimpleErrorMessage (CannotApplyFunction fn arg) =
772830 paras [ line "A function of type"
773− , indent $ typeAsBox fn
831+ , markCodeBox $ indent $ typeAsBox fn
774832 , line "can not be applied to the argument"
775− , indent $ prettyPrintValue valueDepth arg
833+ , markCodeBox $ indent $ prettyPrintValue valueDepth arg
776834 ]
777835 renderSimpleErrorMessage TypeSynonymInstance =
778836 line "Type class instances for type synonyms are disallowed."
779837 renderSimpleErrorMessage (OrphanInstance nm cnm ts) =
780− paras [ line $ "Type class instance " ++ showIdent nm ++ " for "
781− , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName cnm)
782− , Box.vcat Box.left (map typeAtomAsBox ts)
783− ]
838+ paras [ line $ "Type class instance " ++ markCode (showIdent nm) ++ " for "
839+ , markCodeBox $ indent $ Box.hsep 1 Box.left
840+ [ line (showQualified runProperName cnm)
841+ , Box.vcat Box.left (map typeAtomAsBox ts)
842+ ]
784843 , line "is an orphan instance."
785844 , line "An orphan instance is an instance which is defined in neither the class module nor the data type module."
786845 , line "Consider moving the instance, if possible, or using a newtype wrapper."
787846 ]
788847 renderSimpleErrorMessage (InvalidNewtype name) =
789− paras [ line $ "Newtype " ++ runProperName name ++ " is invalid."
848+ paras [ line $ "Newtype " ++ markCode (runProperName name) ++ " is invalid."
790849 , line "Newtypes must define a single constructor with a single argument."
791850 ]
792851 renderSimpleErrorMessage (InvalidInstanceHead ty) =
793852 paras [ line "Type class instance head is invalid due to use of type"
794− , indent $ typeAsBox ty
853+ , markCodeBox $ indent $ typeAsBox ty
795854 , 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."
796855 ]
797856 renderSimpleErrorMessage (TransitiveExportError x ys) =
798− paras [ line $ "An export for " ++ prettyPrintExport x ++ " requires the following to also be exported: "
799− , indent $ paras $ map (line . prettyPrintExport) ys
857+ paras [ line $ "An export for " ++ markCode (prettyPrintExport x) ++ " requires the following to also be exported: "
858+ , indent $ paras $ map (line . markCode . prettyPrintExport) ys
800859 ]
801860 renderSimpleErrorMessage (TransitiveDctorExportError x ctor) =
802− paras [ line $ "An export for " ++ prettyPrintExport x ++ " requires the following data constructor to also be exported: "
803− , indent $ line $ runProperName ctor
861+ paras [ line $ "An export for " ++ markCode (prettyPrintExport x) ++ " requires the following data constructor to also be exported: "
862+ , indent $ line $ markCode $ runProperName ctor
804863 ]
805864 renderSimpleErrorMessage (ShadowedName nm) =
806− line $ "Name '" ++ showIdent nm ++ "' was shadowed."
865+ line $ "Name " ++ markCode (showIdent nm) ++ " was shadowed."
807866 renderSimpleErrorMessage (ShadowedTypeVar tv) =
808− line $ "Type variable '" ++ tv ++ "' was shadowed."
867+ line $ "Type variable " ++ markCode tv ++ " was shadowed."
809868 renderSimpleErrorMessage (UnusedTypeVar tv) =
810− line $ "Type variable '" ++ tv ++ "' was declared but not used."
869+ line $ "Type variable " ++ markCode tv ++ " was declared but not used."
811870 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."
813872 renderSimpleErrorMessage (ImportHidingModule name) =
814− paras [ line "'hiding' imports cannot be used to hide modules."
815− , line $ "An attempt was made to hide the import of " ++ runModuleName name
873+ paras [ line "hiding imports cannot be used to hide modules."
874+ , line $ "An attempt was made to hide the import of " ++ markCode (runModuleName name)
816875 ]
817876 renderSimpleErrorMessage (WildcardInferredType ty) =
818877 paras [ line "Wildcard type definition has the inferred type "
819− , indent $ typeAsBox ty
878+ , markCodeBox $ indent $ typeAsBox ty
820879 ]
821880 renderSimpleErrorMessage (HoleInferredType name ty env) =
822− paras $ [ line $ "Hole '" ++ name ++ "' has the inferred type "
823− , indent $ typeAsBox ty
881+ paras $ [ line $ "Hole '" ++ markCode name ++ "' has the inferred type "
882+ , markCodeBox $ indent $ typeAsBox ty
824883 ] ++ if null env then [] else envInfo
825884 where
826885 envInfo :: [Box.Box]
827886 envInfo = [ line "in the following context:"
828887 , indent $ paras
829888 [ Box.hcat Box.left [ Box.text (showIdent ident <> " :: ")
830− , typeAsBox ty'
889+ , markCodeBox $ typeAsBox ty'
831890 ]
832891 | (ident, ty') <- take 5 env
833892 ]
834893 ]
835894 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) ++ "."
837896 , line "It is good practice to provide type declarations as a form of documentation."
838− , line $ "The inferred type of " ++ showIdent ident ++ " was:"
839− , indent $ typeAsBox ty
897+ , line $ "The inferred type of " ++ markCode (showIdent ident) ++ " was:"
898+ , markCodeBox $ indent $ typeAsBox ty
840899 ]
841900 renderSimpleErrorMessage (OverlappingPattern bs b) =
842901 paras $ [ line "A case expression contains unreachable cases:\n"
@@ -848,26 +907,26 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
848907 , line "You may want to decompose your data types into smaller types."
849908 ]
850909 renderSimpleErrorMessage (UnusedImport name) =
851− line $ "The import of module " ++ runModuleName name ++ " is redundant"
910+ line $ "The import of module " ++ markCode (runModuleName name) ++ " is redundant"
852911
853912 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:"
855914 , indent $ paras $ map line names
856915 , line "It could be replaced with:"
857− , indent $ line $ showSuggestion msg ]
916+ , indent $ line $ markCode $ showSuggestion msg ]
858917
859918 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"
861920
862921 renderSimpleErrorMessage (UnusedDctorExplicitImport name names) =
863− paras [ line $ "The import of type " ++ runProperName name ++ " includes the following unused data constructors:"
864− , indent $ paras $ map (line .runProperName) names ]
922+ paras [ line $ "The import of type " ++ markCode (runProperName name) ++ " includes the following unused data constructors:"
923+ , indent $ paras $ map (line . markCode . runProperName) names ]
865924
866925 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"
868927
869928 renderSimpleErrorMessage (DuplicateImport name imp qual) =
870− line $ "Duplicate import of " ++ prettyPrintImport name imp qual
929+ line $ "Duplicate import of " ++ markCode (prettyPrintImport name imp qual)
871930
872931 renderSimpleErrorMessage (DuplicateImportRef name) =
873932 line $ "Import list contains multiple references to " ++ printName (Qualified Nothing name)
@@ -876,23 +935,23 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
876935 line $ "Export list contains multiple references to " ++ printName (Qualified Nothing name)
877936
878937 renderSimpleErrorMessage (IntOutOfRange value backend lo hi) =
879− paras [ line $ "Integer value " ++ show value ++ " is out of range for the " ++ backend ++ " backend."
880− , line $ "Acceptable values fall within the range " ++ show lo ++ " to " ++ show hi ++ " (inclusive)." ]
938+ paras [ line $ "Integer value " ++ markCode (show value) ++ " is out of range for the " ++ backend ++ " backend."
939+ , line $ "Acceptable values fall within the range " ++ markCode (show lo) ++ " to " ++ markCode (show hi) ++ " (inclusive)." ]
881940
882941 renderSimpleErrorMessage msg@(ImplicitQualifiedImport importedModule asModule _) =
883− paras [ line $ "Module " ++ runModuleName importedModule ++ " was imported as " ++ runModuleName asModule ++ " with unspecified imports."
884− , line $ "As there are multiple modules being imported as " ++ runModuleName asModule ++ ", consider using the explicit form:"
885− , indent $ line $ showSuggestion msg
942+ paras [ line $ "Module " ++ markCode (runModuleName importedModule) ++ " was imported as " ++ markCode (runModuleName asModule) ++ " with unspecified imports."
943+ , line $ "As there are multiple modules being imported as " ++ markCode (runModuleName asModule) ++ ", consider using the explicit form:"
944+ , indent $ line $ markCode $ showSuggestion msg
886945 ]
887946
888947 renderSimpleErrorMessage msg@(ImplicitImport mn _) =
889− paras [ line $ "Module " ++ runModuleName mn ++ " has unspecified imports, consider using the explicit form: "
890− , indent $ line $ showSuggestion msg
948+ paras [ line $ "Module " ++ markCode (runModuleName mn) ++ " has unspecified imports, consider using the explicit form: "
949+ , indent $ line $ markCode $ showSuggestion msg
891950 ]
892951
893952 renderSimpleErrorMessage msg@(HidingImport mn _) =
894− paras [ line $ "Module " ++ runModuleName mn ++ " has unspecified imports, consider using the inclusive form: "
895− , indent $ line $ showSuggestion msg
953+ paras [ line $ "Module " ++ markCode (runModuleName mn) ++ " has unspecified imports, consider using the inclusive form: "
954+ , indent $ line $ markCode $ showSuggestion msg
896955 ]
897956
898957 renderSimpleErrorMessage (CaseBinderLengthDiffers l bs) =
@@ -905,7 +964,7 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
905964 line "An anonymous function argument appears in an invalid context."
906965
907966 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 ++ "."
909968 , line "Only aliases for data constructors may be used in patterns."
910969 ]
911970
@@ -913,9 +972,9 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
913972 line "The require-path option is deprecated and will be removed in PureScript 0.9."
914973
915974 renderSimpleErrorMessage (CannotGeneralizeRecursiveFunction ident ty) =
916− paras [ line $ "Unable to generalize the type of the recursive function " ++ showIdent ident ++ "."
917− , line $ "The inferred type of " ++ showIdent ident ++ " was:"
918− , indent $ typeAsBox ty
975+ paras [ line $ "Unable to generalize the type of the recursive function " ++ markCode (showIdent ident) ++ "."
976+ , line $ "The inferred type of " ++ markCode (showIdent ident) ++ " was:"
977+ , markCodeBox $ indent $ typeAsBox ty
919978 , line "Try adding a type signature."
920979 ]
921980
@@ -923,42 +982,43 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
923982 renderHint (ErrorUnifyingTypes t1 t2) detail =
924983 paras [ detail
925984 , Box.hsep 1 Box.top [ line "while trying to match type"
926− , typeAsBox t1
985+ , markCodeBox $ typeAsBox t1
927986 ]
928987 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "with type"
929− , typeAsBox t2
988+ , markCodeBox $ typeAsBox t2
930989 ]
931990 ]
932991 renderHint (ErrorInExpression expr) detail =
933992 paras [ detail
934993 , Box.hsep 1 Box.top [ Box.text "in the expression"
935− , prettyPrintValue valueDepth expr
994+ , markCodeBox $ markCodeBox $ prettyPrintValue valueDepth expr
936995 ]
937996 ]
938997 renderHint (ErrorInModule mn) detail =
939− paras [ line $ "in module " ++ runModuleName mn
998+ paras [ line $ "in module " ++ markCode (runModuleName mn)
940999 , detail
9411000 ]
9421001 renderHint (ErrorInSubsumption t1 t2) detail =
9431002 paras [ detail
9441003 , Box.hsep 1 Box.top [ line "while checking that type"
945− , typeAsBox t1
1004+ , markCodeBox $ typeAsBox t1
9461005 ]
9471006 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "is at least as general as type"
948− , typeAsBox t2
1007+ , markCodeBox $ typeAsBox t2
9491008 ]
9501009 ]
9511010 renderHint (ErrorInInstance nm ts) detail =
9521011 paras [ detail
953− , Box.hsep 1 Box.top [ line "in type class instance"
954− , line (showQualified runProperName nm)
955− , Box.vcat Box.left (map typeAtomAsBox ts)
956− ]
1012+ , line "in type class instance"
1013+ , markCodeBox $ indent $ Box.hsep 1 Box.top
1014+ [ line $ showQualified runProperName nm
1015+ , Box.vcat Box.left (map typeAtomAsBox ts)
1016+ ]
9571017 ]
9581018 renderHint (ErrorCheckingKind ty) detail =
9591019 paras [ detail
9601020 , Box.hsep 1 Box.top [ line "while checking the kind of"
961− , typeAsBox ty
1021+ , markCodeBox $ typeAsBox ty
9621022 ]
9631023 ]
9641024 renderHint ErrorCheckingGuard detail =
@@ -968,43 +1028,43 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
9681028 renderHint (ErrorInferringType expr) detail =
9691029 paras [ detail
9701030 , Box.hsep 1 Box.top [ line "while inferring the type of"
971− , prettyPrintValue valueDepth expr
1031+ , markCodeBox $ prettyPrintValue valueDepth expr
9721032 ]
9731033 ]
9741034 renderHint (ErrorCheckingType expr ty) detail =
9751035 paras [ detail
9761036 , Box.hsep 1 Box.top [ line "while checking that expression"
977− , prettyPrintValue valueDepth expr
1037+ , markCodeBox $ prettyPrintValue valueDepth expr
9781038 ]
9791039 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "has type"
980− , typeAsBox ty
1040+ , markCodeBox $ typeAsBox ty
9811041 ]
9821042 ]
9831043 renderHint (ErrorCheckingAccessor expr prop) detail =
9841044 paras [ detail
9851045 , 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)
9871047 ]
9881048 ]
9891049 renderHint (ErrorInApplication f t a) detail =
9901050 paras [ detail
9911051 , Box.hsep 1 Box.top [ line "while applying a function"
992− , prettyPrintValue valueDepth f
1052+ , markCodeBox $ prettyPrintValue valueDepth f
9931053 ]
9941054 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "of type"
995− , typeAsBox t
1055+ , markCodeBox $ typeAsBox t
9961056 ]
9971057 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "to argument"
998− , prettyPrintValue valueDepth a
1058+ , markCodeBox $ prettyPrintValue valueDepth a
9991059 ]
10001060 ]
10011061 renderHint (ErrorInDataConstructor nm) detail =
10021062 paras [ detail
1003− , line $ "in data constructor " ++ runProperName nm
1063+ , line $ "in data constructor " ++ markCode (runProperName nm)
10041064 ]
10051065 renderHint (ErrorInTypeConstructor nm) detail =
10061066 paras [ detail
1007− , line $ "in type constructor " ++ runProperName nm
1067+ , line $ "in type constructor " ++ markCode (runProperName nm)
10081068 ]
10091069 renderHint (ErrorInBindingGroup nms) detail =
10101070 paras [ detail
@@ -1016,19 +1076,19 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
10161076 ]
10171077 renderHint (ErrorInTypeSynonym name) detail =
10181078 paras [ detail
1019− , line $ "in type synonym " ++ runProperName name
1079+ , line $ "in type synonym " ++ markCode (runProperName name)
10201080 ]
10211081 renderHint (ErrorInValueDeclaration n) detail =
10221082 paras [ detail
1023− , line $ "in value declaration " ++ showIdent n
1083+ , line $ "in value declaration " ++ markCode (showIdent n)
10241084 ]
10251085 renderHint (ErrorInTypeDeclaration n) detail =
10261086 paras [ detail
1027− , line $ "in type declaration for " ++ showIdent n
1087+ , line $ "in type declaration for " ++ markCode (showIdent n)
10281088 ]
10291089 renderHint (ErrorInForeignImport nm) detail =
10301090 paras [ detail
1031− , line $ "in foreign import " ++ showIdent nm
1091+ , line $ "in foreign import " ++ markCode (showIdent nm)
10321092 ]
10331093 renderHint (PositionedError srcSpan) detail =
10341094 paras [ line $ "at " ++ displaySourceSpan srcSpan
@@ -1037,19 +1097,19 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
10371097
10381098 printName :: Qualified Name -> String
10391099 printName (Qualified mn (IdentName name)) =
1040− "value " ++ showQualified showIdent (Qualified mn name)
1100+ "value " ++ markCode (showQualified showIdent (Qualified mn name))
10411101 printName (Qualified mn (ValOpName op)) =
1042− "operator " ++ showQualified showOp (Qualified mn op)
1102+ "operator " ++ markCode (showQualified showOp (Qualified mn op))
10431103 printName (Qualified mn (TyName name)) =
1044− "type " ++ showQualified runProperName (Qualified mn name)
1104+ "type " ++ markCode (showQualified runProperName (Qualified mn name))
10451105 printName (Qualified mn (TyOpName op)) =
1046− "type operator " ++ showQualified showOp (Qualified mn op)
1106+ "type operator " ++ markCode (showQualified showOp (Qualified mn op))
10471107 printName (Qualified mn (DctorName name)) =
1048− "data constructor " ++ showQualified runProperName (Qualified mn name)
1108+ "data constructor " ++ markCode (showQualified runProperName (Qualified mn name))
10491109 printName (Qualified mn (TyClassName name)) =
1050− "type class " ++ showQualified runProperName (Qualified mn name)
1110+ "type class " ++ markCode (showQualified runProperName (Qualified mn name))
10511111 printName (Qualified Nothing (ModName name)) =
1052− "module " ++ runModuleName name
1112+ "module " ++ markCode (runModuleName name)
10531113 printName (Qualified _ ModName{}) =
10541114 internalError "qualified ModName in printName"
10551115
@@ -1144,32 +1204,32 @@ prettyPrintRef (PositionedDeclarationRef _ _ ref) = prettyPrintExport ref
11441204-- |
11451205-- Pretty print multiple errors
11461206--
1147−prettyPrintMultipleErrors :: Bool -> MultipleErrors -> String
1148−prettyPrintMultipleErrors full = unlines . map renderBox . prettyPrintMultipleErrorsBox full
1207+prettyPrintMultipleErrors :: PPEOptions -> MultipleErrors -> String
1208+prettyPrintMultipleErrors ppeOptions = unlines . map renderBox . prettyPrintMultipleErrorsBox ppeOptions
11491209
11501210-- |
11511211-- Pretty print multiple warnings
11521212--
1153−prettyPrintMultipleWarnings :: Bool -> MultipleErrors -> String
1154−prettyPrintMultipleWarnings full = unlines . map renderBox . prettyPrintMultipleWarningsBox full
1213+prettyPrintMultipleWarnings :: PPEOptions -> MultipleErrors -> String
1214+prettyPrintMultipleWarnings ppeOptions = unlines . map renderBox . prettyPrintMultipleWarningsBox ppeOptions
11551215
11561216-- | Pretty print warnings as a Box
1157−prettyPrintMultipleWarningsBox :: Bool -> MultipleErrors -> [Box.Box]
1158−prettyPrintMultipleWarningsBox = prettyPrintMultipleErrorsWith Warning "Warning found:" "Warning"
1217+prettyPrintMultipleWarningsBox :: PPEOptions -> MultipleErrors -> [Box.Box]
1218+prettyPrintMultipleWarningsBox ppeOptions = prettyPrintMultipleErrorsWith (ppeOptions { ppeLevel = Warning }) "Warning found:" "Warning"
11591219
11601220-- | Pretty print errors as a Box
1161−prettyPrintMultipleErrorsBox :: Bool -> MultipleErrors -> [Box.Box]
1162−prettyPrintMultipleErrorsBox = prettyPrintMultipleErrorsWith Error "Error found:" "Error"
1221+prettyPrintMultipleErrorsBox :: PPEOptions -> MultipleErrors -> [Box.Box]
1222+prettyPrintMultipleErrorsBox ppeOptions = prettyPrintMultipleErrorsWith (ppeOptions { ppeLevel = Error }) "Error found:" "Error"
11631223
1164−prettyPrintMultipleErrorsWith :: Level -> String -> String -> Bool -> MultipleErrors -> [Box.Box]
1165−prettyPrintMultipleErrorsWith level intro _ full (MultipleErrors [e]) =
1166− let result = prettyPrintSingleError full level True e
1224+prettyPrintMultipleErrorsWith :: PPEOptions -> String -> String -> MultipleErrors -> [Box.Box]
1225+prettyPrintMultipleErrorsWith ppeOptions intro _ (MultipleErrors [e]) =
1226+ let result = prettyPrintSingleError ppeOptions e
11671227 in [ Box.vcat Box.left [ Box.text intro
11681228 , result
11691229 ]
11701230 ]
1171−prettyPrintMultipleErrorsWith level _ intro full (MultipleErrors es) =
1172− let result = map (prettyPrintSingleError full level True) es
1231+prettyPrintMultipleErrorsWith ppeOptions _ intro (MultipleErrors es) =
1232+ let result = map (prettyPrintSingleError ppeOptions) es
11731233 in concat $ zipWith withIntro [1 :: Int ..] result
11741234 where
11751235 withIntro i err = [ Box.text (intro ++ " " ++ show i ++ " of " ++ show (length es) ++ ":")