@@ -0,0 +1,75 @@
1+-- Copyright (c) 2019 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
2+-- SPDX-License-Identifier: Apache-2.0
3+
4+{-# LANGUAGE OverloadedStrings #-}
5+
6+module Main (main) where
7+
8+import Control.Monad (void)
9+import qualified Data.Text as T
10+import Development.IDE.Test
11+import Language.Haskell.LSP.Test
12+import Language.Haskell.LSP.Types
13+import System.Environment.Blank (setEnv)
14+import System.FilePath
15+import System.IO.Extra
16+import Test.Tasty
17+import Test.Tasty.HUnit
18+
19+import DA.Bazel.Runfiles
20+
21+
22+main :: IO ()
23+main = defaultMain $ testGroup "HIE"
24+ [ testSession "open close" $ do
25+ doc <- openDoc' "Testing.hs" "haskell" ""
26+ void (message :: Session ProgressStartNotification)
27+ closeDoc doc
28+ void (message :: Session ProgressDoneNotification)
29+ , testSession "fix syntax error" $ do
30+ let content = T.unlines [ "module Testing wher" ]
31+ doc <- openDoc' "Testing.hs" "haskell" content
32+ expectDiagnostics [("Testing.hs", [(DsError, (0, 15), "parse error")])]
33+ let change = TextDocumentContentChangeEvent
34+ { _range = Just (Range (Position 0 15) (Position 0 19))
35+ , _rangeLength = Nothing
36+ , _text = "where"
37+ }
38+ changeDoc doc [change]
39+ expectDiagnostics [("Testing.hs", [])]
40+ , testSession "introduce syntax error" $ do
41+ let content = T.unlines [ "module Testing where" ]
42+ doc <- openDoc' "Testing.hs" "haskell" content
43+ void (message :: Session ProgressStartNotification)
44+ let change = TextDocumentContentChangeEvent
45+ { _range = Just (Range (Position 0 15) (Position 0 18))
46+ , _rangeLength = Nothing
47+ , _text = "wher"
48+ }
49+ changeDoc doc [change]
50+ expectDiagnostics [("Testing.hs", [(DsError, (0, 15), "parse error")])]
51+ ]
52+
53+
54+----------------------------------------------------------------------
55+-- Utils
56+
57+
58+testSession :: String -> Session () -> TestTree
59+testSession name = testCase name . run
60+
61+
62+run :: Session a -> IO a
63+run s = withTempDir $ \dir -> do
64+ let hieCoreExePath = mainWorkspace </> exe "compiler/hie-core/hie-core-exe"
65+ hieCoreExe <- locateRunfiles hieCoreExePath
66+ let cmd = unwords [hieCoreExe, "--lsp", "--cwd", dir]
67+ -- HIE calls getXgdDirectory which assumes that HOME is set.
68+ -- Only sets HOME if it wasn't already set.
69+ setEnv "HOME" "/homeless-shelter" False
70+ runSessionWithConfig conf cmd fullCaps dir s
71+ where
72+ conf = defaultConfig
73+ -- If you uncomment this you can see all messages
74+ -- which can be quite useful for debugging.
75+ -- { logMessages = True, logColor = False, logStdErr = True }