1 {-# LANGUAGE OverloadedStrings #-}
2 module Language.Haskell.LSP.Test
12 import Control.Monad.IO.Class
13 import Control.Monad.Trans.Reader
14 import qualified Data.Text as T
15 import qualified Data.Text.IO as T
19 import qualified Language.Haskell.LSP.Client as Client
20 import qualified Language.Haskell.LSP.TH.DataTypesJSON as LSP
24 type Session = ReaderT Client.Client IO
26 session :: Session a -> IO ()
28 (Just hin, Just hout, _, serverProc) <- createProcess (proc "hie" ["--lsp", "-l", "/tmp/hie.log"])
29 { std_in = CreatePipe, std_out = CreatePipe }
30 client <- Client.start $ Client.Config hin hout notificationHandler requestHandler
34 let initializeParams :: LSP.InitializeParams
35 initializeParams = LSP.InitializeParams (Just pid)
42 Client.sendClientRequest client
43 (Proxy :: Proxy LSP.InitializeRequest)
44 LSP.Initialize initializeParams
45 Client.sendClientNotification client
47 (Just LSP.InitializedParams)
49 putStrLn "Session started"
53 Client.sendClientRequest client
54 (Proxy :: Proxy LSP.ShutdownRequest)
56 Client.sendClientNotification client
62 -- todo: this interrupts the test server process as well?
63 -- interruptProcessGroupOf serverProc
64 -- waitForProcess serverProc
65 terminateProcess serverProc
67 putStrLn "Session ended"
69 openDocument :: FilePath -> Session ()
70 openDocument path = do
71 text <- liftIO $ T.readFile path
73 let uri = LSP.filePathToUri path
76 liftIO $ Client.sendClientNotification client LSP.TextDocumentDidOpen (Just (LSP.DidOpenTextDocumentParams (LSP.TextDocumentItem uri "haskell" 1 text)))
78 documentSymbols :: FilePath -> Session (LSP.List LSP.SymbolInformation)
79 documentSymbols path = do
80 let uri = LSP.filePathToUri path
85 res <- Client.sendClientRequest client
86 (Proxy :: Proxy LSP.DocumentSymbolRequest)
87 LSP.TextDocumentDocumentSymbol (LSP.DocumentSymbolParams (LSP.TextDocumentIdentifier uri))
89 Just (Right syms) -> syms
90 _ -> error "Failed to get document symbols"
92 notificationHandler :: Client.NotificationMessageHandler
93 notificationHandler = Client.NotificationMessageHandler
94 (\(LSP.NotificationMessage _ _ (LSP.ShowMessageParams _ msg)) -> print msg)
95 (\(LSP.NotificationMessage _ _ (LSP.LogMessageParams _ msg)) -> print msg)
96 (\(LSP.NotificationMessage _ _ json) -> putStrLn $ "Telemetry: " ++ show json)
97 (\(LSP.NotificationMessage _ _ (LSP.PublishDiagnosticsParams uri diags)) ->
98 putStrLn $ "Diagnostics at " ++ showUri uri ++ ": " ++ showDiags diags)
100 where showDiags :: LSP.List LSP.Diagnostic -> String
101 showDiags (LSP.List diags) = unlines $ map (T.unpack . (^. LSP.message)) diags
102 showUri :: LSP.Uri -> String
103 showUri = fromMaybe "unknown path" . LSP.uriToFilePath
107 requestHandler :: Client.RequestMessageHandler
108 requestHandler = Client.RequestMessageHandler
109 (\m -> emptyRsp m <$ print m)
110 (\m -> emptyRsp m <$ print m)
111 (\m -> emptyRsp m <$ print m)
112 (\m -> emptyRsp m <$ print m)
113 where emptyRsp :: LSP.RequestMessage m req rsp -> LSP.ResponseMessage a
114 emptyRsp m = LSP.ResponseMessage (m ^. LSP.jsonrpc)
115 (lspIdToRspId $ m ^. LSP.id)
119 lspIdToRspId (LSP.IdInt i) = LSP.IdRspInt i
120 lspIdToRspId (LSP.IdString i) = LSP.IdRspString i