{-# LANGUAGE OverloadedStrings #-}
import Data.Aeson
import Data.Default
+import Data.List (isSuffixOf)
import qualified Data.HashMap.Strict as HM
import Language.Haskell.LSP.Core
import Language.Haskell.LSP.Control
import Language.Haskell.LSP.Types
import Control.Concurrent
import Control.Monad
+import System.Directory
+import System.FilePath
main = do
lfvar <- newEmptyMVar
Nothing
SkObject
Nothing
- (Range (Position 0 0) (Position 0 1))
- (Range (Position 0 0) (Position 0 1))
+ (mkRange 0 0 3 6)
+ (mkRange 0 0 3 6)
Nothing
]
- , didOpenTextDocumentNotificationHandler = pure $ \noti ->
- void $ forkIO $ do
- threadDelay (2 * 10^6)
+ , didOpenTextDocumentNotificationHandler = pure $ \noti -> do
let NotificationMessage _ _ (DidOpenTextDocumentParams doc) = noti
TextDocumentItem uri _ _ _ = doc
- diag = Diagnostic (Range (Position 0 0) (Position 0 1))
+ Just fp = uriToFilePath uri
+ diag = Diagnostic (mkRange 0 0 0 1)
(Just DsWarning)
(Just (NumberValue 42))
(Just "dummy-server")
"Here's a warning"
Nothing
Nothing
+ when (".hs" `isSuffixOf` fp) $ void $ forkIO $ do
+ threadDelay (2 * 10^6)
send $ NotPublishDiagnostics $
fmServerPublishDiagnosticsNotification $ PublishDiagnosticsParams uri $ List [diag]
+
+ -- also act as a registerer for workspace/didChangeWatchedFiles
+ when (".register" `isSuffixOf` fp) $ do
+ reqId <- readMVar lfvar >>= getNextReqId
+ send $ ReqRegisterCapability $ fmServerRegisterCapabilityRequest reqId $
+ RegistrationParams $ List $
+ [ Registration "0" WorkspaceDidChangeWatchedFiles $ Just $ toJSON $
+ DidChangeWatchedFilesRegistrationOptions $ List
+ [ FileSystemWatcher "*.watch" (Just (WatchKind True True True)) ]
+ ]
+ when (".register.abs" `isSuffixOf` fp) $ do
+ curDir <- getCurrentDirectory
+ reqId <- readMVar lfvar >>= getNextReqId
+ send $ ReqRegisterCapability $ fmServerRegisterCapabilityRequest reqId $
+ RegistrationParams $ List $
+ [ Registration "1" WorkspaceDidChangeWatchedFiles $ Just $ toJSON $
+ DidChangeWatchedFilesRegistrationOptions $ List
+ [ FileSystemWatcher (curDir </> "*.watch") (Just (WatchKind True True True)) ]
+ ]
+
+ -- also act as an unregisterer for workspace/didChangeWatchedFiles
+ when (".unregister" `isSuffixOf` fp) $ do
+ reqId <- readMVar lfvar >>= getNextReqId
+ send $ ReqUnregisterCapability $ fmServerUnregisterCapabilityRequest reqId $
+ UnregistrationParams $ List [ Unregistration "0" "workspace/didChangeWatchedFiles" ]
+ when (".unregister.abs" `isSuffixOf` fp) $ do
+ reqId <- readMVar lfvar >>= getNextReqId
+ send $ ReqUnregisterCapability $ fmServerUnregisterCapabilityRequest reqId $
+ UnregistrationParams $ List [ Unregistration "1" "workspace/didChangeWatchedFiles" ]
, executeCommandHandler = pure $ \req -> do
send $ RspExecuteCommand $ makeResponseMessage req Null
reqId <- readMVar lfvar >>= getNextReqId
let RequestMessage _ _ _ (ExecuteCommandParams "doAnEdit" (Just (List [val])) _) = req
Success docUri = fromJSON val
- edit = List [TextEdit (Range (Position 0 0) (Position 0 5)) "howdy"]
+ edit = List [TextEdit (mkRange 0 0 0 5) "howdy"]
send $ ReqApplyWorkspaceEdit $ fmServerApplyWorkspaceEditRequest reqId $
ApplyWorkspaceEditParams $ WorkspaceEdit (Just (HM.singleton docUri edit))
Nothing
Nothing
(Just (Command "" "deleteThis" Nothing))
send $ RspCodeAction $ makeResponseMessage req caresults
+ , didChangeWatchedFilesNotificationHandler = pure $ \_ ->
+ send $ NotLogMessage $ fmServerLogMessageNotification MtLog "got workspace/didChangeWatchedFiles"
+ , completionHandler = pure $ \req -> do
+ let res = CompletionList (CompletionListType False (List [item]))
+ item =
+ CompletionItem "foo" (Just CiConstant) (Just (List [])) Nothing
+ Nothing Nothing Nothing Nothing Nothing Nothing Nothing
+ Nothing Nothing Nothing Nothing Nothing
+ send $ RspCompletion $ makeResponseMessage req res
}
where send msg = readMVar lfvar >>= \lf -> (sendFunc lf) msg
+
+mkRange sl sc el ec = Range (Position sl sc) (Position el ec)