Handle File Events

language-server/lambdananas-language-server.cabal

@@ -26,6 +26,7 @@ library
       Lambdananas.LanguageServer.Diagnostic
       Lambdananas.LanguageServer.Events
       Lambdananas.LanguageServer.Events.CodeAction
+      Lambdananas.LanguageServer.Events.FileEvents
       Lambdananas.LanguageServer.Events.Init
       Lambdananas.LanguageServer.Events.PullDiagnostics
       Lambdananas.LanguageServer.Events.Save

language-server/src/Lambdananas/LanguageServer/Events.hs

@@ -1,6 +1,7 @@
 module Lambdananas.LanguageServer.Events (eventHandlers) where
 
 import Lambdananas.LanguageServer.Events.CodeAction (onCodeActionRequest)
+import Lambdananas.LanguageServer.Events.FileEvents (onDelete, onFileEvent, onRename)
 import Lambdananas.LanguageServer.Events.Init
 import Lambdananas.LanguageServer.Events.PullDiagnostics (onPullDiagnostics)
 import Lambdananas.LanguageServer.Events.Save
@@ -16,4 +17,7 @@ eventHandlers =
         , onSave
         , onPullDiagnostics
         , onCodeActionRequest
+        , onFileEvent
+        , onDelete
+        , onRename
         ]

language-server/src/Lambdananas/LanguageServer/Events/FileEvents.hs

@@ -0,0 +1,46 @@
+module Lambdananas.LanguageServer.Events.FileEvents (
+    onDelete,
+    onFileEvent,
+    onRename,
+) where
+
+import Control.Lens
+import Control.Monad
+import Lambdananas.LanguageServer.Diagnostic
+import Lambdananas.LanguageServer.Logging (debugLog)
+import Lambdananas.LanguageServer.Monad (LSM, withState)
+import Lambdananas.LanguageServer.State (moveDiagnostics, removeDiagnsotics)
+import Language.LSP.Protocol.Lens
+import Language.LSP.Protocol.Message (SMethod (..))
+import Language.LSP.Protocol.Types
+import Language.LSP.Server
+
+onFileEvent :: Handlers LSM
+onFileEvent = notificationHandler SMethod_WorkspaceDidChangeWatchedFiles $ \notif -> do
+    debugLog "Received 'workspace changed' notification"
+    let events = notif ^. params . changes
+    forM_ events $ \e -> do
+        let eventUri = e ^. uri
+        let removeUriFromState u = do
+                withState (\s -> ((), removeDiagnsotics u s))
+                emitDiagnostics (toNormalizedUri u) []
+        case e ^. type_ of
+            FileChangeType_Deleted -> removeUriFromState eventUri
+            FileChangeType_Changed -> removeUriFromState eventUri
+            _ -> return ()
+
+onDelete :: Handlers LSM
+onDelete = notificationHandler SMethod_WorkspaceDidDeleteFiles $ \notif -> do
+    debugLog "Received 'file deletion' notification"
+    let deletedUris = Uri . (^. uri) <$> notif ^. params . files
+    withState (\state -> ((), foldr removeDiagnsotics state deletedUris))
+    -- Flushing diagnostics for the old uri
+    forM_ deletedUris (\u -> emitDiagnostics (toNormalizedUri u) [])
+
+onRename :: Handlers LSM
+onRename = notificationHandler SMethod_WorkspaceDidRenameFiles $ \notif -> do
+    debugLog "Received 'file rename' notification"
+    let renamedUris = (\(FileRename old new) -> (Uri old, Uri new)) <$> notif ^. params . files
+    withState (\state -> ((), foldr (uncurry moveDiagnostics) state renamedUris))
+    -- Flushing diagnostics for the old uris
+    forM_ renamedUris (\(u, _) -> emitDiagnostics (toNormalizedUri u) [])

language-server/src/Lambdananas/LanguageServer/Monad.hs

@@ -2,6 +2,7 @@ module Lambdananas.LanguageServer.Monad (
     LSM,
     getState,
     setState,
+    withState,
     getCodingStyleWarningForFile,
 ) where
 
@@ -30,3 +31,10 @@ getCodingStyleWarningForFile uri = do
     case uriToFilePath uri of
         Nothing -> return []
         Just filePath -> return $ fromMaybe [] $ lookup filePath state
+
+withState :: (State -> (a, State)) -> LSM a
+withState f = do
+    state <- getState
+    let (res, newState) = f state
+    setState newState
+    return res

language-server/src/Lambdananas/LanguageServer/State.hs

@@ -1,6 +1,24 @@
-module Lambdananas.LanguageServer.State (State) where
+module Lambdananas.LanguageServer.State (State, removeDiagnsotics, moveDiagnostics) where
 
+import Data.Maybe (fromMaybe)
 import Lambdananas.Wrapper.Warn
+import Language.LSP.Protocol.Types
 
 -- | Note: We expect 'FilePath' to be absolute
 type State = [(FilePath, [CodingStyleWarning])]
+
+removeDiagnsotics :: Uri -> State -> State
+removeDiagnsotics uri state = case uriToFilePath uri of
+    Nothing -> state
+    Just fp -> filter (\(key, _) -> key /= fp) state
+
+moveDiagnostics :: Uri -> Uri -> State -> State
+moveDiagnostics fromUri toUri state = fromMaybe state $ do
+    fromFilePath <- uriToFilePath fromUri
+    toFilePath <- uriToFilePath toUri
+    return $ replace fromFilePath toFilePath state
+  where
+    replace from to (a : b)
+        | fst a == from = (to, snd a) : b
+        | otherwise = a : replace from to b
+    replace _ _ [] = []

vscode/README.md

@@ -8,3 +8,9 @@ The follow binaries should be in your `PATH`:
 - `lambdananas-language-server`
 
 Go [here](https://github.com/Arthi-chaud/lambdananas-language-server) for installation instruction
+
+## Changelog
+
+### 0.1.0
+
+- Send File Events to Language Server

vscode/package.json

@@ -2,7 +2,7 @@
   "name": "lambdananas-coding-style-checker",
   "displayName": "Lambdananas for VSCode",
   "description": "VSCode Extension for the Lambdananas Coding Style Checker",
-  "version": "0.0.1",
+  "version": "0.1.0",
   "engines": {
     "vscode": "^1.95.0"
   },

vscode/src/extension.ts

@@ -9,7 +9,6 @@ import {
   env,
   window,
   OutputChannel,
-  languages,
 } from "vscode";
 
 import {
@@ -138,7 +137,9 @@ export function activateForFolder(
   const pattern = folder ? `${folder.uri.fsPath}/**/*` : "**/*";
   const clientOptions: LanguageClientOptions = {
     documentSelector: [{ scheme: "file", language: "haskell", pattern }],
-    synchronize: {},
+    synchronize: {
+      fileEvents: workspace.createFileSystemWatcher("**/*.hs")
+    },
     outputChannel,
     outputChannelName: clientName,
     diagnosticCollectionName: clientName,