Use pattern guard, move util to hls-test-utils

Author: jhrcek

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

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)

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

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
 
 

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