Fail with PluginError instead of pattern match error

Author: jhrcek

.hlint.yaml

@@ -107,7 +107,6 @@
     - Ide.Plugin.Eval.Util
     - Ide.Plugin.Floskell
     - Ide.Plugin.ModuleName
-    - Ide.Plugin.Rename
     - Ide.Plugin.Class.ExactPrint
     - TExpectedActual
     - TRigidType

ghcide/src/Development/IDE/Spans/AtPoint.hs

@@ -95,10 +95,10 @@ foiReferencesAtPoint file pos (FOIReferences asts) =
           adjustedLocs = HM.foldr go [] asts
           go (HAR _ _ rf tr _, goMapping) xs = refs ++ typerefs ++ xs
             where
-              refs = mapMaybe (toCurrentLocation goMapping . realSrcSpanToLocation . fst)
-                   $ concat $ mapMaybe (\n -> M.lookup (Right n) rf) names
-              typerefs = mapMaybe (toCurrentLocation goMapping . realSrcSpanToLocation)
-                   $ concat $ mapMaybe (`M.lookup` tr) names
+              refs = concatMap (mapMaybe (toCurrentLocation goMapping . realSrcSpanToLocation . fst))
+                               (mapMaybe (\n -> M.lookup (Right n) rf) names)
+              typerefs = concatMap (mapMaybe (toCurrentLocation goMapping . realSrcSpanToLocation))
+                                   (mapMaybe (`M.lookup` tr) names)
         in (names, adjustedLocs,map fromNormalizedFilePath $ HM.keys asts)
 
 getNamesAtPoint :: HieASTs a -> Position -> PositionMapping -> [Name]

haskell-language-server.cabal

@@ -486,7 +486,6 @@ library hls-rename-plugin
   build-depends:
     , base                  >=4.12    && <5
     , containers
-    , extra
     , ghcide                == 2.6.0.0
     , hashable
     , hiedb

hls-plugin-api/src/Ide/Plugin/Properties.hs

@@ -101,7 +101,7 @@ data SomePropertyKeyWithMetaData
     SomePropertyKeyWithMetaData (SPropertyKey k) (MetaData t)
 
 -- | 'Properties' is a partial implementation of json schema, without supporting union types and validation.
--- In hls, it defines a set of properties which used in dedicated configuration of a plugin.
+-- In hls, it defines a set of properties used in dedicated configuration of a plugin.
 -- A property is an immediate child of the json object in each plugin's "config" section.
 -- It was designed to be compatible with vscode's settings UI.
 -- Use 'emptyProperties' and 'useProperty' to create and consume 'Properties'.

plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs

@@ -15,11 +15,13 @@ import           Control.Monad.Except                  (ExceptT, throwError)
 import           Control.Monad.IO.Class                (MonadIO, liftIO)
 import           Control.Monad.Trans.Class             (lift)
 import           Data.Bifunctor                        (first)
+import           Data.Foldable                         (fold)
 import           Data.Generics
 import           Data.Hashable
 import           Data.HashSet                          (HashSet)
 import qualified Data.HashSet                          as HS
-import           Data.List.Extra                       hiding (length)
+import           Data.List.NonEmpty                    (NonEmpty ((:|)),
+                                                        groupWith)
 import qualified Data.Map                              as M
 import           Data.Maybe
 import           Data.Mod.Word
@@ -62,7 +64,7 @@ descriptor recorder pluginId = mkExactprintPluginDescriptor recorder $ (defaultP
     }
 
 renameProvider :: PluginMethodHandler IdeState Method_TextDocumentRename
-renameProvider state pluginId (RenameParams _prog (TextDocumentIdentifier uri) pos  newNameText) = do
+renameProvider state pluginId (RenameParams _prog (TextDocumentIdentifier uri) pos newNameText) = do
         nfp <- getNormalizedFilePathE uri
         directOldNames <- getNamesAtPos state nfp pos
         directRefs <- concat <$> mapM (refsAtName state nfp) directOldNames
@@ -71,8 +73,8 @@ renameProvider state pluginId (RenameParams _prog (TextDocumentIdentifier uri) p
            indirect references through punned names. To find the transitive closure, we do a pass of
            the direct references to find the references for any punned names.
            See the `IndirectPuns` test for an example. -}
-        indirectOldNames <- concat . filter notNull <$>
-            mapM (uncurry (getNamesAtPos state)) (mapMaybe locToFilePos directRefs)
+        indirectOldNames <- concat . filter ((>1) . length) <$>
+            (mapM (uncurry (getNamesAtPos state)) =<< mapM locToFilePos directRefs)
         let oldNames = filter matchesDirect indirectOldNames ++ directOldNames
             matchesDirect n = occNameFS (nameOccName n) `elem` directFS
               where
@@ -91,7 +93,7 @@ renameProvider state pluginId (RenameParams _prog (TextDocumentIdentifier uri) p
               verTxtDocId <- lift $ getVersionedTextDoc (TextDocumentIdentifier uri)
               getSrcEdit state verTxtDocId (replaceRefs newName locations)
         fileEdits <- mapM getFileEdit filesRefs
-        pure $ InL $ foldl' (<>) mempty fileEdits
+        pure $ InL $ fold fileEdits
 
 -- | Limit renaming across modules.
 failWhenImportOrExport ::
@@ -217,9 +219,8 @@ removeGenerated HAR{..} = HAR{hieAst = go hieAst,..}
       HieASTs (fmap goAst (getAsts hf))
     goAst (Node nsi sp xs) = Node (SourcedNodeInfo $ M.restrictKeys (getSourcedNodeInfo nsi) (S.singleton SourceInfo)) sp (map goAst xs)
 
--- head is safe since groups are non-empty
 collectWith :: (Hashable a, Eq b) => (a -> b) -> HashSet a -> [(b, HashSet a)]
-collectWith f = map (\a -> (f $ head a, HS.fromList a)) . groupOn f . HS.toList
+collectWith f = map (\(a :| as) -> (f a, HS.fromList (a:as))) . groupWith f . HS.toList
 
 locToUri :: Location -> Uri
 locToUri (Location uri _) = uri
@@ -230,10 +231,8 @@ unsafeSrcSpanToLoc srcSpan =
         Nothing       -> error "Invalid conversion from UnhelpfulSpan to Location"
         Just location -> location
 
-locToFilePos :: Location -> Maybe (NormalizedFilePath, Position)
-locToFilePos (Location uri (Range pos _)) = (,pos) <$> nfp
-    where
-        nfp = uriToNormalizedFilePath $ toNormalizedUri uri
+locToFilePos :: Monad m => Location -> ExceptT PluginError m (NormalizedFilePath, Position)
+locToFilePos (Location uri (Range pos _)) = (,pos) <$> getNormalizedFilePathE uri
 
 replaceModName :: Name -> Maybe ModuleName -> Module
 replaceModName name mbModName =