git.iko.soy/rowtype-yoga/purescript-native
on golang help sign in
Add suggestion framework with "Did you mean composition" example
e65645eMichael
psc-make/Main.hs+4−4
compare with golang
unifiedsplit
@@ -62,16 +62,16 @@ runMake opts = runExceptT . runWriterT . flip runReaderT opts . unMake
62makeIO :: (IOError -> P.ErrorMessage) -> IO a -> Make a
62makeIO :: (IOError -> P.ErrorMessage) -> IO a -> Make a
63makeIO f io = do
63makeIO f io = do
64 e <- liftIO $ tryIOError io
64 e <- liftIO $ tryIOError io
65− either (throwError . P.errorMessage . f) return e
65+ either (throwError . P.singleError . f) return e
66
66
67instance P.MonadMake Make where
67instance P.MonadMake Make where
68− getTimestamp path = makeIO (const (P.CannotGetFileInfo path)) $ do
68+ getTimestamp path = makeIO (const (P.SimpleErrorWrapper $ P.CannotGetFileInfo path)) $ do
69 exists <- doesFileExist path
69 exists <- doesFileExist path
70 traverse (const $ getModificationTime path) $ guard exists
70 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
72 putStrLn $ "Reading " ++ path
72 putStrLn $ "Reading " ++ path
73 readFile path
73 readFile path
74− writeTextFile path text = makeIO (const (P.CannotWriteFile path)) $ do
74+ writeTextFile path text = makeIO (const (P.SimpleErrorWrapper $ P.CannotWriteFile path)) $ do
75 mkdirp path
75 mkdirp path
76 putStrLn $ "Writing " ++ path
76 putStrLn $ "Writing " ++ path
77 writeFile path text
77 writeFile path text
psci/PSCi.hs+4−4
@@ -221,14 +221,14 @@ runMake = runExceptT . fmap fst . runWriterT . flip runReaderT options . unMake
221makeIO :: (IOError -> P.ErrorMessage) -> IO a -> Make a
221makeIO :: (IOError -> P.ErrorMessage) -> IO a -> Make a
222makeIO f io = do
222makeIO f io = do
223 e <- liftIO $ tryIOError io
223 e <- liftIO $ tryIOError io
224− either (throwError . P.errorMessage . f) return e
224+ either (throwError . P.singleError . f) return e
225
225
226instance P.MonadMake Make where
226instance P.MonadMake Make where
227− getTimestamp path = makeIO (const (P.CannotGetFileInfo path)) $ do
227+ getTimestamp path = makeIO (const (P.SimpleErrorWrapper $ P.CannotGetFileInfo path)) $ do
228 exists <- doesFileExist path
228 exists <- doesFileExist path
229 traverse (const $ getModificationTime path) $ guard exists
229 traverse (const $ getModificationTime path) $ guard exists
230− readTextFile path = makeIO (const (P.CannotReadFile path)) $ readFile path
230+ readTextFile path = makeIO (const (P.SimpleErrorWrapper $ P.CannotReadFile path)) $ readFile path
231− writeTextFile path text = makeIO (const (P.CannotWriteFile path)) $ do
231+ writeTextFile path text = makeIO (const (P.SimpleErrorWrapper $ P.CannotWriteFile path)) $ do
232 mkdirp path
232 mkdirp path
233 writeFile path text
233 writeFile path text
234 progress s = unless ("Compiling $PSCI" `isPrefixOf` s) $ liftIO . putStrLn $ s
234 progress s = unless ("Compiling $PSCI" `isPrefixOf` s) $ liftIO . putStrLn $ s
src/Language/PureScript/Environment.hs+8
@@ -220,6 +220,14 @@ tyArray = primTy "Array"
220tyObject :: Type
220tyObject :: Type
221tyObject = primTy "Object"
221tyObject = primTy "Object"
222
222
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+
223-- |
231-- |
224-- Smart constructor for function types
232-- Smart constructor for function types
225--
233--
src/Language/PureScript/Errors.hs+253−221
@@ -34,6 +34,7 @@ import Control.Monad.Trans.State.Lazy
34import Control.Arrow(first)
34import Control.Arrow(first)
35
35
36import Language.PureScript.AST
36import Language.PureScript.AST
37+import Language.PureScript.Environment (isObject)
37import Language.PureScript.Pretty
38import Language.PureScript.Pretty
38import Language.PureScript.Types
39import Language.PureScript.Types
39import Language.PureScript.Names
40import Language.PureScript.Names
@@ -47,7 +48,7 @@ import qualified Text.Parsec as P
47-- |
48-- |
48-- A type of error messages
49-- A type of error messages
49--
50--
50−data ErrorMessage
51+data SimpleErrorMessage
51 = ErrorParsingExterns P.ParseError
52 = ErrorParsingExterns P.ParseError
52 | ErrorParsingPrelude P.ParseError
53 | ErrorParsingPrelude P.ParseError
53 | InvalidExternsFile FilePath
54 | InvalidExternsFile FilePath
@@ -70,7 +71,7 @@ data ErrorMessage
70 | UnknownDataConstructor (Qualified ProperName) (Maybe (Qualified ProperName))
71 | UnknownDataConstructor (Qualified ProperName) (Maybe (Qualified ProperName))
71 | UnknownTypeConstructor (Qualified ProperName)
72 | UnknownTypeConstructor (Qualified ProperName)
72 | ConflictingImport String ModuleName
73 | ConflictingImport String ModuleName
73− | ConflictingImports String ModuleName ModuleName
74+ | ConflictingImports String ModuleName ModuleName
74 | ConflictingTypeDecls ProperName
75 | ConflictingTypeDecls ProperName
75 | ConflictingCtorDecls ProperName
76 | ConflictingCtorDecls ProperName
76 | TypeConflictsWithClass ProperName
77 | TypeConflictsWithClass ProperName
@@ -89,7 +90,6 @@ data ErrorMessage
89 | NameNotInScope Ident
90 | NameNotInScope Ident
90 | UndefinedTypeVariable ProperName
91 | UndefinedTypeVariable ProperName
91 | PartiallyAppliedSynonym (Qualified ProperName)
92 | PartiallyAppliedSynonym (Qualified ProperName)
92− | NotYetDefined [Ident] ErrorMessage
93 | EscapedSkolem (Maybe Expr)
93 | EscapedSkolem (Maybe Expr)
94 | UnspecifiedSkolemScope
94 | UnspecifiedSkolemScope
95 | TypesDoNotUnify Type Type
95 | TypesDoNotUnify Type Type
@@ -107,7 +107,6 @@ data ErrorMessage
107 | SubsumptionCheckFailed
107 | SubsumptionCheckFailed
108 | ExprDoesNotHaveType Expr Type
108 | ExprDoesNotHaveType Expr Type
109 | PropertyIsMissing String Type
109 | PropertyIsMissing String Type
110− | ErrorUnifyingTypes Type Type ErrorMessage
111 | CannotApplyFunction Type Expr
110 | CannotApplyFunction Type Expr
112 | TypeSynonymInstance
111 | TypeSynonymInstance
113 | InvalidNewtype
112 | InvalidNewtype
@@ -115,6 +114,14 @@ data ErrorMessage
115 | TransitiveExportError DeclarationRef [DeclarationRef]
114 | TransitiveExportError DeclarationRef [DeclarationRef]
116 | ShadowedName Ident
115 | ShadowedName Ident
117 | PreludeNotPresent
116 | PreludeNotPresent
117+ deriving (Show)
118+
119+-- |
120+-- Wrapper of simpler errors
121+--
122+data ErrorMessage
123+ = NotYetDefined [Ident] ErrorMessage
124+ | ErrorUnifyingTypes Type Type ErrorMessage
118 | ErrorInExpression Expr ErrorMessage
125 | ErrorInExpression Expr ErrorMessage
119 | ErrorInModule ModuleName ErrorMessage
126 | ErrorInModule ModuleName ErrorMessage
120 | ErrorInInstance (Qualified ProperName) [Type] ErrorMessage
127 | ErrorInInstance (Qualified ProperName) [Type] ErrorMessage
@@ -131,102 +138,86 @@ data ErrorMessage
131 | ErrorInValueDeclaration Ident ErrorMessage
138 | ErrorInValueDeclaration Ident ErrorMessage
132 | ErrorInForeignImport Ident ErrorMessage
139 | ErrorInForeignImport Ident ErrorMessage
133 | PositionedError SourceSpan ErrorMessage
140 | PositionedError SourceSpan ErrorMessage
141+ | SimpleErrorWrapper SimpleErrorMessage
134 deriving (Show)
142 deriving (Show)
135
143
136instance UnificationError Type ErrorMessage where
144instance UnificationError Type ErrorMessage where
137− occursCheckFailed = InfiniteType
145+ occursCheckFailed t = SimpleErrorWrapper $ InfiniteType t
138
146
139instance UnificationError Kind ErrorMessage where
147instance UnificationError Kind ErrorMessage where
140− occursCheckFailed = InfiniteKind
148+ occursCheckFailed k = SimpleErrorWrapper $ InfiniteKind k
141
149
142-- |
150-- |
143-- Get the error code for a particular error type
151-- Get the error code for a particular error type
144--
152--
145errorCode :: ErrorMessage -> String
153errorCode :: ErrorMessage -> String
154+errorCode em = case unwrapErrorMessage em of
146−errorCode (ErrorParsingExterns _) = "ErrorParsingExterns"
155+ (ErrorParsingExterns _) -> "ErrorParsingExterns"
147−errorCode (ErrorParsingPrelude _) = "ErrorParsingPrelude"
156+ (ErrorParsingPrelude _) -> "ErrorParsingPrelude"
148−errorCode (InvalidExternsFile _) = "InvalidExternsFile"
157+ (InvalidExternsFile _) -> "InvalidExternsFile"
149−errorCode (CannotGetFileInfo _) = "CannotGetFileInfo"
158+ (CannotGetFileInfo _) -> "CannotGetFileInfo"
150−errorCode (CannotReadFile _) = "CannotReadFile"
159+ (CannotReadFile _) -> "CannotReadFile"
151−errorCode (CannotWriteFile _) = "CannotWriteFile"
160+ (CannotWriteFile _) -> "CannotWriteFile"
152−errorCode (InfiniteType _) = "InfiniteType"
161+ (InfiniteType _) -> "InfiniteType"
153−errorCode (InfiniteKind _) = "InfiniteKind"
162+ (InfiniteKind _) -> "InfiniteKind"
154−errorCode CannotReorderOperators = "CannotReorderOperators"
163+ CannotReorderOperators -> "CannotReorderOperators"
155−errorCode (MultipleFixities _) = "MultipleFixities"
164+ (MultipleFixities _) -> "MultipleFixities"
156−errorCode (OrphanTypeDeclaration _) = "OrphanTypeDeclaration"
165+ (OrphanTypeDeclaration _) -> "OrphanTypeDeclaration"
157−errorCode (OrphanFixityDeclaration _) = "OrphanFixityDeclaration"
166+ (OrphanFixityDeclaration _) -> "OrphanFixityDeclaration"
158−errorCode (RedefinedModule _) = "RedefinedModule"
167+ (RedefinedModule _) -> "RedefinedModule"
159−errorCode (RedefinedIdent _) = "RedefinedIdent"
168+ (RedefinedIdent _) -> "RedefinedIdent"
160−errorCode OverlappingNamesInLet = "OverlappingNamesInLet"
169+ OverlappingNamesInLet -> "OverlappingNamesInLet"
161−errorCode (UnknownModule _) = "UnknownModule"
170+ (UnknownModule _) -> "UnknownModule"
162−errorCode (UnknownType _) = "UnknownType"
171+ (UnknownType _) -> "UnknownType"
163−errorCode (UnknownTypeClass _) = "UnknownTypeClass"
172+ (UnknownTypeClass _) -> "UnknownTypeClass"
164−errorCode (UnknownValue _) = "UnknownValue"
173+ (UnknownValue _) -> "UnknownValue"
165−errorCode (UnknownDataConstructor _ _) = "UnknownDataConstructor"
174+ (UnknownDataConstructor _ _) -> "UnknownDataConstructor"
166−errorCode (UnknownTypeConstructor _) = "UnknownTypeConstructor"
175+ (UnknownTypeConstructor _) -> "UnknownTypeConstructor"
167−errorCode (ConflictingImport _ _) = "ConflictingImport"
176+ (ConflictingImport _ _) -> "ConflictingImport"
168−errorCode (ConflictingImports _ _ _) = "ConflictingImports"
177+ (ConflictingImports _ _ _) -> "ConflictingImports"
169−errorCode (ConflictingTypeDecls _) = "ConflictingTypeDecls"
178+ (ConflictingTypeDecls _) -> "ConflictingTypeDecls"
170−errorCode (ConflictingCtorDecls _) = "ConflictingCtorDecls"
179+ (ConflictingCtorDecls _) -> "ConflictingCtorDecls"
171−errorCode (TypeConflictsWithClass _) = "TypeConflictsWithClass"
180+ (TypeConflictsWithClass _) -> "TypeConflictsWithClass"
172−errorCode (CtorConflictsWithClass _) = "CtorConflictsWithClass"
181+ (CtorConflictsWithClass _) -> "CtorConflictsWithClass"
173−errorCode (ClassConflictsWithType _) = "ClassConflictsWithType"
182+ (ClassConflictsWithType _) -> "ClassConflictsWithType"
174−errorCode (ClassConflictsWithCtor _) = "ClassConflictsWithCtor"
183+ (ClassConflictsWithCtor _) -> "ClassConflictsWithCtor"
175−errorCode (DuplicateClassExport _) = "DuplicateClassExport"
184+ (DuplicateClassExport _) -> "DuplicateClassExport"
176−errorCode (DuplicateValueExport _) = "DuplicateValueExport"
185+ (DuplicateValueExport _) -> "DuplicateValueExport"
177−errorCode (DuplicateTypeArgument _) = "DuplicateTypeArgument"
186+ (DuplicateTypeArgument _) -> "DuplicateTypeArgument"
178−errorCode InvalidDoBind = "InvalidDoBind"
187+ InvalidDoBind -> "InvalidDoBind"
179−errorCode InvalidDoLet = "InvalidDoLet"
188+ InvalidDoLet -> "InvalidDoLet"
180−errorCode (CycleInDeclaration _) = "CycleInDeclaration"
189+ (CycleInDeclaration _) -> "CycleInDeclaration"
181−errorCode (CycleInTypeSynonym _) = "CycleInTypeSynonym"
190+ (CycleInTypeSynonym _) -> "CycleInTypeSynonym"
182−errorCode (CycleInModules _) = "CycleInModules"
191+ (CycleInModules _) -> "CycleInModules"
183−errorCode (NameIsUndefined _) = "NameIsUndefined"
192+ (NameIsUndefined _) -> "NameIsUndefined"
184−errorCode (NameNotInScope _) = "NameNotInScope"
193+ (NameNotInScope _) -> "NameNotInScope"
185−errorCode (UndefinedTypeVariable _) = "UndefinedTypeVariable"
194+ (UndefinedTypeVariable _) -> "UndefinedTypeVariable"
186−errorCode (PartiallyAppliedSynonym _) = "PartiallyAppliedSynonym"
195+ (PartiallyAppliedSynonym _) -> "PartiallyAppliedSynonym"
187−errorCode (EscapedSkolem _) = "EscapedSkolem"
196+ (EscapedSkolem _) -> "EscapedSkolem"
188−errorCode UnspecifiedSkolemScope = "UnspecifiedSkolemScope"
197+ UnspecifiedSkolemScope -> "UnspecifiedSkolemScope"
189−errorCode (TypesDoNotUnify _ _) = "TypesDoNotUnify"
198+ (TypesDoNotUnify _ _) -> "TypesDoNotUnify"
190−errorCode (KindsDoNotUnify _ _) = "KindsDoNotUnify"
199+ (KindsDoNotUnify _ _) -> "KindsDoNotUnify"
191−errorCode (ConstrainedTypeUnified _ _) = "ConstrainedTypeUnified"
200+ (ConstrainedTypeUnified _ _) -> "ConstrainedTypeUnified"
192−errorCode (OverlappingInstances _ _ _) = "OverlappingInstances"
201+ (OverlappingInstances _ _ _) -> "OverlappingInstances"
193−errorCode (NoInstanceFound _ _) = "NoInstanceFound"
202+ (NoInstanceFound _ _) -> "NoInstanceFound"
194−errorCode (DuplicateLabel _ _) = "DuplicateLabel"
203+ (DuplicateLabel _ _) -> "DuplicateLabel"
195−errorCode (DuplicateValueDeclaration _) = "DuplicateValueDeclaration"
204+ (DuplicateValueDeclaration _) -> "DuplicateValueDeclaration"
196−errorCode (ArgListLengthsDiffer _) = "ArgListLengthsDiffer"
205+ (ArgListLengthsDiffer _) -> "ArgListLengthsDiffer"
197−errorCode (OverlappingArgNames _) = "OverlappingArgNames"
206+ (OverlappingArgNames _) -> "OverlappingArgNames"
198−errorCode (MissingClassMember _) = "MissingClassMember"
207+ (MissingClassMember _) -> "MissingClassMember"
199−errorCode (ExpectedType _) = "ExpectedType"
208+ (ExpectedType _) -> "ExpectedType"
200−errorCode (IncorrectConstructorArity _) = "IncorrectConstructorArity"
209+ (IncorrectConstructorArity _) -> "IncorrectConstructorArity"
201−errorCode SubsumptionCheckFailed = "SubsumptionCheckFailed"
210+ SubsumptionCheckFailed -> "SubsumptionCheckFailed"
202−errorCode (ExprDoesNotHaveType _ _) = "ExprDoesNotHaveType"
211+ (ExprDoesNotHaveType _ _) -> "ExprDoesNotHaveType"
203−errorCode (PropertyIsMissing _ _) = "PropertyIsMissing"
212+ (PropertyIsMissing _ _) -> "PropertyIsMissing"
204−errorCode (CannotApplyFunction _ _) = "CannotApplyFunction"
213+ (CannotApplyFunction _ _) -> "CannotApplyFunction"
205−errorCode TypeSynonymInstance = "TypeSynonymInstance"
214+ TypeSynonymInstance -> "TypeSynonymInstance"
206−errorCode InvalidNewtype = "InvalidNewtype"
215+ InvalidNewtype -> "InvalidNewtype"
207−errorCode (InvalidInstanceHead _) = "InvalidInstanceHead"
216+ (InvalidInstanceHead _) -> "InvalidInstanceHead"
208−errorCode (TransitiveExportError _ _) = "TransitiveExportError"
217+ (TransitiveExportError _ _) -> "TransitiveExportError"
209−errorCode (ShadowedName _) = "ShadowedName"
218+ (ShadowedName _) -> "ShadowedName"
210−errorCode PreludeNotPresent = "PreludeNotPresent"
219+ PreludeNotPresent -> "PreludeNotPresent"
211−errorCode (NotYetDefined _ e) = errorCode e
220+
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−
230-- |
221-- |
231-- A stack trace for an error
222-- A stack trace for an error
232--
223--
@@ -234,20 +225,27 @@ newtype MultipleErrors = MultipleErrors
234 { runMultipleErrors :: [ErrorMessage] } deriving (Show, Monoid)
225 { runMultipleErrors :: [ErrorMessage] } deriving (Show, Monoid)
235
226
236instance UnificationError Type MultipleErrors where
227instance UnificationError Type MultipleErrors where
237− occursCheckFailed = errorMessage . occursCheckFailed
228+ occursCheckFailed = occursCheckFailed
238
229
239instance UnificationError Kind MultipleErrors where
230instance UnificationError Kind MultipleErrors where
240− occursCheckFailed = errorMessage . occursCheckFailed
231+ occursCheckFailed = occursCheckFailed
241
232
242-- | Check whether a collection of errors is empty or not.
233-- | Check whether a collection of errors is empty or not.
243nonEmpty :: MultipleErrors -> Bool
234nonEmpty :: MultipleErrors -> Bool
244nonEmpty = not . null . runMultipleErrors
235nonEmpty = not . null . runMultipleErrors
245
236
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+
246-- |
244-- |
247-- Create an error set from a single error message
245-- Create an error set from a single error message
248--
246--
249−errorMessage :: ErrorMessage -> MultipleErrors
247+singleError :: ErrorMessage -> MultipleErrors
250−errorMessage err = MultipleErrors [err]
248+singleError = MultipleErrors . pure
251
249
252-- |
250-- |
253-- Lift a function on ErrorMessage to a function on MultipleErrors
251-- Lift a function on ErrorMessage to a function on MultipleErrors
@@ -261,6 +259,31 @@ data LabelType = TypeLabel | SkolemLabel String deriving (Show, Eq, Ord)
261-- | A map from rigid type variable name/unknown variable pairs to new variables.
259-- | A map from rigid type variable name/unknown variable pairs to new variables.
262type UnknownMap = M.Map (LabelType, Unknown) Unknown
260type UnknownMap = M.Map (LabelType, Unknown) Unknown
263
261
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+
264replaceUnknowns :: Type -> State UnknownMap Type
287replaceUnknowns :: Type -> State UnknownMap Type
265replaceUnknowns = everywhereOnTypesM replaceTypes
288replaceUnknowns = everywhereOnTypesM replaceTypes
266 where
289 where
@@ -277,15 +300,16 @@ replaceUnknowns = everywhereOnTypesM replaceTypes
277onTypesInErrorMessageM :: (Applicative m) => (Type -> m Type) -> ErrorMessage -> m ErrorMessage
300onTypesInErrorMessageM :: (Applicative m) => (Type -> m Type) -> ErrorMessage -> m ErrorMessage
278onTypesInErrorMessageM f = g
301onTypesInErrorMessageM f = g
279 where
302 where
280− g (InfiniteType t) = InfiniteType <$> (f t)
303+ gSimple (InfiniteType t) = InfiniteType <$> (f t)
281− g (TypesDoNotUnify t1 t2) = TypesDoNotUnify <$> (f t1) <*> (f t2)
304+ gSimple (TypesDoNotUnify t1 t2) = TypesDoNotUnify <$> (f t1) <*> (f t2)
282− g (ConstrainedTypeUnified t1 t2) = ConstrainedTypeUnified <$> (f t1) <*> (f t2)
305+ gSimple (ConstrainedTypeUnified t1 t2) = ConstrainedTypeUnified <$> (f t1) <*> (f t2)
283− g (ExprDoesNotHaveType e t) = ExprDoesNotHaveType e <$> (f t)
306+ gSimple (ExprDoesNotHaveType e t) = ExprDoesNotHaveType e <$> (f t)
284− g (PropertyIsMissing s t) = PropertyIsMissing s <$> (f t)
307+ gSimple (PropertyIsMissing s t) = PropertyIsMissing s <$> (f t)
285− g (ErrorUnifyingTypes t1 t2 e) = ErrorUnifyingTypes <$> (f t1) <*> (f t2) <*> (g e)
308+ gSimple (CannotApplyFunction t e) = CannotApplyFunction <$> f t <*> (pure e)
286− g (CannotApplyFunction t e) = CannotApplyFunction <$> f t <*> (pure e)
309+ gSimple (InvalidInstanceHead t) = InvalidInstanceHead <$> f t
287− g (InvalidInstanceHead t) = InvalidInstanceHead <$> f t
310+ gSimple other = pure other
288 g (ErrorInSubsumption t1 t2 em) = ErrorInSubsumption <$> (f t1) <*> (f t2) <*> (g em)
311 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)
289 g (ErrorCheckingType e t em) = ErrorCheckingType e <$> (f t) <*> (g em)
313 g (ErrorCheckingType e t em) = ErrorCheckingType e <$> (f t) <*> (g em)
290 g (ErrorCheckingKind t em) = ErrorCheckingKind <$> (f t) <*> g em
314 g (ErrorCheckingKind t em) = ErrorCheckingKind <$> (f t) <*> g em
291 g (ErrorInApplication e1 t1 e2 em) = ErrorInApplication e1 <$> (f t1) <*> (pure e2) <*> (g em)
315 g (ErrorInApplication e1 t1 e2 em) = ErrorInApplication e1 <$> (f t1) <*> (pure e2) <*> (g em)
@@ -302,7 +326,7 @@ onTypesInErrorMessageM f = g
302 g (ErrorInValueDeclaration x e) = ErrorInValueDeclaration x <$> (g e)
326 g (ErrorInValueDeclaration x e) = ErrorInValueDeclaration x <$> (g e)
303 g (ErrorInForeignImport x e) = ErrorInForeignImport x <$> (g e)
327 g (ErrorInForeignImport x e) = ErrorInForeignImport x <$> (g e)
304 g (PositionedError x e) = PositionedError x <$> (g e)
328 g (PositionedError x e) = PositionedError x <$> (g e)
305− g other = pure other
329+ g (SimpleErrorWrapper sem) = SimpleErrorWrapper <$> gSimple sem
306
330
307-- |
331-- |
308-- Pretty print a single error, simplifying if necessary
332-- Pretty print a single error, simplifying if necessary
@@ -315,132 +339,131 @@ prettyPrintSingleError full e = prettyPrintErrorMessage <$> onTypesInErrorMessag
315 --
339 --
316 prettyPrintErrorMessage :: ErrorMessage -> Box.Box
340 prettyPrintErrorMessage :: ErrorMessage -> Box.Box
317 prettyPrintErrorMessage em =
341 prettyPrintErrorMessage em =
318− paras
342+ paras $
319− [ go em
343+ go em:suggestions em ++
320− , line ("See " ++ wikiUri ++ " for more information, or to contribute content related to this error.")
344+ [line $ "See " ++ wikiUri ++ " for more information, or to contribute content related to this error."]
321− ]
322 where
345 where
323 wikiUri :: String
346 wikiUri :: String
324 wikiUri = "https://github.com/purescript/purescript/wiki/Error-Code-" ++ errorCode e
347 wikiUri = "https://github.com/purescript/purescript/wiki/Error-Code-" ++ errorCode e
325
348
326 go :: ErrorMessage -> Box.Box
349 go :: ErrorMessage -> Box.Box
327− go (CannotGetFileInfo path) = paras [ line "Unable to read file info: "
350+ goSimple (CannotGetFileInfo path) = paras [ line "Unable to read file info: "
328− , indent . line $ path
351+ , indent . line $ path
329− ]
352+ ]
330− go (CannotReadFile path) = paras [ line "Unable to read file: "
353+ goSimple (CannotReadFile path) = paras [ line "Unable to read file: "
331− , indent . line $ path
354+ , indent . line $ path
332− ]
355+ ]
333− go (CannotWriteFile path) = paras [ line "Unable to write file: "
356+ goSimple (CannotWriteFile path) = paras [ line "Unable to write file: "
334− , indent . line $ path
357+ , indent . line $ path
335− ]
358+ ]
336− go (ErrorParsingExterns err) = paras [ line "Error parsing externs files: "
359+ goSimple (ErrorParsingExterns err) = paras [ line "Error parsing externs files: "
337− , indent . line . show $ err
360+ , indent . line . show $ err
338− ]
361+ ]
339− go (ErrorParsingPrelude err) = paras [ line "Error parsing prelude: "
362+ goSimple (ErrorParsingPrelude err) = paras [ line "Error parsing prelude: "
340− , indent . line . show $ err
363+ , indent . line . show $ err
341− ]
364+ ]
342− go (InvalidExternsFile path) = paras [ line "Externs file is invalid: "
365+ goSimple (InvalidExternsFile path) = paras [ line "Externs file is invalid: "
343− , indent . line $ path
366+ , indent . line $ path
344− ]
367+ ]
345− go InvalidDoBind = line "Bind statement cannot be the last statement in a do block"
368+ goSimple 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"
369+ goSimple InvalidDoLet = line "Let statement cannot be the last statement in a do block"
347− go CannotReorderOperators = line "Unable to reorder operators"
370+ goSimple CannotReorderOperators = line "Unable to reorder operators"
348− go UnspecifiedSkolemScope = line "Skolem variable scope is unspecified"
371+ goSimple UnspecifiedSkolemScope = line "Skolem variable scope is unspecified"
349− go OverlappingNamesInLet = line "Overlapping names in let binding."
372+ goSimple OverlappingNamesInLet = line "Overlapping names in let binding."
350− go (InfiniteType ty) = paras [ line "Infinite type detected: "
373+ goSimple (InfiniteType ty) = paras [ line "Infinite type detected: "
351− , indent $ line $ prettyPrintType ty
374+ , indent $ line $ prettyPrintType ty
352− ]
375+ ]
353− go (InfiniteKind ki) = paras [ line "Infinite kind detected: "
376+ goSimple (InfiniteKind ki) = paras [ line "Infinite kind detected: "
354− , indent $ line $ prettyPrintKind ki
377+ , indent $ line $ prettyPrintKind ki
355− ]
378+ ]
356− go (MultipleFixities name) = line $ "Multiple fixity declarations for " ++ show name
379+ goSimple (MultipleFixities name) = line $ "Multiple fixity declarations for " ++ show name
357− go (OrphanTypeDeclaration nm) = line $ "Orphan type declaration for " ++ show nm
380+ goSimple (OrphanTypeDeclaration nm) = line $ "Orphan type declaration for " ++ show nm
358− go (OrphanFixityDeclaration op) = line $ "Orphan fixity declaration for " ++ show op
381+ goSimple (OrphanFixityDeclaration op) = line $ "Orphan fixity declaration for " ++ show op
359− go (RedefinedModule name) = line $ "Module " ++ show name ++ " has been defined multiple times"
382+ goSimple (RedefinedModule name) = line $ "Module " ++ show name ++ " has been defined multiple times"
360− go (RedefinedIdent name) = line $ "Name " ++ show name ++ " has been defined multiple times"
383+ goSimple (RedefinedIdent name) = line $ "Name " ++ show name ++ " has been defined multiple times"
361− go (UnknownModule mn) = line $ "Unknown module " ++ show mn
384+ goSimple (UnknownModule mn) = line $ "Unknown module " ++ show mn
362− go (UnknownType name) = line $ "Unknown type " ++ show name
385+ goSimple (UnknownType name) = line $ "Unknown type " ++ show name
363− go (UnknownTypeClass name) = line $ "Unknown type class " ++ show name
386+ goSimple (UnknownTypeClass name) = line $ "Unknown type class " ++ show name
364− go (UnknownValue name) = line $ "Unknown value " ++ show name
387+ goSimple (UnknownValue name) = line $ "Unknown value " ++ show name
365− go (UnknownTypeConstructor name) = line $ "Unknown type constructor " ++ show name
388+ goSimple (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
389+ goSimple (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
390+ goSimple (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
391+ goSimple (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
392+ goSimple (ConflictingTypeDecls nm) = line $ "Conflicting type declarations for " ++ show nm
370− go (ConflictingCtorDecls nm) = line $ "Conflicting data constructor declarations for " ++ show nm
393+ goSimple (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"
394+ goSimple (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"
395+ goSimple (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"
396+ goSimple (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"
397+ goSimple (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
398+ goSimple (DuplicateClassExport nm) = line $ "Duplicate export declaration for type class " ++ show nm
376− go (DuplicateValueExport nm) = line $ "Duplicate export declaration for value " ++ show nm
399+ goSimple (DuplicateValueExport nm) = line $ "Duplicate export declaration for value " ++ show nm
377− go (CycleInDeclaration nm) = line $ "Cycle in declaration of " ++ show nm
400+ goSimple (CycleInDeclaration nm) = line $ "Cycle in declaration of " ++ show nm
378− go (CycleInModules mns) = line $ "Cycle in module dependencies: " ++ intercalate ", " (map show mns)
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+ ]
379 go (NotYetDefined names err) = paras [ line $ "The following are not yet defined here: " ++ intercalate ", " (map show names) ++ ":"
464 go (NotYetDefined names err) = paras [ line $ "The following are not yet defined here: " ++ intercalate ", " (map show names) ++ ":"
380 , indent $ go err
465 , indent $ go err
381 ]
466 ]
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− ]
444 go (ErrorUnifyingTypes t1 t2 err) = paras [ line "Error unifying type "
467 go (ErrorUnifyingTypes t1 t2 err) = paras [ line "Error unifying type "
445 , indent $ line $ prettyPrintType t1
468 , indent $ line $ prettyPrintType t1
446 , line "with type"
469 , line "with type"
@@ -509,10 +532,19 @@ prettyPrintSingleError full e = prettyPrintErrorMessage <$> onTypesInErrorMessag
509 go (PositionedError srcSpan err) = paras [ line $ "Error at " ++ displaySourceSpan srcSpan ++ ":"
532 go (PositionedError srcSpan err) = paras [ line $ "Error at " ++ displaySourceSpan srcSpan ++ ":"
510 , indent $ go err
533 , indent $ go err
511 ]
534 ]
535+ go (SimpleErrorWrapper sem) = goSimple sem
512
536
513 line :: String -> Box.Box
537 line :: String -> Box.Box
514 line = Box.text
538 line = Box.text
515
539
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+
516 paras :: [Box.Box] -> Box.Box
548 paras :: [Box.Box] -> Box.Box
517 paras = Box.vcat Box.left
549 paras = Box.vcat Box.left
518
550
src/Language/PureScript/Sugar/Names.hs+4−4
@@ -142,7 +142,7 @@ addValue env mn name = updateExportedModule env mn $ \m -> do
142-- Adds an entry to a list of exports unless it is already present, in which case an error is
142-- Adds an entry to a list of exports unless it is already present, in which case an error is
143-- returned.
143-- returned.
144--
144--
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]
146addExport what exports name =
146addExport what exports name =
147 if name `elem` exports
147 if name `elem` exports
148 then throwConflictError what name
148 then throwConflictError what name
@@ -279,7 +279,7 @@ renameInModule imports exports (Module coms mn decls exps) =
279
279
280 -- Update names so unqualified references become qualified, and locally qualified references
280 -- Update names so unqualified references become qualified, and locally qualified references
281 -- are replaced with their canoncial qualified names (e.g. M.Map -> Data.Map.Map)
281 -- 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)
283 -> (ImportEnvironment -> M.Map (Qualified a) (Qualified a))
283 -> (ImportEnvironment -> M.Map (Qualified a) (Qualified a))
284 -> (Exports -> a -> Bool)
284 -> (Exports -> a -> Bool)
285 -> Qualified a
285 -> Qualified a
@@ -529,7 +529,7 @@ resolveImport currentModule importModule exps imps impQual =
529 checkDctorExists = checkImportExists (flip UnknownDataConstructor Nothing)
529 checkDctorExists = checkImportExists (flip UnknownDataConstructor Nothing)
530
530
531 -- Check that an explicitly imported item exists in the module it is being imported from
531 -- 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
533 checkImportExists unknown exports item =
533 checkImportExists unknown exports item =
534 if item `elem` exports
534 if item `elem` exports
535 then return item
535 then return item
@@ -538,5 +538,5 @@ resolveImport currentModule importModule exps imps impQual =
538-- |
538-- |
539-- Raises an error for when there is more than one definition for something.
539-- Raises an error for when there is more than one definition for something.
540--
540--
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
542throwConflictError conflict = throwError . errorMessage . conflict
542throwConflictError conflict = throwError . errorMessage . conflict
src/Language/PureScript/TypeChecker/Skolems.hs+1−1
@@ -88,7 +88,7 @@ skolemEscapeCheck root@TypedValue{} =
88 let (_, f, _, _, _) = everythingWithContextOnValues [] [] (++) def go def def def
88 let (_, f, _, _, _) = everythingWithContextOnValues [] [] (++) def go def def def
89 in case f root of
89 in case f root of
90 [] -> return ()
90 [] -> return ()
91− ((binding, val) : _) -> throwError . errorMessage . ErrorInExpression val $ EscapedSkolem binding
91+ ((binding, val) : _) -> throwError . singleError $ ErrorInExpression val $ SimpleErrorWrapper $ EscapedSkolem binding
92 where
92 where
93 def s _ = (s, [])
93 def s _ = (s, [])
94
94
src/Language/PureScript/TypeChecker/Synonyms.hs+3−3
@@ -46,7 +46,7 @@ buildTypeSubstitution name n = go n []
46 where
46 where
47 go :: Int -> [Type] -> Type -> Either ErrorMessage (Maybe Type)
47 go :: Int -> [Type] -> Type -> Either ErrorMessage (Maybe Type)
48 go 0 args (TypeConstructor ctor) | name == ctor = return (Just $ SaturatedTypeSynonym ctor args)
48 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
50 go m args (TypeApp f arg) = go (m - 1) (arg:args) f
50 go m args (TypeApp f arg) = go (m - 1) (arg:args) f
51 go _ _ _ = return Nothing
51 go _ _ _ = return Nothing
52
52
@@ -87,7 +87,7 @@ replaceAllTypeSynonyms' env d =
87replaceAllTypeSynonyms :: (e ~ MultipleErrors, Functor m, Monad m, MonadState CheckState m, MonadError e m) => Type -> m Type
87replaceAllTypeSynonyms :: (e ~ MultipleErrors, Functor m, Monad m, MonadState CheckState m, MonadError e m) => Type -> m Type
88replaceAllTypeSynonyms d = do
88replaceAllTypeSynonyms d = do
89 env <- getEnv
89 env <- getEnv
90− either (throwError . errorMessage) return $ replaceAllTypeSynonyms' env d
90+ either (throwError . singleError) return $ replaceAllTypeSynonyms' env d
91
91
92-- |
92-- |
93-- Replace a type synonym and its arguments with the aliased type
93-- Replace a type synonym and its arguments with the aliased type
@@ -103,7 +103,7 @@ expandTypeSynonym' env name args =
103expandTypeSynonym :: (e ~ MultipleErrors, Functor m, Monad m, MonadState CheckState m, MonadError e m) => Qualified ProperName -> [Type] -> m Type
103expandTypeSynonym :: (e ~ MultipleErrors, Functor m, Monad m, MonadState CheckState m, MonadError e m) => Qualified ProperName -> [Type] -> m Type
104expandTypeSynonym name args = do
104expandTypeSynonym name args = do
105 env <- getEnv
105 env <- getEnv
106− either (throwError . errorMessage) return $ expandTypeSynonym' env name args
106+ either (throwError . singleError) return $ expandTypeSynonym' env name args
107
107
108expandAllTypeSynonyms :: (e ~ MultipleErrors, Functor m, Applicative m, Monad m, MonadState CheckState m, MonadError e m) => Type -> m Type
108expandAllTypeSynonyms :: (e ~ MultipleErrors, Functor m, Applicative m, Monad m, MonadState CheckState m, MonadError e m) => Type -> m Type
109expandAllTypeSynonyms = everywhereOnTypesTopDownM go
109expandAllTypeSynonyms = everywhereOnTypesTopDownM go