Skip to content

Commit 855a39b

Browse files
committed
Extract stripPrefixes to a common utility, convert comment to haddoc
1 parent e93362d commit 855a39b

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)
@@ -228,7 +227,7 @@ inlayHintDotdotProvider _ state pId InlayHintParams {_textDocument = TextDocumen
228227
-- checks if 'a' is equal to 'Name' if the 'Either' is 'Right a', otherwise return 'False'
229228
nameEq = either (const False) ((==) name)
230229
in fmap fst $ find (nameEq . snd) filteredLocations
231-
valueWithLoc = [ (stripPrefix $ T.pack $ printName name, findLocation name defnLocs') | name <- names' ]
230+
valueWithLoc = [ (stripOccNamePrefix $ T.pack $ printName name, findLocation name defnLocs') | name <- names' ]
232231
-- use `, ` to separate labels with definition location
233232
label = intersperse (mkInlayHintLabelPart (", ", Nothing)) $ fmap mkInlayHintLabelPart valueWithLoc
234233
pure $ InlayHint { _position = currentEnd -- at the end of dotdot
@@ -618,16 +617,5 @@ getRecPatterns conPat@(conPatDetails . unLoc -> Just (RecCon flds))
618617
getRecPatterns _ = ([], False)
619618

620619
printFieldName :: Outputable a => a -> Text
621-
printFieldName = stripPrefix . printOutputable
622-
623-
{- When e.g. DuplicateRecordFields is enabled, compiler generates
624-
names like "$sel:accessor:One" and "$sel:accessor:Two" to
625-
disambiguate record selectors
626-
https://ghc.haskell.org/trac/ghc/wiki/Records/OverloadedRecordFields/DuplicateRecordFields#Implementation
627-
-}
628-
-- See also:
629-
-- https://github.com/haskell/haskell-language-server/blob/master/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs#L811
630-
stripPrefix :: T.Text -> T.Text
631-
stripPrefix name = T.takeWhile (/=':') $ fromMaybe name $
632-
getFirst $ foldMap (First . (`T.stripPrefix` name))
633-
occNamePrefixes
620+
printFieldName = stripOccNamePrefix . printOutputable
621+

0 commit comments

Comments
 (0)