Initial commit

diff --git a/.gitignore b/.gitignore
new file mode 100644 (file)
index 0000000..5e6993c
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+.stack-work
+**/.DS_Store

diff --git a/LICENSE b/LICENSE
new file mode 100644 (file)
index 0000000..de86d49
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright Luke Lau (c) 2018
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Luke Lau nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
\ No newline at end of file

diff --git a/README.md b/README.md
new file mode 100644 (file)
index 0000000..b42dfcf
--- /dev/null
+++ b/README.md
@@ -0,0 +1,2 @@
+# haskell-lsp-test
+This is the functional testing framework for [haskell-ide-engine](https://github.com/haskell/haskell-ide-engine), and potentially any other Language Server Protocol server.

diff --git a/Setup.hs b/Setup.hs
new file mode 100644 (file)
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

diff --git a/example/Main.hs b/example/Main.hs
new file mode 100644 (file)
index 0000000..9318bcb
--- /dev/null
+++ b/example/Main.hs
@@ -0,0 +1,16 @@
+import Language.Haskell.LSP.Test
+import qualified Language.Haskell.LSP.TH.DataTypesJSON as LSP
+import qualified Data.Text.IO as T
+import Control.Lens
+import Control.Monad
+import Control.Monad.IO.Class
+import System.Directory
+import System.Environment
+
+main = do
+  files <- getArgs
+  forM_ files $ \file -> session $ do
+    file <- liftIO $ canonicalizePath file
+    openDocument file
+    symbols <- documentSymbols file
+    liftIO $ mapM_ T.putStrLn (symbols ^.. traverse . LSP.name)

diff --git a/haskell-lsp-test.cabal b/haskell-lsp-test.cabal
new file mode 100644 (file)
index 0000000..44c0487
--- /dev/null
+++ b/haskell-lsp-test.cabal
@@ -0,0 +1,44 @@
+name:                haskell-lsp-test
+version:             0.1.0.0
+-- synopsis:
+-- description:
+homepage:            https://github.com/Bubba/haskell-lsp-test#readme
+license:             BSD3
+license-file:        LICENSE
+author:              Luke Lau
+maintainer:          luke_lau@icloud.com
+copyright:           2018 Luke Lau
+category:            Testing
+build-type:          Simple
+cabal-version:       >=1.10
+extra-source-files:  README.md
+
+library
+  hs-source-dirs:      src
+  exposed-modules:     Language.Haskell.LSP.Test
+  default-language:    Haskell2010
+  build-depends:       base >= 4.7 && < 5
+                     , haskell-lsp-client
+                     , haskell-lsp-types
+                     , lens
+                     , text
+                     , transformers
+                     , process
+  if os(windows)
+    build-depends:     win32
+  else
+    build-depends:     unix
+  other-modules:       Compat
+                       Capabilities
+  ghc-options:         -W
+
+executable example
+  hs-source-dirs:      example
+  main-is:             Main.hs
+  default-language:    Haskell2010
+  build-depends:       base >= 4.7 && < 5
+                     , haskell-lsp-test
+                     , haskell-lsp-types
+                     , lens
+                     , text
+                     , directory

diff --git a/src/Capabilities.hs b/src/Capabilities.hs
new file mode 100644 (file)
index 0000000..f1cc6ee
--- /dev/null
+++ b/src/Capabilities.hs
@@ -0,0 +1,43 @@
+module Capabilities where
+
+import Language.Haskell.LSP.TH.ClientCapabilities
+
+capabilities :: ClientCapabilities
+capabilities = ClientCapabilities (Just workspaceCapabilities)
+                                  (Just textDocumentCapabilities)
+                                  Nothing
+  where
+    workspaceCapabilities = WorkspaceClientCapabilities
+      (Just False)
+      (Just (WorkspaceEditClientCapabilities (Just False)))
+      (Just (DidChangeConfigurationClientCapabilities (Just False)))
+      (Just (DidChangeWatchedFilesClientCapabilities (Just False)))
+      (Just (SymbolClientCapabilities (Just False)))
+      (Just (ExecuteClientCapabilities (Just False)))
+    textDocumentCapabilities = TextDocumentClientCapabilities
+      (Just
+        (SynchronizationTextDocumentClientCapabilities (Just False)
+                                                        (Just False)
+                                                        (Just False)
+                                                        (Just False)
+        )
+      )
+      (Just
+        (CompletionClientCapabilities
+          (Just False)
+          (Just (CompletionItemClientCapabilities (Just False)))
+        )
+      )
+      (Just (HoverClientCapabilities (Just False)))
+      (Just (SignatureHelpClientCapabilities (Just False)))
+      (Just (ReferencesClientCapabilities (Just False)))
+      (Just (DocumentHighlightClientCapabilities (Just False)))
+      (Just (DocumentSymbolClientCapabilities (Just False)))
+      (Just (FormattingClientCapabilities (Just False)))
+      (Just (RangeFormattingClientCapabilities (Just False)))
+      (Just (OnTypeFormattingClientCapabilities (Just False)))
+      (Just (DefinitionClientCapabilities (Just False)))
+      (Just (CodeActionClientCapabilities (Just False)))
+      (Just (CodeLensClientCapabilities (Just False)))
+      (Just (DocumentLinkClientCapabilities (Just False)))
+      (Just (RenameClientCapabilities (Just False)))

diff --git a/src/Compat.hs b/src/Compat.hs
new file mode 100644 (file)
index 0000000..23a3ff1
--- /dev/null
+++ b/src/Compat.hs
@@ -0,0 +1,18 @@
+{-# LANGUAGE CPP #-}
+
+module Compat where
+
+
+#ifdef mingw32_HOST_OS
+
+import qualified System.Win32.Process as P (getCurrentProcessId)
+getProcessID :: IO Int
+getProcessID = fromIntegral <$> P.getCurrentProcessId
+
+#else
+
+import qualified System.Posix.Process as P (getProcessID)
+getProcessID :: IO Int
+getProcessID = fromIntegral <$> P.getProcessID
+
+#endif

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
new file mode 100644 (file)
index 0000000..6ee8405
--- /dev/null
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -0,0 +1,120 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Language.Haskell.LSP.Test
+  (
+  -- * Sessions
+    session
+  -- * Documents
+  , openDocument
+  , documentSymbols
+  ) where
+
+import Control.Lens
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Reader
+import qualified Data.Text as T
+import qualified Data.Text.IO as T
+import Data.Maybe
+import Data.Proxy
+import System.Process
+import qualified Language.Haskell.LSP.Client as Client
+import qualified Language.Haskell.LSP.TH.DataTypesJSON as LSP
+import Capabilities
+import Compat
+
+type Session = ReaderT Client.Client IO
+
+session :: Session a -> IO ()
+session f = do
+  (Just hin, Just hout, _, serverProc) <- createProcess (proc "hie" ["--lsp", "-l", "/tmp/hie.log"])
+    { std_in = CreatePipe, std_out = CreatePipe }
+  client <- Client.start $ Client.Config hin hout notificationHandler requestHandler
+
+  pid <- getProcessID
+
+  let initializeParams :: LSP.InitializeParams
+      initializeParams = LSP.InitializeParams (Just pid)
+                                              Nothing
+                                              Nothing
+                                              Nothing
+                                              capabilities
+                                              Nothing
+
+  Client.sendClientRequest client
+                           (Proxy :: Proxy LSP.InitializeRequest)
+                           LSP.Initialize initializeParams
+  Client.sendClientNotification client
+                                LSP.Initialized
+                                (Just LSP.InitializedParams)
+
+  putStrLn "Session started"
+
+  runReaderT f client
+
+  Client.sendClientRequest client
+                           (Proxy :: Proxy LSP.ShutdownRequest)
+                           LSP.Shutdown Nothing
+  Client.sendClientNotification client
+                                LSP.Exit
+                                (Just LSP.ExitParams)
+
+  Client.stop client
+  
+  -- todo: this interrupts the test server process as well?
+  -- interruptProcessGroupOf serverProc
+  -- waitForProcess serverProc
+  terminateProcess serverProc
+
+  putStrLn "Session ended"
+
+openDocument :: FilePath -> Session ()
+openDocument path = do
+  text <- liftIO $ T.readFile path
+
+  let uri = LSP.filePathToUri path
+
+  client <- ask
+  liftIO $ Client.sendClientNotification client LSP.TextDocumentDidOpen (Just (LSP.DidOpenTextDocumentParams (LSP.TextDocumentItem uri "haskell" 1 text)))
+
+documentSymbols :: FilePath -> Session (LSP.List LSP.SymbolInformation)
+documentSymbols path = do
+  let uri = LSP.filePathToUri path
+
+  client <- ask
+
+  liftIO $ do
+    res <- Client.sendClientRequest client
+                                    (Proxy :: Proxy LSP.DocumentSymbolRequest)
+                                    LSP.TextDocumentDocumentSymbol (LSP.DocumentSymbolParams (LSP.TextDocumentIdentifier uri))
+    return $ case res of
+      Just (Right syms) -> syms
+      _ -> error "Failed to get document symbols"
+
+notificationHandler :: Client.NotificationMessageHandler
+notificationHandler = Client.NotificationMessageHandler
+  (\(LSP.NotificationMessage _ _ (LSP.ShowMessageParams _ msg)) -> print msg)
+  (\(LSP.NotificationMessage _ _ (LSP.LogMessageParams _ msg)) -> print msg)
+  (\(LSP.NotificationMessage _ _ json) -> putStrLn $ "Telemetry: " ++ show json)
+  (\(LSP.NotificationMessage _ _ (LSP.PublishDiagnosticsParams uri diags)) ->
+    putStrLn $ "Diagnostics at " ++ showUri uri ++ ": " ++ showDiags diags)
+
+  where showDiags :: LSP.List LSP.Diagnostic -> String
+        showDiags (LSP.List diags) = unlines $ map (T.unpack . (^. LSP.message)) diags
+        showUri :: LSP.Uri -> String
+        showUri = fromMaybe "unknown path" . LSP.uriToFilePath
+
+
+
+requestHandler :: Client.RequestMessageHandler
+requestHandler = Client.RequestMessageHandler
+  (\m -> emptyRsp m <$ print m)
+  (\m -> emptyRsp m <$ print m)
+  (\m -> emptyRsp m <$ print m)
+  (\m -> emptyRsp m <$ print m)
+  where emptyRsp :: LSP.RequestMessage m req rsp -> LSP.ResponseMessage a
+        emptyRsp m = LSP.ResponseMessage (m ^. LSP.jsonrpc)
+                                         (lspIdToRspId $ m ^. LSP.id)
+                                         Nothing
+                                         Nothing
+
+        lspIdToRspId (LSP.IdInt i) = LSP.IdRspInt i
+        lspIdToRspId (LSP.IdString i) = LSP.IdRspString i

diff --git a/stack.yaml b/stack.yaml
new file mode 100644 (file)
index 0000000..d1bf7cc
--- /dev/null
+++ b/stack.yaml
@@ -0,0 +1,8 @@
+resolver: nightly-2018-04-24
+packages:
+  - .
+
+extra-deps:
+  - github: Bubba/haskell-lsp-client
+    commit: b7cf14eb48837a73032e867dab90db1708220c66
+  - haskell-lsp-types-0.2.2.0