diff --git a/hls-test-utils/src/Test/Hls/Util.hs b/hls-test-utils/src/Test/Hls/Util.hs index 57df6cd2da..cd385a1925 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) diff --git a/plugins/hls-pragmas-plugin/test/Main.hs b/plugins/hls-pragmas-plugin/test/Main.hs index 7d9da73b99..f78261ff55 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,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) - let item = head $ filter ((== label) . (^. L.label)) compls + 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 7e4696376d..2a8dade9dc 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Judgements.hs @@ -34,7 +34,8 @@ buildHypothesis where go (occName -> occ, t) | Just ty <- t - , isAlpha . head . occNameString $ occ = Just $ HyInfo occ UserPrv $ CType 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 cd816d90fb..29b7c173f9 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 <- getCompletionByLabel "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 <- getCompletionByLabel "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 <- getCompletionByLabel "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 <- getCompletionByLabel "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 <- getCompletionByLabel "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 <- getCompletionByLabel "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 <- getCompletionByLabel "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 <- getCompletionByLabel "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 <- getCompletionByLabel "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 <- getCompletionByLabel "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 <- getCompletionByLabel "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 <- getCompletionByLabel "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 <- getCompletionByLabel "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 <- getCompletionByLabel "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 <- getCompletionByLabel "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 <- getCompletionByLabel "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 <- getCompletionByLabel "foldl" compls liftIO $ do item ^. label @?= "foldl" item ^. kind @?= Just CiFunction @@ -327,11 +330,11 @@ 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 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"