@@ -1,201 +1,45 @@
1{-# LANGUAGE GeneralizedNewtypeDeriving #-}
1{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2−{-# LANGUAGE FlexibleContexts #-}
2+{-# LANGUAGE NamedFieldPuns #-}
3−{-# LANGUAGE MultiParamTypeClasses #-}
5−module Language.PureScript.Errors where
4+module Language.PureScript.Errors
5+ ( module Language.PureScript.AST
6+ , module Language.PureScript.Errors
8import Prelude.Compat
9import Prelude.Compat
10−import Data.Ord (comparing)
11+import Control.Arrow ((&&&))
13+import Control.Monad.Error.Class (MonadError(..))
14+import Control.Monad.Trans.State.Lazy
15+import Control.Monad.Writer
11import Data.Char (isSpace)
17import Data.Char (isSpace)
12import Data.Either (lefts, rights)
18import Data.Either (lefts, rights)
13−import Data.List (intercalate, transpose, nub, nubBy, sortBy, partition)
14import Data.Foldable (fold)
19import Data.Foldable (fold)
20+import Data.Functor.Identity (Identity(..))
21+import Data.List (intercalate, transpose, nub, nubBy, sortBy, partition)
15−import Data.Maybe (maybeToList)
22+import Data.Maybe (maybeToList, fromMaybe, mapMaybe)
16−
23+import Data.Ord (comparing)
17import qualified Data.Map as M
24import qualified Data.Map as M
20−import Control.Monad.Writer
21−import Control.Monad.Error.Class (MonadError(..))
22−import Control.Monad.Trans.State.Lazy
23−import Control.Arrow ((&&&))
25−import Language.PureScript.Crash
26import Language.PureScript.AST
26import Language.PureScript.AST
27+import Language.PureScript.Crash
28+import Language.PureScript.Names
27import Language.PureScript.Pretty
29import Language.PureScript.Pretty
28−import Language.PureScript.Pretty.Common (before)
30+import Language.PureScript.Traversals
29import Language.PureScript.Types
31import Language.PureScript.Types
30−import Language.PureScript.Names
32+import Language.PureScript.Pretty.Common (endWith)
31−import Language.PureScript.Kinds
32import qualified Language.PureScript.Bundle as Bundle
33import qualified Language.PureScript.Bundle as Bundle
34+import qualified Language.PureScript.Constants as C
34−import qualified Text.PrettyPrint.Boxes as Box
36+import qualified System.Console.ANSI as ANSI
36import qualified Text.Parsec as P
38import qualified Text.Parsec as P
37import qualified Text.Parsec.Error as PE
39import qualified Text.Parsec.Error as PE
40+import qualified Text.PrettyPrint.Boxes as Box
38import Text.Parsec.Error (Message(..))
41import Text.Parsec.Error (Message(..))
40−-- | A type of error messages
41−data SimpleErrorMessage
42− = ErrorParsingFFIModule FilePath (Maybe Bundle.ErrorMessage)
43− | ErrorParsingModule P.ParseError
44− | MissingFFIModule ModuleName
45− | MultipleFFIModules ModuleName [FilePath]
46− | UnnecessaryFFIModule ModuleName FilePath
47− | MissingFFIImplementations ModuleName [Ident]
48− | UnusedFFIImplementations ModuleName [Ident]
49− | InvalidFFIIdentifier ModuleName String
50− | CannotGetFileInfo FilePath
51− | CannotReadFile FilePath
52− | CannotWriteFile FilePath
55− | MultipleFixities Ident
56− | OrphanTypeDeclaration Ident
57− | OrphanFixityDeclaration String
58− | RedefinedModule ModuleName [SourceSpan]
59− | RedefinedIdent Ident
60− | 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
77− | UnknownImportDataConstructor ModuleName (ProperName 'TypeName) (ProperName 'ConstructorName)
78− | 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)
87− | DuplicateModuleName ModuleName
88− | DuplicateClassExport (ProperName 'ClassName)
89− | DuplicateValueExport Ident
90− | DuplicateTypeOpExport Ident
91− | DuplicateTypeArgument String
94− | CycleInDeclaration Ident
95− | CycleInTypeSynonym (Maybe (ProperName 'TypeName))
96− | CycleInModules [ModuleName]
97− | NameIsUndefined Ident
98− | UndefinedTypeVariable (ProperName 'TypeName)
99− | PartiallyAppliedSynonym (Qualified (ProperName 'TypeName))
100− | EscapedSkolem (Maybe Expr)
101− | TypesDoNotUnify Type Type
102− | KindsDoNotUnify Kind Kind
103− | ConstrainedTypeUnified Type Type
104− | OverlappingInstances (Qualified (ProperName 'ClassName)) [Type] [Qualified Ident]
105− | NoInstanceFound (Qualified (ProperName 'ClassName)) [Type]
106− | PossiblyInfiniteInstance (Qualified (ProperName 'ClassName)) [Type]
107− | CannotDerive (Qualified (ProperName 'ClassName)) [Type]
108− | CannotFindDerivingType (ProperName 'TypeName)
109− | DuplicateLabel String (Maybe Expr)
110− | DuplicateValueDeclaration Ident
111− | ArgListLengthsDiffer Ident
112− | OverlappingArgNames (Maybe Ident)
113− | MissingClassMember Ident
114− | ExtraneousClassMember Ident (Qualified (ProperName 'ClassName))
115− | ExpectedType Type Kind
116− | IncorrectConstructorArity (Qualified (ProperName 'ConstructorName))
117− | ExprDoesNotHaveType Expr Type
118− | PropertyIsMissing String
119− | AdditionalProperty String
120− | CannotApplyFunction Type Expr
121− | TypeSynonymInstance
122− | OrphanInstance Ident (Qualified (ProperName 'ClassName)) [Type]
123− | InvalidNewtype (ProperName 'TypeName)
124− | InvalidInstanceHead Type
125− | TransitiveExportError DeclarationRef [DeclarationRef]
126− | TransitiveDctorExportError DeclarationRef (ProperName 'ConstructorName)
127− | ShadowedName Ident
128− | ShadowedTypeVar String
129− | UnusedTypeVar String
130− | WildcardInferredType Type
131− | HoleInferredType String Type
132− | MissingTypeDeclaration Ident Type
133− | NotExhaustivePattern [[Binder]] Bool
134− | OverlappingPattern [[Binder]] Bool
135− | IncompleteExhaustivityCheck
136− | ClassOperator (ProperName 'ClassName) Ident
137− | MisleadingEmptyTypeImport ModuleName (ProperName 'TypeName)
138− | ImportHidingModule ModuleName
139− | UnusedImport ModuleName
140− | UnusedExplicitImport ModuleName [String] (Maybe ModuleName) [DeclarationRef]
141− | UnusedDctorImport (ProperName 'TypeName)
142− | 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)
148− | DuplicateSelectiveImport ModuleName
149− | DuplicateImport ModuleName ImportDeclarationType (Maybe ModuleName)
150− | DuplicateImportRef String
151− | DuplicateExportRef String
152− | IntOutOfRange Integer String Integer Integer
153− | RedundantEmptyHidingImport ModuleName
154− | ImplicitQualifiedImport ModuleName ModuleName [DeclarationRef]
155− | ImplicitImport ModuleName [DeclarationRef]
156− | HidingImport ModuleName [DeclarationRef]
157− | CaseBinderLengthDiffers Int [Binder]
158− | IncorrectAnonymousArgument
159− | InvalidOperatorInBinder Ident Ident
160− | DeprecatedRequirePath
161− | CannotGeneralizeRecursiveFunction Ident Type
164−-- | Error message hints, providing more detailed information about failure.
165−data ErrorMessageHint
166− = ErrorUnifyingTypes Type Type
167− | ErrorInExpression Expr
168− | ErrorInModule ModuleName
169− | ErrorInInstance (Qualified (ProperName 'ClassName)) [Type]
170− | ErrorInSubsumption Type Type
171− | ErrorCheckingAccessor Expr String
172− | ErrorCheckingType Expr Type
173− | ErrorCheckingKind Type
174− | ErrorCheckingGuard
175− | ErrorInferringType Expr
176− | ErrorInApplication Expr Type Expr
177− | ErrorInDataConstructor (ProperName 'ConstructorName)
178− | ErrorInTypeConstructor (ProperName 'TypeName)
179− | ErrorInBindingGroup [Ident]
180− | ErrorInDataBindingGroup
181− | ErrorInTypeSynonym (ProperName 'TypeName)
182− | ErrorInValueDeclaration Ident
183− | ErrorInTypeDeclaration Ident
184− | ErrorInForeignImport Ident
185− | PositionedError SourceSpan
188−-- | Categories of hints
197−data ErrorMessage = ErrorMessage [ErrorMessageHint] SimpleErrorMessage deriving (Show)
199newtype ErrorSuggestion = ErrorSuggestion String
43newtype ErrorSuggestion = ErrorSuggestion String
201-- | Get the source span for an error
45-- | Get the source span for an error
@@ -241,42 +85,22 @@ errorCode em = case unwrapErrorMessage em of
241 CannotWriteFile{} -> "CannotWriteFile"
85 CannotWriteFile{} -> "CannotWriteFile"
242 InfiniteType{} -> "InfiniteType"
86 InfiniteType{} -> "InfiniteType"
243 InfiniteKind{} -> "InfiniteKind"
87 InfiniteKind{} -> "InfiniteKind"
244− MultipleFixities{} -> "MultipleFixities"
88+ MultipleValueOpFixities{} -> "MultipleValueOpFixities"
89+ MultipleTypeOpFixities{} -> "MultipleTypeOpFixities"
245 OrphanTypeDeclaration{} -> "OrphanTypeDeclaration"
90 OrphanTypeDeclaration{} -> "OrphanTypeDeclaration"
246− OrphanFixityDeclaration{} -> "OrphanFixityDeclaration"
247 RedefinedModule{} -> "RedefinedModule"
91 RedefinedModule{} -> "RedefinedModule"
248 RedefinedIdent{} -> "RedefinedIdent"
92 RedefinedIdent{} -> "RedefinedIdent"
249 OverlappingNamesInLet -> "OverlappingNamesInLet"
93 OverlappingNamesInLet -> "OverlappingNamesInLet"
250− UnknownModule{} -> "UnknownModule"
94+ UnknownName{} -> "UnknownName"
251− UnknownType{} -> "UnknownType"
95+ UnknownImport{} -> "UnknownImport"
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"
266 UnknownImportDataConstructor{} -> "UnknownImportDataConstructor"
96 UnknownImportDataConstructor{} -> "UnknownImportDataConstructor"
97+ UnknownExport{} -> "UnknownExport"
267 UnknownExportDataConstructor{} -> "UnknownExportDataConstructor"
98 UnknownExportDataConstructor{} -> "UnknownExportDataConstructor"
268 ScopeConflict{} -> "ScopeConflict"
99 ScopeConflict{} -> "ScopeConflict"
269 ScopeShadowing{} -> "ScopeShadowing"
100 ScopeShadowing{} -> "ScopeShadowing"
270− ConflictingTypeDecls{} -> "ConflictingTypeDecls"
101+ DeclConflict{} -> "DeclConflict"
271− ConflictingCtorDecls{} -> "ConflictingCtorDecls"
102+ ExportConflict{} -> "ExportConflict"
272− TypeConflictsWithClass{} -> "TypeConflictsWithClass"
273− CtorConflictsWithClass{} -> "CtorConflictsWithClass"
274− ClassConflictsWithType{} -> "ClassConflictsWithType"
275− ClassConflictsWithCtor{} -> "ClassConflictsWithCtor"
276 DuplicateModuleName{} -> "DuplicateModuleName"
103 DuplicateModuleName{} -> "DuplicateModuleName"
277− DuplicateClassExport{} -> "DuplicateClassExport"
278− DuplicateValueExport{} -> "DuplicateValueExport"
279− DuplicateTypeOpExport{} -> "DuplicateTypeOpExport"
280 DuplicateTypeArgument{} -> "DuplicateTypeArgument"
104 DuplicateTypeArgument{} -> "DuplicateTypeArgument"
281 InvalidDoBind -> "InvalidDoBind"
105 InvalidDoBind -> "InvalidDoBind"
282 InvalidDoLet -> "InvalidDoLet"
106 InvalidDoLet -> "InvalidDoLet"
@@ -319,27 +143,19 @@ errorCode em = case unwrapErrorMessage em of
319 WildcardInferredType{} -> "WildcardInferredType"
143 WildcardInferredType{} -> "WildcardInferredType"
320 HoleInferredType{} -> "HoleInferredType"
144 HoleInferredType{} -> "HoleInferredType"
321 MissingTypeDeclaration{} -> "MissingTypeDeclaration"
145 MissingTypeDeclaration{} -> "MissingTypeDeclaration"
322− NotExhaustivePattern{} -> "NotExhaustivePattern"
323 OverlappingPattern{} -> "OverlappingPattern"
146 OverlappingPattern{} -> "OverlappingPattern"
324 IncompleteExhaustivityCheck{} -> "IncompleteExhaustivityCheck"
147 IncompleteExhaustivityCheck{} -> "IncompleteExhaustivityCheck"
325− ClassOperator{} -> "ClassOperator"
326 MisleadingEmptyTypeImport{} -> "MisleadingEmptyTypeImport"
148 MisleadingEmptyTypeImport{} -> "MisleadingEmptyTypeImport"
327 ImportHidingModule{} -> "ImportHidingModule"
149 ImportHidingModule{} -> "ImportHidingModule"
328 UnusedImport{} -> "UnusedImport"
150 UnusedImport{} -> "UnusedImport"
329 UnusedExplicitImport{} -> "UnusedExplicitImport"
151 UnusedExplicitImport{} -> "UnusedExplicitImport"
330 UnusedDctorImport{} -> "UnusedDctorImport"
152 UnusedDctorImport{} -> "UnusedDctorImport"
331 UnusedDctorExplicitImport{} -> "UnusedDctorExplicitImport"
153 UnusedDctorExplicitImport{} -> "UnusedDctorExplicitImport"
332− DeprecatedOperatorDecl{} -> "DeprecatedOperatorDecl"
333− DeprecatedOperatorSection{} -> "DeprecatedOperatorSection"
334− DeprecatedQualifiedSyntax{} -> "DeprecatedQualifiedSyntax"
335− DeprecatedClassImport{} -> "DeprecatedClassImport"
336− DeprecatedClassExport{} -> "DeprecatedClassExport"
337 DuplicateSelectiveImport{} -> "DuplicateSelectiveImport"
154 DuplicateSelectiveImport{} -> "DuplicateSelectiveImport"
338 DuplicateImport{} -> "DuplicateImport"
155 DuplicateImport{} -> "DuplicateImport"
339 DuplicateImportRef{} -> "DuplicateImportRef"
156 DuplicateImportRef{} -> "DuplicateImportRef"
340 DuplicateExportRef{} -> "DuplicateExportRef"
157 DuplicateExportRef{} -> "DuplicateExportRef"
341 IntOutOfRange{} -> "IntOutOfRange"
158 IntOutOfRange{} -> "IntOutOfRange"
342− RedundantEmptyHidingImport{} -> "RedundantEmptyHidingImport"
343 ImplicitQualifiedImport{} -> "ImplicitQualifiedImport"
159 ImplicitQualifiedImport{} -> "ImplicitQualifiedImport"
344 ImplicitImport{} -> "ImplicitImport"
160 ImplicitImport{} -> "ImplicitImport"
345 HidingImport{} -> "HidingImport"
161 HidingImport{} -> "HidingImport"
@@ -377,18 +193,25 @@ onErrorMessages f = MultipleErrors . map f . runMultipleErrors
378-- | Add a hint to an error message
194-- | Add a hint to an error message
379addHint :: ErrorMessageHint -> MultipleErrors -> MultipleErrors
195addHint :: ErrorMessageHint -> MultipleErrors -> MultipleErrors
196+addHint hint = addHints [hint]
198+-- | Add hints to an error message
199+addHints :: [ErrorMessageHint] -> MultipleErrors -> MultipleErrors
380−addHint hint = onErrorMessages $ \(ErrorMessage hints se) -> ErrorMessage (hint : hints) se
200+addHints hints = onErrorMessages $ \(ErrorMessage hints' se) -> ErrorMessage (hints ++ hints') se
382-- | A map from rigid type variable name/unknown variable pairs to new variables.
202-- | A map from rigid type variable name/unknown variable pairs to new variables.
383data TypeMap = TypeMap
203data TypeMap = TypeMap
384− { umSkolemMap :: M.Map Int (String, Int, Maybe SourceSpan)
204+ { umSkolemMap :: M.Map Int (String, Int, Maybe SourceSpan)
385− , umNextSkolem :: Int
205+ -- ^ a map from skolems to their new names, including source and naming info
386− , umUnknownMap :: M.Map Int Int
206+ , umUnknownMap :: M.Map Int Int
387− , umNextUnknown :: Int
207+ -- ^ a map from unification variables to their new names
208+ , umNextIndex :: Int
209+ -- ^ unknowns and skolems share a source of names during renaming, to
210+ -- avoid overlaps in error messages. This is the next label for either case.
388 } deriving Show
211 } deriving Show
390defaultUnknownMap :: TypeMap
213defaultUnknownMap :: TypeMap
391−defaultUnknownMap = TypeMap M.empty 0 M.empty 0
214+defaultUnknownMap = TypeMap M.empty M.empty 0
393-- | How critical the issue is
216-- | How critical the issue is
394data Level = Error | Warning deriving Show
217data Level = Error | Warning deriving Show
@@ -407,21 +230,24 @@ replaceUnknowns = everywhereOnTypesM replaceTypes
408 case M.lookup u (umUnknownMap m) of
231 case M.lookup u (umUnknownMap m) of
409 Nothing -> do
232 Nothing -> do
410− let u' = umNextUnknown m
233+ let u' = umNextIndex m
411− put $ m { umUnknownMap = M.insert u u' (umUnknownMap m), umNextUnknown = u' + 1 }
234+ put $ m { umUnknownMap = M.insert u u' (umUnknownMap m), umNextIndex = u' + 1 }
412 return (TUnknown u')
235 return (TUnknown u')
413 Just u' -> return (TUnknown u')
236 Just u' -> return (TUnknown u')
414 replaceTypes (Skolem name s sko ss) = do
237 replaceTypes (Skolem name s sko ss) = do
416 case M.lookup s (umSkolemMap m) of
239 case M.lookup s (umSkolemMap m) of
417 Nothing -> do
240 Nothing -> do
418− let s' = umNextSkolem m
241+ let s' = umNextIndex m
419− put $ m { umSkolemMap = M.insert s (name, s', ss) (umSkolemMap m), umNextSkolem = s' + 1 }
242+ put $ m { umSkolemMap = M.insert s (name, s', ss) (umSkolemMap m), umNextIndex = s' + 1 }
420 return (Skolem name s' sko ss)
243 return (Skolem name s' sko ss)
421 Just (_, s', _) -> return (Skolem name s' sko ss)
244 Just (_, s', _) -> return (Skolem name s' sko ss)
422 replaceTypes other = return other
245 replaceTypes other = return other
247+onTypesInErrorMessage :: (Type -> Type) -> ErrorMessage -> ErrorMessage
248+onTypesInErrorMessage f = runIdentity . onTypesInErrorMessageM (Identity . f)
424−onTypesInErrorMessageM :: (Applicative m) => (Type -> m Type) -> ErrorMessage -> m ErrorMessage
250+onTypesInErrorMessageM :: Applicative m => (Type -> m Type) -> ErrorMessage -> m ErrorMessage
425onTypesInErrorMessageM f (ErrorMessage hints simple) = ErrorMessage <$> traverse gHint hints <*> gSimple simple
251onTypesInErrorMessageM f (ErrorMessage hints simple) = ErrorMessage <$> traverse gHint hints <*> gSimple simple
427 gSimple (InfiniteType t) = InfiniteType <$> f t
253 gSimple (InfiniteType t) = InfiniteType <$> f t
@@ -430,17 +256,16 @@ onTypesInErrorMessageM f (ErrorMessage hints simple) = ErrorMessage <$> traverse
430 gSimple (ExprDoesNotHaveType e t) = ExprDoesNotHaveType e <$> f t
256 gSimple (ExprDoesNotHaveType e t) = ExprDoesNotHaveType e <$> f t
431 gSimple (CannotApplyFunction t e) = CannotApplyFunction <$> f t <*> pure e
257 gSimple (CannotApplyFunction t e) = CannotApplyFunction <$> f t <*> pure e
432 gSimple (InvalidInstanceHead t) = InvalidInstanceHead <$> f t
258 gSimple (InvalidInstanceHead t) = InvalidInstanceHead <$> f t
433− gSimple (NoInstanceFound cl ts) = NoInstanceFound cl <$> traverse f ts
259+ gSimple (NoInstanceFound con) = NoInstanceFound <$> overConstraintArgs (traverse f) con
434 gSimple (OverlappingInstances cl ts insts) = OverlappingInstances cl <$> traverse f ts <*> pure insts
260 gSimple (OverlappingInstances cl ts insts) = OverlappingInstances cl <$> traverse f ts <*> pure insts
435 gSimple (PossiblyInfiniteInstance cl ts) = PossiblyInfiniteInstance cl <$> traverse f ts
261 gSimple (PossiblyInfiniteInstance cl ts) = PossiblyInfiniteInstance cl <$> traverse f ts
436 gSimple (CannotDerive cl ts) = CannotDerive cl <$> traverse f ts
262 gSimple (CannotDerive cl ts) = CannotDerive cl <$> traverse f ts
437 gSimple (ExpectedType ty k) = ExpectedType <$> f ty <*> pure k
263 gSimple (ExpectedType ty k) = ExpectedType <$> f ty <*> pure k
438 gSimple (OrphanInstance nm cl ts) = OrphanInstance nm cl <$> traverse f ts
264 gSimple (OrphanInstance nm cl ts) = OrphanInstance nm cl <$> traverse f ts
439− gSimple (WildcardInferredType ty) = WildcardInferredType <$> f ty
265+ gSimple (WildcardInferredType ty ctx) = WildcardInferredType <$> f ty <*> traverse (sndM f) ctx
440− gSimple (HoleInferredType name ty) = HoleInferredType name <$> f ty
266+ gSimple (HoleInferredType name ty ctx) = HoleInferredType name <$> f ty <*> traverse (sndM f) ctx
441 gSimple (MissingTypeDeclaration nm ty) = MissingTypeDeclaration nm <$> f ty
267 gSimple (MissingTypeDeclaration nm ty) = MissingTypeDeclaration nm <$> f ty
442 gSimple (CannotGeneralizeRecursiveFunction nm ty) = CannotGeneralizeRecursiveFunction nm <$> f ty
268 gSimple (CannotGeneralizeRecursiveFunction nm ty) = CannotGeneralizeRecursiveFunction nm <$> f ty
444 gSimple other = pure other
269 gSimple other = pure other
446 gHint (ErrorInSubsumption t1 t2) = ErrorInSubsumption <$> f t1 <*> f t2
271 gHint (ErrorInSubsumption t1 t2) = ErrorInSubsumption <$> f t1 <*> f t2
@@ -449,6 +274,7 @@ onTypesInErrorMessageM f (ErrorMessage hints simple) = ErrorMessage <$> traverse
449 gHint (ErrorCheckingKind t) = ErrorCheckingKind <$> f t
274 gHint (ErrorCheckingKind t) = ErrorCheckingKind <$> f t
450 gHint (ErrorInApplication e1 t1 e2) = ErrorInApplication e1 <$> f t1 <*> pure e2
275 gHint (ErrorInApplication e1 t1 e2) = ErrorInApplication e1 <$> f t1 <*> pure e2
451 gHint (ErrorInInstance cl ts) = ErrorInInstance cl <$> traverse f ts
276 gHint (ErrorInInstance cl ts) = ErrorInInstance cl <$> traverse f ts
277+ gHint (ErrorSolvingConstraint con) = ErrorSolvingConstraint <$> overConstraintArgs (traverse f) con
452 gHint other = pure other
278 gHint other = pure other
454wikiUri :: ErrorMessage -> String
280wikiUri :: ErrorMessage -> String
@@ -457,18 +283,16 @@ wikiUri e = "https://github.com/purescript/purescript/wiki/Error-Code-" ++ error
457-- TODO Other possible suggestions:
283-- TODO Other possible suggestions:
458-- WildcardInferredType - source span not small enough
284-- WildcardInferredType - source span not small enough
459-- DuplicateSelectiveImport - would require 2 ranges to remove and 1 insert
285-- DuplicateSelectiveImport - would require 2 ranges to remove and 1 insert
460−-- DeprecatedClassExport, DeprecatedClassImport, DeprecatedOperatorSection, would want to replace smaller span?
461errorSuggestion :: SimpleErrorMessage -> Maybe ErrorSuggestion
286errorSuggestion :: SimpleErrorMessage -> Maybe ErrorSuggestion
462errorSuggestion err = case err of
287errorSuggestion err = case err of
463 UnusedImport{} -> emptySuggestion
288 UnusedImport{} -> emptySuggestion
464− RedundantEmptyHidingImport{} -> emptySuggestion
465 DuplicateImport{} -> emptySuggestion
289 DuplicateImport{} -> emptySuggestion
466− DeprecatedQualifiedSyntax name qualName -> suggest $
467− "import " ++ runModuleName name ++ " as " ++ runModuleName qualName
468 UnusedExplicitImport mn _ qual refs -> suggest $ importSuggestion mn refs qual
290 UnusedExplicitImport mn _ qual refs -> suggest $ importSuggestion mn refs qual
469 ImplicitImport mn refs -> suggest $ importSuggestion mn refs Nothing
291 ImplicitImport mn refs -> suggest $ importSuggestion mn refs Nothing
470 ImplicitQualifiedImport mn asModule refs -> suggest $ importSuggestion mn refs (Just asModule)
292 ImplicitQualifiedImport mn asModule refs -> suggest $ importSuggestion mn refs (Just asModule)
471 HidingImport mn refs -> suggest $ importSuggestion mn refs Nothing
293 HidingImport mn refs -> suggest $ importSuggestion mn refs Nothing
294+ MissingTypeDeclaration ident ty -> suggest $ showIdent ident ++ " :: " ++ prettyPrintType ty
295+ WildcardInferredType ty _ -> suggest $ prettyPrintType ty
472 _ -> Nothing
296 _ -> Nothing
@@ -477,26 +301,87 @@ errorSuggestion err = case err of
478 importSuggestion :: ModuleName -> [ DeclarationRef ] -> Maybe ModuleName -> String
302 importSuggestion :: ModuleName -> [ DeclarationRef ] -> Maybe ModuleName -> String
479 importSuggestion mn refs qual =
303 importSuggestion mn refs qual =
480− "import " ++ runModuleName mn ++ " (" ++ intercalate ", " (map prettyPrintRef refs) ++ ")" ++ qstr qual
304+ "import " ++ runModuleName mn ++ " (" ++ intercalate ", " (mapMaybe prettyPrintRef refs) ++ ")" ++ qstr qual
482 qstr :: Maybe ModuleName -> String
306 qstr :: Maybe ModuleName -> String
483 qstr (Just mn) = " as " ++ runModuleName mn
307 qstr (Just mn) = " as " ++ runModuleName mn
484 qstr Nothing = ""
308 qstr Nothing = ""
310+suggestionSpan :: ErrorMessage -> Maybe SourceSpan
312+ getSpan (unwrapErrorMessage e) <$> errorSpan e
314+ startOnly SourceSpan{spanName, spanStart} = SourceSpan {spanName, spanStart, spanEnd = spanStart}
318+ MissingTypeDeclaration{} -> startOnly ss
486showSuggestion :: SimpleErrorMessage -> String
321showSuggestion :: SimpleErrorMessage -> String
487showSuggestion suggestion = case errorSuggestion suggestion of
322showSuggestion suggestion = case errorSuggestion suggestion of
488 Just (ErrorSuggestion x) -> x
323 Just (ErrorSuggestion x) -> x
326+ansiColor :: (ANSI.ColorIntensity, ANSI.Color) -> String
327+ansiColor (intesity, color) =
328+ ANSI.setSGRCode [ANSI.SetColor ANSI.Foreground intesity color]
330+ansiColorReset :: String
332+ ANSI.setSGRCode [ANSI.Reset]
334+colorCode :: Maybe (ANSI.ColorIntensity, ANSI.Color) -> String -> String
335+colorCode codeColor code = case codeColor of
337+ Just cc -> concat [ansiColor cc, code, ansiColorReset]
339+colorCodeBox :: Maybe (ANSI.ColorIntensity, ANSI.Color) -> Box.Box -> Box.Box
340+colorCodeBox codeColor b = case codeColor of
343+ | Box.rows b == 1 ->
344+ Box.text (ansiColor cc) Box.<> b `endWith` Box.text ansiColorReset
346+ | 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
347+ [ Box.vcat Box.top $ replicate (Box.rows b) $ Box.text $ ansiColor cc
349+ , Box.vcat Box.top $ replicate (Box.rows b) $ Box.text ansiColorReset
353+-- | Default color intesity and color for code
354+defaultCodeColor :: (ANSI.ColorIntensity, ANSI.Color)
355+defaultCodeColor = (ANSI.Dull, ANSI.Yellow)
357+-- | `prettyPrintSingleError` Options
358+data PPEOptions = PPEOptions
359+ { ppeCodeColor :: Maybe (ANSI.ColorIntensity, ANSI.Color) -- ^ Color code with this color... or not
360+ , ppeFull :: Bool -- ^ Should write a full error message?
361+ , ppeLevel :: Level -- ^ Should this report an error or a warning?
362+ , ppeShowWiki :: Bool -- ^ Should show a link to error message's wiki page?
365+-- | Default options for PPEOptions
366+defaultPPEOptions :: PPEOptions
367+defaultPPEOptions = PPEOptions
368+ { ppeCodeColor = Just defaultCodeColor
371+ , ppeShowWiki = True
492-- Pretty print a single error, simplifying if necessary
376-- Pretty print a single error, simplifying if necessary
494−prettyPrintSingleError :: Bool -> Level -> Bool -> ErrorMessage -> Box.Box
378+prettyPrintSingleError :: PPEOptions -> ErrorMessage -> Box.Box
495−prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap $ do
379+prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalState defaultUnknownMap $ do
496 em <- onTypesInErrorMessageM replaceUnknowns (if full then e else simplifyErrorMessage e)
380 em <- onTypesInErrorMessageM replaceUnknowns (if full then e else simplifyErrorMessage e)
497 um <- get
381 um <- get
498 return (prettyPrintErrorMessage um em)
382 return (prettyPrintErrorMessage um em)
384+ (markCode, markCodeBox) = (colorCode &&& colorCodeBox) codeColor
501 -- Pretty print an ErrorMessage
386 -- Pretty print an ErrorMessage
502 prettyPrintErrorMessage :: TypeMap -> ErrorMessage -> Box.Box
387 prettyPrintErrorMessage :: TypeMap -> ErrorMessage -> Box.Box
@@ -505,9 +390,10 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
505 [ foldr renderHint (indent (renderSimpleErrorMessage simple)) hints
390 [ foldr renderHint (indent (renderSimpleErrorMessage simple)) hints
507 maybe [] (return . Box.moveDown 1) typeInformation ++
392 maybe [] (return . Box.moveDown 1) typeInformation ++
393+ [ Box.moveDown 1 $ paras
508− [ Box.moveDown 1 $ paras [ line $ "See " ++ wikiUri e ++ " for more information, "
394+ [ line $ "See " ++ wikiUri e ++ " for more information, "
509− , line $ "or to contribute content related to this " ++ levelText ++ "."
395+ , line $ "or to contribute content related to this " ++ levelText ++ "."
511 | showWiki
397 | showWiki
@@ -522,11 +408,11 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
522 skolemInfo :: (String, Int, Maybe SourceSpan) -> Box.Box
408 skolemInfo :: (String, Int, Maybe SourceSpan) -> Box.Box
523 skolemInfo (name, s, ss) =
409 skolemInfo (name, s, ss) =
525− line (name ++ show s ++ " is a rigid type variable")
411+ line (markCode (name ++ show s) ++ " is a rigid type variable")
526 : foldMap (return . line . (" bound at " ++) . displayStartEndPos) ss
412 : foldMap (return . line . (" bound at " ++) . displayStartEndPos) ss
528 unknownInfo :: Int -> Box.Box
414 unknownInfo :: Int -> Box.Box
529− unknownInfo u = line $ "_" ++ show u ++ " is an unknown type"
415+ unknownInfo u = line $ markCode ("t" ++ show u) ++ " is an unknown type"
531 renderSimpleErrorMessage :: SimpleErrorMessage -> Box.Box
417 renderSimpleErrorMessage :: SimpleErrorMessage -> Box.Box
532 renderSimpleErrorMessage (CannotGetFileInfo path) =
418 renderSimpleErrorMessage (CannotGetFileInfo path) =
@@ -545,35 +431,35 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
545 paras $ [ line "Unable to parse foreign module:"
431 paras $ [ line "Unable to parse foreign module:"
546 , indent . line $ path
432 , indent . line $ path
548− (map (indent . line) (concatMap Bundle.printErrorMessage (maybeToList extra)))
434+ map (indent . line) (concatMap Bundle.printErrorMessage (maybeToList extra))
549 renderSimpleErrorMessage (ErrorParsingModule err) =
435 renderSimpleErrorMessage (ErrorParsingModule err) =
550 paras [ line "Unable to parse module: "
436 paras [ line "Unable to parse module: "
551 , prettyPrintParseError err
437 , prettyPrintParseError err
553 renderSimpleErrorMessage (MissingFFIModule mn) =
439 renderSimpleErrorMessage (MissingFFIModule mn) =
554− line $ "The foreign module implementation for module " ++ runModuleName mn ++ " is missing."
440+ line $ "The foreign module implementation for module " ++ markCode (runModuleName mn) ++ " is missing."
555 renderSimpleErrorMessage (UnnecessaryFFIModule mn path) =
441 renderSimpleErrorMessage (UnnecessaryFFIModule mn path) =
556− paras [ line $ "An unnecessary foreign module implementation was provided for module " ++ runModuleName mn ++ ": "
442+ paras [ line $ "An unnecessary foreign module implementation was provided for module " ++ markCode (runModuleName mn) ++ ": "
557 , indent . line $ path
443 , indent . line $ path
558− , line $ "Module " ++ runModuleName mn ++ " does not contain any foreign import declarations, so a foreign module is not necessary."
444+ , line $ "Module " ++ markCode (runModuleName mn) ++ " does not contain any foreign import declarations, so a foreign module is not necessary."
560 renderSimpleErrorMessage (MissingFFIImplementations mn idents) =
446 renderSimpleErrorMessage (MissingFFIImplementations mn idents) =
561− paras [ line $ "The following values are not defined in the foreign module for module " ++ runModuleName mn ++ ": "
447+ paras [ line $ "The following values are not defined in the foreign module for module " ++ markCode (runModuleName mn) ++ ": "
562 , indent . paras $ map (line . runIdent) idents
448 , indent . paras $ map (line . runIdent) idents
564 renderSimpleErrorMessage (UnusedFFIImplementations mn idents) =
450 renderSimpleErrorMessage (UnusedFFIImplementations mn idents) =
565− paras [ line $ "The following definitions in the foreign module for module " ++ runModuleName mn ++ " are unused: "
451+ paras [ line $ "The following definitions in the foreign module for module " ++ markCode (runModuleName mn) ++ " are unused: "
566 , indent . paras $ map (line . runIdent) idents
452 , indent . paras $ map (line . runIdent) idents
568 renderSimpleErrorMessage (InvalidFFIIdentifier mn ident) =
454 renderSimpleErrorMessage (InvalidFFIIdentifier mn ident) =
569− paras [ line $ "In the FFI module for " ++ runModuleName mn ++ ":"
455+ paras [ line $ "In the FFI module for " ++ markCode (runModuleName mn) ++ ":"
570 , indent . paras $
456 , indent . paras $
571− [ line $ "The identifier `" ++ ident ++ "` is not valid in PureScript."
457+ [ line $ "The identifier " ++ markCode ident ++ " is not valid in PureScript."
572 , line "Note that exported identifiers in FFI modules must be valid PureScript identifiers."
458 , line "Note that exported identifiers in FFI modules must be valid PureScript identifiers."
575 renderSimpleErrorMessage (MultipleFFIModules mn paths) =
461 renderSimpleErrorMessage (MultipleFFIModules mn paths) =
576− paras [ line $ "Multiple foreign module implementations have been provided for module " ++ runModuleName mn ++ ": "
462+ paras [ line $ "Multiple foreign module implementations have been provided for module " ++ markCode (runModuleName mn) ++ ": "
577 , indent . paras $ map line paths
463 , indent . paras $ map line paths
579 renderSimpleErrorMessage InvalidDoBind =
465 renderSimpleErrorMessage InvalidDoBind =
@@ -584,126 +470,78 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
584 line "The same name was used more than once in a let binding."
470 line "The same name was used more than once in a let binding."
585 renderSimpleErrorMessage (InfiniteType ty) =
471 renderSimpleErrorMessage (InfiniteType ty) =
586 paras [ line "An infinite type was inferred for an expression: "
472 paras [ line "An infinite type was inferred for an expression: "
587− , indent $ typeAsBox ty
473+ , markCodeBox $ indent $ typeAsBox ty
589 renderSimpleErrorMessage (InfiniteKind ki) =
475 renderSimpleErrorMessage (InfiniteKind ki) =
590 paras [ line "An infinite kind was inferred for a type: "
476 paras [ line "An infinite kind was inferred for a type: "
591− , indent $ line $ prettyPrintKind ki
477+ , indent $ line $ markCode $ prettyPrintKind ki
593− renderSimpleErrorMessage (MultipleFixities name) =
479+ renderSimpleErrorMessage (MultipleValueOpFixities op) =
594− line $ "There are multiple fixity/precedence declarations for " ++ showIdent name
480+ line $ "There are multiple fixity/precedence declarations for operator " ++ markCode (showOp op)
481+ renderSimpleErrorMessage (MultipleTypeOpFixities op) =
482+ line $ "There are multiple fixity/precedence declarations for type operator " ++ markCode (showOp op)
595 renderSimpleErrorMessage (OrphanTypeDeclaration nm) =
483 renderSimpleErrorMessage (OrphanTypeDeclaration nm) =
596− line $ "The type declaration for " ++ showIdent nm ++ " should be followed by its definition."
484+ line $ "The type declaration for " ++ markCode (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."
599 renderSimpleErrorMessage (RedefinedModule name filenames) =
485 renderSimpleErrorMessage (RedefinedModule name filenames) =
600− paras [ line ("The module " ++ runModuleName name ++ " has been defined multiple times:")
486+ paras [ line ("The module " ++ markCode (runModuleName name) ++ " has been defined multiple times:")
601 , indent . paras $ map (line . displaySourceSpan) filenames
487 , indent . paras $ map (line . displaySourceSpan) filenames
603 renderSimpleErrorMessage (RedefinedIdent name) =
489 renderSimpleErrorMessage (RedefinedIdent name) =
604− line $ "The value " ++ showIdent name ++ " has been defined multiple times"
490+ line $ "The value " ++ markCode (showIdent name) ++ " has been defined multiple times"
605− renderSimpleErrorMessage (UnknownModule mn) =
491+ renderSimpleErrorMessage (UnknownName name) =
606− line $ "Unknown module " ++ runModuleName mn
492+ line $ "Unknown " ++ printName name
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) =
493+ renderSimpleErrorMessage (UnknownImport mn name) =
618− line $ "Unknown data constructor " ++ showQualified runProperName dc ++ foldMap ((" for type constructor " ++) . showQualified runProperName) tc
494+ paras [ line $ "Cannot import " ++ printName (Qualified Nothing name) ++ " from module " ++ markCode (runModuleName mn)
619− renderSimpleErrorMessage (UnknownImportType mn name) =
620− paras [ line $ "Cannot import type " ++ runProperName name ++ " from module " ++ runModuleName mn
621− , line "It either does not exist or the module does not export it."
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."
495 , line "It either does not exist or the module does not export it."
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."
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."
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."
647 renderSimpleErrorMessage (UnknownImportDataConstructor mn tcon dcon) =
497 renderSimpleErrorMessage (UnknownImportDataConstructor mn tcon dcon) =
648− line $ "Module " ++ runModuleName mn ++ " does not export data constructor " ++ runProperName dcon ++ " for type " ++ runProperName tcon
498+ line $ "Module " ++ runModuleName mn ++ " does not export data constructor " ++ markCode (runProperName dcon) ++ " for type " ++ markCode (runProperName tcon)
499+ renderSimpleErrorMessage (UnknownExport name) =
500+ line $ "Cannot export unknown " ++ printName (Qualified Nothing name)
649 renderSimpleErrorMessage (UnknownExportDataConstructor tcon dcon) =
501 renderSimpleErrorMessage (UnknownExportDataConstructor tcon dcon) =
650− line $ "Cannot export data constructor " ++ runProperName dcon ++ " for type " ++ runProperName tcon ++ ", as it has not been declared."
502+ line $ "Cannot export data constructor " ++ markCode (runProperName dcon) ++ " for type " ++ markCode (runProperName tcon) ++ ", as it has not been declared."
651 renderSimpleErrorMessage (ScopeConflict nm ms) =
503 renderSimpleErrorMessage (ScopeConflict nm ms) =
652− paras [ line $ "Conflicting definitions are in scope for " ++ nm ++ " from the following modules:"
504+ paras [ line $ "Conflicting definitions are in scope for " ++ printName (Qualified Nothing nm) ++ " from the following modules:"
653− , indent $ paras $ map (line . runModuleName) ms
505+ , indent $ paras $ map (line . markCode . runModuleName) ms
655 renderSimpleErrorMessage (ScopeShadowing nm exmn ms) =
507 renderSimpleErrorMessage (ScopeShadowing nm exmn ms) =
656− paras [ line $ "Shadowed definitions are in scope for " ++ nm ++ " from the following open imports:"
508+ paras [ line $ "Shadowed definitions are in scope for " ++ printName (Qualified Nothing nm) ++ " from the following open imports:"
657− , indent $ paras $ map (line . ("import " ++) . runModuleName) ms
509+ , indent $ paras $ map (line . markCode . ("import " ++) . runModuleName) ms
658 , line $ "These will be ignored and the " ++ case exmn of
510 , line $ "These will be ignored and the " ++ case exmn of
659− Just exmn' -> "declaration from " ++ runModuleName exmn' ++ " will be used."
511+ Just exmn' -> "declaration from " ++ markCode (runModuleName exmn') ++ " will be used."
660 Nothing -> "local declaration will be used."
512 Nothing -> "local declaration will be used."
662− renderSimpleErrorMessage (ConflictingTypeDecls nm) =
514+ renderSimpleErrorMessage (DeclConflict new existing) =
663− line $ "Conflicting type declarations for " ++ runProperName nm
515+ line $ "Declaration for " ++ printName (Qualified Nothing new) ++ " conflicts with an existing " ++ nameType existing ++ " of the same name."
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) =
516+ renderSimpleErrorMessage (ExportConflict new existing) =
671− line $ "Type class " ++ runProperName nm ++ " conflicts with a type declaration with the same name."
517+ line $ "Export for " ++ printName new ++ " conflicts with " ++ runName existing
672− renderSimpleErrorMessage (ClassConflictsWithCtor nm) =
673− line $ "Type class " ++ runProperName nm ++ " conflicts with a data constructor declaration with the same name."
674 renderSimpleErrorMessage (DuplicateModuleName mn) =
518 renderSimpleErrorMessage (DuplicateModuleName mn) =
675− line $ "Module " ++ runModuleName mn ++ " has been defined multiple times."
519+ line $ "Module " ++ markCode (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
682 renderSimpleErrorMessage (CycleInDeclaration nm) =
520 renderSimpleErrorMessage (CycleInDeclaration nm) =
683− line $ "The value of " ++ showIdent nm ++ " is undefined here, so this reference is not allowed."
521+ line $ "The value of " ++ markCode (showIdent nm) ++ " is undefined here, so this reference is not allowed."
684 renderSimpleErrorMessage (CycleInModules mns) =
522 renderSimpleErrorMessage (CycleInModules mns) =
685 paras [ line "There is a cycle in module dependencies in these modules: "
523 paras [ line "There is a cycle in module dependencies in these modules: "
686− , indent $ paras (map (line . runModuleName) mns)
524+ , indent $ paras (map (line . markCode . runModuleName) mns)
688 renderSimpleErrorMessage (CycleInTypeSynonym name) =
526 renderSimpleErrorMessage (CycleInTypeSynonym name) =
689 paras [ line $ case name of
527 paras [ line $ case name of
690− Just pn -> "A cycle appears in the definition of type synonym " ++ runProperName pn
528+ Just pn -> "A cycle appears in the definition of type synonym " ++ markCode (runProperName pn)
691 Nothing -> "A cycle appears in a set of type synonym definitions."
529 Nothing -> "A cycle appears in a set of type synonym definitions."
692 , line "Cycles are disallowed because they can lead to loops in the type checker."
530 , line "Cycles are disallowed because they can lead to loops in the type checker."
693 , line "Consider using a 'newtype' instead."
531 , line "Consider using a 'newtype' instead."
695 renderSimpleErrorMessage (NameIsUndefined ident) =
533 renderSimpleErrorMessage (NameIsUndefined ident) =
696− line $ "Value " ++ showIdent ident ++ " is undefined."
534+ line $ "Value " ++ markCode (showIdent ident) ++ " is undefined."
697 renderSimpleErrorMessage (UndefinedTypeVariable name) =
535 renderSimpleErrorMessage (UndefinedTypeVariable name) =
698− line $ "Type variable " ++ runProperName name ++ " is undefined."
536+ line $ "Type variable " ++ markCode (runProperName name) ++ " is undefined."
699 renderSimpleErrorMessage (PartiallyAppliedSynonym name) =
537 renderSimpleErrorMessage (PartiallyAppliedSynonym name) =
700− paras [ line $ "Type synonym " ++ showQualified runProperName name ++ " is partially applied."
538+ paras [ line $ "Type synonym " ++ markCode (showQualified runProperName name) ++ " is partially applied."
701 , line "Type synonyms must be applied to all of their type arguments."
539 , line "Type synonyms must be applied to all of their type arguments."
703 renderSimpleErrorMessage (EscapedSkolem binding) =
541 renderSimpleErrorMessage (EscapedSkolem binding) =
704 paras $ [ line "A type variable has escaped its scope." ]
542 paras $ [ line "A type variable has escaped its scope." ]
705 <> foldMap (\expr -> [ line "Relevant expression: "
543 <> foldMap (\expr -> [ line "Relevant expression: "
706− , indent $ prettyPrintValue valueDepth expr
544+ , markCodeBox $ indent $ prettyPrintValue valueDepth expr
707 ]) binding
545 ]) binding
708 renderSimpleErrorMessage (TypesDoNotUnify u1 u2)
546 renderSimpleErrorMessage (TypesDoNotUnify u1 u2)
709 = let (sorted1, sorted2) = sortRows u1 u2
547 = let (sorted1, sorted2) = sortRows u1 u2
@@ -725,39 +563,56 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
725 , rowFromList (sortBy (comparing fst) sd2 ++ map (fst &&& snd . snd) common, r2)
563 , rowFromList (sortBy (comparing fst) sd2 ++ map (fst &&& snd . snd) common, r2)
727 in paras [ line "Could not match type"
565 in paras [ line "Could not match type"
728− , indent $ typeAsBox sorted1
566+ , markCodeBox $ indent $ typeAsBox sorted1
729 , line "with type"
567 , line "with type"
730− , indent $ typeAsBox sorted2
568+ , markCodeBox $ indent $ typeAsBox sorted2
733 renderSimpleErrorMessage (KindsDoNotUnify k1 k2) =
571 renderSimpleErrorMessage (KindsDoNotUnify k1 k2) =
734 paras [ line "Could not match kind"
572 paras [ line "Could not match kind"
735− , indent $ line $ prettyPrintKind k1
573+ , indent $ line $ markCode $ prettyPrintKind k1
736 , line "with kind"
574 , line "with kind"
737− , indent $ line $ prettyPrintKind k2
575+ , indent $ line $ markCode $ prettyPrintKind k2
739 renderSimpleErrorMessage (ConstrainedTypeUnified t1 t2) =
577 renderSimpleErrorMessage (ConstrainedTypeUnified t1 t2) =
740 paras [ line "Could not match constrained type"
578 paras [ line "Could not match constrained type"
741− , indent $ typeAsBox t1
579+ , markCodeBox $ indent $ typeAsBox t1
742 , line "with type"
580 , line "with type"
743− , indent $ typeAsBox t2
581+ , markCodeBox $ indent $ typeAsBox t2
745 renderSimpleErrorMessage (OverlappingInstances nm ts (d : ds)) =
583 renderSimpleErrorMessage (OverlappingInstances nm ts (d : ds)) =
746 paras [ line "Overlapping type class instances found for"
584 paras [ line "Overlapping type class instances found for"
585+ , markCodeBox $ indent $ Box.hsep 1 Box.left
747− , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
586+ [ line (showQualified runProperName nm)
748− , Box.vcat Box.left (map typeAtomAsBox ts)
587+ , Box.vcat Box.left (map typeAtomAsBox ts)
750 , line "The following instances were found:"
589 , line "The following instances were found:"
751 , indent $ paras (line (showQualified showIdent d ++ " (chosen)") : map (line . showQualified showIdent) ds)
590 , indent $ paras (line (showQualified showIdent d ++ " (chosen)") : map (line . showQualified showIdent) ds)
752 , line "Overlapping type class instances can lead to different behavior based on the order of module imports, and for that reason are not recommended."
591 , line "Overlapping type class instances can lead to different behavior based on the order of module imports, and for that reason are not recommended."
753 , line "They may be disallowed completely in a future version of the compiler."
592 , line "They may be disallowed completely in a future version of the compiler."
755 renderSimpleErrorMessage OverlappingInstances{} = internalError "OverlappingInstances: empty instance list"
594 renderSimpleErrorMessage OverlappingInstances{} = internalError "OverlappingInstances: empty instance list"
756− renderSimpleErrorMessage (NoInstanceFound nm ts) =
595+ renderSimpleErrorMessage (NoInstanceFound (Constraint C.Fail [ TypeLevelString message ] _)) =
596+ paras [ line "A custom type error occurred while solving type class constraints:"
597+ , indent . paras . map line . lines $ message
599+ renderSimpleErrorMessage (NoInstanceFound (Constraint C.Partial
601+ (Just (PartialConstraintData bs b)))) =
602+ paras [ line "A case expression could not be determined to cover all inputs."
603+ , line "The following additional cases are required to cover all inputs:\n"
606+ (map (paras . map (line . markCode)) (transpose bs))
607+ : [line "..." | not b]
608+ , line "Alternatively, add a Partial constraint to the type of the enclosing value."
610+ renderSimpleErrorMessage (NoInstanceFound (Constraint nm ts _)) =
757 paras [ line "No type class instance was found for"
611 paras [ line "No type class instance was found for"
612+ , markCodeBox $ indent $ Box.hsep 1 Box.left
758− , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
613+ [ line (showQualified runProperName nm)
759− , Box.vcat Box.left (map typeAtomAsBox ts)
614+ , Box.vcat Box.left (map typeAtomAsBox ts)
761 , paras [ line "The instance head contains unknown type variables. Consider adding a type annotation."
616 , paras [ line "The instance head contains unknown type variables. Consider adding a type annotation."
762 | any containsUnknowns ts
617 | any containsUnknowns ts
@@ -770,130 +625,118 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
770 go _ = False
625 go _ = False
771 renderSimpleErrorMessage (PossiblyInfiniteInstance nm ts) =
626 renderSimpleErrorMessage (PossiblyInfiniteInstance nm ts) =
772 paras [ line "Type class instance for"
627 paras [ line "Type class instance for"
628+ , markCodeBox $ indent $ Box.hsep 1 Box.left
773− , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
629+ [ line (showQualified runProperName nm)
774− , Box.vcat Box.left (map typeAtomAsBox ts)
630+ , Box.vcat Box.left (map typeAtomAsBox ts)
776 , line "is possibly infinite."
632 , line "is possibly infinite."
778 renderSimpleErrorMessage (CannotDerive nm ts) =
634 renderSimpleErrorMessage (CannotDerive nm ts) =
779 paras [ line "Cannot derive a type class instance for"
635 paras [ line "Cannot derive a type class instance for"
636+ , markCodeBox $ indent $ Box.hsep 1 Box.left
780− , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName nm)
637+ [ line (showQualified runProperName nm)
781− , Box.vcat Box.left (map typeAtomAsBox ts)
638+ , Box.vcat Box.left (map typeAtomAsBox ts)
784 renderSimpleErrorMessage (CannotFindDerivingType nm) =
641 renderSimpleErrorMessage (CannotFindDerivingType nm) =
785− line $ "Cannot derive a type class instance, because the type declaration for " ++ runProperName nm ++ " could not be found."
642+ line $ "Cannot derive a type class instance, because the type declaration for " ++ markCode (runProperName nm) ++ " could not be found."
786 renderSimpleErrorMessage (DuplicateLabel l expr) =
643 renderSimpleErrorMessage (DuplicateLabel l expr) =
787− paras $ [ line $ "Label " ++ show l ++ " appears more than once in a row type." ]
644+ paras $ [ line $ "Label " ++ markCode l ++ " appears more than once in a row type." ]
788 <> foldMap (\expr' -> [ line "Relevant expression: "
645 <> foldMap (\expr' -> [ line "Relevant expression: "
789− , indent $ prettyPrintValue valueDepth expr'
646+ , markCodeBox $ indent $ prettyPrintValue valueDepth expr'
791 renderSimpleErrorMessage (DuplicateTypeArgument name) =
648 renderSimpleErrorMessage (DuplicateTypeArgument name) =
792− line $ "Type argument " ++ show name ++ " appears more than once."
649+ line $ "Type argument " ++ markCode name ++ " appears more than once."
793 renderSimpleErrorMessage (DuplicateValueDeclaration nm) =
650 renderSimpleErrorMessage (DuplicateValueDeclaration nm) =
794− line $ "Multiple value declarations exist for " ++ showIdent nm ++ "."
651+ line $ "Multiple value declarations exist for " ++ markCode (showIdent nm) ++ "."
795 renderSimpleErrorMessage (ArgListLengthsDiffer ident) =
652 renderSimpleErrorMessage (ArgListLengthsDiffer ident) =
796− line $ "Argument list lengths differ in declaration " ++ showIdent ident
653+ line $ "Argument list lengths differ in declaration " ++ markCode (showIdent ident)
797 renderSimpleErrorMessage (OverlappingArgNames ident) =
654 renderSimpleErrorMessage (OverlappingArgNames ident) =
798 line $ "Overlapping names in function/binder" ++ foldMap ((" in declaration " ++) . showIdent) ident
655 line $ "Overlapping names in function/binder" ++ foldMap ((" in declaration " ++) . showIdent) ident
799 renderSimpleErrorMessage (MissingClassMember ident) =
656 renderSimpleErrorMessage (MissingClassMember ident) =
800− line $ "Type class member " ++ showIdent ident ++ " has not been implemented."
657+ line $ "Type class member " ++ markCode (showIdent ident) ++ " has not been implemented."
801 renderSimpleErrorMessage (ExtraneousClassMember ident className) =
658 renderSimpleErrorMessage (ExtraneousClassMember ident className) =
802− line $ showIdent ident ++ " is not a member of type class " ++ showQualified runProperName className
659+ line $ "" ++ markCode (showIdent ident) ++ " is not a member of type class " ++ markCode (showQualified runProperName className)
803 renderSimpleErrorMessage (ExpectedType ty kind) =
660 renderSimpleErrorMessage (ExpectedType ty kind) =
804− paras [ line "In a type-annotated expression x :: t, the type t must have kind *."
661+ paras [ line $ "In a type-annotated expression " ++ markCode "x :: t" ++ ", the type " ++ markCode "t" ++ " must have kind " ++ markCode "*" ++ "."
805 , line "The error arises from the type"
662 , line "The error arises from the type"
806− , indent $ typeAsBox ty
663+ , markCodeBox $ indent $ typeAsBox ty
807 , line "having the kind"
664 , line "having the kind"
808− , indent $ line $ prettyPrintKind kind
665+ , indent $ line $ markCode $ prettyPrintKind kind
809 , line "instead."
666 , line "instead."
811 renderSimpleErrorMessage (IncorrectConstructorArity nm) =
668 renderSimpleErrorMessage (IncorrectConstructorArity nm) =
812− line $ "Data constructor " ++ showQualified runProperName nm ++ " was given the wrong number of arguments in a case expression."
669+ line $ "Data constructor " ++ markCode (showQualified runProperName nm) ++ " was given the wrong number of arguments in a case expression."
813 renderSimpleErrorMessage (ExprDoesNotHaveType expr ty) =
670 renderSimpleErrorMessage (ExprDoesNotHaveType expr ty) =
814 paras [ line "Expression"
671 paras [ line "Expression"
815− , indent $ prettyPrintValue valueDepth expr
672+ , markCodeBox $ indent $ prettyPrintValue valueDepth expr
816 , line "does not have type"
673 , line "does not have type"
817− , indent $ typeAsBox ty
674+ , markCodeBox $ indent $ typeAsBox ty
819 renderSimpleErrorMessage (PropertyIsMissing prop) =
676 renderSimpleErrorMessage (PropertyIsMissing prop) =
820− line $ "Type of expression lacks required label " ++ show prop ++ "."
677+ line $ "Type of expression lacks required label " ++ markCode prop ++ "."
821 renderSimpleErrorMessage (AdditionalProperty prop) =
678 renderSimpleErrorMessage (AdditionalProperty prop) =
822− line $ "Type of expression contains additional label " ++ show prop ++ "."
679+ line $ "Type of expression contains additional label " ++ markCode prop ++ "."
823 renderSimpleErrorMessage (CannotApplyFunction fn arg) =
680 renderSimpleErrorMessage (CannotApplyFunction fn arg) =
824 paras [ line "A function of type"
681 paras [ line "A function of type"
825− , indent $ typeAsBox fn
682+ , markCodeBox $ indent $ typeAsBox fn
826 , line "can not be applied to the argument"
683 , line "can not be applied to the argument"
827− , indent $ prettyPrintValue valueDepth arg
684+ , markCodeBox $ indent $ prettyPrintValue valueDepth arg
829 renderSimpleErrorMessage TypeSynonymInstance =
686 renderSimpleErrorMessage TypeSynonymInstance =
830 line "Type class instances for type synonyms are disallowed."
687 line "Type class instances for type synonyms are disallowed."
831 renderSimpleErrorMessage (OrphanInstance nm cnm ts) =
688 renderSimpleErrorMessage (OrphanInstance nm cnm ts) =
832− paras [ line $ "Type class instance " ++ showIdent nm ++ " for "
689+ paras [ line $ "Type class instance " ++ markCode (showIdent nm) ++ " for "
690+ , markCodeBox $ indent $ Box.hsep 1 Box.left
833− , indent $ Box.hsep 1 Box.left [ line (showQualified runProperName cnm)
691+ [ line (showQualified runProperName cnm)
834− , Box.vcat Box.left (map typeAtomAsBox ts)
692+ , Box.vcat Box.left (map typeAtomAsBox ts)
836 , line "is an orphan instance."
694 , line "is an orphan instance."
837 , line "An orphan instance is an instance which is defined in neither the class module nor the data type module."
695 , line "An orphan instance is an instance which is defined in neither the class module nor the data type module."
838 , line "Consider moving the instance, if possible, or using a newtype wrapper."
696 , line "Consider moving the instance, if possible, or using a newtype wrapper."
840 renderSimpleErrorMessage (InvalidNewtype name) =
698 renderSimpleErrorMessage (InvalidNewtype name) =
841− paras [ line $ "Newtype " ++ runProperName name ++ " is invalid."
699+ paras [ line $ "Newtype " ++ markCode (runProperName name) ++ " is invalid."
842 , line "Newtypes must define a single constructor with a single argument."
700 , line "Newtypes must define a single constructor with a single argument."
844 renderSimpleErrorMessage (InvalidInstanceHead ty) =
702 renderSimpleErrorMessage (InvalidInstanceHead ty) =
845 paras [ line "Type class instance head is invalid due to use of type"
703 paras [ line "Type class instance head is invalid due to use of type"
846− , indent $ typeAsBox ty
704+ , markCodeBox $ indent $ typeAsBox ty
847 , 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."
705 , 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."
849 renderSimpleErrorMessage (TransitiveExportError x ys) =
707 renderSimpleErrorMessage (TransitiveExportError x ys) =
850− paras [ line $ "An export for " ++ prettyPrintExport x ++ " requires the following to also be exported: "
708+ paras [ line $ "An export for " ++ markCode (prettyPrintExport x) ++ " requires the following to also be exported: "
851− , indent $ paras $ map (line . prettyPrintExport) ys
709+ , indent $ paras $ map (line . markCode . prettyPrintExport) ys
853 renderSimpleErrorMessage (TransitiveDctorExportError x ctor) =
711 renderSimpleErrorMessage (TransitiveDctorExportError x ctor) =
854− paras [ line $ "An export for " ++ prettyPrintExport x ++ " requires the following data constructor to also be exported: "
712+ paras [ line $ "An export for " ++ markCode (prettyPrintExport x) ++ " requires the following data constructor to also be exported: "
855− , indent $ line $ runProperName ctor
713+ , indent $ line $ markCode $ runProperName ctor
857 renderSimpleErrorMessage (ShadowedName nm) =
715 renderSimpleErrorMessage (ShadowedName nm) =
858− line $ "Name '" ++ showIdent nm ++ "' was shadowed."
716+ line $ "Name " ++ markCode (showIdent nm) ++ " was shadowed."
859 renderSimpleErrorMessage (ShadowedTypeVar tv) =
717 renderSimpleErrorMessage (ShadowedTypeVar tv) =
860− line $ "Type variable '" ++ tv ++ "' was shadowed."
718+ line $ "Type variable " ++ markCode tv ++ " was shadowed."
861 renderSimpleErrorMessage (UnusedTypeVar tv) =
719 renderSimpleErrorMessage (UnusedTypeVar tv) =
862− line $ "Type variable '" ++ tv ++ "' was declared but not used."
720+ line $ "Type variable " ++ markCode 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"
868 renderSimpleErrorMessage (MisleadingEmptyTypeImport mn name) =
721 renderSimpleErrorMessage (MisleadingEmptyTypeImport mn name) =
869− line $ "Importing type " ++ runProperName name ++ "(..) from " ++ runModuleName mn ++ " is misleading as it has no exported data constructors."
722+ line $ "Importing type " ++ markCode (runProperName name ++ "(..)") ++ " from " ++ markCode (runModuleName mn) ++ " is misleading as it has no exported data constructors."
870 renderSimpleErrorMessage (ImportHidingModule name) =
723 renderSimpleErrorMessage (ImportHidingModule name) =
871− paras [ line "'hiding' imports cannot be used to hide modules."
724+ paras [ line "hiding imports cannot be used to hide modules."
872− , line $ "An attempt was made to hide the import of " ++ runModuleName name
725+ , line $ "An attempt was made to hide the import of " ++ markCode (runModuleName name)
874− renderSimpleErrorMessage (WildcardInferredType ty) =
727+ renderSimpleErrorMessage (WildcardInferredType ty ctx) =
875− paras [ line "Wildcard type definition has the inferred type "
728+ paras $ [ line "Wildcard type definition has the inferred type "
876− , indent $ typeAsBox ty
729+ , markCodeBox $ indent $ typeAsBox ty
877− ]
730+ ] ++ renderContext ctx
878− renderSimpleErrorMessage (HoleInferredType name ty) =
731+ renderSimpleErrorMessage (HoleInferredType name ty ctx) =
879− paras [ line $ "Hole '" ++ name ++ "' has the inferred type "
732+ paras $ [ line $ "Hole '" ++ markCode name ++ "' has the inferred type "
880− , indent $ typeAsBox ty
733+ , markCodeBox $ indent $ typeAsBox ty
881− ]
734+ ] ++ renderContext ctx
882 renderSimpleErrorMessage (MissingTypeDeclaration ident ty) =
735 renderSimpleErrorMessage (MissingTypeDeclaration ident ty) =
883− paras [ line $ "No type declaration was provided for the top-level declaration of " ++ showIdent ident ++ "."
736+ paras [ line $ "No type declaration was provided for the top-level declaration of " ++ markCode (showIdent ident) ++ "."
884 , line "It is good practice to provide type declarations as a form of documentation."
737 , line "It is good practice to provide type declarations as a form of documentation."
885− , line $ "The inferred type of " ++ showIdent ident ++ " was:"
738+ , line $ "The inferred type of " ++ markCode (showIdent ident) ++ " was:"
886− , indent $ typeAsBox ty
739+ , markCodeBox $ indent $ typeAsBox ty
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"
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."
898 renderSimpleErrorMessage (OverlappingPattern bs b) =
741 renderSimpleErrorMessage (OverlappingPattern bs b) =
899 paras $ [ line "A case expression contains unreachable cases:\n"
742 paras $ [ line "A case expression contains unreachable cases:\n"
@@ -905,109 +748,51 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
905 , line "You may want to decompose your data types into smaller types."
748 , line "You may want to decompose your data types into smaller types."
907 renderSimpleErrorMessage (UnusedImport name) =
750 renderSimpleErrorMessage (UnusedImport name) =
908− line $ "The import of module " ++ runModuleName name ++ " is redundant"
751+ line $ "The import of module " ++ markCode (runModuleName name) ++ " is redundant"
910 renderSimpleErrorMessage msg@(UnusedExplicitImport mn names _ _) =
753 renderSimpleErrorMessage msg@(UnusedExplicitImport mn names _ _) =
911− paras [ line $ "The import of module " ++ runModuleName mn ++ " contains the following unused references:"
754+ paras [ line $ "The import of module " ++ markCode (runModuleName mn) ++ " contains the following unused references:"
912 , indent $ paras $ map line names
755 , indent $ paras $ map line names
913 , line "It could be replaced with:"
756 , line "It could be replaced with:"
914− , indent $ line $ showSuggestion msg ]
757+ , indent $ line $ markCode $ showSuggestion msg ]
916 renderSimpleErrorMessage (UnusedDctorImport name) =
759 renderSimpleErrorMessage (UnusedDctorImport name) =
917− line $ "The import of type " ++ runProperName name ++ " includes data constructors but only the type is used"
760+ line $ "The import of type " ++ markCode (runProperName name) ++ " includes data constructors but only the type is used"
919 renderSimpleErrorMessage (UnusedDctorExplicitImport name names) =
762 renderSimpleErrorMessage (UnusedDctorExplicitImport name names) =
920− paras [ line $ "The import of type " ++ runProperName name ++ " includes the following unused data constructors:"
763+ paras [ line $ "The import of type " ++ markCode (runProperName name) ++ " includes the following unused data constructors:"
921− , indent $ paras $ map (line .runProperName) names ]
764+ , indent $ paras $ map (line . markCode . runProperName) names ]
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."
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 $
936− , prettyPrintValue valueDepth l
945− , prettyPrintValue valueDepth r
948− , line "Support for legacy operator sections will be removed in PureScript 0.9."
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."
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."
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."
978 renderSimpleErrorMessage (DuplicateSelectiveImport name) =
766 renderSimpleErrorMessage (DuplicateSelectiveImport name) =
979− line $ "There is an existing import of " ++ runModuleName name ++ ", consider merging the import lists"
767+ line $ "There is an existing import of " ++ markCode (runModuleName name) ++ ", consider merging the import lists"
981 renderSimpleErrorMessage (DuplicateImport name imp qual) =
769 renderSimpleErrorMessage (DuplicateImport name imp qual) =
982− line $ "Duplicate import of " ++ prettyPrintImport name imp qual
770+ line $ "Duplicate import of " ++ markCode (prettyPrintImport name imp qual)
984− renderSimpleErrorMessage (DuplicateImportRef ref) =
772+ renderSimpleErrorMessage (DuplicateImportRef name) =
985− line $ "Import list contains multiple references to " ++ ref
773+ line $ "Import list contains multiple references to " ++ printName (Qualified Nothing name)
987− renderSimpleErrorMessage (DuplicateExportRef ref) =
775+ renderSimpleErrorMessage (DuplicateExportRef name) =
988− line $ "Export list contains multiple references to " ++ ref
776+ line $ "Export list contains multiple references to " ++ printName (Qualified Nothing name)
990 renderSimpleErrorMessage (IntOutOfRange value backend lo hi) =
778 renderSimpleErrorMessage (IntOutOfRange value backend lo hi) =
991− paras [ line $ "Integer value " ++ show value ++ " is out of range for the " ++ backend ++ " backend."
779+ paras [ line $ "Integer value " ++ markCode (show value) ++ " is out of range for the " ++ backend ++ " backend."
992− , line $ "Acceptable values fall within the range " ++ show lo ++ " to " ++ show hi ++ " (inclusive)." ]
780+ , line $ "Acceptable values fall within the range " ++ markCode (show lo) ++ " to " ++ markCode (show hi) ++ " (inclusive)." ]
994− renderSimpleErrorMessage (RedundantEmptyHidingImport mn) =
995− line $ "The import for module " ++ runModuleName mn ++ " is redundant as all members have been explicitly hidden."
997 renderSimpleErrorMessage msg@(ImplicitQualifiedImport importedModule asModule _) =
782 renderSimpleErrorMessage msg@(ImplicitQualifiedImport importedModule asModule _) =
998− paras [ line $ "Module " ++ runModuleName importedModule ++ " was imported as " ++ runModuleName asModule ++ " with unspecified imports."
783+ paras [ line $ "Module " ++ markCode (runModuleName importedModule) ++ " was imported as " ++ markCode (runModuleName asModule) ++ " with unspecified imports."
999− , line $ "As there are multiple modules being imported as " ++ runModuleName asModule ++ ", consider using the explicit form:"
784+ , line $ "As there are multiple modules being imported as " ++ markCode (runModuleName asModule) ++ ", consider using the explicit form:"
1000− , indent $ line $ showSuggestion msg
785+ , indent $ line $ markCode $ showSuggestion msg
1003 renderSimpleErrorMessage msg@(ImplicitImport mn _) =
788 renderSimpleErrorMessage msg@(ImplicitImport mn _) =
1004− paras [ line $ "Module " ++ runModuleName mn ++ " has unspecified imports, consider using the explicit form: "
789+ paras [ line $ "Module " ++ markCode (runModuleName mn) ++ " has unspecified imports, consider using the explicit form: "
1005− , indent $ line $ showSuggestion msg
790+ , indent $ line $ markCode $ showSuggestion msg
1008 renderSimpleErrorMessage msg@(HidingImport mn _) =
793 renderSimpleErrorMessage msg@(HidingImport mn _) =
1009− paras [ line $ "Module " ++ runModuleName mn ++ " has unspecified imports, consider using the inclusive form: "
794+ paras [ line $ "Module " ++ markCode (runModuleName mn) ++ " has unspecified imports, consider using the inclusive form: "
1010− , indent $ line $ showSuggestion msg
795+ , indent $ line $ markCode $ showSuggestion msg
1013 renderSimpleErrorMessage (CaseBinderLengthDiffers l bs) =
798 renderSimpleErrorMessage (CaseBinderLengthDiffers l bs) =
@@ -1020,7 +805,7 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
1020 line "An anonymous function argument appears in an invalid context."
805 line "An anonymous function argument appears in an invalid context."
1022 renderSimpleErrorMessage (InvalidOperatorInBinder op fn) =
807 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 ++ "."
808+ paras [ line $ "Operator " ++ markCode (showQualified showOp op) ++ " cannot be used in a pattern as it is an alias for function " ++ showQualified showIdent fn ++ "."
1024 , line "Only aliases for data constructors may be used in patterns."
809 , line "Only aliases for data constructors may be used in patterns."
@@ -1028,9 +813,9 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
1028 line "The require-path option is deprecated and will be removed in PureScript 0.9."
813 line "The require-path option is deprecated and will be removed in PureScript 0.9."
1030 renderSimpleErrorMessage (CannotGeneralizeRecursiveFunction ident ty) =
815 renderSimpleErrorMessage (CannotGeneralizeRecursiveFunction ident ty) =
1031− paras [ line $ "Unable to generalize the type of the recursive function " ++ showIdent ident ++ "."
816+ paras [ line $ "Unable to generalize the type of the recursive function " ++ markCode (showIdent ident) ++ "."
1032− , line $ "The inferred type of " ++ showIdent ident ++ " was:"
817+ , line $ "The inferred type of " ++ markCode (showIdent ident) ++ " was:"
1033− , indent $ typeAsBox ty
818+ , markCodeBox $ indent $ typeAsBox ty
1034 , line "Try adding a type signature."
819 , line "Try adding a type signature."
@@ -1038,42 +823,43 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
1038 renderHint (ErrorUnifyingTypes t1 t2) detail =
823 renderHint (ErrorUnifyingTypes t1 t2) detail =
1039 paras [ detail
824 paras [ detail
1040 , Box.hsep 1 Box.top [ line "while trying to match type"
825 , Box.hsep 1 Box.top [ line "while trying to match type"
1041− , typeAsBox t1
826+ , markCodeBox $ typeAsBox t1
1043 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "with type"
828 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "with type"
1044− , typeAsBox t2
829+ , markCodeBox $ typeAsBox t2
1047 renderHint (ErrorInExpression expr) detail =
832 renderHint (ErrorInExpression expr) detail =
1048 paras [ detail
833 paras [ detail
1049 , Box.hsep 1 Box.top [ Box.text "in the expression"
834 , Box.hsep 1 Box.top [ Box.text "in the expression"
1050− , prettyPrintValue valueDepth expr
835+ , markCodeBox $ markCodeBox $ prettyPrintValue valueDepth expr
1053 renderHint (ErrorInModule mn) detail =
838 renderHint (ErrorInModule mn) detail =
1054− paras [ line $ "in module " ++ runModuleName mn
839+ paras [ line $ "in module " ++ markCode (runModuleName mn)
1055 , detail
840 , detail
1057 renderHint (ErrorInSubsumption t1 t2) detail =
842 renderHint (ErrorInSubsumption t1 t2) detail =
1058 paras [ detail
843 paras [ detail
1059 , Box.hsep 1 Box.top [ line "while checking that type"
844 , Box.hsep 1 Box.top [ line "while checking that type"
1060− , typeAsBox t1
845+ , markCodeBox $ typeAsBox t1
1062 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "is at least as general as type"
847 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "is at least as general as type"
1063− , typeAsBox t2
848+ , markCodeBox $ typeAsBox t2
1066 renderHint (ErrorInInstance nm ts) detail =
851 renderHint (ErrorInInstance nm ts) detail =
1067 paras [ detail
852 paras [ detail
1068− , Box.hsep 1 Box.top [ line "in type class instance"
853+ , line "in type class instance"
854+ , markCodeBox $ indent $ Box.hsep 1 Box.top
1069− , line (showQualified runProperName nm)
855+ [ line $ showQualified runProperName nm
1070− , Box.vcat Box.left (map typeAtomAsBox ts)
856+ , Box.vcat Box.left (map typeAtomAsBox ts)
1073 renderHint (ErrorCheckingKind ty) detail =
859 renderHint (ErrorCheckingKind ty) detail =
1074 paras [ detail
860 paras [ detail
1075 , Box.hsep 1 Box.top [ line "while checking the kind of"
861 , Box.hsep 1 Box.top [ line "while checking the kind of"
1076− , typeAsBox ty
862+ , markCodeBox $ typeAsBox ty
1079 renderHint ErrorCheckingGuard detail =
865 renderHint ErrorCheckingGuard detail =
@@ -1083,43 +869,43 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
1083 renderHint (ErrorInferringType expr) detail =
869 renderHint (ErrorInferringType expr) detail =
1084 paras [ detail
870 paras [ detail
1085 , Box.hsep 1 Box.top [ line "while inferring the type of"
871 , Box.hsep 1 Box.top [ line "while inferring the type of"
1086− , prettyPrintValue valueDepth expr
872+ , markCodeBox $ prettyPrintValue valueDepth expr
1089 renderHint (ErrorCheckingType expr ty) detail =
875 renderHint (ErrorCheckingType expr ty) detail =
1090 paras [ detail
876 paras [ detail
1091 , Box.hsep 1 Box.top [ line "while checking that expression"
877 , Box.hsep 1 Box.top [ line "while checking that expression"
1092− , prettyPrintValue valueDepth expr
878+ , markCodeBox $ prettyPrintValue valueDepth expr
1094 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "has type"
880 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "has type"
1095− , typeAsBox ty
881+ , markCodeBox $ typeAsBox ty
1098 renderHint (ErrorCheckingAccessor expr prop) detail =
884 renderHint (ErrorCheckingAccessor expr prop) detail =
1099 paras [ detail
885 paras [ detail
1100 , Box.hsep 1 Box.top [ line "while checking type of property accessor"
886 , Box.hsep 1 Box.top [ line "while checking type of property accessor"
1101− , prettyPrintValue valueDepth (Accessor prop expr)
887+ , markCodeBox $ prettyPrintValue valueDepth (Accessor prop expr)
1104 renderHint (ErrorInApplication f t a) detail =
890 renderHint (ErrorInApplication f t a) detail =
1105 paras [ detail
891 paras [ detail
1106 , Box.hsep 1 Box.top [ line "while applying a function"
892 , Box.hsep 1 Box.top [ line "while applying a function"
1107− , prettyPrintValue valueDepth f
893+ , markCodeBox $ prettyPrintValue valueDepth f
1109 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "of type"
895 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "of type"
1110− , typeAsBox t
896+ , markCodeBox $ typeAsBox t
1112 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "to argument"
898 , Box.moveRight 2 $ Box.hsep 1 Box.top [ line "to argument"
1113− , prettyPrintValue valueDepth a
899+ , markCodeBox $ prettyPrintValue valueDepth a
1116 renderHint (ErrorInDataConstructor nm) detail =
902 renderHint (ErrorInDataConstructor nm) detail =
1117 paras [ detail
903 paras [ detail
1118− , line $ "in data constructor " ++ runProperName nm
904+ , line $ "in data constructor " ++ markCode (runProperName nm)
1120 renderHint (ErrorInTypeConstructor nm) detail =
906 renderHint (ErrorInTypeConstructor nm) detail =
1121 paras [ detail
907 paras [ detail
1122− , line $ "in type constructor " ++ runProperName nm
908+ , line $ "in type constructor " ++ markCode (runProperName nm)
1124 renderHint (ErrorInBindingGroup nms) detail =
910 renderHint (ErrorInBindingGroup nms) detail =
1125 paras [ detail
911 paras [ detail
@@ -1131,25 +917,75 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
1132 renderHint (ErrorInTypeSynonym name) detail =
918 renderHint (ErrorInTypeSynonym name) detail =
1133 paras [ detail
919 paras [ detail
1134− , line $ "in type synonym " ++ runProperName name
920+ , line $ "in type synonym " ++ markCode (runProperName name)
1136 renderHint (ErrorInValueDeclaration n) detail =
922 renderHint (ErrorInValueDeclaration n) detail =
1137 paras [ detail
923 paras [ detail
1138− , line $ "in value declaration " ++ showIdent n
924+ , line $ "in value declaration " ++ markCode (showIdent n)
1140 renderHint (ErrorInTypeDeclaration n) detail =
926 renderHint (ErrorInTypeDeclaration n) detail =
1141 paras [ detail
927 paras [ detail
1142− , line $ "in type declaration for " ++ showIdent n
928+ , line $ "in type declaration for " ++ markCode (showIdent n)
1144 renderHint (ErrorInForeignImport nm) detail =
930 renderHint (ErrorInForeignImport nm) detail =
1145 paras [ detail
931 paras [ detail
1146− , line $ "in foreign import " ++ showIdent nm
932+ , line $ "in foreign import " ++ markCode (showIdent nm)
934+ renderHint (ErrorSolvingConstraint (Constraint nm ts _)) detail =
936+ , line "while solving type class constriant"
937+ , markCodeBox $ indent $ Box.hsep 1 Box.left
938+ [ line (showQualified runProperName nm)
939+ , Box.vcat Box.left (map typeAtomAsBox ts)
1148 renderHint (PositionedError srcSpan) detail =
942 renderHint (PositionedError srcSpan) detail =
1149 paras [ line $ "at " ++ displaySourceSpan srcSpan
943 paras [ line $ "at " ++ displaySourceSpan srcSpan
1150 , detail
944 , detail
947+ renderContext :: Context -> [Box.Box]
948+ renderContext [] = []
950+ [ line "in the following context:"
952+ [ Box.hcat Box.left [ Box.text (showIdent ident <> " :: ")
953+ , markCodeBox $ typeAsBox ty'
955+ | (ident, ty') <- take 5 ctx
959+ printName :: Qualified Name -> String
960+ printName qn = nameType (disqualify qn) ++ " " ++ markCode (runName qn)
962+ nameType :: Name -> String
963+ nameType (IdentName _) = "value"
964+ nameType (ValOpName _) = "operator"
965+ nameType (TyName _) = "type"
966+ nameType (TyOpName _) = "type operator"
967+ nameType (DctorName _) = "data constructor"
968+ nameType (TyClassName _) = "type class"
969+ nameType (ModName _) = "module"
971+ runName :: Qualified Name -> String
972+ runName (Qualified mn (IdentName name)) =
973+ showQualified showIdent (Qualified mn name)
974+ runName (Qualified mn (ValOpName op)) =
975+ showQualified showOp (Qualified mn op)
976+ runName (Qualified mn (TyName name)) =
977+ showQualified runProperName (Qualified mn name)
978+ runName (Qualified mn (TyOpName op)) =
979+ showQualified showOp (Qualified mn op)
980+ runName (Qualified mn (DctorName name)) =
981+ showQualified runProperName (Qualified mn name)
982+ runName (Qualified mn (TyClassName name)) =
983+ showQualified runProperName (Qualified mn name)
984+ runName (Qualified Nothing (ModName name)) =
986+ runName (Qualified _ ModName{}) =
987+ internalError "qualified ModName in runName"
1153 valueDepth :: Int
989 valueDepth :: Int
1154 valueDepth | full = 1000
990 valueDepth | full = 1000
1155 | otherwise = 3
991 | otherwise = 3
@@ -1192,6 +1028,10 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
1193 isUnifyHint ErrorUnifyingTypes{} = True
1029 isUnifyHint ErrorUnifyingTypes{} = True
1194 isUnifyHint _ = False
1030 isUnifyHint _ = False
1031+ stripRedudantHints NoInstanceFound{} = stripFirst isSolverHint
1033+ isSolverHint ErrorSolvingConstraint{} = True
1034+ isSolverHint _ = False
1195 stripRedudantHints _ = id
1035 stripRedudantHints _ = id
1197 stripFirst :: (ErrorMessageHint -> Bool) -> [ErrorMessageHint] -> [ErrorMessageHint]
1037 stripFirst :: (ErrorMessageHint -> Bool) -> [ErrorMessageHint] -> [ErrorMessageHint]
@@ -1203,70 +1043,86 @@ prettyPrintSingleError full level showWiki e = flip evalState defaultUnknownMap
1203 stripFirst _ [] = []
1043 stripFirst _ [] = []
1205 hintCategory :: ErrorMessageHint -> HintCategory
1045 hintCategory :: ErrorMessageHint -> HintCategory
1206− hintCategory ErrorCheckingType{} = ExprHint
1046+ hintCategory ErrorCheckingType{} = ExprHint
1207− hintCategory ErrorInferringType{} = ExprHint
1047+ hintCategory ErrorInferringType{} = ExprHint
1208− hintCategory ErrorInExpression{} = ExprHint
1048+ hintCategory ErrorInExpression{} = ExprHint
1209− hintCategory ErrorUnifyingTypes{} = CheckHint
1049+ hintCategory ErrorUnifyingTypes{} = CheckHint
1210− hintCategory ErrorInSubsumption{} = CheckHint
1050+ hintCategory ErrorInSubsumption{} = CheckHint
1211− hintCategory ErrorInApplication{} = CheckHint
1051+ hintCategory ErrorInApplication{} = CheckHint
1212− hintCategory ErrorCheckingKind{} = CheckHint
1052+ hintCategory ErrorCheckingKind{} = CheckHint
1053+ hintCategory ErrorSolvingConstraint{} = SolverHint
1213− hintCategory PositionedError{} = PositionHint
1054+ hintCategory PositionedError{} = PositionHint
1214− hintCategory _ = OtherHint
1055+ hintCategory _ = OtherHint
1216-- Pretty print and export declaration
1057-- Pretty print and export declaration
1217prettyPrintExport :: DeclarationRef -> String
1058prettyPrintExport :: DeclarationRef -> String
1218prettyPrintExport (TypeRef pn _) = runProperName pn
1059prettyPrintExport (TypeRef pn _) = runProperName pn
1219−prettyPrintExport ref = prettyPrintRef ref
1060+prettyPrintExport ref =
1062+ (internalError "prettyPrintRef returned Nothing in prettyPrintExport")
1063+ (prettyPrintRef ref)
1221prettyPrintImport :: ModuleName -> ImportDeclarationType -> Maybe ModuleName -> String
1065prettyPrintImport :: ModuleName -> ImportDeclarationType -> Maybe ModuleName -> String
1222prettyPrintImport mn idt qual =
1066prettyPrintImport mn idt qual =
1223 let i = case idt of
1067 let i = case idt of
1224 Implicit -> runModuleName mn
1068 Implicit -> runModuleName mn
1225− Explicit refs -> runModuleName mn ++ " (" ++ intercalate ", " (map prettyPrintRef refs) ++ ")"
1069+ Explicit refs -> runModuleName mn ++ " (" ++ intercalate ", " (mapMaybe prettyPrintRef refs) ++ ")"
1226− Hiding refs -> runModuleName mn ++ " hiding (" ++ intercalate "," (map prettyPrintRef refs) ++ ")"
1070+ Hiding refs -> runModuleName mn ++ " hiding (" ++ intercalate "," (mapMaybe prettyPrintRef refs) ++ ")"
1227 in i ++ maybe "" (\q -> " as " ++ runModuleName q) qual
1071 in i ++ maybe "" (\q -> " as " ++ runModuleName q) qual
1229−prettyPrintRef :: DeclarationRef -> String
1073+prettyPrintRef :: DeclarationRef -> Maybe String
1230−prettyPrintRef (TypeRef pn Nothing) = runProperName pn ++ "(..)"
1074+prettyPrintRef (TypeRef pn Nothing) =
1075+ Just $ runProperName pn ++ "(..)"
1231−prettyPrintRef (TypeRef pn (Just [])) = runProperName pn
1076+prettyPrintRef (TypeRef pn (Just [])) =
1077+ Just $ runProperName pn
1078+prettyPrintRef (TypeRef pn (Just dctors)) =
1232−prettyPrintRef (TypeRef pn (Just dctors)) = runProperName pn ++ "(" ++ intercalate ", " (map runProperName dctors) ++ ")"
1079+ Just $ runProperName pn ++ "(" ++ intercalate ", " (map runProperName dctors) ++ ")"
1233−prettyPrintRef (TypeOpRef ident) = "type " ++ showIdent ident
1080+prettyPrintRef (TypeOpRef op) =
1081+ Just $ "type " ++ showOp op
1234−prettyPrintRef (ValueRef ident) = showIdent ident
1082+prettyPrintRef (ValueRef ident) =
1083+ Just $ showIdent ident
1084+prettyPrintRef (ValueOpRef op) =
1086+prettyPrintRef (TypeClassRef pn) =
1235−prettyPrintRef (TypeClassRef pn) = "class " ++ runProperName pn
1087+ Just $ "class " ++ runProperName pn
1236−prettyPrintRef (ProperRef name) = name
1237−prettyPrintRef (TypeInstanceRef ident) = showIdent ident
1088+prettyPrintRef (TypeInstanceRef ident) =
1089+ Just $ showIdent ident
1238−prettyPrintRef (ModuleRef name) = "module " ++ runModuleName name
1090+prettyPrintRef (ModuleRef name) =
1091+ Just $ "module " ++ runModuleName name
1092+prettyPrintRef (ReExportRef _ _) =
1239−prettyPrintRef (PositionedDeclarationRef _ _ ref) = prettyPrintExport ref
1094+prettyPrintRef (PositionedDeclarationRef _ _ ref) =
1242-- Pretty print multiple errors
1098-- Pretty print multiple errors
1244−prettyPrintMultipleErrors :: Bool -> MultipleErrors -> String
1100+prettyPrintMultipleErrors :: PPEOptions -> MultipleErrors -> String
1245−prettyPrintMultipleErrors full = unlines . map renderBox . prettyPrintMultipleErrorsBox full
1101+prettyPrintMultipleErrors ppeOptions = unlines . map renderBox . prettyPrintMultipleErrorsBox ppeOptions
1248-- Pretty print multiple warnings
1104-- Pretty print multiple warnings
1250−prettyPrintMultipleWarnings :: Bool -> MultipleErrors -> String
1106+prettyPrintMultipleWarnings :: PPEOptions -> MultipleErrors -> String
1251−prettyPrintMultipleWarnings full = unlines . map renderBox . prettyPrintMultipleWarningsBox full
1107+prettyPrintMultipleWarnings ppeOptions = unlines . map renderBox . prettyPrintMultipleWarningsBox ppeOptions
1253-- | Pretty print warnings as a Box
1109-- | Pretty print warnings as a Box
1254−prettyPrintMultipleWarningsBox :: Bool -> MultipleErrors -> [Box.Box]
1110+prettyPrintMultipleWarningsBox :: PPEOptions -> MultipleErrors -> [Box.Box]
1255−prettyPrintMultipleWarningsBox = prettyPrintMultipleErrorsWith Warning "Warning found:" "Warning"
1111+prettyPrintMultipleWarningsBox ppeOptions = prettyPrintMultipleErrorsWith (ppeOptions { ppeLevel = Warning }) "Warning found:" "Warning"
1257-- | Pretty print errors as a Box
1113-- | Pretty print errors as a Box
1258−prettyPrintMultipleErrorsBox :: Bool -> MultipleErrors -> [Box.Box]
1114+prettyPrintMultipleErrorsBox :: PPEOptions -> MultipleErrors -> [Box.Box]
1259−prettyPrintMultipleErrorsBox = prettyPrintMultipleErrorsWith Error "Error found:" "Error"
1115+prettyPrintMultipleErrorsBox ppeOptions = prettyPrintMultipleErrorsWith (ppeOptions { ppeLevel = Error }) "Error found:" "Error"
1261−prettyPrintMultipleErrorsWith :: Level -> String -> String -> Bool -> MultipleErrors -> [Box.Box]
1117+prettyPrintMultipleErrorsWith :: PPEOptions -> String -> String -> MultipleErrors -> [Box.Box]
1262−prettyPrintMultipleErrorsWith level intro _ full (MultipleErrors [e]) =
1118+prettyPrintMultipleErrorsWith ppeOptions intro _ (MultipleErrors [e]) =
1263− let result = prettyPrintSingleError full level True e
1119+ let result = prettyPrintSingleError ppeOptions e
1264 in [ Box.vcat Box.left [ Box.text intro
1120 in [ Box.vcat Box.left [ Box.text intro
1265 , result
1121 , result
1268−prettyPrintMultipleErrorsWith level _ intro full (MultipleErrors es) =
1124+prettyPrintMultipleErrorsWith ppeOptions _ intro (MultipleErrors es) =
1269− let result = map (prettyPrintSingleError full level True) es
1125+ let result = map (prettyPrintSingleError ppeOptions) es
1270 in concat $ zipWith withIntro [1 :: Int ..] result
1126 in concat $ zipWith withIntro [1 :: Int ..] result
1272 withIntro i err = [ Box.text (intro ++ " " ++ show i ++ " of " ++ show (length es) ++ ":")
1128 withIntro i err = [ Box.text (intro ++ " " ++ show i ++ " of " ++ show (length es) ++ ":")