32bc8cc · rowtype-yoga/purescript-native

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

on golang help sign in

Warn for shadowed type class variables (#2441)

32bc8ccHardy Jones10 years ago

examples/warning/2140.pursnew file+5

compare with golang

unifiedsplit

@@ -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

157 | ErrorInTypeSynonym (ProperName 'TypeName)

158 | ErrorInValueDeclaration Ident

159 | ErrorInTypeDeclaration Ident

160+ | ErrorInTypeClassDeclaration (ProperName 'ClassName)

160 | ErrorInForeignImport Ident

161 | ErrorInForeignImport Ident

161 | ErrorSolvingConstraint Constraint

162 | ErrorSolvingConstraint Constraint

162 | PositionedError SourceSpan

163 | PositionedError SourceSpan

src/Language/PureScript/Errors.hs+4

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

984 paras [ detail

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

986 ]

987+ renderHint (ErrorInTypeClassDeclaration name) detail =

988+ paras [ detail

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

990+ ]

987 renderHint (ErrorInForeignImport nm) detail =

991 renderHint (ErrorInForeignImport nm) detail =

988 paras [ detail

992 paras [ detail

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

993 , 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

45 f :: Declaration -> MultipleErrors

46 f (PositionedDeclaration pos _ dec) = addHint (PositionedError pos) (f 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)

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

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

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

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

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

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

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

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

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

57 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

70 | otherwise = mempty

75 | otherwise = mempty

71 stepDo _ _ = mempty

76 stepDo _ _ = mempty

73− checkTypeVarsInDecl :: Declaration -> MultipleErrors

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

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

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

76− checkTypeVars :: Type -> MultipleErrors

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

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

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

78 where

83 where

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

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

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

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