@@ -39,55 +39,17 @@ tests = let
39
39
case hover of
40
40
Nothing -> unless (expected == ExpectNoHover ) $ liftIO $ assertFailure " no hover found"
41
41
Just Hover {_contents = (InL MarkupContent {_value = standardizeQuotes -> msg})
42
- ,_range = rangeInHover } ->
42
+ ,_range = _rangeInHover } ->
43
43
case expected of
44
- ExpectRange expectedRange -> checkHoverRange expectedRange rangeInHover msg
45
- ExpectHoverRange expectedRange -> checkHoverRange expectedRange rangeInHover msg
44
+ ExpectRange _expectedRange -> liftIO $ assertFailure $ " ExpectRange assertion not implemented, yet. "
45
+ ExpectHoverRange _expectedRange -> liftIO $ assertFailure $ " ExpectHoverRange assertion not implemented, yet. "
46
46
ExpectHoverText snippets -> liftIO $ traverse_ (`assertFoundIn` msg) snippets
47
47
ExpectHoverExcludeText snippets -> liftIO $ traverse_ (`assertNotFoundIn` msg) snippets
48
48
ExpectHoverTextRegex re -> liftIO $ assertBool (" Regex not found in " <> T. unpack msg) (msg =~ re :: Bool )
49
49
ExpectNoHover -> liftIO $ assertFailure $ " Expected no hover but got " <> show hover
50
50
_ -> pure () -- all other expectations not relevant to hover
51
51
_ -> liftIO $ assertFailure $ " test not expecting this kind of hover info" <> show hover
52
52
53
- extractLineColFromHoverMsg :: T. Text -> [T. Text ]
54
- extractLineColFromHoverMsg =
55
- -- Hover messages contain multiple lines, and we are looking for the definition
56
- -- site
57
- T. lines
58
- -- The line we are looking for looks like: "*Defined at /tmp/GotoHover.hs:22:3*"
59
- -- So filter by the start of the line
60
- >>> mapMaybe (T. stripPrefix " *Defined at" )
61
- -- There can be multiple definitions per hover message!
62
- -- See the test "field in record definition" for example.
63
- -- The tests check against the last line that contains the above line.
64
- >>> last
65
- -- [" /tmp/", "22:3*"]
66
- >>> T. splitOn (sourceFileName <> " :" )
67
- -- "22:3*"
68
- >>> last
69
- -- ["22:3", ""]
70
- >>> T. splitOn " *"
71
- -- "22:3"
72
- >>> head
73
- -- ["22", "3"]
74
- >>> T. splitOn " :"
75
-
76
- checkHoverRange :: Range -> Maybe Range -> T. Text -> Session ()
77
- checkHoverRange expectedRange rangeInHover msg =
78
- let
79
- lineCol = extractLineColFromHoverMsg msg
80
- -- looks like hovers use 1-based numbering while definitions use 0-based
81
- -- turns out that they are stored 1-based in RealSrcLoc by GHC itself.
82
- adjust Position {_line = l, _character = c} =
83
- Position {_line = l + 1 , _character = c + 1 }
84
- in
85
- case map (read . T. unpack) lineCol of
86
- [l,c] -> liftIO $ adjust (expectedRange ^. L. start) @=? Position l c
87
- _ -> liftIO $ assertFailure $
88
- " expected: " <> show (" [...]" <> sourceFileName <> " :<LINE>:<COL>**[...]" , Just expectedRange) <>
89
- " \n but got: " <> show (msg, rangeInHover)
90
-
91
53
assertFoundIn :: T. Text -> T. Text -> Assertion
92
54
assertFoundIn part whole = assertBool
93
55
(T. unpack $ " failed to find: `" <> part <> " ` in hover message:\n " <> whole)
0 commit comments