1 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE LambdaCase #-}
5 import qualified Language.Haskell.LSP.TH.DataTypesJSON as LSP
6 import qualified Language.Haskell.LSP.TH.ClientCapabilities as LSP
7 import qualified LSP.Client as Client
9 import qualified Data.Text.IO as T
10 import Control.Concurrent
15 import System.Environment
16 import System.Directory
19 import qualified Compat
23 progName <- getProgName
26 when (length args /= 1) $ do
27 hPutStrLn stderr ("This program expects one argument: " ++ progName ++ " FILEPATH")
32 exists <- doesFileExist path
34 hPutStrLn stderr ("File does not exist: " ++ path)
37 file <- canonicalizePath path
41 let caps = LSP.ClientCapabilities (Just workspaceCaps) (Just textDocumentCaps) Nothing
42 workspaceCaps = LSP.WorkspaceClientCapabilities
44 (Just (LSP.WorkspaceEditClientCapabilities (Just False)))
45 (Just (LSP.DidChangeConfigurationClientCapabilities (Just False)))
46 (Just (LSP.DidChangeWatchedFilesClientCapabilities (Just False)))
47 (Just (LSP.SymbolClientCapabilities (Just False)))
48 (Just (LSP.ExecuteClientCapabilities (Just False)))
49 textDocumentCaps = LSP.TextDocumentClientCapabilities
50 (Just (LSP.SynchronizationTextDocumentClientCapabilities
55 (Just (LSP.CompletionClientCapabilities
57 (Just (LSP.CompletionItemClientCapabilities (Just False)))))
58 (Just (LSP.HoverClientCapabilities (Just False)))
59 (Just (LSP.SignatureHelpClientCapabilities (Just False)))
60 (Just (LSP.ReferencesClientCapabilities (Just False)))
61 (Just (LSP.DocumentHighlightClientCapabilities (Just False)))
62 (Just (LSP.DocumentSymbolClientCapabilities (Just False)))
63 (Just (LSP.FormattingClientCapabilities (Just False)))
64 (Just (LSP.RangeFormattingClientCapabilities (Just False)))
65 (Just (LSP.OnTypeFormattingClientCapabilities (Just False)))
66 (Just (LSP.DefinitionClientCapabilities (Just False)))
67 (Just (LSP.CodeActionClientCapabilities (Just False)))
68 (Just (LSP.CodeLensClientCapabilities (Just False)))
69 (Just (LSP.DocumentLinkClientCapabilities (Just False)))
70 (Just (LSP.RenameClientCapabilities (Just False)))
72 initializeParams :: LSP.InitializeParams
73 initializeParams = LSP.InitializeParams (Just pid) Nothing Nothing Nothing caps Nothing
76 (Just inp, Just out, _, _) <- createProcess (proc "hie" ["--lsp", "-l", "/tmp/hie.log", "--debug"])
77 {std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe}
79 client <- Client.start (Client.Config inp out testNotificationMessageHandler testRequestMessageHandler)
81 Client.sendClientRequest client (Proxy :: Proxy LSP.InitializeRequest) LSP.Initialize initializeParams
83 Client.sendClientNotification client LSP.Initialized (Just LSP.InitializedParams)
85 txt <- T.readFile file
87 let uri = LSP.filePathToUri file
89 Client.sendClientNotification client LSP.TextDocumentDidOpen (Just (LSP.DidOpenTextDocumentParams (LSP.TextDocumentItem uri "haskell" 1 txt)))
91 Client.sendClientRequest
93 (Proxy :: Proxy LSP.DefinitionRequest)
94 LSP.TextDocumentDefinition
95 (LSP.TextDocumentPositionParams (LSP.TextDocumentIdentifier uri) (LSP.Position 88 36)) >>= \case
96 Just (Right pos) -> print pos
97 _ -> putStrLn "Server couldn't give us defnition position"
99 Client.sendClientRequest client (Proxy :: Proxy LSP.DocumentSymbolRequest) LSP.TextDocumentDocumentSymbol (LSP.DocumentSymbolParams (LSP.TextDocumentIdentifier uri))
101 Just (Right as) -> mapM_ T.putStrLn (as ^.. traverse . LSP.name)
102 _ -> putStrLn "Server couldn't give us document symbol information"
104 Client.sendClientRequest client (Proxy :: Proxy LSP.ShutdownRequest) LSP.Shutdown Nothing
105 Client.sendClientNotification client LSP.Exit (Just LSP.ExitParams)
109 testRequestMessageHandler :: Client.RequestMessageHandler
110 testRequestMessageHandler = Client.RequestMessageHandler
111 (\m -> emptyResponse m <$ print m)
112 (\m -> emptyResponse m <$ print m)
113 (\m -> emptyResponse m <$ print m)
114 (\m -> emptyResponse m <$ print m)
116 toRspId (LSP.IdInt i) = LSP.IdRspInt i
117 toRspId (LSP.IdString t) = LSP.IdRspString t
119 emptyResponse :: LSP.RequestMessage m req resp -> LSP.ResponseMessage a
120 emptyResponse m = LSP.ResponseMessage (m ^. LSP.jsonrpc) (toRspId (m ^. LSP.id)) Nothing Nothing
122 testNotificationMessageHandler :: Client.NotificationMessageHandler
123 testNotificationMessageHandler = Client.NotificationMessageHandler
124 (T.putStrLn . view (LSP.params . LSP.message))
125 (T.putStrLn . view (LSP.params . LSP.message))
126 (print . view LSP.params)
127 (mapM_ T.putStrLn . (^.. LSP.params . LSP.diagnostics . traverse . LSP.message))