content: {-# LANGUAGE BlockArguments #-}
  {-# LANGUAGE CPP            #-}
  {-# LANGUAGE DataKinds      #-}
  {-# LANGUAGE MultiWayIf     #-}
  {-# LANGUAGE NamedFieldPuns #-}
  {-# LANGUAGE TypeOperators  #-}
  {-# LANGUAGE ViewPatterns   #-}
  
  module Dhall.LSP.Handlers where
  
  import Data.Void    (Void)
  import Dhall        (EvaluateSettings)
  import Dhall.Core
      ( Expr (Embed, Note)
      , Import (..)
      , ImportHashed (..)
      , ImportType (..)
      , headers
      , pretty
      )
  import Dhall.Import (localToPath)
  import Dhall.Parser (Src (..))
  
  import Dhall.LSP.Backend.Completion
      ( Completion (..)
      , buildCompletionContext
      , completeEnvironmentImport
      , completeFromContext
      , completeLocalImport
      , completeProjections
      , completionQueryAt
      )
  import Dhall.LSP.Backend.Dhall
      ( FileIdentifier
      , fileIdentifierFromFilePath
      , fileIdentifierFromURI
      , invalidate
      , load
      , parse
      , parseWithHeader
      , typecheck
      )
  import Dhall.LSP.Backend.Diagnostics
      ( Diagnosis (..)
      , Range (..)
      , diagnose
      , embedsWithRanges
      , explain
      , rangeFromDhall
      )
  import Dhall.LSP.Backend.Formatting  (formatExpr, formatExprWithHeader)
  import Dhall.LSP.Backend.Freezing
      ( computeSemanticHash
      , getAllImportsWithHashPositions
      , getImportHashPosition
      , stripHash
      )
  import Dhall.LSP.Backend.Linting     (Suggestion (..), lint, suggest)
  import Dhall.LSP.Backend.Parsing     (binderExprFromText)
  import Dhall.LSP.Backend.Typing      (annotateLet, exprAt, typeAt)
  import Dhall.LSP.State
  
  import Control.Applicative           ((<|>))
  import Control.Lens                  (assign, modifying, use, (^.))
  import Control.Monad                 (forM, guard)
  import Control.Monad.Trans           (lift, liftIO)
  import Control.Monad.Trans.Except    (catchE, throwE)
  import Data.Aeson                    (FromJSON (..), Value (..))
  import Data.Maybe                    (maybeToList)
  import Data.Text                     (Text, isPrefixOf)
  import Language.LSP.Protocol.Lens
      ( arguments
      , character
      , command
      , line
      , params
      , position
      , textDocument
      , uri
      )
  import Language.LSP.Protocol.Message
      ( Method (..)
      , SMethod (..)
      , TRequestMessage
      )
  import Language.LSP.Protocol.Types   hiding (Range (..))
  import Language.LSP.Server           (Handlers, LspT)
  import System.FilePath               (takeDirectory, (</>))
  import Text.Megaparsec               (SourcePos (..), unPos)
  
  import qualified Data.Aeson                  as Aeson
  import qualified Data.Map.Strict             as Map
  import qualified Data.Text                   as Text
  import qualified Language.LSP.Protocol.Types as LSP.Types
  import qualified Language.LSP.Server         as LSP
  import qualified Language.LSP.VFS            as LSP
  import qualified Network.URI                 as URI
  import qualified Network.URI.Encode          as URI
  
  #if MIN_VERSION_lsp(2,4,0)
  import qualified Data.Text.Utf16.Rope.Mixed as Rope
  #else
  import qualified Data.Text.Utf16.Rope as Rope
  #endif
  
  liftLSP :: LspT ServerConfig IO a -> HandlerM a
  liftLSP m = lift (lift m)
  
  -- | A helper function to query haskell-lsp's VFS.
  readUri :: Uri -> HandlerM Text
  readUri uri_ = do
    mVirtualFile <- liftLSP (LSP.getVirtualFile (LSP.Types.toNormalizedUri uri_))
    case mVirtualFile of
      Just (LSP.VirtualFile _ _ rope) -> return (Rope.toText rope)
      Nothing -> throwE (Error, "Could not find " <> Text.pack (show uri_) <> " in VFS.")
  
  loadFile :: EvaluateSettings -> Uri -> HandlerM (Expr Src Void)
  loadFile settings uri_ = do
    txt <- readUri uri_
    fileIdentifier <- fileIdentifierFromUri uri_
    cache <- use importCache
  
    expr <- case parse txt of
      Right e -> return e
      _ -> throwE (Error, "Failed to parse Dhall file.")
  
    loaded <- liftIO $ load settings fileIdentifier expr cache
    (cache', expr') <- case loaded of
      Right x -> return x
      _ -> throwE (Error, "Failed to resolve imports.")
    -- Update cache. Don't cache current expression because it might not have been
    -- written to disk yet (readUri reads from the VFS).
    assign importCache cache'
    return expr'
  
  -- helper
  fileIdentifierFromUri :: Uri -> HandlerM FileIdentifier
  fileIdentifierFromUri uri_ =
    let mFileIdentifier = fmap fileIdentifierFromFilePath (uriToFilePath uri_)
                          <|> (do uri' <- (URI.parseURI . Text.unpack . getUri) uri_
                                  fileIdentifierFromURI uri')
    in case mFileIdentifier of
      Just fileIdentifier -> return fileIdentifier
      Nothing -> throwE (Error, getUri uri_ <> " is not a valid name for a dhall file.")
  
  -- helper
  rangeToJSON :: Range -> LSP.Types.Range
  rangeToJSON (Range (x1,y1) (x2,y2)) =
      LSP.Types.Range
        (Position (fromIntegral x1) (fromIntegral y1))
        (Position (fromIntegral x2) (fromIntegral y2))
  
  hoverHandler :: EvaluateSettings -> Handlers HandlerM
  hoverHandler settings =
      LSP.requestHandler SMethod_TextDocumentHover \request respond -> handleErrorWithDefault respond (InR LSP.Types.Null) do
          let uri_ = request^.params.textDocument.uri
  
          let Position{ _line = fromIntegral -> _line, _character = fromIntegral -> _character } = request^.params.position
  
          errorMap <- use errors
  
          case Map.lookup uri_ errorMap of
              Nothing -> do
                  expr <- loadFile settings uri_
                  (welltyped, _) <- case typecheck settings expr of
                      Left  _  -> throwE (Info, "Can't infer type; code does not type-check.")
                      Right wt -> return wt
                  case typeAt (_line, _character) welltyped of
                      Left err -> throwE (Error, Text.pack err)
                      Right (mSrc, typ) -> do
                          let _range = fmap (rangeToJSON . rangeFromDhall) mSrc
  
                          let _contents = InL (mkPlainText (pretty typ))
                          respond (Right (InL Hover{ _contents, _range }))
              Just err -> do
                  let isHovered (Diagnosis _ (Just (Range left right)) _) =
                          left <= (_line, _character) && (_line, _character) <= right
                      isHovered _ =
                          False
  
                  let hoverFromDiagnosis (Diagnosis _ (Just (Range left right)) diagnosis) = do
                          let _range = Just (rangeToJSON (Range left right))
                              encodedDiag = URI.encode (Text.unpack diagnosis)
  
                              _kind = MarkupKind_Markdown
  
                              _value =
                                      "[Explain error](dhall-explain:?"
                                  <>  Text.pack encodedDiag
                                  <>  " )"
  
                              _contents = InL MarkupContent{..}
                          Just Hover{ _contents, _range }
                      hoverFromDiagnosis _ =
                          Nothing
  
                  let mHover = do
                          explanation <- explain err
  
                          guard (isHovered explanation)
  
                          hoverFromDiagnosis explanation
  
                  respond (Right (maybeToNull mHover))
  
  documentLinkHandler :: Handlers HandlerM
  documentLinkHandler =
      LSP.requestHandler SMethod_TextDocumentDocumentLink \request respond -> handleErrorWithDefault respond (InL []) do
          let uri_ = request^.params.textDocument.uri
  
          path <- case uriToFilePath uri_ of
              Nothing ->
                  throwE (Log, "Could not process document links; failed to convert URI to file path.")
              Just p ->
                  return p
  
          txt <- readUri uri_
  
          expr <- case parse txt of
              Right e ->
                  return e
              Left _ ->
                  throwE (Log, "Could not process document links; did not parse.")
  
          let imports = embedsWithRanges expr :: [(Range, Import)]
  
          let basePath = takeDirectory path
  
          let go :: (Range, Import) -> IO [DocumentLink]
              go (range_, Import (ImportHashed _ (Local prefix file)) _) = do
                filePath <- localToPath prefix file
                let filePath' = basePath </> filePath  -- absolute file path
                let _range = rangeToJSON range_
  #if MIN_VERSION_lsp(2,5,0)
                let _target = Just (filePathToUri filePath')
  #else
                let _target = Just (getUri (filePathToUri filePath'))
  #endif
                let _tooltip = Nothing
                let _data_ = Nothing
                return [DocumentLink {..}]
  
              go (range_, Import (ImportHashed _ (Remote url)) _) = do
                let _range = rangeToJSON range_
                let url' = url { headers = Nothing }
  #if MIN_VERSION_lsp(2,5,0)
                let _target = Just (Uri (pretty url'))
  #else
                let _target = Just (pretty url')
  #endif
                let _tooltip = Nothing
                let _data_ = Nothing
                return [DocumentLink {..}]
  
              go _ = return []
  
          links <- liftIO $ mapM go imports
          respond (Right (InL (concat links)))
  
  
  diagnosticsHandler :: EvaluateSettings -> Uri -> HandlerM ()
  diagnosticsHandler settings _uri = do
    txt <- readUri _uri
    fileIdentifier <- fileIdentifierFromUri _uri
    -- make sure we don't keep a stale version around
    modifying importCache (invalidate fileIdentifier)
    cache <- use importCache
  
    errs <- flip catchE (return . Just) $ do
        expr <- case parse txt of
          Right e -> return e
          Left err -> throwE err
        loaded <- liftIO $ load settings fileIdentifier expr cache
        (cache', expr') <- case loaded of
          Right x -> return x
          Left err -> throwE err
        _ <- case typecheck settings expr' of
          Right (wt, _typ) -> return wt
          Left err -> throwE err
        assign importCache cache'
        return Nothing
  
    let suggestions =
          case parse txt of
            Right expr -> suggest expr
            _ -> []
  
        suggestionToDiagnostic Suggestion { range = range_, .. } =
          let _range = rangeToJSON range_
              _severity = Just DiagnosticSeverity_Hint
              _source = Just "Dhall.Lint"
              _code = Nothing
              _codeDescription = Nothing
              _message = suggestion
              _tags = Nothing
              _relatedInformation = Nothing
              _data_ = Nothing
          in Diagnostic {..}
  
        diagnosisToDiagnostic Diagnosis { range = range_, .. } =
          let _range = case range_ of
                Just range' -> rangeToJSON range'
                Nothing     -> LSP.Types.Range (Position 0 0) (Position 0 0)
              _severity = Just DiagnosticSeverity_Error
              _source = Just doctor
              _code = Nothing
              _codeDescription = Nothing
              _tags = Nothing
              _message = diagnosis
              _relatedInformation = Nothing
              _data_ = Nothing
          in Diagnostic {..}
  
    modifying errors (Map.alter (const errs) _uri)  -- cache errors
  
    let _version = Nothing
    let _diagnostics =
                (   concatMap (map diagnosisToDiagnostic . diagnose) (maybeToList errs)
                ++  map suggestionToDiagnostic suggestions
                )
  
  
    liftLSP (LSP.sendNotification SMethod_TextDocumentPublishDiagnostics PublishDiagnosticsParams{ _uri, _version, _diagnostics })
  
  documentFormattingHandler :: Handlers HandlerM
  documentFormattingHandler =
      LSP.requestHandler SMethod_TextDocumentFormatting \request respond -> handleErrorWithDefault respond (InL []) do
          let _uri = request^.params.textDocument.uri
  
          txt <- readUri _uri
  
          (header, expr) <- case parseWithHeader txt of
            Right res -> return res
            _ -> throwE (Warning, "Failed to format dhall code; parse error.")
  
          ServerConfig{..} <- liftLSP LSP.getConfig
  
          let numLines = fromIntegral (Text.length txt)
          let _newText= formatExprWithHeader chosenCharacterSet expr header
          let _range = LSP.Types.Range (Position 0 0) (Position numLines 0)
  
          respond (Right (InL [TextEdit{..}]))
  
  
  executeCommandHandler :: EvaluateSettings -> Handlers HandlerM
  executeCommandHandler settings =
      LSP.requestHandler SMethod_WorkspaceExecuteCommand \request respond -> handleErrorWithDefault respond (InL Aeson.Null) do
          let command_ = request^.params.command
          if  | command_ == "dhall.server.lint" ->
                  executeLintAndFormat request respond
              | command_ == "dhall.server.annotateLet" ->
                  executeAnnotateLet settings request
              | command_ == "dhall.server.freezeImport" ->
                  executeFreezeImport settings request
              | command_ == "dhall.server.freezeAllImports" ->
                  executeFreezeAllImports settings request
              | otherwise -> do
                  throwE
                      ( Warning
                      , "Command '" <> command_ <> "' not known; ignored."
                      )
  
  getCommandArguments
      :: FromJSON a => TRequestMessage 'Method_WorkspaceExecuteCommand -> HandlerM a
  -- (HasParams s a, FromJSON a) => s -> HandlerM a
  getCommandArguments request = do
    json <- case request ^. params . arguments of
      Just (x : _) -> return x
      _ -> throwE (Error, "Failed to execute command; arguments missing.")
    case Aeson.fromJSON json of
      Aeson.Success args ->
          return args
      _ ->
          throwE (Error, "Failed to execute command; failed to parse arguments.")
  
  -- implements dhall.server.lint
  executeLintAndFormat
      :: TRequestMessage 'Method_WorkspaceExecuteCommand
      -> (Either a (Value |? Null) -> HandlerM b)
      -> HandlerM ()
  executeLintAndFormat request respond = do
    uri_ <- getCommandArguments request
    txt <- readUri uri_
  
    (header, expr) <- case parseWithHeader txt of
      Right res -> return res
      _ -> throwE (Warning, "Failed to lint dhall code; parse error.")
  
    ServerConfig{..} <- liftLSP LSP.getConfig
  
    let numLines = fromIntegral (Text.length txt)
  
    let _newText = formatExprWithHeader chosenCharacterSet (lint expr) header
  
    let _range = LSP.Types.Range (Position 0 0) (Position numLines 0)
  
    let _edit =
            WorkspaceEdit
                { _changes = Just (Map.singleton uri_ [TextEdit{..}])
                , _documentChanges = Nothing
                , _changeAnnotations = Nothing
                }
  
    let _label = Nothing
  
    _ <- respond (Right (InL Aeson.Null))
  
    _ <- liftLSP (LSP.sendRequest SMethod_WorkspaceApplyEdit ApplyWorkspaceEditParams{ _label, _edit } nullHandler)
  
    return ()
  
  executeAnnotateLet
      :: EvaluateSettings
      -> TRequestMessage 'Method_WorkspaceExecuteCommand
      -> HandlerM ()
  executeAnnotateLet settings request = do
    args <- getCommandArguments request :: HandlerM TextDocumentPositionParams
    let uri_ = args ^. textDocument . uri
        line_ = fromIntegral (args ^. position . line)
        col_ = fromIntegral (args ^. position . character)
  
    expr <- loadFile settings uri_
    (welltyped, _) <- case typecheck settings expr of
      Left _ -> throwE (Warning, "Failed to annotate let binding; not well-typed.")
      Right e -> return e
  
    ServerConfig{..} <- liftLSP LSP.getConfig
  
    (Src (SourcePos _ x1 y1) (SourcePos _ x2 y2) _, annotExpr)
      <- case annotateLet (line_, col_) welltyped of
        Right x -> return x
        Left msg -> throwE (Warning, Text.pack msg)
  
    let _range = LSP.Types.Range (Position (fromIntegral (unPos x1 - 1)) (fromIntegral (unPos y1 - 1)))
                        (Position (fromIntegral (unPos x2 - 1)) (fromIntegral (unPos y2 - 1)))
  
    let _newText= formatExpr chosenCharacterSet annotExpr
  
    let _edit = WorkspaceEdit
            { _changes = Just (Map.singleton uri_ [TextEdit{..}])
            , _documentChanges = Nothing
            , _changeAnnotations = Nothing
            }
  
    let _label = Nothing
  
    _ <- liftLSP (LSP.sendRequest SMethod_WorkspaceApplyEdit ApplyWorkspaceEditParams{ _label, _edit } nullHandler)
  
    return ()
  
  executeFreezeAllImports
      :: EvaluateSettings
      -> TRequestMessage 'Method_WorkspaceExecuteCommand
      -> HandlerM ()
  executeFreezeAllImports settings request = do
    uri_ <- getCommandArguments request
  
    fileIdentifier <- fileIdentifierFromUri uri_
    txt <- readUri uri_
    expr <- case parse txt of
      Right e -> return e
      Left _ -> throwE (Warning, "Could not freeze imports; did not parse.")
  
    let importRanges = getAllImportsWithHashPositions expr
    edits_ <- forM importRanges $ \(import_, Range (x1, y1) (x2, y2)) -> do
      cache <- use importCache
      let importExpr = Embed (stripHash import_)
  
      hashResult <- liftIO $ computeSemanticHash settings fileIdentifier importExpr cache
      (cache', hash) <- case hashResult of
        Right (c, t) -> return (c, t)
        Left _ -> throwE (Error, "Could not freeze import; failed to evaluate import.")
      assign importCache cache'
  
      let _range = LSP.Types.Range (Position (fromIntegral x1) (fromIntegral y1)) (Position (fromIntegral x2) (fromIntegral y2))
      let _newText = " " <> hash
      return TextEdit{..}
  
    let _edit = WorkspaceEdit
            { _changes = Just (Map.singleton uri_ edits_)
            , _documentChanges = Nothing
            , _changeAnnotations = Nothing
            }
  
    let _label = Nothing
  
    _ <- liftLSP (LSP.sendRequest SMethod_WorkspaceApplyEdit ApplyWorkspaceEditParams{ _edit, _label } nullHandler)
  
    return ()
  
  executeFreezeImport
      :: EvaluateSettings
      -> TRequestMessage 'Method_WorkspaceExecuteCommand
      -> HandlerM ()
  executeFreezeImport settings request = do
    args <- getCommandArguments request :: HandlerM TextDocumentPositionParams
    let uri_  = args ^. textDocument . uri
    let line_ = fromIntegral (args ^. position . line)
    let col_  = fromIntegral (args ^. position . character)
  
    txt <- readUri uri_
    expr <- case parse txt of
      Right e -> return e
      Left _ -> throwE (Warning, "Could not freeze import; did not parse.")
  
    (src, import_)
      <- case exprAt (line_, col_) expr of
        Just (Note src (Embed i)) -> return (src, i)
        _ -> throwE (Warning, "You weren't pointing at an import!")
  
    Range (x1, y1) (x2, y2) <- case getImportHashPosition src of
        Just range_ -> return range_
        Nothing -> throwE (Error, "Failed to re-parse import!")
  
    fileIdentifier <- fileIdentifierFromUri uri_
    cache <- use importCache
    let importExpr = Embed (stripHash import_)
  
    hashResult <- liftIO $ computeSemanticHash settings fileIdentifier importExpr cache
    (cache', hash) <- case hashResult of
      Right (c, t) -> return (c, t)
      Left _ -> throwE (Error, "Could not freeze import; failed to evaluate import.")
    assign importCache cache'
  
    let _range = LSP.Types.Range (Position (fromIntegral x1) (fromIntegral y1)) (Position (fromIntegral x2) (fromIntegral y2))
    let _newText = " " <> hash
  
    let _edit = WorkspaceEdit
            { _changes = Just (Map.singleton uri_ [TextEdit{..}])
            , _documentChanges = Nothing
            , _changeAnnotations = Nothing
            }
  
    let _label = Nothing
  
    _ <- liftLSP (LSP.sendRequest SMethod_WorkspaceApplyEdit ApplyWorkspaceEditParams{ _edit, _label } nullHandler)
  
    return ()
  
  completionHandler :: EvaluateSettings -> Handlers HandlerM
  completionHandler settings =
    LSP.requestHandler SMethod_TextDocumentCompletion \request respond -> handleErrorWithDefault respond (InR (InL (CompletionList False Nothing []))) do
      let uri_  = request ^. params . textDocument . uri
          line_ = fromIntegral (request ^. params . position . line)
          col_  = fromIntegral (request ^. params . position . character)
  
      txt <- readUri uri_
      let (completionLeadup, completionPrefix) = completionQueryAt txt (line_, col_)
  
      let computeCompletions
            -- environment variable
            | "env:" `isPrefixOf` completionPrefix =
              liftIO completeEnvironmentImport
  
            -- local import
            | any (`isPrefixOf` completionPrefix) [ "/", "./", "../", "~/" ] = do
              let relativeTo | Just path <- uriToFilePath uri_ = path
                           | otherwise = "."
              liftIO $ completeLocalImport relativeTo (Text.unpack completionPrefix)
  
            -- record projection / union constructor
            | (target_, _) <- Text.breakOnEnd "." completionPrefix
            , not (Text.null target_) = do
              let bindersExpr = binderExprFromText completionLeadup
  
              fileIdentifier <- fileIdentifierFromUri uri_
              cache <- use importCache
              loadedBinders <- liftIO $ load settings fileIdentifier bindersExpr cache
  
              (cache', bindersExpr') <-
                case loadedBinders of
                  Right (cache', binders) ->
                    return (cache', binders)
                  Left _ -> throwE (Log, "Could not complete projection; failed to load binders expression.")
  
              let completionContext = buildCompletionContext bindersExpr'
  
              targetExpr <- case parse (Text.dropEnd 1 target_) of
                Right e -> return e
                Left _ -> throwE (Log, "Could not complete projection; prefix did not parse.")
  
              loaded' <- liftIO $ load settings fileIdentifier targetExpr cache'
              case loaded' of
                Right (cache'', targetExpr') -> do
                  assign importCache cache''
                  return (completeProjections completionContext targetExpr')
                Left _ -> return []
  
            -- complete identifiers in scope
            | otherwise = do
              let bindersExpr = binderExprFromText completionLeadup
  
              fileIdentifier <- fileIdentifierFromUri uri_
              cache <- use importCache  -- todo save cache afterwards
              loadedBinders <- liftIO $ load settings fileIdentifier bindersExpr cache
  
              bindersExpr' <-
                case loadedBinders of
                  Right (cache', binders) -> do
                    assign importCache cache'
                    return binders
                  Left _ -> throwE (Log, "Could not complete projection; failed to load binders expression.")
  
              let context_ = buildCompletionContext bindersExpr'
  
              return (completeFromContext context_)
  
      completions <- computeCompletions
  
      let toCompletionItem (Completion {..}) = CompletionItem {..}
           where
            _label = completeText
            _labelDetails = Nothing
            _kind = Nothing
            _tags = mempty
            _detail = fmap pretty completeType
            _documentation = Nothing
            _deprecated = Nothing
            _preselect = Nothing
            _sortText = Nothing
            _filterText = Nothing
            _insertText = Nothing
            _insertTextFormat = Nothing
            _insertTextMode = Nothing
            _textEdit = Nothing
            _textEditText = Nothing
            _additionalTextEdits = Nothing
            _commitCharacters = Nothing
            _command = Nothing
            _data_ = Nothing
  
      let _items = (map toCompletionItem completions)
      let _itemDefaults = Nothing
      let _isIncomplete = False
  
      respond (Right (InR (InL CompletionList{..})))
  
  nullHandler :: a -> LspT ServerConfig IO ()
  nullHandler _ = return ()
  
  didOpenTextDocumentNotificationHandler :: EvaluateSettings -> Handlers HandlerM
  didOpenTextDocumentNotificationHandler settings =
      LSP.notificationHandler SMethod_TextDocumentDidOpen \notification -> do
          let _uri = notification^.params.textDocument.uri
          diagnosticsHandler settings _uri
  
  didSaveTextDocumentNotificationHandler :: EvaluateSettings -> Handlers HandlerM
  didSaveTextDocumentNotificationHandler settings =
      LSP.notificationHandler SMethod_TextDocumentDidSave \notification -> do
          let _uri = notification^.params.textDocument.uri
          diagnosticsHandler settings _uri
  
  
  -- this handler is a stab to prevent `lsp:no handler for:` messages.
  initializedHandler :: Handlers HandlerM
  initializedHandler =
      LSP.notificationHandler SMethod_Initialized \_ -> return ()
  
  -- this handler is a stab to prevent `lsp:no handler for:` messages.
  workspaceChangeConfigurationHandler :: Handlers HandlerM
  workspaceChangeConfigurationHandler =
      LSP.notificationHandler SMethod_WorkspaceDidChangeConfiguration \_ -> return ()
  
  -- this handler is a stab to prevent `lsp:no handler for:` messages.
  textDocumentChangeHandler :: Handlers HandlerM
  textDocumentChangeHandler =
      LSP.notificationHandler SMethod_TextDocumentDidChange \_ -> return ()
  
  -- this handler is a stab to prevent `lsp:no handler for:` messages.
  cancelationHandler :: Handlers HandlerM
  cancelationHandler =
      LSP.notificationHandler SMethod_CancelRequest \_ -> return ()
  
  -- This handler is a stub to prevent `lsp:no handler for:` messages.
  documentDidCloseHandler :: Handlers HandlerM
  documentDidCloseHandler =
      LSP.notificationHandler SMethod_TextDocumentDidClose \_ -> return ()
  
  handleErrorWithDefault :: (Either a1 b -> HandlerM a2)
   -> b
   -> HandlerM a2
   -> HandlerM a2
  handleErrorWithDefault respond _default = flip catchE handler
    where
      handler (Log, _message)  = do
                      let _type_ = MessageType_Log
                      liftLSP $ LSP.sendNotification SMethod_WindowLogMessage LogMessageParams{..}
                      respond (Right _default)
  
      handler (severity_, _message) = do
                      let _type_ = case severity_ of
                            Error   -> MessageType_Error
                            Warning -> MessageType_Warning
                            Info    -> MessageType_Info
  #if !MIN_TOOL_VERSION_ghc(9,2,0)
                            Log     -> MessageType_Log
  #endif
  
                      liftLSP $ LSP.sendNotification SMethod_WindowShowMessage ShowMessageParams{..}
                      respond (Right _default)
  