git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Add suggestion framework with "Did you mean composition" example
commite65645ea0a32a87c3770a39d4873a105e440bb7d authorMichael <mjg.py3@gmail.com> dateMon 27 Apr 2015, 23:37 (12 years ago) parent498dadc
7 files changed+277−237
psc-make/Main.hs+4−4 psci/PSCi.hs+4−4 src/Language/PureScript/Environment.hs+8 src/Language/PureScript/Errors.hs+253−221 src/Language/PureScript/Sugar/Names.hs+4−4 src/Language/PureScript/TypeChecker/Skolems.hs+1−1 src/Language/PureScript/TypeChecker/Synonyms.hs+3−3
psc-make/Main.hs+4−4
@@ -62,16 +62,16 @@ runMake opts = runExceptT . runWriterT . flip runReaderT opts . unMake
6262makeIO :: (IOError -> P.ErrorMessage) -> IO a -> Make a
6363makeIO f io = do
6464 e <- liftIO $ tryIOError io
65− either (throwError . P.errorMessage . f) return e
65+ either (throwError . P.singleError . f) return e
6666
6767instance P.MonadMake Make where
68− getTimestamp path = makeIO (const (P.CannotGetFileInfo path)) $ do
68+ getTimestamp path = makeIO (const (P.SimpleErrorWrapper $ P.CannotGetFileInfo path)) $ do
6969 exists <- doesFileExist path
7070 traverse (const $ getModificationTime path) $ guard exists
71− readTextFile path = makeIO (const (P.CannotReadFile path))$ do
71+ readTextFile path = makeIO (const (P.SimpleErrorWrapper $ P.CannotReadFile path)) $ do
7272 putStrLn $ "Reading " ++ path
7373 readFile path
74− writeTextFile path text = makeIO (const (P.CannotWriteFile path)) $ do
74+ writeTextFile path text = makeIO (const (P.SimpleErrorWrapper $ P.CannotWriteFile path)) $ do
7575 mkdirp path
7676 putStrLn $ "Writing " ++ path
7777 writeFile path text
psci/PSCi.hs+4−4
@@ -221,14 +221,14 @@ runMake = runExceptT . fmap fst . runWriterT . flip runReaderT options . unMake
221221makeIO :: (IOError -> P.ErrorMessage) -> IO a -> Make a
222222makeIO f io = do
223223 e <- liftIO $ tryIOError io
224− either (throwError . P.errorMessage . f) return e
224+ either (throwError . P.singleError . f) return e
225225
226226instance P.MonadMake Make where
227− getTimestamp path = makeIO (const (P.CannotGetFileInfo path)) $ do
227+ getTimestamp path = makeIO (const (P.SimpleErrorWrapper $ P.CannotGetFileInfo path)) $ do
228228 exists <- doesFileExist path
229229 traverse (const $ getModificationTime path) $ guard exists
230− readTextFile path = makeIO (const (P.CannotReadFile path)) $ readFile path
231− writeTextFile path text = makeIO (const (P.CannotWriteFile path)) $ do
230+ readTextFile path = makeIO (const (P.SimpleErrorWrapper $ P.CannotReadFile path)) $ readFile path
231+ writeTextFile path text = makeIO (const (P.SimpleErrorWrapper $ P.CannotWriteFile path)) $ do
232232 mkdirp path
233233 writeFile path text
234234 progress s = unless ("Compiling $PSCI" `isPrefixOf` s) $ liftIO . putStrLn $ s
src/Language/PureScript/Environment.hs+8
@@ -220,6 +220,14 @@ tyArray = primTy "Array"
220220tyObject :: Type
221221tyObject = primTy "Object"
222222
223+-- |
224+-- Check whether a type is an object
225+--
226+isObject :: Type -> Bool
227+isObject = (==) tyObject . extract
228+ where extract (TypeApp t _) = t
229+ extract t = t
230+
223231-- |
224232-- Smart constructor for function types
225233--
src/Language/PureScript/Errors.hs+253−221
@@ -34,6 +34,7 @@ import Control.Monad.Trans.State.Lazy
3434import Control.Arrow(first)
3535
3636import Language.PureScript.AST
37+import Language.PureScript.Environment (isObject)
3738import Language.PureScript.Pretty
3839import Language.PureScript.Types
3940import Language.PureScript.Names
@@ -47,7 +48,7 @@ import qualified Text.Parsec as P
4748-- |
4849-- A type of error messages
4950--
50−data ErrorMessage
51+data SimpleErrorMessage
5152 = ErrorParsingExterns P.ParseError
5253 | ErrorParsingPrelude P.ParseError
5354 | InvalidExternsFile FilePath
@@ -70,7 +71,7 @@ data ErrorMessage
7071 | UnknownDataConstructor (Qualified ProperName) (Maybe (Qualified ProperName))
7172 | UnknownTypeConstructor (Qualified ProperName)
7273 | ConflictingImport String ModuleName
73− | ConflictingImports String ModuleName ModuleName
74+ | ConflictingImports String ModuleName ModuleName
7475 | ConflictingTypeDecls ProperName
7576 | ConflictingCtorDecls ProperName
7677 | TypeConflictsWithClass ProperName
@@ -89,7 +90,6 @@ data ErrorMessage
8990 | NameNotInScope Ident
9091 | UndefinedTypeVariable ProperName
9192 | PartiallyAppliedSynonym (Qualified ProperName)
92− | NotYetDefined [Ident] ErrorMessage
9393 | EscapedSkolem (Maybe Expr)
9494 | UnspecifiedSkolemScope
9595 | TypesDoNotUnify Type Type
@@ -107,7 +107,6 @@ data ErrorMessage
107107 | SubsumptionCheckFailed
108108 | ExprDoesNotHaveType Expr Type
109109 | PropertyIsMissing String Type
110− | ErrorUnifyingTypes Type Type ErrorMessage
111110 | CannotApplyFunction Type Expr
112111 | TypeSynonymInstance
113112 | InvalidNewtype
@@ -115,6 +114,14 @@ data ErrorMessage
115114 | TransitiveExportError DeclarationRef [DeclarationRef]
116115 | ShadowedName Ident
117116 | PreludeNotPresent
117+ deriving (Show)
118+
119+-- |
120+-- Wrapper of simpler errors
121+--
122+data ErrorMessage
123+ = NotYetDefined [Ident] ErrorMessage
124+ | ErrorUnifyingTypes Type Type ErrorMessage
118125 | ErrorInExpression Expr ErrorMessage
119126 | ErrorInModule ModuleName ErrorMessage
120127 | ErrorInInstance (Qualified ProperName) [Type] ErrorMessage
@@ -131,102 +138,86 @@ data ErrorMessage
131138 | ErrorInValueDeclaration Ident ErrorMessage
132139 | ErrorInForeignImport Ident ErrorMessage
133140 | PositionedError SourceSpan ErrorMessage
141+ | SimpleErrorWrapper SimpleErrorMessage
134142 deriving (Show)
135143
136144instance UnificationError Type ErrorMessage where
137− occursCheckFailed = InfiniteType
145+ occursCheckFailed t = SimpleErrorWrapper $ InfiniteType t
138146
139147instance UnificationError Kind ErrorMessage where
140− occursCheckFailed = InfiniteKind
148+ occursCheckFailed k = SimpleErrorWrapper $ InfiniteKind k
141149
142150-- |
143151-- Get the error code for a particular error type
144152--
145153errorCode :: ErrorMessage -> String
146−errorCode (ErrorParsingExterns _) = "ErrorParsingExterns"
147−errorCode (ErrorParsingPrelude _) = "ErrorParsingPrelude"
148−errorCode (InvalidExternsFile _) = "InvalidExternsFile"
149−errorCode (CannotGetFileInfo _) = "CannotGetFileInfo"
150−errorCode (CannotReadFile _) = "CannotReadFile"
151−errorCode (CannotWriteFile _) = "CannotWriteFile"
152−errorCode (InfiniteType _) = "InfiniteType"
153−errorCode (InfiniteKind _) = "InfiniteKind"
154−errorCode CannotReorderOperators = "CannotReorderOperators"
155−errorCode (MultipleFixities _) = "MultipleFixities"
156−errorCode (OrphanTypeDeclaration _) = "OrphanTypeDeclaration"
157−errorCode (OrphanFixityDeclaration _) = "OrphanFixityDeclaration"
158−errorCode (RedefinedModule _) = "RedefinedModule"
159−errorCode (RedefinedIdent _) = "RedefinedIdent"
160−errorCode OverlappingNamesInLet = "OverlappingNamesInLet"
161−errorCode (UnknownModule _) = "UnknownModule"
162−errorCode (UnknownType _) = "UnknownType"
163−errorCode (UnknownTypeClass _) = "UnknownTypeClass"
164−errorCode (UnknownValue _) = "UnknownValue"
165−errorCode (UnknownDataConstructor _ _) = "UnknownDataConstructor"
166−errorCode (UnknownTypeConstructor _) = "UnknownTypeConstructor"
167−errorCode (ConflictingImport _ _) = "ConflictingImport"
168−errorCode (ConflictingImports _ _ _) = "ConflictingImports"
169−errorCode (ConflictingTypeDecls _) = "ConflictingTypeDecls"
170−errorCode (ConflictingCtorDecls _) = "ConflictingCtorDecls"
171−errorCode (TypeConflictsWithClass _) = "TypeConflictsWithClass"
172−errorCode (CtorConflictsWithClass _) = "CtorConflictsWithClass"
173−errorCode (ClassConflictsWithType _) = "ClassConflictsWithType"
174−errorCode (ClassConflictsWithCtor _) = "ClassConflictsWithCtor"
175−errorCode (DuplicateClassExport _) = "DuplicateClassExport"
176−errorCode (DuplicateValueExport _) = "DuplicateValueExport"
177−errorCode (DuplicateTypeArgument _) = "DuplicateTypeArgument"
178−errorCode InvalidDoBind = "InvalidDoBind"
179−errorCode InvalidDoLet = "InvalidDoLet"
180−errorCode (CycleInDeclaration _) = "CycleInDeclaration"
181−errorCode (CycleInTypeSynonym _) = "CycleInTypeSynonym"
182−errorCode (CycleInModules _) = "CycleInModules"
183−errorCode (NameIsUndefined _) = "NameIsUndefined"
184−errorCode (NameNotInScope _) = "NameNotInScope"
185−errorCode (UndefinedTypeVariable _) = "UndefinedTypeVariable"
186−errorCode (PartiallyAppliedSynonym _) = "PartiallyAppliedSynonym"
187−errorCode (EscapedSkolem _) = "EscapedSkolem"
188−errorCode UnspecifiedSkolemScope = "UnspecifiedSkolemScope"
189−errorCode (TypesDoNotUnify _ _) = "TypesDoNotUnify"
190−errorCode (KindsDoNotUnify _ _) = "KindsDoNotUnify"
191−errorCode (ConstrainedTypeUnified _ _) = "ConstrainedTypeUnified"
192−errorCode (OverlappingInstances _ _ _) = "OverlappingInstances"
193−errorCode (NoInstanceFound _ _) = "NoInstanceFound"
194−errorCode (DuplicateLabel _ _) = "DuplicateLabel"
195−errorCode (DuplicateValueDeclaration _) = "DuplicateValueDeclaration"
196−errorCode (ArgListLengthsDiffer _) = "ArgListLengthsDiffer"
197−errorCode (OverlappingArgNames _) = "OverlappingArgNames"
198−errorCode (MissingClassMember _) = "MissingClassMember"
199−errorCode (ExpectedType _) = "ExpectedType"
200−errorCode (IncorrectConstructorArity _) = "IncorrectConstructorArity"
201−errorCode SubsumptionCheckFailed = "SubsumptionCheckFailed"
202−errorCode (ExprDoesNotHaveType _ _) = "ExprDoesNotHaveType"
203−errorCode (PropertyIsMissing _ _) = "PropertyIsMissing"
204−errorCode (CannotApplyFunction _ _) = "CannotApplyFunction"
205−errorCode TypeSynonymInstance = "TypeSynonymInstance"
206−errorCode InvalidNewtype = "InvalidNewtype"
207−errorCode (InvalidInstanceHead _) = "InvalidInstanceHead"
208−errorCode (TransitiveExportError _ _) = "TransitiveExportError"
209−errorCode (ShadowedName _) = "ShadowedName"
210−errorCode PreludeNotPresent = "PreludeNotPresent"
211−errorCode (NotYetDefined _ e) = errorCode e
212−errorCode (ErrorUnifyingTypes _ _ e) = errorCode e
213−errorCode (ErrorInExpression _ e) = errorCode e
214−errorCode (ErrorInModule _ e) = errorCode e
215−errorCode (ErrorInInstance _ _ e) = errorCode e
216−errorCode (ErrorInSubsumption _ _ e) = errorCode e
217−errorCode (ErrorCheckingType _ _ e) = errorCode e
218−errorCode (ErrorCheckingKind _ e) = errorCode e
219−errorCode (ErrorInferringType _ e) = errorCode e
220−errorCode (ErrorInApplication _ _ _ e) = errorCode e
221−errorCode (ErrorInDataConstructor _ e) = errorCode e
222−errorCode (ErrorInTypeConstructor _ e) = errorCode e
223−errorCode (ErrorInBindingGroup _ e) = errorCode e
224−errorCode (ErrorInDataBindingGroup e) = errorCode e
225−errorCode (ErrorInTypeSynonym _ e) = errorCode e
226−errorCode (ErrorInValueDeclaration _ e) = errorCode e
227−errorCode (ErrorInForeignImport _ e) = errorCode e
228−errorCode (PositionedError _ e) = errorCode e
229−
154+errorCode em = case unwrapErrorMessage em of
155+ (ErrorParsingExterns _) -> "ErrorParsingExterns"
156+ (ErrorParsingPrelude _) -> "ErrorParsingPrelude"
157+ (InvalidExternsFile _) -> "InvalidExternsFile"
158+ (CannotGetFileInfo _) -> "CannotGetFileInfo"
159+ (CannotReadFile _) -> "CannotReadFile"
160+ (CannotWriteFile _) -> "CannotWriteFile"
161+ (InfiniteType _) -> "InfiniteType"
162+ (InfiniteKind _) -> "InfiniteKind"
163+ CannotReorderOperators -> "CannotReorderOperators"
164+ (MultipleFixities _) -> "MultipleFixities"
165+ (OrphanTypeDeclaration _) -> "OrphanTypeDeclaration"
166+ (OrphanFixityDeclaration _) -> "OrphanFixityDeclaration"
167+ (RedefinedModule _) -> "RedefinedModule"
168+ (RedefinedIdent _) -> "RedefinedIdent"
169+ OverlappingNamesInLet -> "OverlappingNamesInLet"
170+ (UnknownModule _) -> "UnknownModule"
171+ (UnknownType _) -> "UnknownType"
172+ (UnknownTypeClass _) -> "UnknownTypeClass"
173+ (UnknownValue _) -> "UnknownValue"
174+ (UnknownDataConstructor _ _) -> "UnknownDataConstructor"
175+ (UnknownTypeConstructor _) -> "UnknownTypeConstructor"
176+ (ConflictingImport _ _) -> "ConflictingImport"
177+ (ConflictingImports _ _ _) -> "ConflictingImports"
178+ (ConflictingTypeDecls _) -> "ConflictingTypeDecls"
179+ (ConflictingCtorDecls _) -> "ConflictingCtorDecls"
180+ (TypeConflictsWithClass _) -> "TypeConflictsWithClass"
181+ (CtorConflictsWithClass _) -> "CtorConflictsWithClass"
182+ (ClassConflictsWithType _) -> "ClassConflictsWithType"
183+ (ClassConflictsWithCtor _) -> "ClassConflictsWithCtor"
184+ (DuplicateClassExport _) -> "DuplicateClassExport"
185+ (DuplicateValueExport _) -> "DuplicateValueExport"
186+ (DuplicateTypeArgument _) -> "DuplicateTypeArgument"
187+ InvalidDoBind -> "InvalidDoBind"
188+ InvalidDoLet -> "InvalidDoLet"
189+ (CycleInDeclaration _) -> "CycleInDeclaration"
190+ (CycleInTypeSynonym _) -> "CycleInTypeSynonym"
191+ (CycleInModules _) -> "CycleInModules"
192+ (NameIsUndefined _) -> "NameIsUndefined"
193+ (NameNotInScope _) -> "NameNotInScope"
194+ (UndefinedTypeVariable _) -> "UndefinedTypeVariable"
195+ (PartiallyAppliedSynonym _) -> "PartiallyAppliedSynonym"
196+ (EscapedSkolem _) -> "EscapedSkolem"
197+ UnspecifiedSkolemScope -> "UnspecifiedSkolemScope"
198+ (TypesDoNotUnify _ _) -> "TypesDoNotUnify"
199+ (KindsDoNotUnify _ _) -> "KindsDoNotUnify"
200+ (ConstrainedTypeUnified _ _) -> "ConstrainedTypeUnified"
201+ (OverlappingInstances _ _ _) -> "OverlappingInstances"
202+ (NoInstanceFound _ _) -> "NoInstanceFound"
203+ (DuplicateLabel _ _) -> "DuplicateLabel"
204+ (DuplicateValueDeclaration _) -> "DuplicateValueDeclaration"
205+ (ArgListLengthsDiffer _) -> "ArgListLengthsDiffer"
206+ (OverlappingArgNames _) -> "OverlappingArgNames"
207+ (MissingClassMember _) -> "MissingClassMember"
208+ (ExpectedType _) -> "ExpectedType"
209+ (IncorrectConstructorArity _) -> "IncorrectConstructorArity"
210+ SubsumptionCheckFailed -> "SubsumptionCheckFailed"
211+ (ExprDoesNotHaveType _ _) -> "ExprDoesNotHaveType"
212+ (PropertyIsMissing _ _) -> "PropertyIsMissing"
213+ (CannotApplyFunction _ _) -> "CannotApplyFunction"
214+ TypeSynonymInstance -> "TypeSynonymInstance"
215+ InvalidNewtype -> "InvalidNewtype"
216+ (InvalidInstanceHead _) -> "InvalidInstanceHead"
217+ (TransitiveExportError _ _) -> "TransitiveExportError"
218+ (ShadowedName _) -> "ShadowedName"
219+ PreludeNotPresent -> "PreludeNotPresent"
220+
230221-- |
231222-- A stack trace for an error
232223--
@@ -234,20 +225,27 @@ newtype MultipleErrors = MultipleErrors
234225 { runMultipleErrors :: [ErrorMessage] } deriving (Show, Monoid)
235226
236227instance UnificationError Type MultipleErrors where
237− occursCheckFailed = errorMessage . occursCheckFailed
228+ occursCheckFailed = occursCheckFailed
238229
239230instance UnificationError Kind MultipleErrors where
240− occursCheckFailed = errorMessage . occursCheckFailed
231+ occursCheckFailed = occursCheckFailed
241232
242233-- | Check whether a collection of errors is empty or not.
243234nonEmpty :: MultipleErrors -> Bool
244235nonEmpty = not . null . runMultipleErrors
245236
237+-- |
238+-- Create an error set from a single simple error message
239+--
240+errorMessage :: SimpleErrorMessage -> MultipleErrors
241+errorMessage err = MultipleErrors [SimpleErrorWrapper err]
242+
243+
246244-- |
247245-- Create an error set from a single error message
248246--
249−errorMessage :: ErrorMessage -> MultipleErrors
250−errorMessage err = MultipleErrors [err]
247+singleError :: ErrorMessage -> MultipleErrors
248+singleError = MultipleErrors . pure
251249
252250-- |
253251-- Lift a function on ErrorMessage to a function on MultipleErrors
@@ -261,6 +259,31 @@ data LabelType = TypeLabel | SkolemLabel String deriving (Show, Eq, Ord)
261259-- | A map from rigid type variable name/unknown variable pairs to new variables.
262260type UnknownMap = M.Map (LabelType, Unknown) Unknown
263261
262+-- |
263+-- Extract nested error messages from wrapper errors
264+--
265+unwrapErrorMessage :: ErrorMessage -> SimpleErrorMessage
266+unwrapErrorMessage em = case em of
267+ (ErrorCheckingKind _ err) -> unwrapErrorMessage err
268+ (ErrorCheckingType _ _ err) -> unwrapErrorMessage err
269+ (ErrorInApplication _ _ _ err) -> unwrapErrorMessage err
270+ (ErrorInBindingGroup _ err) -> unwrapErrorMessage err
271+ (ErrorInDataBindingGroup err) -> unwrapErrorMessage err
272+ (ErrorInDataConstructor _ err) -> unwrapErrorMessage err
273+ (ErrorInExpression _ err) -> unwrapErrorMessage err
274+ (ErrorInForeignImport _ err) -> unwrapErrorMessage err
275+ (ErrorInInstance _ _ err) -> unwrapErrorMessage err
276+ (ErrorInModule _ err) -> unwrapErrorMessage err
277+ (ErrorInSubsumption _ _ err) -> unwrapErrorMessage err
278+ (ErrorInTypeConstructor _ err) -> unwrapErrorMessage err
279+ (ErrorInTypeSynonym _ err) -> unwrapErrorMessage err
280+ (ErrorInValueDeclaration _ err) -> unwrapErrorMessage err
281+ (ErrorInferringType _ err) -> unwrapErrorMessage err
282+ (ErrorUnifyingTypes _ _ err) -> unwrapErrorMessage err
283+ (NotYetDefined _ err) -> unwrapErrorMessage err
284+ (PositionedError _ err) -> unwrapErrorMessage err
285+ (SimpleErrorWrapper sem) -> sem
286+
264287replaceUnknowns :: Type -> State UnknownMap Type
265288replaceUnknowns = everywhereOnTypesM replaceTypes
266289 where
@@ -277,15 +300,16 @@ replaceUnknowns = everywhereOnTypesM replaceTypes
277300onTypesInErrorMessageM :: (Applicative m) => (Type -> m Type) -> ErrorMessage -> m ErrorMessage
278301onTypesInErrorMessageM f = g
279302 where
280− g (InfiniteType t) = InfiniteType <$> (f t)
281− g (TypesDoNotUnify t1 t2) = TypesDoNotUnify <$> (f t1) <*> (f t2)
282− g (ConstrainedTypeUnified t1 t2) = ConstrainedTypeUnified <$> (f t1) <*> (f t2)
283− g (ExprDoesNotHaveType e t) = ExprDoesNotHaveType e <$> (f t)
284− g (PropertyIsMissing s t) = PropertyIsMissing s <$> (f t)
285− g (ErrorUnifyingTypes t1 t2 e) = ErrorUnifyingTypes <$> (f t1) <*> (f t2) <*> (g e)
286− g (CannotApplyFunction t e) = CannotApplyFunction <$> f t <*> (pure e)
287− g (InvalidInstanceHead t) = InvalidInstanceHead <$> f t
303+ gSimple (InfiniteType t) = InfiniteType <$> (f t)
304+ gSimple (TypesDoNotUnify t1 t2) = TypesDoNotUnify <$> (f t1) <*> (f t2)
305+ gSimple (ConstrainedTypeUnified t1 t2) = ConstrainedTypeUnified <$> (f t1) <*> (f t2)
306+ gSimple (ExprDoesNotHaveType e t) = ExprDoesNotHaveType e <$> (f t)
307+ gSimple (PropertyIsMissing s t) = PropertyIsMissing s <$> (f t)
308+ gSimple (CannotApplyFunction t e) = CannotApplyFunction <$> f t <*> (pure e)
309+ gSimple (InvalidInstanceHead t) = InvalidInstanceHead <$> f t
310+ gSimple other = pure other
288311 g (ErrorInSubsumption t1 t2 em) = ErrorInSubsumption <$> (f t1) <*> (f t2) <*> (g em)
312+ g (ErrorUnifyingTypes t1 t2 e) = ErrorUnifyingTypes <$> (f t1) <*> (f t2) <*> (g e)
289313 g (ErrorCheckingType e t em) = ErrorCheckingType e <$> (f t) <*> (g em)
290314 g (ErrorCheckingKind t em) = ErrorCheckingKind <$> (f t) <*> g em
291315 g (ErrorInApplication e1 t1 e2 em) = ErrorInApplication e1 <$> (f t1) <*> (pure e2) <*> (g em)
@@ -302,7 +326,7 @@ onTypesInErrorMessageM f = g
302326 g (ErrorInValueDeclaration x e) = ErrorInValueDeclaration x <$> (g e)
303327 g (ErrorInForeignImport x e) = ErrorInForeignImport x <$> (g e)
304328 g (PositionedError x e) = PositionedError x <$> (g e)
305− g other = pure other
329+ g (SimpleErrorWrapper sem) = SimpleErrorWrapper <$> gSimple sem
306330
307331-- |
308332-- Pretty print a single error, simplifying if necessary
@@ -315,132 +339,131 @@ prettyPrintSingleError full e = prettyPrintErrorMessage <$> onTypesInErrorMessag
315339 --
316340 prettyPrintErrorMessage :: ErrorMessage -> Box.Box
317341 prettyPrintErrorMessage em =
318− paras
319− [ go em
320− , line ("See " ++ wikiUri ++ " for more information, or to contribute content related to this error.")
321− ]
342+ paras $
343+ go em:suggestions em ++
344+ [line $ "See " ++ wikiUri ++ " for more information, or to contribute content related to this error."]
322345 where
323346 wikiUri :: String
324347 wikiUri = "https://github.com/purescript/purescript/wiki/Error-Code-" ++ errorCode e
325348
326349 go :: ErrorMessage -> Box.Box
327− go (CannotGetFileInfo path) = paras [ line "Unable to read file info: "
328− , indent . line $ path
329− ]
330− go (CannotReadFile path) = paras [ line "Unable to read file: "
331− , indent . line $ path
332− ]
333− go (CannotWriteFile path) = paras [ line "Unable to write file: "
334− , indent . line $ path
335− ]
336− go (ErrorParsingExterns err) = paras [ line "Error parsing externs files: "
337− , indent . line . show $ err
338− ]
339− go (ErrorParsingPrelude err) = paras [ line "Error parsing prelude: "
340− , indent . line . show $ err
341− ]
342− go (InvalidExternsFile path) = paras [ line "Externs file is invalid: "
343− , indent . line $ path
344− ]
345− go InvalidDoBind = line "Bind statement cannot be the last statement in a do block"
346− go InvalidDoLet = line "Let statement cannot be the last statement in a do block"
347− go CannotReorderOperators = line "Unable to reorder operators"
348− go UnspecifiedSkolemScope = line "Skolem variable scope is unspecified"
349− go OverlappingNamesInLet = line "Overlapping names in let binding."
350− go (InfiniteType ty) = paras [ line "Infinite type detected: "
351− , indent $ line $ prettyPrintType ty
352− ]
353− go (InfiniteKind ki) = paras [ line "Infinite kind detected: "
354− , indent $ line $ prettyPrintKind ki
355− ]
356− go (MultipleFixities name) = line $ "Multiple fixity declarations for " ++ show name
357− go (OrphanTypeDeclaration nm) = line $ "Orphan type declaration for " ++ show nm
358− go (OrphanFixityDeclaration op) = line $ "Orphan fixity declaration for " ++ show op
359− go (RedefinedModule name) = line $ "Module " ++ show name ++ " has been defined multiple times"
360− go (RedefinedIdent name) = line $ "Name " ++ show name ++ " has been defined multiple times"
361− go (UnknownModule mn) = line $ "Unknown module " ++ show mn
362− go (UnknownType name) = line $ "Unknown type " ++ show name
363− go (UnknownTypeClass name) = line $ "Unknown type class " ++ show name
364− go (UnknownValue name) = line $ "Unknown value " ++ show name
365− go (UnknownTypeConstructor name) = line $ "Unknown type constructor " ++ show name
366− go (UnknownDataConstructor dc tc) = line $ "Unknown data constructor " ++ show dc ++ foldMap ((" for type constructor " ++) . show) tc
367− go (ConflictingImport nm mn) = line $ "Declaration " ++ nm ++ " conflicts with import " ++ show mn
368− go (ConflictingImports nm m1 m2) = line $ "Conflicting imports for " ++ nm ++ " from modules " ++ show m1 ++ " and " ++ show m2
369− go (ConflictingTypeDecls nm) = line $ "Conflicting type declarations for " ++ show nm
370− go (ConflictingCtorDecls nm) = line $ "Conflicting data constructor declarations for " ++ show nm
371− go (TypeConflictsWithClass nm) = line $ "Type " ++ show nm ++ " conflicts with type class declaration of the same name"
372− go (CtorConflictsWithClass nm) = line $ "Data constructor " ++ show nm ++ " conflicts with type class declaration of the same name"
373− go (ClassConflictsWithType nm) = line $ "Type class " ++ show nm ++ " conflicts with type declaration of the same name"
374− go (ClassConflictsWithCtor nm) = line $ "Type class " ++ show nm ++ " conflicts with data constructor declaration of the same name"
375− go (DuplicateClassExport nm) = line $ "Duplicate export declaration for type class " ++ show nm
376− go (DuplicateValueExport nm) = line $ "Duplicate export declaration for value " ++ show nm
377− go (CycleInDeclaration nm) = line $ "Cycle in declaration of " ++ show nm
378− go (CycleInModules mns) = line $ "Cycle in module dependencies: " ++ intercalate ", " (map show mns)
350+ goSimple (CannotGetFileInfo path) = paras [ line "Unable to read file info: "
351+ , indent . line $ path
352+ ]
353+ goSimple (CannotReadFile path) = paras [ line "Unable to read file: "
354+ , indent . line $ path
355+ ]
356+ goSimple (CannotWriteFile path) = paras [ line "Unable to write file: "
357+ , indent . line $ path
358+ ]
359+ goSimple (ErrorParsingExterns err) = paras [ line "Error parsing externs files: "
360+ , indent . line . show $ err
361+ ]
362+ goSimple (ErrorParsingPrelude err) = paras [ line "Error parsing prelude: "
363+ , indent . line . show $ err
364+ ]
365+ goSimple (InvalidExternsFile path) = paras [ line "Externs file is invalid: "
366+ , indent . line $ path
367+ ]
368+ goSimple InvalidDoBind = line "Bind statement cannot be the last statement in a do block"
369+ goSimple InvalidDoLet = line "Let statement cannot be the last statement in a do block"
370+ goSimple CannotReorderOperators = line "Unable to reorder operators"
371+ goSimple UnspecifiedSkolemScope = line "Skolem variable scope is unspecified"
372+ goSimple OverlappingNamesInLet = line "Overlapping names in let binding."
373+ goSimple (InfiniteType ty) = paras [ line "Infinite type detected: "
374+ , indent $ line $ prettyPrintType ty
375+ ]
376+ goSimple (InfiniteKind ki) = paras [ line "Infinite kind detected: "
377+ , indent $ line $ prettyPrintKind ki
378+ ]
379+ goSimple (MultipleFixities name) = line $ "Multiple fixity declarations for " ++ show name
380+ goSimple (OrphanTypeDeclaration nm) = line $ "Orphan type declaration for " ++ show nm
381+ goSimple (OrphanFixityDeclaration op) = line $ "Orphan fixity declaration for " ++ show op
382+ goSimple (RedefinedModule name) = line $ "Module " ++ show name ++ " has been defined multiple times"
383+ goSimple (RedefinedIdent name) = line $ "Name " ++ show name ++ " has been defined multiple times"
384+ goSimple (UnknownModule mn) = line $ "Unknown module " ++ show mn
385+ goSimple (UnknownType name) = line $ "Unknown type " ++ show name
386+ goSimple (UnknownTypeClass name) = line $ "Unknown type class " ++ show name
387+ goSimple (UnknownValue name) = line $ "Unknown value " ++ show name
388+ goSimple (UnknownTypeConstructor name) = line $ "Unknown type constructor " ++ show name
389+ goSimple (UnknownDataConstructor dc tc) = line $ "Unknown data constructor " ++ show dc ++ foldMap ((" for type constructor " ++) . show) tc
390+ goSimple (ConflictingImport nm mn) = line $ "Declaration " ++ nm ++ " conflicts with import " ++ show mn
391+ goSimple (ConflictingImports nm m1 m2) = line $ "Conflicting imports for " ++ nm ++ " from modules " ++ show m1 ++ " and " ++ show m2
392+ goSimple (ConflictingTypeDecls nm) = line $ "Conflicting type declarations for " ++ show nm
393+ goSimple (ConflictingCtorDecls nm) = line $ "Conflicting data constructor declarations for " ++ show nm
394+ goSimple (TypeConflictsWithClass nm) = line $ "Type " ++ show nm ++ " conflicts with type class declaration of the same name"
395+ goSimple (CtorConflictsWithClass nm) = line $ "Data constructor " ++ show nm ++ " conflicts with type class declaration of the same name"
396+ goSimple (ClassConflictsWithType nm) = line $ "Type class " ++ show nm ++ " conflicts with type declaration of the same name"
397+ goSimple (ClassConflictsWithCtor nm) = line $ "Type class " ++ show nm ++ " conflicts with data constructor declaration of the same name"
398+ goSimple (DuplicateClassExport nm) = line $ "Duplicate export declaration for type class " ++ show nm
399+ goSimple (DuplicateValueExport nm) = line $ "Duplicate export declaration for value " ++ show nm
400+ goSimple (CycleInDeclaration nm) = line $ "Cycle in declaration of " ++ show nm
401+ goSimple (CycleInModules mns) = line $ "Cycle in module dependencies: " ++ intercalate ", " (map show mns)
402+ goSimple (CycleInTypeSynonym pn) = line $ "Cycle in type synonym" ++ foldMap ((" " ++) . show) pn
403+ goSimple (NameIsUndefined ident) = line $ show ident ++ " is undefined"
404+ goSimple (NameNotInScope ident) = line $ show ident ++ " may not be defined in the current scope"
405+ goSimple (UndefinedTypeVariable name) = line $ "Type variable " ++ show name ++ " is undefined"
406+ goSimple (PartiallyAppliedSynonym name) = line $ "Partially applied type synonym " ++ show name
407+ goSimple (EscapedSkolem binding) = paras $ [ line "Rigid/skolem type variable has escaped." ]
408+ <> foldMap (\expr -> [ line "Relevant expression: "
409+ , indent $ line $ prettyPrintValue expr
410+ ]) binding
411+ goSimple (TypesDoNotUnify t1 t2) = paras [ line "Cannot unify type"
412+ , indent $ line $ prettyPrintType t1
413+ , line "with type"
414+ , indent $ line $ prettyPrintType t2
415+ ]
416+ goSimple (KindsDoNotUnify k1 k2) = paras [ line "Cannot unify kind"
417+ , indent $ line $ prettyPrintKind k1
418+ , line "with kind"
419+ , indent $ line $ prettyPrintKind k2
420+ ]
421+ goSimple (ConstrainedTypeUnified t1 t2) = paras [ line "Cannot unify constrained type"
422+ , indent $ line $ prettyPrintType t1
423+ , line "with type"
424+ , indent $ line $ prettyPrintType t2
425+ ]
426+ goSimple (OverlappingInstances nm ts ds) = paras [ line $ "Overlapping instances found for " ++ show nm ++ " " ++ unwords (map prettyPrintTypeAtom ts) ++ ":"
427+ , paras $ map prettyPrintDictionaryValue ds
428+ ]
429+ goSimple (NoInstanceFound nm ts) = line $ "No instance found for " ++ show nm ++ " " ++ unwords (map prettyPrintTypeAtom ts)
430+ goSimple (DuplicateLabel l expr) = paras $ [ line $ "Duplicate label " ++ show l ++ " in row." ]
431+ <> foldMap (\expr' -> [ line "Relevant expression: "
432+ , indent $ line $ prettyPrintValue expr'
433+ ]) expr
434+ goSimple (DuplicateTypeArgument name) = line $ "Duplicate type argument " ++ show name
435+ goSimple (DuplicateValueDeclaration nm) = line $ "Duplicate value declaration for " ++ show nm
436+ goSimple (ArgListLengthsDiffer ident) = line $ "Argument list lengths differ in declaration " ++ show ident
437+ goSimple (OverlappingArgNames ident) = line $ "Overlapping names in function/binder" ++ foldMap ((" in declaration" ++) . show) ident
438+ goSimple (MissingClassMember ident) = line $ "Member " ++ show ident ++ " has not been implemented"
439+ goSimple (ExpectedType kind) = line $ "Expected type of kind *, was " ++ prettyPrintKind kind
440+ goSimple (IncorrectConstructorArity nm) = line $ "Wrong number of arguments to constructor " ++ show nm
441+ goSimple SubsumptionCheckFailed = line $ "Unable to check type subsumption"
442+ goSimple (ExprDoesNotHaveType expr ty) = paras [ line "Expression"
443+ , indent $ line $ prettyPrintValue expr
444+ , line "does not have type"
445+ , indent $ line $ prettyPrintType ty
446+ ]
447+ goSimple (PropertyIsMissing prop row) = line $ "Row " ++ prettyPrintRow row ++ " lacks required property " ++ show prop
448+ goSimple (CannotApplyFunction fn arg) = paras [ line "Cannot apply function of type"
449+ , indent $ line $ prettyPrintType fn
450+ , line "to argument"
451+ , indent $ line $ prettyPrintValue arg
452+ ]
453+ goSimple TypeSynonymInstance = line "Type synonym instances are disallowed"
454+ goSimple InvalidNewtype = line "Newtypes must define a single constructor with a single argument"
455+ goSimple (InvalidInstanceHead ty) = paras [ line "Invalid type in class instance head:"
456+ , indent $ line $ prettyPrintType ty
457+ ]
458+ goSimple (TransitiveExportError x ys) = paras $ (line $ "An export for " ++ prettyPrintExport x ++ " requires the following to also be exported: ")
459+ : map (line . prettyPrintExport) ys
460+ goSimple (ShadowedName nm) = line $ "Name '" ++ show nm ++ "' was shadowed."
461+ goSimple PreludeNotPresent = paras [ line $ "There is no Prelude module loaded, and the --no-prelude option was not specified."
462+ , line $ "You probably need to install the Prelude and other dependencies using Bower."
463+ ]
379464 go (NotYetDefined names err) = paras [ line $ "The following are not yet defined here: " ++ intercalate ", " (map show names) ++ ":"
380465 , indent $ go err
381466 ]
382− go (CycleInTypeSynonym pn) = line $ "Cycle in type synonym" ++ foldMap ((" " ++) . show) pn
383− go (NameIsUndefined ident) = line $ show ident ++ " is undefined"
384− go (NameNotInScope ident) = line $ show ident ++ " may not be defined in the current scope"
385− go (UndefinedTypeVariable name) = line $ "Type variable " ++ show name ++ " is undefined"
386− go (PartiallyAppliedSynonym name) = line $ "Partially applied type synonym " ++ show name
387− go (EscapedSkolem binding) = paras $ [ line "Rigid/skolem type variable has escaped." ]
388− <> foldMap (\expr -> [ line "Relevant expression: "
389− , indent $ line $ prettyPrintValue expr
390− ]) binding
391− go (TypesDoNotUnify t1 t2) = paras [ line "Cannot unify type"
392− , indent $ line $ prettyPrintType t1
393− , line "with type"
394− , indent $ line $ prettyPrintType t2
395− ]
396− go (KindsDoNotUnify k1 k2) = paras [ line "Cannot unify kind"
397− , indent $ line $ prettyPrintKind k1
398− , line "with kind"
399− , indent $ line $ prettyPrintKind k2
400− ]
401− go (ConstrainedTypeUnified t1 t2) = paras [ line "Cannot unify constrained type"
402− , indent $ line $ prettyPrintType t1
403− , line "with type"
404− , indent $ line $ prettyPrintType t2
405− ]
406− go (OverlappingInstances nm ts ds) = paras [ line $ "Overlapping instances found for " ++ show nm ++ " " ++ unwords (map prettyPrintTypeAtom ts) ++ ":"
407− , paras $ map prettyPrintDictionaryValue ds
408− ]
409− go (NoInstanceFound nm ts) = line $ "No instance found for " ++ show nm ++ " " ++ unwords (map prettyPrintTypeAtom ts)
410− go (DuplicateLabel l expr) = paras $ [ line $ "Duplicate label " ++ show l ++ " in row." ]
411− <> foldMap (\expr' -> [ line "Relevant expression: "
412− , indent $ line $ prettyPrintValue expr'
413− ]) expr
414− go (DuplicateTypeArgument name) = line $ "Duplicate type argument " ++ show name
415− go (DuplicateValueDeclaration nm) = line $ "Duplicate value declaration for " ++ show nm
416− go (ArgListLengthsDiffer ident) = line $ "Argument list lengths differ in declaration " ++ show ident
417− go (OverlappingArgNames ident) = line $ "Overlapping names in function/binder" ++ foldMap ((" in declaration" ++) . show) ident
418− go (MissingClassMember ident) = line $ "Member " ++ show ident ++ " has not been implemented"
419− go (ExpectedType kind) = line $ "Expected type of kind *, was " ++ prettyPrintKind kind
420− go (IncorrectConstructorArity nm) = line $ "Wrong number of arguments to constructor " ++ show nm
421− go SubsumptionCheckFailed = line $ "Unable to check type subsumption"
422− go (ExprDoesNotHaveType expr ty) = paras [ line "Expression"
423− , indent $ line $ prettyPrintValue expr
424− , line "does not have type"
425− , indent $ line $ prettyPrintType ty
426− ]
427− go (PropertyIsMissing prop row) = line $ "Row " ++ prettyPrintRow row ++ " lacks required property " ++ show prop
428− go (CannotApplyFunction fn arg) = paras [ line "Cannot apply function of type"
429− , indent $ line $ prettyPrintType fn
430− , line "to argument"
431− , indent $ line $ prettyPrintValue arg
432− ]
433− go TypeSynonymInstance = line "Type synonym instances are disallowed"
434− go InvalidNewtype = line "Newtypes must define a single constructor with a single argument"
435− go (InvalidInstanceHead ty) = paras [ line "Invalid type in class instance head:"
436− , indent $ line $ prettyPrintType ty
437− ]
438− go (TransitiveExportError x ys) = paras $ (line $ "An export for " ++ prettyPrintExport x ++ " requires the following to also be exported: ")
439− : map (line . prettyPrintExport) ys
440− go (ShadowedName nm) = line $ "Name '" ++ show nm ++ "' was shadowed."
441− go PreludeNotPresent = paras [ line $ "There is no Prelude module loaded, and the --no-prelude option was not specified."
442− , line $ "You probably need to install the Prelude and other dependencies using Bower."
443− ]
444467 go (ErrorUnifyingTypes t1 t2 err) = paras [ line "Error unifying type "
445468 , indent $ line $ prettyPrintType t1
446469 , line "with type"
@@ -509,10 +532,19 @@ prettyPrintSingleError full e = prettyPrintErrorMessage <$> onTypesInErrorMessag
509532 go (PositionedError srcSpan err) = paras [ line $ "Error at " ++ displaySourceSpan srcSpan ++ ":"
510533 , indent $ go err
511534 ]
535+ go (SimpleErrorWrapper sem) = goSimple sem
512536
513537 line :: String -> Box.Box
514538 line = Box.text
515539
540+ suggestions :: ErrorMessage -> [Box.Box]
541+ suggestions = suggestions' . unwrapErrorMessage
542+ where
543+ suggestions' (TypesDoNotUnify t1 t2)
544+ | any isObject [t1, t2] = [line "Note that function composition in PureScript is defined using `(<<<)`"]
545+ | otherwise = []
546+ suggestions' _ = []
547+
516548 paras :: [Box.Box] -> Box.Box
517549 paras = Box.vcat Box.left
518550
src/Language/PureScript/Sugar/Names.hs+4−4
@@ -142,7 +142,7 @@ addValue env mn name = updateExportedModule env mn $ \m -> do
142142-- Adds an entry to a list of exports unless it is already present, in which case an error is
143143-- returned.
144144--
145−addExport :: (Applicative m, MonadError MultipleErrors m, Eq a, Show a) => (a -> ErrorMessage) -> [a] -> a -> m [a]
145+addExport :: (Applicative m, MonadError MultipleErrors m, Eq a, Show a) => (a -> SimpleErrorMessage) -> [a] -> a -> m [a]
146146addExport what exports name =
147147 if name `elem` exports
148148 then throwConflictError what name
@@ -279,7 +279,7 @@ renameInModule imports exports (Module coms mn decls exps) =
279279
280280 -- Update names so unqualified references become qualified, and locally qualified references
281281 -- are replaced with their canoncial qualified names (e.g. M.Map -> Data.Map.Map)
282− update :: (Ord a, Show a) => (Qualified a -> ErrorMessage)
282+ update :: (Ord a, Show a) => (Qualified a -> SimpleErrorMessage)
283283 -> (ImportEnvironment -> M.Map (Qualified a) (Qualified a))
284284 -> (Exports -> a -> Bool)
285285 -> Qualified a
@@ -529,7 +529,7 @@ resolveImport currentModule importModule exps imps impQual =
529529 checkDctorExists = checkImportExists (flip UnknownDataConstructor Nothing)
530530
531531 -- Check that an explicitly imported item exists in the module it is being imported from
532− checkImportExists :: (Eq a, Show a) => (Qualified a -> ErrorMessage) -> [a] -> a -> m a
532+ checkImportExists :: (Eq a, Show a) => (Qualified a -> SimpleErrorMessage) -> [a] -> a -> m a
533533 checkImportExists unknown exports item =
534534 if item `elem` exports
535535 then return item
@@ -538,5 +538,5 @@ resolveImport currentModule importModule exps imps impQual =
538538-- |
539539-- Raises an error for when there is more than one definition for something.
540540--
541−throwConflictError :: (Applicative m, MonadError MultipleErrors m, Show a) => (a -> ErrorMessage) -> a -> m b
541+throwConflictError :: (Applicative m, MonadError MultipleErrors m, Show a) => (a -> SimpleErrorMessage) -> a -> m b
542542throwConflictError conflict = throwError . errorMessage . conflict
src/Language/PureScript/TypeChecker/Skolems.hs+1−1
@@ -88,7 +88,7 @@ skolemEscapeCheck root@TypedValue{} =
8888 let (_, f, _, _, _) = everythingWithContextOnValues [] [] (++) def go def def def
8989 in case f root of
9090 [] -> return ()
91− ((binding, val) : _) -> throwError . errorMessage . ErrorInExpression val $ EscapedSkolem binding
91+ ((binding, val) : _) -> throwError . singleError $ ErrorInExpression val $ SimpleErrorWrapper $ EscapedSkolem binding
9292 where
9393 def s _ = (s, [])
9494
src/Language/PureScript/TypeChecker/Synonyms.hs+3−3
@@ -46,7 +46,7 @@ buildTypeSubstitution name n = go n []
4646 where
4747 go :: Int -> [Type] -> Type -> Either ErrorMessage (Maybe Type)
4848 go 0 args (TypeConstructor ctor) | name == ctor = return (Just $ SaturatedTypeSynonym ctor args)
49− go m _ (TypeConstructor ctor) | m > 0 && name == ctor = throwError $ PartiallyAppliedSynonym name
49+ go m _ (TypeConstructor ctor) | m > 0 && name == ctor = throwError $ SimpleErrorWrapper $ PartiallyAppliedSynonym name
5050 go m args (TypeApp f arg) = go (m - 1) (arg:args) f
5151 go _ _ _ = return Nothing
5252
@@ -87,7 +87,7 @@ replaceAllTypeSynonyms' env d =
8787replaceAllTypeSynonyms :: (e ~ MultipleErrors, Functor m, Monad m, MonadState CheckState m, MonadError e m) => Type -> m Type
8888replaceAllTypeSynonyms d = do
8989 env <- getEnv
90− either (throwError . errorMessage) return $ replaceAllTypeSynonyms' env d
90+ either (throwError . singleError) return $ replaceAllTypeSynonyms' env d
9191
9292-- |
9393-- Replace a type synonym and its arguments with the aliased type
@@ -103,7 +103,7 @@ expandTypeSynonym' env name args =
103103expandTypeSynonym :: (e ~ MultipleErrors, Functor m, Monad m, MonadState CheckState m, MonadError e m) => Qualified ProperName -> [Type] -> m Type
104104expandTypeSynonym name args = do
105105 env <- getEnv
106− either (throwError . errorMessage) return $ expandTypeSynonym' env name args
106+ either (throwError . singleError) return $ expandTypeSynonym' env name args
107107
108108expandAllTypeSynonyms :: (e ~ MultipleErrors, Functor m, Applicative m, Monad m, MonadState CheckState m, MonadError e m) => Type -> m Type
109109expandAllTypeSynonyms = everywhereOnTypesTopDownM go