, transformers
, process
, directory
+ , containers
if os(windows)
build-depends: win32
else
build-depends: unix
other-modules: Compat
Capabilities
+ Language.Haskell.LSP.Test.Files
ghc-options: -W
test-suite tests
--- /dev/null
+{-# LANGUAGE FlexibleContexts #-}
+module Language.Haskell.LSP.Test.Files
+ ( loadSwappedFiles
+ , FileMap
+ , emptyFileMap
+ )
+where
+
+import Language.Haskell.LSP.Core
+import qualified Language.Haskell.LSP.Control as Control
+import Language.Haskell.LSP.Types hiding ( error )
+import Data.Default
+import Control.Lens
+import Control.Monad
+import Control.Concurrent
+import Data.Aeson
+import qualified Data.ByteString.Lazy.Char8 as B
+import Data.Map as Map
+import Data.Maybe
+import System.Directory
+import System.IO
+
+type FileMap = Map.Map FilePath FilePath
+
+emptyFileMap :: FileMap
+emptyFileMap = Map.empty
+
+buildFiles
+ :: (HasParams a b, HasTextDocument b c, HasUri c Uri)
+ => [a]
+ -> FileMap
+ -> IO FileMap
+buildFiles ns oldMap = foldM createFile oldMap ns
+ where
+ createFile map n = do
+ let fp = fromMaybe (error "Couldn't convert file path")
+ (uriToFilePath $ n ^. params . textDocument . uri)
+ if Map.member fp map
+ then return map
+ else do
+ tmpDir <- getTemporaryDirectory
+ (tmpFp, tmpH) <- openTempFile tmpDir "lspTestDoc"
+ readFile fp >>= hPutStr tmpH
+ return $ Map.insert fp tmpFp map
+
+swapFile :: (HasUri a Uri) => FileMap -> a -> a
+swapFile m msg = fromMaybe msg $ do
+ let oldUri = msg ^. uri
+ oldFp <- uriToFilePath oldUri
+ newFp <- Map.lookup oldFp m
+ let newUri = filePathToUri newFp
+ return $ uri .~ newUri $ msg
+
+loadSwappedFiles :: FileMap -> Handle -> IO ([B.ByteString], FileMap)
+loadSwappedFiles map h = do
+ fileMapVar <- newMVar map
+ msgsVar <- newMVar []
+ nullH <- openFile "/dev/null" WriteMode
+ Control.runWithHandles h
+ nullH
+ (const $ Right (), const $ return Nothing)
+ (handlers msgsVar fileMapVar)
+ def
+ Nothing
+ Nothing
+ newMap <- readMVar fileMapVar
+ msgs <- reverse <$> readMVar msgsVar
+ return (msgs, newMap)
+
+handlers :: MVar [B.ByteString] -> MVar FileMap -> Handlers
+handlers msgs fileMap = Handlers
+ {
+ -- Requests
+ hoverHandler = Just put
+ , completionHandler = Just put
+ , completionResolveHandler = Just put
+ , signatureHelpHandler = Just put
+ , definitionHandler = Just put
+ , referencesHandler = Just put
+ , documentHighlightHandler = Just put
+ , documentSymbolHandler = Just $ swapUri (params . textDocument)
+ , workspaceSymbolHandler = Just put
+ , codeActionHandler = Just put
+ , codeLensHandler = Just put
+ , codeLensResolveHandler = Just put
+ , documentFormattingHandler = Just put
+ , documentRangeFormattingHandler = Just put
+ , documentTypeFormattingHandler = Just put
+ , renameHandler = Just $ swapUri (params . textDocument)
+ , documentLinkHandler = Just $ swapUri (params . textDocument)
+ , documentLinkResolveHandler = Just put
+ , executeCommandHandler = Just put
+ , initializeRequestHandler = Just put
+ -- Notifications
+ , didChangeConfigurationParamsHandler = Just put
+ , didOpenTextDocumentNotificationHandler = Just $ swapUri (params . textDocument)
+ , didChangeTextDocumentNotificationHandler = Just $ swapUri (params . textDocument)
+ , didCloseTextDocumentNotificationHandler = Just $ swapUri (params . textDocument)
+ , didSaveTextDocumentNotificationHandler = Just $ swapUri (params . textDocument)
+ , willSaveWaitUntilTextDocHandler = Just put
+ , didChangeWatchedFilesNotificationHandler = Just put
+ , initializedHandler = Just put
+ , willSaveTextDocumentNotificationHandler = Just $ swapUri (params . textDocument)
+ , cancelNotificationHandler = Just put
+ , exitNotificationHandler = Just put
+ -- Responses
+ , responseHandler = Just put
+ }
+ where
+ swapUri f msg = do
+ modifyMVar_ fileMap (buildFiles [msg])
+ map <- readMVar fileMap
+ put $ swapFile map $ msg ^. f
+
+ put :: ToJSON a => a -> IO ()
+ put msg = modifyMVar_ msgs (return . (encode msg :))
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
-- | A testing tool for replaying recorded client logs back to a server,
-- and validating that the server output matches up with another log.
module Language.Haskell.LSP.Test.Recorded
import System.IO
import System.Directory
import System.Process
+import Language.Haskell.LSP.Test.Files
-- | Replays a recorded client output and
-- makes sure it matches up with an expected response.
prevDir <- getCurrentDirectory
(Just serverIn, Just serverOut, _, serverProc) <- createProcess
- (proc "hie" ["--lsp", "-l", "/tmp/hie.log", "-d"]) { std_in = CreatePipe
- , std_out = CreatePipe
- }
+ (proc "hie" ["--lsp", "-l", "/tmp/hie.log"]) { std_in = CreatePipe , std_out = CreatePipe }
hSetBuffering serverIn NoBuffering
hSetBuffering serverOut NoBuffering
- -- todo: use qsem
-- whether to send the next request
reqSema <- newEmptyMVar :: IO (MVar LSP.LspIdRsp)
-- whether to send the next response
serverRecIn <- openFile sfp ReadMode
null <- openFile "/dev/null" WriteMode
- expectedMsgs <- getAllMessages serverRecIn
+
+ (clientMsgs, fileMap) <- loadSwappedFiles emptyFileMap clientRecIn
+
+ tmpDir <- getTemporaryDirectory
+ (_, mappedClientRecIn) <- openTempFile tmpDir "clientRecInMapped"
+ mapM_ (B.hPut mappedClientRecIn) $ map addHeader clientMsgs
+ hSeek mappedClientRecIn AbsoluteSeek 0
+
+
+ (expectedMsgs, _) <- loadSwappedFiles fileMap serverRecIn
-- listen to server
forkIO $ runReaderT (listenServer expectedMsgs serverOut semas) didPass
-- start client replay
forkIO $ do
- Control.runWithHandles clientRecIn
+ Control.runWithHandles mappedClientRecIn
null
(const $ Right (), const $ return Nothing)
(handlers serverIn semas)
then return []
else do
msg <- getNextMessage h
+
(msg :) <$> getAllMessages h
-- | Fetches the next message bytes based on
Nothing -> error "Couldn't read Content-Length header"
Just size -> B.hGet h size
-
handlers :: Handle -> (MVar LSP.LspIdRsp, MVar LSP.LspId) -> Handlers
handlers serverH (reqSema, rspSema) = def
{
, responseHandler = Just response
}
where
+
-- TODO: May need to prevent premature exit notification being sent
-- notification msg@(LSP.NotificationMessage _ LSP.Exit _) = do
-- putStrLn "Will send exit notification soon"
putStrLn $ "Sent a notification " ++ show m
request msg@(LSP.RequestMessage _ id m _) = do
+
+ when (m == LSP.TextDocumentDocumentSymbol) $ threadDelay 5000000
+
B.hPut serverH $ addHeader (encode msg)
putStrLn $ "Sent a request id " ++ show id ++ ": " ++ show m ++ "\nWaiting for a response"
--- /dev/null
+module Main where
+
+main :: IO ()
+main = do
+ let initialList = []
+ interactWithUser initialList
+
+type Item = String
+type Items = [Item]
+
+data Command = Quit
+ | DisplayItems
+ | AddItem String
+ | RemoveItem Int
+ | Help
+
+type Error = String
+
+parseCommand :: String -> Either Error Command
+parseCommand line = case words line of
+ ["quit"] -> Right Quit
+ ["items"] -> Right DisplayItems
+ "add" : item -> Right $ AddItem $ unwords item
+ "remove" : i -> Right $ RemoveItem $ read $ unwords i
+ ["help"] -> Right Help
+ _ -> Left "Unknown command"
+
+addItem :: Item -> Items -> Items
+addItem = (:)
+
+displayItems :: Items -> String
+displayItems = unlines . map ("- " ++)
+
+removeItem :: Int -> Items -> Either Error Items
+removeItem i items
+ | i < 0 || i >= length items = Left "Out of range"
+ | otherwise = Right result
+ where (front, back) = splitAt (i + 1) items
+ result = init front ++ back
+
+interactWithUser :: Items -> IO ()
+interactWithUser items = do
+ line <- getLine
+ case parseCommand line of
+ Right DisplayItems -> do
+ putStrLn $ displayItems items
+ interactWithUser items
+
+ Right (AddItem item) -> do
+ let newItems = addItem item items
+ putStrLn "Added"
+ interactWithUser newItems
+
+ Right (RemoveItem i) ->
+ case removeItem i items of
+ Right newItems -> do
+ putStrLn $ "Removed " ++ items !! i
+ interactWithUser newItems
+ Left err -> do
+ putStrLn err
+ interactWithUser items
+
+
+ Right Quit -> return ()
+
+ Right Help -> do
+ putStrLn "Commands:"
+ putStrLn "help"
+ putStrLn "items"
+ putStrLn "add"
+ putStrLn "quit"
+ interactWithUser items
+
+ Left err -> do
+ putStrLn $ "Error: " ++ err
+ interactWithUser items
-Content-Length: 400\r
+Content-Length: 380\r
\r
-{"jsonrpc":"2.0","method":"initialize","params":{"capabilities":{"textDocument":{"completion":{"completionItem":{"commitCharactersSupport":null,"documentationFormat":null,"snippetSupport":false},"dynamicRegistration":null}}},"initializationOptions":null,"processId":60645,"rootPath":"/Users/luke/Repos/haskell-lsp-client","rootUri":"file:///Users/luke/Repos/haskell-lsp-client","trace":"off"},"id":9}Content-Length: 52\r
+{"jsonrpc":"2.0","method":"initialize","params":{"capabilities":{"textDocument":{"completion":{"completionItem":{"commitCharactersSupport":null,"documentationFormat":null,"snippetSupport":false},"dynamicRegistration":null}}},"initializationOptions":{"cacheDirectory":"/tmp/lspCache"},"processId":15099,"rootPath":"/Users/luke","rootUri":"file:///Users/luke","trace":"off"},"id":9}Content-Length: 52\r
\r
-{"jsonrpc":"2.0","method":"initialized","params":{}}Content-Length: 5528\r
+{"jsonrpc":"2.0","method":"initialized","params":{}}Content-Length: 144\r
\r
-{"jsonrpc":"2.0","method":"textDocument/didOpen","params":{"textDocument":{"languageId":"haskell","text":"{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE LambdaCase #-}\nmodule Main where\n\nimport qualified Language.Haskell.LSP.TH.DataTypesJSON as LSP\nimport qualified Language.Haskell.LSP.TH.ClientCapabilities as LSP\nimport qualified LSP.Client as Client\nimport Data.Proxy\nimport qualified Data.Text.IO as T\nimport Control.Concurrent\nimport System.Process\nimport Control.Lens\nimport System.IO\nimport System.Exit\nimport System.Environment\nimport System.Directory\nimport Control.Monad\n\nimport qualified Compat\n\nmain :: IO ()\nmain = do\n progName <- getProgName\n args <- getArgs\n\n when (length args /= 1) $ do\n hPutStrLn stderr (\"This program expects one argument: \" ++ progName ++ \" FILEPATH\")\n exitFailure\n\n let [path] = args\n\n exists <- doesFileExist path\n unless exists $ do\n hPutStrLn stderr (\"File does not exist: \" ++ path)\n exitFailure\n\n file <- canonicalizePath path\n\n pid <- Compat.getPID\n\n let caps = LSP.ClientCapabilities (Just workspaceCaps) (Just textDocumentCaps) Nothing\n workspaceCaps = LSP.WorkspaceClientCapabilities\n (Just False)\n (Just (LSP.WorkspaceEditClientCapabilities (Just False)))\n (Just (LSP.DidChangeConfigurationClientCapabilities (Just False)))\n (Just (LSP.DidChangeWatchedFilesClientCapabilities (Just False)))\n (Just (LSP.SymbolClientCapabilities (Just False)))\n (Just (LSP.ExecuteClientCapabilities (Just False)))\n textDocumentCaps = LSP.TextDocumentClientCapabilities\n (Just (LSP.SynchronizationTextDocumentClientCapabilities\n (Just False)\n (Just False)\n (Just False)\n (Just False)))\n (Just (LSP.CompletionClientCapabilities\n (Just False)\n (Just (LSP.CompletionItemClientCapabilities (Just False)))))\n (Just (LSP.HoverClientCapabilities (Just False)))\n (Just (LSP.SignatureHelpClientCapabilities (Just False)))\n (Just (LSP.ReferencesClientCapabilities (Just False)))\n (Just (LSP.DocumentHighlightClientCapabilities (Just False)))\n (Just (LSP.DocumentSymbolClientCapabilities (Just False)))\n (Just (LSP.FormattingClientCapabilities (Just False)))\n (Just (LSP.RangeFormattingClientCapabilities (Just False)))\n (Just (LSP.OnTypeFormattingClientCapabilities (Just False)))\n (Just (LSP.DefinitionClientCapabilities (Just False)))\n (Just (LSP.CodeActionClientCapabilities (Just False)))\n (Just (LSP.CodeLensClientCapabilities (Just False)))\n (Just (LSP.DocumentLinkClientCapabilities (Just False)))\n (Just (LSP.RenameClientCapabilities (Just False)))\n\n initializeParams :: LSP.InitializeParams\n initializeParams = LSP.InitializeParams (Just pid) Nothing Nothing Nothing caps Nothing\n\n\n (Just inp, Just out, _, _) <- createProcess (proc \"hie\" [\"--lsp\", \"-l\", \"/tmp/hie.log\", \"--debug\"])\n {std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe}\n\n client <- Client.start (Client.Config inp out testNotificationMessageHandler testRequestMessageHandler)\n\n Client.sendClientRequest client (Proxy :: Proxy LSP.InitializeRequest) LSP.Initialize initializeParams\n\n Client.sendClientNotification client LSP.Initialized (Just LSP.InitializedParams)\n\n txt <- T.readFile file\n\n let uri = LSP.filePathToUri file\n\n Client.sendClientNotification client LSP.TextDocumentDidOpen (Just (LSP.DidOpenTextDocumentParams (LSP.TextDocumentItem uri \"haskell\" 1 txt)))\n\n Client.sendClientRequest\n client\n (Proxy :: Proxy LSP.DefinitionRequest)\n LSP.TextDocumentDefinition\n (LSP.TextDocumentPositionParams (LSP.TextDocumentIdentifier uri) (LSP.Position 88 36)) >>= \\case\n Just (Right pos) -> print pos\n _ -> putStrLn \"Server couldn't give us defnition position\"\n\n Client.sendClientRequest client (Proxy :: Proxy LSP.DocumentSymbolRequest) LSP.TextDocumentDocumentSymbol (LSP.DocumentSymbolParams (LSP.TextDocumentIdentifier uri))\n >>= \\case\n Just (Right as) -> mapM_ T.putStrLn (as ^.. traverse . LSP.name)\n _ -> putStrLn \"Server couldn't give us document symbol information\"\n\n Client.sendClientRequest client (Proxy :: Proxy LSP.ShutdownRequest) LSP.Shutdown Nothing\n Client.sendClientNotification client LSP.Exit (Just LSP.ExitParams)\n\n Client.stop client\n\ntestRequestMessageHandler :: Client.RequestMessageHandler\ntestRequestMessageHandler = Client.RequestMessageHandler\n (\\m -> emptyResponse m <$ print m)\n (\\m -> emptyResponse m <$ print m)\n (\\m -> emptyResponse m <$ print m)\n (\\m -> emptyResponse m <$ print m)\n where\n toRspId (LSP.IdInt i) = LSP.IdRspInt i\n toRspId (LSP.IdString t) = LSP.IdRspString t\n\n emptyResponse :: LSP.RequestMessage m req resp -> LSP.ResponseMessage a\n emptyResponse m = LSP.ResponseMessage (m ^. LSP.jsonrpc) (toRspId (m ^. LSP.id)) Nothing Nothing\n\ntestNotificationMessageHandler :: Client.NotificationMessageHandler\ntestNotificationMessageHandler = Client.NotificationMessageHandler\n (T.putStrLn . view (LSP.params . LSP.message))\n (T.putStrLn . view (LSP.params . LSP.message))\n (print . view LSP.params)\n (mapM_ T.putStrLn . (^.. LSP.params . LSP.diagnostics . traverse . LSP.message))\n","uri":"file:///Users/luke/Repos/haskell-lsp-client/example/Main.hs","version":0}}}Content-Length: 38\r
+{"jsonrpc":"2.0","method":"workspace/didChangeConfiguration","params":{"settings":{"initializationOptions":{"cacheDirectory":"/tmp/lspCache"}}}}Content-Length: 2084\r
\r
-{"jsonrpc":"2.0","result":null,"id":0}Content-Length: 5560\r
+{"jsonrpc":"2.0","method":"textDocument/didOpen","params":{"textDocument":{"languageId":"haskell","text":"module Main where\n\nmain :: IO ()\nmain = do\n let initialList = []\n interactWithUser initialList\n\ntype Item = String\ntype Items = [Item]\n\ndata Command = Quit\n | DisplayItems\n | AddItem String\n | RemoveItem Int\n | Help\n\ntype Error = String\n\nparseCommand :: String -> Either Error Command\nparseCommand line = case words line of\n [\"quit\"] -> Right Quit\n [\"items\"] -> Right DisplayItems\n \"add\" : item -> Right $ AddItem $ unwords item\n \"remove\" : i -> Right $ RemoveItem $ read $ unwords i\n [\"help\"] -> Right Help\n _ -> Left \"Unknown command\"\n\naddItem :: Item -> Items -> Items\naddItem = (:)\n\ndisplayItems :: Items -> String\ndisplayItems = unlines . map (\"- \" ++)\n\nremoveItem :: Int -> Items -> Either Error Items\nremoveItem i items\n | i < 0 || i >= length items = Left \"Out of range\"\n | otherwise = Right result\n where (front, back) = splitAt (i + 1) items\n result = init front ++ back\n\ninteractWithUser :: Items -> IO ()\ninteractWithUser items = do\n line <- getLine\n case parseCommand line of\n Right DisplayItems -> do\n putStrLn $ displayItems items\n interactWithUser items\n\n Right (AddItem item) -> do\n let newItems = addItem item items\n putStrLn \"Added\"\n interactWithUser newItems\n\n Right (RemoveItem i) ->\n case removeItem i items of\n Right newItems -> do\n putStrLn $ \"Removed \" ++ items !! i\n interactWithUser newItems\n Left err -> do\n putStrLn err\n interactWithUser items\n\n\n Right Quit -> return ()\n\n Right Help -> do\n putStrLn \"Commands:\"\n putStrLn \"help\"\n putStrLn \"items\"\n putStrLn \"add\"\n putStrLn \"quit\"\n interactWithUser items\n\n Left err -> do\n putStrLn $ \"Error: \" ++ err\n interactWithUser items\n","uri":"file:///Users/luke/Desktop/simple.hs","version":0}}}Content-Length: 38\r
\r
-{"jsonrpc":"2.0","method":"textDocument/didChange","params":{"contentChanges":[{"range":null,"rangeLength":null,"text":"{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE LambdaCase #-}\nmodule Main where\n\nimport qualified Language.Haskell.LSP.TH.DataTypesJSON as LSP\nimport qualified Language.Haskell.LSP.TH.ClientCapabilities as LSP\nimport qualified LSP.Client as Client\nimport Data.Proxy\nimport qualified Data.Text.IO as T\nimport Control.Concurrent\nimport System.Process\nimport Control.Lens\nimport System.IO\nimport System.Exit\nimport System.Environment\nimport System.Directory\nimport Control.Monad\n\nimport qualified Compat\n\nmain :: IO ()\nmain = do\n progName <- getProgName\n args <- getArgs\n\n when (length args /= 1) $ do\n hPutStrLn stderr (\"This program expects one argument: \" ++ progName ++ \" FILEPATH\")\n exitFailure\n\n let [path] = args\n\n exists <- doesFileExist path\n unless exists $ do\n hPutStrLn stderr (\"File does not exist: \" ++ path)\n exitFailure\n\n file <- canonicalizePath patj\n\n pid <- Compat.getPID\n\n let caps = LSP.ClientCapabilities (Just workspaceCaps) (Just textDocumentCaps) Nothing\n workspaceCaps = LSP.WorkspaceClientCapabilities\n (Just False)\n (Just (LSP.WorkspaceEditClientCapabilities (Just False)))\n (Just (LSP.DidChangeConfigurationClientCapabilities (Just False)))\n (Just (LSP.DidChangeWatchedFilesClientCapabilities (Just False)))\n (Just (LSP.SymbolClientCapabilities (Just False)))\n (Just (LSP.ExecuteClientCapabilities (Just False)))\n textDocumentCaps = LSP.TextDocumentClientCapabilities\n (Just (LSP.SynchronizationTextDocumentClientCapabilities\n (Just False)\n (Just False)\n (Just False)\n (Just False)))\n (Just (LSP.CompletionClientCapabilities\n (Just False)\n (Just (LSP.CompletionItemClientCapabilities (Just False)))))\n (Just (LSP.HoverClientCapabilities (Just False)))\n (Just (LSP.SignatureHelpClientCapabilities (Just False)))\n (Just (LSP.ReferencesClientCapabilities (Just False)))\n (Just (LSP.DocumentHighlightClientCapabilities (Just False)))\n (Just (LSP.DocumentSymbolClientCapabilities (Just False)))\n (Just (LSP.FormattingClientCapabilities (Just False)))\n (Just (LSP.RangeFormattingClientCapabilities (Just False)))\n (Just (LSP.OnTypeFormattingClientCapabilities (Just False)))\n (Just (LSP.DefinitionClientCapabilities (Just False)))\n (Just (LSP.CodeActionClientCapabilities (Just False)))\n (Just (LSP.CodeLensClientCapabilities (Just False)))\n (Just (LSP.DocumentLinkClientCapabilities (Just False)))\n (Just (LSP.RenameClientCapabilities (Just False)))\n\n initializeParams :: LSP.InitializeParams\n initializeParams = LSP.InitializeParams (Just pid) Nothing Nothing Nothing caps Nothing\n\n\n (Just inp, Just out, _, _) <- createProcess (proc \"hie\" [\"--lsp\", \"-l\", \"/tmp/hie.log\", \"--debug\"])\n {std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe}\n\n client <- Client.start (Client.Config inp out testNotificationMessageHandler testRequestMessageHandler)\n\n Client.sendClientRequest client (Proxy :: Proxy LSP.InitializeRequest) LSP.Initialize initializeParams\n\n Client.sendClientNotification client LSP.Initialized (Just LSP.InitializedParams)\n\n txt <- T.readFile file\n\n let uri = LSP.filePathToUri file\n\n Client.sendClientNotification client LSP.TextDocumentDidOpen (Just (LSP.DidOpenTextDocumentParams (LSP.TextDocumentItem uri \"haskell\" 1 txt)))\n\n Client.sendClientRequest\n client\n (Proxy :: Proxy LSP.DefinitionRequest)\n LSP.TextDocumentDefinition\n (LSP.TextDocumentPositionParams (LSP.TextDocumentIdentifier uri) (LSP.Position 88 36)) >>= \\case\n Just (Right pos) -> print pos\n _ -> putStrLn \"Server couldn't give us defnition position\"\n\n Client.sendClientRequest client (Proxy :: Proxy LSP.DocumentSymbolRequest) LSP.TextDocumentDocumentSymbol (LSP.DocumentSymbolParams (LSP.TextDocumentIdentifier uri))\n >>= \\case\n Just (Right as) -> mapM_ T.putStrLn (as ^.. traverse . LSP.name)\n _ -> putStrLn \"Server couldn't give us document symbol information\"\n\n Client.sendClientRequest client (Proxy :: Proxy LSP.ShutdownRequest) LSP.Shutdown Nothing\n Client.sendClientNotification client LSP.Exit (Just LSP.ExitParams)\n\n Client.stop client\n\ntestRequestMessageHandler :: Client.RequestMessageHandler\ntestRequestMessageHandler = Client.RequestMessageHandler\n (\\m -> emptyResponse m <$ print m)\n (\\m -> emptyResponse m <$ print m)\n (\\m -> emptyResponse m <$ print m)\n (\\m -> emptyResponse m <$ print m)\n where\n toRspId (LSP.IdInt i) = LSP.IdRspInt i\n toRspId (LSP.IdString t) = LSP.IdRspString t\n\n emptyResponse :: LSP.RequestMessage m req resp -> LSP.ResponseMessage a\n emptyResponse m = LSP.ResponseMessage (m ^. LSP.jsonrpc) (toRspId (m ^. LSP.id)) Nothing Nothing\n\ntestNotificationMessageHandler :: Client.NotificationMessageHandler\ntestNotificationMessageHandler = Client.NotificationMessageHandler\n (T.putStrLn . view (LSP.params . LSP.message))\n (T.putStrLn . view (LSP.params . LSP.message))\n (print . view LSP.params)\n (mapM_ T.putStrLn . (^.. LSP.params . LSP.diagnostics . traverse . LSP.message))\n"}],"textDocument":{"uri":"file:///Users/luke/Repos/haskell-lsp-client/example/Main.hs","version":1}}}Content-Length: 5560\r
+{"jsonrpc":"2.0","result":null,"id":0}Content-Length: 137\r
\r
-{"jsonrpc":"2.0","method":"textDocument/didChange","params":{"contentChanges":[{"range":null,"rangeLength":null,"text":"{-# LANGUAGE OverloadedStrings #-}\n{-# LANGUAGE LambdaCase #-}\nmodule Main where\n\nimport qualified Language.Haskell.LSP.TH.DataTypesJSON as LSP\nimport qualified Language.Haskell.LSP.TH.ClientCapabilities as LSP\nimport qualified LSP.Client as Client\nimport Data.Proxy\nimport qualified Data.Text.IO as T\nimport Control.Concurrent\nimport System.Process\nimport Control.Lens\nimport System.IO\nimport System.Exit\nimport System.Environment\nimport System.Directory\nimport Control.Monad\n\nimport qualified Compat\n\nmain :: IO ()\nmain = do\n progName <- getProgName\n args <- getArgs\n\n when (length args /= 1) $ do\n hPutStrLn stderr (\"This program expects one argument: \" ++ progName ++ \" FILEPATH\")\n exitFailure\n\n let [path] = args\n\n exists <- doesFileExist path\n unless exists $ do\n hPutStrLn stderr (\"File does not exist: \" ++ path)\n exitFailure\n\n file <- canonicalizePath path\n\n pid <- Compat.getPID\n\n let caps = LSP.ClientCapabilities (Just workspaceCaps) (Just textDocumentCaps) Nothing\n workspaceCaps = LSP.WorkspaceClientCapabilities\n (Just False)\n (Just (LSP.WorkspaceEditClientCapabilities (Just False)))\n (Just (LSP.DidChangeConfigurationClientCapabilities (Just False)))\n (Just (LSP.DidChangeWatchedFilesClientCapabilities (Just False)))\n (Just (LSP.SymbolClientCapabilities (Just False)))\n (Just (LSP.ExecuteClientCapabilities (Just False)))\n textDocumentCaps = LSP.TextDocumentClientCapabilities\n (Just (LSP.SynchronizationTextDocumentClientCapabilities\n (Just False)\n (Just False)\n (Just False)\n (Just False)))\n (Just (LSP.CompletionClientCapabilities\n (Just False)\n (Just (LSP.CompletionItemClientCapabilities (Just False)))))\n (Just (LSP.HoverClientCapabilities (Just False)))\n (Just (LSP.SignatureHelpClientCapabilities (Just False)))\n (Just (LSP.ReferencesClientCapabilities (Just False)))\n (Just (LSP.DocumentHighlightClientCapabilities (Just False)))\n (Just (LSP.DocumentSymbolClientCapabilities (Just False)))\n (Just (LSP.FormattingClientCapabilities (Just False)))\n (Just (LSP.RangeFormattingClientCapabilities (Just False)))\n (Just (LSP.OnTypeFormattingClientCapabilities (Just False)))\n (Just (LSP.DefinitionClientCapabilities (Just False)))\n (Just (LSP.CodeActionClientCapabilities (Just False)))\n (Just (LSP.CodeLensClientCapabilities (Just False)))\n (Just (LSP.DocumentLinkClientCapabilities (Just False)))\n (Just (LSP.RenameClientCapabilities (Just False)))\n\n initializeParams :: LSP.InitializeParams\n initializeParams = LSP.InitializeParams (Just pid) Nothing Nothing Nothing caps Nothing\n\n\n (Just inp, Just out, _, _) <- createProcess (proc \"hie\" [\"--lsp\", \"-l\", \"/tmp/hie.log\", \"--debug\"])\n {std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe}\n\n client <- Client.start (Client.Config inp out testNotificationMessageHandler testRequestMessageHandler)\n\n Client.sendClientRequest client (Proxy :: Proxy LSP.InitializeRequest) LSP.Initialize initializeParams\n\n Client.sendClientNotification client LSP.Initialized (Just LSP.InitializedParams)\n\n txt <- T.readFile file\n\n let uri = LSP.filePathToUri file\n\n Client.sendClientNotification client LSP.TextDocumentDidOpen (Just (LSP.DidOpenTextDocumentParams (LSP.TextDocumentItem uri \"haskell\" 1 txt)))\n\n Client.sendClientRequest\n client\n (Proxy :: Proxy LSP.DefinitionRequest)\n LSP.TextDocumentDefinition\n (LSP.TextDocumentPositionParams (LSP.TextDocumentIdentifier uri) (LSP.Position 88 36)) >>= \\case\n Just (Right pos) -> print pos\n _ -> putStrLn \"Server couldn't give us defnition position\"\n\n Client.sendClientRequest client (Proxy :: Proxy LSP.DocumentSymbolRequest) LSP.TextDocumentDocumentSymbol (LSP.DocumentSymbolParams (LSP.TextDocumentIdentifier uri))\n >>= \\case\n Just (Right as) -> mapM_ T.putStrLn (as ^.. traverse . LSP.name)\n _ -> putStrLn \"Server couldn't give us document symbol information\"\n\n Client.sendClientRequest client (Proxy :: Proxy LSP.ShutdownRequest) LSP.Shutdown Nothing\n Client.sendClientNotification client LSP.Exit (Just LSP.ExitParams)\n\n Client.stop client\n\ntestRequestMessageHandler :: Client.RequestMessageHandler\ntestRequestMessageHandler = Client.RequestMessageHandler\n (\\m -> emptyResponse m <$ print m)\n (\\m -> emptyResponse m <$ print m)\n (\\m -> emptyResponse m <$ print m)\n (\\m -> emptyResponse m <$ print m)\n where\n toRspId (LSP.IdInt i) = LSP.IdRspInt i\n toRspId (LSP.IdString t) = LSP.IdRspString t\n\n emptyResponse :: LSP.RequestMessage m req resp -> LSP.ResponseMessage a\n emptyResponse m = LSP.ResponseMessage (m ^. LSP.jsonrpc) (toRspId (m ^. LSP.id)) Nothing Nothing\n\ntestNotificationMessageHandler :: Client.NotificationMessageHandler\ntestNotificationMessageHandler = Client.NotificationMessageHandler\n (T.putStrLn . view (LSP.params . LSP.message))\n (T.putStrLn . view (LSP.params . LSP.message))\n (print . view LSP.params)\n (mapM_ T.putStrLn . (^.. LSP.params . LSP.diagnostics . traverse . LSP.message))\n"}],"textDocument":{"uri":"file:///Users/luke/Repos/haskell-lsp-client/example/Main.hs","version":2}}}Content-Length: 210\r
+{"jsonrpc":"2.0","method":"textDocument/documentSymbol","params":{"textDocument":{"uri":"file:///Users/luke/Desktop/simple.hs"}},"id":25}Content-Length: 190\r
\r
-{"jsonrpc":"2.0","method":"textDocument/rename","params":{"newName":"notPath","position":{"character":30,"line":36},"textDocument":{"uri":"file:///Users/luke/Repos/haskell-lsp-client/example/Main.hs"}},"id":45}Content-Length: 47\r
+{"jsonrpc":"2.0","method":"textDocument/rename","params":{"newName":"arseCommand","position":{"character":0,"line":19},"textDocument":{"uri":"file:///Users/luke/Desktop/simple.hs"}},"id":33}Content-Length: 2113\r
+\r
+{"jsonrpc":"2.0","method":"textDocument/didChange","params":{"contentChanges":[{"range":null,"rangeLength":null,"text":"module Main where\n\nmain :: IO ()\nmain = do\n let initialList = []\n interactWithUser initialList\n\ntype Item = String\ntype Items = [Item]\n\ndata Command = Quit\n | DisplayItems\n | AddItem String\n | RemoveItem Int\n | Help\n\ntype Error = String\n\narseCommand :: String -> Either Error Command\narseCommand line = case words line of\n [\"quit\"] -> Right Quit\n [\"items\"] -> Right DisplayItems\n \"add\" : item -> Right $ AddItem $ unwords item\n \"remove\" : i -> Right $ RemoveItem $ read $ unwords i\n [\"help\"] -> Right Help\n _ -> Left \"Unknown command\"\n\naddItem :: Item -> Items -> Items\naddItem = (:)\n\ndisplayItems :: Items -> String\ndisplayItems = unlines . map (\"- \" ++)\n\nremoveItem :: Int -> Items -> Either Error Items\nremoveItem i items\n | i < 0 || i >= length items = Left \"Out of range\"\n | otherwise = Right result\n where (front, back) = splitAt (i + 1) items\n result = init front ++ back\n\ninteractWithUser :: Items -> IO ()\ninteractWithUser items = do\n line <- getLine\n case arseCommand line of\n Right DisplayItems -> do\n putStrLn $ displayItems items\n interactWithUser items\n\n Right (AddItem item) -> do\n let newItems = addItem item items\n putStrLn \"Added\"\n interactWithUser newItems\n\n Right (RemoveItem i) ->\n case removeItem i items of\n Right newItems -> do\n putStrLn $ \"Removed \" ++ items !! i\n interactWithUser newItems\n Left err -> do\n putStrLn err\n interactWithUser items\n\n\n Right Quit -> return ()\n\n Right Help -> do\n putStrLn \"Commands:\"\n putStrLn \"help\"\n putStrLn \"items\"\n putStrLn \"add\"\n putStrLn \"quit\"\n interactWithUser items\n\n Left err -> do\n putStrLn $ \"Error: \" ++ err\n interactWithUser items\n"}],"textDocument":{"uri":"file:///Users/luke/Desktop/simple.hs","version":1}}}Content-Length: 191\r
+\r
+{"jsonrpc":"2.0","method":"textDocument/rename","params":{"newName":"parseCommand","position":{"character":0,"line":19},"textDocument":{"uri":"file:///Users/luke/Desktop/simple.hs"}},"id":42}Content-Length: 2116\r
+\r
+{"jsonrpc":"2.0","method":"textDocument/didChange","params":{"contentChanges":[{"range":null,"rangeLength":null,"text":"module Main where\n\nmain :: IO ()\nmain = do\n let initialList = []\n interactWithUser initialList\n\ntype Item = String\ntype Items = [Item]\n\ndata Command = Quit\n | DisplayItems\n | AddItem String\n | RemoveItem Int\n | Help\n\ntype Error = String\n\nparseCommand :: String -> Either Error Command\nparseCommand line = case words line of\n [\"quit\"] -> Right Quit\n [\"items\"] -> Right DisplayItems\n \"add\" : item -> Right $ AddItem $ unwords item\n \"remove\" : i -> Right $ RemoveItem $ read $ unwords i\n [\"help\"] -> Right Help\n _ -> Left \"Unknown command\"\n\naddItem :: Item -> Items -> Items\naddItem = (:)\n\ndisplayItems :: Items -> String\ndisplayItems = unlines . map (\"- \" ++)\n\nremoveItem :: Int -> Items -> Either Error Items\nremoveItem i items\n | i < 0 || i >= length items = Left \"Out of range\"\n | otherwise = Right result\n where (front, back) = splitAt (i + 1) items\n result = init front ++ back\n\ninteractWithUser :: Items -> IO ()\ninteractWithUser items = do\n line <- getLine\n case parseCommand line of\n Right DisplayItems -> do\n putStrLn $ displayItems items\n interactWithUser items\n\n Right (AddItem item) -> do\n let newItems = addItem item items\n putStrLn \"Added\"\n interactWithUser newItems\n\n Right (RemoveItem i) ->\n case removeItem i items of\n Right newItems -> do\n putStrLn $ \"Removed \" ++ items !! i\n interactWithUser newItems\n Left err -> do\n putStrLn err\n interactWithUser items\n\n\n Right Quit -> return ()\n\n Right Help -> do\n putStrLn \"Commands:\"\n putStrLn \"help\"\n putStrLn \"items\"\n putStrLn \"add\"\n putStrLn \"quit\"\n interactWithUser items\n\n Left err -> do\n putStrLn $ \"Error: \" ++ err\n interactWithUser items\n"}],"textDocument":{"uri":"file:///Users/luke/Desktop/simple.hs","version":2}}}Content-Length: 47\r
\r
{"jsonrpc":"2.0","method":"exit","params":null}
\ No newline at end of file
-Content-Length: 579\r
+Content-Length: 502\r
\r
-{"result":{"capabilities":{"textDocumentSync":{"openClose":true,"change":2,"willSave":false,"willSaveWaitUntil":false,"save":{"includeText":false}},"hoverProvider":true,"completionProvider":{"resolveProvider":true,"triggerCharacters":["."]},"definitionProvider":true,"referencesProvider":true,"documentHighlightProvider":true,"documentSymbolProvider":true,"codeActionProvider":true,"documentFormattingProvider":true,"documentRangeFormattingProvider":true,"renameProvider":true,"executeCommandProvider":{"commands":["applyrefact:applyOne","hare:demote"]}}},"jsonrpc":"2.0","id":9}Content-Length: 209\r
+{"result":{"capabilities":{"textDocumentSync":{"openClose":true,"change":2,"willSave":false,"willSaveWaitUntil":false,"save":{"includeText":false}},"hoverProvider":true,"completionProvider":{"resolveProvider":true,"triggerCharacters":["."]},"definitionProvider":true,"referencesProvider":true,"documentHighlightProvider":true,"documentSymbolProvider":true,"codeActionProvider":true,"documentFormattingProvider":true,"documentRangeFormattingProvider":true,"renameProvider":true}},"jsonrpc":"2.0","id":9}Content-Length: 209\r
\r
{"jsonrpc":"2.0","id":0,"method":"client/registerCapability","params":{"registrations":[{"registerOptions":{"documentSelector":{"language":"haskell"}},"method":"workspace/executeCommand","id":"hare:demote"}]}}Content-Length: 208\r
\r
-{"jsonrpc":"2.0","method":"window/logMessage","params":{"type":4,"message":"Using ghc version: Version 0.2.0.0, Git revision 73fc39b23129436626232230e0f79a391120db5a (dirty) (1350 commits) x86_64 ghc-8.4.2"}}Content-Length: 145\r
+{"jsonrpc":"2.0","method":"window/logMessage","params":{"type":4,"message":"Using ghc version: Version 0.2.0.0, Git revision 376bd18c8907cc054dcc96cbce712032cb3a6ee0 (dirty) (1366 commits) x86_64 ghc-8.4.2"}}Content-Length: 145\r
\r
-{"jsonrpc":"2.0","method":"window/logMessage","params":{"type":4,"message":"Using hoogle db at: /Users/luke/.hoogle/default-haskell-5.0.17.hoo"}}Content-Length: 156\r
+{"jsonrpc":"2.0","method":"window/logMessage","params":{"type":4,"message":"Using hoogle db at: /Users/luke/.hoogle/default-haskell-5.0.17.hoo"}}Content-Length: 422\r
\r
-{"jsonrpc":"2.0","method":"textDocument/publishDiagnostics","params":{"uri":"file:///Users/luke/Repos/haskell-lsp-client/example/Main.hs","diagnostics":[]}}Content-Length: 156\r
+{"jsonrpc":"2.0","method":"window/logMessage","params":{"type":1,"message":"haskell-lsp:didChangeConfiguration error. NotificationMessage {_jsonrpc = \"2.0\", _method = WorkspaceDidChangeConfiguration, _params = DidChangeConfigurationParams {_settings = Object (fromList [(\"initializationOptions\",Object (fromList [(\"cacheDirectory\",String \"/tmp/lspCache\")]))])}} \"key \\\"languageServerHaskell\\\" not present\""}}Content-Length: 133\r
\r
-{"jsonrpc":"2.0","method":"textDocument/publishDiagnostics","params":{"uri":"file:///Users/luke/Repos/haskell-lsp-client/example/Main.hs","diagnostics":[]}}Content-Length: 156\r
+{"jsonrpc":"2.0","method":"textDocument/publishDiagnostics","params":{"uri":"file:///Users/luke/Desktop/simple.hs","diagnostics":[]}}Content-Length: 133\r
\r
-{"jsonrpc":"2.0","method":"textDocument/publishDiagnostics","params":{"uri":"file:///Users/luke/Repos/haskell-lsp-client/example/Main.hs","diagnostics":[]}}Content-Length: 366\r
+{"jsonrpc":"2.0","method":"textDocument/publishDiagnostics","params":{"uri":"file:///Users/luke/Desktop/simple.hs","diagnostics":[]}}Content-Length: 2627\r
\r
-{"jsonrpc":"2.0","method":"textDocument/publishDiagnostics","params":{"uri":"file:///Users/luke/Repos/haskell-lsp-client/example/Main.hs","diagnostics":[{"severity":1,"range":{"start":{"line":36,"character":27},"end":{"line":36,"character":31}},"source":"ghcmod","message":"• Variable not in scope: patj :: FilePath\n• Perhaps you meant ‘path’ (line 30)"}]}}Content-Length: 366\r
+{"result":[{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":3,"character":0},"end":{"line":3,"character":4}}},"kind":12,"name":"main"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":7,"character":5},"end":{"line":7,"character":9}}},"kind":5,"name":"Item"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":8,"character":5},"end":{"line":8,"character":10}}},"kind":5,"name":"Items"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":10,"character":5},"end":{"line":10,"character":12}}},"kind":5,"name":"Command"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":10,"character":15},"end":{"line":10,"character":19}}},"kind":9,"containerName":"Command","name":"Quit"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":11,"character":15},"end":{"line":11,"character":27}}},"kind":9,"containerName":"Command","name":"DisplayItems"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":12,"character":15},"end":{"line":12,"character":22}}},"kind":9,"containerName":"Command","name":"AddItem"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":13,"character":15},"end":{"line":13,"character":25}}},"kind":9,"containerName":"Command","name":"RemoveItem"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":14,"character":15},"end":{"line":14,"character":19}}},"kind":9,"containerName":"Command","name":"Help"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":16,"character":5},"end":{"line":16,"character":10}}},"kind":5,"name":"Error"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":19,"character":0},"end":{"line":19,"character":12}}},"kind":12,"name":"parseCommand"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":28,"character":0},"end":{"line":28,"character":7}}},"kind":12,"name":"addItem"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":31,"character":0},"end":{"line":31,"character":12}}},"kind":12,"name":"displayItems"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":34,"character":0},"end":{"line":34,"character":10}}},"kind":12,"name":"removeItem"},{"location":{"uri":"file:///Users/luke/Desktop/simple.hs","range":{"start":{"line":41,"character":0},"end":{"line":41,"character":16}}},"kind":12,"name":"interactWithUser"}],"jsonrpc":"2.0","id":25}Content-Length: 383\r
\r
-{"jsonrpc":"2.0","method":"textDocument/publishDiagnostics","params":{"uri":"file:///Users/luke/Repos/haskell-lsp-client/example/Main.hs","diagnostics":[{"severity":1,"range":{"start":{"line":36,"character":27},"end":{"line":36,"character":31}},"source":"ghcmod","message":"• Variable not in scope: patj :: FilePath\n• Perhaps you meant ‘path’ (line 30)"}]}}Content-Length: 156\r
+{"result":{"changes":{"file:///Users/luke/Desktop/simple.hs":[{"range":{"start":{"line":43,"character":0},"end":{"line":43,"character":27}},"newText":" case arseCommand line of"},{"range":{"start":{"line":18,"character":0},"end":{"line":19,"character":38}},"newText":"arseCommand :: String -> Either Error Command\narseCommand line = case words line of"}]}},"jsonrpc":"2.0","id":33}Content-Length: 133\r
\r
-{"jsonrpc":"2.0","method":"textDocument/publishDiagnostics","params":{"uri":"file:///Users/luke/Repos/haskell-lsp-client/example/Main.hs","diagnostics":[]}}Content-Length: 628\r
+{"jsonrpc":"2.0","method":"textDocument/publishDiagnostics","params":{"uri":"file:///Users/luke/Desktop/simple.hs","diagnostics":[]}}Content-Length: 133\r
\r
-{"result":{"changes":{"file:///Users/luke/Repos/haskell-lsp-client/example/Main.hs":[{"range":{"start":{"line":36,"character":0},"end":{"line":36,"character":31}},"newText":" file <- canonicalizePath notPath"},{"range":{"start":{"line":33,"character":0},"end":{"line":33,"character":54}},"newText":" hPutStrLn stderr (\"File does not exist: \" ++ notPath)"},{"range":{"start":{"line":31,"character":0},"end":{"line":31,"character":30}},"newText":" exists <- doesFileExist notPath"},{"range":{"start":{"line":29,"character":0},"end":{"line":29,"character":19}},"newText":" let [notPath] = args"}]}},"jsonrpc":"2.0","id":45}
\ No newline at end of file
+{"jsonrpc":"2.0","method":"textDocument/publishDiagnostics","params":{"uri":"file:///Users/luke/Desktop/simple.hs","diagnostics":[]}}Content-Length: 386\r
+\r
+{"result":{"changes":{"file:///Users/luke/Desktop/simple.hs":[{"range":{"start":{"line":43,"character":0},"end":{"line":43,"character":26}},"newText":" case parseCommand line of"},{"range":{"start":{"line":18,"character":0},"end":{"line":19,"character":37}},"newText":"parseCommand :: String -> Either Error Command\nparseCommand line = case words line of"}]}},"jsonrpc":"2.0","id":42}Content-Length: 133\r
+\r
+{"jsonrpc":"2.0","method":"textDocument/publishDiagnostics","params":{"uri":"file:///Users/luke/Desktop/simple.hs","diagnostics":[]}}Content-Length: 133\r
+\r
+{"jsonrpc":"2.0","method":"textDocument/publishDiagnostics","params":{"uri":"file:///Users/luke/Desktop/simple.hs","diagnostics":[]}}
\ No newline at end of file
projects / lsp-test.git / commitdiff