Skip to content

Commit e657ed3

Browse files
committed
Extract stripPrefixes to a common utility, convert comment to haddoc
1 parent 6605900 commit e657ed3

File tree

3 files changed

+18
-31
lines changed

3 files changed

+18
-31
lines changed

ghcide/src/Development/IDE/GHC/CoreFile.hs

Lines changed: 12 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,8 @@ module Development.IDE.GHC.CoreFile
1010
, readBinCoreFile
1111
, writeBinCoreFile
1212
, getImplicitBinds
13-
, occNamePrefixes) where
13+
, occNamePrefixes
14+
, stripOccNamePrefix) where
1415

1516
import Control.Monad
1617
import Control.Monad.IO.Class
@@ -29,6 +30,7 @@ import GHC.Iface.Env
2930
#if MIN_VERSION_ghc(9,11,0)
3031
import qualified GHC.Iface.Load as Iface
3132
#endif
33+
import Data.Monoid (First (..))
3234
import GHC.Iface.Recomp.Binary (fingerprintBinMem)
3335
import GHC.IfaceToCore
3436
import GHC.Types.Id.Make
@@ -264,3 +266,12 @@ occNamePrefixes =
264266
, "$c"
265267
, "$m"
266268
]
269+
270+
-- | When e.g. DuplicateRecordFields is enabled, compiler generates
271+
-- names like "$sel:accessor:One" and "$sel:accessor:Two" to
272+
-- disambiguate record selectors
273+
-- https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/DuplicateRecordFields#Implementation
274+
stripOccNamePrefix :: T.Text -> T.Text
275+
stripOccNamePrefix name = T.takeWhile (/=':') $ fromMaybe name $
276+
getFirst $ foldMap (First . (`T.stripPrefix` name))
277+
occNamePrefixes

ghcide/src/Development/IDE/Plugin/Completions/Logic.hs

Lines changed: 2 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -37,14 +37,13 @@ import Data.Aeson (ToJSON (toJSON))
3737
import Data.Function (on)
3838

3939
import qualified Data.HashSet as HashSet
40-
import Data.Monoid (First (..))
4140
import Data.Ord (Down (Down))
4241
import qualified Data.Set as Set
4342
import Development.IDE.Core.PositionMapping
4443
import Development.IDE.GHC.Compat hiding (isQual, ppr)
4544
import qualified Development.IDE.GHC.Compat as GHC
4645
import Development.IDE.GHC.Compat.Util
47-
import Development.IDE.GHC.CoreFile (occNamePrefixes)
46+
import Development.IDE.GHC.CoreFile (stripOccNamePrefix)
4847
import Development.IDE.GHC.Error
4948
import Development.IDE.GHC.Util
5049
import Development.IDE.Plugin.Completions.Types
@@ -261,7 +260,7 @@ mkNameCompItem doc thingParent origName provenance isInfix !imp mod = CI {..}
261260
compKind = occNameToComKind origName
262261
isTypeCompl = isTcOcc origName
263262
typeText = Nothing
264-
label = stripPrefix $ printOutputable origName
263+
label = stripOccNamePrefix $ printOutputable origName
265264
insertText = case isInfix of
266265
Nothing -> label
267266
Just LeftSide -> label <> "`"
@@ -801,17 +800,6 @@ openingBacktick line prefixModule prefixText Position { _character=(fromIntegral
801800

802801
-- ---------------------------------------------------------------------
803802

804-
-- | Under certain circumstance GHC generates some extra stuff that we
805-
-- don't want in the autocompleted symbols
806-
{- When e.g. DuplicateRecordFields is enabled, compiler generates
807-
names like "$sel:accessor:One" and "$sel:accessor:Two" to disambiguate record selectors
808-
https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/DuplicateRecordFields#Implementation
809-
-}
810-
-- TODO: Turn this into an alex lexer that discards prefixes as if they were whitespace.
811-
stripPrefix :: T.Text -> T.Text
812-
stripPrefix name = T.takeWhile (/=':') $ fromMaybe name $
813-
getFirst $ foldMap (First . (`T.stripPrefix` name)) occNamePrefixes
814-
815803
mkRecordSnippetCompItem :: Uri -> Maybe T.Text -> T.Text -> [T.Text] -> Provenance -> Maybe (LImportDecl GhcPs) -> CompItem
816804
mkRecordSnippetCompItem uri parent ctxStr compl importedFrom imp = r
817805
where

plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs

Lines changed: 4 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,6 @@ import Data.List (find, intersperse)
2626
import qualified Data.Map as Map
2727
import Data.Maybe (fromMaybe, isJust,
2828
mapMaybe, maybeToList)
29-
import Data.Monoid (First (..), getFirst)
3029
import Data.Text (Text)
3130
import qualified Data.Text as T
3231
import Data.Unique (hashUnique, newUnique)
@@ -82,7 +81,7 @@ import Development.IDE.GHC.Compat.Core (Extension (NamedFieldPuns
8281
mapConPatDetail, mapLoc,
8382
pattern RealSrcSpan,
8483
plusUFM_C, unitUFM)
85-
import Development.IDE.GHC.CoreFile (occNamePrefixes)
84+
import Development.IDE.GHC.CoreFile (stripOccNamePrefix)
8685
import Development.IDE.GHC.Util (getExtensions,
8786
printOutputable)
8887
import Development.IDE.Graph (RuleResult)
@@ -240,7 +239,7 @@ inlayHintDotdotProvider _ state pId InlayHintParams {_textDocument = TextDocumen
240239
-- checks if 'a' is equal to 'Name' if the 'Either' is 'Right a', otherwise return 'False'
241240
nameEq = either (const False) ((==) name)
242241
in fmap fst $ find (nameEq . snd) filteredLocations
243-
valueWithLoc = [ (stripPrefix $ T.pack $ printName name, findLocation name defnLocs') | name <- names' ]
242+
valueWithLoc = [ (stripOccNamePrefix $ T.pack $ printName name, findLocation name defnLocs') | name <- names' ]
244243
-- use `, ` to separate labels with definition location
245244
label = intersperse (mkInlayHintLabelPart (", ", Nothing)) $ fmap mkInlayHintLabelPart valueWithLoc
246245
pure $ InlayHint { _position = currentEnd -- at the end of dotdot
@@ -645,16 +644,5 @@ getRecPatterns conPat@(conPatDetails . unLoc -> Just (RecCon flds))
645644
getRecPatterns _ = ([], False)
646645

647646
printFieldName :: Outputable a => a -> Text
648-
printFieldName = stripPrefix . printOutputable
649-
650-
{- When e.g. DuplicateRecordFields is enabled, compiler generates
651-
names like "$sel:accessor:One" and "$sel:accessor:Two" to
652-
disambiguate record selectors
653-
https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/DuplicateRecordFields#Implementation
654-
-}
655-
-- See also:
656-
-- https://github.com/haskell/haskell-language-server/blob/master/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs#L811
657-
stripPrefix :: T.Text -> T.Text
658-
stripPrefix name = T.takeWhile (/=':') $ fromMaybe name $
659-
getFirst $ foldMap (First . (`T.stripPrefix` name))
660-
occNamePrefixes
647+
printFieldName = stripOccNamePrefix . printOutputable
648+

0 commit comments

Comments
 (0)