Extract stripPrefixes to a common utility, convert comment to haddoc

kozak · kozak · commit e657ed3e63e8 · 2025-05-24T08:52:12.000+02:00
diff --git a/ghcide/src/Development/IDE/GHC/CoreFile.hs b/ghcide/src/Development/IDE/GHC/CoreFile.hs
@@ -10,7 +10,8 @@ module Development.IDE.GHC.CoreFile
   , readBinCoreFile
   , writeBinCoreFile
   , getImplicitBinds
-  , occNamePrefixes) where
+  , occNamePrefixes
+  , stripOccNamePrefix) where
 
 import           Control.Monad
 import           Control.Monad.IO.Class
@@ -29,6 +30,7 @@ import           GHC.Iface.Env
 #if MIN_VERSION_ghc(9,11,0)
 import qualified GHC.Iface.Load                  as Iface
 #endif
+import           Data.Monoid                     (First (..))
 import           GHC.Iface.Recomp.Binary         (fingerprintBinMem)
 import           GHC.IfaceToCore
 import           GHC.Types.Id.Make
@@ -264,3 +266,12 @@ occNamePrefixes =
   , "$c"
   , "$m"
   ]
+
+-- | When e.g. DuplicateRecordFields is enabled, compiler generates
+-- names like "$sel:accessor:One" and "$sel:accessor:Two" to
+-- disambiguate record selectors
+-- https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/DuplicateRecordFields#Implementation
+stripOccNamePrefix :: T.Text -> T.Text
+stripOccNamePrefix name = T.takeWhile (/=':') $ fromMaybe name $
+    getFirst $ foldMap (First . (`T.stripPrefix` name))
+    occNamePrefixes
diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs
@@ -37,14 +37,13 @@ import           Data.Aeson                               (ToJSON (toJSON))
 import           Data.Function                            (on)
 
 import qualified Data.HashSet                             as HashSet
-import           Data.Monoid                              (First (..))
 import           Data.Ord                                 (Down (Down))
 import qualified Data.Set                                 as Set
 import           Development.IDE.Core.PositionMapping
 import           Development.IDE.GHC.Compat               hiding (isQual, ppr)
 import qualified Development.IDE.GHC.Compat               as GHC
 import           Development.IDE.GHC.Compat.Util
-import           Development.IDE.GHC.CoreFile             (occNamePrefixes)
+import           Development.IDE.GHC.CoreFile             (stripOccNamePrefix)
 import           Development.IDE.GHC.Error
 import           Development.IDE.GHC.Util
 import           Development.IDE.Plugin.Completions.Types
@@ -261,7 +260,7 @@ mkNameCompItem doc thingParent origName provenance isInfix !imp mod = CI {..}
     compKind = occNameToComKind origName
     isTypeCompl = isTcOcc origName
     typeText = Nothing
-    label = stripPrefix $ printOutputable origName
+    label = stripOccNamePrefix $ printOutputable origName
     insertText = case isInfix of
             Nothing         -> label
             Just LeftSide   -> label <> "`"
@@ -801,17 +800,6 @@ openingBacktick line prefixModule prefixText Position { _character=(fromIntegral
 
 -- ---------------------------------------------------------------------
 
--- | Under certain circumstance GHC generates some extra stuff that we
--- don't want in the autocompleted symbols
-    {- When e.g. DuplicateRecordFields is enabled, compiler generates
-    names like "$sel:accessor:One" and "$sel:accessor:Two" to disambiguate record selectors
-    https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/DuplicateRecordFields#Implementation
-    -}
--- TODO: Turn this into an alex lexer that discards prefixes as if they were whitespace.
-stripPrefix :: T.Text -> T.Text
-stripPrefix name = T.takeWhile (/=':') $ fromMaybe name $
-  getFirst $ foldMap (First . (`T.stripPrefix` name)) occNamePrefixes
-
 mkRecordSnippetCompItem :: Uri -> Maybe T.Text -> T.Text -> [T.Text] -> Provenance -> Maybe (LImportDecl GhcPs) -> CompItem
 mkRecordSnippetCompItem uri parent ctxStr compl importedFrom imp = r
   where
diff --git a/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs b/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs
@@ -26,7 +26,6 @@ import           Data.List                            (find, intersperse)
 import qualified Data.Map                             as Map
 import           Data.Maybe                           (fromMaybe, isJust,
                                                        mapMaybe, maybeToList)
-import           Data.Monoid                          (First (..), getFirst)
 import           Data.Text                            (Text)
 import qualified Data.Text                            as T
 import           Data.Unique                          (hashUnique, newUnique)
@@ -82,7 +81,7 @@ import           Development.IDE.GHC.Compat.Core      (Extension (NamedFieldPuns
                                                        mapConPatDetail, mapLoc,
                                                        pattern RealSrcSpan,
                                                        plusUFM_C, unitUFM)
-import           Development.IDE.GHC.CoreFile         (occNamePrefixes)
+import           Development.IDE.GHC.CoreFile         (stripOccNamePrefix)
 import           Development.IDE.GHC.Util             (getExtensions,
                                                        printOutputable)
 import           Development.IDE.Graph                (RuleResult)
@@ -240,7 +239,7 @@ inlayHintDotdotProvider _ state pId InlayHintParams {_textDocument = TextDocumen
                    -- checks if 'a' is equal to 'Name' if the 'Either' is 'Right a', otherwise return 'False'
                    nameEq = either (const False) ((==) name)
                 in fmap fst $ find (nameEq . snd) filteredLocations
-             valueWithLoc = [ (stripPrefix $ T.pack $ printName name, findLocation name defnLocs') | name <- names' ]
+             valueWithLoc = [ (stripOccNamePrefix $ T.pack $ printName name, findLocation name defnLocs') | name <- names' ]
              -- use `, ` to separate labels with definition location
              label = intersperse (mkInlayHintLabelPart (", ", Nothing)) $ fmap mkInlayHintLabelPart valueWithLoc
          pure $ InlayHint { _position = currentEnd -- at the end of dotdot
@@ -645,16 +644,5 @@ getRecPatterns conPat@(conPatDetails . unLoc -> Just (RecCon flds))
 getRecPatterns _ = ([], False)
 
 printFieldName :: Outputable a => a -> Text
-printFieldName = stripPrefix . printOutputable
-
-{- When e.g. DuplicateRecordFields is enabled, compiler generates
-    names like "$sel:accessor:One" and "$sel:accessor:Two" to
-    disambiguate record selectors
-    https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/DuplicateRecordFields#Implementation
--}
--- See also:
--- https://github.com/haskell/haskell-language-server/blob/master/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs#L811
-stripPrefix :: T.Text -> T.Text
-stripPrefix name = T.takeWhile (/=':') $ fromMaybe name $
-    getFirst $ foldMap (First . (`T.stripPrefix` name))
-    occNamePrefixes
+printFieldName = stripOccNamePrefix . printOutputable
+
