{-# LANGUAGE DeriveAnyClass   #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE TypeFamilies     #-}

-- | An HLS plugin to provide code lenses for type signatures
module Development.IDE.Plugin.TypeLenses (
  descriptor,
  suggestSignature,
  typeLensCommandId,
  GlobalBindingTypeSig (..),
  GetGlobalBindingTypeSigs (..),
  GlobalBindingTypeSigsResult (..),
  Log(..)
  ) where

import           Control.Concurrent.STM.Stats         (atomically)
import           Control.DeepSeq                      (rwhnf)
import           Control.Lens                         ((?~))
import           Control.Monad                        (mzero)
import           Control.Monad.Extra                  (whenMaybe)
import           Control.Monad.IO.Class               (MonadIO (liftIO))
import           Control.Monad.Trans.Class            (MonadTrans (lift))
import           Data.Aeson.Types                     (toJSON)
import qualified Data.Aeson.Types                     as A
import           Data.List                            (find)
import qualified Data.Map                             as Map
import           Data.Maybe                           (catMaybes, maybeToList)
import qualified Data.Text                            as T
import           Development.IDE                      (GhcSession (..),
                                                       HscEnvEq (hscEnv),
                                                       RuleResult, Rules, Uri,
                                                       define, srcSpanToRange,
                                                       usePropertyAction)
import           Development.IDE.Core.Compile         (TcModuleResult (..))
import           Development.IDE.Core.PluginUtils
import           Development.IDE.Core.PositionMapping (PositionMapping,
                                                       fromCurrentRange,
                                                       toCurrentRange)
import           Development.IDE.Core.Rules           (IdeState, runAction)
import           Development.IDE.Core.RuleTypes       (TypeCheck (TypeCheck))
import           Development.IDE.Core.Service         (getDiagnostics)
import           Development.IDE.Core.Shake           (getHiddenDiagnostics,
                                                       use)
import qualified Development.IDE.Core.Shake           as Shake
import           Development.IDE.GHC.Compat
import           Development.IDE.GHC.Util             (printName)
import           Development.IDE.Graph.Classes
import           Development.IDE.Types.Location       (Position (Position, _line),
                                                       Range (Range, _end, _start))
import           GHC.Generics                         (Generic)
import           Ide.Logger                           (Pretty (pretty),
                                                       Recorder, WithPriority,
                                                       cmapWithPrio)
import           Ide.Plugin.Error
import           Ide.Plugin.Properties
import           Ide.PluginUtils                      (mkLspCommand)
import           Ide.Types                            (CommandFunction,
                                                       CommandId (CommandId),
                                                       PluginCommand (PluginCommand),
                                                       PluginDescriptor (..),
                                                       PluginId,
                                                       PluginMethodHandler,
                                                       ResolveFunction,
                                                       configCustomConfig,
                                                       defaultConfigDescriptor,
                                                       defaultPluginDescriptor,
                                                       mkCustomConfig,
                                                       mkPluginHandler,
                                                       mkResolveHandler)
import qualified Language.LSP.Protocol.Lens           as L
import           Language.LSP.Protocol.Message        (Method (Method_CodeLensResolve, Method_TextDocumentCodeLens),
                                                       SMethod (..))
import           Language.LSP.Protocol.Types          (ApplyWorkspaceEditParams (ApplyWorkspaceEditParams),
                                                       CodeLens (..),
                                                       CodeLensParams (CodeLensParams, _textDocument),
                                                       Command, Diagnostic (..),
                                                       Null (Null),
                                                       TextDocumentIdentifier (TextDocumentIdentifier),
                                                       TextEdit (TextEdit),
                                                       WorkspaceEdit (WorkspaceEdit),
                                                       type (|?) (..))
import qualified Language.LSP.Server                  as LSP
import           Text.Regex.TDFA                      ((=~))

data Log = LogShake Shake.Log deriving Int -> Log -> ShowS
[Log] -> ShowS
Log -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Log] -> ShowS
$cshowList :: [Log] -> ShowS
show :: Log -> String
$cshow :: Log -> String
showsPrec :: Int -> Log -> ShowS
$cshowsPrec :: Int -> Log -> ShowS
Show

instance Pretty Log where
  pretty :: forall ann. Log -> Doc ann
pretty = \case
    LogShake Log
msg -> forall a ann. Pretty a => a -> Doc ann
pretty Log
msg


typeLensCommandId :: T.Text
typeLensCommandId :: Text
typeLensCommandId = Text
"typesignature.add"

descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
descriptor :: Recorder (WithPriority Log)
-> PluginId -> PluginDescriptor IdeState
descriptor Recorder (WithPriority Log)
recorder PluginId
plId =
  (forall ideState. PluginId -> PluginDescriptor ideState
defaultPluginDescriptor PluginId
plId)
    { $sel:pluginHandlers:PluginDescriptor :: PluginHandlers IdeState
pluginHandlers = forall ideState (m :: Method 'ClientToServer 'Request).
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'Method_TextDocumentCodeLens
SMethod_TextDocumentCodeLens PluginMethodHandler IdeState 'Method_TextDocumentCodeLens
codeLensProvider
                    forall a. Semigroup a => a -> a -> a
<> forall ideState a (m :: Method 'ClientToServer 'Request).
(FromJSON a, PluginRequestMethod m,
 HasData_ (MessageParams m) (Maybe Value)) =>
SClientMethod m
-> ResolveFunction ideState a m -> PluginHandlers ideState
mkResolveHandler SMethod 'Method_CodeLensResolve
SMethod_CodeLensResolve ResolveFunction IdeState TypeLensesResolve 'Method_CodeLensResolve
codeLensResolveProvider
    , $sel:pluginCommands:PluginDescriptor :: [PluginCommand IdeState]
pluginCommands = [forall ideState a.
FromJSON a =>
CommandId
-> Text -> CommandFunction ideState a -> PluginCommand ideState
PluginCommand (Text -> CommandId
CommandId Text
typeLensCommandId) Text
"adds a signature" CommandFunction IdeState WorkspaceEdit
commandHandler]
    , $sel:pluginRules:PluginDescriptor :: Rules ()
pluginRules = Recorder (WithPriority Log) -> Rules ()
rules Recorder (WithPriority Log)
recorder
    , $sel:pluginConfigDescriptor:PluginDescriptor :: ConfigDescriptor
pluginConfigDescriptor = ConfigDescriptor
defaultConfigDescriptor {$sel:configCustomConfig:ConfigDescriptor :: CustomConfig
configCustomConfig = forall (r :: [PropertyKey]). Properties r -> CustomConfig
mkCustomConfig Properties '[ 'PropertyKey "mode" ('TEnum Mode)]
properties}
    }

properties :: Properties '[ 'PropertyKey "mode" (TEnum Mode)]
properties :: Properties '[ 'PropertyKey "mode" ('TEnum Mode)]
properties = Properties '[]
emptyProperties
  forall a b. a -> (a -> b) -> b
& forall (s :: Symbol) (r :: [PropertyKey]) a.
(KnownSymbol s, NotElem s r, ToJSON a, FromJSON a, Eq a, Show a) =>
KeyNameProxy s
-> Text
-> [(a, Text)]
-> a
-> Properties r
-> Properties ('PropertyKey s ('TEnum a) : r)
defineEnumProperty forall a. IsLabel "mode" a => a
#mode Text
"Control how type lenses are shown"
    [ (Mode
Always, Text
"Always displays type lenses of global bindings")
    , (Mode
Exported, Text
"Only display type lenses of exported global bindings")
    , (Mode
Diagnostics, Text
"Follows error messages produced by GHC about missing signatures")
    ] Mode
Always

codeLensProvider :: PluginMethodHandler IdeState Method_TextDocumentCodeLens
codeLensProvider :: PluginMethodHandler IdeState 'Method_TextDocumentCodeLens
codeLensProvider IdeState
ideState PluginId
pId CodeLensParams{$sel:_textDocument:CodeLensParams :: CodeLensParams -> TextDocumentIdentifier
_textDocument = TextDocumentIdentifier Uri
uri} = do
    Mode
mode <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. String -> IdeState -> Action a -> IO a
runAction String
"codeLens.config" IdeState
ideState forall a b. (a -> b) -> a -> b
$ forall (s :: Symbol) (k :: PropertyKey) (t :: PropertyType)
       (r :: [PropertyKey]).
HasProperty s k t r =>
KeyNameProxy s -> PluginId -> Properties r -> Action (ToHsType t)
usePropertyAction forall a. IsLabel "mode" a => a
#mode PluginId
pId Properties '[ 'PropertyKey "mode" ('TEnum Mode)]
properties
    NormalizedFilePath
nfp <- forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
uri
    -- We have two ways we can possibly generate code lenses for type lenses.
    -- Different options are with different "modes" of the type-lenses plugin.
    -- (Remember here, as the code lens is not resolved yet, we only really need
    -- the range and any data that will help us resolve it later)
    let -- The first option is to generate lens from diagnostics about
        -- top level bindings.
        generateLensFromGlobalDiags :: [FileDiagnostic] -> [CodeLens]
generateLensFromGlobalDiags [FileDiagnostic]
diags =
          -- We don't actually pass any data to resolve, however we need this
          -- dummy type to make sure HLS resolves our lens
          [ Range -> Maybe Command -> Maybe Value -> CodeLens
CodeLens Range
_range forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON TypeLensesResolve
TypeLensesResolve)
            | (NormalizedFilePath
dFile, ShowDiagnostic
_, diag :: Diagnostic
diag@Diagnostic{Range
$sel:_range:Diagnostic :: Diagnostic -> Range
_range :: Range
_range}) <- [FileDiagnostic]
diags
            , NormalizedFilePath
dFile forall a. Eq a => a -> a -> Bool
== NormalizedFilePath
nfp
            , Diagnostic -> Bool
isGlobalDiagnostic Diagnostic
diag]
        -- The second option is to generate lenses from the GlobalBindingTypeSig
        -- rule. This is the only type that needs to have the range adjusted
        -- with PositionMapping.
        -- PositionMapping for diagnostics doesn't make sense, because we always
        -- have fresh diagnostics even if current module parsed failed (the
        -- diagnostic would then be parse failed). See
        -- https://github.com/haskell/haskell-language-server/pull/3558 for this
        -- discussion.
        generateLensFromGlobal :: [GlobalBindingTypeSig] -> PositionMapping -> [CodeLens]
generateLensFromGlobal [GlobalBindingTypeSig]
sigs PositionMapping
mp = do
          [ Range -> Maybe Command -> Maybe Value -> CodeLens
CodeLens Range
newRange forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON TypeLensesResolve
TypeLensesResolve)
            | GlobalBindingTypeSig
sig <- [GlobalBindingTypeSig]
sigs
            , Just Range
range <- [SrcSpan -> Maybe Range
srcSpanToRange (GlobalBindingTypeSig -> SrcSpan
gbSrcSpan GlobalBindingTypeSig
sig)]
            , Just Range
newRange <- [PositionMapping -> Range -> Maybe Range
toCurrentRange PositionMapping
mp Range
range]]
    if Mode
mode forall a. Eq a => a -> a -> Bool
== Mode
Always Bool -> Bool -> Bool
|| Mode
mode forall a. Eq a => a -> a -> Bool
== Mode
Exported
      then do
        -- In this mode we get the global bindings from the
        -- GlobalBindingTypeSigs rule.
        (GlobalBindingTypeSigsResult [GlobalBindingTypeSig]
gblSigs, PositionMapping
gblSigsMp) <-
          forall (m :: * -> *) e a.
MonadIO m =>
String -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE String
"codeLens.GetGlobalBindingTypeSigs" IdeState
ideState
          forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k
-> NormalizedFilePath
-> ExceptT PluginError Action (v, PositionMapping)
useWithStaleE GetGlobalBindingTypeSigs
GetGlobalBindingTypeSigs NormalizedFilePath
nfp
        -- Depending on whether we only want exported or not we filter our list
        -- of signatures to get what we want
        let relevantGlobalSigs :: [GlobalBindingTypeSig]
relevantGlobalSigs =
              if Mode
mode forall a. Eq a => a -> a -> Bool
== Mode
Exported
                then forall a. (a -> Bool) -> [a] -> [a]
filter GlobalBindingTypeSig -> Bool
gbExported [GlobalBindingTypeSig]
gblSigs
                else [GlobalBindingTypeSig]
gblSigs
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> a |? b
InL forall a b. (a -> b) -> a -> b
$ [GlobalBindingTypeSig] -> PositionMapping -> [CodeLens]
generateLensFromGlobal [GlobalBindingTypeSig]
relevantGlobalSigs PositionMapping
gblSigsMp
      else do
        -- For this mode we exclusively use diagnostics to create the lenses.
        -- However we will still use the GlobalBindingTypeSigs to resolve them.
        [FileDiagnostic]
diags <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ IdeState -> STM [FileDiagnostic]
getDiagnostics IdeState
ideState
        [FileDiagnostic]
hDiags <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ IdeState -> STM [FileDiagnostic]
getHiddenDiagnostics IdeState
ideState
        let allDiags :: [FileDiagnostic]
allDiags = [FileDiagnostic]
diags forall a. Semigroup a => a -> a -> a
<> [FileDiagnostic]
hDiags
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> a |? b
InL forall a b. (a -> b) -> a -> b
$ [FileDiagnostic] -> [CodeLens]
generateLensFromGlobalDiags [FileDiagnostic]
allDiags

codeLensResolveProvider :: ResolveFunction IdeState TypeLensesResolve Method_CodeLensResolve
codeLensResolveProvider :: ResolveFunction IdeState TypeLensesResolve 'Method_CodeLensResolve
codeLensResolveProvider IdeState
ideState PluginId
pId lens :: MessageParams 'Method_CodeLensResolve
lens@CodeLens{Range
$sel:_range:CodeLens :: CodeLens -> Range
_range :: Range
_range} Uri
uri TypeLensesResolve
TypeLensesResolve = do
  NormalizedFilePath
nfp <- forall (m :: * -> *).
Monad m =>
Uri -> ExceptT PluginError m NormalizedFilePath
getNormalizedFilePathE Uri
uri
  (gblSigs :: GlobalBindingTypeSigsResult
gblSigs@(GlobalBindingTypeSigsResult [GlobalBindingTypeSig]
_), PositionMapping
pm) <-
    forall (m :: * -> *) e a.
MonadIO m =>
String -> IdeState -> ExceptT e Action a -> ExceptT e m a
runActionE String
"codeLens.GetGlobalBindingTypeSigs" IdeState
ideState
    forall a b. (a -> b) -> a -> b
$ forall k v.
IdeRule k v =>
k
-> NormalizedFilePath
-> ExceptT PluginError Action (v, PositionMapping)
useWithStaleE GetGlobalBindingTypeSigs
GetGlobalBindingTypeSigs NormalizedFilePath
nfp
  -- regardless of how the original lens was generated, we want to get the range
  -- that the global bindings rule would expect here, hence the need to reverse
  -- position map the range, regardless of whether it was position mapped in the
  -- beginning or freshly taken from diagnostics.
  Range
newRange <- forall (m :: * -> *) e b. Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe PluginError
PluginStaleResolve (PositionMapping -> Range -> Maybe Range
fromCurrentRange PositionMapping
pm Range
_range)
  -- We also pass on the PositionMapping so that the generated text edit can
  -- have the range adjusted.
  (Text
title, TextEdit
edit) <-
        forall (m :: * -> *) e b. Monad m => e -> Maybe b -> ExceptT e m b
handleMaybe PluginError
PluginStaleResolve forall a b. (a -> b) -> a -> b
$ Bool
-> Maybe GlobalBindingTypeSigsResult
-> Maybe PositionMapping
-> Range
-> Maybe (Text, TextEdit)
suggestGlobalSignature' Bool
False (forall a. a -> Maybe a
Just GlobalBindingTypeSigsResult
gblSigs) (forall a. a -> Maybe a
Just PositionMapping
pm) Range
newRange
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ MessageParams 'Method_CodeLensResolve
lens forall a b. a -> (a -> b) -> b
& forall s a. HasCommand s a => Lens' s a
L.command forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ PluginId -> Uri -> Text -> TextEdit -> Command
generateLensCommand PluginId
pId Uri
uri Text
title TextEdit
edit

generateLensCommand :: PluginId -> Uri -> T.Text -> TextEdit -> Command
generateLensCommand :: PluginId -> Uri -> Text -> TextEdit -> Command
generateLensCommand PluginId
pId Uri
uri Text
title TextEdit
edit =
  let wEdit :: WorkspaceEdit
wEdit = Maybe (Map Uri [TextEdit])
-> Maybe
     [TextDocumentEdit |? (CreateFile |? (RenameFile |? DeleteFile))]
-> Maybe (Map ChangeAnnotationIdentifier ChangeAnnotation)
-> WorkspaceEdit
WorkspaceEdit (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
Map.singleton Uri
uri forall a b. (a -> b) -> a -> b
$ [TextEdit
edit]) forall a. Maybe a
Nothing forall a. Maybe a
Nothing
  in PluginId -> CommandId -> Text -> Maybe [Value] -> Command
mkLspCommand PluginId
pId (Text -> CommandId
CommandId Text
typeLensCommandId) Text
title (forall a. a -> Maybe a
Just [forall a. ToJSON a => a -> Value
toJSON WorkspaceEdit
wEdit])

-- Since the lenses are created with diagnostics, and since the globalTypeSig
-- rule can't be changed as it is also used by the hls-refactor plugin, we can't
-- rely on actions. Because we can't rely on actions it doesn't make sense to
-- recompute the edit upon command. Hence the command here just takes a edit
-- and applies it.
commandHandler :: CommandFunction IdeState WorkspaceEdit
commandHandler :: CommandFunction IdeState WorkspaceEdit
commandHandler IdeState
_ideState WorkspaceEdit
wedit = do
  LspId 'Method_WorkspaceApplyEdit
_ <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'ServerToClient 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod m
-> MessageParams m
-> (Either ResponseError (MessageResult m) -> f ())
-> f (LspId m)
LSP.sendRequest SMethod 'Method_WorkspaceApplyEdit
SMethod_WorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams forall a. Maybe a
Nothing WorkspaceEdit
wedit) (\Either ResponseError (MessageResult 'Method_WorkspaceApplyEdit)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> a |? b
InR Null
Null

--------------------------------------------------------------------------------
suggestSignature :: Bool -> Maybe GlobalBindingTypeSigsResult -> Diagnostic -> [(T.Text, TextEdit)]
suggestSignature :: Bool
-> Maybe GlobalBindingTypeSigsResult
-> Diagnostic
-> [(Text, TextEdit)]
suggestSignature Bool
isQuickFix Maybe GlobalBindingTypeSigsResult
mGblSigs Diagnostic
diag =
  forall a. Maybe a -> [a]
maybeToList (Bool
-> Maybe GlobalBindingTypeSigsResult
-> Diagnostic
-> Maybe (Text, TextEdit)
suggestGlobalSignature Bool
isQuickFix Maybe GlobalBindingTypeSigsResult
mGblSigs Diagnostic
diag)

-- The suggestGlobalSignature is separated into two functions. The main function
-- works with a diagnostic, which then calls the secondary function with
-- whatever pieces of the diagnostic it needs. This allows the resolve function,
-- which no longer has the Diagnostic, to still call the secondary functions.
suggestGlobalSignature :: Bool -> Maybe GlobalBindingTypeSigsResult -> Diagnostic -> Maybe (T.Text, TextEdit)
suggestGlobalSignature :: Bool
-> Maybe GlobalBindingTypeSigsResult
-> Diagnostic
-> Maybe (Text, TextEdit)
suggestGlobalSignature Bool
isQuickFix Maybe GlobalBindingTypeSigsResult
mGblSigs diag :: Diagnostic
diag@Diagnostic{Range
_range :: Range
$sel:_range:Diagnostic :: Diagnostic -> Range
_range}
  | Diagnostic -> Bool
isGlobalDiagnostic Diagnostic
diag =
    Bool
-> Maybe GlobalBindingTypeSigsResult
-> Maybe PositionMapping
-> Range
-> Maybe (Text, TextEdit)
suggestGlobalSignature' Bool
isQuickFix Maybe GlobalBindingTypeSigsResult
mGblSigs forall a. Maybe a
Nothing Range
_range
  | Bool
otherwise = forall a. Maybe a
Nothing

isGlobalDiagnostic :: Diagnostic -> Bool
isGlobalDiagnostic :: Diagnostic -> Bool
isGlobalDiagnostic Diagnostic{Text
$sel:_message:Diagnostic :: Diagnostic -> Text
_message :: Text
_message} = Text
_message forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ (Text
"(Top-level binding|Pattern synonym) with no type signature" :: T.Text)

-- If a PositionMapping is supplied, this function will call
-- gblBindingTypeSigToEdit with it to create a TextEdit in the right location.
suggestGlobalSignature' :: Bool -> Maybe GlobalBindingTypeSigsResult -> Maybe PositionMapping -> Range -> Maybe (T.Text, TextEdit)
suggestGlobalSignature' :: Bool
-> Maybe GlobalBindingTypeSigsResult
-> Maybe PositionMapping
-> Range
-> Maybe (Text, TextEdit)
suggestGlobalSignature' Bool
isQuickFix Maybe GlobalBindingTypeSigsResult
mGblSigs Maybe PositionMapping
pm Range
range
  |   Just (GlobalBindingTypeSigsResult [GlobalBindingTypeSig]
sigs) <- Maybe GlobalBindingTypeSigsResult
mGblSigs
    , Just GlobalBindingTypeSig
sig <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\GlobalBindingTypeSig
x -> SrcSpan -> Range -> Bool
sameThing (GlobalBindingTypeSig -> SrcSpan
gbSrcSpan GlobalBindingTypeSig
x) Range
range) [GlobalBindingTypeSig]
sigs
    , Text
signature <- String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ GlobalBindingTypeSig -> String
gbRendered GlobalBindingTypeSig
sig
    , Text
title <- if Bool
isQuickFix then Text
"add signature: " forall a. Semigroup a => a -> a -> a
<> Text
signature else Text
signature
    , Just TextEdit
action <- GlobalBindingTypeSig -> Maybe PositionMapping -> Maybe TextEdit
gblBindingTypeSigToEdit GlobalBindingTypeSig
sig Maybe PositionMapping
pm =
    forall a. a -> Maybe a
Just (Text
title, TextEdit
action)
  | Bool
otherwise = forall a. Maybe a
Nothing

sameThing :: SrcSpan -> Range -> Bool
sameThing :: SrcSpan -> Range -> Bool
sameThing SrcSpan
s1 Range
s2 = (Range -> Position
_start forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SrcSpan -> Maybe Range
srcSpanToRange SrcSpan
s1) forall a. Eq a => a -> a -> Bool
== (Range -> Position
_start forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> Maybe a
Just Range
s2)

gblBindingTypeSigToEdit :: GlobalBindingTypeSig -> Maybe PositionMapping -> Maybe TextEdit
gblBindingTypeSigToEdit :: GlobalBindingTypeSig -> Maybe PositionMapping -> Maybe TextEdit
gblBindingTypeSigToEdit GlobalBindingTypeSig{Bool
String
Name
gbName :: GlobalBindingTypeSig -> Name
gbExported :: Bool
gbRendered :: String
gbName :: Name
gbRendered :: GlobalBindingTypeSig -> String
gbExported :: GlobalBindingTypeSig -> Bool
..} Maybe PositionMapping
mmp
  | Just Range{Position
_end :: Position
_start :: Position
$sel:_start:Range :: Range -> Position
$sel:_end:Range :: Range -> Position
..} <- SrcSpan -> Maybe Range
srcSpanToRange forall a b. (a -> b) -> a -> b
$ forall a. NamedThing a => a -> SrcSpan
getSrcSpan Name
gbName
    , Position
startOfLine <- UInt -> UInt -> Position
Position (Position -> UInt
_line Position
_start) UInt
0
    , Range
beforeLine <- Position -> Position -> Range
Range Position
startOfLine Position
startOfLine
    -- If `mmp` is `Nothing`, return the original range,
    -- otherwise we apply `toCurrentRange`, and the guard should fail if `toCurrentRange` failed.
    , Just Range
range <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. a -> Maybe a
Just Range
beforeLine) (forall a b c. (a -> b -> c) -> b -> a -> c
flip PositionMapping -> Range -> Maybe Range
toCurrentRange Range
beforeLine) Maybe PositionMapping
mmp
    -- We need to flatten the signature, as otherwise long signatures are
    -- rendered on multiple lines with invalid formatting.
    , String
renderedFlat <- [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
gbRendered
    = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Range -> Text -> TextEdit
TextEdit Range
range forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
renderedFlat forall a. Semigroup a => a -> a -> a
<> Text
"\n"
  | Bool
otherwise = forall a. Maybe a
Nothing

-- |We don't need anything to resolve our lens, but a data field is mandatory
-- to get types resolved in HLS
data TypeLensesResolve = TypeLensesResolve
  deriving (forall x. Rep TypeLensesResolve x -> TypeLensesResolve
forall x. TypeLensesResolve -> Rep TypeLensesResolve x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TypeLensesResolve x -> TypeLensesResolve
$cfrom :: forall x. TypeLensesResolve -> Rep TypeLensesResolve x
Generic, Value -> Parser [TypeLensesResolve]
Value -> Parser TypeLensesResolve
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TypeLensesResolve]
$cparseJSONList :: Value -> Parser [TypeLensesResolve]
parseJSON :: Value -> Parser TypeLensesResolve
$cparseJSON :: Value -> Parser TypeLensesResolve
A.FromJSON, [TypeLensesResolve] -> Encoding
[TypeLensesResolve] -> Value
TypeLensesResolve -> Encoding
TypeLensesResolve -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TypeLensesResolve] -> Encoding
$ctoEncodingList :: [TypeLensesResolve] -> Encoding
toJSONList :: [TypeLensesResolve] -> Value
$ctoJSONList :: [TypeLensesResolve] -> Value
toEncoding :: TypeLensesResolve -> Encoding
$ctoEncoding :: TypeLensesResolve -> Encoding
toJSON :: TypeLensesResolve -> Value
$ctoJSON :: TypeLensesResolve -> Value
A.ToJSON)

data Mode
  = -- | always displays type lenses of global bindings, no matter what GHC flags are set
    Always
  | -- | similar to 'Always', but only displays for exported global bindings
    Exported
  | -- |  follows error messages produced by GHC
    Diagnostics
  deriving (Mode -> Mode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c== :: Mode -> Mode -> Bool
Eq, Eq Mode
Mode -> Mode -> Bool
Mode -> Mode -> Ordering
Mode -> Mode -> Mode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Mode -> Mode -> Mode
$cmin :: Mode -> Mode -> Mode
max :: Mode -> Mode -> Mode
$cmax :: Mode -> Mode -> Mode
>= :: Mode -> Mode -> Bool
$c>= :: Mode -> Mode -> Bool
> :: Mode -> Mode -> Bool
$c> :: Mode -> Mode -> Bool
<= :: Mode -> Mode -> Bool
$c<= :: Mode -> Mode -> Bool
< :: Mode -> Mode -> Bool
$c< :: Mode -> Mode -> Bool
compare :: Mode -> Mode -> Ordering
$ccompare :: Mode -> Mode -> Ordering
Ord, Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> String
$cshow :: Mode -> String
showsPrec :: Int -> Mode -> ShowS
$cshowsPrec :: Int -> Mode -> ShowS
Show, ReadPrec [Mode]
ReadPrec Mode
Int -> ReadS Mode
ReadS [Mode]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Mode]
$creadListPrec :: ReadPrec [Mode]
readPrec :: ReadPrec Mode
$creadPrec :: ReadPrec Mode
readList :: ReadS [Mode]
$creadList :: ReadS [Mode]
readsPrec :: Int -> ReadS Mode
$creadsPrec :: Int -> ReadS Mode
Read, Int -> Mode
Mode -> Int
Mode -> [Mode]
Mode -> Mode
Mode -> Mode -> [Mode]
Mode -> Mode -> Mode -> [Mode]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Mode -> Mode -> Mode -> [Mode]
$cenumFromThenTo :: Mode -> Mode -> Mode -> [Mode]
enumFromTo :: Mode -> Mode -> [Mode]
$cenumFromTo :: Mode -> Mode -> [Mode]
enumFromThen :: Mode -> Mode -> [Mode]
$cenumFromThen :: Mode -> Mode -> [Mode]
enumFrom :: Mode -> [Mode]
$cenumFrom :: Mode -> [Mode]
fromEnum :: Mode -> Int
$cfromEnum :: Mode -> Int
toEnum :: Int -> Mode
$ctoEnum :: Int -> Mode
pred :: Mode -> Mode
$cpred :: Mode -> Mode
succ :: Mode -> Mode
$csucc :: Mode -> Mode
Enum)

instance A.ToJSON Mode where
  toJSON :: Mode -> Value
toJSON Mode
Always      = Value
"always"
  toJSON Mode
Exported    = Value
"exported"
  toJSON Mode
Diagnostics = Value
"diagnostics"

instance A.FromJSON Mode where
  parseJSON :: Value -> Parser Mode
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
A.withText String
"Mode" forall a b. (a -> b) -> a -> b
$ \case
    Text
"always"      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Mode
Always
    Text
"exported"    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Mode
Exported
    Text
"diagnostics" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Mode
Diagnostics
    Text
_             -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

--------------------------------------------------------------------------------

showDocRdrEnv :: HscEnv -> GlobalRdrEnv -> SDoc -> String
showDocRdrEnv :: HscEnv -> GlobalRdrEnv -> SDoc -> String
showDocRdrEnv HscEnv
env GlobalRdrEnv
rdrEnv = HscEnv -> PrintUnqualified -> SDoc -> String
showSDocForUser' HscEnv
env (HscEnv -> GlobalRdrEnv -> PrintUnqualified
mkPrintUnqualifiedDefault HscEnv
env GlobalRdrEnv
rdrEnv)

data GetGlobalBindingTypeSigs = GetGlobalBindingTypeSigs
  deriving (forall x.
Rep GetGlobalBindingTypeSigs x -> GetGlobalBindingTypeSigs
forall x.
GetGlobalBindingTypeSigs -> Rep GetGlobalBindingTypeSigs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetGlobalBindingTypeSigs x -> GetGlobalBindingTypeSigs
$cfrom :: forall x.
GetGlobalBindingTypeSigs -> Rep GetGlobalBindingTypeSigs x
Generic, Int -> GetGlobalBindingTypeSigs -> ShowS
[GetGlobalBindingTypeSigs] -> ShowS
GetGlobalBindingTypeSigs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetGlobalBindingTypeSigs] -> ShowS
$cshowList :: [GetGlobalBindingTypeSigs] -> ShowS
show :: GetGlobalBindingTypeSigs -> String
$cshow :: GetGlobalBindingTypeSigs -> String
showsPrec :: Int -> GetGlobalBindingTypeSigs -> ShowS
$cshowsPrec :: Int -> GetGlobalBindingTypeSigs -> ShowS
Show, GetGlobalBindingTypeSigs -> GetGlobalBindingTypeSigs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetGlobalBindingTypeSigs -> GetGlobalBindingTypeSigs -> Bool
$c/= :: GetGlobalBindingTypeSigs -> GetGlobalBindingTypeSigs -> Bool
== :: GetGlobalBindingTypeSigs -> GetGlobalBindingTypeSigs -> Bool
$c== :: GetGlobalBindingTypeSigs -> GetGlobalBindingTypeSigs -> Bool
Eq, Eq GetGlobalBindingTypeSigs
GetGlobalBindingTypeSigs -> GetGlobalBindingTypeSigs -> Bool
GetGlobalBindingTypeSigs -> GetGlobalBindingTypeSigs -> Ordering
GetGlobalBindingTypeSigs
-> GetGlobalBindingTypeSigs -> GetGlobalBindingTypeSigs
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GetGlobalBindingTypeSigs
-> GetGlobalBindingTypeSigs -> GetGlobalBindingTypeSigs
$cmin :: GetGlobalBindingTypeSigs
-> GetGlobalBindingTypeSigs -> GetGlobalBindingTypeSigs
max :: GetGlobalBindingTypeSigs
-> GetGlobalBindingTypeSigs -> GetGlobalBindingTypeSigs
$cmax :: GetGlobalBindingTypeSigs
-> GetGlobalBindingTypeSigs -> GetGlobalBindingTypeSigs
>= :: GetGlobalBindingTypeSigs -> GetGlobalBindingTypeSigs -> Bool
$c>= :: GetGlobalBindingTypeSigs -> GetGlobalBindingTypeSigs -> Bool
> :: GetGlobalBindingTypeSigs -> GetGlobalBindingTypeSigs -> Bool
$c> :: GetGlobalBindingTypeSigs -> GetGlobalBindingTypeSigs -> Bool
<= :: GetGlobalBindingTypeSigs -> GetGlobalBindingTypeSigs -> Bool
$c<= :: GetGlobalBindingTypeSigs -> GetGlobalBindingTypeSigs -> Bool
< :: GetGlobalBindingTypeSigs -> GetGlobalBindingTypeSigs -> Bool
$c< :: GetGlobalBindingTypeSigs -> GetGlobalBindingTypeSigs -> Bool
compare :: GetGlobalBindingTypeSigs -> GetGlobalBindingTypeSigs -> Ordering
$ccompare :: GetGlobalBindingTypeSigs -> GetGlobalBindingTypeSigs -> Ordering
Ord, Eq GetGlobalBindingTypeSigs
Int -> GetGlobalBindingTypeSigs -> Int
GetGlobalBindingTypeSigs -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: GetGlobalBindingTypeSigs -> Int
$chash :: GetGlobalBindingTypeSigs -> Int
hashWithSalt :: Int -> GetGlobalBindingTypeSigs -> Int
$chashWithSalt :: Int -> GetGlobalBindingTypeSigs -> Int
Hashable, GetGlobalBindingTypeSigs -> ()
forall a. (a -> ()) -> NFData a
rnf :: GetGlobalBindingTypeSigs -> ()
$crnf :: GetGlobalBindingTypeSigs -> ()
NFData)

data GlobalBindingTypeSig = GlobalBindingTypeSig
  { GlobalBindingTypeSig -> Name
gbName     :: Name
  , GlobalBindingTypeSig -> String
gbRendered :: String
  , GlobalBindingTypeSig -> Bool
gbExported :: Bool
  }

gbSrcSpan :: GlobalBindingTypeSig -> SrcSpan
gbSrcSpan :: GlobalBindingTypeSig -> SrcSpan
gbSrcSpan GlobalBindingTypeSig{Name
gbName :: Name
gbName :: GlobalBindingTypeSig -> Name
gbName} = forall a. NamedThing a => a -> SrcSpan
getSrcSpan Name
gbName

newtype GlobalBindingTypeSigsResult = GlobalBindingTypeSigsResult [GlobalBindingTypeSig]

instance Show GlobalBindingTypeSigsResult where
  show :: GlobalBindingTypeSigsResult -> String
show GlobalBindingTypeSigsResult
_ = String
"<GetTypeResult>"

instance NFData GlobalBindingTypeSigsResult where
  rnf :: GlobalBindingTypeSigsResult -> ()
rnf = forall a. a -> ()
rwhnf

type instance RuleResult GetGlobalBindingTypeSigs = GlobalBindingTypeSigsResult

rules :: Recorder (WithPriority Log) -> Rules ()
rules :: Recorder (WithPriority Log) -> Rules ()
rules Recorder (WithPriority Log)
recorder = do
  forall k v.
IdeRule k v =>
Recorder (WithPriority Log)
-> (k -> NormalizedFilePath -> Action (IdeResult v)) -> Rules ()
define (forall a b.
(a -> b) -> Recorder (WithPriority b) -> Recorder (WithPriority a)
cmapWithPrio Log -> Log
LogShake Recorder (WithPriority Log)
recorder) forall a b. (a -> b) -> a -> b
$ \GetGlobalBindingTypeSigs
GetGlobalBindingTypeSigs NormalizedFilePath
nfp -> do
    Maybe TcModuleResult
tmr <- forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use TypeCheck
TypeCheck NormalizedFilePath
nfp
    -- we need session here for tidying types
    Maybe HscEnvEq
hsc <- forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GhcSession
GhcSession NormalizedFilePath
nfp
    Maybe GlobalBindingTypeSigsResult
result <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Maybe HscEnv
-> Maybe TcGblEnv -> IO (Maybe GlobalBindingTypeSigsResult)
gblBindingType (HscEnvEq -> HscEnv
hscEnv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe HscEnvEq
hsc) (TcModuleResult -> TcGblEnv
tmrTypechecked forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe TcModuleResult
tmr)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], Maybe GlobalBindingTypeSigsResult
result)

gblBindingType :: Maybe HscEnv -> Maybe TcGblEnv -> IO (Maybe GlobalBindingTypeSigsResult)
gblBindingType :: Maybe HscEnv
-> Maybe TcGblEnv -> IO (Maybe GlobalBindingTypeSigsResult)
gblBindingType (Just HscEnv
hsc) (Just TcGblEnv
gblEnv) = do
  let exports :: NameSet
exports = [AvailInfo] -> NameSet
availsToNameSet forall a b. (a -> b) -> a -> b
$ TcGblEnv -> [AvailInfo]
tcg_exports TcGblEnv
gblEnv
      sigs :: NameSet
sigs = TcGblEnv -> NameSet
tcg_sigs TcGblEnv
gblEnv
      binds :: [IdP GhcTc]
binds = forall p idR.
CollectPass p =>
Bag (XRec p (HsBindLR p idR)) -> [IdP p]
collectHsBindsBinders forall a b. (a -> b) -> a -> b
$ TcGblEnv -> LHsBinds GhcTc
tcg_binds TcGblEnv
gblEnv
      patSyns :: [PatSyn]
patSyns = TcGblEnv -> [PatSyn]
tcg_patsyns TcGblEnv
gblEnv
      rdrEnv :: GlobalRdrEnv
rdrEnv = TcGblEnv -> GlobalRdrEnv
tcg_rdr_env TcGblEnv
gblEnv
      showDoc :: SDoc -> String
showDoc = HscEnv -> GlobalRdrEnv -> SDoc -> String
showDocRdrEnv HscEnv
hsc GlobalRdrEnv
rdrEnv
      hasSig :: (Monad m) => Name -> m a -> m (Maybe a)
      hasSig :: forall (m :: * -> *) a. Monad m => Name -> m a -> m (Maybe a)
hasSig Name
name m a
f = forall (m :: * -> *) a. Applicative m => Bool -> m a -> m (Maybe a)
whenMaybe (Name
name Name -> NameSet -> Bool
`elemNameSet` NameSet
sigs) m a
f
      bindToSig :: Id -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GlobalBindingTypeSig)
bindToSig Id
identifier = forall a. a -> a
liftZonkM forall a b. (a -> b) -> a -> b
$ do
        let name :: Name
name = Id -> Name
idName Id
identifier
        forall (m :: * -> *) a. Monad m => Name -> m a -> m (Maybe a)
hasSig Name
name forall a b. (a -> b) -> a -> b
$ do
          TidyEnv
env <- TcM TidyEnv
tcInitTidyEnv
          let (TidyEnv
_, Type
ty) = TidyEnv -> Type -> (TidyEnv, Type)
tidyOpenType TidyEnv
env (Id -> Type
idType Id
identifier)
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Name -> String -> Bool -> GlobalBindingTypeSig
GlobalBindingTypeSig Name
name (Name -> String
printName Name
name forall a. Semigroup a => a -> a -> a
<> String
" :: " forall a. Semigroup a => a -> a -> a
<> SDoc -> String
showDoc (Type -> SDoc
pprSigmaType Type
ty)) (Name
name Name -> NameSet -> Bool
`elemNameSet` NameSet
exports)
      patToSig :: PatSyn -> IO (Maybe GlobalBindingTypeSig)
patToSig PatSyn
p = do
        let name :: Name
name = PatSyn -> Name
patSynName PatSyn
p
        forall (m :: * -> *) a. Monad m => Name -> m a -> m (Maybe a)
hasSig Name
name forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Name -> String -> Bool -> GlobalBindingTypeSig
GlobalBindingTypeSig Name
name (String
"pattern " forall a. Semigroup a => a -> a -> a
<> Name -> String
printName Name
name forall a. Semigroup a => a -> a -> a
<> String
" :: " forall a. Semigroup a => a -> a -> a
<> SDoc -> String
showDoc (PatSyn -> SDoc
pprPatSynTypeWithoutForalls PatSyn
p)) (Name
name Name -> NameSet -> Bool
`elemNameSet` NameSet
exports)
  (Messages DecoratedSDoc
_, forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a. [Maybe a] -> [a]
catMaybes -> [GlobalBindingTypeSig]
bindings) <- forall r.
HscEnv
-> TcGblEnv
-> RealSrcSpan
-> TcM r
-> IO (Messages DecoratedSDoc, Maybe r)
initTcWithGbl HscEnv
hsc TcGblEnv
gblEnv (RealSrcLoc -> RealSrcSpan
realSrcLocSpan forall a b. (a -> b) -> a -> b
$ FastString -> Int -> Int -> RealSrcLoc
mkRealSrcLoc FastString
"<dummy>" Int
1 Int
1) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Id -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe GlobalBindingTypeSig)
bindToSig [IdP GhcTc]
binds
  [GlobalBindingTypeSig]
patterns <- forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM PatSyn -> IO (Maybe GlobalBindingTypeSig)
patToSig [PatSyn]
patSyns
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GlobalBindingTypeSig] -> GlobalBindingTypeSigsResult
GlobalBindingTypeSigsResult forall a b. (a -> b) -> a -> b
$ [GlobalBindingTypeSig]
bindings forall a. Semigroup a => a -> a -> a
<> [GlobalBindingTypeSig]
patterns
gblBindingType Maybe HscEnv
_ Maybe TcGblEnv
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing

pprPatSynTypeWithoutForalls :: PatSyn -> SDoc
pprPatSynTypeWithoutForalls :: PatSyn -> SDoc
pprPatSynTypeWithoutForalls PatSyn
p = PatSyn -> SDoc
pprPatSynType PatSyn
pWithoutTypeVariables
  where
    pWithoutTypeVariables :: PatSyn
pWithoutTypeVariables = Name
-> Bool
-> ([InvisTVBinder], ThetaType)
-> ([InvisTVBinder], ThetaType)
-> ThetaType
-> Type
-> PatSynMatcher
-> PatSynBuilder
-> [FieldLabel]
-> PatSyn
mkPatSyn Name
name Bool
declared_infix ([], ThetaType
req_theta) ([], ThetaType
prov_theta) ThetaType
orig_args' Type
orig_res_ty PatSynMatcher
matcher PatSynBuilder
builder [FieldLabel]
field_labels
    ([Id]
_univ_tvs, ThetaType
req_theta, [Id]
_ex_tvs, ThetaType
prov_theta, [Scaled Type]
orig_args, Type
orig_res_ty) = PatSyn -> ([Id], ThetaType, [Id], ThetaType, [Scaled Type], Type)
patSynSig PatSyn
p
    name :: Name
name = PatSyn -> Name
patSynName PatSyn
p
    declared_infix :: Bool
declared_infix = PatSyn -> Bool
patSynIsInfix PatSyn
p
    matcher :: PatSynMatcher
matcher = PatSyn -> PatSynMatcher
patSynMatcher PatSyn
p
    builder :: PatSynBuilder
builder = PatSyn -> PatSynBuilder
patSynBuilder PatSyn
p
    field_labels :: [FieldLabel]
field_labels = PatSyn -> [FieldLabel]
patSynFieldLabels PatSyn
p
    orig_args' :: ThetaType
orig_args' = forall a b. (a -> b) -> [a] -> [b]
map forall a. Scaled a -> a
scaledThing [Scaled Type]
orig_args