From 128861d0ec87462d707c66296ff6d51c86f5b5ea Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Sat, 29 Jan 2022 11:40:26 +0100 Subject: [PATCH 1/5] Get rid of come head usages --- plugins/hls-pragmas-plugin/test/Main.hs | 19 ++++-- .../src/Wingman/Judgements.hs | 2 +- test/functional/Completion.hs | 61 +++++++++++-------- test/functional/FunctionalCodeAction.hs | 7 ++- 4 files changed, 57 insertions(+), 32 deletions(-) diff --git a/plugins/hls-pragmas-plugin/test/Main.hs b/plugins/hls-pragmas-plugin/test/Main.hs index 7d9da73b99..685c10f58c 100644 --- a/plugins/hls-pragmas-plugin/test/Main.hs +++ b/plugins/hls-pragmas-plugin/test/Main.hs @@ -3,7 +3,8 @@ module Main ( main ) where -import Control.Lens ((^.)) +import Control.Lens ((^.), (^..), traversed) +import Data.Foldable (find) import qualified Data.Text as T import qualified Ide.Plugin.Pragmas as Pragmas import qualified Language.LSP.Types.Lens as L @@ -74,7 +75,10 @@ codeActionTest testComment fp actions = _ <- waitForDiagnosticsFrom doc cas <- map fromAction <$> getAllCodeActions doc mapM_ (\(action, contains) -> go action contains cas) actions - executeCodeAction $ head cas + action <- case cas of + (a:_) -> pure a + [] -> liftIO $ assertFailure "Expected non-empty list of code actions" + executeCodeAction action where go action contains cas = liftIO $ action `elem` map (^. L.title) cas @? contains @@ -85,8 +89,9 @@ codeActionTests' = goldenWithPragmas "no duplication" "NamedFieldPuns" $ \doc -> do _ <- waitForDiagnosticsFrom doc cas <- map fromAction <$> getCodeActions doc (Range (Position 8 9) (Position 8 9)) - liftIO $ length cas == 1 @? "Expected one code action, but got: " <> show cas - let ca = head cas + ca <- liftIO $ case cas of + [ca] -> pure ca + _ -> assertFailure $ "Expected one code action, but got: " <> show cas liftIO $ (ca ^. L.title == "Add \"NamedFieldPuns\"") @? "NamedFieldPuns code action" executeCodeAction ca , goldenWithPragmas "doesn't suggest disabling type errors" "DeferredTypeErrors" $ \doc -> do @@ -119,7 +124,11 @@ completionTest testComment fileName te' label textFormat insertText detail [a, b let te = TextEdit (Range (Position a b) (Position c d)) te' _ <- applyEdit doc te compls <- getCompletions doc (Position x y) - let item = head $ filter ((== label) . (^. L.label)) compls + item <- case find (\c -> c ^. L.label == label) compls of + Just c -> pure c + Nothing -> liftIO . assertFailure $ + "Completion with label " <> show label + <> " not found in " <> show (compls ^.. traversed . L.label) liftIO $ do item ^. L.label @?= label item ^. L.kind @?= Just CiKeyword diff --git a/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs b/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs index 7e4696376d..8a60de8fe1 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs @@ -34,7 +34,7 @@ buildHypothesis where go (occName -> occ, t) | Just ty <- t - , isAlpha . head . occNameString $ occ = Just $ HyInfo occ UserPrv $ CType ty + , maybe False isAlpha . listToMaybe . occNameString $ occ = Just $ HyInfo occ UserPrv $ CType ty | otherwise = Nothing diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs index cd816d90fb..00fc2a7c97 100644 --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -4,6 +4,7 @@ module Completion(tests) where import Control.Lens hiding ((.=)) import Data.Aeson (object, (.=)) +import Data.Foldable (find) import qualified Data.Text as T import Ide.Plugin.Config (maxCompletions) import Language.LSP.Types.Lens hiding (applyEdit) @@ -19,7 +20,7 @@ tests = testGroup "completions" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 9) - let item = head $ filter ((== "putStrLn") . (^. label)) compls + item <- getCopletionByLabel "putStrLn" compls liftIO $ do item ^. label @?= "putStrLn" item ^. kind @?= Just CiFunction @@ -35,7 +36,7 @@ tests = testGroup "completions" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 9) - let item = head $ filter ((== "putStrLn") . (^. label)) compls + item <- getCopletionByLabel "putStrLn" compls resolvedRes <- request SCompletionItemResolve item let eResolved = resolvedRes ^. result case eResolved of @@ -56,7 +57,7 @@ tests = testGroup "completions" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 1 23) - let item = head $ filter ((== "Maybe") . (^. label)) compls + item <- getCopletionByLabel "Maybe" compls liftIO $ do item ^. label @?= "Maybe" item ^. detail @?= Just "Data.Maybe" @@ -71,7 +72,7 @@ tests = testGroup "completions" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 2 24) - let item = head $ filter ((== "List") . (^. label)) compls + item <- getCopletionByLabel "List" compls liftIO $ do item ^. label @?= "List" item ^. detail @?= Just "Data.List" @@ -91,7 +92,7 @@ tests = testGroup "completions" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 4) - let item = head $ filter (\c -> c^.label == "accessor") compls + item <- getCopletionByLabel "accessor" compls liftIO $ do item ^. label @?= "accessor" item ^. kind @?= Just CiFunction @@ -101,7 +102,7 @@ tests = testGroup "completions" [ let te = TextEdit (Range (Position 5 7) (Position 5 9)) "id" _ <- applyEdit doc te compls <- getCompletions doc (Position 5 9) - let item = head $ filter ((== "id") . (^. label)) compls + item <- getCopletionByLabel "id" compls liftIO $ do item ^. detail @?= Just ":: a -> a" @@ -111,7 +112,7 @@ tests = testGroup "completions" [ let te = TextEdit (Range (Position 5 7) (Position 5 24)) "flip" _ <- applyEdit doc te compls <- getCompletions doc (Position 5 11) - let item = head $ filter ((== "flip") . (^. label)) compls + item <- getCopletionByLabel "flip" compls liftIO $ item ^. detail @?= Just ":: (a -> b -> c) -> b -> a -> c" @@ -128,7 +129,7 @@ tests = testGroup "completions" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 0 31) - let item = head $ filter ((== "Alternative") . (^. label)) compls + item <- getCopletionByLabel "Alternative" compls liftIO $ do item ^. label @?= "Alternative" item ^. kind @?= Just CiFunction @@ -141,7 +142,7 @@ tests = testGroup "completions" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 0 41) - let item = head $ filter ((== "liftA") . (^. label)) compls + item <- getCopletionByLabel "liftA" compls liftIO $ do item ^. label @?= "liftA" item ^. kind @?= Just CiFunction @@ -159,7 +160,7 @@ snippetTests = testGroup "snippets" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 14) - let item = head $ filter ((== "Nothing") . (^. label)) compls + item <- getCopletionByLabel "Nothing" compls liftIO $ do item ^. insertTextFormat @?= Just Snippet item ^. insertText @?= Just "Nothing " @@ -171,7 +172,7 @@ snippetTests = testGroup "snippets" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 11) - let item = head $ filter ((== "foldl") . (^. label)) compls + item <- getCopletionByLabel "foldl" compls liftIO $ do item ^. label @?= "foldl" item ^. kind @?= Just CiFunction @@ -185,7 +186,7 @@ snippetTests = testGroup "snippets" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 11) - let item = head $ filter ((== "mapM") . (^. label)) compls + item <- getCopletionByLabel "mapM" compls liftIO $ do item ^. label @?= "mapM" item ^. kind @?= Just CiFunction @@ -199,7 +200,7 @@ snippetTests = testGroup "snippets" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 18) - let item = head $ filter ((== "filter") . (^. label)) compls + item <- getCopletionByLabel "filter" compls liftIO $ do item ^. label @?= "filter" item ^. kind @?= Just CiFunction @@ -213,7 +214,7 @@ snippetTests = testGroup "snippets" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 18) - let item = head $ filter ((== "filter") . (^. label)) compls + item <- getCopletionByLabel "filter" compls liftIO $ do item ^. label @?= "filter" item ^. kind @?= Just CiFunction @@ -227,7 +228,7 @@ snippetTests = testGroup "snippets" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 29) - let item = head $ filter ((== "intersperse") . (^. label)) compls + item <- getCopletionByLabel "intersperse" compls liftIO $ do item ^. label @?= "intersperse" item ^. kind @?= Just CiFunction @@ -241,7 +242,7 @@ snippetTests = testGroup "snippets" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 29) - let item = head $ filter ((== "intersperse") . (^. label)) compls + item <- getCopletionByLabel "intersperse" compls liftIO $ do item ^. label @?= "intersperse" item ^. kind @?= Just CiFunction @@ -268,7 +269,9 @@ snippetTests = testGroup "snippets" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 1 6) - let item = head $ filter (\c -> (c ^. label == "MkFoo") && maybe False ("MkFoo {" `T.isPrefixOf`) (c ^. insertText)) compls + item <- case find (\c -> (c ^. label == "MkFoo") && maybe False ("MkFoo {" `T.isPrefixOf`) (c ^. insertText)) compls of + Just c -> pure c + Nothing -> liftIO . assertFailure $ "Completion with label 'MkFoo' and insertText starting with 'MkFoo {' not found among " <> show compls liftIO $ do item ^. insertTextFormat @?= Just Snippet 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" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 11) - let item = head $ filter ((== "foldl") . (^. label)) compls + item <- getCopletionByLabel "foldl" compls liftIO $ do item ^. label @?= "foldl" item ^. kind @?= Just CiFunction @@ -327,11 +330,21 @@ contextTests = testGroup "contexts" [ ] shouldContainCompl :: [CompletionItem] -> T.Text -> Assertion -compls `shouldContainCompl` x = - any ((== x) . (^. label)) compls - @? "Should contain completion: " ++ show x +compls `shouldContainCompl` lbl = + any ((== lbl) . (^. label)) compls + @? "Should contain completion: " ++ show lbl shouldNotContainCompl :: [CompletionItem] -> T.Text -> Assertion -compls `shouldNotContainCompl` x = - all ((/= x) . (^. label)) compls - @? "Should not contain completion: " ++ show x +compls `shouldNotContainCompl` lbl = + all ((/= lbl) . (^. label)) compls + @? "Should not contain completion: " ++ show lbl + +getCopletionByLabel :: T.Text -> [CompletionItem] -> Session CompletionItem +getCopletionByLabel lbl compls = + case find (\c -> c ^. label == lbl) compls of + Just c -> pure c + Nothing -> + let knownLabels = compls ^.. traversed . label + in liftIO . assertFailure $ + "Completion with label " <> show lbl + <> " not found in " <> show knownLabels diff --git a/test/functional/FunctionalCodeAction.hs b/test/functional/FunctionalCodeAction.hs index 321ba401b5..ff709441fa 100644 --- a/test/functional/FunctionalCodeAction.hs +++ b/test/functional/FunctionalCodeAction.hs @@ -139,7 +139,8 @@ packageTests = testGroup "add package suggestions" [ -- ignore the first empty hlint diagnostic publish [_,_:diag:_] <- count 2 $ waitForDiagnosticsFrom doc - let prefixes = [ "Could not load module `Codec.Compression.GZip'" -- Windows && GHC >= 8.6 + let prefixes = + [ "Could not load module `Codec.Compression.GZip'" -- Windows && GHC >= 8.6 , "Could not find module `Codec.Compression.GZip'" -- Windows , "Could not load module ‘Codec.Compression.GZip’" -- GHC >= 8.6 , "Could not find module ‘Codec.Compression.GZip’" @@ -148,7 +149,9 @@ packageTests = testGroup "add package suggestions" [ mActions <- getAllCodeActions doc let allActions = map fromAction mActions - action = head allActions + action <- case allActions of + (a:_) -> pure a + _ -> liftIO $ assertFailure "Expected non-empty list of actions" liftIO $ do action ^. L.title @?= "Add zlib as a dependency" From a571cba0367a661493a748c70682a575f406c64a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Sat, 29 Jan 2022 11:52:27 +0100 Subject: [PATCH 2/5] Fix typo --- test/functional/Completion.hs | 38 +++++++++++++++++------------------ 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs index 00fc2a7c97..941477e898 100644 --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -20,7 +20,7 @@ tests = testGroup "completions" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 9) - item <- getCopletionByLabel "putStrLn" compls + item <- getCompletionByLabel "putStrLn" compls liftIO $ do item ^. label @?= "putStrLn" item ^. kind @?= Just CiFunction @@ -36,7 +36,7 @@ tests = testGroup "completions" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 9) - item <- getCopletionByLabel "putStrLn" compls + item <- getCompletionByLabel "putStrLn" compls resolvedRes <- request SCompletionItemResolve item let eResolved = resolvedRes ^. result case eResolved of @@ -57,7 +57,7 @@ tests = testGroup "completions" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 1 23) - item <- getCopletionByLabel "Maybe" compls + item <- getCompletionByLabel "Maybe" compls liftIO $ do item ^. label @?= "Maybe" item ^. detail @?= Just "Data.Maybe" @@ -72,7 +72,7 @@ tests = testGroup "completions" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 2 24) - item <- getCopletionByLabel "List" compls + item <- getCompletionByLabel "List" compls liftIO $ do item ^. label @?= "List" item ^. detail @?= Just "Data.List" @@ -92,7 +92,7 @@ tests = testGroup "completions" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 4) - item <- getCopletionByLabel "accessor" compls + item <- getCompletionByLabel "accessor" compls liftIO $ do item ^. label @?= "accessor" item ^. kind @?= Just CiFunction @@ -102,7 +102,7 @@ tests = testGroup "completions" [ let te = TextEdit (Range (Position 5 7) (Position 5 9)) "id" _ <- applyEdit doc te compls <- getCompletions doc (Position 5 9) - item <- getCopletionByLabel "id" compls + item <- getCompletionByLabel "id" compls liftIO $ do item ^. detail @?= Just ":: a -> a" @@ -112,7 +112,7 @@ tests = testGroup "completions" [ let te = TextEdit (Range (Position 5 7) (Position 5 24)) "flip" _ <- applyEdit doc te compls <- getCompletions doc (Position 5 11) - item <- getCopletionByLabel "flip" compls + item <- getCompletionByLabel "flip" compls liftIO $ item ^. detail @?= Just ":: (a -> b -> c) -> b -> a -> c" @@ -129,7 +129,7 @@ tests = testGroup "completions" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 0 31) - item <- getCopletionByLabel "Alternative" compls + item <- getCompletionByLabel "Alternative" compls liftIO $ do item ^. label @?= "Alternative" item ^. kind @?= Just CiFunction @@ -142,7 +142,7 @@ tests = testGroup "completions" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 0 41) - item <- getCopletionByLabel "liftA" compls + item <- getCompletionByLabel "liftA" compls liftIO $ do item ^. label @?= "liftA" item ^. kind @?= Just CiFunction @@ -160,7 +160,7 @@ snippetTests = testGroup "snippets" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 14) - item <- getCopletionByLabel "Nothing" compls + item <- getCompletionByLabel "Nothing" compls liftIO $ do item ^. insertTextFormat @?= Just Snippet item ^. insertText @?= Just "Nothing " @@ -172,7 +172,7 @@ snippetTests = testGroup "snippets" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 11) - item <- getCopletionByLabel "foldl" compls + item <- getCompletionByLabel "foldl" compls liftIO $ do item ^. label @?= "foldl" item ^. kind @?= Just CiFunction @@ -186,7 +186,7 @@ snippetTests = testGroup "snippets" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 11) - item <- getCopletionByLabel "mapM" compls + item <- getCompletionByLabel "mapM" compls liftIO $ do item ^. label @?= "mapM" item ^. kind @?= Just CiFunction @@ -200,7 +200,7 @@ snippetTests = testGroup "snippets" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 18) - item <- getCopletionByLabel "filter" compls + item <- getCompletionByLabel "filter" compls liftIO $ do item ^. label @?= "filter" item ^. kind @?= Just CiFunction @@ -214,7 +214,7 @@ snippetTests = testGroup "snippets" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 18) - item <- getCopletionByLabel "filter" compls + item <- getCompletionByLabel "filter" compls liftIO $ do item ^. label @?= "filter" item ^. kind @?= Just CiFunction @@ -228,7 +228,7 @@ snippetTests = testGroup "snippets" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 29) - item <- getCopletionByLabel "intersperse" compls + item <- getCompletionByLabel "intersperse" compls liftIO $ do item ^. label @?= "intersperse" item ^. kind @?= Just CiFunction @@ -242,7 +242,7 @@ snippetTests = testGroup "snippets" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 29) - item <- getCopletionByLabel "intersperse" compls + item <- getCompletionByLabel "intersperse" compls liftIO $ do item ^. label @?= "intersperse" item ^. kind @?= Just CiFunction @@ -282,7 +282,7 @@ snippetTests = testGroup "snippets" [ _ <- applyEdit doc te compls <- getCompletions doc (Position 5 11) - item <- getCopletionByLabel "foldl" compls + item <- getCompletionByLabel "foldl" compls liftIO $ do item ^. label @?= "foldl" item ^. kind @?= Just CiFunction @@ -339,8 +339,8 @@ compls `shouldNotContainCompl` lbl = all ((/= lbl) . (^. label)) compls @? "Should not contain completion: " ++ show lbl -getCopletionByLabel :: T.Text -> [CompletionItem] -> Session CompletionItem -getCopletionByLabel lbl compls = +getCompletionByLabel :: T.Text -> [CompletionItem] -> Session CompletionItem +getCompletionByLabel lbl compls = case find (\c -> c ^. label == lbl) compls of Just c -> pure c Nothing -> From 8a8af330eb581a7233aaa4969100709cd2906a39 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Sun, 30 Jan 2022 10:33:46 +0100 Subject: [PATCH 3/5] Use pattern guard, move util to hls-test-utils --- ghcide/test/exe/Main.hs | 3 ++- hls-test-utils/src/Test/Hls/Util.hs | 10 ++++++++++ plugins/hls-pragmas-plugin/test/Main.hs | 6 +----- plugins/hls-tactics-plugin/src/Wingman/Judgements.hs | 6 +++--- test/functional/Completion.hs | 10 ---------- 5 files changed, 16 insertions(+), 19 deletions(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index da2439e3bb..29be70bad6 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -4937,7 +4937,8 @@ projectCompletionTests = "import ALocal" ] compls <- getCompletions doc (Position 1 13) - let item = head $ filter ((== "ALocalModule") . (^. Lens.label)) compls + -- + item <- getCompletionByLabel "ALocalModule" compls liftIO $ do item ^. Lens.label @?= "ALocalModule", testSession' "auto complete functions from qualified imports without alias" $ \dir-> do diff --git a/hls-test-utils/src/Test/Hls/Util.hs b/hls-test-utils/src/Test/Hls/Util.hs index 57df6cd2da..b12c6f5a7f 100644 --- a/hls-test-utils/src/Test/Hls/Util.hs +++ b/hls-test-utils/src/Test/Hls/Util.hs @@ -18,6 +18,7 @@ module Test.Hls.Util , flushStackEnvironment , fromAction , fromCommand + , getCompletionByLabel , getHspecFormattedConfig , ghcVersion, GhcVersion(..) , hostOS, OS(..) @@ -447,3 +448,12 @@ actual `expectSameLocations` expected = do fp <- canonicalizePath file return (filePathToUri fp, l, c)) actual' @?= expected' + +-- --------------------------------------------------------------------- +getCompletionByLabel :: MonadIO m => T.Text -> [CompletionItem] -> m CompletionItem +getCompletionByLabel desiredLabel compls = + case find (\c -> c ^. L.label == desiredLabel) compls of + Just c -> pure c + Nothing -> liftIO . assertFailure $ + "Completion with label " <> show desiredLabel + <> " not found in " <> show (fmap (^. L.label) compls) \ No newline at end of file diff --git a/plugins/hls-pragmas-plugin/test/Main.hs b/plugins/hls-pragmas-plugin/test/Main.hs index 685c10f58c..f78261ff55 100644 --- a/plugins/hls-pragmas-plugin/test/Main.hs +++ b/plugins/hls-pragmas-plugin/test/Main.hs @@ -124,11 +124,7 @@ completionTest testComment fileName te' label textFormat insertText detail [a, b let te = TextEdit (Range (Position a b) (Position c d)) te' _ <- applyEdit doc te compls <- getCompletions doc (Position x y) - item <- case find (\c -> c ^. L.label == label) compls of - Just c -> pure c - Nothing -> liftIO . assertFailure $ - "Completion with label " <> show label - <> " not found in " <> show (compls ^.. traversed . L.label) + item <- getCompletionByLabel label compls liftIO $ do item ^. L.label @?= label item ^. L.kind @?= Just CiKeyword diff --git a/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs b/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs index 8a60de8fe1..029315858e 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs @@ -32,9 +32,9 @@ buildHypothesis = Hypothesis . mapMaybe go where - go (occName -> occ, t) - | Just ty <- t - , maybe False isAlpha . listToMaybe . occNameString $ occ = Just $ HyInfo occ UserPrv $ CType ty + go (occName -> occ, Just ty) + | (h:_) <- occNameString occ + , isAlpha h = Just $ HyInfo occ UserPrv $ CType ty | otherwise = Nothing diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs index 941477e898..29b7c173f9 100644 --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -338,13 +338,3 @@ shouldNotContainCompl :: [CompletionItem] -> T.Text -> Assertion compls `shouldNotContainCompl` lbl = all ((/= lbl) . (^. label)) compls @? "Should not contain completion: " ++ show lbl - -getCompletionByLabel :: T.Text -> [CompletionItem] -> Session CompletionItem -getCompletionByLabel lbl compls = - case find (\c -> c ^. label == lbl) compls of - Just c -> pure c - Nothing -> - let knownLabels = compls ^.. traversed . label - in liftIO . assertFailure $ - "Completion with label " <> show lbl - <> " not found in " <> show knownLabels From a617cb27840d62c522c6edc49d4250b39d9976b7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Sun, 30 Jan 2022 10:55:34 +0100 Subject: [PATCH 4/5] Revert the change in ghcide tests --- ghcide/test/exe/Main.hs | 3 +-- hls-test-utils/src/Test/Hls/Util.hs | 2 +- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 29be70bad6..da2439e3bb 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -4937,8 +4937,7 @@ projectCompletionTests = "import ALocal" ] compls <- getCompletions doc (Position 1 13) - -- - item <- getCompletionByLabel "ALocalModule" compls + let item = head $ filter ((== "ALocalModule") . (^. Lens.label)) compls liftIO $ do item ^. Lens.label @?= "ALocalModule", testSession' "auto complete functions from qualified imports without alias" $ \dir-> do diff --git a/hls-test-utils/src/Test/Hls/Util.hs b/hls-test-utils/src/Test/Hls/Util.hs index b12c6f5a7f..cd385a1925 100644 --- a/hls-test-utils/src/Test/Hls/Util.hs +++ b/hls-test-utils/src/Test/Hls/Util.hs @@ -456,4 +456,4 @@ getCompletionByLabel desiredLabel compls = Just c -> pure c Nothing -> liftIO . assertFailure $ "Completion with label " <> show desiredLabel - <> " not found in " <> show (fmap (^. L.label) compls) \ No newline at end of file + <> " not found in " <> show (fmap (^. L.label) compls) From cd08b6c2dfe8ccd50af2a23b44e8399dd756dcb7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Sun, 30 Jan 2022 11:15:22 +0100 Subject: [PATCH 5/5] Fix nonexaustive pattern warning --- plugins/hls-tactics-plugin/src/Wingman/Judgements.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs b/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs index 029315858e..2a8dade9dc 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs @@ -32,8 +32,9 @@ buildHypothesis = Hypothesis . mapMaybe go where - go (occName -> occ, Just ty) - | (h:_) <- occNameString occ + go (occName -> occ, t) + | Just ty <- t + , (h:_) <- occNameString occ , isAlpha h = Just $ HyInfo occ UserPrv $ CType ty | otherwise = Nothing