ab73d58 · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

Improve context info for lint warnings

commitab73d58e7e1596733468c3ee5e3dec004022a39c authorGary Burgess <gary.burgess@gmail.com> dateSun 13 Sep 2015, 14:18 (11 years ago) parent3ba23c7

2 files changed+19−9

compare with golang

unifiedsplit

src/Language/PureScript/Errors.hs+8 src/Language/PureScript/Linter.hs+11−9

src/Language/PureScript/Errors.hs+8

@@ -170,6 +170,7 @@ data ErrorMessage

170170 | ErrorInDataBindingGroup ErrorMessage

171171 | ErrorInTypeSynonym ProperName ErrorMessage

172172 | ErrorInValueDeclaration Ident ErrorMessage

173+ | ErrorInTypeDeclaration Ident ErrorMessage

173174 | ErrorInForeignImport Ident ErrorMessage

174175 | PositionedError SourceSpan ErrorMessage

175176 | SimpleErrorWrapper SimpleErrorMessage

@@ -340,6 +341,7 @@ unwrapErrorMessage em = case em of

340341 (ErrorInTypeConstructor _ err) -> unwrapErrorMessage err

341342 (ErrorInTypeSynonym _ err) -> unwrapErrorMessage err

342343 (ErrorInValueDeclaration _ err) -> unwrapErrorMessage err

344+ (ErrorInTypeDeclaration _ err) -> unwrapErrorMessage err

343345 (ErrorInferringType _ err) -> unwrapErrorMessage err

344346 (ErrorUnifyingTypes _ _ err) -> unwrapErrorMessage err

345347 (NotYetDefined _ err) -> unwrapErrorMessage err

@@ -386,6 +388,7 @@ onTypesInErrorMessageM f = g

386388 g (ErrorInDataBindingGroup e) = ErrorInDataBindingGroup <$> (g e)

387389 g (ErrorInTypeSynonym x e) = ErrorInTypeSynonym x <$> (g e)

388390 g (ErrorInValueDeclaration x e) = ErrorInValueDeclaration x <$> (g e)

391+ g (ErrorInTypeDeclaration x e) = ErrorInTypeDeclaration x <$> (g e)

389392 g (ErrorInForeignImport x e) = ErrorInForeignImport x <$> (g e)

390393 g (PositionedError x e) = PositionedError x <$> (g e)

391394 g (SimpleErrorWrapper sem) = SimpleErrorWrapper <$> gSimple sem

@@ -740,6 +743,10 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError

740743 paras [ lineWithLevel $ "in value declaration " ++ showIdent n ++ ":"

741744 , go err

742745 ]

746+ go (ErrorInTypeDeclaration n err) =

747+ paras [ lineWithLevel $ "in type declaration for " ++ showIdent n ++ ":"

748+ , go err

749+ ]

743750 go (ErrorInForeignImport nm err) =

744751 paras [ lineWithLevel $ "in foreign import " ++ showIdent nm ++ ":"

745752 , go err

@@ -805,6 +812,7 @@ prettyPrintSingleError full level e = prettyPrintErrorMessage <$> onTypesInError

805812 unwrap pos (ErrorInDataBindingGroup err) = ErrorInDataBindingGroup (unwrap pos err)

806813 unwrap pos (ErrorInTypeSynonym nm err) = ErrorInTypeSynonym nm (unwrap pos err)

807814 unwrap pos (ErrorInValueDeclaration nm err) = ErrorInValueDeclaration nm (unwrap pos err)

815+ unwrap pos (ErrorInTypeDeclaration nm err) = ErrorInTypeDeclaration nm (unwrap pos err)

808816 unwrap pos (ErrorInForeignImport nm err) = ErrorInForeignImport nm (unwrap pos err)

809817 unwrap pos (NotYetDefined ns err) = NotYetDefined ns (unwrap pos err)

810818 unwrap _ (PositionedError pos err) = unwrap (Just pos) err

src/Language/PureScript/Linter.hs+11−9

@@ -60,7 +60,9 @@ lint (Module _ _ mn ds _) = censor (onErrorMessages (ErrorInModule mn)) $ mapM_

6060

6161 f' :: Declaration -> MultipleErrors

6262 f' (PositionedDeclaration pos _ dec) = onErrorMessages (PositionedError pos) (f' dec)

63− f' dec = f dec <> checkTypeVars dec

63+ f' dec@(ValueDeclaration name _ _ _) = onErrorMessages (ErrorInValueDeclaration name) (f dec <> checkTypeVarsInDecl dec)

64+ f' (TypeDeclaration name ty) = onErrorMessages (ErrorInTypeDeclaration name) (checkTypeVars ty)

65+ f' dec = f dec <> checkTypeVarsInDecl dec

6466

6567 in tell (f' d)

6668 where

@@ -90,11 +92,11 @@ lint (Module _ _ mn ds _) = censor (onErrorMessages (ErrorInModule mn)) $ mapM_

9092 bindName :: S.Set Ident -> Ident -> (S.Set Ident, MultipleErrors)

9193 bindName = bind ShadowedName

9294

93− checkTypeVars :: Declaration -> MultipleErrors

94− checkTypeVars d =

95− let (checkShadow, _, _, _, _) = accumTypes (everythingWithContextOnTypes S.empty mempty mappend step)

96− (checkUnused, _, _, _, _) = accumTypes findUnused

97− in checkShadow d <> checkUnused d

95+ checkTypeVarsInDecl :: Declaration -> MultipleErrors

96+ checkTypeVarsInDecl d = let (f, _, _, _, _) = accumTypes checkTypeVars in f d

97+

98+ checkTypeVars :: Type -> MultipleErrors

99+ checkTypeVars ty = everythingWithContextOnTypes S.empty mempty mappend step ty <> findUnused ty

98100 where

99101 step :: S.Set String -> Type -> (S.Set String, MultipleErrors)

100102 step s (ForAll tv _ _) = bindVar s tv

@@ -102,9 +104,9 @@ lint (Module _ _ mn ds _) = censor (onErrorMessages (ErrorInModule mn)) $ mapM_

102104 bindVar :: S.Set String -> String -> (S.Set String, MultipleErrors)

103105 bindVar = bind ShadowedTypeVar

104106 findUnused :: Type -> MultipleErrors

105− findUnused ty =

106− let used = usedTypeVariables ty

107− declared = everythingOnTypes (++) go ty

107+ findUnused ty' =

108+ let used = usedTypeVariables ty'

109+ declared = everythingOnTypes (++) go ty'

108110 unused = nub declared \\ nub used

109111 in foldl (<>) mempty $ map (errorMessage . UnusedTypeVar) unused

110112 where