@@ -1,40 +1,40 @@
11{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2−{-# LANGUAGE FlexibleContexts #-}
3−{-# LANGUAGE MultiParamTypeClasses #-}
2+{-# LANGUAGE NamedFieldPuns #-}
43
54module Language.PureScript.Errors where
65
7−import Prelude ()
86import Prelude.Compat
97
10−import Data.Ord (comparing)
8+import Control.Arrow ((&&&))
9+import Control.Monad
10+import Control.Monad.Error.Class (MonadError(..))
11+import Control.Monad.Trans.State.Lazy
12+import Control.Monad.Writer
13+
1114import Data.Char (isSpace)
1215import Data.Either (lefts, rights)
13−import Data.List (intercalate, transpose, nub, nubBy, sortBy, partition)
1416import Data.Foldable (fold)
17+import Data.List (intercalate, transpose, nub, nubBy, sortBy, partition)
1518import Data.Maybe (maybeToList)
16−
19+import Data.Ord (comparing)
1720import qualified Data.Map as M
1821
19−import Control.Monad
20−import Control.Monad.Writer
21−import Control.Monad.Error.Class (MonadError(..))
22−import Control.Monad.Trans.State.Lazy
23−import Control.Arrow ((&&&))
24−
25−import Language.PureScript.Crash
2622import Language.PureScript.AST
23+import Language.PureScript.Crash
24+import Language.PureScript.Kinds
25+import Language.PureScript.Names
2726import Language.PureScript.Pretty
28−import Language.PureScript.Pretty.Common (before)
27+import Language.PureScript.Traversals
2928import Language.PureScript.Types
30−import Language.PureScript.Names
31−import Language.PureScript.Kinds
29+import Language.PureScript.Pretty.Common (endWith)
3230import qualified Language.PureScript.Bundle as Bundle
31+import qualified Language.PureScript.Constants as C
3332
34−import qualified Text.PrettyPrint.Boxes as Box
33+import qualified System.Console.ANSI as ANSI
3534
3635import qualified Text.Parsec as P
3736import qualified Text.Parsec.Error as PE
37+import qualified Text.PrettyPrint.Boxes as Box
3838import Text.Parsec.Error (Message(..))
3939
4040-- | A type of error messages
@@ -52,42 +52,22 @@ data SimpleErrorMessage
5252 | CannotWriteFile FilePath
5353 | InfiniteType Type
5454 | InfiniteKind Kind
55− | MultipleFixities Ident
55+ | MultipleValueOpFixities (OpName 'ValueOpName)
56+ | MultipleTypeOpFixities (OpName 'TypeOpName)
5657 | OrphanTypeDeclaration Ident
57− | OrphanFixityDeclaration String
5858 | RedefinedModule ModuleName [SourceSpan]
5959 | RedefinedIdent Ident
6060 | OverlappingNamesInLet
61− | UnknownModule ModuleName
62− | UnknownType (Qualified (ProperName 'TypeName))
63− | UnknownTypeOp (Qualified Ident)
64− | UnknownTypeClass (Qualified (ProperName 'ClassName))
65− | UnknownValue (Qualified Ident)
66− | UnknownDataConstructor (Qualified (ProperName 'ConstructorName)) (Maybe (Qualified (ProperName 'ConstructorName)))
67− | UnknownTypeConstructor (Qualified (ProperName 'TypeName))
68− | UnknownImportType ModuleName (ProperName 'TypeName)
69− | UnknownExportType (ProperName 'TypeName)
70− | UnknownImportTypeOp ModuleName Ident
71− | UnknownExportTypeOp Ident
72− | UnknownImportTypeClass ModuleName (ProperName 'ClassName)
73− | UnknownExportTypeClass (ProperName 'ClassName)
74− | UnknownImportValue ModuleName Ident
75− | UnknownExportValue Ident
76− | UnknownExportModule ModuleName
61+ | UnknownName (Qualified Name)
62+ | UnknownImport ModuleName Name
7763 | UnknownImportDataConstructor ModuleName (ProperName 'TypeName) (ProperName 'ConstructorName)
64+ | UnknownExport Name
7865 | UnknownExportDataConstructor (ProperName 'TypeName) (ProperName 'ConstructorName)
79− | ScopeConflict String [ModuleName]
80− | ScopeShadowing String (Maybe ModuleName) [ModuleName]
81− | ConflictingTypeDecls (ProperName 'TypeName)
82− | ConflictingCtorDecls (ProperName 'ConstructorName)
83− | TypeConflictsWithClass (ProperName 'TypeName)
84− | CtorConflictsWithClass (ProperName 'ConstructorName)
85− | ClassConflictsWithType (ProperName 'ClassName)
86− | ClassConflictsWithCtor (ProperName 'ClassName)
66+ | ScopeConflict Name [ModuleName]
67+ | ScopeShadowing Name (Maybe ModuleName) [ModuleName]
68+ | DeclConflict Name Name
69+ | ExportConflict (Qualified Name) (Qualified Name)
8770 | DuplicateModuleName ModuleName
88− | DuplicateClassExport (ProperName 'ClassName)
89− | DuplicateValueExport Ident
90− | DuplicateTypeOpExport Ident
9171 | DuplicateTypeArgument String
9272 | InvalidDoBind
9373 | InvalidDoLet
@@ -102,7 +82,7 @@ data SimpleErrorMessage
10282 | KindsDoNotUnify Kind Kind
10383 | ConstrainedTypeUnified Type Type
10484 | OverlappingInstances (Qualified (ProperName 'ClassName)) [Type] [Qualified Ident]
105− | NoInstanceFound (Qualified (ProperName 'ClassName)) [Type]
85+ | NoInstanceFound Constraint
10686 | PossiblyInfiniteInstance (Qualified (ProperName 'ClassName)) [Type]
10787 | CannotDerive (Qualified (ProperName 'ClassName)) [Type]
10888 | CannotFindDerivingType (ProperName 'TypeName)
@@ -128,35 +108,27 @@ data SimpleErrorMessage
128108 | ShadowedTypeVar String
129109 | UnusedTypeVar String
130110 | WildcardInferredType Type
131− | HoleInferredType String Type
111+ | HoleInferredType String Type [(Ident, Type)]
132112 | MissingTypeDeclaration Ident Type
133− | NotExhaustivePattern [[Binder]] Bool
134113 | OverlappingPattern [[Binder]] Bool
135114 | IncompleteExhaustivityCheck
136− | ClassOperator (ProperName 'ClassName) Ident
137115 | MisleadingEmptyTypeImport ModuleName (ProperName 'TypeName)
138116 | ImportHidingModule ModuleName
139117 | UnusedImport ModuleName
140118 | UnusedExplicitImport ModuleName [String] (Maybe ModuleName) [DeclarationRef]
141119 | UnusedDctorImport (ProperName 'TypeName)
142120 | UnusedDctorExplicitImport (ProperName 'TypeName) [ProperName 'ConstructorName]
143− | DeprecatedOperatorDecl String
144− | DeprecatedOperatorSection Expr (Either Expr Expr)
145− | DeprecatedQualifiedSyntax ModuleName ModuleName
146− | DeprecatedClassImport ModuleName (ProperName 'ClassName)
147− | DeprecatedClassExport (ProperName 'ClassName)
148121 | DuplicateSelectiveImport ModuleName
149122 | DuplicateImport ModuleName ImportDeclarationType (Maybe ModuleName)
150− | DuplicateImportRef String
151− | DuplicateExportRef String
123+ | DuplicateImportRef Name
124+ | DuplicateExportRef Name
152125 | IntOutOfRange Integer String Integer Integer
153− | RedundantEmptyHidingImport ModuleName
154126 | ImplicitQualifiedImport ModuleName ModuleName [DeclarationRef]
155127 | ImplicitImport ModuleName [DeclarationRef]
156128 | HidingImport ModuleName [DeclarationRef]
157129 | CaseBinderLengthDiffers Int [Binder]
158130 | IncorrectAnonymousArgument
159− | InvalidOperatorInBinder Ident Ident
131+ | InvalidOperatorInBinder (Qualified (OpName 'ValueOpName)) (Qualified Ident)
160132 | DeprecatedRequirePath
161133 | CannotGeneralizeRecursiveFunction Ident Type
162134 deriving (Show)
@@ -241,42 +213,22 @@ errorCode em = case unwrapErrorMessage em of
241213 CannotWriteFile{} -> "CannotWriteFile"
242214 InfiniteType{} -> "InfiniteType"
243215 InfiniteKind{} -> "InfiniteKind"
244− MultipleFixities{} -> "MultipleFixities"
216+ MultipleValueOpFixities{} -> "MultipleValueOpFixities"
217+ MultipleTypeOpFixities{} -> "MultipleTypeOpFixities"
245218 OrphanTypeDeclaration{} -> "OrphanTypeDeclaration"
246− OrphanFixityDeclaration{} -> "OrphanFixityDeclaration"
247219 RedefinedModule{} -> "RedefinedModule"
248220 RedefinedIdent{} -> "RedefinedIdent"
249221 OverlappingNamesInLet -> "OverlappingNamesInLet"
250− UnknownModule{} -> "UnknownModule"
251− UnknownType{} -> "UnknownType"
252− UnknownTypeOp{} -> "UnknownTypeOp"
253− UnknownTypeClass{} -> "UnknownTypeClass"
254− UnknownValue{} -> "UnknownValue"
255− UnknownDataConstructor{} -> "UnknownDataConstructor"
256− UnknownTypeConstructor{} -> "UnknownTypeConstructor"
257− UnknownImportType{} -> "UnknownImportType"
258− UnknownImportTypeOp{} -> "UnknownImportTypeOp"
259− UnknownExportType{} -> "UnknownExportType"
260− UnknownExportTypeOp{} -> "UnknownExportTypeOp"
261− UnknownImportTypeClass{} -> "UnknownImportTypeClass"
262− UnknownExportTypeClass{} -> "UnknownExportTypeClass"
263− UnknownImportValue{} -> "UnknownImportValue"
264− UnknownExportValue{} -> "UnknownExportValue"
265− UnknownExportModule{} -> "UnknownExportModule"
222+ UnknownName{} -> "UnknownName"
223+ UnknownImport{} -> "UnknownImport"
266224 UnknownImportDataConstructor{} -> "UnknownImportDataConstructor"
225+ UnknownExport{} -> "UnknownExport"
267226 UnknownExportDataConstructor{} -> "UnknownExportDataConstructor"
268227 ScopeConflict{} -> "ScopeConflict"
269228 ScopeShadowing{} -> "ScopeShadowing"
270− ConflictingTypeDecls{} -> "ConflictingTypeDecls"
271− ConflictingCtorDecls{} -> "ConflictingCtorDecls"
272− TypeConflictsWithClass{} -> "TypeConflictsWithClass"
273− CtorConflictsWithClass{} -> "CtorConflictsWithClass"
274− ClassConflictsWithType{} -> "ClassConflictsWithType"
275− ClassConflictsWithCtor{} -> "ClassConflictsWithCtor"
229+ DeclConflict{} -> "DeclConflict"
230+ ExportConflict{} -> "ExportConflict"
276231 DuplicateModuleName{} -> "DuplicateModuleName"
277− DuplicateClassExport{} -> "DuplicateClassExport"
278− DuplicateValueExport{} -> "DuplicateValueExport"
279− DuplicateTypeOpExport{} -> "DuplicateTypeOpExport"
280232 DuplicateTypeArgument{} -> "DuplicateTypeArgument"
281233 InvalidDoBind -> "InvalidDoBind"
282234 InvalidDoLet -> "InvalidDoLet"
@@ -319,27 +271,19 @@ errorCode em = case unwrapErrorMessage em of
319271 WildcardInferredType{} -> "WildcardInferredType"
320272 HoleInferredType{} -> "HoleInferredType"
321273 MissingTypeDeclaration{} -> "MissingTypeDeclaration"
322− NotExhaustivePattern{} -> "NotExhaustivePattern"
323274 OverlappingPattern{} -> "OverlappingPattern"
324275 IncompleteExhaustivityCheck{} -> "IncompleteExhaustivityCheck"
325− ClassOperator{} -> "ClassOperator"
326276 MisleadingEmptyTypeImport{} -> "MisleadingEmptyTypeImport"
327277 ImportHidingModule{} -> "ImportHidingModule"
328278 UnusedImport{} -> "UnusedImport"
329279 UnusedExplicitImport{} -> "UnusedExplicitImport"
330280 UnusedDctorImport{} -> "UnusedDctorImport"
331281 UnusedDctorExplicitImport{} -> "UnusedDctorExplicitImport"
332− DeprecatedOperatorDecl{} -> "DeprecatedOperatorDecl"
333− DeprecatedOperatorSection{} -> "DeprecatedOperatorSection"
334− DeprecatedQualifiedSyntax{} -> "DeprecatedQualifiedSyntax"
335− DeprecatedClassImport{} -> "DeprecatedClassImport"
336− DeprecatedClassExport{} -> "DeprecatedClassExport"
337282 DuplicateSelectiveImport{} -> "DuplicateSelectiveImport"
338283 DuplicateImport{} -> "DuplicateImport"
339284 DuplicateImportRef{} -> "DuplicateImportRef"
340285 DuplicateExportRef{} -> "DuplicateExportRef"
341286 IntOutOfRange{} -> "IntOutOfRange"
342− RedundantEmptyHidingImport{} -> "RedundantEmptyHidingImport"
343287 ImplicitQualifiedImport{} -> "ImplicitQualifiedImport"
344288 ImplicitImport{} -> "ImplicitImport"
345289 HidingImport{} -> "HidingImport"
@@ -381,14 +325,17 @@ addHint hint = onErrorMessages $ \(ErrorMessage hints se) -> ErrorMessage (hint
381325
382326-- | A map from rigid type variable name/unknown variable pairs to new variables.
383327data TypeMap = TypeMap
384− { umSkolemMap :: M.Map Int (String, Int, Maybe SourceSpan)
385− , umNextSkolem :: Int
386− , umUnknownMap :: M.Map Int Int
387− , umNextUnknown :: Int
328+ { umSkolemMap :: M.Map Int (String, Int, Maybe SourceSpan)
329+ -- ^ a map from skolems to their new names, including source and naming info
330+ , umUnknownMap :: M.Map Int Int
331+ -- ^ a map from unification variables to their new names
332+ , umNextIndex :: Int
333+ -- ^ unknowns and skolems share a source of names during renaming, to
334+ -- avoid overlaps in error messages. This is the next label for either case.
388335 } deriving Show
389336
390337defaultUnknownMap :: TypeMap
391−defaultUnknownMap = TypeMap M.empty 0 M.empty 0
338+defaultUnknownMap = TypeMap M.empty M.empty 0
392339
393340-- | How critical the issue is
394341data Level = Error | Warning deriving Show
@@ -407,16 +354,16 @@ replaceUnknowns = everywhereOnTypesM replaceTypes
407354 m <- get
408355 case M.lookup u (umUnknownMap m) of
409356 Nothing -> do
410− let u' = umNextUnknown m
411− put $ m { umUnknownMap = M.insert u u' (umUnknownMap m), umNextUnknown = u' + 1 }
357+ let u' = umNextIndex m
358+ put $ m { umUnknownMap = M.insert u u' (umUnknownMap m), umNextIndex = u' + 1 }
412359 return (TUnknown u')
413360 Just u' -> return (TUnknown u')
414361 replaceTypes (Skolem name s sko ss) = do
415362 m <- get
416363 case M.lookup s (umSkolemMap m) of
417364 Nothing -> do
418− let s' = umNextSkolem m
419− put $ m { umSkolemMap = M.insert s (name, s', ss) (umSkolemMap m), umNextSkolem = s' + 1 }
365+ let s' = umNextIndex m
366+ put $ m { umSkolemMap = M.insert s (name, s', ss) (umSkolemMap m), umNextIndex = s' + 1 }
420367 return (Skolem name s' sko ss)
421368 Just (_, s', _) -> return (Skolem name s' sko ss)
422369 replaceTypes other = return other
@@ -430,14 +377,14 @@ onTypesInErrorMessageM f (ErrorMessage hints simple) = ErrorMessage <$> traverse
430377 gSimple (ExprDoesNotHaveType e t) = ExprDoesNotHaveType e <$> f t
431378 gSimple (CannotApplyFunction t e) = CannotApplyFunction <$> f t <*> pure e
432379 gSimple (InvalidInstanceHead t) = InvalidInstanceHead <$> f t
433− gSimple (NoInstanceFound cl ts) = NoInstanceFound cl <$> traverse f ts
380+ gSimple (NoInstanceFound con) = NoInstanceFound <$> overConstraintArgs (traverse f) con
434381 gSimple (OverlappingInstances cl ts insts) = OverlappingInstances cl <$> traverse f ts <*> pure insts
435382 gSimple (PossiblyInfiniteInstance cl ts) = PossiblyInfiniteInstance cl <$> traverse f ts
436383 gSimple (CannotDerive cl ts) = CannotDerive cl <$> traverse f ts
437384 gSimple (ExpectedType ty k) = ExpectedType <$> f ty <*> pure k
438385 gSimple (OrphanInstance nm cl ts) = OrphanInstance nm cl <$> traverse f ts
439386 gSimple (WildcardInferredType ty) = WildcardInferredType <$> f ty
440− gSimple (HoleInferredType name ty) = HoleInferredType name <$> f ty
387+ gSimple (HoleInferredType name ty env) = HoleInferredType name <$> f ty <*> traverse (sndM f) env
441388 gSimple (MissingTypeDeclaration nm ty) = MissingTypeDeclaration nm <$> f ty
442389 gSimple (CannotGeneralizeRecursiveFunction nm ty) = CannotGeneralizeRecursiveFunction nm <$> f ty
443390
@@ -457,18 +404,16 @@ wikiUri e = "https://github.com/purescript/purescript/wiki/Error-Code-" ++ error
457404-- TODO Other possible suggestions:
458405-- WildcardInferredType - source span not small enough
459406-- DuplicateSelectiveImport - would require 2 ranges to remove and 1 insert
460−-- DeprecatedClassExport, DeprecatedClassImport, DeprecatedOperatorSection, would want to replace smaller span?
461407errorSuggestion :: SimpleErrorMessage -> Maybe ErrorSuggestion
462408errorSuggestion err = case err of
463409 UnusedImport{} -> emptySuggestion
464− RedundantEmptyHidingImport{} -> emptySuggestion
465410 DuplicateImport{} -> emptySuggestion
466− DeprecatedQualifiedSyntax name qualName -> suggest $
467− "import " ++ runModuleName name ++ " as " ++ runModuleName qualName
468411 UnusedExplicitImport mn _ qual refs -> suggest $ importSuggestion mn refs qual
469412 ImplicitImport mn refs -> suggest $ importSuggestion mn refs Nothing
470413 ImplicitQualifiedImport mn asModule refs -> suggest $ importSuggestion mn refs (Just asModule)
471414 HidingImport mn refs -> suggest $ importSuggestion mn refs Nothing
415+ MissingTypeDeclaration ident ty -> suggest $ showIdent ident ++ " :: " ++ prettyPrintType ty
416+ WildcardInferredType ty -> suggest $ prettyPrintType ty
472417 _ -> Nothing
473418
474419 where
@@ -483,20 +428,81 @@ errorSuggestion err = case err of
483428 qstr (Just mn) = " as " ++ runModuleName mn
484429 qstr Nothing = ""
485430
431+suggestionSpan :: ErrorMessage -> Maybe SourceSpan
432+suggestionSpan e =
433+ getSpan (unwrapErrorMessage e) <$> errorSpan e
434+ where
435+ startOnly SourceSpan{spanName, spanStart} = SourceSpan {spanName, spanStart, spanEnd = spanStart}
436+
437+ getSpan simple ss =
438+ case simple of
439+ MissingTypeDeclaration{} -> startOnly ss
440+ _ -> ss
441+
486442showSuggestion :: SimpleErrorMessage -> String
487443showSuggestion suggestion = case errorSuggestion suggestion of
488444 Just (ErrorSuggestion x) -> x
489445 _ -> ""
490446
447+ansiColor :: (ANSI.ColorIntensity, ANSI.Color) -> String
448+ansiColor (intesity, color) =
449+ ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground intesity color]
450+
451+ansiColorReset :: String
452+ansiColorReset =
453+ ANSI.setSGRCode [ANSI.Reset]
454+
455+colorCode :: Maybe (ANSI.ColorIntensity, ANSI.Color) -> String -> String
456+colorCode codeColor code = case codeColor of
457+ Nothing -> code
458+ Just cc -> concat [ansiColor cc, code, ansiColorReset]
459+
460+colorCodeBox :: Maybe (ANSI.ColorIntensity, ANSI.Color) -> Box.Box -> Box.Box
461+colorCodeBox codeColor b = case codeColor of
462+ Nothing -> b
463+ Just cc
464+ | Box.rows b == 1 ->
465+ Box.text (ansiColor cc) Box.<> b `endWith` Box.text ansiColorReset
466+
467+ | 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
468+ [ Box.vcat Box.top $ replicate (Box.rows b) $ Box.text $ ansiColor cc
469+ , b
470+ , Box.vcat Box.top $ replicate (Box.rows b) $ Box.text ansiColorReset
471+ ]
472+
473+
474+-- | Default color intesity and color for code
475+defaultCodeColor :: (ANSI.ColorIntensity, ANSI.Color)
476+defaultCodeColor = (ANSI.Dull, ANSI.Yellow)
477+
478+-- | `prettyPrintSingleError` Options
479+data PPEOptions = PPEOptions
480+ { ppeCodeColor :: Maybe (ANSI.ColorIntensity, ANSI.Color) -- ^ Color code with this color... or not
481+ , ppeFull :: Bool -- ^ Should write a full error message?
482+ , ppeLevel :: Level -- ^ Should this report an error or a warning?
483+ , ppeShowWiki :: Bool -- ^ Should show a link to error message's wiki page?
484+ }
485+
486+-- | Default options for PPEOptions
487+defaultPPEOptions :: PPEOptions
488+defaultPPEOptions = PPEOptions
489+ { ppeCodeColor = Just defaultCodeColor
490+ , ppeFull = False
491+ , ppeLevel = Error
492+ , ppeShowWiki = True
493+ }
494+
495+
491496-- |
492497-- Pretty print a single error, simplifying if necessary
493498--
494−prettyPrintSingleError :: Bool -> Level -> Bool -> ErrorMessage -> Box.Box
495−prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap $ do
499+prettyPrintSingleError :: PPEOptions -> ErrorMessage -> Box.Box
500+prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalState defaultUnknownMap $ do
496501 em <- onTypesInErrorMessageM replaceUnknowns (if full then e else simplifyErrorMessage e)
497502 um <- get
498503 return (prettyPrintErrorMessage um em)
499504 where
505+ (markCode, markCodeBox) = (colorCode &&& colorCodeBox) codeColor
500506
501507 -- Pretty print an ErrorMessage
502508 prettyPrintErrorMessage :: TypeMap -> ErrorMessage -> Box.Box
@@ -505,9 +511,10 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
505511 [ foldr renderHint (indent (renderSimpleErrorMessage simple)) hints
506512 ] ++
507513 maybe [] (return . Box.moveDown 1) typeInformation ++
508− [ Box.moveDown 1 $ paras [ line $ "See " ++ wikiUri e ++ " for more information, "
509− , line $ "or to contribute content related to this " ++ levelText ++ "."
510− ]
514+ [ Box.moveDown 1 $ paras
515+ [ line $ "See " ++ wikiUri e ++ " for more information, "
516+ , line $ "or to contribute content related to this " ++ levelText ++ "."
517+ ]
511518 | showWiki
512519 ]
513520 where
@@ -522,11 +529,11 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
522529 skolemInfo :: (String, Int, Maybe SourceSpan) -> Box.Box
523530 skolemInfo (name, s, ss) =
524531 paras $
525− line (name ++ show s ++ " is a rigid type variable")
532+ line (markCode (name ++ show s) ++ " is a rigid type variable")
526533 : foldMap (return . line . (" bound at " ++) . displayStartEndPos) ss
527534
528535 unknownInfo :: Int -> Box.Box
529− unknownInfo u = line $ "_" ++ show u ++ " is an unknown type"
536+ unknownInfo u = line $ markCode ("t" ++ show u) ++ " is an unknown type"
530537
531538 renderSimpleErrorMessage :: SimpleErrorMessage -> Box.Box
532539 renderSimpleErrorMessage (CannotGetFileInfo path) =
@@ -545,35 +552,35 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
545552 paras $ [ line "Unable to parse foreign module:"
546553 , indent . line $ path
547554 ] ++
548− (map (indent . line) (concatMap Bundle.printErrorMessage (maybeToList extra)))
555+ map (indent . line) (concatMap Bundle.printErrorMessage (maybeToList extra))
549556 renderSimpleErrorMessage (ErrorParsingModule err) =
550557 paras [ line "Unable to parse module: "
551558 , prettyPrintParseError err
552559 ]
553560 renderSimpleErrorMessage (MissingFFIModule mn) =
554− line $ "The foreign module implementation for module " ++ runModuleName mn ++ " is missing."
561+ line $ "The foreign module implementation for module " ++ markCode (runModuleName mn) ++ " is missing."
555562 renderSimpleErrorMessage (UnnecessaryFFIModule mn path) =
556− paras [ line $ "An unnecessary foreign module implementation was provided for module " ++ runModuleName mn ++ ": "
563+ paras [ line $ "An unnecessary foreign module implementation was provided for module " ++ markCode (runModuleName mn) ++ ": "
557564 , indent . line $ path
558− , line $ "Module " ++ runModuleName mn ++ " does not contain any foreign import declarations, so a foreign module is not necessary."
565+ , line $ "Module " ++ markCode (runModuleName mn) ++ " does not contain any foreign import declarations, so a foreign module is not necessary."
559566 ]
560567 renderSimpleErrorMessage (MissingFFIImplementations mn idents) =
561− paras [ line $ "The following values are not defined in the foreign module for module " ++ runModuleName mn ++ ": "
568+ paras [ line $ "The following values are not defined in the foreign module for module " ++ markCode (runModuleName mn) ++ ": "
562569 , indent . paras $ map (line . runIdent) idents
563570 ]
564571 renderSimpleErrorMessage (UnusedFFIImplementations mn idents) =
565− paras [ line $ "The following definitions in the foreign module for module " ++ runModuleName mn ++ " are unused: "
572+ paras [ line $ "The following definitions in the foreign module for module " ++ markCode (runModuleName mn) ++ " are unused: "
566573 , indent . paras $ map (line . runIdent) idents
567574 ]
568575 renderSimpleErrorMessage (InvalidFFIIdentifier mn ident) =
569− paras [ line $ "In the FFI module for " ++ runModuleName mn ++ ":"
576+ paras [ line $ "In the FFI module for " ++ markCode (runModuleName mn) ++ ":"
570577 , indent . paras $
571− [ line $ "The identifier `" ++ ident ++ "` is not valid in PureScript."
578+ [ line $ "The identifier " ++ markCode ident ++ " is not valid in PureScript."
572579 , line "Note that exported identifiers in FFI modules must be valid PureScript identifiers."
573580 ]
574581 ]
575582 renderSimpleErrorMessage (MultipleFFIModules mn paths) =
576− paras [ line $ "Multiple foreign module implementations have been provided for module " ++ runModuleName mn ++ ": "
583+ paras [ line $ "Multiple foreign module implementations have been provided for module " ++ markCode (runModuleName mn) ++ ": "
577584 , indent . paras $ map line paths
578585 ]
579586 renderSimpleErrorMessage InvalidDoBind =
@@ -584,126 +591,78 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
584591 line "The same name was used more than once in a let binding."
585592 renderSimpleErrorMessage (InfiniteType ty) =
586593 paras [ line "An infinite type was inferred for an expression: "
587− , indent $ typeAsBox ty
594+ , markCodeBox $ indent $ typeAsBox ty
588595 ]
589596 renderSimpleErrorMessage (InfiniteKind ki) =
590597 paras [ line "An infinite kind was inferred for a type: "
591− , indent $ line $ prettyPrintKind ki
598+ , indent $ line $ markCode $ prettyPrintKind ki
592599 ]
593− renderSimpleErrorMessage (MultipleFixities name) =
594− line $ "There are multiple fixity/precedence declarations for " ++ showIdent name
600+ renderSimpleErrorMessage (MultipleValueOpFixities op) =
601+ line $ "There are multiple fixity/precedence declarations for operator " ++ markCode (showOp op)
602+ renderSimpleErrorMessage (MultipleTypeOpFixities op) =
603+ line $ "There are multiple fixity/precedence declarations for type operator " ++ markCode (showOp op)
595604 renderSimpleErrorMessage (OrphanTypeDeclaration nm) =
596− line $ "The type declaration for " ++ showIdent nm ++ " should be followed by its definition."
597− renderSimpleErrorMessage (OrphanFixityDeclaration op) =
598− line $ "The fixity/precedence declaration for " ++ show op ++ " should appear in the same module as its definition."
605+ line $ "The type declaration for " ++ markCode (showIdent nm) ++ " should be followed by its definition."
599606 renderSimpleErrorMessage (RedefinedModule name filenames) =
600− paras [ line ("The module " ++ runModuleName name ++ " has been defined multiple times:")
607+ paras [ line ("The module " ++ markCode (runModuleName name) ++ " has been defined multiple times:")
601608 , indent . paras $ map (line . displaySourceSpan) filenames
602609 ]
603610 renderSimpleErrorMessage (RedefinedIdent name) =
604− line $ "The value " ++ showIdent name ++ " has been defined multiple times"
605− renderSimpleErrorMessage (UnknownModule mn) =
606− line $ "Unknown module " ++ runModuleName mn
607− renderSimpleErrorMessage (UnknownType name) =
608− line $ "Unknown type " ++ showQualified runProperName name
609− renderSimpleErrorMessage (UnknownTypeOp name) =
610− line $ "Unknown type operator " ++ showQualified showIdent name
611− renderSimpleErrorMessage (UnknownTypeClass name) =
612− line $ "Unknown type class " ++ showQualified runProperName name
613− renderSimpleErrorMessage (UnknownValue name) =
614− line $ "Unknown value " ++ showQualified showIdent name
615− renderSimpleErrorMessage (UnknownTypeConstructor name) =
616− line $ "Unknown type constructor " ++ showQualified runProperName name
617− renderSimpleErrorMessage (UnknownDataConstructor dc tc) =
618− line $ "Unknown data constructor " ++ showQualified runProperName dc ++ foldMap ((" for type constructor " ++) . showQualified runProperName) tc
619− renderSimpleErrorMessage (UnknownImportType mn name) =
620− paras [ line $ "Cannot import type " ++ runProperName name ++ " from module " ++ runModuleName mn
611+ line $ "The value " ++ markCode (showIdent name) ++ " has been defined multiple times"
612+ renderSimpleErrorMessage (UnknownName name) =
613+ line $ "Unknown " ++ printName name
614+ renderSimpleErrorMessage (UnknownImport mn name) =
615+ paras [ line $ "Cannot import " ++ printName (Qualified Nothing name) ++ " from module " ++ markCode (runModuleName mn)
621616 , line "It either does not exist or the module does not export it."
622617 ]
623− renderSimpleErrorMessage (UnknownExportType name) =
624− line $ "Cannot export unknown type " ++ runProperName name
625− renderSimpleErrorMessage (UnknownImportTypeOp mn name) =
626− paras [ line $ "Cannot import type operator " ++ showIdent name ++ " from module " ++ runModuleName mn
627− , line "It either does not exist or the module does not export it."
628− ]
629− renderSimpleErrorMessage (UnknownExportTypeOp name) =
630− line $ "Cannot export unknown type operator " ++ showIdent name
631− renderSimpleErrorMessage (UnknownImportTypeClass mn name) =
632− paras [ line $ "Cannot import type class " ++ runProperName name ++ " from module " ++ runModuleName mn
633− , line "It either does not exist or the module does not export it."
634− ]
635− renderSimpleErrorMessage (UnknownExportTypeClass name) =
636− line $ "Cannot export unknown type class " ++ runProperName name
637− renderSimpleErrorMessage (UnknownImportValue mn name) =
638− paras [ line $ "Cannot import value " ++ showIdent name ++ " from module " ++ runModuleName mn
639− , line "It either does not exist or the module does not export it."
640− ]
641− renderSimpleErrorMessage (UnknownExportValue name) =
642− line $ "Cannot export unknown value " ++ showIdent name
643− renderSimpleErrorMessage (UnknownExportModule name) =
644− paras [ line $ "Cannot export unknown module " ++ runModuleName name
645− , line "It either does not exist or has not been imported by the current module."
646− ]
647618 renderSimpleErrorMessage (UnknownImportDataConstructor mn tcon dcon) =
648− line $ "Module " ++ runModuleName mn ++ " does not export data constructor " ++ runProperName dcon ++ " for type " ++ runProperName tcon
619+ line $ "Module " ++ runModuleName mn ++ " does not export data constructor " ++ markCode (runProperName dcon) ++ " for type " ++ markCode (runProperName tcon)
620+ renderSimpleErrorMessage (UnknownExport name) =
621+ line $ "Cannot export unknown " ++ printName (Qualified Nothing name)
649622 renderSimpleErrorMessage (UnknownExportDataConstructor tcon dcon) =
650− line $ "Cannot export data constructor " ++ runProperName dcon ++ " for type " ++ runProperName tcon ++ ", as it has not been declared."
623+ line $ "Cannot export data constructor " ++ markCode (runProperName dcon) ++ " for type " ++ markCode (runProperName tcon) ++ ", as it has not been declared."
651624 renderSimpleErrorMessage (ScopeConflict nm ms) =
652− paras [ line $ "Conflicting definitions are in scope for " ++ nm ++ " from the following modules:"
653− , indent $ paras $ map (line . runModuleName) ms
625+ paras [ line $ "Conflicting definitions are in scope for " ++ printName (Qualified Nothing nm) ++ " from the following modules:"
626+ , indent $ paras $ map (line . markCode . runModuleName) ms
654627 ]
655628 renderSimpleErrorMessage (ScopeShadowing nm exmn ms) =
656− paras [ line $ "Shadowed definitions are in scope for " ++ nm ++ " from the following open imports:"
657− , indent $ paras $ map (line . ("import " ++) . runModuleName) ms
629+ paras [ line $ "Shadowed definitions are in scope for " ++ printName (Qualified Nothing nm) ++ " from the following open imports:"
630+ , indent $ paras $ map (line . markCode . ("import " ++) . runModuleName) ms
658631 , line $ "These will be ignored and the " ++ case exmn of
659− Just exmn' -> "declaration from " ++ runModuleName exmn' ++ " will be used."
632+ Just exmn' -> "declaration from " ++ markCode (runModuleName exmn') ++ " will be used."
660633 Nothing -> "local declaration will be used."
661634 ]
662− renderSimpleErrorMessage (ConflictingTypeDecls nm) =
663− line $ "Conflicting type declarations for " ++ runProperName nm
664− renderSimpleErrorMessage (ConflictingCtorDecls nm) =
665− line $ "Conflicting data constructor declarations for " ++ runProperName nm
666− renderSimpleErrorMessage (TypeConflictsWithClass nm) =
667− line $ "Type " ++ runProperName nm ++ " conflicts with a type class declaration with the same name."
668− renderSimpleErrorMessage (CtorConflictsWithClass nm) =
669− line $ "Data constructor " ++ runProperName nm ++ " conflicts with a type class declaration with the same name."
670− renderSimpleErrorMessage (ClassConflictsWithType nm) =
671− line $ "Type class " ++ runProperName nm ++ " conflicts with a type declaration with the same name."
672− renderSimpleErrorMessage (ClassConflictsWithCtor nm) =
673− line $ "Type class " ++ runProperName nm ++ " conflicts with a data constructor declaration with the same name."
635+ renderSimpleErrorMessage (DeclConflict new existing) =
636+ line $ "Declaration for " ++ printName (Qualified Nothing new) ++ " conflicts with an existing " ++ nameType existing ++ " of the same name."
637+ renderSimpleErrorMessage (ExportConflict new existing) =
638+ line $ "Export for " ++ printName new ++ " conflicts with " ++ runName existing
674639 renderSimpleErrorMessage (DuplicateModuleName mn) =
675− line $ "Module " ++ runModuleName mn ++ " has been defined multiple times."
676− renderSimpleErrorMessage (DuplicateClassExport nm) =
677− line $ "Duplicate export declaration for type class " ++ runProperName nm
678− renderSimpleErrorMessage (DuplicateValueExport nm) =
679− line $ "Duplicate export declaration for value " ++ showIdent nm
680− renderSimpleErrorMessage (DuplicateTypeOpExport nm) =
681− line $ "Duplicate export declaration for type operator " ++ showIdent nm
640+ line $ "Module " ++ markCode (runModuleName mn) ++ " has been defined multiple times."
682641 renderSimpleErrorMessage (CycleInDeclaration nm) =
683− line $ "The value of " ++ showIdent nm ++ " is undefined here, so this reference is not allowed."
642+ line $ "The value of " ++ markCode (showIdent nm) ++ " is undefined here, so this reference is not allowed."
684643 renderSimpleErrorMessage (CycleInModules mns) =
685644 paras [ line "There is a cycle in module dependencies in these modules: "
686− , indent $ paras (map (line . runModuleName) mns)
645+ , indent $ paras (map (line . markCode . runModuleName) mns)
687646 ]
688647 renderSimpleErrorMessage (CycleInTypeSynonym name) =
689648 paras [ line $ case name of
690− Just pn -> "A cycle appears in the definition of type synonym " ++ runProperName pn
649+ Just pn -> "A cycle appears in the definition of type synonym " ++ markCode (runProperName pn)
691650 Nothing -> "A cycle appears in a set of type synonym definitions."
692651 , line "Cycles are disallowed because they can lead to loops in the type checker."
693652 , line "Consider using a 'newtype' instead."
694653 ]
695654 renderSimpleErrorMessage (NameIsUndefined ident) =
696− line $ "Value " ++ showIdent ident ++ " is undefined."
655+ line $ "Value " ++ markCode (showIdent ident) ++ " is undefined."
697656 renderSimpleErrorMessage (UndefinedTypeVariable name) =
698− line $ "Type variable " ++ runProperName name ++ " is undefined."
657+ line $ "Type variable " ++ markCode (runProperName name) ++ " is undefined."
699658 renderSimpleErrorMessage (PartiallyAppliedSynonym name) =
700− paras [ line $ "Type synonym " ++ showQualified runProperName name ++ " is partially applied."
659+ paras [ line $ "Type synonym " ++ markCode (showQualified runProperName name) ++ " is partially applied."
701660 , line "Type synonyms must be applied to all of their type arguments."
702661 ]
703662 renderSimpleErrorMessage (EscapedSkolem binding) =
704663 paras $ [ line "A type variable has escaped its scope." ]
705664 <> foldMap (\expr -> [ line "Relevant expression: "
706− , indent $ prettyPrintValue valueDepth expr
665+ , markCodeBox $ indent $ prettyPrintValue valueDepth expr
707666 ]) binding
708667 renderSimpleErrorMessage (TypesDoNotUnify u1 u2)
709668 = let (sorted1, sorted2) = sortRows u1 u2
@@ -725,39 +684,56 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
725684 , rowFromList (sortBy (comparing fst) sd2 ++ map (fst &&& snd . snd) common, r2)
726685 )
727686 in paras [ line "Could not match type"
728− , indent $ typeAsBox sorted1
687+ , markCodeBox $ indent $ typeAsBox sorted1
729688 , line "with type"
730− , indent $ typeAsBox sorted2
689+ , markCodeBox $ indent $ typeAsBox sorted2
731690 ]
732691
733692 renderSimpleErrorMessage (KindsDoNotUnify k1 k2) =
734693 paras [ line "Could not match kind"
735− , indent $ line $ prettyPrintKind k1
694+ , indent $ line $ markCode $ prettyPrintKind k1
736695 , line "with kind"
737− , indent $ line $ prettyPrintKind k2
696+ , indent $ line $ markCode $ prettyPrintKind k2
738697 ]
739698 renderSimpleErrorMessage (ConstrainedTypeUnified t1 t2) =
740699 paras [ line "Could not match constrained type"
741− , indent $ typeAsBox t1
700+ , markCodeBox $ indent $ typeAsBox t1
742701 , line "with type"
743− , indent $ typeAsBox t2
702+ , markCodeBox $ indent $ typeAsBox t2
744703 ]
745704 renderSimpleErrorMessage (OverlappingInstances nm ts (d : ds)) =
746705 paras [ line "Overlapping type class instances found for"
747− , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
748− , Box.vcat Box.left (map typeAtomAsBox ts)
749− ]
706+ , markCodeBox $ indent $ Box.hsep 1 Box.left
707+ [ line (showQualified runProperName nm)
708+ , Box.vcat Box.left (map typeAtomAsBox ts)
709+ ]
750710 , line "The following instances were found:"
751711 , indent $ paras (line (showQualified showIdent d ++ " (chosen)") : map (line . showQualified showIdent) ds)
752712 , line "Overlapping type class instances can lead to different behavior based on the order of module imports, and for that reason are not recommended."
753713 , line "They may be disallowed completely in a future version of the compiler."
754714 ]
755715 renderSimpleErrorMessage OverlappingInstances{} = internalError "OverlappingInstances: empty instance list"
756− renderSimpleErrorMessage (NoInstanceFound nm ts) =
716+ renderSimpleErrorMessage (NoInstanceFound (Constraint C.Fail [ TypeLevelString message ] _)) =
717+ paras [ line "A custom type error occurred while solving type class constraints:"
718+ , indent . paras . map line . lines $ message
719+ ]
720+ renderSimpleErrorMessage (NoInstanceFound (Constraint C.Partial
721+ _
722+ (Just (PartialConstraintData bs b)))) =
723+ paras [ line "A case expression could not be determined to cover all inputs."
724+ , line "The following additional cases are required to cover all inputs:\n"
725+ , indent $ paras $
726+ Box.hsep 1 Box.left
727+ (map (paras . map (line . markCode)) (transpose bs))
728+ : [line "..." | not b]
729+ , line "Alternatively, add a Partial constraint to the type of the enclosing value."
730+ ]
731+ renderSimpleErrorMessage (NoInstanceFound (Constraint nm ts _)) =
757732 paras [ line "No type class instance was found for"
758− , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
759− , Box.vcat Box.left (map typeAtomAsBox ts)
760− ]
733+ , markCodeBox $ indent $ Box.hsep 1 Box.left
734+ [ line (showQualified runProperName nm)
735+ , Box.vcat Box.left (map typeAtomAsBox ts)
736+ ]
761737 , paras [ line "The instance head contains unknown type variables. Consider adding a type annotation."
762738 | any containsUnknowns ts
763739 ]
@@ -770,130 +746,128 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
770746 go _ = False
771747 renderSimpleErrorMessage (PossiblyInfiniteInstance nm ts) =
772748 paras [ line "Type class instance for"
773− , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
774− , Box.vcat Box.left (map typeAtomAsBox ts)
775− ]
749+ , markCodeBox $ indent $ Box.hsep 1 Box.left
750+ [ line (showQualified runProperName nm)
751+ , Box.vcat Box.left (map typeAtomAsBox ts)
752+ ]
776753 , line "is possibly infinite."
777754 ]
778755 renderSimpleErrorMessage (CannotDerive nm ts) =
779756 paras [ line "Cannot derive a type class instance for"
780− , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
781− , Box.vcat Box.left (map typeAtomAsBox ts)
782− ]
757+ , markCodeBox $ indent $ Box.hsep 1 Box.left
758+ [ line (showQualified runProperName nm)
759+ , Box.vcat Box.left (map typeAtomAsBox ts)
760+ ]
783761 ]
784762 renderSimpleErrorMessage (CannotFindDerivingType nm) =
785− line $ "Cannot derive a type class instance, because the type declaration for " ++ runProperName nm ++ " could not be found."
763+ line $ "Cannot derive a type class instance, because the type declaration for " ++ markCode (runProperName nm) ++ " could not be found."
786764 renderSimpleErrorMessage (DuplicateLabel l expr) =
787− paras $ [ line $ "Label " ++ show l ++ " appears more than once in a row type." ]
765+ paras $ [ line $ "Label " ++ markCode l ++ " appears more than once in a row type." ]
788766 <> foldMap (\expr' -> [ line "Relevant expression: "
789− , indent $ prettyPrintValue valueDepth expr'
767+ , markCodeBox $ indent $ prettyPrintValue valueDepth expr'
790768 ]) expr
791769 renderSimpleErrorMessage (DuplicateTypeArgument name) =
792− line $ "Type argument " ++ show name ++ " appears more than once."
770+ line $ "Type argument " ++ markCode name ++ " appears more than once."
793771 renderSimpleErrorMessage (DuplicateValueDeclaration nm) =
794− line $ "Multiple value declarations exist for " ++ showIdent nm ++ "."
772+ line $ "Multiple value declarations exist for " ++ markCode (showIdent nm) ++ "."
795773 renderSimpleErrorMessage (ArgListLengthsDiffer ident) =
796− line $ "Argument list lengths differ in declaration " ++ showIdent ident
774+ line $ "Argument list lengths differ in declaration " ++ markCode (showIdent ident)
797775 renderSimpleErrorMessage (OverlappingArgNames ident) =
798776 line $ "Overlapping names in function/binder" ++ foldMap ((" in declaration " ++) . showIdent) ident
799777 renderSimpleErrorMessage (MissingClassMember ident) =
800− line $ "Type class member " ++ showIdent ident ++ " has not been implemented."
778+ line $ "Type class member " ++ markCode (showIdent ident) ++ " has not been implemented."
801779 renderSimpleErrorMessage (ExtraneousClassMember ident className) =
802− line $ showIdent ident ++ " is not a member of type class " ++ showQualified runProperName className
780+ line $ "" ++ markCode (showIdent ident) ++ " is not a member of type class " ++ markCode (showQualified runProperName className)
803781 renderSimpleErrorMessage (ExpectedType ty kind) =
804− paras [ line "In a type-annotated expression x :: t, the type t must have kind *."
782+ paras [ line $ "In a type-annotated expression " ++ markCode "x :: t" ++ ", the type " ++ markCode "t" ++ " must have kind " ++ markCode "*" ++ "."
805783 , line "The error arises from the type"
806− , indent $ typeAsBox ty
784+ , markCodeBox $ indent $ typeAsBox ty
807785 , line "having the kind"
808− , indent $ line $ prettyPrintKind kind
786+ , indent $ line $ markCode $ prettyPrintKind kind
809787 , line "instead."
810788 ]
811789 renderSimpleErrorMessage (IncorrectConstructorArity nm) =
812− line $ "Data constructor " ++ showQualified runProperName nm ++ " was given the wrong number of arguments in a case expression."
790+ line $ "Data constructor " ++ markCode (showQualified runProperName nm) ++ " was given the wrong number of arguments in a case expression."
813791 renderSimpleErrorMessage (ExprDoesNotHaveType expr ty) =
814792 paras [ line "Expression"
815− , indent $ prettyPrintValue valueDepth expr
793+ , markCodeBox $ indent $ prettyPrintValue valueDepth expr
816794 , line "does not have type"
817− , indent $ typeAsBox ty
795+ , markCodeBox $ indent $ typeAsBox ty
818796 ]
819797 renderSimpleErrorMessage (PropertyIsMissing prop) =
820− line $ "Type of expression lacks required label " ++ show prop ++ "."
798+ line $ "Type of expression lacks required label " ++ markCode prop ++ "."
821799 renderSimpleErrorMessage (AdditionalProperty prop) =
822− line $ "Type of expression contains additional label " ++ show prop ++ "."
800+ line $ "Type of expression contains additional label " ++ markCode prop ++ "."
823801 renderSimpleErrorMessage (CannotApplyFunction fn arg) =
824802 paras [ line "A function of type"
825− , indent $ typeAsBox fn
803+ , markCodeBox $ indent $ typeAsBox fn
826804 , line "can not be applied to the argument"
827− , indent $ prettyPrintValue valueDepth arg
805+ , markCodeBox $ indent $ prettyPrintValue valueDepth arg
828806 ]
829807 renderSimpleErrorMessage TypeSynonymInstance =
830808 line "Type class instances for type synonyms are disallowed."
831809 renderSimpleErrorMessage (OrphanInstance nm cnm ts) =
832− paras [ line $ "Type class instance " ++ showIdent nm ++ " for "
833− , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName cnm)
834− , Box.vcat Box.left (map typeAtomAsBox ts)
835− ]
810+ paras [ line $ "Type class instance " ++ markCode (showIdent nm) ++ " for "
811+ , markCodeBox $ indent $ Box.hsep 1 Box.left
812+ [ line (showQualified runProperName cnm)
813+ , Box.vcat Box.left (map typeAtomAsBox ts)
814+ ]
836815 , line "is an orphan instance."
837816 , line "An orphan instance is an instance which is defined in neither the class module nor the data type module."
838817 , line "Consider moving the instance, if possible, or using a newtype wrapper."
839818 ]
840819 renderSimpleErrorMessage (InvalidNewtype name) =
841− paras [ line $ "Newtype " ++ runProperName name ++ " is invalid."
820+ paras [ line $ "Newtype " ++ markCode (runProperName name) ++ " is invalid."
842821 , line "Newtypes must define a single constructor with a single argument."
843822 ]
844823 renderSimpleErrorMessage (InvalidInstanceHead ty) =
845824 paras [ line "Type class instance head is invalid due to use of type"
846− , indent $ typeAsBox ty
825+ , markCodeBox $ indent $ typeAsBox ty
847826 , 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."
848827 ]
849828 renderSimpleErrorMessage (TransitiveExportError x ys) =
850− paras [ line $ "An export for " ++ prettyPrintExport x ++ " requires the following to also be exported: "
851− , indent $ paras $ map (line . prettyPrintExport) ys
829+ paras [ line $ "An export for " ++ markCode (prettyPrintExport x) ++ " requires the following to also be exported: "
830+ , indent $ paras $ map (line . markCode . prettyPrintExport) ys
852831 ]
853832 renderSimpleErrorMessage (TransitiveDctorExportError x ctor) =
854− paras [ line $ "An export for " ++ prettyPrintExport x ++ " requires the following data constructor to also be exported: "
855− , indent $ line $ runProperName ctor
833+ paras [ line $ "An export for " ++ markCode (prettyPrintExport x) ++ " requires the following data constructor to also be exported: "
834+ , indent $ line $ markCode $ runProperName ctor
856835 ]
857836 renderSimpleErrorMessage (ShadowedName nm) =
858− line $ "Name '" ++ showIdent nm ++ "' was shadowed."
837+ line $ "Name " ++ markCode (showIdent nm) ++ " was shadowed."
859838 renderSimpleErrorMessage (ShadowedTypeVar tv) =
860− line $ "Type variable '" ++ tv ++ "' was shadowed."
839+ line $ "Type variable " ++ markCode tv ++ " was shadowed."
861840 renderSimpleErrorMessage (UnusedTypeVar tv) =
862− line $ "Type variable '" ++ tv ++ "' was declared but not used."
863− renderSimpleErrorMessage (ClassOperator className opName) =
864− paras [ line $ "Type class '" ++ runProperName className ++ "' declares operator " ++ showIdent opName ++ "."
865− , line "This may be disallowed in the future - consider declaring a named member in the class and making the operator an alias:"
866− , indent . line $ showIdent opName ++ " = someMember"
867− ]
841+ line $ "Type variable " ++ markCode tv ++ " was declared but not used."
868842 renderSimpleErrorMessage (MisleadingEmptyTypeImport mn name) =
869− line $ "Importing type " ++ runProperName name ++ "(..) from " ++ runModuleName mn ++ " is misleading as it has no exported data constructors."
843+ line $ "Importing type " ++ markCode (runProperName name ++ "(..)") ++ " from " ++ markCode (runModuleName mn) ++ " is misleading as it has no exported data constructors."
870844 renderSimpleErrorMessage (ImportHidingModule name) =
871− paras [ line "'hiding' imports cannot be used to hide modules."
872− , line $ "An attempt was made to hide the import of " ++ runModuleName name
845+ paras [ line "hiding imports cannot be used to hide modules."
846+ , line $ "An attempt was made to hide the import of " ++ markCode (runModuleName name)
873847 ]
874848 renderSimpleErrorMessage (WildcardInferredType ty) =
875849 paras [ line "Wildcard type definition has the inferred type "
876− , indent $ typeAsBox ty
877− ]
878− renderSimpleErrorMessage (HoleInferredType name ty) =
879− paras [ line $ "Hole '" ++ name ++ "' has the inferred type "
880− , indent $ typeAsBox ty
850+ , markCodeBox $ indent $ typeAsBox ty
881851 ]
852+ renderSimpleErrorMessage (HoleInferredType name ty env) =
853+ paras $ [ line $ "Hole '" ++ markCode name ++ "' has the inferred type "
854+ , markCodeBox $ indent $ typeAsBox ty
855+ ] ++ if null env then [] else envInfo
856+ where
857+ envInfo :: [Box.Box]
858+ envInfo = [ line "in the following context:"
859+ , indent $ paras
860+ [ Box.hcat Box.left [ Box.text (showIdent ident <> " :: ")
861+ , markCodeBox $ typeAsBox ty'
862+ ]
863+ | (ident, ty') <- take 5 env
864+ ]
865+ ]
882866 renderSimpleErrorMessage (MissingTypeDeclaration ident ty) =
883− paras [ line $ "No type declaration was provided for the top-level declaration of " ++ showIdent ident ++ "."
867+ paras [ line $ "No type declaration was provided for the top-level declaration of " ++ markCode (showIdent ident) ++ "."
884868 , line "It is good practice to provide type declarations as a form of documentation."
885− , line $ "The inferred type of " ++ showIdent ident ++ " was:"
886− , indent $ typeAsBox ty
887− ]
888− renderSimpleErrorMessage (NotExhaustivePattern bs b) =
889− paras [ line "A case expression could not be determined to cover all inputs."
890− , line "The following additional cases are required to cover all inputs:\n"
891− , indent $ paras $
892− Box.hsep 1 Box.left
893− (map (paras . map (line . prettyPrintBinderAtom)) (transpose bs))
894− : [line "..." | not b]
895− , line "Or alternatively, add a Partial constraint to the type of the enclosing value."
896− , line "Non-exhaustive patterns for values without a `Partial` constraint will be disallowed in PureScript 0.9."
869+ , line $ "The inferred type of " ++ markCode (showIdent ident) ++ " was:"
870+ , markCodeBox $ indent $ typeAsBox ty
897871 ]
898872 renderSimpleErrorMessage (OverlappingPattern bs b) =
899873 paras $ [ line "A case expression contains unreachable cases:\n"
@@ -905,109 +879,51 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
905879 , line "You may want to decompose your data types into smaller types."
906880 ]
907881 renderSimpleErrorMessage (UnusedImport name) =
908− line $ "The import of module " ++ runModuleName name ++ " is redundant"
882+ line $ "The import of module " ++ markCode (runModuleName name) ++ " is redundant"
909883
910884 renderSimpleErrorMessage msg@(UnusedExplicitImport mn names _ _) =
911− paras [ line $ "The import of module " ++ runModuleName mn ++ " contains the following unused references:"
885+ paras [ line $ "The import of module " ++ markCode (runModuleName mn) ++ " contains the following unused references:"
912886 , indent $ paras $ map line names
913887 , line "It could be replaced with:"
914− , indent $ line $ showSuggestion msg ]
888+ , indent $ line $ markCode $ showSuggestion msg ]
915889
916890 renderSimpleErrorMessage (UnusedDctorImport name) =
917− line $ "The import of type " ++ runProperName name ++ " includes data constructors but only the type is used"
891+ line $ "The import of type " ++ markCode (runProperName name) ++ " includes data constructors but only the type is used"
918892
919893 renderSimpleErrorMessage (UnusedDctorExplicitImport name names) =
920− paras [ line $ "The import of type " ++ runProperName name ++ " includes the following unused data constructors:"
921− , indent $ paras $ map (line .runProperName) names ]
922−
923− renderSimpleErrorMessage (DeprecatedOperatorDecl name) =
924− paras [ line $ "The operator (" ++ name ++ ") was declared as a value rather than an alias for a named function."
925− , line "Operator aliases are declared by using a fixity declaration, for example:"
926− , indent $ line $ "infixl 9 someFunction as " ++ name
927− , line "Support for value-declared operators will be removed in PureScript 0.9."
928− ]
929−
930− renderSimpleErrorMessage (DeprecatedOperatorSection op val) =
931− paras [ line "An operator section uses legacy syntax. Operator sections are now written using anonymous function syntax:"
932− , indent $ foldr1 before $
933− case val of
934− Left l ->
935− [ line "("
936− , prettyPrintValue valueDepth l
937− , line " "
938− , renderOperator op
939− , line " _)"
940− ]
941− Right r ->
942− [ line "(_ "
943− , renderOperator op
944− , line " "
945− , prettyPrintValue valueDepth r
946− , line ")"
947− ]
948− , line "Support for legacy operator sections will be removed in PureScript 0.9."
949− ]
950− where
951− renderOperator (PositionedValue _ _ ex) = renderOperator ex
952− renderOperator (Var (Qualified _ (Op ident))) = line ident
953− renderOperator other = Box.hcat Box.top [ line "`", prettyPrintValue valueDepth other, line "`" ]
954− renderSimpleErrorMessage (DeprecatedQualifiedSyntax name qualName) =
955− paras [ line "Import uses the deprecated 'qualified' syntax:"
956− , indent $ line $ "import qualified " ++ runModuleName name ++ " as " ++ runModuleName qualName
957− , line "Should instead use the form:"
958− , indent $ line $ "import " ++ runModuleName name ++ " as " ++ runModuleName qualName
959− , line "The deprecated syntax will be removed in PureScript 0.9."
960− ]
961−
962− renderSimpleErrorMessage (DeprecatedClassImport mn name) =
963− paras [ line $ "Class import from " ++ runModuleName mn ++ " uses deprecated syntax that omits the 'class' keyword:"
964− , indent $ line $ runProperName name
965− , line "Should instead use the form:"
966− , indent $ line $ "class " ++ runProperName name
967− , line "The deprecated syntax will be removed in PureScript 0.9."
968− ]
969−
970− renderSimpleErrorMessage (DeprecatedClassExport name) =
971− paras [ line "Class export uses deprecated syntax that omits the 'class' keyword:"
972− , indent $ line $ runProperName name
973− , line "Should instead use the form:"
974− , indent $ line $ "class " ++ runProperName name
975− , line "The deprecated syntax will be removed in PureScript 0.9."
976− ]
894+ paras [ line $ "The import of type " ++ markCode (runProperName name) ++ " includes the following unused data constructors:"
895+ , indent $ paras $ map (line . markCode . runProperName) names ]
977896
978897 renderSimpleErrorMessage (DuplicateSelectiveImport name) =
979− line $ "There is an existing import of " ++ runModuleName name ++ ", consider merging the import lists"
898+ line $ "There is an existing import of " ++ markCode (runModuleName name) ++ ", consider merging the import lists"
980899
981900 renderSimpleErrorMessage (DuplicateImport name imp qual) =
982− line $ "Duplicate import of " ++ prettyPrintImport name imp qual
901+ line $ "Duplicate import of " ++ markCode (prettyPrintImport name imp qual)
983902
984− renderSimpleErrorMessage (DuplicateImportRef ref) =
985− line $ "Import list contains multiple references to " ++ ref
903+ renderSimpleErrorMessage (DuplicateImportRef name) =
904+ line $ "Import list contains multiple references to " ++ printName (Qualified Nothing name)
986905
987− renderSimpleErrorMessage (DuplicateExportRef ref) =
988− line $ "Export list contains multiple references to " ++ ref
906+ renderSimpleErrorMessage (DuplicateExportRef name) =
907+ line $ "Export list contains multiple references to " ++ printName (Qualified Nothing name)
989908
990909 renderSimpleErrorMessage (IntOutOfRange value backend lo hi) =
991− paras [ line $ "Integer value " ++ show value ++ " is out of range for the " ++ backend ++ " backend."
992− , line $ "Acceptable values fall within the range " ++ show lo ++ " to " ++ show hi ++ " (inclusive)." ]
993−
994− renderSimpleErrorMessage (RedundantEmptyHidingImport mn) =
995− line $ "The import for module " ++ runModuleName mn ++ " is redundant as all members have been explicitly hidden."
910+ paras [ line $ "Integer value " ++ markCode (show value) ++ " is out of range for the " ++ backend ++ " backend."
911+ , line $ "Acceptable values fall within the range " ++ markCode (show lo) ++ " to " ++ markCode (show hi) ++ " (inclusive)." ]
996912
997913 renderSimpleErrorMessage msg@(ImplicitQualifiedImport importedModule asModule _) =
998− paras [ line $ "Module " ++ runModuleName importedModule ++ " was imported as " ++ runModuleName asModule ++ " with unspecified imports."
999− , line $ "As there are multiple modules being imported as " ++ runModuleName asModule ++ ", consider using the explicit form:"
1000− , indent $ line $ showSuggestion msg
914+ paras [ line $ "Module " ++ markCode (runModuleName importedModule) ++ " was imported as " ++ markCode (runModuleName asModule) ++ " with unspecified imports."
915+ , line $ "As there are multiple modules being imported as " ++ markCode (runModuleName asModule) ++ ", consider using the explicit form:"
916+ , indent $ line $ markCode $ showSuggestion msg
1001917 ]
1002918
1003919 renderSimpleErrorMessage msg@(ImplicitImport mn _) =
1004− paras [ line $ "Module " ++ runModuleName mn ++ " has unspecified imports, consider using the explicit form: "
1005− , indent $ line $ showSuggestion msg
920+ paras [ line $ "Module " ++ markCode (runModuleName mn) ++ " has unspecified imports, consider using the explicit form: "
921+ , indent $ line $ markCode $ showSuggestion msg
1006922 ]
1007923
1008924 renderSimpleErrorMessage msg@(HidingImport mn _) =
1009− paras [ line $ "Module " ++ runModuleName mn ++ " has unspecified imports, consider using the inclusive form: "
1010− , indent $ line $ showSuggestion msg
925+ paras [ line $ "Module " ++ markCode (runModuleName mn) ++ " has unspecified imports, consider using the inclusive form: "
926+ , indent $ line $ markCode $ showSuggestion msg
1011927 ]
1012928
1013929 renderSimpleErrorMessage (CaseBinderLengthDiffers l bs) =
@@ -1020,7 +936,7 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
1020936 line "An anonymous function argument appears in an invalid context."
1021937
1022938 renderSimpleErrorMessage (InvalidOperatorInBinder op fn) =
1023− paras [ line $ "Operator " ++ showIdent op ++ " cannot be used in a pattern as it is an alias for function " ++ showIdent fn ++ "."
939+ paras [ line $ "Operator " ++ markCode (showQualified showOp op) ++ " cannot be used in a pattern as it is an alias for function " ++ showQualified showIdent fn ++ "."
1024940 , line "Only aliases for data constructors may be used in patterns."
1025941 ]
1026942
@@ -1028,9 +944,9 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
1028944 line "The require-path option is deprecated and will be removed in PureScript 0.9."
1029945
1030946 renderSimpleErrorMessage (CannotGeneralizeRecursiveFunction ident ty) =
1031− paras [ line $ "Unable to generalize the type of the recursive function " ++ showIdent ident ++ "."
1032− , line $ "The inferred type of " ++ showIdent ident ++ " was:"
1033− , indent $ typeAsBox ty
947+ paras [ line $ "Unable to generalize the type of the recursive function " ++ markCode (showIdent ident) ++ "."
948+ , line $ "The inferred type of " ++ markCode (showIdent ident) ++ " was:"
949+ , markCodeBox $ indent $ typeAsBox ty
1034950 , line "Try adding a type signature."
1035951 ]
1036952
@@ -1038,42 +954,43 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
1038954 renderHint (ErrorUnifyingTypes t1 t2) detail =
1039955 paras [ detail
1040956 , Box.hsep 1 Box.top [ line "while trying to match type"
1041− , typeAsBox t1
957+ , markCodeBox $ typeAsBox t1
1042958 ]
1043959 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "with type"
1044− , typeAsBox t2
960+ , markCodeBox $ typeAsBox t2
1045961 ]
1046962 ]
1047963 renderHint (ErrorInExpression expr) detail =
1048964 paras [ detail
1049965 , Box.hsep 1 Box.top [ Box.text "in the expression"
1050− , prettyPrintValue valueDepth expr
966+ , markCodeBox $ markCodeBox $ prettyPrintValue valueDepth expr
1051967 ]
1052968 ]
1053969 renderHint (ErrorInModule mn) detail =
1054− paras [ line $ "in module " ++ runModuleName mn
970+ paras [ line $ "in module " ++ markCode (runModuleName mn)
1055971 , detail
1056972 ]
1057973 renderHint (ErrorInSubsumption t1 t2) detail =
1058974 paras [ detail
1059975 , Box.hsep 1 Box.top [ line "while checking that type"
1060− , typeAsBox t1
976+ , markCodeBox $ typeAsBox t1
1061977 ]
1062978 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "is at least as general as type"
1063− , typeAsBox t2
979+ , markCodeBox $ typeAsBox t2
1064980 ]
1065981 ]
1066982 renderHint (ErrorInInstance nm ts) detail =
1067983 paras [ detail
1068− , Box.hsep 1 Box.top [ line "in type class instance"
1069− , line (showQualified runProperName nm)
1070− , Box.vcat Box.left (map typeAtomAsBox ts)
1071− ]
984+ , line "in type class instance"
985+ , markCodeBox $ indent $ Box.hsep 1 Box.top
986+ [ line $ showQualified runProperName nm
987+ , Box.vcat Box.left (map typeAtomAsBox ts)
988+ ]
1072989 ]
1073990 renderHint (ErrorCheckingKind ty) detail =
1074991 paras [ detail
1075992 , Box.hsep 1 Box.top [ line "while checking the kind of"
1076− , typeAsBox ty
993+ , markCodeBox $ typeAsBox ty
1077994 ]
1078995 ]
1079996 renderHint ErrorCheckingGuard detail =
@@ -1083,43 +1000,43 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
10831000 renderHint (ErrorInferringType expr) detail =
10841001 paras [ detail
10851002 , Box.hsep 1 Box.top [ line "while inferring the type of"
1086− , prettyPrintValue valueDepth expr
1003+ , markCodeBox $ prettyPrintValue valueDepth expr
10871004 ]
10881005 ]
10891006 renderHint (ErrorCheckingType expr ty) detail =
10901007 paras [ detail
10911008 , Box.hsep 1 Box.top [ line "while checking that expression"
1092− , prettyPrintValue valueDepth expr
1009+ , markCodeBox $ prettyPrintValue valueDepth expr
10931010 ]
10941011 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "has type"
1095− , typeAsBox ty
1012+ , markCodeBox $ typeAsBox ty
10961013 ]
10971014 ]
10981015 renderHint (ErrorCheckingAccessor expr prop) detail =
10991016 paras [ detail
11001017 , Box.hsep 1 Box.top [ line "while checking type of property accessor"
1101− , prettyPrintValue valueDepth (Accessor prop expr)
1018+ , markCodeBox $ prettyPrintValue valueDepth (Accessor prop expr)
11021019 ]
11031020 ]
11041021 renderHint (ErrorInApplication f t a) detail =
11051022 paras [ detail
11061023 , Box.hsep 1 Box.top [ line "while applying a function"
1107− , prettyPrintValue valueDepth f
1024+ , markCodeBox $ prettyPrintValue valueDepth f
11081025 ]
11091026 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "of type"
1110− , typeAsBox t
1027+ , markCodeBox $ typeAsBox t
11111028 ]
11121029 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "to argument"
1113− , prettyPrintValue valueDepth a
1030+ , markCodeBox $ prettyPrintValue valueDepth a
11141031 ]
11151032 ]
11161033 renderHint (ErrorInDataConstructor nm) detail =
11171034 paras [ detail
1118− , line $ "in data constructor " ++ runProperName nm
1035+ , line $ "in data constructor " ++ markCode (runProperName nm)
11191036 ]
11201037 renderHint (ErrorInTypeConstructor nm) detail =
11211038 paras [ detail
1122− , line $ "in type constructor " ++ runProperName nm
1039+ , line $ "in type constructor " ++ markCode (runProperName nm)
11231040 ]
11241041 renderHint (ErrorInBindingGroup nms) detail =
11251042 paras [ detail
@@ -1131,25 +1048,55 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
11311048 ]
11321049 renderHint (ErrorInTypeSynonym name) detail =
11331050 paras [ detail
1134− , line $ "in type synonym " ++ runProperName name
1051+ , line $ "in type synonym " ++ markCode (runProperName name)
11351052 ]
11361053 renderHint (ErrorInValueDeclaration n) detail =
11371054 paras [ detail
1138− , line $ "in value declaration " ++ showIdent n
1055+ , line $ "in value declaration " ++ markCode (showIdent n)
11391056 ]
11401057 renderHint (ErrorInTypeDeclaration n) detail =
11411058 paras [ detail
1142− , line $ "in type declaration for " ++ showIdent n
1059+ , line $ "in type declaration for " ++ markCode (showIdent n)
11431060 ]
11441061 renderHint (ErrorInForeignImport nm) detail =
11451062 paras [ detail
1146− , line $ "in foreign import " ++ showIdent nm
1063+ , line $ "in foreign import " ++ markCode (showIdent nm)
11471064 ]
11481065 renderHint (PositionedError srcSpan) detail =
11491066 paras [ line $ "at " ++ displaySourceSpan srcSpan
11501067 , detail
11511068 ]
11521069
1070+ printName :: Qualified Name -> String
1071+ printName qn = nameType (disqualify qn) ++ " " ++ markCode (runName qn)
1072+
1073+ nameType :: Name -> String
1074+ nameType (IdentName _) = "value"
1075+ nameType (ValOpName _) = "operator"
1076+ nameType (TyName _) = "type"
1077+ nameType (TyOpName _) = "type operator"
1078+ nameType (DctorName _) = "data constructor"
1079+ nameType (TyClassName _) = "type class"
1080+ nameType (ModName _) = "module"
1081+
1082+ runName :: Qualified Name -> String
1083+ runName (Qualified mn (IdentName name)) =
1084+ showQualified showIdent (Qualified mn name)
1085+ runName (Qualified mn (ValOpName op)) =
1086+ showQualified showOp (Qualified mn op)
1087+ runName (Qualified mn (TyName name)) =
1088+ showQualified runProperName (Qualified mn name)
1089+ runName (Qualified mn (TyOpName op)) =
1090+ showQualified showOp (Qualified mn op)
1091+ runName (Qualified mn (DctorName name)) =
1092+ showQualified runProperName (Qualified mn name)
1093+ runName (Qualified mn (TyClassName name)) =
1094+ showQualified runProperName (Qualified mn name)
1095+ runName (Qualified Nothing (ModName name)) =
1096+ runModuleName name
1097+ runName (Qualified _ ModName{}) =
1098+ internalError "qualified ModName in runName"
1099+
11531100 valueDepth :: Int
11541101 valueDepth | full = 1000
11551102 | otherwise = 3
@@ -1230,10 +1177,10 @@ prettyPrintRef :: DeclarationRef -> String
12301177prettyPrintRef (TypeRef pn Nothing) = runProperName pn ++ "(..)"
12311178prettyPrintRef (TypeRef pn (Just [])) = runProperName pn
12321179prettyPrintRef (TypeRef pn (Just dctors)) = runProperName pn ++ "(" ++ intercalate ", " (map runProperName dctors) ++ ")"
1233−prettyPrintRef (TypeOpRef ident) = "type " ++ showIdent ident
1180+prettyPrintRef (TypeOpRef op) = "type " ++ showOp op
12341181prettyPrintRef (ValueRef ident) = showIdent ident
1182+prettyPrintRef (ValueOpRef op) = showOp op
12351183prettyPrintRef (TypeClassRef pn) = "class " ++ runProperName pn
1236−prettyPrintRef (ProperRef name) = name
12371184prettyPrintRef (TypeInstanceRef ident) = showIdent ident
12381185prettyPrintRef (ModuleRef name) = "module " ++ runModuleName name
12391186prettyPrintRef (PositionedDeclarationRef _ _ ref) = prettyPrintExport ref
@@ -1241,32 +1188,32 @@ prettyPrintRef (PositionedDeclarationRef _ _ ref) = prettyPrintExport ref
12411188-- |
12421189-- Pretty print multiple errors
12431190--
1244−prettyPrintMultipleErrors :: Bool -> MultipleErrors -> String
1245−prettyPrintMultipleErrors full = unlines . map renderBox . prettyPrintMultipleErrorsBox full
1191+prettyPrintMultipleErrors :: PPEOptions -> MultipleErrors -> String
1192+prettyPrintMultipleErrors ppeOptions = unlines . map renderBox . prettyPrintMultipleErrorsBox ppeOptions
12461193
12471194-- |
12481195-- Pretty print multiple warnings
12491196--
1250−prettyPrintMultipleWarnings :: Bool -> MultipleErrors -> String
1251−prettyPrintMultipleWarnings full = unlines . map renderBox . prettyPrintMultipleWarningsBox full
1197+prettyPrintMultipleWarnings :: PPEOptions -> MultipleErrors -> String
1198+prettyPrintMultipleWarnings ppeOptions = unlines . map renderBox . prettyPrintMultipleWarningsBox ppeOptions
12521199
12531200-- | Pretty print warnings as a Box
1254−prettyPrintMultipleWarningsBox :: Bool -> MultipleErrors -> [Box.Box]
1255−prettyPrintMultipleWarningsBox = prettyPrintMultipleErrorsWith Warning "Warning found:" "Warning"
1201+prettyPrintMultipleWarningsBox :: PPEOptions -> MultipleErrors -> [Box.Box]
1202+prettyPrintMultipleWarningsBox ppeOptions = prettyPrintMultipleErrorsWith (ppeOptions { ppeLevel = Warning }) "Warning found:" "Warning"
12561203
12571204-- | Pretty print errors as a Box
1258−prettyPrintMultipleErrorsBox :: Bool -> MultipleErrors -> [Box.Box]
1259−prettyPrintMultipleErrorsBox = prettyPrintMultipleErrorsWith Error "Error found:" "Error"
1205+prettyPrintMultipleErrorsBox :: PPEOptions -> MultipleErrors -> [Box.Box]
1206+prettyPrintMultipleErrorsBox ppeOptions = prettyPrintMultipleErrorsWith (ppeOptions { ppeLevel = Error }) "Error found:" "Error"
12601207
1261−prettyPrintMultipleErrorsWith :: Level -> String -> String -> Bool -> MultipleErrors -> [Box.Box]
1262−prettyPrintMultipleErrorsWith level intro _ full (MultipleErrors [e]) =
1263− let result = prettyPrintSingleError full level True e
1208+prettyPrintMultipleErrorsWith :: PPEOptions -> String -> String -> MultipleErrors -> [Box.Box]
1209+prettyPrintMultipleErrorsWith ppeOptions intro _ (MultipleErrors [e]) =
1210+ let result = prettyPrintSingleError ppeOptions e
12641211 in [ Box.vcat Box.left [ Box.text intro
12651212 , result
12661213 ]
12671214 ]
1268−prettyPrintMultipleErrorsWith level _ intro full (MultipleErrors es) =
1269− let result = map (prettyPrintSingleError full level True) es
1215+prettyPrintMultipleErrorsWith ppeOptions _ intro (MultipleErrors es) =
1216+ let result = map (prettyPrintSingleError ppeOptions) es
12701217 in concat $ zipWith withIntro [1 :: Int ..] result
12711218 where
12721219 withIntro i err = [ Box.text (intro ++ " " ++ show i ++ " of " ++ show (length es) ++ ":")