module Unison.LSP.FileAnalysis.UnusedBindings where

import Data.Foldable qualified as Foldable
import Data.Map qualified as Map
import Data.Set qualified as Set
import Data.Text qualified as Text
import Language.LSP.Protocol.Types (Diagnostic)
import Language.LSP.Protocol.Types qualified as Lsp
import U.Core.ABT (ABT (..))
import U.Core.ABT qualified as ABT
import Unison.LSP.Conversions qualified as Cv
import Unison.LSP.Diagnostics qualified as Diagnostic
import Unison.Parser.Ann (Ann)
import Unison.Prelude
import Unison.Symbol (Symbol (..))
import Unison.Term (Term)
import Unison.Term qualified as Term
import Unison.Util.List qualified as ListUtils
import Unison.Util.Range qualified as Range
import Unison.Util.Recursion
import Unison.Var qualified as Var

data VarUsages = VarUsages
  { VarUsages -> Map Symbol (Set Ann)
unusedVars :: Map Symbol (Set Ann),
    VarUsages -> Set Symbol
usedVars :: Set Symbol,
    -- This is generally a copy of usedVars, except that we _don't_ remove variables when they go out of scope.
    -- This is solely so we have the information to handle an edge case in pattern guards where vars are independently
    -- brought into scope in BOTH the guards and the body of a match case, and we want to count a var as used if it
    -- appears in _either_.
    VarUsages -> Set Symbol
allUsedVars :: Set Symbol
  }

instance Semigroup VarUsages where
  VarUsages Map Symbol (Set Ann)
a Set Symbol
b Set Symbol
c <> :: VarUsages -> VarUsages -> VarUsages
<> VarUsages Map Symbol (Set Ann)
a' Set Symbol
b' Set Symbol
c' =
    Map Symbol (Set Ann) -> Set Symbol -> Set Symbol -> VarUsages
VarUsages ((Set Ann -> Set Ann -> Set Ann)
-> Map Symbol (Set Ann)
-> Map Symbol (Set Ann)
-> Map Symbol (Set Ann)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Set Ann -> Set Ann -> Set Ann
forall a. Semigroup a => a -> a -> a
(<>) Map Symbol (Set Ann)
a Map Symbol (Set Ann)
a') (Set Symbol
b Set Symbol -> Set Symbol -> Set Symbol
forall a. Semigroup a => a -> a -> a
<> Set Symbol
b') (Set Symbol
c Set Symbol -> Set Symbol -> Set Symbol
forall a. Semigroup a => a -> a -> a
<> Set Symbol
c')

instance Monoid VarUsages where
  mempty :: VarUsages
mempty = Map Symbol (Set Ann) -> Set Symbol -> Set Symbol -> VarUsages
VarUsages Map Symbol (Set Ann)
forall a. Monoid a => a
mempty Set Symbol
forall a. Monoid a => a
mempty Set Symbol
forall a. Monoid a => a
mempty

analyseTerm :: Lsp.Uri -> Term Symbol Ann -> [Diagnostic]
analyseTerm :: Uri -> Term Symbol Ann -> [Diagnostic]
analyseTerm Uri
fileUri Term Symbol Ann
tm =
  let (VarUsages {Map Symbol (Set Ann)
$sel:unusedVars:VarUsages :: VarUsages -> Map Symbol (Set Ann)
unusedVars :: Map Symbol (Set Ann)
unusedVars}) = Algebra (Term' (F Symbol Ann Ann) Symbol Ann) VarUsages
-> Term Symbol Ann -> VarUsages
forall a.
Algebra (Term' (F Symbol Ann Ann) Symbol Ann) a
-> Term Symbol Ann -> a
forall t (f :: * -> *) a. Recursive t f => Algebra f a -> t -> a
cata Algebra (Term' (F Symbol Ann Ann) Symbol Ann) VarUsages
alg Term Symbol Ann
tm
      vars :: [(Text, Set Ann)]
vars =
        Map Symbol (Set Ann) -> [(Symbol, Set Ann)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Symbol (Set Ann)
unusedVars [(Symbol, Set Ann)]
-> ([(Symbol, Set Ann)] -> [(Text, Set Ann)]) -> [(Text, Set Ann)]
forall a b. a -> (a -> b) -> b
& ((Symbol, Set Ann) -> Maybe (Text, Set Ann))
-> [(Symbol, Set Ann)] -> [(Text, Set Ann)]
forall a b. (a -> Maybe b) -> [a] -> [b]
forall (f :: * -> *) a b.
Filterable f =>
(a -> Maybe b) -> f a -> f b
mapMaybe \(Symbol
v, Set Ann
ann) -> do
          (,Set Ann
ann) (Text -> (Text, Set Ann)) -> Maybe Text -> Maybe (Text, Set Ann)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Symbol -> Maybe Text
getRelevantVarName Symbol
v
      diagnostics :: [Diagnostic]
diagnostics =
        [(Text, Set Ann)]
vars [(Text, Set Ann)]
-> ([(Text, Set Ann)] -> [Diagnostic]) -> [Diagnostic]
forall a b. a -> (a -> b) -> b
& ((Text, Set Ann) -> [Diagnostic])
-> [(Text, Set Ann)] -> [Diagnostic]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \(Text
varName, Set Ann
anns) -> do
          Ann
ann <- Set Ann -> [Ann]
forall a. Set a -> [a]
Set.toList Set Ann
anns
          Range
range <- Maybe Range -> [Range]
forall a. Maybe a -> [a]
maybeToList (Maybe Range -> [Range]) -> Maybe Range -> [Range]
forall a b. (a -> b) -> a -> b
$ Ann -> Maybe Range
Cv.annToURange Ann
ann
          -- Limit the range to the first line of the binding to not be too annoying.
          -- Maybe in the future we can get the actual annotation of the variable name.
          let lspRange :: Range
lspRange = Range -> Range
Cv.uToLspRange (Range -> Range) -> (Range -> Range) -> Range -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> Range
Range.startingLine (Range -> Range) -> Range -> Range
forall a b. (a -> b) -> a -> b
$ Range
range
          Diagnostic -> [Diagnostic]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Diagnostic -> [Diagnostic]) -> Diagnostic -> [Diagnostic]
forall a b. (a -> b) -> a -> b
$ Uri
-> Range
-> DiagnosticSeverity
-> [DiagnosticTag]
-> Text
-> [(Text, Range)]
-> Diagnostic
Diagnostic.mkDiagnostic Uri
fileUri Range
lspRange DiagnosticSeverity
Diagnostic.DiagnosticSeverity_Warning [DiagnosticTag
Lsp.DiagnosticTag_Unnecessary] (Text
"Unused binding " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
tShow Text
varName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". Use the binding, or prefix it with an _ to dismiss this warning.") []
   in [Diagnostic]
diagnostics
  where
    getRelevantVarName :: Symbol -> Maybe Text
    getRelevantVarName :: Symbol -> Maybe Text
getRelevantVarName = \case
      -- Sometimes 'do' gets a binding of '()', which we don't care about
      Symbol Word64
_ (Var.User Text
"()") -> Maybe Text
forall a. Maybe a
Nothing
      Symbol Word64
_ (Var.User Text
"") -> Maybe Text
forall a. Maybe a
Nothing
      -- We only care about user bindings which don't start with an underscore
      Symbol Word64
_ (Var.User Text
n) -> do
        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Text -> Text -> Bool
Text.isPrefixOf Text
"_" Text
n))
        Text -> Maybe Text
forall a. a -> Maybe a
Just Text
n
      Symbol
_ -> Maybe Text
forall a. Maybe a
Nothing
    alg :: Algebra (ABT.Term' (Term.F Symbol Ann Ann) Symbol Ann) VarUsages
    alg :: Algebra (Term' (F Symbol Ann Ann) Symbol Ann) VarUsages
alg (ABT.Term' Set Symbol
_ Ann
ann ABT (F Symbol Ann Ann) Symbol VarUsages
abt) = case ABT (F Symbol Ann Ann) Symbol VarUsages
abt of
      Var Symbol
v -> VarUsages {$sel:unusedVars:VarUsages :: Map Symbol (Set Ann)
unusedVars = Map Symbol (Set Ann)
forall a. Monoid a => a
mempty, $sel:usedVars:VarUsages :: Set Symbol
usedVars = Symbol -> Set Symbol
forall a. a -> Set a
Set.singleton Symbol
v, $sel:allUsedVars:VarUsages :: Set Symbol
allUsedVars = Symbol -> Set Symbol
forall a. a -> Set a
Set.singleton Symbol
v}
      Cycle VarUsages
x -> VarUsages
x
      Abs Symbol
v (VarUsages {Map Symbol (Set Ann)
$sel:unusedVars:VarUsages :: VarUsages -> Map Symbol (Set Ann)
unusedVars :: Map Symbol (Set Ann)
unusedVars, Set Symbol
$sel:usedVars:VarUsages :: VarUsages -> Set Symbol
usedVars :: Set Symbol
usedVars, Set Symbol
$sel:allUsedVars:VarUsages :: VarUsages -> Set Symbol
allUsedVars :: Set Symbol
allUsedVars}) ->
        if Symbol
v Symbol -> Set Symbol -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Symbol
usedVars
          then VarUsages {Map Symbol (Set Ann)
$sel:unusedVars:VarUsages :: Map Symbol (Set Ann)
unusedVars :: Map Symbol (Set Ann)
unusedVars, $sel:usedVars:VarUsages :: Set Symbol
usedVars = Symbol -> Set Symbol -> Set Symbol
forall a. Ord a => a -> Set a -> Set a
Set.delete Symbol
v Set Symbol
usedVars, Set Symbol
$sel:allUsedVars:VarUsages :: Set Symbol
allUsedVars :: Set Symbol
allUsedVars}
          else VarUsages {$sel:unusedVars:VarUsages :: Map Symbol (Set Ann)
unusedVars = Symbol -> Set Ann -> Map Symbol (Set Ann) -> Map Symbol (Set Ann)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Symbol
v (Ann -> Set Ann
forall a. a -> Set a
Set.singleton Ann
ann) Map Symbol (Set Ann)
unusedVars, Set Symbol
$sel:usedVars:VarUsages :: Set Symbol
usedVars :: Set Symbol
usedVars, Set Symbol
$sel:allUsedVars:VarUsages :: Set Symbol
allUsedVars :: Set Symbol
allUsedVars}
      Tm F Symbol Ann Ann VarUsages
fx ->
        case F Symbol Ann Ann VarUsages
fx of
          -- We need to special-case pattern guards because the pattern, guard, and body treat each of their vars in
          -- their own independent scopes, even though the vars created in the pattern are the same ones used in the
          -- guards and bindings :shrug:
          Term.Match VarUsages
scrutinee [MatchCase Ann VarUsages]
cases ->
            let -- There's a separate case for every guard on a single pattern, so we first do our best to group up cases with the same pattern.
                -- Otherwise, a var may be reported unused in one branch of a guard even though it's used in another branch.
                groupedCases :: Map (Pattern Ann) [MatchCase Ann VarUsages]
groupedCases = (MatchCase Ann VarUsages -> Pattern Ann)
-> [MatchCase Ann VarUsages]
-> Map (Pattern Ann) [MatchCase Ann VarUsages]
forall (f :: * -> *) k v.
(Foldable f, Ord k) =>
(v -> k) -> f v -> Map k [v]
ListUtils.groupBy (\(Term.MatchCase Pattern Ann
pat Maybe VarUsages
_ VarUsages
_) -> Pattern Ann
pat) [MatchCase Ann VarUsages]
cases
                caseVars :: VarUsages
caseVars =
                  Map (Pattern Ann) [MatchCase Ann VarUsages]
groupedCases Map (Pattern Ann) [MatchCase Ann VarUsages]
-> (Map (Pattern Ann) [MatchCase Ann VarUsages] -> VarUsages)
-> VarUsages
forall a b. a -> (a -> b) -> b
& ([MatchCase Ann VarUsages] -> VarUsages)
-> Map (Pattern Ann) [MatchCase Ann VarUsages] -> VarUsages
forall m a. Monoid m => (a -> m) -> Map (Pattern Ann) a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap \[MatchCase Ann VarUsages]
singlePatCases ->
                    let (VarUsages {$sel:unusedVars:VarUsages :: VarUsages -> Map Symbol (Set Ann)
unusedVars = Map Symbol (Set Ann)
unused, $sel:usedVars:VarUsages :: VarUsages -> Set Symbol
usedVars = Set Symbol
used, $sel:allUsedVars:VarUsages :: VarUsages -> Set Symbol
allUsedVars = Set Symbol
allUsed}) =
                          [MatchCase Ann VarUsages]
singlePatCases
                            [MatchCase Ann VarUsages]
-> ([MatchCase Ann VarUsages] -> VarUsages) -> VarUsages
forall a b. a -> (a -> b) -> b
& (MatchCase Ann VarUsages -> VarUsages)
-> [MatchCase Ann VarUsages] -> VarUsages
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
                              ( \(Term.MatchCase Pattern Ann
pat Maybe VarUsages
guard VarUsages
body) ->
                                  -- This is imprecise, but it's quite annoying to get the actual ann of the unused bindings, so
                                  -- we just use the FULL span of the pattern for now. We could fix this with a bit
                                  -- of elbow grease.
                                  let patSpanAnn :: Ann
patSpanAnn = Pattern Ann -> Ann
forall m. Monoid m => Pattern m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Pattern Ann
pat
                                      combindedVarUsages :: VarUsages
combindedVarUsages = Maybe VarUsages -> VarUsages
forall m. Monoid m => Maybe m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Maybe VarUsages
guard VarUsages -> VarUsages -> VarUsages
forall a. Semigroup a => a -> a -> a
<> VarUsages
body
                                   in VarUsages
combindedVarUsages {unusedVars = (unusedVars combindedVarUsages) $> (Set.singleton patSpanAnn)}
                              )
                        actuallyUnusedVars :: Map Symbol (Set Ann)
actuallyUnusedVars = Map Symbol (Set Ann)
unused Map Symbol (Set Ann)
-> (Map Symbol (Set Ann) -> Map Symbol (Set Ann))
-> Map Symbol (Set Ann)
forall a b. a -> (a -> b) -> b
& (Symbol -> Set Ann -> Bool)
-> Map Symbol (Set Ann) -> Map Symbol (Set Ann)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey \Symbol
k Set Ann
_ -> Symbol
k Symbol -> Set Symbol -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.notMember` Set Symbol
allUsed
                     in VarUsages {$sel:unusedVars:VarUsages :: Map Symbol (Set Ann)
unusedVars = Map Symbol (Set Ann)
actuallyUnusedVars, $sel:usedVars:VarUsages :: Set Symbol
usedVars = Set Symbol
used, $sel:allUsedVars:VarUsages :: Set Symbol
allUsedVars = Set Symbol
allUsed}
             in VarUsages
scrutinee VarUsages -> VarUsages -> VarUsages
forall a. Semigroup a => a -> a -> a
<> VarUsages
caseVars
          F Symbol Ann Ann VarUsages
_ -> F Symbol Ann Ann VarUsages -> VarUsages
forall m. Monoid m => F Symbol Ann Ann m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
Foldable.fold F Symbol Ann Ann VarUsages
fx