-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0

{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE RankNTypes            #-}

module Development.IDE.LSP.Notifications
    ( whenUriFile
    , descriptor
    ) where

import qualified Language.LSP.Server                   as LSP
import           Language.LSP.Types
import qualified Language.LSP.Types                    as LSP
import qualified Language.LSP.Types.Capabilities       as LSP

import           Development.IDE.Core.IdeConfiguration
import           Development.IDE.Core.Service
import           Development.IDE.Core.Shake
import           Development.IDE.Types.Location
import           Development.IDE.Types.Logger
import           Development.IDE.Types.Options

import           Control.Monad.Extra
import qualified Data.HashMap.Strict                   as M
import qualified Data.HashSet                          as S
import qualified Data.Text                             as Text

import           Control.Monad.IO.Class
import           Development.IDE.Core.FileExists       (modifyFileExists,
                                                        watchedGlobs)
import           Development.IDE.Core.FileStore        (resetFileStore,
                                                        setFileModified,
                                                        setSomethingModified,
                                                        typecheckParents)
import           Development.IDE.Core.OfInterest
import           Ide.Plugin.Config                     (CheckParents (CheckOnClose))
import           Ide.Types

whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO ()
whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO ()
whenUriFile Uri
uri NormalizedFilePath -> IO ()
act = Maybe FilePath -> (FilePath -> IO ()) -> IO ()
forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust (Uri -> Maybe FilePath
LSP.uriToFilePath Uri
uri) ((FilePath -> IO ()) -> IO ()) -> (FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ NormalizedFilePath -> IO ()
act (NormalizedFilePath -> IO ())
-> (FilePath -> NormalizedFilePath) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> NormalizedFilePath
toNormalizedFilePath'

descriptor :: PluginId -> PluginDescriptor IdeState
descriptor :: PluginId -> PluginDescriptor IdeState
descriptor PluginId
plId = (PluginId -> PluginDescriptor IdeState
forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId) { pluginNotificationHandlers :: PluginNotificationHandlers IdeState
pluginNotificationHandlers = [PluginNotificationHandlers IdeState]
-> PluginNotificationHandlers IdeState
forall a. Monoid a => [a] -> a
mconcat
  [ SClientMethod 'TextDocumentDidOpen
-> PluginNotificationMethodHandler IdeState 'TextDocumentDidOpen
-> PluginNotificationHandlers IdeState
forall (m :: Method 'FromClient 'Notification) ideState.
HasTracing (MessageParams m) =>
SClientMethod m
-> PluginNotificationMethodHandler ideState m
-> PluginNotificationHandlers ideState
mkPluginNotificationHandler SClientMethod 'TextDocumentDidOpen
LSP.STextDocumentDidOpen (PluginNotificationMethodHandler IdeState 'TextDocumentDidOpen
 -> PluginNotificationHandlers IdeState)
-> PluginNotificationMethodHandler IdeState 'TextDocumentDidOpen
-> PluginNotificationHandlers IdeState
forall a b. (a -> b) -> a -> b
$
      \IdeState
ide PluginId
_ (DidOpenTextDocumentParams TextDocumentItem{_uri,_version}) -> IO () -> LspT Config IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LspT Config IO ()) -> IO () -> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$ do
      IdeState
-> VersionedTextDocumentIdentifier
-> List TextDocumentContentChangeEvent
-> IO ()
updatePositionMapping IdeState
ide (Uri -> TextDocumentVersion -> VersionedTextDocumentIdentifier
VersionedTextDocumentIdentifier Uri
_uri (Int -> TextDocumentVersion
forall a. a -> Maybe a
Just Int
_version)) ([TextDocumentContentChangeEvent]
-> List TextDocumentContentChangeEvent
forall a. [a] -> List a
List [])
      Uri -> (NormalizedFilePath -> IO ()) -> IO ()
whenUriFile Uri
_uri ((NormalizedFilePath -> IO ()) -> IO ())
-> (NormalizedFilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \NormalizedFilePath
file -> do
          -- We don't know if the file actually exists, or if the contents match those on disk
          -- For example, vscode restores previously unsaved contents on open
          IdeState
-> (HashMap NormalizedFilePath FileOfInterestStatus
    -> HashMap NormalizedFilePath FileOfInterestStatus)
-> IO ()
modifyFilesOfInterest IdeState
ide (NormalizedFilePath
-> FileOfInterestStatus
-> HashMap NormalizedFilePath FileOfInterestStatus
-> HashMap NormalizedFilePath FileOfInterestStatus
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert NormalizedFilePath
file Modified :: Bool -> FileOfInterestStatus
Modified{firstOpen :: Bool
firstOpen=Bool
True})
          IdeState -> Bool -> NormalizedFilePath -> IO ()
setFileModified IdeState
ide Bool
False NormalizedFilePath
file
          Logger -> Text -> IO ()
logDebug (IdeState -> Logger
ideLogger IdeState
ide) (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Opened text document: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Uri -> Text
getUri Uri
_uri

  , SClientMethod 'TextDocumentDidChange
-> PluginNotificationMethodHandler IdeState 'TextDocumentDidChange
-> PluginNotificationHandlers IdeState
forall (m :: Method 'FromClient 'Notification) ideState.
HasTracing (MessageParams m) =>
SClientMethod m
-> PluginNotificationMethodHandler ideState m
-> PluginNotificationHandlers ideState
mkPluginNotificationHandler SClientMethod 'TextDocumentDidChange
LSP.STextDocumentDidChange (PluginNotificationMethodHandler IdeState 'TextDocumentDidChange
 -> PluginNotificationHandlers IdeState)
-> PluginNotificationMethodHandler IdeState 'TextDocumentDidChange
-> PluginNotificationHandlers IdeState
forall a b. (a -> b) -> a -> b
$
      \IdeState
ide PluginId
_ (DidChangeTextDocumentParams identifier@VersionedTextDocumentIdentifier{_uri} changes) -> IO () -> LspT Config IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LspT Config IO ()) -> IO () -> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$ do
        IdeState
-> VersionedTextDocumentIdentifier
-> List TextDocumentContentChangeEvent
-> IO ()
updatePositionMapping IdeState
ide VersionedTextDocumentIdentifier
identifier List TextDocumentContentChangeEvent
changes
        Uri -> (NormalizedFilePath -> IO ()) -> IO ()
whenUriFile Uri
_uri ((NormalizedFilePath -> IO ()) -> IO ())
-> (NormalizedFilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \NormalizedFilePath
file -> do
          IdeState
-> (HashMap NormalizedFilePath FileOfInterestStatus
    -> HashMap NormalizedFilePath FileOfInterestStatus)
-> IO ()
modifyFilesOfInterest IdeState
ide (NormalizedFilePath
-> FileOfInterestStatus
-> HashMap NormalizedFilePath FileOfInterestStatus
-> HashMap NormalizedFilePath FileOfInterestStatus
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert NormalizedFilePath
file Modified :: Bool -> FileOfInterestStatus
Modified{firstOpen :: Bool
firstOpen=Bool
False})
          IdeState -> Bool -> NormalizedFilePath -> IO ()
setFileModified IdeState
ide Bool
False NormalizedFilePath
file
        Logger -> Text -> IO ()
logDebug (IdeState -> Logger
ideLogger IdeState
ide) (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Modified text document: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Uri -> Text
getUri Uri
_uri

  , SClientMethod 'TextDocumentDidSave
-> PluginNotificationMethodHandler IdeState 'TextDocumentDidSave
-> PluginNotificationHandlers IdeState
forall (m :: Method 'FromClient 'Notification) ideState.
HasTracing (MessageParams m) =>
SClientMethod m
-> PluginNotificationMethodHandler ideState m
-> PluginNotificationHandlers ideState
mkPluginNotificationHandler SClientMethod 'TextDocumentDidSave
LSP.STextDocumentDidSave (PluginNotificationMethodHandler IdeState 'TextDocumentDidSave
 -> PluginNotificationHandlers IdeState)
-> PluginNotificationMethodHandler IdeState 'TextDocumentDidSave
-> PluginNotificationHandlers IdeState
forall a b. (a -> b) -> a -> b
$
      \IdeState
ide PluginId
_ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> IO () -> LspT Config IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LspT Config IO ()) -> IO () -> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$ do
        Uri -> (NormalizedFilePath -> IO ()) -> IO ()
whenUriFile Uri
_uri ((NormalizedFilePath -> IO ()) -> IO ())
-> (NormalizedFilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \NormalizedFilePath
file -> do
            IdeState
-> (HashMap NormalizedFilePath FileOfInterestStatus
    -> HashMap NormalizedFilePath FileOfInterestStatus)
-> IO ()
modifyFilesOfInterest IdeState
ide (NormalizedFilePath
-> FileOfInterestStatus
-> HashMap NormalizedFilePath FileOfInterestStatus
-> HashMap NormalizedFilePath FileOfInterestStatus
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
M.insert NormalizedFilePath
file FileOfInterestStatus
OnDisk)
            IdeState -> Bool -> NormalizedFilePath -> IO ()
setFileModified IdeState
ide Bool
True NormalizedFilePath
file
        Logger -> Text -> IO ()
logDebug (IdeState -> Logger
ideLogger IdeState
ide) (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Saved text document: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Uri -> Text
getUri Uri
_uri

  , SClientMethod 'TextDocumentDidClose
-> PluginNotificationMethodHandler IdeState 'TextDocumentDidClose
-> PluginNotificationHandlers IdeState
forall (m :: Method 'FromClient 'Notification) ideState.
HasTracing (MessageParams m) =>
SClientMethod m
-> PluginNotificationMethodHandler ideState m
-> PluginNotificationHandlers ideState
mkPluginNotificationHandler SClientMethod 'TextDocumentDidClose
LSP.STextDocumentDidClose (PluginNotificationMethodHandler IdeState 'TextDocumentDidClose
 -> PluginNotificationHandlers IdeState)
-> PluginNotificationMethodHandler IdeState 'TextDocumentDidClose
-> PluginNotificationHandlers IdeState
forall a b. (a -> b) -> a -> b
$
        \IdeState
ide PluginId
_ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> IO () -> LspT Config IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LspT Config IO ()) -> IO () -> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$ do
          Uri -> (NormalizedFilePath -> IO ()) -> IO ()
whenUriFile Uri
_uri ((NormalizedFilePath -> IO ()) -> IO ())
-> (NormalizedFilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \NormalizedFilePath
file -> do
              IdeState
-> (HashMap NormalizedFilePath FileOfInterestStatus
    -> HashMap NormalizedFilePath FileOfInterestStatus)
-> IO ()
modifyFilesOfInterest IdeState
ide (NormalizedFilePath
-> HashMap NormalizedFilePath FileOfInterestStatus
-> HashMap NormalizedFilePath FileOfInterestStatus
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
M.delete NormalizedFilePath
file)
              -- Refresh all the files that depended on this
              CheckParents
checkParents <- IdeOptions -> IO CheckParents
optCheckParents (IdeOptions -> IO CheckParents) -> IO IdeOptions -> IO CheckParents
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ShakeExtras -> IO IdeOptions
getIdeOptionsIO (IdeState -> ShakeExtras
shakeExtras IdeState
ide)
              Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CheckParents
checkParents CheckParents -> CheckParents -> Bool
forall a. Ord a => a -> a -> Bool
>= CheckParents
CheckOnClose) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IdeState -> NormalizedFilePath -> IO ()
typecheckParents IdeState
ide NormalizedFilePath
file
              Logger -> Text -> IO ()
logDebug (IdeState -> Logger
ideLogger IdeState
ide) (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Closed text document: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Uri -> Text
getUri Uri
_uri

  , SClientMethod 'WorkspaceDidChangeWatchedFiles
-> PluginNotificationMethodHandler
     IdeState 'WorkspaceDidChangeWatchedFiles
-> PluginNotificationHandlers IdeState
forall (m :: Method 'FromClient 'Notification) ideState.
HasTracing (MessageParams m) =>
SClientMethod m
-> PluginNotificationMethodHandler ideState m
-> PluginNotificationHandlers ideState
mkPluginNotificationHandler SClientMethod 'WorkspaceDidChangeWatchedFiles
LSP.SWorkspaceDidChangeWatchedFiles (PluginNotificationMethodHandler
   IdeState 'WorkspaceDidChangeWatchedFiles
 -> PluginNotificationHandlers IdeState)
-> PluginNotificationMethodHandler
     IdeState 'WorkspaceDidChangeWatchedFiles
-> PluginNotificationHandlers IdeState
forall a b. (a -> b) -> a -> b
$
      \IdeState
ide PluginId
_ (DidChangeWatchedFilesParams (List fileEvents)) -> IO () -> LspT Config IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LspT Config IO ()) -> IO () -> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$ do
        -- See Note [File existence cache and LSP file watchers] which explains why we get these notifications and
        -- what we do with them
        let msg :: Text
msg = FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ [FileEvent] -> FilePath
forall a. Show a => a -> FilePath
show [FileEvent]
fileEvents
        Logger -> Text -> IO ()
logDebug (IdeState -> Logger
ideLogger IdeState
ide) (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Watched file events: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
        IdeState -> [FileEvent] -> IO ()
modifyFileExists IdeState
ide [FileEvent]
fileEvents
        IdeState -> [FileEvent] -> IO ()
resetFileStore IdeState
ide [FileEvent]
fileEvents
        IdeState -> IO ()
setSomethingModified IdeState
ide

  , SClientMethod 'WorkspaceDidChangeWorkspaceFolders
-> PluginNotificationMethodHandler
     IdeState 'WorkspaceDidChangeWorkspaceFolders
-> PluginNotificationHandlers IdeState
forall (m :: Method 'FromClient 'Notification) ideState.
HasTracing (MessageParams m) =>
SClientMethod m
-> PluginNotificationMethodHandler ideState m
-> PluginNotificationHandlers ideState
mkPluginNotificationHandler SClientMethod 'WorkspaceDidChangeWorkspaceFolders
LSP.SWorkspaceDidChangeWorkspaceFolders (PluginNotificationMethodHandler
   IdeState 'WorkspaceDidChangeWorkspaceFolders
 -> PluginNotificationHandlers IdeState)
-> PluginNotificationMethodHandler
     IdeState 'WorkspaceDidChangeWorkspaceFolders
-> PluginNotificationHandlers IdeState
forall a b. (a -> b) -> a -> b
$
      \IdeState
ide PluginId
_ (DidChangeWorkspaceFoldersParams events) -> IO () -> LspT Config IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LspT Config IO ()) -> IO () -> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$ do
        let add :: HashSet NormalizedUri
-> HashSet NormalizedUri -> HashSet NormalizedUri
add       = HashSet NormalizedUri
-> HashSet NormalizedUri -> HashSet NormalizedUri
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
S.union
            substract :: HashSet NormalizedUri
-> HashSet NormalizedUri -> HashSet NormalizedUri
substract = (HashSet NormalizedUri
 -> HashSet NormalizedUri -> HashSet NormalizedUri)
-> HashSet NormalizedUri
-> HashSet NormalizedUri
-> HashSet NormalizedUri
forall a b c. (a -> b -> c) -> b -> a -> c
flip HashSet NormalizedUri
-> HashSet NormalizedUri -> HashSet NormalizedUri
forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
S.difference
        IdeState
-> (HashSet NormalizedUri -> HashSet NormalizedUri) -> IO ()
modifyWorkspaceFolders IdeState
ide
          ((HashSet NormalizedUri -> HashSet NormalizedUri) -> IO ())
-> (HashSet NormalizedUri -> HashSet NormalizedUri) -> IO ()
forall a b. (a -> b) -> a -> b
$ HashSet NormalizedUri
-> HashSet NormalizedUri -> HashSet NormalizedUri
add       ((WorkspaceFolder -> HashSet NormalizedUri)
-> List WorkspaceFolder -> HashSet NormalizedUri
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (NormalizedUri -> HashSet NormalizedUri
forall a. Hashable a => a -> HashSet a
S.singleton (NormalizedUri -> HashSet NormalizedUri)
-> (WorkspaceFolder -> NormalizedUri)
-> WorkspaceFolder
-> HashSet NormalizedUri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceFolder -> NormalizedUri
parseWorkspaceFolder) (WorkspaceFoldersChangeEvent -> List WorkspaceFolder
_added   WorkspaceFoldersChangeEvent
events))
          (HashSet NormalizedUri -> HashSet NormalizedUri)
-> (HashSet NormalizedUri -> HashSet NormalizedUri)
-> HashSet NormalizedUri
-> HashSet NormalizedUri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet NormalizedUri
-> HashSet NormalizedUri -> HashSet NormalizedUri
substract ((WorkspaceFolder -> HashSet NormalizedUri)
-> List WorkspaceFolder -> HashSet NormalizedUri
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (NormalizedUri -> HashSet NormalizedUri
forall a. Hashable a => a -> HashSet a
S.singleton (NormalizedUri -> HashSet NormalizedUri)
-> (WorkspaceFolder -> NormalizedUri)
-> WorkspaceFolder
-> HashSet NormalizedUri
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WorkspaceFolder -> NormalizedUri
parseWorkspaceFolder) (WorkspaceFoldersChangeEvent -> List WorkspaceFolder
_removed WorkspaceFoldersChangeEvent
events))

  , SClientMethod 'WorkspaceDidChangeConfiguration
-> PluginNotificationMethodHandler
     IdeState 'WorkspaceDidChangeConfiguration
-> PluginNotificationHandlers IdeState
forall (m :: Method 'FromClient 'Notification) ideState.
HasTracing (MessageParams m) =>
SClientMethod m
-> PluginNotificationMethodHandler ideState m
-> PluginNotificationHandlers ideState
mkPluginNotificationHandler SClientMethod 'WorkspaceDidChangeConfiguration
LSP.SWorkspaceDidChangeConfiguration (PluginNotificationMethodHandler
   IdeState 'WorkspaceDidChangeConfiguration
 -> PluginNotificationHandlers IdeState)
-> PluginNotificationMethodHandler
     IdeState 'WorkspaceDidChangeConfiguration
-> PluginNotificationHandlers IdeState
forall a b. (a -> b) -> a -> b
$
      \IdeState
ide PluginId
_ (DidChangeConfigurationParams cfg) -> IO () -> LspT Config IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LspT Config IO ()) -> IO () -> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$ do
        let msg :: Text
msg = FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Value -> FilePath
forall a. Show a => a -> FilePath
show Value
cfg
        Logger -> Text -> IO ()
logDebug (IdeState -> Logger
ideLogger IdeState
ide) (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Configuration changed: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
        IdeState -> (Maybe Value -> Maybe Value) -> IO ()
modifyClientSettings IdeState
ide (Maybe Value -> Maybe Value -> Maybe Value
forall a b. a -> b -> a
const (Maybe Value -> Maybe Value -> Maybe Value)
-> Maybe Value -> Maybe Value -> Maybe Value
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just Value
cfg)
        IdeState -> IO ()
setSomethingModified IdeState
ide

  , SClientMethod 'Initialized
-> PluginNotificationMethodHandler IdeState 'Initialized
-> PluginNotificationHandlers IdeState
forall (m :: Method 'FromClient 'Notification) ideState.
HasTracing (MessageParams m) =>
SClientMethod m
-> PluginNotificationMethodHandler ideState m
-> PluginNotificationHandlers ideState
mkPluginNotificationHandler SClientMethod 'Initialized
LSP.SInitialized (PluginNotificationMethodHandler IdeState 'Initialized
 -> PluginNotificationHandlers IdeState)
-> PluginNotificationMethodHandler IdeState 'Initialized
-> PluginNotificationHandlers IdeState
forall a b. (a -> b) -> a -> b
$ \IdeState
ide PluginId
_ MessageParams 'Initialized
_ -> do
      ClientCapabilities
clientCapabilities <- LspT Config IO ClientCapabilities
forall config (m :: * -> *).
MonadLsp config m =>
m ClientCapabilities
LSP.getClientCapabilities
      let watchSupported :: Bool
watchSupported = case () of
            ()
_ | LSP.ClientCapabilities{Maybe WorkspaceClientCapabilities
$sel:_workspace:ClientCapabilities :: ClientCapabilities -> Maybe WorkspaceClientCapabilities
_workspace :: Maybe WorkspaceClientCapabilities
_workspace} <- ClientCapabilities
clientCapabilities
              , Just LSP.WorkspaceClientCapabilities{Maybe DidChangeWatchedFilesClientCapabilities
$sel:_didChangeWatchedFiles:WorkspaceClientCapabilities :: WorkspaceClientCapabilities
-> Maybe DidChangeWatchedFilesClientCapabilities
_didChangeWatchedFiles :: Maybe DidChangeWatchedFilesClientCapabilities
_didChangeWatchedFiles} <- Maybe WorkspaceClientCapabilities
_workspace
              , Just LSP.DidChangeWatchedFilesClientCapabilities{Maybe Bool
$sel:_dynamicRegistration:DidChangeWatchedFilesClientCapabilities :: DidChangeWatchedFilesClientCapabilities -> Maybe Bool
_dynamicRegistration :: Maybe Bool
_dynamicRegistration} <- Maybe DidChangeWatchedFilesClientCapabilities
_didChangeWatchedFiles
              , Just Bool
True <- Maybe Bool
_dynamicRegistration
                -> Bool
True
              | Bool
otherwise -> Bool
False
      if Bool
watchSupported
      then do
        IdeOptions
opts <- IO IdeOptions -> LspT Config IO IdeOptions
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO IdeOptions -> LspT Config IO IdeOptions)
-> IO IdeOptions -> LspT Config IO IdeOptions
forall a b. (a -> b) -> a -> b
$ ShakeExtras -> IO IdeOptions
getIdeOptionsIO (ShakeExtras -> IO IdeOptions) -> ShakeExtras -> IO IdeOptions
forall a b. (a -> b) -> a -> b
$ IdeState -> ShakeExtras
shakeExtras IdeState
ide
        let
          regParams :: RegistrationParams
regParams    = List SomeRegistration -> RegistrationParams
RegistrationParams ([SomeRegistration] -> List SomeRegistration
forall a. [a] -> List a
List [Registration 'WorkspaceDidChangeWatchedFiles -> SomeRegistration
forall (t :: MethodType) (m :: Method 'FromClient t).
Registration m -> SomeRegistration
SomeRegistration Registration 'WorkspaceDidChangeWatchedFiles
registration])
          -- The registration ID is arbitrary and is only used in case we want to deregister (which we won't).
          -- We could also use something like a random UUID, as some other servers do, but this works for
          -- our purposes.
          registration :: Registration 'WorkspaceDidChangeWatchedFiles
registration = Text
-> SClientMethod 'WorkspaceDidChangeWatchedFiles
-> RegistrationOptions 'WorkspaceDidChangeWatchedFiles
-> Registration 'WorkspaceDidChangeWatchedFiles
forall (t :: MethodType) (m :: Method 'FromClient t).
Text -> SClientMethod m -> RegistrationOptions m -> Registration m
Registration Text
"globalFileWatches"
                                      SClientMethod 'WorkspaceDidChangeWatchedFiles
SWorkspaceDidChangeWatchedFiles
                                      RegistrationOptions 'WorkspaceDidChangeWatchedFiles
DidChangeWatchedFilesRegistrationOptions
regOptions
          regOptions :: DidChangeWatchedFilesRegistrationOptions
regOptions =
            DidChangeWatchedFilesRegistrationOptions :: List FileSystemWatcher -> DidChangeWatchedFilesRegistrationOptions
DidChangeWatchedFilesRegistrationOptions { $sel:_watchers:DidChangeWatchedFilesRegistrationOptions :: List FileSystemWatcher
_watchers = [FileSystemWatcher] -> List FileSystemWatcher
forall a. [a] -> List a
List [FileSystemWatcher]
watchers }
          -- See Note [File existence cache and LSP file watchers] for why this exists, and the choice of watch kind
          watchKind :: WatchKind
watchKind = WatchKind :: Bool -> Bool -> Bool -> WatchKind
WatchKind { $sel:_watchCreate:WatchKind :: Bool
_watchCreate = Bool
True, $sel:_watchChange:WatchKind :: Bool
_watchChange = Bool
True, $sel:_watchDelete:WatchKind :: Bool
_watchDelete = Bool
True}
          -- See Note [Which files should we watch?] for an explanation of why the pattern is the way that it is
          -- The patterns will be something like "**/.hs", i.e. "any number of directory segments,
          -- followed by a file with an extension 'hs'.
          watcher :: Text -> FileSystemWatcher
watcher Text
glob = FileSystemWatcher :: Text -> Maybe WatchKind -> FileSystemWatcher
FileSystemWatcher { $sel:_globPattern:FileSystemWatcher :: Text
_globPattern = Text
glob, $sel:_kind:FileSystemWatcher :: Maybe WatchKind
_kind = WatchKind -> Maybe WatchKind
forall a. a -> Maybe a
Just WatchKind
watchKind }
          -- We use multiple watchers instead of one using '{}' because lsp-test doesn't
          -- support that: https://github.com/bubba/lsp-test/issues/77
          watchers :: [FileSystemWatcher]
watchers = [ Text -> FileSystemWatcher
watcher (FilePath -> Text
Text.pack FilePath
glob) | FilePath
glob <- IdeOptions -> [FilePath]
watchedGlobs IdeOptions
opts ]

        LspT Config IO (LspId 'ClientRegisterCapability)
-> LspT Config IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (LspT Config IO (LspId 'ClientRegisterCapability)
 -> LspT Config IO ())
-> LspT Config IO (LspId 'ClientRegisterCapability)
-> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$ SServerMethod 'ClientRegisterCapability
-> MessageParams 'ClientRegisterCapability
-> (Either ResponseError (ResponseResult 'ClientRegisterCapability)
    -> LspT Config IO ())
-> LspT Config IO (LspId 'ClientRegisterCapability)
forall (m :: Method 'FromServer 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod m
-> MessageParams m
-> (Either ResponseError (ResponseResult m) -> f ())
-> f (LspId m)
LSP.sendRequest SServerMethod 'ClientRegisterCapability
SClientRegisterCapability MessageParams 'ClientRegisterCapability
RegistrationParams
regParams (LspT Config IO ()
-> Either ResponseError Empty -> LspT Config IO ()
forall a b. a -> b -> a
const (LspT Config IO ()
 -> Either ResponseError Empty -> LspT Config IO ())
-> LspT Config IO ()
-> Either ResponseError Empty
-> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$ () -> LspT Config IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) -- TODO handle response
      else IO () -> LspT Config IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> LspT Config IO ()) -> IO () -> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$ Logger -> Text -> IO ()
logDebug (IdeState -> Logger
ideLogger IdeState
ide) Text
"Warning: Client does not support watched files. Falling back to OS polling"
  ]
    }