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

module Unison.LSP.CancelRequest where

import Control.Lens
import Control.Monad.Reader
import Data.Map qualified as Map
import Language.LSP.Protocol.Lens as LSP
import Language.LSP.Protocol.Message qualified as Msg
import Language.LSP.Protocol.Types
import Unison.LSP.Types
import UnliftIO.STM

-- | Allows a client to cancel work from a previous request.
cancelRequestHandler :: Msg.TNotificationMessage 'Msg.Method_CancelRequest -> Lsp ()
cancelRequestHandler :: forall {f :: MessageDirection}.
TNotificationMessage 'Method_CancelRequest -> Lsp ()
cancelRequestHandler TNotificationMessage 'Method_CancelRequest
m = do
  Map (Int32 |? Text) (IO ())
cancelMap <- (Env -> TVar (Map (Int32 |? Text) (IO ())))
-> Lsp (TVar (Map (Int32 |? Text) (IO ())))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env -> TVar (Map (Int32 |? Text) (IO ()))
cancellationMapVar Lsp (TVar (Map (Int32 |? Text) (IO ())))
-> (TVar (Map (Int32 |? Text) (IO ()))
    -> Lsp (Map (Int32 |? Text) (IO ())))
-> Lsp (Map (Int32 |? Text) (IO ()))
forall a b. Lsp a -> (a -> Lsp b) -> Lsp b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TVar (Map (Int32 |? Text) (IO ()))
-> Lsp (Map (Int32 |? Text) (IO ()))
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO
  let reqId' :: Int32 |? Text
reqId' = case TNotificationMessage 'Method_CancelRequest
m TNotificationMessage 'Method_CancelRequest
-> Getting
     CancelParams
     (TNotificationMessage 'Method_CancelRequest)
     CancelParams
-> CancelParams
forall s a. s -> Getting a s a -> a
^. Getting
  CancelParams
  (TNotificationMessage 'Method_CancelRequest)
  CancelParams
forall s a. HasParams s a => Lens' s a
Lens' (TNotificationMessage 'Method_CancelRequest) CancelParams
params of
        CancelParams Int32 |? Text
id' -> Int32 |? Text
id'
  case (Int32 |? Text) -> Map (Int32 |? Text) (IO ()) -> Maybe (IO ())
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int32 |? Text
reqId' Map (Int32 |? Text) (IO ())
cancelMap of
    Just IO ()
cancel -> IO () -> Lsp ()
forall a. IO a -> Lsp a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
cancel
    Maybe (IO ())
Nothing -> () -> Lsp ()
forall a. a -> Lsp a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()