-- |
-- This module implements a simple linting pass on the PureScript AST.
--
module Language.PureScript.Linter (lint, module L) where

import Prelude

import Control.Monad.Writer.Class

import Data.Maybe (mapMaybe)
import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as Text
import Control.Monad ((<=<))

import Language.PureScript.AST
import Language.PureScript.Errors
import Language.PureScript.Linter.Exhaustive as L
import Language.PureScript.Linter.Imports as L
import Language.PureScript.Names
import Language.PureScript.Types
import qualified Language.PureScript.Constants.Libs as C

-- | Lint the PureScript AST.
-- |
-- | Right now, this pass performs a shadowing check and a check for unused bindings.
lint :: forall m. (MonadWriter MultipleErrors m) => Module -> m ()
lint :: forall (m :: * -> *).
MonadWriter MultipleErrors m =>
Module -> m ()
lint modl :: Module
modl@(Module SourceSpan
_ [Comment]
_ ModuleName
mn [Declaration]
ds Maybe [DeclarationRef]
_) = do
  forall (m :: * -> *).
MonadWriter MultipleErrors m =>
Module -> m ()
lintUnused Module
modl
  forall w (m :: * -> *) a. MonadWriter w m => (w -> w) -> m a -> m a
censor (ErrorMessageHint -> MultipleErrors -> MultipleErrors
addHint (ModuleName -> ErrorMessageHint
ErrorInModule ModuleName
mn)) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Declaration -> m ()
lintDeclaration [Declaration]
ds

  where
  moduleNames :: S.Set ScopedIdent
  moduleNames :: Set ScopedIdent
moduleNames = forall a. Ord a => [a] -> Set a
S.fromList (forall a b. (a -> b) -> [a] -> [b]
map Ident -> ScopedIdent
ToplevelIdent (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Declaration -> Maybe Ident
getDeclIdent [Declaration]
ds))

  getDeclIdent :: Declaration -> Maybe Ident
  getDeclIdent :: Declaration -> Maybe Ident
getDeclIdent = Name -> Maybe Ident
getIdentName forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Declaration -> Maybe Name
declName

  lintDeclaration :: Declaration -> m ()
  lintDeclaration :: Declaration -> m ()
lintDeclaration = forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell forall b c a. (b -> c) -> (a -> b) -> a -> c
. Declaration -> MultipleErrors
f
    where
    (Set ScopedIdent -> Declaration -> MultipleErrors
warningsInDecl, Set ScopedIdent -> Expr -> MultipleErrors
_, Set ScopedIdent -> Binder -> MultipleErrors
_, Set ScopedIdent -> CaseAlternative -> MultipleErrors
_, Set ScopedIdent -> DoNotationElement -> MultipleErrors
_) = forall r.
Monoid r =>
(Set ScopedIdent -> Declaration -> r)
-> (Set ScopedIdent -> Expr -> r)
-> (Set ScopedIdent -> Binder -> r)
-> (Set ScopedIdent -> CaseAlternative -> r)
-> (Set ScopedIdent -> DoNotationElement -> r)
-> (Set ScopedIdent -> Declaration -> r,
    Set ScopedIdent -> Expr -> r, Set ScopedIdent -> Binder -> r,
    Set ScopedIdent -> CaseAlternative -> r,
    Set ScopedIdent -> DoNotationElement -> r)
everythingWithScope (\Set ScopedIdent
_ Declaration
_ -> forall a. Monoid a => a
mempty) Set ScopedIdent -> Expr -> MultipleErrors
stepE Set ScopedIdent -> Binder -> MultipleErrors
stepB (\Set ScopedIdent
_ CaseAlternative
_ -> forall a. Monoid a => a
mempty) Set ScopedIdent -> DoNotationElement -> MultipleErrors
stepDo

    f :: Declaration -> MultipleErrors
    f :: Declaration -> MultipleErrors
f (TypeClassDeclaration SourceAnn
_ ProperName 'ClassName
name [(Text, Maybe SourceType)]
args [SourceConstraint]
_ [FunctionalDependency]
_ [Declaration]
decs) = ErrorMessageHint -> MultipleErrors -> MultipleErrors
addHint (ProperName 'ClassName -> ErrorMessageHint
ErrorInTypeClassDeclaration ProperName 'ClassName
name) (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Set Text -> Declaration -> MultipleErrors
f' (forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Maybe SourceType)]
args)) [Declaration]
decs)
    f Declaration
dec = Set Text -> Declaration -> MultipleErrors
f' forall a. Set a
S.empty Declaration
dec

    f' :: S.Set Text -> Declaration -> MultipleErrors
    f' :: Set Text -> Declaration -> MultipleErrors
f' Set Text
s dec :: Declaration
dec@(ValueDeclaration ValueDeclarationData [GuardedExpr]
vd) =
      ErrorMessageHint -> MultipleErrors -> MultipleErrors
addHint (Ident -> ErrorMessageHint
ErrorInValueDeclaration (forall a. ValueDeclarationData a -> Ident
valdeclIdent ValueDeclarationData [GuardedExpr]
vd)) (Set ScopedIdent -> Declaration -> MultipleErrors
warningsInDecl Set ScopedIdent
moduleNames Declaration
dec forall a. Semigroup a => a -> a -> a
<> Set Text -> Declaration -> MultipleErrors
checkTypeVarsInDecl Set Text
s Declaration
dec)
    f' Set Text
s (TypeDeclaration td :: TypeDeclarationData
td@(TypeDeclarationData (SourceSpan
ss, [Comment]
_) Ident
_ SourceType
_)) =
      ErrorMessageHint -> MultipleErrors -> MultipleErrors
addHint (Ident -> ErrorMessageHint
ErrorInTypeDeclaration (TypeDeclarationData -> Ident
tydeclIdent TypeDeclarationData
td)) (SourceSpan -> Set Text -> SourceType -> MultipleErrors
checkTypeVars SourceSpan
ss Set Text
s (TypeDeclarationData -> SourceType
tydeclType TypeDeclarationData
td))
    f' Set Text
s Declaration
dec = Set ScopedIdent -> Declaration -> MultipleErrors
warningsInDecl Set ScopedIdent
moduleNames Declaration
dec forall a. Semigroup a => a -> a -> a
<> Set Text -> Declaration -> MultipleErrors
checkTypeVarsInDecl Set Text
s Declaration
dec

    stepE :: S.Set ScopedIdent -> Expr -> MultipleErrors
    stepE :: Set ScopedIdent -> Expr -> MultipleErrors
stepE Set ScopedIdent
s (Abs (VarBinder SourceSpan
ss Ident
name) Expr
_) | Ident
name Ident -> Set ScopedIdent -> Bool
`inScope` Set ScopedIdent
s = SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' SourceSpan
ss (Ident -> SimpleErrorMessage
ShadowedName Ident
name)
    stepE Set ScopedIdent
s (Let WhereProvenance
_ [Declaration]
ds' Expr
_) = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Declaration -> MultipleErrors
go [Declaration]
ds'
      where
      go :: Declaration -> MultipleErrors
go Declaration
d | Just Ident
i <- Declaration -> Maybe Ident
getDeclIdent Declaration
d
           , Ident -> Set ScopedIdent -> Bool
inScope Ident
i Set ScopedIdent
s = SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' (Declaration -> SourceSpan
declSourceSpan Declaration
d) (Ident -> SimpleErrorMessage
ShadowedName Ident
i)
           | Bool
otherwise = forall a. Monoid a => a
mempty
    stepE Set ScopedIdent
_ Expr
_ = forall a. Monoid a => a
mempty

    stepB :: S.Set ScopedIdent -> Binder -> MultipleErrors
    stepB :: Set ScopedIdent -> Binder -> MultipleErrors
stepB Set ScopedIdent
s (VarBinder SourceSpan
ss Ident
name)
      | Ident
name Ident -> Set ScopedIdent -> Bool
`inScope` Set ScopedIdent
s
      = SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' SourceSpan
ss (Ident -> SimpleErrorMessage
ShadowedName Ident
name)
    stepB Set ScopedIdent
s (NamedBinder SourceSpan
ss Ident
name Binder
_)
      | Ident -> Set ScopedIdent -> Bool
inScope Ident
name Set ScopedIdent
s
      = SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' SourceSpan
ss (Ident -> SimpleErrorMessage
ShadowedName Ident
name)
    stepB Set ScopedIdent
_ Binder
_ = forall a. Monoid a => a
mempty

    stepDo :: S.Set ScopedIdent -> DoNotationElement -> MultipleErrors
    stepDo :: Set ScopedIdent -> DoNotationElement -> MultipleErrors
stepDo Set ScopedIdent
s (DoNotationLet [Declaration]
ds') = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Declaration -> MultipleErrors
go [Declaration]
ds'
      where
      go :: Declaration -> MultipleErrors
go Declaration
d
        | Just Ident
i <- Declaration -> Maybe Ident
getDeclIdent Declaration
d, Ident
i Ident -> Set ScopedIdent -> Bool
`inScope` Set ScopedIdent
s = SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' (Declaration -> SourceSpan
declSourceSpan Declaration
d) (Ident -> SimpleErrorMessage
ShadowedName Ident
i)
        | Bool
otherwise = forall a. Monoid a => a
mempty
    stepDo Set ScopedIdent
_ DoNotationElement
_ = forall a. Monoid a => a
mempty

  checkTypeVarsInDecl :: S.Set Text -> Declaration -> MultipleErrors
  checkTypeVarsInDecl :: Set Text -> Declaration -> MultipleErrors
checkTypeVarsInDecl Set Text
s Declaration
d = let (Declaration -> MultipleErrors
f, Expr -> MultipleErrors
_, Binder -> MultipleErrors
_, CaseAlternative -> MultipleErrors
_, DoNotationElement -> MultipleErrors
_) = forall r.
Monoid r =>
(SourceType -> r)
-> (Declaration -> r, Expr -> r, Binder -> r, CaseAlternative -> r,
    DoNotationElement -> r)
accumTypes (SourceSpan -> Set Text -> SourceType -> MultipleErrors
checkTypeVars (Declaration -> SourceSpan
declSourceSpan Declaration
d) Set Text
s) in Declaration -> MultipleErrors
f Declaration
d

  checkTypeVars :: SourceSpan -> S.Set Text -> SourceType -> MultipleErrors
  checkTypeVars :: SourceSpan -> Set Text -> SourceType -> MultipleErrors
checkTypeVars SourceSpan
ss Set Text
set SourceType
ty = forall s r a.
s -> r -> (r -> r -> r) -> (s -> Type a -> (s, r)) -> Type a -> r
everythingWithContextOnTypes Set Text
set forall a. Monoid a => a
mempty forall a. Monoid a => a -> a -> a
mappend Set Text -> SourceType -> (Set Text, MultipleErrors)
step SourceType
ty forall a. Semigroup a => a -> a -> a
<> forall a b. (a, b) -> b
snd (SourceType -> (Set Text, MultipleErrors)
findUnused SourceType
ty)
    where

    step :: S.Set Text -> SourceType -> (S.Set Text, MultipleErrors)
    step :: Set Text -> SourceType -> (Set Text, MultipleErrors)
step Set Text
s (ForAll SourceAnn
_ Text
tv Maybe SourceType
_ SourceType
_ Maybe SkolemScope
_) = Set Text -> Text -> (Set Text, MultipleErrors)
bindVar Set Text
s Text
tv
    step Set Text
s SourceType
_ = (Set Text
s, forall a. Monoid a => a
mempty)

    bindVar :: S.Set Text -> Text -> (S.Set Text, MultipleErrors)
    bindVar :: Set Text -> Text -> (Set Text, MultipleErrors)
bindVar = forall a.
Ord a =>
SourceSpan
-> (a -> SimpleErrorMessage)
-> Set a
-> a
-> (Set a, MultipleErrors)
bind SourceSpan
ss Text -> SimpleErrorMessage
ShadowedTypeVar

    findUnused :: SourceType -> (S.Set Text, MultipleErrors)
    findUnused :: SourceType -> (Set Text, MultipleErrors)
findUnused = Set Text -> SourceType -> (Set Text, MultipleErrors)
go Set Text
set where
      -- Recursively walk the type and prune used variables from `unused`
      go :: S.Set Text -> SourceType -> (S.Set Text, MultipleErrors)
      go :: Set Text -> SourceType -> (Set Text, MultipleErrors)
go Set Text
unused (TypeVar SourceAnn
_ Text
v) = (forall a. Ord a => a -> Set a -> Set a
S.delete Text
v Set Text
unused, forall a. Monoid a => a
mempty)
      go Set Text
unused (ForAll SourceAnn
_ Text
tv Maybe SourceType
mbK SourceType
t1 Maybe SkolemScope
_) =
        let (Set Text
nowUnused, MultipleErrors
errors)
              | Just SourceType
k <- Maybe SourceType
mbK = Set Text -> SourceType -> (Set Text, MultipleErrors)
go Set Text
unused SourceType
k (Set Text, MultipleErrors)
-> (Set Text, MultipleErrors) -> (Set Text, MultipleErrors)
`combine` Set Text -> SourceType -> (Set Text, MultipleErrors)
go (forall a. Ord a => a -> Set a -> Set a
S.insert Text
tv Set Text
unused) SourceType
t1
              | Bool
otherwise = Set Text -> SourceType -> (Set Text, MultipleErrors)
go (forall a. Ord a => a -> Set a -> Set a
S.insert Text
tv Set Text
unused) SourceType
t1
            restoredUnused :: Set Text
restoredUnused = if forall a. Ord a => a -> Set a -> Bool
S.member Text
tv Set Text
unused then forall a. Ord a => a -> Set a -> Set a
S.insert Text
tv Set Text
nowUnused else Set Text
nowUnused
            combinedErrors :: MultipleErrors
combinedErrors = if forall a. Ord a => a -> Set a -> Bool
S.member Text
tv Set Text
nowUnused then MultipleErrors
errors forall a. Semigroup a => a -> a -> a
<> SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' SourceSpan
ss (Text -> SimpleErrorMessage
UnusedTypeVar Text
tv) else MultipleErrors
errors
        in (Set Text
restoredUnused, MultipleErrors
combinedErrors)
      go Set Text
unused (TypeApp SourceAnn
_ SourceType
f SourceType
x) = Set Text -> SourceType -> (Set Text, MultipleErrors)
go Set Text
unused SourceType
f (Set Text, MultipleErrors)
-> (Set Text, MultipleErrors) -> (Set Text, MultipleErrors)
`combine` Set Text -> SourceType -> (Set Text, MultipleErrors)
go Set Text
unused SourceType
x
      go Set Text
unused (KindApp SourceAnn
_ SourceType
f SourceType
x) = Set Text -> SourceType -> (Set Text, MultipleErrors)
go Set Text
unused SourceType
f (Set Text, MultipleErrors)
-> (Set Text, MultipleErrors) -> (Set Text, MultipleErrors)
`combine` Set Text -> SourceType -> (Set Text, MultipleErrors)
go Set Text
unused SourceType
x
      go Set Text
unused (ConstrainedType SourceAnn
_ SourceConstraint
c SourceType
t1) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Set Text, MultipleErrors)
-> (Set Text, MultipleErrors) -> (Set Text, MultipleErrors)
combine (Set Text
unused, forall a. Monoid a => a
mempty) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Set Text -> SourceType -> (Set Text, MultipleErrors)
go Set Text
unused) (forall a. Constraint a -> [Type a]
constraintArgs SourceConstraint
c forall a. Semigroup a => a -> a -> a
<> [SourceType
t1])
      go Set Text
unused (RCons SourceAnn
_ Label
_ SourceType
t1 SourceType
rest) = Set Text -> SourceType -> (Set Text, MultipleErrors)
go Set Text
unused SourceType
t1 (Set Text, MultipleErrors)
-> (Set Text, MultipleErrors) -> (Set Text, MultipleErrors)
`combine` Set Text -> SourceType -> (Set Text, MultipleErrors)
go Set Text
unused SourceType
rest
      go Set Text
unused (KindedType SourceAnn
_ SourceType
t1 SourceType
_) = Set Text -> SourceType -> (Set Text, MultipleErrors)
go Set Text
unused SourceType
t1
      go Set Text
unused (ParensInType SourceAnn
_ SourceType
t1) = Set Text -> SourceType -> (Set Text, MultipleErrors)
go Set Text
unused SourceType
t1
      go Set Text
unused (BinaryNoParensType SourceAnn
_ SourceType
t1 SourceType
t2 SourceType
t3) = Set Text -> SourceType -> (Set Text, MultipleErrors)
go Set Text
unused SourceType
t1 (Set Text, MultipleErrors)
-> (Set Text, MultipleErrors) -> (Set Text, MultipleErrors)
`combine` Set Text -> SourceType -> (Set Text, MultipleErrors)
go Set Text
unused SourceType
t2 (Set Text, MultipleErrors)
-> (Set Text, MultipleErrors) -> (Set Text, MultipleErrors)
`combine` Set Text -> SourceType -> (Set Text, MultipleErrors)
go Set Text
unused SourceType
t3
      go Set Text
unused TUnknown{} = (Set Text
unused, forall a. Monoid a => a
mempty)
      go Set Text
unused TypeLevelString{} = (Set Text
unused, forall a. Monoid a => a
mempty)
      go Set Text
unused TypeLevelInt{} = (Set Text
unused, forall a. Monoid a => a
mempty)
      go Set Text
unused TypeWildcard{} = (Set Text
unused, forall a. Monoid a => a
mempty)
      go Set Text
unused TypeConstructor{} = (Set Text
unused, forall a. Monoid a => a
mempty)
      go Set Text
unused TypeOp{} = (Set Text
unused, forall a. Monoid a => a
mempty)
      go Set Text
unused Skolem{} = (Set Text
unused, forall a. Monoid a => a
mempty)
      go Set Text
unused REmpty{} = (Set Text
unused, forall a. Monoid a => a
mempty)

      combine ::
        (S.Set Text, MultipleErrors) ->
        (S.Set Text, MultipleErrors) ->
        (S.Set Text, MultipleErrors)
      combine :: (Set Text, MultipleErrors)
-> (Set Text, MultipleErrors) -> (Set Text, MultipleErrors)
combine (Set Text
a, MultipleErrors
b) (Set Text
c, MultipleErrors
d) = (forall a. Ord a => Set a -> Set a -> Set a
S.intersection Set Text
a Set Text
c, MultipleErrors
b forall a. Semigroup a => a -> a -> a
<> MultipleErrors
d)

  bind :: (Ord a) => SourceSpan -> (a -> SimpleErrorMessage) -> S.Set a -> a -> (S.Set a, MultipleErrors)
  bind :: forall a.
Ord a =>
SourceSpan
-> (a -> SimpleErrorMessage)
-> Set a
-> a
-> (Set a, MultipleErrors)
bind SourceSpan
ss a -> SimpleErrorMessage
mkError Set a
s a
name
    | a
name forall a. Ord a => a -> Set a -> Bool
`S.member` Set a
s = (Set a
s, SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' SourceSpan
ss (a -> SimpleErrorMessage
mkError a
name))
    | Bool
otherwise = (forall a. Ord a => a -> Set a -> Set a
S.insert a
name Set a
s, forall a. Monoid a => a
mempty)



lintUnused :: forall m. (MonadWriter MultipleErrors m) => Module -> m ()
lintUnused :: forall (m :: * -> *).
MonadWriter MultipleErrors m =>
Module -> m ()
lintUnused (Module SourceSpan
modSS [Comment]
_ ModuleName
mn [Declaration]
modDecls Maybe [DeclarationRef]
exports) =
  forall w (m :: * -> *) a. MonadWriter w m => (w -> w) -> m a -> m a
censor (ErrorMessageHint -> MultipleErrors -> MultipleErrors
addHint (ModuleName -> ErrorMessageHint
ErrorInModule ModuleName
mn)) forall a b. (a -> b) -> a -> b
$ do
    [Set Ident]
topVars <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Declaration -> m (Set Ident)
lintDeclaration [Declaration]
modDecls
    let allVars :: Set Ident
allVars = forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions [Set Ident]
topVars
    case Maybe [DeclarationRef]
exports of
      Maybe [DeclarationRef]
Nothing ->
        forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just [DeclarationRef]
exports'
        | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any DeclarationRef -> Bool
thisModuleRef [DeclarationRef]
exports' -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        | Bool
otherwise -> do
          let exportIds :: Set Ident
exportIds = forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DeclarationRef -> Maybe Ident
getValueRef [DeclarationRef]
exports'
              expectedUsedDecls :: Set Ident
expectedUsedDecls = forall a. Ord a => [a] -> Set a
S.fromList (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Declaration -> Maybe Ident
getDeclIdent forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter Declaration -> Bool
isValueDecl [Declaration]
modDecls) forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set Ident
exportIds
              unused :: Set Ident
unused = (Set Ident
expectedUsedDecls forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set Ident
allVars) forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set Ident
rebindable
              newErrs :: MultipleErrors
newErrs = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Ident -> MultipleErrors
unusedDeclError forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList Set Ident
unused
          forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell MultipleErrors
newErrs
          forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
  unusedDeclError :: Ident -> MultipleErrors
unusedDeclError Ident
ident = SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' SourceSpan
ss forall a b. (a -> b) -> a -> b
$ Ident -> SimpleErrorMessage
UnusedDeclaration Ident
ident
    where
      ss :: SourceSpan
ss = case forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Ident
ident) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Declaration -> Maybe Ident
getDeclIdent) [Declaration]
modDecls of
                  Declaration
decl:[Declaration]
_ -> Declaration -> SourceSpan
declSourceSpan Declaration
decl
                  [Declaration]
_ -> SourceSpan
modSS

  thisModuleRef :: DeclarationRef -> Bool
  thisModuleRef :: DeclarationRef -> Bool
thisModuleRef (ModuleRef SourceSpan
_ ModuleName
mn') = ModuleName
mn forall a. Eq a => a -> a -> Bool
== ModuleName
mn'
  thisModuleRef DeclarationRef
_ = Bool
False

  rebindable :: S.Set Ident
  rebindable :: Set Ident
rebindable = forall a. Ord a => [a] -> Set a
S.fromList [ Text -> Ident
Ident forall a. (Eq a, IsString a) => a
C.S_bind, Text -> Ident
Ident forall a. (Eq a, IsString a) => a
C.S_discard ]

  getDeclIdent :: Declaration -> Maybe Ident
  getDeclIdent :: Declaration -> Maybe Ident
getDeclIdent = Name -> Maybe Ident
getIdentName forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Declaration -> Maybe Name
declName

  lintDeclaration :: Declaration -> m (S.Set Ident)
  lintDeclaration :: Declaration -> m (Set Ident)
lintDeclaration Declaration
declToLint = do
    let (Set Ident
vars, MultipleErrors
errs) = Declaration -> (Set Ident, MultipleErrors)
goDecl Declaration
declToLint
    forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell MultipleErrors
errs
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Set Ident
vars
    where

    goDecl :: Declaration -> (S.Set Ident, MultipleErrors)
    goDecl :: Declaration -> (Set Ident, MultipleErrors)
goDecl (ValueDeclaration ValueDeclarationData [GuardedExpr]
vd) =
        let allExprs :: [Expr]
allExprs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GuardedExpr -> [Expr]
unguard forall a b. (a -> b) -> a -> b
$ forall a. ValueDeclarationData a -> a
valdeclExpression ValueDeclarationData [GuardedExpr]
vd
            bindNewNames :: Set (SourceSpan, Ident)
bindNewNames = forall a. Ord a => [a] -> Set a
S.fromList (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Binder -> [(SourceSpan, Ident)]
binderNamesWithSpans forall a b. (a -> b) -> a -> b
$ forall a. ValueDeclarationData a -> [Binder]
valdeclBinders ValueDeclarationData [GuardedExpr]
vd)
            (Set Ident
vars, MultipleErrors
errs) = Set (SourceSpan, Ident)
-> (Set Ident, MultipleErrors) -> (Set Ident, MultipleErrors)
removeAndWarn Set (SourceSpan, Ident)
bindNewNames forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Expr -> (Set Ident, MultipleErrors)
go [Expr]
allExprs
            errs' :: MultipleErrors
errs' = ErrorMessageHint -> MultipleErrors -> MultipleErrors
addHint (Ident -> ErrorMessageHint
ErrorInValueDeclaration forall a b. (a -> b) -> a -> b
$ forall a. ValueDeclarationData a -> Ident
valdeclIdent ValueDeclarationData [GuardedExpr]
vd) MultipleErrors
errs
        in
          (Set Ident
vars, MultipleErrors
errs')

    goDecl (TypeInstanceDeclaration SourceAnn
_ SourceAnn
_ ChainId
_ Integer
_ Either Text Ident
_ [SourceConstraint]
_ Qualified (ProperName 'ClassName)
_ [SourceType]
_ (ExplicitInstance [Declaration]
decls)) = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Declaration -> (Set Ident, MultipleErrors)
goDecl [Declaration]
decls
    goDecl Declaration
_ = forall a. Monoid a => a
mempty

    go :: Expr -> (S.Set Ident, MultipleErrors)
    go :: Expr -> (Set Ident, MultipleErrors)
go (Var SourceSpan
_ (Qualified (BySourcePos SourcePos
_) Ident
v)) = (forall a. a -> Set a
S.singleton Ident
v, forall a. Monoid a => a
mempty)
    go (Var SourceSpan
_ Qualified Ident
_) = (forall a. Set a
S.empty, forall a. Monoid a => a
mempty)

    go (Let WhereProvenance
_ [Declaration]
ds Expr
e) = [Declaration]
-> (Set Ident, MultipleErrors) -> (Set Ident, MultipleErrors)
onDecls [Declaration]
ds (Expr -> (Set Ident, MultipleErrors)
go Expr
e)

    go (Abs Binder
binder Expr
v1) =
      let newNames :: Set (SourceSpan, Ident)
newNames = forall a. Ord a => [a] -> Set a
S.fromList (Binder -> [(SourceSpan, Ident)]
binderNamesWithSpans Binder
binder)
      in
      Set (SourceSpan, Ident)
-> (Set Ident, MultipleErrors) -> (Set Ident, MultipleErrors)
removeAndWarn Set (SourceSpan, Ident)
newNames forall a b. (a -> b) -> a -> b
$ Expr -> (Set Ident, MultipleErrors)
go Expr
v1

    go (UnaryMinus SourceSpan
_ Expr
v1) = Expr -> (Set Ident, MultipleErrors)
go Expr
v1
    go (BinaryNoParens Expr
v0 Expr
v1 Expr
v2) = Expr -> (Set Ident, MultipleErrors)
go Expr
v0 forall a. Semigroup a => a -> a -> a
<> Expr -> (Set Ident, MultipleErrors)
go Expr
v1 forall a. Semigroup a => a -> a -> a
<> Expr -> (Set Ident, MultipleErrors)
go Expr
v2
    go (Parens Expr
v1) = Expr -> (Set Ident, MultipleErrors)
go Expr
v1
    go (Accessor PSString
_ Expr
v1) = Expr -> (Set Ident, MultipleErrors)
go Expr
v1

    go (ObjectUpdate Expr
obj [(PSString, Expr)]
vs) = forall a. Monoid a => [a] -> a
mconcat (Expr -> (Set Ident, MultipleErrors)
go Expr
obj forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Expr -> (Set Ident, MultipleErrors)
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(PSString, Expr)]
vs)
    go (ObjectUpdateNested Expr
obj PathTree Expr
vs) = Expr -> (Set Ident, MultipleErrors)
go Expr
obj forall a. Semigroup a => a -> a -> a
<> PathTree Expr -> (Set Ident, MultipleErrors)
goTree PathTree Expr
vs
      where
        goTree :: PathTree Expr -> (Set Ident, MultipleErrors)
goTree (PathTree AssocList PSString (PathNode Expr)
tree) = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (PathNode Expr -> (Set Ident, MultipleErrors)
goNode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall k t. AssocList k t -> [(k, t)]
runAssocList AssocList PSString (PathNode Expr)
tree)
        goNode :: PathNode Expr -> (Set Ident, MultipleErrors)
goNode (Leaf Expr
val) = Expr -> (Set Ident, MultipleErrors)
go Expr
val
        goNode (Branch PathTree Expr
val) = PathTree Expr -> (Set Ident, MultipleErrors)
goTree PathTree Expr
val

    go (App Expr
v1 Expr
v2) = Expr -> (Set Ident, MultipleErrors)
go Expr
v1 forall a. Semigroup a => a -> a -> a
<> Expr -> (Set Ident, MultipleErrors)
go Expr
v2
    go (Unused Expr
v) = Expr -> (Set Ident, MultipleErrors)
go Expr
v
    go (IfThenElse Expr
v1 Expr
v2 Expr
v3) = Expr -> (Set Ident, MultipleErrors)
go Expr
v1 forall a. Semigroup a => a -> a -> a
<> Expr -> (Set Ident, MultipleErrors)
go Expr
v2 forall a. Semigroup a => a -> a -> a
<> Expr -> (Set Ident, MultipleErrors)
go Expr
v3
    go (Case [Expr]
vs [CaseAlternative]
alts) =
      let f :: CaseAlternative -> (Set Ident, MultipleErrors)
f (CaseAlternative [Binder]
binders [GuardedExpr]
gexprs) =
            let bindNewNames :: Set (SourceSpan, Ident)
bindNewNames = forall a. Ord a => [a] -> Set a
S.fromList (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Binder -> [(SourceSpan, Ident)]
binderNamesWithSpans [Binder]
binders)
                allExprs :: [Expr]
allExprs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GuardedExpr -> [Expr]
unguard [GuardedExpr]
gexprs
            in
                Set (SourceSpan, Ident)
-> (Set Ident, MultipleErrors) -> (Set Ident, MultipleErrors)
removeAndWarn Set (SourceSpan, Ident)
bindNewNames forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Expr -> (Set Ident, MultipleErrors)
go [Expr]
allExprs
      in
      forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Expr -> (Set Ident, MultipleErrors)
go [Expr]
vs forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map CaseAlternative -> (Set Ident, MultipleErrors)
f [CaseAlternative]
alts

    go (TypedValue Bool
_ Expr
v1 SourceType
_) = Expr -> (Set Ident, MultipleErrors)
go Expr
v1
    go (Do Maybe ModuleName
_ [DoNotationElement]
es) = [DoNotationElement] -> Maybe Expr -> (Set Ident, MultipleErrors)
doElts [DoNotationElement]
es forall a. Maybe a
Nothing
    go (Ado Maybe ModuleName
_ [DoNotationElement]
es Expr
v1) = [DoNotationElement] -> Maybe Expr -> (Set Ident, MultipleErrors)
doElts [DoNotationElement]
es (forall a. a -> Maybe a
Just Expr
v1)

    go (Literal SourceSpan
_ (ArrayLiteral [Expr]
es)) = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Expr -> (Set Ident, MultipleErrors)
go [Expr]
es
    go (Literal SourceSpan
_ (ObjectLiteral [(PSString, Expr)]
oo)) = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Expr -> (Set Ident, MultipleErrors)
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(PSString, Expr)]
oo

    go (PositionedValue SourceSpan
_ [Comment]
_ Expr
v1) = Expr -> (Set Ident, MultipleErrors)
go Expr
v1

    go (Literal SourceSpan
_ Literal Expr
_) = forall a. Monoid a => a
mempty
    go (Op SourceSpan
_ Qualified (OpName 'ValueOpName)
_) = forall a. Monoid a => a
mempty
    go (Constructor SourceSpan
_ Qualified (ProperName 'ConstructorName)
_) = forall a. Monoid a => a
mempty
    go (TypeClassDictionary SourceConstraint
_ Map
  QualifiedBy
  (Map
     (Qualified (ProperName 'ClassName))
     (Map (Qualified Ident) (NonEmpty NamedDict)))
_ [ErrorMessageHint]
_) = forall a. Monoid a => a
mempty
    go (DeferredDictionary Qualified (ProperName 'ClassName)
_ [SourceType]
_) = forall a. Monoid a => a
mempty
    go (DerivedInstancePlaceholder Qualified (ProperName 'ClassName)
_ InstanceDerivationStrategy
_) = forall a. Monoid a => a
mempty
    go Expr
AnonymousArgument = forall a. Monoid a => a
mempty
    go (Hole Text
_) = forall a. Monoid a => a
mempty


    doElts :: [DoNotationElement] -> Maybe Expr -> (S.Set Ident, MultipleErrors)
    doElts :: [DoNotationElement] -> Maybe Expr -> (Set Ident, MultipleErrors)
doElts (DoNotationValue Expr
e : [DoNotationElement]
rest) Maybe Expr
v = Expr -> (Set Ident, MultipleErrors)
go Expr
e forall a. Semigroup a => a -> a -> a
<> [DoNotationElement] -> Maybe Expr -> (Set Ident, MultipleErrors)
doElts [DoNotationElement]
rest Maybe Expr
v
    doElts (DoNotationBind Binder
binder Expr
e : [DoNotationElement]
rest) Maybe Expr
v =
      let bindNewNames :: Set (SourceSpan, Ident)
bindNewNames = forall a. Ord a => [a] -> Set a
S.fromList (Binder -> [(SourceSpan, Ident)]
binderNamesWithSpans Binder
binder)
      in Expr -> (Set Ident, MultipleErrors)
go Expr
e forall a. Semigroup a => a -> a -> a
<> Set (SourceSpan, Ident)
-> (Set Ident, MultipleErrors) -> (Set Ident, MultipleErrors)
removeAndWarn Set (SourceSpan, Ident)
bindNewNames ([DoNotationElement] -> Maybe Expr -> (Set Ident, MultipleErrors)
doElts [DoNotationElement]
rest Maybe Expr
v)

    doElts (DoNotationLet [Declaration]
ds : [DoNotationElement]
rest) Maybe Expr
v = [Declaration]
-> (Set Ident, MultipleErrors) -> (Set Ident, MultipleErrors)
onDecls [Declaration]
ds ([DoNotationElement] -> Maybe Expr -> (Set Ident, MultipleErrors)
doElts [DoNotationElement]
rest Maybe Expr
v)

    doElts (PositionedDoNotationElement SourceSpan
_ [Comment]
_ DoNotationElement
e : [DoNotationElement]
rest) Maybe Expr
v = [DoNotationElement] -> Maybe Expr -> (Set Ident, MultipleErrors)
doElts (DoNotationElement
e forall a. a -> [a] -> [a]
: [DoNotationElement]
rest) Maybe Expr
v
    doElts [] (Just Expr
e) = Expr -> (Set Ident, MultipleErrors)
go Expr
e forall a. Semigroup a => a -> a -> a
<> (Set Ident
rebindable, forall a. Monoid a => a
mempty)
    doElts [] Maybe Expr
Nothing = (Set Ident
rebindable, forall a. Monoid a => a
mempty)

    -- (non-recursively, recursively) bound idents in decl
    declIdents :: Declaration -> (S.Set (SourceSpan, Ident), S.Set (SourceSpan, Ident))
    declIdents :: Declaration -> (Set (SourceSpan, Ident), Set (SourceSpan, Ident))
declIdents (ValueDecl (SourceSpan
ss,[Comment]
_) Ident
ident NameKind
_ [Binder]
_ [GuardedExpr]
_) = (forall a. Set a
S.empty, forall a. a -> Set a
S.singleton (SourceSpan
ss, Ident
ident))
    declIdents (BoundValueDeclaration SourceAnn
_ Binder
binders Expr
_) = (forall a. Ord a => [a] -> Set a
S.fromList forall a b. (a -> b) -> a -> b
$ Binder -> [(SourceSpan, Ident)]
binderNamesWithSpans Binder
binders, forall a. Set a
S.empty)
    declIdents Declaration
_ = (forall a. Set a
S.empty, forall a. Set a
S.empty)

    onDecls :: [ Declaration ] -> (S.Set Ident, MultipleErrors) -> (S.Set Ident, MultipleErrors)
    onDecls :: [Declaration]
-> (Set Ident, MultipleErrors) -> (Set Ident, MultipleErrors)
onDecls [Declaration]
ds (Set Ident, MultipleErrors)
errs = 
      let 
        onDecl :: Declaration
-> ((Set Ident, MultipleErrors), Set (SourceSpan, Ident))
-> ((Set Ident, MultipleErrors), Set (SourceSpan, Ident))
onDecl Declaration
d ((Set Ident, MultipleErrors)
accErrs, Set (SourceSpan, Ident)
accLetNamesRec) = 
            let (Set (SourceSpan, Ident)
letNames, Set (SourceSpan, Ident)
recNames) = Declaration -> (Set (SourceSpan, Ident), Set (SourceSpan, Ident))
declIdents Declaration
d
                dErrs :: (Set Ident, MultipleErrors)
dErrs = Declaration -> (Set Ident, MultipleErrors)
underDecl Declaration
d
                errs' :: (Set Ident, MultipleErrors)
errs' = (Set Ident, MultipleErrors)
dErrs forall a. Semigroup a => a -> a -> a
<> Set (SourceSpan, Ident)
-> (Set Ident, MultipleErrors) -> (Set Ident, MultipleErrors)
removeAndWarn Set (SourceSpan, Ident)
letNames (Set Ident, MultipleErrors)
accErrs
            in
                ((Set Ident, MultipleErrors)
errs', Set (SourceSpan, Ident)
accLetNamesRec forall a. Semigroup a => a -> a -> a
<> Set (SourceSpan, Ident)
recNames)
        ((Set Ident, MultipleErrors)
errs'', Set (SourceSpan, Ident)
letNamesRec) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Declaration
-> ((Set Ident, MultipleErrors), Set (SourceSpan, Ident))
-> ((Set Ident, MultipleErrors), Set (SourceSpan, Ident))
onDecl ((Set Ident, MultipleErrors)
errs, forall a. Set a
S.empty) [Declaration]
ds
      in
        Set (SourceSpan, Ident)
-> (Set Ident, MultipleErrors) -> (Set Ident, MultipleErrors)
removeAndWarn Set (SourceSpan, Ident)
letNamesRec (Set Ident, MultipleErrors)
errs''

    -- let f x = e  -- check the x in e (but not the f)
    underDecl :: Declaration -> (Set Ident, MultipleErrors)
underDecl (ValueDecl SourceAnn
_ Ident
_ NameKind
_ [Binder]
binders [GuardedExpr]
gexprs) =
      let bindNewNames :: Set (SourceSpan, Ident)
bindNewNames = forall a. Ord a => [a] -> Set a
S.fromList (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Binder -> [(SourceSpan, Ident)]
binderNamesWithSpans [Binder]
binders)
          allExprs :: [Expr]
allExprs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap GuardedExpr -> [Expr]
unguard [GuardedExpr]
gexprs
      in
          Set (SourceSpan, Ident)
-> (Set Ident, MultipleErrors) -> (Set Ident, MultipleErrors)
removeAndWarn Set (SourceSpan, Ident)
bindNewNames forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall a. Semigroup a => a -> a -> a
(<>) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Expr -> (Set Ident, MultipleErrors)
go [Expr]
allExprs
    -- let {x} = e  -- no binding to check inside e
    underDecl (BoundValueDeclaration SourceAnn
_ Binder
_ Expr
expr) = Expr -> (Set Ident, MultipleErrors)
go Expr
expr
    underDecl Declaration
_ = (forall a. Monoid a => a
mempty, forall a. Monoid a => a
mempty)

    unguard :: GuardedExpr -> [Expr]
unguard (GuardedExpr [Guard]
guards Expr
expr) = forall a b. (a -> b) -> [a] -> [b]
map Guard -> Expr
unguard' [Guard]
guards forall a. [a] -> [a] -> [a]
++ [Expr
expr]
    unguard' :: Guard -> Expr
unguard' (ConditionGuard Expr
ee) = Expr
ee
    unguard' (PatternGuard Binder
_ Expr
ee) = Expr
ee

    removeAndWarn :: S.Set (SourceSpan, Ident) -> (S.Set Ident, MultipleErrors) -> (S.Set Ident, MultipleErrors)
    removeAndWarn :: Set (SourceSpan, Ident)
-> (Set Ident, MultipleErrors) -> (Set Ident, MultipleErrors)
removeAndWarn Set (SourceSpan, Ident)
newNamesWithSpans (Set Ident
used, MultipleErrors
errors) =
      let newNames :: Set Ident
newNames = forall b a. Ord b => (a -> b) -> Set a -> Set b
S.map forall a b. (a, b) -> b
snd Set (SourceSpan, Ident)
newNamesWithSpans
          filteredUsed :: Set Ident
filteredUsed = Set Ident
used forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set Ident
newNames
          warnUnused :: Set Ident
warnUnused = forall a. (a -> Bool) -> Set a -> Set a
S.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Bool
Text.isPrefixOf Text
"_" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Text
runIdent) (Set Ident
newNames forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set Ident
used)
          warnUnusedSpans :: Set (SourceSpan, Ident)
warnUnusedSpans = forall a. (a -> Bool) -> Set a -> Set a
S.filter (\(SourceSpan
_,Ident
ident) -> Ident
ident forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Set Ident
warnUnused) Set (SourceSpan, Ident)
newNamesWithSpans 
          combinedErrors :: MultipleErrors
combinedErrors = if Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a. Set a -> Bool
S.null Set (SourceSpan, Ident)
warnUnusedSpans then MultipleErrors
errors forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a b. (a -> b) -> [a] -> [b]
map (\(SourceSpan
ss,Ident
ident) -> SourceSpan -> SimpleErrorMessage -> MultipleErrors
errorMessage' SourceSpan
ss forall a b. (a -> b) -> a -> b
$ Ident -> SimpleErrorMessage
UnusedName Ident
ident) forall a b. (a -> b) -> a -> b
$ forall a. Set a -> [a]
S.toList Set (SourceSpan, Ident)
warnUnusedSpans) else MultipleErrors
errors
      in
        (Set Ident
filteredUsed, MultipleErrors
combinedErrors)