{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE QuasiQuotes #-}

module Unison.LSP.CodeAction where

import Control.Lens hiding (List)
import Data.IntervalMap qualified as IM
import Language.LSP.Protocol.Lens
import Language.LSP.Protocol.Message qualified as Msg
import Language.LSP.Protocol.Types
import Unison.Debug qualified as Debug
import Unison.LSP.Conversions
import Unison.LSP.FileAnalysis
import Unison.LSP.Types
import Unison.Prelude

-- | Computes code actions for a document.
codeActionHandler :: Msg.TRequestMessage 'Msg.Method_TextDocumentCodeAction -> (Either Msg.ResponseError (Msg.MessageResult 'Msg.Method_TextDocumentCodeAction) -> Lsp ()) -> Lsp ()
codeActionHandler :: TRequestMessage 'Method_TextDocumentCodeAction
-> (Either
      ResponseError (MessageResult 'Method_TextDocumentCodeAction)
    -> Lsp ())
-> Lsp ()
codeActionHandler TRequestMessage 'Method_TextDocumentCodeAction
m Either ResponseError (MessageResult 'Method_TextDocumentCodeAction)
-> Lsp ()
respond =
  Either ResponseError ([Command |? CodeAction] |? Null) -> Lsp ()
Either ResponseError (MessageResult 'Method_TextDocumentCodeAction)
-> Lsp ()
respond (Either ResponseError ([Command |? CodeAction] |? Null) -> Lsp ())
-> (Maybe [CodeAction]
    -> Either ResponseError ([Command |? CodeAction] |? Null))
-> Maybe [CodeAction]
-> Lsp ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ResponseError ([Command |? CodeAction] |? Null)
-> ([CodeAction]
    -> Either ResponseError ([Command |? CodeAction] |? Null))
-> Maybe [CodeAction]
-> Either ResponseError ([Command |? CodeAction] |? Null)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (([Command |? CodeAction] |? Null)
-> Either ResponseError ([Command |? CodeAction] |? Null)
forall a b. b -> Either a b
Right (([Command |? CodeAction] |? Null)
 -> Either ResponseError ([Command |? CodeAction] |? Null))
-> ([Command |? CodeAction] |? Null)
-> Either ResponseError ([Command |? CodeAction] |? Null)
forall a b. (a -> b) -> a -> b
$ [Command |? CodeAction] -> [Command |? CodeAction] |? Null
forall a b. a -> a |? b
InL [Command |? CodeAction]
forall a. Monoid a => a
mempty) (([Command |? CodeAction] |? Null)
-> Either ResponseError ([Command |? CodeAction] |? Null)
forall a b. b -> Either a b
Right (([Command |? CodeAction] |? Null)
 -> Either ResponseError ([Command |? CodeAction] |? Null))
-> ([CodeAction] -> [Command |? CodeAction] |? Null)
-> [CodeAction]
-> Either ResponseError ([Command |? CodeAction] |? Null)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Command |? CodeAction] -> [Command |? CodeAction] |? Null
forall a b. a -> a |? b
InL ([Command |? CodeAction] -> [Command |? CodeAction] |? Null)
-> ([CodeAction] -> [Command |? CodeAction])
-> [CodeAction]
-> [Command |? CodeAction] |? Null
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CodeAction -> Command |? CodeAction)
-> [CodeAction] -> [Command |? CodeAction]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CodeAction -> Command |? CodeAction
forall a b. b -> a |? b
InR) (Maybe [CodeAction] -> Lsp ())
-> Lsp (Maybe [CodeAction]) -> Lsp ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MaybeT Lsp [CodeAction] -> Lsp (Maybe [CodeAction])
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT do
    FileAnalysis {IntervalMap Position [CodeAction]
codeActions :: IntervalMap Position [CodeAction]
$sel:codeActions:FileAnalysis :: FileAnalysis -> IntervalMap Position [CodeAction]
codeActions} <- Uri -> MaybeT Lsp FileAnalysis
getFileAnalysis (TRequestMessage 'Method_TextDocumentCodeAction
m TRequestMessage 'Method_TextDocumentCodeAction
-> Getting Uri (TRequestMessage 'Method_TextDocumentCodeAction) Uri
-> Uri
forall s a. s -> Getting a s a -> a
^. (CodeActionParams -> Const Uri CodeActionParams)
-> TRequestMessage 'Method_TextDocumentCodeAction
-> Const Uri (TRequestMessage 'Method_TextDocumentCodeAction)
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_TextDocumentCodeAction) CodeActionParams
params ((CodeActionParams -> Const Uri CodeActionParams)
 -> TRequestMessage 'Method_TextDocumentCodeAction
 -> Const Uri (TRequestMessage 'Method_TextDocumentCodeAction))
-> ((Uri -> Const Uri Uri)
    -> CodeActionParams -> Const Uri CodeActionParams)
-> Getting Uri (TRequestMessage 'Method_TextDocumentCodeAction) Uri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> CodeActionParams -> Const Uri CodeActionParams
forall s a. HasTextDocument s a => Lens' s a
Lens' CodeActionParams TextDocumentIdentifier
textDocument ((TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
 -> CodeActionParams -> Const Uri CodeActionParams)
-> ((Uri -> Const Uri Uri)
    -> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier)
-> (Uri -> Const Uri Uri)
-> CodeActionParams
-> Const Uri CodeActionParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Uri -> Const Uri Uri)
-> TextDocumentIdentifier -> Const Uri TextDocumentIdentifier
forall s a. HasUri s a => Lens' s a
Lens' TextDocumentIdentifier Uri
uri)
    let r :: Range
r = TRequestMessage 'Method_TextDocumentCodeAction
m TRequestMessage 'Method_TextDocumentCodeAction
-> Getting
     Range (TRequestMessage 'Method_TextDocumentCodeAction) Range
-> Range
forall s a. s -> Getting a s a -> a
^. (CodeActionParams -> Const Range CodeActionParams)
-> TRequestMessage 'Method_TextDocumentCodeAction
-> Const Range (TRequestMessage 'Method_TextDocumentCodeAction)
forall s a. HasParams s a => Lens' s a
Lens'
  (TRequestMessage 'Method_TextDocumentCodeAction) CodeActionParams
params ((CodeActionParams -> Const Range CodeActionParams)
 -> TRequestMessage 'Method_TextDocumentCodeAction
 -> Const Range (TRequestMessage 'Method_TextDocumentCodeAction))
-> ((Range -> Const Range Range)
    -> CodeActionParams -> Const Range CodeActionParams)
-> Getting
     Range (TRequestMessage 'Method_TextDocumentCodeAction) Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Range -> Const Range Range)
-> CodeActionParams -> Const Range CodeActionParams
forall s a. HasRange s a => Lens' s a
Lens' CodeActionParams Range
range
    let relevantActions :: IntervalMap Position [CodeAction]
relevantActions = IntervalMap Position [CodeAction]
-> Interval Position -> IntervalMap Position [CodeAction]
forall k e v.
Interval k e =>
IntervalMap k v -> k -> IntervalMap k v
IM.intersecting IntervalMap Position [CodeAction]
codeActions (Range -> Interval Position
rangeToInterval Range
r)
    DebugFlag
-> String -> IntervalMap Position [CodeAction] -> MaybeT Lsp ()
forall a (m :: * -> *).
(Show a, Monad m) =>
DebugFlag -> String -> a -> m ()
Debug.debugM DebugFlag
Debug.LSP String
"All CodeActions" (IntervalMap Position [CodeAction]
codeActions)
    DebugFlag
-> String
-> (Range, IntervalMap Position [CodeAction])
-> MaybeT Lsp ()
forall a (m :: * -> *).
(Show a, Monad m) =>
DebugFlag -> String -> a -> m ()
Debug.debugM DebugFlag
Debug.LSP String
"Relevant actions" (Range
r, IntervalMap Position [CodeAction]
relevantActions)
    pure $ IntervalMap Position [CodeAction] -> [CodeAction]
forall m. Monoid m => IntervalMap (Interval Position) m -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold IntervalMap Position [CodeAction]
relevantActions