Skip to content

Commit 80339ff

Browse files
garybkritzcreek
garyb
authored and
kritzcreek
committed
Fix UnusedTypeVar missing position info (purescript#3214)
1 parent 3f3b473 commit 80339ff

1 file changed

Lines changed: 12 additions & 10 deletions

File tree

‎src/Language/PureScript/Linter.hs‎

Lines changed: 12 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -48,9 +48,10 @@ lint (Module _ _ mn ds _) = censor (addHint (ErrorInModule mn)) $ mapM_ lintDecl
4848
f dec = f' S.empty dec
4949

5050
f' :: S.Set Text -> Declaration -> MultipleErrors
51-
f' s dec@(ValueDeclaration vd) = addHint (ErrorInValueDeclaration (valdeclIdent vd)) (warningsInDecl moduleNames dec <> checkTypeVarsInDecl s dec)
51+
f' s dec@(ValueDeclaration vd) =
52+
addHint (ErrorInValueDeclaration (valdeclIdent vd)) (warningsInDecl moduleNames dec <> checkTypeVarsInDecl s dec)
5253
f' s (TypeDeclaration td@(TypeDeclarationData (ss, _) _ _)) =
53-
addHint (PositionedError ss) $ addHint (ErrorInTypeDeclaration (tydeclIdent td)) (checkTypeVars s (tydeclType td))
54+
addHint (ErrorInTypeDeclaration (tydeclIdent td)) (checkTypeVars ss s (tydeclType td))
5455
f' s dec = warningsInDecl moduleNames dec <> checkTypeVarsInDecl s dec
5556

5657
stepE :: S.Set Ident -> Expr -> MultipleErrors
@@ -76,27 +77,28 @@ lint (Module _ _ mn ds _) = censor (addHint (ErrorInModule mn)) $ mapM_ lintDecl
7677
stepDo _ _ = mempty
7778

7879
checkTypeVarsInDecl :: S.Set Text -> Declaration -> MultipleErrors
79-
checkTypeVarsInDecl s d = let (f, _, _, _, _) = accumTypes (checkTypeVars s) in f d
80+
checkTypeVarsInDecl s d = let (f, _, _, _, _) = accumTypes (checkTypeVars (declSourceSpan d) s) in f d
8081

81-
checkTypeVars :: S.Set Text -> Type -> MultipleErrors
82-
checkTypeVars set ty = everythingWithContextOnTypes set mempty mappend step ty <> findUnused ty
82+
checkTypeVars :: SourceSpan -> S.Set Text -> Type -> MultipleErrors
83+
checkTypeVars ss set ty = everythingWithContextOnTypes set mempty mappend step ty <> findUnused ty
8384
where
8485
step :: S.Set Text -> Type -> (S.Set Text, MultipleErrors)
8586
step s (ForAll tv _ _) = bindVar s tv
8687
step s _ = (s, mempty)
8788
bindVar :: S.Set Text -> Text -> (S.Set Text, MultipleErrors)
88-
bindVar = bind ShadowedTypeVar
89+
bindVar = bind ss ShadowedTypeVar
8990
findUnused :: Type -> MultipleErrors
9091
findUnused ty' =
9192
let used = usedTypeVariables ty'
9293
declared = everythingOnTypes (++) go ty'
9394
unused = ordNub declared \\ ordNub used
94-
in foldl (<>) mempty $ map (errorMessage . UnusedTypeVar) unused
95+
in foldl (<>) mempty $ map (errorMessage' ss . UnusedTypeVar) unused
9596
where
9697
go :: Type -> [Text]
9798
go (ForAll tv _ _) = [tv]
9899
go _ = []
99100

100-
bind :: (Ord a) => (a -> SimpleErrorMessage) -> S.Set a -> a -> (S.Set a, MultipleErrors)
101-
bind mkError s name | name `S.member` s = (s, errorMessage (mkError name))
102-
| otherwise = (S.insert name s, mempty)
101+
bind :: (Ord a) => SourceSpan -> (a -> SimpleErrorMessage) -> S.Set a -> a -> (S.Set a, MultipleErrors)
102+
bind ss mkError s name
103+
| name `S.member` s = (s, errorMessage' ss (mkError name))
104+
| otherwise = (S.insert name s, mempty)

0 commit comments

Comments
 (0)