src/Language/Haskell/LSP/Test.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 module Language.Haskell.LSP.Test
   3   (
   4   -- * Sessions
   5     session
   6   -- * Documents
   7   , openDocument
   8   , documentSymbols
   9   ) where
  10
  11 import Control.Lens
  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
  16 import Data.Maybe
  17 import Data.Proxy
  18 import System.Process
  19 import qualified Language.Haskell.LSP.Client as Client
  20 import qualified Language.Haskell.LSP.TH.DataTypesJSON as LSP
  21 import Capabilities
  22 import Compat
  23
  24 type Session = ReaderT Client.Client IO
  25
  26 session :: Session a -> IO ()
  27 session f = do
  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
  31
  32   pid <- getProcessID
  33
  34   let initializeParams :: LSP.InitializeParams
  35       initializeParams = LSP.InitializeParams (Just pid)
  36                                               Nothing
  37                                               Nothing
  38                                               Nothing
  39                                               capabilities
  40                                               Nothing
  41
  42   Client.sendClientRequest client
  43                            (Proxy :: Proxy LSP.InitializeRequest)
  44                            LSP.Initialize initializeParams
  45   Client.sendClientNotification client
  46                                 LSP.Initialized
  47                                 (Just LSP.InitializedParams)
  48
  49   putStrLn "Session started"
  50
  51   runReaderT f client
  52
  53   Client.sendClientRequest client
  54                            (Proxy :: Proxy LSP.ShutdownRequest)
  55                            LSP.Shutdown Nothing
  56   Client.sendClientNotification client
  57                                 LSP.Exit
  58                                 (Just LSP.ExitParams)
  59
  60   Client.stop client
  61
  62   -- todo: this interrupts the test server process as well?
  63   -- interruptProcessGroupOf serverProc
  64   -- waitForProcess serverProc
  65   terminateProcess serverProc
  66
  67   putStrLn "Session ended"
  68
  69 openDocument :: FilePath -> Session ()
  70 openDocument path = do
  71   text <- liftIO $ T.readFile path
  72
  73   let uri = LSP.filePathToUri path
  74
  75   client <- ask
  76   liftIO $ Client.sendClientNotification client LSP.TextDocumentDidOpen (Just (LSP.DidOpenTextDocumentParams (LSP.TextDocumentItem uri "haskell" 1 text)))
  77
  78 documentSymbols :: FilePath -> Session (LSP.List LSP.SymbolInformation)
  79 documentSymbols path = do
  80   let uri = LSP.filePathToUri path
  81
  82   client <- ask
  83
  84   liftIO $ do
  85     res <- Client.sendClientRequest client
  86                                     (Proxy :: Proxy LSP.DocumentSymbolRequest)
  87                                     LSP.TextDocumentDocumentSymbol (LSP.DocumentSymbolParams (LSP.TextDocumentIdentifier uri))
  88     return $ case res of
  89       Just (Right syms) -> syms
  90       _ -> error "Failed to get document symbols"
  91
  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)
  99
 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
 104
 105
 106
 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)
 116                                          Nothing
 117                                          Nothing
 118
 119         lspIdToRspId (LSP.IdInt i) = LSP.IdRspInt i
 120         lspIdToRspId (LSP.IdString i) = LSP.IdRspString i