Skip to content

Commit 7a4e1a9

Browse files
committed
fixes
1 parent 64f76e3 commit 7a4e1a9

File tree

6 files changed

+21
-10
lines changed

6 files changed

+21
-10
lines changed

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

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -55,6 +55,8 @@ module Development.IDE.GHC.Compat(
5555
mkAstNode,
5656
combineRealSrcSpans,
5757

58+
nonDetOccEnvElts,
59+
5860
isQualifiedImport,
5961
GhcVersion(..),
6062
ghcVersion,
@@ -268,6 +270,11 @@ import GHC.Types.Error
268270
import GHC.Driver.Config.Stg.Pipeline
269271
#endif
270272

273+
#if !MIN_VERSION_ghc(9,3,0)
274+
nonDetOccEnvElts :: OccEnv a -> [a]
275+
nonDetOccEnvElts = occEnvElts
276+
#endif
277+
271278
type ModIfaceAnnotation = Annotation
272279

273280
#if MIN_VERSION_ghc(9,3,0)

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -186,7 +186,7 @@ getCompletionsLSP ide plId
186186
let exportsMap = fromMaybe mempty packageExportsMap <> projectExportsMap
187187

188188
let moduleExports = getModuleExportsMap exportsMap
189-
exportsCompItems = foldMap (map (fromIdentInfo uri) . Set.toList) . occEnvElts . getExportsMap $ exportsMap
189+
exportsCompItems = foldMap (map (fromIdentInfo uri) . Set.toList) . nonDetOccEnvElts . getExportsMap $ exportsMap
190190
exportsCompls = mempty{anyQualCompls = exportsCompItems}
191191
let compls = (fst <$> localCompls) <> (fst <$> nonLocalCompls) <> Just exportsCompls <> Just lModules
192192

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -292,6 +292,7 @@ fromIdentInfo doc id@IdentInfo{..} q = CI
292292
, insertText=rend
293293
, provenance = DefinedIn mod
294294
, label=rend
295+
, typeText = Nothing
295296
, isInfix=Nothing
296297
, isTypeCompl= not (isDatacon id) && isUpper (T.head rend)
297298
, additionalTextEdits= Just $

ghcide/src/Development/IDE/Types/Exports.hs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -69,7 +69,7 @@ updateExportsMap old new = ExportsMap
6969
| m_uniq <- nonDetKeysUFM (getModuleExportsMap new)]
7070

7171
size :: ExportsMap -> Int
72-
size = sum . map (Set.size) . occEnvElts . getExportsMap
72+
size = sum . map (Set.size) . nonDetOccEnvElts . getExportsMap
7373

7474
mkVarOrDataOcc :: Text -> OccName
7575
mkVarOrDataOcc t = mkOcc $ mkFastStringByteString $ encodeUtf8 t
@@ -98,7 +98,8 @@ rendered = occNameText . name
9898
-- TODO: pattern synonymoccNameText :: OccName -> Text
9999
occNameText :: OccName -> Text
100100
occNameText name
101-
| isTcOcc name && isSymOcc name = "type " <> renderedOcc
101+
| isSymOcc name = "(" <> renderedOcc <> ")"
102+
| isTcOcc name && isSymOcc name = "type (" <> renderedOcc <> ")"
102103
| otherwise = renderedOcc
103104
where
104105
renderedOcc = renderOcc name

plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/ImportUtils.hs

Lines changed: 8 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,7 @@ module Development.IDE.Plugin.Plugins.ImportUtils
1010
import Data.List.NonEmpty (NonEmpty ((:|)))
1111
import qualified Data.Text as T
1212
import Development.IDE.Plugin.CodeAction.ExactPrint (wildCardSymbol)
13-
import Development.IDE.Types.Exports (IdentInfo (..))
13+
import Development.IDE.Types.Exports
1414
import Language.LSP.Types (CodeActionKind (..))
1515

1616
-- | Possible import styles for an 'IdentInfo'.
@@ -49,16 +49,18 @@ data ImportStyle
4949
deriving Show
5050

5151
importStyles :: IdentInfo -> NonEmpty ImportStyle
52-
importStyles IdentInfo {parent, rendered, isDatacon}
53-
| Just p <- parent
52+
importStyles i@(IdentInfo {parent})
53+
| Just p <- pr
5454
-- Constructors always have to be imported via their parent data type, but
5555
-- methods and associated type/data families can also be imported as
5656
-- top-level exports.
57-
= ImportViaParent rendered p
58-
:| [ImportTopLevel rendered | not isDatacon]
57+
= ImportViaParent rend p
58+
:| [ImportTopLevel rend | not (isDatacon i)]
5959
<> [ImportAllConstructors p]
6060
| otherwise
61-
= ImportTopLevel rendered :| []
61+
= ImportTopLevel rend :| []
62+
where rend = rendered i
63+
pr = occNameText <$> parent
6264

6365
-- | Used for adding new imports
6466
renderImportStyle :: ImportStyle -> T.Text

plugins/hls-refactor-plugin/test/Main.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1675,7 +1675,7 @@ suggestImportTests = testGroup "suggest import actions"
16751675
, test True [] "f = (&) [] id" [] "import Data.Function ((&))"
16761676
, test True [] "f = (.|.)" [] "import Data.Bits (Bits((.|.)))"
16771677
, test True [] "f = (.|.)" [] "import Data.Bits ((.|.))"
1678-
, test True [] "f :: a ~~ b" [] "import Data.Type.Equality (type (~~))"
1678+
, test True [] "f :: a ~~ b" [] "import Data.Type.Equality ((~~))"
16791679
, test True
16801680
["qualified Data.Text as T"
16811681
] "f = T.putStrLn" [] "import qualified Data.Text.IO as T"

0 commit comments

Comments
 (0)