1 {-# LANGUAGE DataKinds #-}
2 {-# LANGUAGE OverloadedStrings #-}
5 import Control.Monad.Reader
8 import qualified Data.HashMap.Strict as HM
9 import Data.List (isSuffixOf)
10 import Language.Haskell.LSP.Control
11 import Language.Haskell.LSP.Core
12 import Language.Haskell.LSP.Types
13 import System.Directory
14 import System.FilePath
16 import UnliftIO.Concurrent
19 handlerEnv <- HandlerEnv <$> newEmptyMVar <*> newEmptyMVar
22 { doInitialize = \env _req -> pure $ Right env,
23 onConfigurationChange = const $ pure $ Right (),
24 staticHandlers = handlers,
25 interpretHandler = \env ->
27 (\m -> runLspT env (runReaderT m handlerEnv))
30 options = def {executeCommandCommands = Just ["doAnEdit"]}
33 data HandlerEnv = HandlerEnv
34 { relRegToken :: MVar (RegistrationToken WorkspaceDidChangeWatchedFiles),
35 absRegToken :: MVar (RegistrationToken WorkspaceDidChangeWatchedFiles)
38 handlers :: Handlers (ReaderT HandlerEnv (LspM ()))
41 [ notificationHandler SInitialized $
43 sendNotification SWindowLogMessage $
44 LogMessageParams MtLog "initialized",
45 requestHandler STextDocumentHover $
50 Hover (HoverContents (MarkupContent MkPlainText "hello")) Nothing,
51 requestHandler STextDocumentDocumentSymbol $
66 notificationHandler STextDocumentDidOpen $
68 let NotificationMessage _ _ (DidOpenTextDocumentParams doc) = noti
69 TextDocumentItem uri _ _ _ = doc
70 Just fp = uriToFilePath uri
82 when (".hs" `isSuffixOf` fp) $
86 threadDelay (2 * 10 ^ 6)
88 sendNotification STextDocumentPublishDiagnostics $
89 PublishDiagnosticsParams uri Nothing (List [diag])
90 -- also act as a registerer for workspace/didChangeWatchedFiles
91 when (".register" `isSuffixOf` fp) $
94 DidChangeWatchedFilesRegistrationOptions $
98 (Just (WatchKind True True True))
100 Just token <- runInIO $
101 registerCapability SWorkspaceDidChangeWatchedFiles regOpts $
103 sendNotification SWindowLogMessage $
104 LogMessageParams MtLog "got workspace/didChangeWatchedFiles"
105 runInIO $ asks relRegToken >>= \v -> putMVar v token
106 when (".register.abs" `isSuffixOf` fp) $
108 curDir <- getCurrentDirectory
110 DidChangeWatchedFilesRegistrationOptions $
113 (curDir </> "*.watch")
114 (Just (WatchKind True True True))
116 Just token <- runInIO $
117 registerCapability SWorkspaceDidChangeWatchedFiles regOpts $
119 sendNotification SWindowLogMessage $
120 LogMessageParams MtLog "got workspace/didChangeWatchedFiles"
121 runInIO $ asks absRegToken >>= \v -> putMVar v token
122 -- also act as an unregisterer for workspace/didChangeWatchedFiles
123 when (".unregister" `isSuffixOf` fp) $
125 Just token <- runInIO $ asks relRegToken >>= tryReadMVar
126 runInIO $ unregisterCapability token
127 when (".unregister.abs" `isSuffixOf` fp) $
129 Just token <- runInIO $ asks absRegToken >>= tryReadMVar
130 runInIO $ unregisterCapability token,
131 requestHandler SWorkspaceExecuteCommand $ \req resp -> do
132 let RequestMessage _ _ _ (ExecuteCommandParams Nothing "doAnEdit" (Just (List [val]))) = req
133 Success docUri = fromJSON val
134 edit = List [TextEdit (mkRange 0 0 0 5) "howdy"]
136 ApplyWorkspaceEditParams (Just "Howdy edit") $
137 WorkspaceEdit (Just (HM.singleton docUri edit)) Nothing
139 void $ sendRequest SWorkspaceApplyEdit params (const (pure ())),
140 requestHandler STextDocumentCodeAction $ \req resp -> do
141 let RequestMessage _ _ _ params = req
142 CodeActionParams _ _ _ _ cactx = params
143 CodeActionContext diags _ = cactx
144 codeActions = fmap diag2ca diags
152 (Just (Command "" "deleteThis" Nothing))
153 resp $ Right $ InR <$> codeActions,
154 requestHandler STextDocumentCompletion $ \_req resp -> do
155 let res = CompletionList True (List [item])
174 resp $ Right $ InR res