32bc8cc · rowtype-yoga/purescript-native

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

Warn for shadowed type class variables (#2441)

* Warn for shadowed type class variables * Fork higher when gathering errors for type classes

commit32bc8cc042b5303d9a47fdc454024c2aa62bb0c0 authorHardy Jones <jones3.hardy@gmail.com> dateFri 25 Nov 2016, 13:38 (10 years ago) parent1e6fc9d

4 files changed+22−7

compare with golang

unifiedsplit

examples/warning/2140.purs+5 src/Language/PureScript/AST/Declarations.hs+1 src/Language/PureScript/Errors.hs+4 src/Language/PureScript/Linter.hs+12−7

examples/warning/2140.pursnew file+5

@@ -0,0 +1,5 @@

1+-- @shouldWarnWith ShadowedTypeVar

2+module Main where

4+class Test a where

5+ f :: (forall a. a -> a) -> a -> a

src/Language/PureScript/AST/Declarations.hs+1

@@ -157,6 +157,7 @@ data ErrorMessageHint

157157 | ErrorInTypeSynonym (ProperName 'TypeName)

158158 | ErrorInValueDeclaration Ident

159159 | ErrorInTypeDeclaration Ident

160+ | ErrorInTypeClassDeclaration (ProperName 'ClassName)

160161 | ErrorInForeignImport Ident

161162 | ErrorSolvingConstraint Constraint

162163 | PositionedError SourceSpan

src/Language/PureScript/Errors.hs+4

@@ -984,6 +984,10 @@ prettyPrintSingleError (PPEOptions codeColor full level showWiki) e = flip evalS

984984 paras [ detail

985985 , line $ "in type declaration for " ++ markCode (showIdent n)

986986 ]

987+ renderHint (ErrorInTypeClassDeclaration name) detail =

988+ paras [ detail

989+ , line $ "in type class declaration for " ++ markCode (runProperName name)

990+ ]

987991 renderHint (ErrorInForeignImport nm) detail =

988992 paras [ detail

989993 , line $ "in foreign import " ++ markCode (showIdent nm)

src/Language/PureScript/Linter.hs+12−7

@@ -44,9 +44,14 @@ lint (Module _ _ mn ds _) = censor (addHint (ErrorInModule mn)) $ mapM_ lintDecl

4444

4545 f :: Declaration -> MultipleErrors

4646 f (PositionedDeclaration pos _ dec) = addHint (PositionedError pos) (f dec)

47− f dec@(ValueDeclaration name _ _ _) = addHint (ErrorInValueDeclaration name) (warningsInDecl moduleNames dec <> checkTypeVarsInDecl dec)

48− f (TypeDeclaration name ty) = addHint (ErrorInTypeDeclaration name) (checkTypeVars ty)

49− f dec = warningsInDecl moduleNames dec <> checkTypeVarsInDecl dec

47+ f (TypeClassDeclaration name args _ _ decs) = addHint (ErrorInTypeClassDeclaration name) (foldMap (f' (S.fromList $ fst <$> args)) decs)

48+ f dec = f' S.empty dec

49+

50+ f' :: S.Set String -> Declaration -> MultipleErrors

51+ f' s (PositionedDeclaration pos _ dec) = addHint (PositionedError pos) (f' s dec)

52+ f' s dec@(ValueDeclaration name _ _ _) = addHint (ErrorInValueDeclaration name) (warningsInDecl moduleNames dec <> checkTypeVarsInDecl s dec)

53+ f' s (TypeDeclaration name ty) = addHint (ErrorInTypeDeclaration name) (checkTypeVars s ty)

54+ f' s dec = warningsInDecl moduleNames dec <> checkTypeVarsInDecl s dec

5055

5156 stepE :: S.Set Ident -> Expr -> MultipleErrors

5257 stepE s (Abs (Left name) _) | name `S.member` s = errorMessage (ShadowedName name)

@@ -70,11 +75,11 @@ lint (Module _ _ mn ds _) = censor (addHint (ErrorInModule mn)) $ mapM_ lintDecl

7075 | otherwise = mempty

7176 stepDo _ _ = mempty

7277

73− checkTypeVarsInDecl :: Declaration -> MultipleErrors

74− checkTypeVarsInDecl d = let (f, _, _, _, _) = accumTypes checkTypeVars in f d

78+ checkTypeVarsInDecl :: S.Set String -> Declaration -> MultipleErrors

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

7580

76− checkTypeVars :: Type -> MultipleErrors

77− checkTypeVars ty = everythingWithContextOnTypes S.empty mempty mappend step ty <> findUnused ty

81+ checkTypeVars :: S.Set String -> Type -> MultipleErrors

82+ checkTypeVars set ty = everythingWithContextOnTypes set mempty mappend step ty <> findUnused ty

7883 where

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

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