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

{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RankNTypes            #-}

module Development.IDE.LSP.Notifications
    ( setHandlersNotifications
    ) where

import           Development.IDE.LSP.Server
import qualified Language.Haskell.LSP.Core        as LSP
import           Language.Haskell.LSP.Types
import qualified Language.Haskell.LSP.Types       as LSP
import qualified Language.Haskell.LSP.Messages    as LSP
import qualified Language.Haskell.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.Aeson                       as A
import           Data.Foldable                    as F
import           Data.Maybe
import qualified Data.HashMap.Strict              as M
import qualified Data.HashSet                     as S
import qualified Data.Text                        as Text

import           Development.IDE.Core.FileStore   (setSomethingModified, setFileModified, typecheckParents)
import           Development.IDE.Core.FileExists  (modifyFileExists, watchedGlobs)
import           Development.IDE.Core.OfInterest


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'

setHandlersNotifications :: PartialHandlers c
setHandlersNotifications :: PartialHandlers c
setHandlersNotifications = (WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
forall c.
(WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
PartialHandlers ((WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c)
-> (WithMessage c -> Handlers -> IO Handlers) -> PartialHandlers c
forall a b. (a -> b) -> a -> b
$ \WithMessage{(LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs c
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
$sel:withInitialize:WithMessage :: forall c.
WithMessage c
-> (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
$sel:withResponseAndRequest:WithMessage :: forall c.
WithMessage c
-> forall m rm req resp newReqParams newReqBody.
   (Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
   (ResponseMessage resp -> FromServerMessage)
   -> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
   -> (LspFuncs c
       -> IdeState
       -> req
       -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
   -> Maybe (Handler (RequestMessage m req resp))
$sel:withNotification:WithMessage :: forall c.
WithMessage c
-> forall m req.
   (Show m, Show req) =>
   Maybe (Handler (NotificationMessage m req))
   -> (LspFuncs c -> IdeState -> req -> IO ())
   -> Maybe (Handler (NotificationMessage m req))
$sel:withResponse:WithMessage :: forall c.
WithMessage c
-> forall m req resp.
   (Show m, Show req) =>
   (ResponseMessage resp -> FromServerMessage)
   -> (LspFuncs c
       -> IdeState -> req -> IO (Either ResponseError resp))
   -> Maybe (Handler (RequestMessage m req resp))
withInitialize :: (LspFuncs c -> IdeState -> InitializeParams -> IO ())
-> Maybe (Handler InitializeRequest)
withResponseAndRequest :: forall m rm req resp newReqParams newReqBody.
(Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
(ResponseMessage resp -> FromServerMessage)
-> (RequestMessage rm newReqParams newReqBody -> FromServerMessage)
-> (LspFuncs c
    -> IdeState
    -> req
    -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
-> Maybe (Handler (RequestMessage m req resp))
withNotification :: forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
withResponse :: forall m req resp.
(Show m, Show req) =>
(ResponseMessage resp -> FromServerMessage)
-> (LspFuncs c
    -> IdeState -> req -> IO (Either ResponseError resp))
-> Maybe (Handler (RequestMessage m req resp))
..} Handlers
x -> Handlers -> IO Handlers
forall (m :: * -> *) a. Monad m => a -> m a
return Handlers
x
    {didOpenTextDocumentNotificationHandler :: Maybe (Handler DidOpenTextDocumentNotification)
LSP.didOpenTextDocumentNotificationHandler = Maybe (Handler DidOpenTextDocumentNotification)
-> (LspFuncs c -> IdeState -> DidOpenTextDocumentParams -> IO ())
-> Maybe (Handler DidOpenTextDocumentNotification)
forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
withNotification (Handlers -> Maybe (Handler DidOpenTextDocumentNotification)
LSP.didOpenTextDocumentNotificationHandler Handlers
x) ((LspFuncs c -> IdeState -> DidOpenTextDocumentParams -> IO ())
 -> Maybe (Handler DidOpenTextDocumentNotification))
-> (LspFuncs c -> IdeState -> DidOpenTextDocumentParams -> IO ())
-> Maybe (Handler DidOpenTextDocumentNotification)
forall a b. (a -> b) -> a -> b
$
        \LspFuncs c
_ IdeState
ide (DidOpenTextDocumentParams TextDocumentItem{Uri
$sel:_uri:TextDocumentItem :: TextDocumentItem -> Uri
_uri :: Uri
_uri,Int
$sel:_version:TextDocumentItem :: TextDocumentItem -> Int
_version :: Int
_version}) -> 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 FileOfInterestStatus
Modified)
                IdeState -> Bool -> NormalizedFilePath -> IO ()
setFileModified IdeState
ide Bool
False NormalizedFilePath
file
                Logger -> Text -> IO ()
logInfo (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

    ,didChangeTextDocumentNotificationHandler :: Maybe (Handler DidChangeTextDocumentNotification)
LSP.didChangeTextDocumentNotificationHandler = Maybe (Handler DidChangeTextDocumentNotification)
-> (LspFuncs c -> IdeState -> DidChangeTextDocumentParams -> IO ())
-> Maybe (Handler DidChangeTextDocumentNotification)
forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
withNotification (Handlers -> Maybe (Handler DidChangeTextDocumentNotification)
LSP.didChangeTextDocumentNotificationHandler Handlers
x) ((LspFuncs c -> IdeState -> DidChangeTextDocumentParams -> IO ())
 -> Maybe (Handler DidChangeTextDocumentNotification))
-> (LspFuncs c -> IdeState -> DidChangeTextDocumentParams -> IO ())
-> Maybe (Handler DidChangeTextDocumentNotification)
forall a b. (a -> b) -> a -> b
$
        \LspFuncs c
_ IdeState
ide (DidChangeTextDocumentParams identifier :: VersionedTextDocumentIdentifier
identifier@VersionedTextDocumentIdentifier{Uri
$sel:_uri:VersionedTextDocumentIdentifier :: VersionedTextDocumentIdentifier -> Uri
_uri :: Uri
_uri} List TextDocumentContentChangeEvent
changes) -> 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 FileOfInterestStatus
Modified)
              IdeState -> Bool -> NormalizedFilePath -> IO ()
setFileModified IdeState
ide Bool
False NormalizedFilePath
file
            Logger -> Text -> IO ()
logInfo (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

    ,didSaveTextDocumentNotificationHandler :: Maybe (Handler DidSaveTextDocumentNotification)
LSP.didSaveTextDocumentNotificationHandler = Maybe (Handler DidSaveTextDocumentNotification)
-> (LspFuncs c -> IdeState -> DidSaveTextDocumentParams -> IO ())
-> Maybe (Handler DidSaveTextDocumentNotification)
forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
withNotification (Handlers -> Maybe (Handler DidSaveTextDocumentNotification)
LSP.didSaveTextDocumentNotificationHandler Handlers
x) ((LspFuncs c -> IdeState -> DidSaveTextDocumentParams -> IO ())
 -> Maybe (Handler DidSaveTextDocumentNotification))
-> (LspFuncs c -> IdeState -> DidSaveTextDocumentParams -> IO ())
-> Maybe (Handler DidSaveTextDocumentNotification)
forall a b. (a -> b) -> a -> b
$
        \LspFuncs c
_ IdeState
ide (DidSaveTextDocumentParams TextDocumentIdentifier{Uri
$sel:_uri:TextDocumentIdentifier :: TextDocumentIdentifier -> Uri
_uri :: Uri
_uri}) -> 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 ()
logInfo (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

    ,didCloseTextDocumentNotificationHandler :: Maybe (Handler DidCloseTextDocumentNotification)
LSP.didCloseTextDocumentNotificationHandler = Maybe (Handler DidCloseTextDocumentNotification)
-> (LspFuncs c -> IdeState -> DidCloseTextDocumentParams -> IO ())
-> Maybe (Handler DidCloseTextDocumentNotification)
forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
withNotification (Handlers -> Maybe (Handler DidCloseTextDocumentNotification)
LSP.didCloseTextDocumentNotificationHandler Handlers
x) ((LspFuncs c -> IdeState -> DidCloseTextDocumentParams -> IO ())
 -> Maybe (Handler DidCloseTextDocumentNotification))
-> (LspFuncs c -> IdeState -> DidCloseTextDocumentParams -> IO ())
-> Maybe (Handler DidCloseTextDocumentNotification)
forall a b. (a -> b) -> a -> b
$
        \LspFuncs c
_ IdeState
ide (DidCloseTextDocumentParams TextDocumentIdentifier{Uri
_uri :: Uri
$sel:_uri:TextDocumentIdentifier :: TextDocumentIdentifier -> Uri
_uri}) -> 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
                IdeOptions{CheckParents
optCheckParents :: IdeOptions -> CheckParents
optCheckParents :: CheckParents
optCheckParents} <- ShakeExtras -> IO IdeOptions
getIdeOptionsIO (ShakeExtras -> IO IdeOptions) -> ShakeExtras -> IO IdeOptions
forall a b. (a -> b) -> a -> b
$ IdeState -> ShakeExtras
shakeExtras IdeState
ide
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CheckParents
optCheckParents 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 ()
logInfo (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
    ,didChangeWatchedFilesNotificationHandler :: Maybe (Handler DidChangeWatchedFilesNotification)
LSP.didChangeWatchedFilesNotificationHandler = Maybe (Handler DidChangeWatchedFilesNotification)
-> (LspFuncs c -> IdeState -> DidChangeWatchedFilesParams -> IO ())
-> Maybe (Handler DidChangeWatchedFilesNotification)
forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
withNotification (Handlers -> Maybe (Handler DidChangeWatchedFilesNotification)
LSP.didChangeWatchedFilesNotificationHandler Handlers
x) ((LspFuncs c -> IdeState -> DidChangeWatchedFilesParams -> IO ())
 -> Maybe (Handler DidChangeWatchedFilesNotification))
-> (LspFuncs c -> IdeState -> DidChangeWatchedFilesParams -> IO ())
-> Maybe (Handler DidChangeWatchedFilesNotification)
forall a b. (a -> b) -> a -> b
$
        \LspFuncs c
_ IdeState
ide (DidChangeWatchedFilesParams List FileEvent
fileEvents) -> do
            -- See Note [File existence cache and LSP file watchers] which explains why we get these notifications and
            -- what we do with them
            let events :: [(NormalizedFilePath, Bool)]
events =
                    (FileEvent -> Maybe (NormalizedFilePath, Bool))
-> [FileEvent] -> [(NormalizedFilePath, Bool)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe
                        (\(FileEvent Uri
uri FileChangeType
ev) ->
                            (, FileChangeType
ev FileChangeType -> FileChangeType -> Bool
forall a. Eq a => a -> a -> Bool
/= FileChangeType
FcDeleted) (NormalizedFilePath -> (NormalizedFilePath, Bool))
-> (FilePath -> NormalizedFilePath)
-> FilePath
-> (NormalizedFilePath, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> NormalizedFilePath
toNormalizedFilePath'
                            (FilePath -> (NormalizedFilePath, Bool))
-> Maybe FilePath -> Maybe (NormalizedFilePath, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Uri -> Maybe FilePath
LSP.uriToFilePath Uri
uri
                        )
                        ( List FileEvent -> [FileEvent]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList List FileEvent
fileEvents )
            let msg :: Text
msg = FilePath -> Text
Text.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ [(NormalizedFilePath, Bool)] -> FilePath
forall a. Show a => a -> FilePath
show [(NormalizedFilePath, Bool)]
events
            Logger -> Text -> IO ()
logDebug (IdeState -> Logger
ideLogger IdeState
ide) (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Text
"Files created or deleted: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
            IdeState -> [(NormalizedFilePath, Bool)] -> IO ()
modifyFileExists IdeState
ide [(NormalizedFilePath, Bool)]
events
            IdeState -> IO ()
setSomethingModified IdeState
ide

    ,didChangeWorkspaceFoldersNotificationHandler :: Maybe (Handler DidChangeWorkspaceFoldersNotification)
LSP.didChangeWorkspaceFoldersNotificationHandler = Maybe (Handler DidChangeWorkspaceFoldersNotification)
-> (LspFuncs c
    -> IdeState -> DidChangeWorkspaceFoldersParams -> IO ())
-> Maybe (Handler DidChangeWorkspaceFoldersNotification)
forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
withNotification (Handlers -> Maybe (Handler DidChangeWorkspaceFoldersNotification)
LSP.didChangeWorkspaceFoldersNotificationHandler Handlers
x) ((LspFuncs c
  -> IdeState -> DidChangeWorkspaceFoldersParams -> IO ())
 -> Maybe (Handler DidChangeWorkspaceFoldersNotification))
-> (LspFuncs c
    -> IdeState -> DidChangeWorkspaceFoldersParams -> IO ())
-> Maybe (Handler DidChangeWorkspaceFoldersNotification)
forall a b. (a -> b) -> a -> b
$
        \LspFuncs c
_ IdeState
ide (DidChangeWorkspaceFoldersParams WorkspaceFoldersChangeEvent
events) -> 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))

    ,didChangeConfigurationParamsHandler :: Maybe (Handler DidChangeConfigurationNotification)
LSP.didChangeConfigurationParamsHandler = Maybe (Handler DidChangeConfigurationNotification)
-> (LspFuncs c
    -> IdeState -> DidChangeConfigurationParams -> IO ())
-> Maybe (Handler DidChangeConfigurationNotification)
forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
withNotification (Handlers -> Maybe (Handler DidChangeConfigurationNotification)
LSP.didChangeConfigurationParamsHandler Handlers
x) ((LspFuncs c -> IdeState -> DidChangeConfigurationParams -> IO ())
 -> Maybe (Handler DidChangeConfigurationNotification))
-> (LspFuncs c
    -> IdeState -> DidChangeConfigurationParams -> IO ())
-> Maybe (Handler DidChangeConfigurationNotification)
forall a b. (a -> b) -> a -> b
$
        \LspFuncs c
_ IdeState
ide (DidChangeConfigurationParams Value
cfg) -> 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 ()
logInfo (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

    -- Initialized handler, good time to dynamically register capabilities
    ,initializedHandler :: Maybe (Handler InitializedNotification)
LSP.initializedHandler = Maybe (Handler InitializedNotification)
-> (LspFuncs c -> IdeState -> Maybe InitializedParams -> IO ())
-> Maybe (Handler InitializedNotification)
forall m req.
(Show m, Show req) =>
Maybe (Handler (NotificationMessage m req))
-> (LspFuncs c -> IdeState -> req -> IO ())
-> Maybe (Handler (NotificationMessage m req))
withNotification (Handlers -> Maybe (Handler InitializedNotification)
LSP.initializedHandler Handlers
x) ((LspFuncs c -> IdeState -> Maybe InitializedParams -> IO ())
 -> Maybe (Handler InitializedNotification))
-> (LspFuncs c -> IdeState -> Maybe InitializedParams -> IO ())
-> Maybe (Handler InitializedNotification)
forall a b. (a -> b) -> a -> b
$ \lsp :: LspFuncs c
lsp@LSP.LspFuncs{Maybe FilePath
IO (Maybe c)
IO (Maybe [WorkspaceFolder])
IO LspId
IO (FilePath -> FilePath)
ClientCapabilities
FlushDiagnosticsBySourceFunc
PublishDiagnosticsFunc
SendFunc
NormalizedUri -> IO (Maybe FilePath)
NormalizedUri -> IO (Maybe VirtualFile)
forall a. Text -> ProgressCancellable -> IO a -> IO a
forall a.
Text
-> ProgressCancellable -> ((Progress -> IO ()) -> IO a) -> IO a
clientCapabilities :: forall c. LspFuncs c -> ClientCapabilities
config :: forall c. LspFuncs c -> IO (Maybe c)
sendFunc :: forall c. LspFuncs c -> SendFunc
getVirtualFileFunc :: forall c. LspFuncs c -> NormalizedUri -> IO (Maybe VirtualFile)
persistVirtualFileFunc :: forall c. LspFuncs c -> NormalizedUri -> IO (Maybe FilePath)
reverseFileMapFunc :: forall c. LspFuncs c -> IO (FilePath -> FilePath)
publishDiagnosticsFunc :: forall c. LspFuncs c -> PublishDiagnosticsFunc
flushDiagnosticsBySourceFunc :: forall c. LspFuncs c -> FlushDiagnosticsBySourceFunc
getNextReqId :: forall c. LspFuncs c -> IO LspId
rootPath :: forall c. LspFuncs c -> Maybe FilePath
getWorkspaceFolders :: forall c. LspFuncs c -> IO (Maybe [WorkspaceFolder])
withProgress :: forall c.
LspFuncs c
-> forall a.
   Text
   -> ProgressCancellable -> ((Progress -> IO ()) -> IO a) -> IO a
withIndefiniteProgress :: forall c.
LspFuncs c -> forall a. Text -> ProgressCancellable -> IO a -> IO a
withIndefiniteProgress :: forall a. Text -> ProgressCancellable -> IO a -> IO a
withProgress :: forall a.
Text
-> ProgressCancellable -> ((Progress -> IO ()) -> IO a) -> IO a
getWorkspaceFolders :: IO (Maybe [WorkspaceFolder])
rootPath :: Maybe FilePath
getNextReqId :: IO LspId
flushDiagnosticsBySourceFunc :: FlushDiagnosticsBySourceFunc
publishDiagnosticsFunc :: PublishDiagnosticsFunc
reverseFileMapFunc :: IO (FilePath -> FilePath)
persistVirtualFileFunc :: NormalizedUri -> IO (Maybe FilePath)
getVirtualFileFunc :: NormalizedUri -> IO (Maybe VirtualFile)
sendFunc :: SendFunc
config :: IO (Maybe c)
clientCapabilities :: ClientCapabilities
..} IdeState
ide Maybe InitializedParams
_ -> do
        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 LspFuncs c -> IdeState -> IO ()
forall c. LspFuncs c -> IdeState -> IO ()
registerWatcher LspFuncs c
lsp IdeState
ide
        else Logger -> Text -> IO ()
logDebug (IdeState -> Logger
ideLogger IdeState
ide) Text
"Warning: Client does not support watched files. Falling back to OS polling"

    }
    where
        registerWatcher :: LspFuncs c -> IdeState -> IO ()
registerWatcher LSP.LspFuncs{Maybe FilePath
IO (Maybe c)
IO (Maybe [WorkspaceFolder])
IO LspId
IO (FilePath -> FilePath)
ClientCapabilities
FlushDiagnosticsBySourceFunc
PublishDiagnosticsFunc
SendFunc
NormalizedUri -> IO (Maybe FilePath)
NormalizedUri -> IO (Maybe VirtualFile)
forall a. Text -> ProgressCancellable -> IO a -> IO a
forall a.
Text
-> ProgressCancellable -> ((Progress -> IO ()) -> IO a) -> IO a
withIndefiniteProgress :: forall a. Text -> ProgressCancellable -> IO a -> IO a
withProgress :: forall a.
Text
-> ProgressCancellable -> ((Progress -> IO ()) -> IO a) -> IO a
getWorkspaceFolders :: IO (Maybe [WorkspaceFolder])
rootPath :: Maybe FilePath
getNextReqId :: IO LspId
flushDiagnosticsBySourceFunc :: FlushDiagnosticsBySourceFunc
publishDiagnosticsFunc :: PublishDiagnosticsFunc
reverseFileMapFunc :: IO (FilePath -> FilePath)
persistVirtualFileFunc :: NormalizedUri -> IO (Maybe FilePath)
getVirtualFileFunc :: NormalizedUri -> IO (Maybe VirtualFile)
sendFunc :: SendFunc
config :: IO (Maybe c)
clientCapabilities :: ClientCapabilities
clientCapabilities :: forall c. LspFuncs c -> ClientCapabilities
config :: forall c. LspFuncs c -> IO (Maybe c)
sendFunc :: forall c. LspFuncs c -> SendFunc
getVirtualFileFunc :: forall c. LspFuncs c -> NormalizedUri -> IO (Maybe VirtualFile)
persistVirtualFileFunc :: forall c. LspFuncs c -> NormalizedUri -> IO (Maybe FilePath)
reverseFileMapFunc :: forall c. LspFuncs c -> IO (FilePath -> FilePath)
publishDiagnosticsFunc :: forall c. LspFuncs c -> PublishDiagnosticsFunc
flushDiagnosticsBySourceFunc :: forall c. LspFuncs c -> FlushDiagnosticsBySourceFunc
getNextReqId :: forall c. LspFuncs c -> IO LspId
rootPath :: forall c. LspFuncs c -> Maybe FilePath
getWorkspaceFolders :: forall c. LspFuncs c -> IO (Maybe [WorkspaceFolder])
withProgress :: forall c.
LspFuncs c
-> forall a.
   Text
   -> ProgressCancellable -> ((Progress -> IO ()) -> IO a) -> IO a
withIndefiniteProgress :: forall c.
LspFuncs c -> forall a. Text -> ProgressCancellable -> IO a -> IO a
..} IdeState
ide = do
            LspId
lspId <- IO LspId
getNextReqId
            IdeOptions
opts <- ShakeExtras -> IO IdeOptions
getIdeOptionsIO (ShakeExtras -> IO IdeOptions) -> ShakeExtras -> IO IdeOptions
forall a b. (a -> b) -> a -> b
$ IdeState -> ShakeExtras
shakeExtras IdeState
ide
            let
              req :: RequestMessage ServerMethod RegistrationParams resp
req = Text
-> LspId
-> ServerMethod
-> RegistrationParams
-> RequestMessage ServerMethod RegistrationParams resp
forall m req resp.
Text -> LspId -> m -> req -> RequestMessage m req resp
RequestMessage Text
"2.0" LspId
lspId ServerMethod
ClientRegisterCapability RegistrationParams
regParams
              regParams :: RegistrationParams
regParams    = List Registration -> RegistrationParams
RegistrationParams ([Registration] -> List Registration
forall a. [a] -> List a
List [Registration
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
registration = Text -> ClientMethod -> Maybe Value -> Registration
Registration Text
"globalFileWatches"
                                          ClientMethod
WorkspaceDidChangeWatchedFiles
                                          (Value -> Maybe Value
forall a. a -> Maybe a
Just (DidChangeWatchedFilesRegistrationOptions -> Value
forall a. ToJSON a => a -> Value
A.toJSON 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
False, $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 :: FilePath -> FileSystemWatcher
watcher FilePath
glob = FileSystemWatcher :: FilePath -> Maybe WatchKind -> FileSystemWatcher
FileSystemWatcher { $sel:_globPattern:FileSystemWatcher :: FilePath
_globPattern = FilePath
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 = [ FilePath -> FileSystemWatcher
watcher FilePath
glob | FilePath
glob <- IdeOptions -> [FilePath]
watchedGlobs IdeOptions
opts ]

            SendFunc
sendFunc SendFunc -> SendFunc
forall a b. (a -> b) -> a -> b
$ RegisterCapabilityRequest -> FromServerMessage
LSP.ReqRegisterCapability RegisterCapabilityRequest
forall resp. RequestMessage ServerMethod RegistrationParams resp
req