X-Git-Url: http://git.lukelau.me/?p=lsp-test.git;a=blobdiff_plain;f=test%2Frecordings%2FdocumentSymbolFail%2Fexample%2FMain.hs;fp=test%2Frecordings%2FdocumentSymbolFail%2Fexample%2FMain.hs;h=ca9f84938163da8a5a8f0f6cd7fa732e9ea9ecd7;hp=0000000000000000000000000000000000000000;hb=37aa4a22ec691b45bbd1cd0dd23d70e90a0c4e40;hpb=6930c3cb143fb7aca3f14ea865052ab79c386684

diff --git a/test/recordings/documentSymbolFail/example/Main.hs b/test/recordings/documentSymbolFail/example/Main.hs
new file mode 100644
index 0000000..ca9f849
--- /dev/null
+++ b/test/recordings/documentSymbolFail/example/Main.hs
@@ -0,0 +1,127 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE LambdaCase #-}
+module Main where
+
+import qualified Language.Haskell.LSP.TH.DataTypesJSON as LSP
+import qualified Language.Haskell.LSP.TH.ClientCapabilities as LSP
+import qualified LSP.Client as Client
+import Data.Proxy
+import qualified Data.Text.IO as T
+import Control.Concurrent
+import System.Process
+import Control.Lens
+import System.IO
+import System.Exit
+import System.Environment
+import System.Directory
+import Control.Monad
+
+import qualified Compat
+
+main :: IO ()
+main = do
+  progName <- getProgName
+  args <- getArgs
+
+  when (length args /= 1) $ do
+    hPutStrLn stderr ("This program expects one argument: " ++ progName ++ " FILEPATH")
+    exitFailure
+
+  let [path] = args
+
+  exists <- doesFileExist path
+  unless exists $ do
+    hPutStrLn stderr ("File does not exist: " ++ path)
+    exitFailure
+
+  file <- canonicalizePath path
+
+  pid <- Compat.getPID
+
+  let caps = LSP.ClientCapabilities (Just workspaceCaps) (Just textDocumentCaps) Nothing
+      workspaceCaps = LSP.WorkspaceClientCapabilities
+        (Just False)
+        (Just (LSP.WorkspaceEditClientCapabilities (Just False)))
+        (Just (LSP.DidChangeConfigurationClientCapabilities (Just False)))
+        (Just (LSP.DidChangeWatchedFilesClientCapabilities (Just False)))
+        (Just (LSP.SymbolClientCapabilities (Just False)))
+        (Just (LSP.ExecuteClientCapabilities (Just False)))
+      textDocumentCaps = LSP.TextDocumentClientCapabilities
+        (Just (LSP.SynchronizationTextDocumentClientCapabilities
+                 (Just False)
+                 (Just False)
+                 (Just False)
+                 (Just False)))
+        (Just (LSP.CompletionClientCapabilities
+                 (Just False)
+                 (Just (LSP.CompletionItemClientCapabilities (Just False)))))
+        (Just (LSP.HoverClientCapabilities (Just False)))
+        (Just (LSP.SignatureHelpClientCapabilities (Just False)))
+        (Just (LSP.ReferencesClientCapabilities (Just False)))
+        (Just (LSP.DocumentHighlightClientCapabilities (Just False)))
+        (Just (LSP.DocumentSymbolClientCapabilities (Just False)))
+        (Just (LSP.FormattingClientCapabilities (Just False)))
+        (Just (LSP.RangeFormattingClientCapabilities (Just False)))
+        (Just (LSP.OnTypeFormattingClientCapabilities (Just False)))
+        (Just (LSP.DefinitionClientCapabilities (Just False)))
+        (Just (LSP.CodeActionClientCapabilities (Just False)))
+        (Just (LSP.CodeLensClientCapabilities (Just False)))
+        (Just (LSP.DocumentLinkClientCapabilities (Just False)))
+        (Just (LSP.RenameClientCapabilities (Just False)))
+
+      initializeParams :: LSP.InitializeParams
+      initializeParams = LSP.InitializeParams (Just pid) Nothing Nothing Nothing caps Nothing
+
+
+  (Just inp, Just out, _, _) <- createProcess (proc "hie" ["--lsp", "-l", "/tmp/hie.log", "--debug"])
+    {std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe}
+
+  client <- Client.start (Client.Config inp out testNotificationMessageHandler testRequestMessageHandler)
+
+  Client.sendClientRequest client (Proxy :: Proxy LSP.InitializeRequest) LSP.Initialize initializeParams
+
+  Client.sendClientNotification client LSP.Initialized (Just LSP.InitializedParams)
+
+  txt <- T.readFile file
+
+  let uri = LSP.filePathToUri file
+
+  Client.sendClientNotification client LSP.TextDocumentDidOpen (Just (LSP.DidOpenTextDocumentParams (LSP.TextDocumentItem uri "haskell" 1 txt)))
+
+  Client.sendClientRequest
+    client
+    (Proxy :: Proxy LSP.DefinitionRequest)
+    LSP.TextDocumentDefinition
+    (LSP.TextDocumentPositionParams (LSP.TextDocumentIdentifier uri) (LSP.Position 88 36)) >>= \case
+      Just (Right pos) -> print pos
+      _ -> putStrLn "Server couldn't give us defnition position"
+
+  Client.sendClientRequest client (Proxy :: Proxy LSP.DocumentSymbolRequest) LSP.TextDocumentDocumentSymbol (LSP.DocumentSymbolParams (LSP.TextDocumentIdentifier uri))
+    >>= \case
+      Just (Right as) -> mapM_ T.putStrLn (as ^.. traverse . LSP.name)
+      _ -> putStrLn "Server couldn't give us document symbol information"
+
+  Client.sendClientRequest client (Proxy :: Proxy LSP.ShutdownRequest) LSP.Shutdown Nothing
+  Client.sendClientNotification client LSP.Exit (Just LSP.ExitParams)
+
+  Client.stop client
+
+testRequestMessageHandler :: Client.RequestMessageHandler
+testRequestMessageHandler = Client.RequestMessageHandler
+  (\m -> emptyResponse m <$ print m)
+  (\m -> emptyResponse m <$ print m)
+  (\m -> emptyResponse m <$ print m)
+  (\m -> emptyResponse m <$ print m)
+  where
+    toRspId (LSP.IdInt i) = LSP.IdRspInt i
+    toRspId (LSP.IdString t) = LSP.IdRspString t
+
+    emptyResponse :: LSP.RequestMessage m req resp -> LSP.ResponseMessage a
+    emptyResponse m = LSP.ResponseMessage (m ^. LSP.jsonrpc) (toRspId (m ^. LSP.id)) Nothing Nothing
+
+testNotificationMessageHandler :: Client.NotificationMessageHandler
+testNotificationMessageHandler = Client.NotificationMessageHandler
+  (T.putStrLn . view (LSP.params . LSP.message))
+  (T.putStrLn . view (LSP.params . LSP.message))
+  (print . view LSP.params)
+  (mapM_ T.putStrLn . (^.. LSP.params . LSP.diagnostics . traverse . LSP.message))