{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
module Swarm.Language.LSP.VarUsage where

import Control.Monad (guard)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Map (Map)
import Data.Map qualified as M
import Data.Set (Set)
import Data.Set qualified as S
import Data.Text (Text)
import Data.Text qualified as T
import Language.LSP.Protocol.Types qualified as J
import Swarm.Language.Parser.Util qualified as P
import Swarm.Language.Syntax
import Swarm.Util qualified as U

data BindingType
  = Lambda
  | Let
  | Bind
  deriving (BindingType -> BindingType -> Bool
(BindingType -> BindingType -> Bool)
-> (BindingType -> BindingType -> Bool) -> Eq BindingType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BindingType -> BindingType -> Bool
== :: BindingType -> BindingType -> Bool
$c/= :: BindingType -> BindingType -> Bool
/= :: BindingType -> BindingType -> Bool
Eq, Int -> BindingType -> ShowS
[BindingType] -> ShowS
BindingType -> String
(Int -> BindingType -> ShowS)
-> (BindingType -> String)
-> ([BindingType] -> ShowS)
-> Show BindingType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BindingType -> ShowS
showsPrec :: Int -> BindingType -> ShowS
$cshow :: BindingType -> String
show :: BindingType -> String
$cshowList :: [BindingType] -> ShowS
showList :: [BindingType] -> ShowS
Show)

data VarUsage = VarUsage LocVar BindingType

type BindingSites = Map Var (NonEmpty SrcLoc)

data Usage = Usage
  { Usage -> Set LocVar
usages :: Set LocVar
  -- ^ Variable references
  , Usage -> [VarUsage]
problems :: [VarUsage]
  -- ^ Variable declarations without any references
  }

instance Semigroup Usage where
  Usage Set LocVar
y1 [VarUsage]
z1 <> :: Usage -> Usage -> Usage
<> Usage Set LocVar
y2 [VarUsage]
z2 =
    Set LocVar -> [VarUsage] -> Usage
Usage
      (Set LocVar
y1 Set LocVar -> Set LocVar -> Set LocVar
forall a. Semigroup a => a -> a -> a
<> Set LocVar
y2)
      ([VarUsage]
z1 [VarUsage] -> [VarUsage] -> [VarUsage]
forall a. Semigroup a => a -> a -> a
<> [VarUsage]
z2)

instance Monoid Usage where
  mempty :: Usage
mempty = Set LocVar -> [VarUsage] -> Usage
Usage Set LocVar
forall a. Monoid a => a
mempty [VarUsage]
forall a. Monoid a => a
mempty

toErrPos :: Text -> VarUsage -> Maybe (J.Range, Text)
toErrPos :: Text -> VarUsage -> Maybe (Range, Text)
toErrPos Text
code (VarUsage (LV SrcLoc
loc Text
v) BindingType
scope) = do
  -- A leading underscore will suppress the unused variable warning
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text
"_" Text -> Text -> Bool
`T.isPrefixOf` Text
v
  (Int, Int)
rangePair <- case SrcLoc
loc of
    SrcLoc Int
s Int
e -> (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
s, Int
e)
    SrcLoc
_ -> Maybe (Int, Int)
forall a. Maybe a
Nothing
  let ((Int, Int)
start, (Int, Int)
end) = Text -> (Int, Int) -> ((Int, Int), (Int, Int))
P.getLocRange Text
code (Int, Int)
rangePair
      ((Int
startLine, Int
startCol), (Int
endLine, Int
endCol)) = ((Int, Int) -> (Int, Int)
forall {a} {b}. (Num a, Num b) => (a, b) -> (a, b)
minusOne (Int, Int)
start, (Int, Int) -> (Int, Int)
forall {a} {b}. (Num a, Num b) => (a, b) -> (a, b)
minusOne (Int, Int)
end)
      range :: Range
range =
        Position -> Position -> Range
J.Range
          (UInt -> UInt -> Position
J.Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
startLine) (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
startCol))
          (UInt -> UInt -> Position
J.Position (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
endLine) (Int -> UInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
endCol))
  (Range, Text) -> Maybe (Range, Text)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Range
range, Text
txt)
 where
  txt :: Text
txt =
    [Text] -> Text
T.unwords
      [ Text
"Unused variable"
      , Text -> Text
U.quote Text
v
      , Text
"in"
      , String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ BindingType -> String
forall a. Show a => a -> String
show BindingType
scope
      , Text
"expression"
      ]
  minusOne :: (a, b) -> (a, b)
minusOne (a
x, b
y) = (a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
1, b
y b -> b -> b
forall a. Num a => a -> a -> a
- b
1)

-- | Descends the syntax tree rooted at a variable declaration,
-- accumulating variable references.
-- Generates a "problem" if an associated variable reference
-- is not encountered in the subtree for this declaration.
checkOccurrences ::
  BindingSites ->
  LocVar ->
  BindingType ->
  [Syntax] ->
  Usage
checkOccurrences :: BindingSites -> LocVar -> BindingType -> [Syntax] -> Usage
checkOccurrences BindingSites
bindings lv :: LocVar
lv@(LV SrcLoc
loc Text
v) BindingType
declType [Syntax]
childSyntaxes =
  Set LocVar -> [VarUsage] -> Usage
Usage Set LocVar
childUsages ([VarUsage] -> Usage) -> [VarUsage] -> Usage
forall a b. (a -> b) -> a -> b
$ [VarUsage]
missing [VarUsage] -> [VarUsage] -> [VarUsage]
forall a. Semigroup a => a -> a -> a
<> [VarUsage]
deeperMissing
 where
  deeperBindings :: BindingSites
deeperBindings = (NonEmpty SrcLoc -> NonEmpty SrcLoc -> NonEmpty SrcLoc)
-> Text -> NonEmpty SrcLoc -> BindingSites -> BindingSites
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith NonEmpty SrcLoc -> NonEmpty SrcLoc -> NonEmpty SrcLoc
forall a. Semigroup a => a -> a -> a
(<>) Text
v (SrcLoc -> NonEmpty SrcLoc
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc) BindingSites
bindings
  Usage Set LocVar
childUsages [VarUsage]
deeperMissing = [Usage] -> Usage
forall a. Monoid a => [a] -> a
mconcat ([Usage] -> Usage) -> [Usage] -> Usage
forall a b. (a -> b) -> a -> b
$ (Syntax -> Usage) -> [Syntax] -> [Usage]
forall a b. (a -> b) -> [a] -> [b]
map (BindingSites -> Syntax -> Usage
getUsage BindingSites
deeperBindings) [Syntax]
childSyntaxes
  missing :: [VarUsage]
missing = [LocVar -> BindingType -> VarUsage
VarUsage LocVar
lv BindingType
declType | LocVar
lv LocVar -> Set LocVar -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set LocVar
childUsages]

-- | Build up the bindings map as a function argument as
-- we descend into the syntax tree.
-- Aggregates unused bindings as we return from each layer.
getUsage ::
  BindingSites ->
  Syntax ->
  Usage
getUsage :: BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings (CSyntax SrcLoc
_pos Term
t Comments
_comments) = case Term
t of
  TVar Text
v -> Set LocVar -> [VarUsage] -> Usage
Usage Set LocVar
myUsages [VarUsage]
forall a. Monoid a => a
mempty
   where
    myUsages :: Set LocVar
myUsages = case Text -> BindingSites -> Maybe (NonEmpty SrcLoc)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
v BindingSites
bindings of
      Maybe (NonEmpty SrcLoc)
Nothing -> Set LocVar
forall a. Monoid a => a
mempty
      Just (SrcLoc
loc :| [SrcLoc]
_) -> LocVar -> Set LocVar
forall a. a -> Set a
S.singleton (LocVar -> Set LocVar) -> LocVar -> Set LocVar
forall a b. (a -> b) -> a -> b
$ SrcLoc -> Text -> LocVar
LV SrcLoc
loc Text
v
  SLam LocVar
v Maybe Type
_ Syntax
s -> BindingSites -> LocVar -> BindingType -> [Syntax] -> Usage
checkOccurrences BindingSites
bindings LocVar
v BindingType
Lambda [Syntax
s]
  SApp Syntax
s1 Syntax
s2 -> BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings Syntax
s1 Usage -> Usage -> Usage
forall a. Semigroup a => a -> a -> a
<> BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings Syntax
s2
  -- Warn on unused 'let' bindings...
  SLet LetSyntax
LSLet Bool
_ LocVar
v Maybe Polytype
_ Maybe Requirements
_ Syntax
s1 Syntax
s2 -> BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings Syntax
s1 Usage -> Usage -> Usage
forall a. Semigroup a => a -> a -> a
<> BindingSites -> LocVar -> BindingType -> [Syntax] -> Usage
checkOccurrences BindingSites
bindings LocVar
v BindingType
Let [Syntax
s2]
  -- But don't warn on unused 'def' bindings, because they may be
  -- intended to be used at a later REPL input.
  SLet LetSyntax
LSDef Bool
_ LocVar
_ Maybe Polytype
_ Maybe Requirements
_ Syntax
s1 Syntax
s2 -> BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings Syntax
s1 Usage -> Usage -> Usage
forall a. Semigroup a => a -> a -> a
<> BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings Syntax
s2
  SPair Syntax
s1 Syntax
s2 -> BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings Syntax
s1 Usage -> Usage -> Usage
forall a. Semigroup a => a -> a -> a
<> BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings Syntax
s2
  SBind Maybe LocVar
maybeVar Maybe ()
_ Maybe Polytype
_ Maybe Requirements
_ Syntax
s1 Syntax
s2 -> case Maybe LocVar
maybeVar of
    Just LocVar
v -> BindingSites -> LocVar -> BindingType -> [Syntax] -> Usage
checkOccurrences BindingSites
bindings LocVar
v BindingType
Bind [Syntax
s1, Syntax
s2]
    Maybe LocVar
Nothing -> BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings Syntax
s1 Usage -> Usage -> Usage
forall a. Semigroup a => a -> a -> a
<> BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings Syntax
s2
  SDelay Syntax
s -> BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings Syntax
s
  Term
_ -> Usage
forall a. Monoid a => a
mempty