{-# LANGUAGE NamedFieldPuns #-}

module Dhall.LSP.Backend.Linting
  ( Suggestion(..)
  , suggest
  , Lint.lint
  )
where

import Control.Lens                  (universeOf)
import Data.Maybe                    (maybeToList)
import Data.Text                     (Text)
import Dhall.Core
    ( Binding (..)
    , Expr (..)
    , Import
    , MultiLet (..)
    )
import Dhall.LSP.Backend.Diagnostics
import Dhall.Parser                  (Src)

import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Maybe         as Maybe
import qualified Dhall.Core         as Core
import qualified Dhall.Lint         as Lint

data Suggestion = Suggestion {
    Suggestion -> Range
range :: Range,
    Suggestion -> Text
suggestion :: Text
    }

-- Diagnose nested let-blocks.
--
-- Pattern matching on a 'Let' wrapped in a 'Note' prevents us from repeating
-- the search beginning at different @let@s in the same let-block – only
-- the outermost 'Let' of a let-block is wrapped in a 'Note'.
diagLetInLet :: Expr Src a -> Maybe Suggestion
diagLetInLet :: Expr Src a -> Maybe Suggestion
diagLetInLet (Note Src
_ (Let Binding Src a
b Expr Src a
e)) = case Binding Src a -> Expr Src a -> MultiLet Src a
forall s a. Binding s a -> Expr s a -> MultiLet s a
Core.multiLet Binding Src a
b Expr Src a
e of
    MultiLet NonEmpty (Binding Src a)
_ (Note Src
src (Let {})) ->
      Suggestion -> Maybe Suggestion
forall a. a -> Maybe a
Just (Range -> Text -> Suggestion
Suggestion (Src -> Range
rangeFromDhall Src
src) Text
"Superfluous 'in' before nested let binding")
    MultiLet Src a
_ -> Maybe Suggestion
forall a. Maybe a
Nothing
diagLetInLet Expr Src a
_ = Maybe Suggestion
forall a. Maybe a
Nothing

-- Given a let-block compute all unused variables in the block.
unusedBindings :: Eq a => MultiLet s a -> [ (Text, Maybe s) ]
unusedBindings :: MultiLet s a -> [(Text, Maybe s)]
unusedBindings (MultiLet NonEmpty (Binding s a)
bindings Expr s a
d) =
  let go :: [Binding s a] -> [(Text, Maybe s)]
go bs :: [Binding s a]
bs@(Binding { variable :: forall s a. Binding s a -> Text
variable = Text
var, Expr s a
value :: forall s a. Binding s a -> Expr s a
value :: Expr s a
value } : [Binding s a]
_)
          | Just Expr s a
_ <- Expr s a -> Maybe (Expr s a)
forall a s. Eq a => Expr s a -> Maybe (Expr s a)
Lint.removeUnusedBindings ([Binding s a] -> Expr s a -> Expr s a
forall (f :: * -> *) s a.
Foldable f =>
f (Binding s a) -> Expr s a -> Expr s a
Core.wrapInLets [Binding s a]
bs Expr s a
d) =
              [ (Text
var, Maybe s
maybeSrc) ]
        where
          maybeSrc :: Maybe s
maybeSrc = case Expr s a
value of
              Note s
src Expr s a
_ -> s -> Maybe s
forall a. a -> Maybe a
Just s
src
              Expr s a
_          -> Maybe s
forall a. Maybe a
Nothing
      go [Binding s a]
_ = []
  in ([Binding s a] -> [(Text, Maybe s)])
-> NonEmpty [Binding s a] -> [(Text, Maybe s)]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap [Binding s a] -> [(Text, Maybe s)]
go (NonEmpty (Binding s a) -> NonEmpty [Binding s a]
forall (f :: * -> *) a. Foldable f => f a -> NonEmpty [a]
NonEmpty.tails NonEmpty (Binding s a)
bindings)

-- Diagnose unused let bindings.
diagUnusedBindings :: Eq a => Expr Src a -> [Suggestion]
diagUnusedBindings :: Expr Src a -> [Suggestion]
diagUnusedBindings (Note Src
src (Let Binding Src a
b Expr Src a
e)) =
    ((Text, Maybe Src) -> Suggestion)
-> [(Text, Maybe Src)] -> [Suggestion]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Maybe Src) -> Suggestion
adapt (MultiLet Src a -> [(Text, Maybe Src)]
forall a s. Eq a => MultiLet s a -> [(Text, Maybe s)]
unusedBindings (Binding Src a -> Expr Src a -> MultiLet Src a
forall s a. Binding s a -> Expr s a -> MultiLet s a
Core.multiLet Binding Src a
b Expr Src a
e))
  where
    adapt :: (Text, Maybe Src) -> Suggestion
adapt (Text
var, Maybe Src
maybeSrc) =
        Range -> Text -> Suggestion
Suggestion (Src -> Range
rangeFromDhall Src
finalSrc) (Text
"Unused let binding '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
var Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'")
      where
        finalSrc :: Src
finalSrc = Src -> Maybe Src -> Src
forall a. a -> Maybe a -> a
Maybe.fromMaybe Src
src Maybe Src
maybeSrc
diagUnusedBindings Expr Src a
_ = []

-- | Given an dhall expression suggest all the possible improvements that would
--   be made by the linter.
suggest :: Expr Src Import -> [Suggestion]
suggest :: Expr Src Import -> [Suggestion]
suggest Expr Src Import
expr = [[Suggestion]] -> [Suggestion]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ Maybe Suggestion -> [Suggestion]
forall a. Maybe a -> [a]
maybeToList (Expr Src Import -> Maybe Suggestion
forall a. Expr Src a -> Maybe Suggestion
diagLetInLet Expr Src Import
e) [Suggestion] -> [Suggestion] -> [Suggestion]
forall a. [a] -> [a] -> [a]
++ Expr Src Import -> [Suggestion]
forall a. Eq a => Expr Src a -> [Suggestion]
diagUnusedBindings Expr Src Import
e
                      | Expr Src Import
e <- Getting [Expr Src Import] (Expr Src Import) (Expr Src Import)
-> Expr Src Import -> [Expr Src Import]
forall a. Getting [a] a a -> a -> [a]
universeOf Getting [Expr Src Import] (Expr Src Import) (Expr Src Import)
forall (f :: * -> *) s a.
Applicative f =>
(Expr s a -> f (Expr s a)) -> Expr s a -> f (Expr s a)
Core.subExpressions Expr Src Import
expr ]