test/data/documentSymbolFail/example/Main.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-# LANGUAGE LambdaCase #-}
   3 module Main where
   4
   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
   8 import Data.Proxy
   9 import qualified Data.Text.IO as T
  10 import Control.Concurrent
  11 import System.Process
  12 import Control.Lens
  13 import System.IO
  14 import System.Exit
  15 import System.Environment
  16 import System.Directory
  17 import Control.Monad
  18
  19 import qualified Compat
  20
  21 main :: IO ()
  22 main = do
  23   progName <- getProgName
  24   args <- getArgs
  25
  26   when (length args /= 1) $ do
  27     hPutStrLn stderr ("This program expects one argument: " ++ progName ++ " FILEPATH")
  28     exitFailure
  29
  30   let [path] = args
  31
  32   exists <- doesFileExist path
  33   unless exists $ do
  34     hPutStrLn stderr ("File does not exist: " ++ path)
  35     exitFailure
  36
  37   file <- canonicalizePath path
  38
  39   pid <- Compat.getPID
  40
  41   let caps = LSP.ClientCapabilities (Just workspaceCaps) (Just textDocumentCaps) Nothing
  42       workspaceCaps = LSP.WorkspaceClientCapabilities
  43         (Just False)
  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
  51                  (Just False)
  52                  (Just False)
  53                  (Just False)
  54                  (Just False)))
  55         (Just (LSP.CompletionClientCapabilities
  56                  (Just False)
  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)))
  71
  72       initializeParams :: LSP.InitializeParams
  73       initializeParams = LSP.InitializeParams (Just pid) Nothing Nothing Nothing caps Nothing
  74
  75
  76   (Just inp, Just out, _, _) <- createProcess (proc "hie" ["--lsp", "-l", "/tmp/hie.log", "--debug"])
  77     {std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe}
  78
  79   client <- Client.start (Client.Config inp out testNotificationMessageHandler testRequestMessageHandler)
  80
  81   Client.sendClientRequest client (Proxy :: Proxy LSP.InitializeRequest) LSP.Initialize initializeParams
  82
  83   Client.sendClientNotification client LSP.Initialized (Just LSP.InitializedParams)
  84
  85   txt <- T.readFile file
  86
  87   let uri = LSP.filePathToUri file
  88
  89   Client.sendClientNotification client LSP.TextDocumentDidOpen (Just (LSP.DidOpenTextDocumentParams (LSP.TextDocumentItem uri "haskell" 1 txt)))
  90
  91   Client.sendClientRequest
  92     client
  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"
  98
  99   Client.sendClientRequest client (Proxy :: Proxy LSP.DocumentSymbolRequest) LSP.TextDocumentDocumentSymbol (LSP.DocumentSymbolParams (LSP.TextDocumentIdentifier uri))
 100     >>= \case
 101       Just (Right as) -> mapM_ T.putStrLn (as ^.. traverse . LSP.name)
 102       _ -> putStrLn "Server couldn't give us document symbol information"
 103
 104   Client.sendClientRequest client (Proxy :: Proxy LSP.ShutdownRequest) LSP.Shutdown Nothing
 105   Client.sendClientNotification client LSP.Exit (Just LSP.ExitParams)
 106
 107   Client.stop client
 108
 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)
 115   where
 116     toRspId (LSP.IdInt i) = LSP.IdRspInt i
 117     toRspId (LSP.IdString t) = LSP.IdRspString t
 118
 119     emptyResponse :: LSP.RequestMessage m req resp -> LSP.ResponseMessage a
 120     emptyResponse m = LSP.ResponseMessage (m ^. LSP.jsonrpc) (toRspId (m ^. LSP.id)) Nothing Nothing
 121
 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))