@@ -16,8 +16,7 @@ module Development.IDE.Plugin.TypeLenses (
16
16
17
17
import Control.Concurrent.STM.Stats (atomically )
18
18
import Control.DeepSeq (rwhnf )
19
- import Control.Lens (Bifunctor (bimap ), (?~) ,
20
- (^.) )
19
+ import Control.Lens ((?~) , (^.) )
21
20
import Control.Monad (mzero )
22
21
import Control.Monad.Extra (whenMaybe )
23
22
import Control.Monad.IO.Class (MonadIO (liftIO ))
@@ -268,7 +267,7 @@ data Mode
268
267
Always
269
268
| -- | similar to 'Always', but only displays for exported global bindings
270
269
Exported
271
- | -- | follows error messages produced by GHC
270
+ | -- | follows error messages produced by GHC
272
271
Diagnostics
273
272
deriving (Eq , Ord , Show , Read , Enum )
274
273
@@ -323,16 +322,16 @@ rules recorder = do
323
322
result <- liftIO $ gblBindingType (hscEnv <$> hsc) (tmrTypechecked <$> tmr)
324
323
pure ([] , result)
325
324
326
- bindToSig :: Id -> HscEnv -> GlobalRdrEnv -> IOEnv (Env TcGblEnv TcLclEnv ) (Name , String )
325
+ -- | Converts a given haskell bind to its corresponding type signature.
326
+ bindToSig :: Id -> HscEnv -> GlobalRdrEnv -> IOEnv (Env TcGblEnv TcLclEnv ) String
327
327
bindToSig id hsc rdrEnv = do
328
328
env <-
329
329
#if MIN_VERSION_ghc(9,7,0)
330
330
liftZonkM
331
331
#endif
332
332
tcInitTidyEnv
333
- let name = idName id
334
- (_, ty) = tidyOpenType env (idType id )
335
- pure (name, showDocRdrEnv hsc rdrEnv (pprSigmaType ty))
333
+ let (_, ty) = tidyOpenType env (idType id )
334
+ pure (showDocRdrEnv hsc rdrEnv (pprSigmaType ty))
336
335
337
336
gblBindingType :: Maybe HscEnv -> Maybe TcGblEnv -> IO (Maybe GlobalBindingTypeSigsResult )
338
337
gblBindingType (Just hsc) (Just gblEnv) = do
@@ -346,8 +345,9 @@ gblBindingType (Just hsc) (Just gblEnv) = do
346
345
renderBind id = do
347
346
let name = idName id
348
347
hasSig name $ do
349
- (name', sig) <- bindToSig id hsc rdrEnv
350
- pure $ GlobalBindingTypeSig name (printName name' <> " :: " <> sig) (name `elemNameSet` exports)
348
+ -- convert from bind id to its signature
349
+ sig <- bindToSig id hsc rdrEnv
350
+ pure $ GlobalBindingTypeSig name (printName name <> " :: " <> sig) (name `elemNameSet` exports)
351
351
patToSig p = do
352
352
let name = patSynName p
353
353
hasSig name
@@ -471,7 +471,8 @@ whereClauseInlayHints state plId (InlayHintParams _ (TextDocumentIdentifier uri)
471
471
(_, sig) <- liftIO
472
472
$ initTcWithGbl hsc tcGblEnv ghostSpan
473
473
$ bindToSig id hsc rdrEnv
474
- pure $ generateWhereInlayHints range (maybe (" " , " " ) (bimap (T. pack . printName) T. pack) sig) offset
474
+ let name = idName id
475
+ pure $ generateWhereInlayHints range (T. pack $ printName name) (maybe " _" T. pack sig) offset
475
476
476
477
inlayHints <- sequence
477
478
[ bindingToInlayHints bindingId bindingRange offset
@@ -488,8 +489,8 @@ whereClauseInlayHints state plId (InlayHintParams _ (TextDocumentIdentifier uri)
488
489
489
490
pure $ InL inlayHints
490
491
where
491
- generateWhereInlayHints :: Range -> ( T. Text, T. Text) -> Int -> InlayHint
492
- generateWhereInlayHints range ( name, ty) offset =
492
+ generateWhereInlayHints :: Range -> T. Text -> T. Text -> Int -> InlayHint
493
+ generateWhereInlayHints range name ty offset =
493
494
let edit = makeEdit range (name <> " :: " <> ty) offset
494
495
in InlayHint { _textEdits = Just [edit]
495
496
, _paddingRight = Nothing
0 commit comments