9
9
{-# LANGUAGE PolyKinds #-}
10
10
{-# LANGUAGE RecordWildCards #-}
11
11
{-# LANGUAGE TypeOperators #-}
12
- {-# OPTIONS_GHC -Wno-deprecations -Wno- unticked-promoted-constructors #-}
12
+ {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
13
13
14
14
module Main
15
15
( main
@@ -33,9 +33,7 @@ import Ide.Types
33
33
import qualified Language.LSP.Protocol.Lens as L
34
34
import Language.LSP.Protocol.Message
35
35
import Language.LSP.Protocol.Types hiding
36
- (SemanticTokenAbsolute (length , line ),
37
- SemanticTokenRelative (length ),
38
- SemanticTokensEdit (_start ),
36
+ (SemanticTokensEdit (_start ),
39
37
mkRange )
40
38
import Language.LSP.Test
41
39
import System.Directory
@@ -81,6 +79,7 @@ tests =
81
79
, completionTests
82
80
]
83
81
82
+ initializeTests :: TestTree
84
83
initializeTests = withResource acquire release tests
85
84
where
86
85
tests :: IO (TResponseMessage Method_Initialize ) -> TestTree
@@ -640,7 +639,10 @@ renameActionTests = testGroup "rename actions"
640
639
doc <- createDoc " Testing.hs" " haskell" content
641
640
_ <- waitForDiagnostics
642
641
actionsOrCommands <- getCodeActions doc (Range (Position 3 12 ) (Position 3 20 ))
643
- [fixTypo] <- pure [action | InR action@ CodeAction { _title = actionTitle } <- actionsOrCommands, " monus" `T.isInfixOf` actionTitle , " Replace" `T.isInfixOf` actionTitle]
642
+ [fixTypo] <- pure [action | InR action@ CodeAction { _title = actionTitle } <- actionsOrCommands
643
+ , " monus" `T.isInfixOf` actionTitle
644
+ , " Replace" `T.isInfixOf` actionTitle
645
+ ]
644
646
executeCodeAction fixTypo
645
647
contentAfterAction <- documentContents doc
646
648
let expectedContentAfterAction = T. unlines
@@ -659,9 +661,11 @@ renameActionTests = testGroup "rename actions"
659
661
, " foo = 'bread"
660
662
]
661
663
doc <- createDoc " Testing.hs" " haskell" content
662
- diags <- waitForDiagnostics
664
+ _ <- waitForDiagnostics
663
665
actionsOrCommands <- getCodeActions doc (Range (Position 4 6 ) (Position 4 12 ))
664
- [fixTypo] <- pure [action | InR action@ CodeAction { _title = actionTitle } <- actionsOrCommands, " break" `T.isInfixOf` actionTitle ]
666
+ [fixTypo] <- pure [action | InR action@ CodeAction { _title = actionTitle } <- actionsOrCommands
667
+ , " break" `T.isInfixOf` actionTitle
668
+ ]
665
669
executeCodeAction fixTypo
666
670
contentAfterAction <- documentContents doc
667
671
let expectedContentAfterAction = T. unlines
@@ -776,9 +780,9 @@ typeWildCardActionTests = testGroup "type wildcard actions"
776
780
doc <- createDoc " Testing.hs" " haskell" content
777
781
_ <- waitForDiagnostics
778
782
actionsOrCommands <- getAllCodeActions doc
779
- let [addSignature] = [action | InR action@ CodeAction { _title = actionTitle } <- actionsOrCommands
780
- , " Use type signature" `T.isInfixOf` actionTitle
781
- ]
783
+ [addSignature] <- pure [action | InR action@ CodeAction { _title = actionTitle } <- actionsOrCommands
784
+ , " Use type signature" `T.isInfixOf` actionTitle
785
+ ]
782
786
executeCodeAction addSignature
783
787
contentAfterAction <- documentContents doc
784
788
liftIO $ expectedContentAfterAction @=? contentAfterAction
@@ -1782,7 +1786,7 @@ suggestAddRecordFieldImportTests = testGroup "suggest imports of record fields w
1782
1786
doc <- createDoc " Test.hs" " haskell" before
1783
1787
waitForProgressDone
1784
1788
_ <- waitForDiagnostics
1785
- let defLine = fromIntegral $ 1 + 2
1789
+ let defLine = 3
1786
1790
range = Range (Position defLine 0 ) (Position defLine maxBound )
1787
1791
actions <- getCodeActions doc range
1788
1792
action <- liftIO $ pickActionWithTitle " Add foo to the import list of B" actions
@@ -1913,7 +1917,6 @@ suggestImportDisambiguationTests = testGroup "suggest import disambiguation acti
1913
1917
contentAfterAction <- documentContents doc
1914
1918
liftIO $ T. replace " \r\n " " \n " expected @=? contentAfterAction
1915
1919
compareHideFunctionTo = compareTwo " HideFunction.hs"
1916
- auxFiles = [" AVec.hs" , " BVec.hs" , " CVec.hs" , " DVec.hs" , " EVec.hs" , " FVec.hs" ]
1917
1920
withTarget file locs k = runWithExtraFiles " hiding" $ \ dir -> do
1918
1921
doc <- openDoc file " haskell"
1919
1922
void $ expectDiagnostics [(file, [(DiagnosticSeverity_Error , loc, " Ambiguous occurrence" ) | loc <- locs])]
@@ -2122,9 +2125,8 @@ insertNewDefinitionTests = testGroup "insert new definition actions"
2122
2125
]
2123
2126
docB <- createDoc " ModuleB.hs" " haskell" (T. unlines $ txtB ++ txtB')
2124
2127
_ <- waitForDiagnostics
2125
- InR action@ CodeAction { _title = actionTitle } : _
2126
- <- filter (\ (InR CodeAction {_title= x}) -> " Define" `T.isPrefixOf` x) <$>
2127
- getCodeActions docB (R 0 0 0 50 )
2128
+ action@ CodeAction { _title = actionTitle } : _
2129
+ <- findCodeActionsByPrefix docB (R 0 0 0 50 ) [" Define" ]
2128
2130
liftIO $ actionTitle @?= " Define select :: [Bool] -> Bool"
2129
2131
executeCodeAction action
2130
2132
contentAfterAction <- documentContents docB
@@ -2134,6 +2136,27 @@ insertNewDefinitionTests = testGroup "insert new definition actions"
2134
2136
, " select = _"
2135
2137
]
2136
2138
++ txtB')
2139
+ , testSession " insert new function definition - with similar suggestion in scope" $ do
2140
+ doc <- createDoc " Module.hs" " haskell" $ T. unlines
2141
+ [ " import Control.Monad" -- brings `mplus` into scope, leading to additional suggestion
2142
+ -- "Perhaps use \8216mplus\8217 (imported from Control.Monad)"
2143
+ , " f :: Int -> Int"
2144
+ , " f x = plus x x"
2145
+ ]
2146
+ _ <- waitForDiagnostics
2147
+ action@ CodeAction { _title = actionTitle } : _
2148
+ <- findCodeActionsByPrefix doc (R 2 0 2 13 ) [" Define" ]
2149
+ liftIO $ actionTitle @?= " Define plus :: Int -> Int -> Int"
2150
+ executeCodeAction action
2151
+ contentAfterAction <- documentContents doc
2152
+ liftIO $ contentAfterAction @?= T. unlines
2153
+ [ " import Control.Monad"
2154
+ , " f :: Int -> Int"
2155
+ , " f x = plus x x"
2156
+ , " "
2157
+ , " plus :: Int -> Int -> Int"
2158
+ , " plus = _"
2159
+ ]
2137
2160
, testSession " define a hole" $ do
2138
2161
let txtB =
2139
2162
[" foo True = _select [True]"
@@ -2146,9 +2169,8 @@ insertNewDefinitionTests = testGroup "insert new definition actions"
2146
2169
]
2147
2170
docB <- createDoc " ModuleB.hs" " haskell" (T. unlines $ txtB ++ txtB')
2148
2171
_ <- waitForDiagnostics
2149
- InR action@ CodeAction { _title = actionTitle } : _
2150
- <- filter (\ (InR CodeAction {_title= x}) -> " Define" `T.isPrefixOf` x) <$>
2151
- getCodeActions docB (R 0 0 0 50 )
2172
+ action@ CodeAction { _title = actionTitle } : _
2173
+ <- findCodeActionsByPrefix docB (R 0 0 0 50 ) [" Define" ]
2152
2174
liftIO $ actionTitle @?= " Define select :: [Bool] -> Bool"
2153
2175
executeCodeAction action
2154
2176
contentAfterAction <- documentContents docB
@@ -2180,9 +2202,8 @@ insertNewDefinitionTests = testGroup "insert new definition actions"
2180
2202
, " haddock = undefined" ]
2181
2203
docB <- createDoc " ModuleB.hs" " haskell" (T. unlines start)
2182
2204
_ <- waitForDiagnostics
2183
- InR action@ CodeAction { _title = actionTitle } : _
2184
- <- filter (\ (InR CodeAction {_title= x}) -> " Define" `T.isPrefixOf` x) <$>
2185
- getCodeActions docB (R 1 0 0 50 )
2205
+ action@ CodeAction { _title = actionTitle } : _
2206
+ <- findCodeActionsByPrefix docB (R 1 0 0 50 ) [" Define" ]
2186
2207
liftIO $ actionTitle @?= " Define select :: Int -> Bool"
2187
2208
executeCodeAction action
2188
2209
contentAfterAction <- documentContents docB
@@ -2206,9 +2227,8 @@ insertNewDefinitionTests = testGroup "insert new definition actions"
2206
2227
, " normal = undefined" ]
2207
2228
docB <- createDoc " ModuleB.hs" " haskell" (T. unlines start)
2208
2229
_ <- waitForDiagnostics
2209
- InR action@ CodeAction { _title = actionTitle } : _
2210
- <- filter (\ (InR CodeAction {_title= x}) -> " Define" `T.isPrefixOf` x) <$>
2211
- getCodeActions docB (R 1 0 0 50 )
2230
+ action@ CodeAction { _title = actionTitle } : _
2231
+ <- findCodeActionsByPrefix docB (R 1 0 0 50 ) [" Define" ]
2212
2232
liftIO $ actionTitle @?= " Define select :: Int -> Bool"
2213
2233
executeCodeAction action
2214
2234
contentAfterAction <- documentContents docB
@@ -2223,9 +2243,8 @@ insertNewDefinitionTests = testGroup "insert new definition actions"
2223
2243
]
2224
2244
docB <- createDoc " ModuleB.hs" " haskell" (T. unlines $ txtB ++ txtB')
2225
2245
_ <- waitForDiagnostics
2226
- InR action@ CodeAction { _title = actionTitle } : _
2227
- <- filter (\ (InR CodeAction {_title= x}) -> " Define" `T.isPrefixOf` x) <$>
2228
- getCodeActions docB (R 0 0 0 50 )
2246
+ action@ CodeAction { _title = actionTitle } : _ <-
2247
+ findCodeActionsByPrefix docB (R 0 0 0 50 ) [" Define" ]
2229
2248
liftIO $ actionTitle @?= " Define select :: _"
2230
2249
executeCodeAction action
2231
2250
contentAfterAction <- documentContents docB
@@ -2237,6 +2256,7 @@ insertNewDefinitionTests = testGroup "insert new definition actions"
2237
2256
++ txtB')
2238
2257
]
2239
2258
2259
+
2240
2260
deleteUnusedDefinitionTests :: TestTree
2241
2261
deleteUnusedDefinitionTests = testGroup " delete unused definition action"
2242
2262
[ testSession " delete unused top level binding" $
@@ -2573,8 +2593,10 @@ importRenameActionTests = testGroup "import rename actions"
2573
2593
]
2574
2594
doc <- createDoc " Testing.hs" " haskell" content
2575
2595
_ <- waitForDiagnostics
2576
- actionsOrCommands <- getCodeActions doc (Range (Position 1 8 ) (Position 1 16 ))
2577
- let [changeToMap] = [action | InR action@ CodeAction { _title = actionTitle } <- actionsOrCommands, (" Data." <> modname) `T.isInfixOf` actionTitle ]
2596
+ actionsOrCommands <- getCodeActions doc (R 1 8 1 16 )
2597
+ [changeToMap] <- pure [action | InR action@ CodeAction { _title = actionTitle } <- actionsOrCommands
2598
+ , (" Data." <> modname) `T.isInfixOf` actionTitle
2599
+ ]
2578
2600
executeCodeAction changeToMap
2579
2601
contentAfterAction <- documentContents doc
2580
2602
let expectedContentAfterAction = T. unlines
@@ -3845,12 +3867,8 @@ pattern R x y x' y' = Range (Position x y) (Position x' y')
3845
3867
-- Which we need to do on macOS since the $TMPDIR can be in @/private/var@ or
3846
3868
-- @/var@
3847
3869
withTempDir :: (FilePath -> IO a ) -> IO a
3848
- withTempDir f = System.IO.Extra. withTempDir $ \ dir -> do
3849
- dir' <- canonicalizePath dir
3850
- f dir'
3851
-
3852
- ignoreForGHC92 :: String -> TestTree -> TestTree
3853
- ignoreForGHC92 = ignoreForGhcVersions [GHC92 ]
3870
+ withTempDir f = System.IO.Extra. withTempDir $ \ dir ->
3871
+ canonicalizePath dir >>= f
3854
3872
3855
3873
brokenForGHC94 :: String -> TestTree -> TestTree
3856
3874
brokenForGHC94 = knownBrokenForGhcVersions [GHC94 ]
0 commit comments