{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
module Development.IDE.LSP.Notifications
( whenUriFile
, descriptor
) where
import Language.LSP.Types
import qualified Language.LSP.Types 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.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 (registerFileWatches,
resetFileStore,
setFileModified,
setSomethingModified,
typecheckParents)
import Development.IDE.Core.OfInterest
import Development.IDE.Core.RuleTypes (GetClientSettings (..))
import Development.IDE.Types.Shake (toKey)
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
IdeState -> NormalizedFilePath -> FileOfInterestStatus -> IO ()
addFileOfInterest IdeState
ide 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 -> NormalizedFilePath -> FileOfInterestStatus -> IO ()
addFileOfInterest IdeState
ide 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 -> NormalizedFilePath -> FileOfInterestStatus -> IO ()
addFileOfInterest IdeState
ide 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 -> NormalizedFilePath -> IO ()
deleteFileOfInterest IdeState
ide NormalizedFilePath
file
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
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 -> [SomeShakeValue] -> 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 -> [SomeShakeValue] -> IO ()
setSomethingModified IdeState
ide [GetClientSettings -> NormalizedFilePath -> SomeShakeValue
forall k. ShakeValue k => k -> NormalizedFilePath -> SomeShakeValue
toKey GetClientSettings
GetClientSettings NormalizedFilePath
emptyFilePath ]
, 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
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
$ IdeState -> IO ()
shakeSessionInit IdeState
ide
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 globs :: [FilePath]
globs = IdeOptions -> [FilePath]
watchedGlobs IdeOptions
opts
Bool
success <- [FilePath] -> LspT Config IO Bool
registerFileWatches [FilePath]
globs
Bool -> LspT Config IO () -> LspT Config IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
success (LspT Config IO () -> LspT Config IO ())
-> LspT Config IO () -> LspT Config IO ()
forall a b. (a -> b) -> a -> b
$
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"
]
}