{-# LANGUAGE OverloadedStrings #-}

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.Types qualified as J
import Swarm.Language.Parse qualified as P
import Swarm.Language.Syntax
import Swarm.Util qualified as U

data BindingType
  = Lambda
  | Let
  | Bind
  deriving (BindingType -> BindingType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BindingType -> BindingType -> Bool
$c/= :: BindingType -> BindingType -> Bool
== :: BindingType -> BindingType -> Bool
$c== :: BindingType -> BindingType -> Bool
Eq, Int -> BindingType -> ShowS
[BindingType] -> ShowS
BindingType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BindingType] -> ShowS
$cshowList :: [BindingType] -> ShowS
show :: BindingType -> String
$cshow :: BindingType -> String
showsPrec :: Int -> BindingType -> ShowS
$cshowsPrec :: Int -> 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 forall a. Semigroup a => a -> a -> a
<> Set LocVar
y2)
      ([VarUsage]
z1 forall a. Semigroup a => a -> a -> a
<> [VarUsage]
z2)

instance Monoid Usage where
  mempty :: Usage
mempty = Set LocVar -> [VarUsage] -> Usage
Usage forall a. Monoid a => a
mempty 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
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not 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 -> forall a. a -> Maybe a
Just (Int
s, Int
e)
    SrcLoc
_ -> 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)) = (forall {a} {b}. (Num a, Num b) => (a, b) -> (a, b)
minusOne (Int, Int)
start, 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 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
startLine) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
startCol))
          (UInt -> UInt -> Position
J.Position (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
endLine) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
endCol))
  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 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show BindingType
scope
      , Text
"expression"
      ]
  minusOne :: (a, b) -> (a, b)
minusOne (a
x, b
y) = (a
x forall a. Num a => a -> a -> a
- a
1, b
y 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 forall a b. (a -> b) -> a -> b
$ [VarUsage]
missing forall a. Semigroup a => a -> a -> a
<> [VarUsage]
deeperMissing
 where
  deeperBindings :: BindingSites
deeperBindings = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith forall a. Semigroup a => a -> a -> a
(<>) Text
v (forall (f :: * -> *) a. Applicative f => a -> f a
pure SrcLoc
loc) BindingSites
bindings
  Usage Set LocVar
childUsages [VarUsage]
deeperMissing = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ 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 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 (Syntax SrcLoc
_pos Term
t) = case Term
t of
  TVar Text
v -> Set LocVar -> [VarUsage] -> Usage
Usage Set LocVar
myUsages forall a. Monoid a => a
mempty
   where
    myUsages :: Set LocVar
myUsages = case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Text
v BindingSites
bindings of
      Maybe (NonEmpty SrcLoc)
Nothing -> forall a. Monoid a => a
mempty
      Just (SrcLoc
loc :| [SrcLoc]
_) -> forall a. a -> Set a
S.singleton 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 forall a. Semigroup a => a -> a -> a
<> BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings Syntax
s2
  SLet Bool
_ LocVar
v Maybe Polytype
_ Syntax
s1 Syntax
s2 -> BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings Syntax
s1 forall a. Semigroup a => a -> a -> a
<> BindingSites -> LocVar -> BindingType -> [Syntax] -> Usage
checkOccurrences BindingSites
bindings LocVar
v BindingType
Let [Syntax
s2]
  SPair Syntax
s1 Syntax
s2 -> BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings Syntax
s1 forall a. Semigroup a => a -> a -> a
<> BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings Syntax
s2
  SDef Bool
_ LocVar
_v Maybe Polytype
_ Syntax
s -> BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings Syntax
s
  SBind Maybe LocVar
maybeVar 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 forall a. Semigroup a => a -> a -> a
<> BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings Syntax
s2
  SDelay DelayType
_ Syntax
s -> BindingSites -> Syntax -> Usage
getUsage BindingSites
bindings Syntax
s
  Term
_ -> forall a. Monoid a => a
mempty