Skip to content

Commit 50d4b0a

Browse files
committed
refactor: Create a type-level expect failure
1 parent edfc677 commit 50d4b0a

File tree

3 files changed

+47
-10
lines changed

3 files changed

+47
-10
lines changed

ghcide/test/exe/ReferenceTests.hs

Lines changed: 33 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE DataKinds #-}
12
{-# LANGUAGE GADTs #-}
23
{-# LANGUAGE OverloadedStrings #-}
34

@@ -30,10 +31,13 @@ import Ide.PluginUtils (toAbsolute)
3031
import Ide.Types
3132
import System.FilePath (addTrailingPathSeparator,
3233
(</>))
33-
import Test.Hls (FromServerMessage' (..),
34+
import Test.Hls (BrokenBehavior (..),
35+
ExpectBroken (..),
36+
FromServerMessage' (..),
3437
SMethod (..),
3538
TCustomMessage (..),
36-
TNotificationMessage (..))
39+
TNotificationMessage (..),
40+
unCurrent)
3741
import Test.Hls.FileSystem (copyDir)
3842
import Test.Tasty
3943
import Test.Tasty.HUnit
@@ -90,15 +94,24 @@ tests = testGroup "references"
9094
]
9195

9296
-- TODO: references provider does not respect includeDeclaration parameter
93-
, referenceTest "INCORRECTLY returns declarations when we ask to exclude them"
97+
, referenceTestExpectFail "works when we ask to exclude declarations"
9498
("References.hs", 4, 7)
9599
NoExcludeDeclaration
96-
[ ("References.hs", 4, 6)
97-
, ("References.hs", 6, 0)
98-
, ("References.hs", 6, 14)
99-
, ("References.hs", 9, 7)
100-
, ("References.hs", 10, 11)
101-
]
100+
(BrokenIdeal
101+
[ ("References.hs", 6, 0)
102+
, ("References.hs", 6, 14)
103+
, ("References.hs", 9, 7)
104+
, ("References.hs", 10, 11)
105+
]
106+
)
107+
(BrokenCurrent
108+
[ ("References.hs", 4, 6)
109+
, ("References.hs", 6, 0)
110+
, ("References.hs", 6, 14)
111+
, ("References.hs", 9, 7)
112+
, ("References.hs", 10, 11)
113+
]
114+
)
102115
]
103116

104117
, testGroup "can get references to non FOIs"
@@ -194,6 +207,17 @@ referenceTest name loc includeDeclaration expected =
194207
where
195208
docs = map fst3 expected
196209

210+
referenceTestExpectFail
211+
:: (HasCallStack)
212+
=> String
213+
-> SymbolLocation
214+
-> IncludeDeclaration
215+
-> ExpectBroken 'Ideal [SymbolLocation]
216+
-> ExpectBroken 'Current [SymbolLocation]
217+
-> TestTree
218+
referenceTestExpectFail name loc includeDeclaration _ =
219+
referenceTest name loc includeDeclaration . unCurrent
220+
197221
type SymbolLocation = (FilePath, UInt, UInt)
198222

199223
expectSameLocations :: (HasCallStack) => FilePath -> [Location] -> [SymbolLocation] -> Assertion

hls-test-utils/src/Test/Hls.hs

Lines changed: 13 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -39,6 +39,10 @@ module Test.Hls
3939
-- * Helpful re-exports
4040
PluginDescriptor,
4141
IdeState,
42+
-- * Helpers for expected test case failuers
43+
BrokenBehavior(..),
44+
ExpectBroken(..),
45+
unCurrent,
4246
-- * Assertion helper functions
4347
waitForProgressDone,
4448
waitForAllProgressDone,
@@ -166,6 +170,15 @@ instance Pretty LogTestHarness where
166170
LogCleanup -> "Cleaned up temporary directory"
167171
LogNoCleanup -> "No cleanup of temporary directory"
168172

173+
data BrokenBehavior = Current | Ideal
174+
175+
data ExpectBroken (k :: BrokenBehavior) a where
176+
BrokenCurrent :: a -> ExpectBroken 'Current a
177+
BrokenIdeal :: a -> ExpectBroken 'Ideal a
178+
179+
unCurrent :: ExpectBroken 'Current a -> a
180+
unCurrent (BrokenCurrent a) = a
181+
169182
-- | Run 'defaultMainWithRerun', limiting each single test case running at most 10 minutes
170183
defaultTestRunner :: TestTree -> IO ()
171184
defaultTestRunner = defaultMainWithRerun . adjustOption (const $ mkTimeout 600000000)
@@ -903,4 +916,3 @@ kick proxyMsg = do
903916
case fromJSON _params of
904917
Success x -> return x
905918
other -> error $ "Failed to parse kick/done details: " <> show other
906-

plugins/hls-explicit-fixity-plugin/src/Ide/Plugin/ExplicitFixity.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE DataKinds #-}
12
{-# LANGUAGE LambdaCase #-}
23
{-# LANGUAGE OverloadedStrings #-}
34
{-# LANGUAGE TypeFamilies #-}

0 commit comments

Comments
 (0)