Skip to content

Commit c5dbf34

Browse files
isovectorisovector
committed
Merge branch 'wingman-at-lightspeed' of github.com:isovector/haskell-language-server into wingman-at-lightspeed
2 parents 97a8a4d + 5343d05 commit c5dbf34

17 files changed

+120
-40
lines changed

‎.circleci/config.yml

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -18,9 +18,9 @@ defaults: &defaults
1818

1919
- restore_cache:
2020
keys:
21-
- stack-cache-{{ .Environment.HIE_CACHE }}-{{ arch }}-{{ .Environment.CIRCLE_JOB }}-{{ checksum "stack-build.txt" }}-{{ checksum "all-cabal.txt" }}
22-
- stack-cache-{{ .Environment.HIE_CACHE }}-{{ arch }}-{{ .Environment.CIRCLE_JOB }}-{{ checksum "stack-build.txt" }}
23-
- stack-cache-{{ .Environment.HIE_CACHE }}-{{ arch }}-{{ .Environment.CIRCLE_JOB }}-{{ checksum "resolver.txt" }}
21+
- v2-stack-cache-{{ .Environment.HIE_CACHE }}-{{ arch }}-{{ .Environment.CIRCLE_JOB }}-{{ checksum "stack-build.txt" }}-{{ checksum "all-cabal.txt" }}
22+
- v2-stack-cache-{{ .Environment.HIE_CACHE }}-{{ arch }}-{{ .Environment.CIRCLE_JOB }}-{{ checksum "stack-build.txt" }}
23+
- v2-stack-cache-{{ .Environment.HIE_CACHE }}-{{ arch }}-{{ .Environment.CIRCLE_JOB }}-{{ checksum "resolver.txt" }}
2424

2525
- run:
2626
name: Stack upgrade
@@ -46,7 +46,7 @@ defaults: &defaults
4646
destination: bin
4747

4848
- save_cache:
49-
key: stack-cache-{{ .Environment.HIE_CACHE }}-{{ arch }}-{{ .Environment.CIRCLE_JOB }}-{{ checksum "resolver.txt" }}
49+
key: v2-stack-cache-{{ .Environment.HIE_CACHE }}-{{ arch }}-{{ .Environment.CIRCLE_JOB }}-{{ checksum "resolver.txt" }}
5050
paths: &cache_paths
5151
- ~/.stack
5252
- ~/build/.stack-work
@@ -58,7 +58,7 @@ defaults: &defaults
5858
no_output_timeout: 120m
5959

6060
- save_cache:
61-
key: stack-cache-{{ .Environment.HIE_CACHE }}-{{ arch }}-{{ .Environment.CIRCLE_JOB }}-{{ checksum "stack-build.txt" }}-{{ checksum "all-cabal.txt" }}
61+
key: v2-stack-cache-{{ .Environment.HIE_CACHE }}-{{ arch }}-{{ .Environment.CIRCLE_JOB }}-{{ checksum "stack-build.txt" }}-{{ checksum "all-cabal.txt" }}
6262
paths: *cache_paths
6363

6464
version: 2

‎ghcide/bench/config.yaml

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -48,6 +48,7 @@ experiments:
4848
- "code actions after edit"
4949
- "code actions after cradle edit"
5050
- "documentSymbols after edit"
51+
- "hole fit suggestions"
5152

5253
# An ordered list of versions to analyze
5354
versions:

‎ghcide/bench/lib/Experiments.hs

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,7 @@ import Data.Maybe
3131
import qualified Data.Text as T
3232
import Data.Version
3333
import Development.IDE.Plugin.Test
34+
import Development.IDE.Test.Diagnostic
3435
import Development.Shake (CmdOption (Cwd, FileStdout),
3536
cmd_)
3637
import Experiments.Types
@@ -169,6 +170,36 @@ experiments =
169170
sendNotification SWorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $
170171
List [ FileEvent (filePathToUri "hie.yaml") FcChanged ]
171172
flip allWithIdentifierPos docs $ \DocumentPositions{..} -> isJust <$> getHover doc (fromJust identifierP)
173+
),
174+
---------------------------------------------------------------------------------------
175+
benchWithSetup
176+
"hole fit suggestions"
177+
( mapM_ $ \DocumentPositions{..} -> do
178+
let edit :: TextDocumentContentChangeEvent =TextDocumentContentChangeEvent
179+
{ _range = Just Range {_start = bottom, _end = bottom}
180+
, _rangeLength = Nothing, _text = t}
181+
bottom = Position maxBound 0
182+
t = T.unlines
183+
[""
184+
,"holef :: [Int] -> [Int]"
185+
,"holef = _"
186+
,""
187+
,"holeg :: [()] -> [()]"
188+
,"holeg = _"
189+
]
190+
changeDoc doc [edit]
191+
)
192+
(\docs -> do
193+
forM_ docs $ \DocumentPositions{..} ->
194+
changeDoc doc [charEdit stringLiteralP]
195+
void waitForDiagnostics
196+
waitForProgressDone
197+
flip allM docs $ \DocumentPositions{..} -> do
198+
bottom <- pred . length . T.lines <$> documentContents doc
199+
diags <- getCurrentDiagnostics doc
200+
case requireDiagnostic diags (DsError, (bottom, 8), "Found hole", Nothing) of
201+
Nothing -> pure True
202+
Just _err -> pure False
172203
)
173204
]
174205

‎ghcide/ghcide.cabal

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -370,6 +370,7 @@ test-suite ghcide-tests
370370
main-is: Main.hs
371371
other-modules:
372372
Development.IDE.Test
373+
Development.IDE.Test.Diagnostic
373374
Development.IDE.Test.Runfiles
374375
Experiments
375376
Experiments.Types
@@ -403,17 +404,20 @@ executable ghcide-bench
403404
extra,
404405
filepath,
405406
ghcide,
407+
lens,
406408
lsp-test,
409+
lsp-types,
407410
optparse-applicative,
408411
process,
409412
safe-exceptions,
410413
hls-graph,
411414
shake,
412415
text
413-
hs-source-dirs: bench/lib bench/exe
416+
hs-source-dirs: bench/lib bench/exe test/src
414417
ghc-options: -threaded -Wall -Wno-name-shadowing -rtsopts
415418
main-is: Main.hs
416419
other-modules:
420+
Development.IDE.Test.Diagnostic
417421
Experiments
418422
Experiments.Types
419423
default-extensions:

‎ghcide/test/exe/Main.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5137,6 +5137,7 @@ benchmarkTests =
51375137
assertBool "did not successfully complete 5 repetitions" $ Bench.success res
51385138
| e <- Bench.experiments
51395139
, Bench.name e /= "edit" -- the edit experiment does not ever fail
5140+
, Bench.name e /= "hole fit suggestions" -- is too slow!
51405141
-- the cradle experiments are way too slow
51415142
, not ("cradle" `isInfixOf` Bench.name e)
51425143
]

‎ghcide/test/src/Development/IDE/Test.hs

Lines changed: 10 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -33,6 +33,7 @@ import Data.Maybe (fromJust)
3333
import qualified Data.Text as T
3434
import Development.IDE.Plugin.Test (TestRequest (..),
3535
WaitForIdeRuleResult)
36+
import Development.IDE.Test.Diagnostic
3637
import Language.LSP.Test hiding (message)
3738
import qualified Language.LSP.Test as LspTest
3839
import Language.LSP.Types
@@ -41,31 +42,14 @@ import System.Directory (canonicalizePath)
4142
import System.Time.Extra
4243
import Test.Tasty.HUnit
4344

44-
-- | (0-based line number, 0-based column number)
45-
type Cursor = (Int, Int)
46-
47-
cursorPosition :: Cursor -> Position
48-
cursorPosition (line, col) = Position line col
49-
50-
requireDiagnostic :: HasCallStack => List Diagnostic -> (DiagnosticSeverity, Cursor, T.Text, Maybe DiagnosticTag) -> Assertion
51-
requireDiagnostic actuals expected@(severity, cursor, expectedMsg, expectedTag) = do
52-
unless (any match actuals) $
53-
assertFailure $
54-
"Could not find " <> show expected <>
55-
" in " <> show actuals
56-
where
57-
match :: Diagnostic -> Bool
58-
match d =
59-
Just severity == _severity d
60-
&& cursorPosition cursor == d ^. range . start
61-
&& standardizeQuotes (T.toLower expectedMsg) `T.isInfixOf`
62-
standardizeQuotes (T.toLower $ d ^. message)
63-
&& hasTag expectedTag (d ^. tags)
64-
65-
hasTag :: Maybe DiagnosticTag -> Maybe (List DiagnosticTag) -> Bool
66-
hasTag Nothing _ = True
67-
hasTag (Just _) Nothing = False
68-
hasTag (Just actualTag) (Just (List tags)) = actualTag `elem` tags
45+
requireDiagnosticM
46+
:: (Foldable f, Show (f Diagnostic), HasCallStack)
47+
=> f Diagnostic
48+
-> (DiagnosticSeverity, Cursor, T.Text, Maybe DiagnosticTag)
49+
-> Assertion
50+
requireDiagnosticM actuals expected = case requireDiagnostic actuals expected of
51+
Nothing -> pure ()
52+
Just err -> assertFailure err
6953

7054
-- |wait for @timeout@ seconds and report an assertion failure
7155
-- if any diagnostic messages arrive in that period
@@ -154,7 +138,7 @@ expectDiagnosticsWithTags' next expected = go expected
154138
<> " got "
155139
<> show actual
156140
Just expected -> do
157-
liftIO $ mapM_ (requireDiagnostic actual) expected
141+
liftIO $ mapM_ (requireDiagnosticM actual) expected
158142
liftIO $
159143
unless (length expected == length actual) $
160144
assertFailure $
@@ -182,14 +166,6 @@ canonicalizeUri uri = filePathToUri <$> canonicalizePath (fromJust (uriToFilePat
182166
diagnostic :: Session (NotificationMessage TextDocumentPublishDiagnostics)
183167
diagnostic = LspTest.message STextDocumentPublishDiagnostics
184168

185-
standardizeQuotes :: T.Text -> T.Text
186-
standardizeQuotes msg = let
187-
repl '‘' = '\''
188-
repl '’' = '\''
189-
repl '`' = '\''
190-
repl c = c
191-
in T.map repl msg
192-
193169
waitForAction :: String -> TextDocumentIdentifier -> Session (Either ResponseError WaitForIdeRuleResult)
194170
waitForAction key TextDocumentIdentifier{_uri} = do
195171
let cm = SCustomMethod "test"

‎ghcide/test/src/Development/IDE/Test/Diagnostic.hs

Lines changed: 47 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,47 @@
1+
module Development.IDE.Test.Diagnostic where
2+
3+
import Control.Lens ((^.))
4+
import qualified Data.Text as T
5+
import GHC.Stack (HasCallStack)
6+
import Language.LSP.Types
7+
import Language.LSP.Types.Lens as Lsp
8+
9+
-- | (0-based line number, 0-based column number)
10+
type Cursor = (Int, Int)
11+
12+
cursorPosition :: Cursor -> Position
13+
cursorPosition (line, col) = Position line col
14+
15+
type ErrorMsg = String
16+
17+
requireDiagnostic
18+
:: (Foldable f, Show (f Diagnostic), HasCallStack)
19+
=> f Diagnostic
20+
-> (DiagnosticSeverity, Cursor, T.Text, Maybe DiagnosticTag)
21+
-> Maybe ErrorMsg
22+
requireDiagnostic actuals expected@(severity, cursor, expectedMsg, expectedTag)
23+
| any match actuals = Nothing
24+
| otherwise = Just $
25+
"Could not find " <> show expected <>
26+
" in " <> show actuals
27+
where
28+
match :: Diagnostic -> Bool
29+
match d =
30+
Just severity == _severity d
31+
&& cursorPosition cursor == d ^. range . start
32+
&& standardizeQuotes (T.toLower expectedMsg) `T.isInfixOf`
33+
standardizeQuotes (T.toLower $ d ^. message)
34+
&& hasTag expectedTag (d ^. tags)
35+
36+
hasTag :: Maybe DiagnosticTag -> Maybe (List DiagnosticTag) -> Bool
37+
hasTag Nothing _ = True
38+
hasTag (Just _) Nothing = False
39+
hasTag (Just actualTag) (Just (List tags)) = actualTag `elem` tags
40+
41+
standardizeQuotes :: T.Text -> T.Text
42+
standardizeQuotes msg = let
43+
repl '‘' = '\''
44+
repl '’' = '\''
45+
repl '`' = '\''
46+
repl c = c
47+
in T.map repl msg

‎stack-8.10.2.yaml

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -69,6 +69,8 @@ extra-deps:
6969
- unliftio-core-0.2.0.1@sha256:9b3e44ea9aacacbfc35b3b54015af450091916ac3618a41868ebf6546977659a,1082
7070

7171
configure-options:
72+
$targets:
73+
- --enable-executable-dynamic
7274
ghcide:
7375
- --disable-library-for-ghci
7476
haskell-language-server:

‎stack-8.10.3.yaml

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -69,6 +69,8 @@ extra-deps:
6969
- unliftio-core-0.2.0.1@sha256:9b3e44ea9aacacbfc35b3b54015af450091916ac3618a41868ebf6546977659a,1082
7070

7171
configure-options:
72+
$targets:
73+
- --enable-executable-dynamic
7274
ghcide:
7375
- --disable-library-for-ghci
7476
haskell-language-server:

‎stack-8.10.4.yaml

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -71,6 +71,8 @@ extra-deps:
7171
# - hlint-3.3@sha256:4218ad6e03050f5d68aeba0e025f5f05e366c8fd49657f2a19df04ee31b2bb23,4154
7272

7373
configure-options:
74+
$targets:
75+
- --enable-executable-dynamic
7476
ghcide:
7577
- --disable-library-for-ghci
7678
haskell-language-server:

‎stack-8.10.5.yaml

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -73,6 +73,8 @@ extra-deps:
7373
# - hlint-3.3@sha256:4218ad6e03050f5d68aeba0e025f5f05e366c8fd49657f2a19df04ee31b2bb23,4154
7474

7575
configure-options:
76+
$targets:
77+
- --enable-executable-dynamic
7678
ghcide:
7779
- --disable-library-for-ghci
7880
haskell-language-server:

‎stack-8.6.4.yaml

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -118,6 +118,8 @@ flags:
118118

119119

120120
configure-options:
121+
$targets:
122+
- --enable-executable-dynamic
121123
ghcide:
122124
- --disable-library-for-ghci
123125
haskell-language-server:

‎stack-8.6.5.yaml

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -107,6 +107,8 @@ extra-deps:
107107
- resourcet-1.2.3
108108

109109
configure-options:
110+
$targets:
111+
- --enable-executable-dynamic
110112
ghcide:
111113
- --disable-library-for-ghci
112114
haskell-language-server:

‎stack-8.8.3.yaml

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -86,6 +86,8 @@ extra-deps:
8686
- unliftio-core-0.2.0.1@sha256:9b3e44ea9aacacbfc35b3b54015af450091916ac3618a41868ebf6546977659a,1082
8787

8888
configure-options:
89+
$targets:
90+
- --enable-executable-dynamic
8991
ghcide:
9092
- --disable-library-for-ghci
9193
haskell-language-server:

‎stack-8.8.4.yaml

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -83,6 +83,8 @@ extra-deps:
8383
- unliftio-core-0.2.0.1@sha256:9b3e44ea9aacacbfc35b3b54015af450091916ac3618a41868ebf6546977659a,1082
8484

8585
configure-options:
86+
$targets:
87+
- --enable-executable-dynamic
8688
ghcide:
8789
- --disable-library-for-ghci
8890
haskell-language-server:

‎stack-9.0.1.yaml

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -101,6 +101,8 @@ extra-deps:
101101
commit: 16e19aaf34e286f3d27b3988c61040823ec66537
102102

103103
configure-options:
104+
$targets:
105+
- --enable-executable-dynamic
104106
ghcide:
105107
- --disable-library-for-ghci
106108
haskell-language-server:

‎stack.yaml

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -62,6 +62,8 @@ extra-deps:
6262
- unliftio-core-0.2.0.1@sha256:9b3e44ea9aacacbfc35b3b54015af450091916ac3618a41868ebf6546977659a,1082
6363

6464
configure-options:
65+
$targets:
66+
- --enable-executable-dynamic
6567
ghcide:
6668
- --disable-library-for-ghci
6769
haskell-language-server:

0 commit comments

Comments
 (0)