Skip to content

Commit 261f58b

Browse files
jhrcekjhrcek
committed
Get rid of come head usages
1 parent c1bea2d commit 261f58b

File tree

4 files changed

+57
-32
lines changed

4 files changed

+57
-32
lines changed

‎plugins/hls-pragmas-plugin/test/Main.hs

Lines changed: 14 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,8 @@ module Main
33
( main
44
) where
55

6-
import Control.Lens ((^.))
6+
import Control.Lens ((^.), (^..), traversed)
7+
import Data.Foldable (find)
78
import qualified Data.Text as T
89
import qualified Ide.Plugin.Pragmas as Pragmas
910
import qualified Language.LSP.Types.Lens as L
@@ -74,7 +75,10 @@ codeActionTest testComment fp actions =
7475
_ <- waitForDiagnosticsFrom doc
7576
cas <- map fromAction <$> getAllCodeActions doc
7677
mapM_ (\(action, contains) -> go action contains cas) actions
77-
executeCodeAction $ head cas
78+
action <- case cas of
79+
(a:_) -> pure a
80+
[] -> liftIO $ assertFailure "Expected non-empty list of code actions"
81+
executeCodeAction action
7882
where
7983
go action contains cas = liftIO $ action `elem` map (^. L.title) cas @? contains
8084

@@ -85,8 +89,9 @@ codeActionTests' =
8589
goldenWithPragmas "no duplication" "NamedFieldPuns" $ \doc -> do
8690
_ <- waitForDiagnosticsFrom doc
8791
cas <- map fromAction <$> getCodeActions doc (Range (Position 8 9) (Position 8 9))
88-
liftIO $ length cas == 1 @? "Expected one code action, but got: " <> show cas
89-
let ca = head cas
92+
ca <- liftIO $ case cas of
93+
[ca] -> pure ca
94+
_ -> assertFailure $ "Expected one code action, but got: " <> show cas
9095
liftIO $ (ca ^. L.title == "Add \"NamedFieldPuns\"") @? "NamedFieldPuns code action"
9196
executeCodeAction ca
9297
, goldenWithPragmas "doesn't suggest disabling type errors" "DeferredTypeErrors" $ \doc -> do
@@ -119,7 +124,11 @@ completionTest testComment fileName te' label textFormat insertText detail [a, b
119124
let te = TextEdit (Range (Position a b) (Position c d)) te'
120125
_ <- applyEdit doc te
121126
compls <- getCompletions doc (Position x y)
122-
let item = head $ filter ((== label) . (^. L.label)) compls
127+
item <- case find (\c -> c ^. L.label == label) compls of
128+
Just c -> pure c
129+
Nothing -> liftIO . assertFailure $
130+
"Completion with label " <> show label
131+
<> " not found in " <> show (compls ^.. traversed . L.label)
123132
liftIO $ do
124133
item ^. L.label @?= label
125134
item ^. L.kind @?= Just CiKeyword

‎plugins/hls-tactics-plugin/src/Wingman/Judgements.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,7 @@ buildHypothesis
3434
where
3535
go (occName -> occ, t)
3636
| Just ty <- t
37-
, isAlpha . head . occNameString $ occ = Just $ HyInfo occ UserPrv $ CType ty
37+
, maybe False isAlpha . listToMaybe . occNameString $ occ = Just $ HyInfo occ UserPrv $ CType ty
3838
| otherwise = Nothing
3939

4040

‎test/functional/Completion.hs

Lines changed: 37 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@ module Completion(tests) where
44

55
import Control.Lens hiding ((.=))
66
import Data.Aeson (object, (.=))
7+
import Data.Foldable (find)
78
import qualified Data.Text as T
89
import Ide.Plugin.Config (maxCompletions)
910
import Language.LSP.Types.Lens hiding (applyEdit)
@@ -19,7 +20,7 @@ tests = testGroup "completions" [
1920
_ <- applyEdit doc te
2021

2122
compls <- getCompletions doc (Position 5 9)
22-
let item = head $ filter ((== "putStrLn") . (^. label)) compls
23+
item <- getCopletionByLabel "putStrLn" compls
2324
liftIO $ do
2425
item ^. label @?= "putStrLn"
2526
item ^. kind @?= Just CiFunction
@@ -35,7 +36,7 @@ tests = testGroup "completions" [
3536
_ <- applyEdit doc te
3637

3738
compls <- getCompletions doc (Position 5 9)
38-
let item = head $ filter ((== "putStrLn") . (^. label)) compls
39+
item <- getCopletionByLabel "putStrLn" compls
3940
resolvedRes <- request SCompletionItemResolve item
4041
let eResolved = resolvedRes ^. result
4142
case eResolved of
@@ -56,7 +57,7 @@ tests = testGroup "completions" [
5657
_ <- applyEdit doc te
5758

5859
compls <- getCompletions doc (Position 1 23)
59-
let item = head $ filter ((== "Maybe") . (^. label)) compls
60+
item <- getCopletionByLabel "Maybe" compls
6061
liftIO $ do
6162
item ^. label @?= "Maybe"
6263
item ^. detail @?= Just "Data.Maybe"
@@ -71,7 +72,7 @@ tests = testGroup "completions" [
7172
_ <- applyEdit doc te
7273

7374
compls <- getCompletions doc (Position 2 24)
74-
let item = head $ filter ((== "List") . (^. label)) compls
75+
item <- getCopletionByLabel "List" compls
7576
liftIO $ do
7677
item ^. label @?= "List"
7778
item ^. detail @?= Just "Data.List"
@@ -91,7 +92,7 @@ tests = testGroup "completions" [
9192
_ <- applyEdit doc te
9293

9394
compls <- getCompletions doc (Position 5 4)
94-
let item = head $ filter (\c -> c^.label == "accessor") compls
95+
item <- getCopletionByLabel "accessor" compls
9596
liftIO $ do
9697
item ^. label @?= "accessor"
9798
item ^. kind @?= Just CiFunction
@@ -101,7 +102,7 @@ tests = testGroup "completions" [
101102
let te = TextEdit (Range (Position 5 7) (Position 5 9)) "id"
102103
_ <- applyEdit doc te
103104
compls <- getCompletions doc (Position 5 9)
104-
let item = head $ filter ((== "id") . (^. label)) compls
105+
item <- getCopletionByLabel "id" compls
105106
liftIO $ do
106107
item ^. detail @?= Just ":: a -> a"
107108

@@ -111,7 +112,7 @@ tests = testGroup "completions" [
111112
let te = TextEdit (Range (Position 5 7) (Position 5 24)) "flip"
112113
_ <- applyEdit doc te
113114
compls <- getCompletions doc (Position 5 11)
114-
let item = head $ filter ((== "flip") . (^. label)) compls
115+
item <- getCopletionByLabel "flip" compls
115116
liftIO $
116117
item ^. detail @?= Just ":: (a -> b -> c) -> b -> a -> c"
117118

@@ -128,7 +129,7 @@ tests = testGroup "completions" [
128129
_ <- applyEdit doc te
129130

130131
compls <- getCompletions doc (Position 0 31)
131-
let item = head $ filter ((== "Alternative") . (^. label)) compls
132+
item <- getCopletionByLabel "Alternative" compls
132133
liftIO $ do
133134
item ^. label @?= "Alternative"
134135
item ^. kind @?= Just CiFunction
@@ -141,7 +142,7 @@ tests = testGroup "completions" [
141142
_ <- applyEdit doc te
142143

143144
compls <- getCompletions doc (Position 0 41)
144-
let item = head $ filter ((== "liftA") . (^. label)) compls
145+
item <- getCopletionByLabel "liftA" compls
145146
liftIO $ do
146147
item ^. label @?= "liftA"
147148
item ^. kind @?= Just CiFunction
@@ -159,7 +160,7 @@ snippetTests = testGroup "snippets" [
159160
_ <- applyEdit doc te
160161

161162
compls <- getCompletions doc (Position 5 14)
162-
let item = head $ filter ((== "Nothing") . (^. label)) compls
163+
item <- getCopletionByLabel "Nothing" compls
163164
liftIO $ do
164165
item ^. insertTextFormat @?= Just Snippet
165166
item ^. insertText @?= Just "Nothing "
@@ -171,7 +172,7 @@ snippetTests = testGroup "snippets" [
171172
_ <- applyEdit doc te
172173

173174
compls <- getCompletions doc (Position 5 11)
174-
let item = head $ filter ((== "foldl") . (^. label)) compls
175+
item <- getCopletionByLabel "foldl" compls
175176
liftIO $ do
176177
item ^. label @?= "foldl"
177178
item ^. kind @?= Just CiFunction
@@ -185,7 +186,7 @@ snippetTests = testGroup "snippets" [
185186
_ <- applyEdit doc te
186187

187188
compls <- getCompletions doc (Position 5 11)
188-
let item = head $ filter ((== "mapM") . (^. label)) compls
189+
item <- getCopletionByLabel "mapM" compls
189190
liftIO $ do
190191
item ^. label @?= "mapM"
191192
item ^. kind @?= Just CiFunction
@@ -199,7 +200,7 @@ snippetTests = testGroup "snippets" [
199200
_ <- applyEdit doc te
200201

201202
compls <- getCompletions doc (Position 5 18)
202-
let item = head $ filter ((== "filter") . (^. label)) compls
203+
item <- getCopletionByLabel "filter" compls
203204
liftIO $ do
204205
item ^. label @?= "filter"
205206
item ^. kind @?= Just CiFunction
@@ -213,7 +214,7 @@ snippetTests = testGroup "snippets" [
213214
_ <- applyEdit doc te
214215

215216
compls <- getCompletions doc (Position 5 18)
216-
let item = head $ filter ((== "filter") . (^. label)) compls
217+
item <- getCopletionByLabel "filter" compls
217218
liftIO $ do
218219
item ^. label @?= "filter"
219220
item ^. kind @?= Just CiFunction
@@ -227,7 +228,7 @@ snippetTests = testGroup "snippets" [
227228
_ <- applyEdit doc te
228229

229230
compls <- getCompletions doc (Position 5 29)
230-
let item = head $ filter ((== "intersperse") . (^. label)) compls
231+
item <- getCopletionByLabel "intersperse" compls
231232
liftIO $ do
232233
item ^. label @?= "intersperse"
233234
item ^. kind @?= Just CiFunction
@@ -241,7 +242,7 @@ snippetTests = testGroup "snippets" [
241242
_ <- applyEdit doc te
242243

243244
compls <- getCompletions doc (Position 5 29)
244-
let item = head $ filter ((== "intersperse") . (^. label)) compls
245+
item <- getCopletionByLabel "intersperse" compls
245246
liftIO $ do
246247
item ^. label @?= "intersperse"
247248
item ^. kind @?= Just CiFunction
@@ -268,7 +269,9 @@ snippetTests = testGroup "snippets" [
268269
_ <- applyEdit doc te
269270

270271
compls <- getCompletions doc (Position 1 6)
271-
let item = head $ filter (\c -> (c ^. label == "MkFoo") && maybe False ("MkFoo {" `T.isPrefixOf`) (c ^. insertText)) compls
272+
item <- case find (\c -> (c ^. label == "MkFoo") && maybe False ("MkFoo {" `T.isPrefixOf`) (c ^. insertText)) compls of
273+
Just c -> pure c
274+
Nothing -> liftIO . assertFailure $ "Completion with label 'MkFoo' and insertText starting with 'MkFoo {' not found among " <> show compls
272275
liftIO $ do
273276
item ^. insertTextFormat @?= Just Snippet
274277
item ^. insertText @?= Just "MkFoo {arg1=${1:_arg1}, arg2=${2:_arg2}, arg3=${3:_arg3}, arg4=${4:_arg4}, arg5=${5:_arg5}}"
@@ -279,7 +282,7 @@ snippetTests = testGroup "snippets" [
279282
_ <- applyEdit doc te
280283

281284
compls <- getCompletions doc (Position 5 11)
282-
let item = head $ filter ((== "foldl") . (^. label)) compls
285+
item <- getCopletionByLabel "foldl" compls
283286
liftIO $ do
284287
item ^. label @?= "foldl"
285288
item ^. kind @?= Just CiFunction
@@ -327,11 +330,21 @@ contextTests = testGroup "contexts" [
327330
]
328331

329332
shouldContainCompl :: [CompletionItem] -> T.Text -> Assertion
330-
compls `shouldContainCompl` x =
331-
any ((== x) . (^. label)) compls
332-
@? "Should contain completion: " ++ show x
333+
compls `shouldContainCompl` lbl =
334+
any ((== lbl) . (^. label)) compls
335+
@? "Should contain completion: " ++ show lbl
333336

334337
shouldNotContainCompl :: [CompletionItem] -> T.Text -> Assertion
335-
compls `shouldNotContainCompl` x =
336-
all ((/= x) . (^. label)) compls
337-
@? "Should not contain completion: " ++ show x
338+
compls `shouldNotContainCompl` lbl =
339+
all ((/= lbl) . (^. label)) compls
340+
@? "Should not contain completion: " ++ show lbl
341+
342+
getCopletionByLabel :: T.Text -> [CompletionItem] -> Session CompletionItem
343+
getCopletionByLabel lbl compls =
344+
case find (\c -> c ^. label == lbl) compls of
345+
Just c -> pure c
346+
Nothing ->
347+
let knownLabels = compls ^.. traversed . label
348+
in liftIO . assertFailure $
349+
"Completion with label " <> show lbl
350+
<> " not found in " <> show knownLabels

‎test/functional/FunctionalCodeAction.hs

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -139,7 +139,8 @@ packageTests = testGroup "add package suggestions" [
139139
-- ignore the first empty hlint diagnostic publish
140140
[_,_:diag:_] <- count 2 $ waitForDiagnosticsFrom doc
141141

142-
let prefixes = [ "Could not load module `Codec.Compression.GZip'" -- Windows && GHC >= 8.6
142+
let prefixes =
143+
[ "Could not load module `Codec.Compression.GZip'" -- Windows && GHC >= 8.6
143144
, "Could not find module `Codec.Compression.GZip'" -- Windows
144145
, "Could not load module ‘Codec.Compression.GZip’" -- GHC >= 8.6
145146
, "Could not find module ‘Codec.Compression.GZip’"
@@ -148,7 +149,9 @@ packageTests = testGroup "add package suggestions" [
148149

149150
mActions <- getAllCodeActions doc
150151
let allActions = map fromAction mActions
151-
action = head allActions
152+
action <- case allActions of
153+
(a:_) -> pure a
154+
_ -> liftIO $ assertFailure "Expected non-empty list of actions"
152155

153156
liftIO $ do
154157
action ^. L.title @?= "Add zlib as a dependency"

0 commit comments

Comments
 (0)