+-- File watching
+
+processFileWatchRegistration :: (MonadIO m, HasReader SessionContext m, HasState SessionState m)
+ => T.Text -> Registration -> m ()
+processFileWatchRegistration regId reg = do
+ mgr <- asks watchManager
+ let mOpts = do
+ regOpts <- reg ^. registerOptions
+ case fromJSON regOpts of
+ Error _ -> Nothing
+ Success x -> Just x
+ case mOpts of
+ Nothing -> pure ()
+ Just (DidChangeWatchedFilesRegistrationOptions (List ws)) ->
+ forM_ ws $ \(FileSystemWatcher pat' watchKind) -> do
+ pat <- liftIO $ canonicalizePath pat'
+ let glob = compile pat
+ -- the root-most dir before any globbing stuff happens
+ dir = fst $ commonDirectory glob
+ pred = match glob . eventPath
+ -- If no watchKind specified, spec defaults to all true
+ WatchKind wkC wkM wkD = fromMaybe (WatchKind True True True) watchKind
+ handle <- asks serverIn
+ unwatch <- liftIO $ watchTree mgr dir pred $ \event -> do
+ let fe = FileEvent (filePathToUri (eventPath event)) typ
+ typ = case event of
+ FS.Added _ _ _ -> FcCreated
+ FS.Modified _ _ _ -> FcChanged
+ FS.Removed _ _ _ -> FcDeleted
+ -- This is a bit of a guess
+ FS.Unknown _ _ _ -> FcChanged
+ matches = case typ of
+ FcCreated -> wkC
+ FcChanged -> wkM
+ FcDeleted -> wkD
+ params = DidChangeWatchedFilesParams (List [fe])
+ msg = fmClientDidChangeWatchedFilesNotification params
+ liftIO $ when matches $ B.hPut handle (addHeader $ encode msg)
+ modify $ \s ->
+ s { unwatchers = Map.insertWith (++) regId [unwatch] (unwatchers s) }
+
+processFileWatchUnregistrations :: (MonadIO m, HasReader SessionContext m, HasState SessionState m)
+ => [T.Text] -> m ()
+processFileWatchUnregistrations regIds =
+ forM_ regIds $ \regId -> modifyM $ \s -> do
+ let fs = fromMaybe [] (Map.lookup regId (unwatchers s))
+ liftIO $ sequence fs
+ return $ s { unwatchers = Map.delete regId (unwatchers s) }