src/Language/Haskell/LSP/Test.hs

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