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 Language.Haskell.LSP.Messages
21 import qualified Language.Haskell.LSP.TH.DataTypesJSON as LSP
22 import Language.Haskell.LSP.Test.Recorded
26 type Session = ReaderT Client.Client IO
28 manualSession :: Session a -> IO ()
30 (Just hin, Just hout, _, serverProc) <- createProcess (proc "hie" ["--lsp", "-l", "/tmp/hie.log"])
31 { std_in = CreatePipe, std_out = CreatePipe }
32 client <- Client.start $ Client.Config hin hout notificationHandler requestHandler
36 let initializeParams :: LSP.InitializeParams
37 initializeParams = LSP.InitializeParams (Just pid)
44 Client.sendClientRequest client
45 (Proxy :: Proxy LSP.InitializeRequest)
46 LSP.Initialize initializeParams
47 Client.sendClientNotification client
49 (Just LSP.InitializedParams)
51 putStrLn "Session started"
55 Client.sendClientRequest client
56 (Proxy :: Proxy LSP.ShutdownRequest)
58 Client.sendClientNotification client
64 -- todo: this interrupts the test server process as well?
65 -- interruptProcessGroupOf serverProc
66 -- waitForProcess serverProc
67 terminateProcess serverProc
69 putStrLn "Session ended"
71 openDocument :: FilePath -> Session ()
72 openDocument path = do
73 text <- liftIO $ T.readFile path
75 let uri = LSP.filePathToUri path
78 liftIO $ Client.sendClientNotification client LSP.TextDocumentDidOpen (Just (LSP.DidOpenTextDocumentParams (LSP.TextDocumentItem uri "haskell" 1 text)))
80 documentSymbols :: FilePath -> Session (LSP.List LSP.SymbolInformation)
81 documentSymbols path = do
82 let uri = LSP.filePathToUri path
87 res <- Client.sendClientRequest client
88 (Proxy :: Proxy LSP.DocumentSymbolRequest)
89 LSP.TextDocumentDocumentSymbol (LSP.DocumentSymbolParams (LSP.TextDocumentIdentifier uri))
91 Just (Right syms) -> syms
92 _ -> error "Failed to get document symbols"
94 notificationHandler :: Client.NotificationMessageHandler
95 notificationHandler = Client.NotificationMessageHandler
96 (\(LSP.NotificationMessage _ _ (LSP.ShowMessageParams _ msg)) -> print msg)
97 (\(LSP.NotificationMessage _ _ (LSP.LogMessageParams _ msg)) -> print msg)
98 (\(LSP.NotificationMessage _ _ json) -> putStrLn $ "Telemetry: " ++ show json)
99 (\(LSP.NotificationMessage _ _ (LSP.PublishDiagnosticsParams uri diags)) ->
100 putStrLn $ "Diagnostics at " ++ showUri uri ++ ": " ++ showDiags diags)
102 where showDiags :: LSP.List LSP.Diagnostic -> String
103 showDiags (LSP.List diags) = unlines $ map (T.unpack . (^. LSP.message)) diags
104 showUri :: LSP.Uri -> String
105 showUri = fromMaybe "unknown path" . LSP.uriToFilePath
109 requestHandler :: Client.RequestMessageHandler
110 requestHandler = Client.RequestMessageHandler
111 (\m -> emptyRsp m <$ print m)
112 (\m -> emptyRsp m <$ print m)
113 (\m -> emptyRsp m <$ print m)
114 (\m -> emptyRsp m <$ print m)
115 where emptyRsp :: LSP.RequestMessage m req rsp -> LSP.ResponseMessage a
116 emptyRsp m = LSP.ResponseMessage (m ^. LSP.jsonrpc)
117 (lspIdToRspId $ m ^. LSP.id)
121 lspIdToRspId (LSP.IdInt i) = LSP.IdRspInt i
122 lspIdToRspId (LSP.IdString i) = LSP.IdRspString i