{-# 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.Monad                       (mzero)
import           Control.Monad.Extra                 (whenMaybe)
import           Control.Monad.IO.Class              (MonadIO (liftIO))
import           Data.Aeson.Types                    (Value (..), toJSON)
import qualified Data.Aeson.Types                    as A
import qualified Data.HashMap.Strict                 as Map
import           Data.List                           (find)
import           Data.Maybe                          (catMaybes)
import qualified Data.Text                           as T
import           Development.IDE                     (GhcSession (..),
                                                      HscEnvEq (hscEnv),
                                                      RuleResult, Rules, define,
                                                      srcSpanToRange,
                                                      usePropertyAction)
import           Development.IDE.Core.Compile        (TcModuleResult (..))
import           Development.IDE.Core.Rules          (IdeState, runAction)
import           Development.IDE.Core.RuleTypes      (GetBindings (GetBindings),
                                                      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.Spans.LocalBindings (Bindings, getFuzzyScope)
import           Development.IDE.Types.Location      (Position (Position, _character, _line),
                                                      Range (Range, _end, _start),
                                                      toNormalizedFilePath',
                                                      uriToFilePath')
import           Development.IDE.Types.Logger        (Pretty (pretty), Recorder,
                                                      WithPriority,
                                                      cmapWithPrio)
import           GHC.Generics                        (Generic)
import           Ide.Plugin.Config                   (Config)
import           Ide.Plugin.Properties
import           Ide.PluginUtils                     (mkLspCommand)
import           Ide.Types                           (CommandFunction,
                                                      CommandId (CommandId),
                                                      PluginCommand (PluginCommand),
                                                      PluginDescriptor (..),
                                                      PluginId,
                                                      configCustomConfig,
                                                      defaultConfigDescriptor,
                                                      defaultPluginDescriptor,
                                                      mkCustomConfig,
                                                      mkPluginHandler)
import qualified Language.LSP.Server                 as LSP
import           Language.LSP.Types                  (ApplyWorkspaceEditParams (ApplyWorkspaceEditParams),
                                                      CodeLens (CodeLens),
                                                      CodeLensParams (CodeLensParams, _textDocument),
                                                      Diagnostic (..),
                                                      List (..), ResponseError,
                                                      SMethod (..),
                                                      TextDocumentIdentifier (TextDocumentIdentifier),
                                                      TextEdit (TextEdit),
                                                      WorkspaceEdit (WorkspaceEdit))
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
log -> forall a ann. Pretty a => a -> Doc ann
pretty Log
log

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)
    { pluginHandlers :: PluginHandlers IdeState
pluginHandlers = forall (m :: Method 'FromClient 'Request) ideState.
PluginRequestMethod m =>
SClientMethod m
-> PluginMethodHandler ideState m -> PluginHandlers ideState
mkPluginHandler SMethod 'TextDocumentCodeLens
STextDocumentCodeLens IdeState
-> PluginId
-> CodeLensParams
-> LspM Config (Either ResponseError (List CodeLens))
codeLensProvider
    , pluginCommands :: [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]
    , pluginRules :: Rules ()
pluginRules = Recorder (WithPriority Log) -> Rules ()
rules Recorder (WithPriority Log)
recorder
    , pluginConfigDescriptor :: ConfigDescriptor
pluginConfigDescriptor = ConfigDescriptor
defaultConfigDescriptor {configCustomConfig :: 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 ::
  IdeState ->
  PluginId ->
  CodeLensParams ->
  LSP.LspM Config (Either ResponseError (List CodeLens))
codeLensProvider :: IdeState
-> PluginId
-> CodeLensParams
-> LspM Config (Either ResponseError (List CodeLens))
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
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> List a
List) forall a b. (a -> b) -> a -> b
$ case Uri -> Maybe String
uriToFilePath' Uri
uri of
    Just (String -> NormalizedFilePath
toNormalizedFilePath' -> NormalizedFilePath
filePath) -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
      Maybe HscEnv
env <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HscEnvEq -> HscEnv
hscEnv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. String -> IdeState -> Action a -> IO a
runAction String
"codeLens.GhcSession" IdeState
ideState (forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GhcSession
GhcSession NormalizedFilePath
filePath)
      Maybe TcModuleResult
tmr <- forall a. String -> IdeState -> Action a -> IO a
runAction String
"codeLens.TypeCheck" IdeState
ideState (forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use TypeCheck
TypeCheck NormalizedFilePath
filePath)
      Maybe Bindings
bindings <- forall a. String -> IdeState -> Action a -> IO a
runAction String
"codeLens.GetBindings" IdeState
ideState (forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetBindings
GetBindings NormalizedFilePath
filePath)
      Maybe GlobalBindingTypeSigsResult
gblSigs <- forall a. String -> IdeState -> Action a -> IO a
runAction String
"codeLens.GetGlobalBindingTypeSigs" IdeState
ideState (forall k v.
IdeRule k v =>
k -> NormalizedFilePath -> Action (Maybe v)
use GetGlobalBindingTypeSigs
GetGlobalBindingTypeSigs NormalizedFilePath
filePath)

      [FileDiagnostic]
diag <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ IdeState -> STM [FileDiagnostic]
getDiagnostics IdeState
ideState
      [FileDiagnostic]
hDiag <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ IdeState -> STM [FileDiagnostic]
getHiddenDiagnostics IdeState
ideState

      let toWorkSpaceEdit :: [TextEdit] -> WorkspaceEdit
toWorkSpaceEdit [TextEdit]
tedit = Maybe WorkspaceEditMap
-> Maybe (List DocumentChange)
-> Maybe ChangeAnnotationMap
-> WorkspaceEdit
WorkspaceEdit (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall k v. Hashable k => k -> v -> HashMap k v
Map.singleton Uri
uri forall a b. (a -> b) -> a -> b
$ forall a. [a] -> List a
List [TextEdit]
tedit) forall a. Maybe a
Nothing forall a. Maybe a
Nothing
          generateLensForGlobal :: GlobalBindingTypeSig -> Maybe CodeLens
generateLensForGlobal sig :: GlobalBindingTypeSig
sig@GlobalBindingTypeSig{Bool
String
Name
gbExported :: GlobalBindingTypeSig -> Bool
gbRendered :: GlobalBindingTypeSig -> String
gbName :: GlobalBindingTypeSig -> Name
gbExported :: Bool
gbRendered :: String
gbName :: Name
..} = do
            Range
range <- SrcSpan -> Maybe Range
srcSpanToRange forall a b. (a -> b) -> a -> b
$ GlobalBindingTypeSig -> SrcSpan
gbSrcSpan GlobalBindingTypeSig
sig
            TextEdit
tedit <- GlobalBindingTypeSig -> Maybe TextEdit
gblBindingTypeSigToEdit GlobalBindingTypeSig
sig
            let wedit :: WorkspaceEdit
wedit = [TextEdit] -> WorkspaceEdit
toWorkSpaceEdit [TextEdit
tedit]
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PluginId -> Range -> Text -> WorkspaceEdit -> CodeLens
generateLens PluginId
pId Range
range (String -> Text
T.pack String
gbRendered) WorkspaceEdit
wedit
          gblSigs' :: [GlobalBindingTypeSig]
gblSigs' = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\(GlobalBindingTypeSigsResult [GlobalBindingTypeSig]
x) -> [GlobalBindingTypeSig]
x) Maybe GlobalBindingTypeSigsResult
gblSigs
          generateLensFromDiags :: (Diagnostic -> [(Text, [TextEdit])]) -> IO [CodeLens]
generateLensFromDiags Diagnostic -> [(Text, [TextEdit])]
f =
            forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
              [ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ PluginId -> Range -> Text -> WorkspaceEdit -> CodeLens
generateLens PluginId
pId Range
_range Text
title WorkspaceEdit
edit
              | (NormalizedFilePath
dFile, ShowDiagnostic
_, dDiag :: Diagnostic
dDiag@Diagnostic{$sel:_range:Diagnostic :: Diagnostic -> Range
_range = Range
_range}) <- [FileDiagnostic]
diag forall a. [a] -> [a] -> [a]
++ [FileDiagnostic]
hDiag
              , NormalizedFilePath
dFile forall a. Eq a => a -> a -> Bool
== NormalizedFilePath
filePath
              , (Text
title, [TextEdit]
tedit) <- Diagnostic -> [(Text, [TextEdit])]
f Diagnostic
dDiag
              , let edit :: WorkspaceEdit
edit = [TextEdit] -> WorkspaceEdit
toWorkSpaceEdit [TextEdit]
tedit
              ]

      case Mode
mode of
        Mode
Always ->
          forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ GlobalBindingTypeSig -> Maybe CodeLens
generateLensForGlobal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [GlobalBindingTypeSig]
gblSigs')
            forall a. Semigroup a => a -> a -> a
<> (Diagnostic -> [(Text, [TextEdit])]) -> IO [CodeLens]
generateLensFromDiags (Bool
-> Maybe HscEnv
-> Maybe TcModuleResult
-> Maybe Bindings
-> Diagnostic
-> [(Text, [TextEdit])]
suggestLocalSignature Bool
False Maybe HscEnv
env Maybe TcModuleResult
tmr Maybe Bindings
bindings) -- we still need diagnostics for local bindings
        Mode
Exported -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ GlobalBindingTypeSig -> Maybe CodeLens
generateLensForGlobal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> [a] -> [a]
filter GlobalBindingTypeSig -> Bool
gbExported [GlobalBindingTypeSig]
gblSigs'
        Mode
Diagnostics -> (Diagnostic -> [(Text, [TextEdit])]) -> IO [CodeLens]
generateLensFromDiags forall a b. (a -> b) -> a -> b
$ Bool
-> Maybe HscEnv
-> Maybe GlobalBindingTypeSigsResult
-> Maybe TcModuleResult
-> Maybe Bindings
-> Diagnostic
-> [(Text, [TextEdit])]
suggestSignature Bool
False Maybe HscEnv
env Maybe GlobalBindingTypeSigsResult
gblSigs Maybe TcModuleResult
tmr Maybe Bindings
bindings
    Maybe String
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []

generateLens :: PluginId -> Range -> T.Text -> WorkspaceEdit -> CodeLens
generateLens :: PluginId -> Range -> Text -> WorkspaceEdit -> CodeLens
generateLens PluginId
pId Range
_range Text
title WorkspaceEdit
edit =
  let cId :: Command
cId = 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
edit])
   in Range -> Maybe Command -> Maybe Value -> CodeLens
CodeLens Range
_range (forall a. a -> Maybe a
Just Command
cId) forall a. Maybe a
Nothing

commandHandler :: CommandFunction IdeState WorkspaceEdit
commandHandler :: CommandFunction IdeState WorkspaceEdit
commandHandler IdeState
_ideState WorkspaceEdit
wedit = do
  LspId 'WorkspaceApplyEdit
_ <- forall (m :: Method 'FromServer 'Request) (f :: * -> *) config.
MonadLsp config f =>
SServerMethod m
-> MessageParams m
-> (Either ResponseError (ResponseResult m) -> f ())
-> f (LspId m)
LSP.sendRequest SMethod 'WorkspaceApplyEdit
SWorkspaceApplyEdit (Maybe Text -> WorkspaceEdit -> ApplyWorkspaceEditParams
ApplyWorkspaceEditParams forall a. Maybe a
Nothing WorkspaceEdit
wedit) (\Either ResponseError (ResponseResult 'WorkspaceApplyEdit)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Value
Null

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

suggestSignature :: Bool -> Maybe HscEnv -> Maybe GlobalBindingTypeSigsResult -> Maybe TcModuleResult -> Maybe Bindings -> Diagnostic -> [(T.Text, [TextEdit])]
suggestSignature :: Bool
-> Maybe HscEnv
-> Maybe GlobalBindingTypeSigsResult
-> Maybe TcModuleResult
-> Maybe Bindings
-> Diagnostic
-> [(Text, [TextEdit])]
suggestSignature Bool
isQuickFix Maybe HscEnv
env Maybe GlobalBindingTypeSigsResult
mGblSigs Maybe TcModuleResult
mTmr Maybe Bindings
mBindings Diagnostic
diag =
  Bool
-> Maybe GlobalBindingTypeSigsResult
-> Diagnostic
-> [(Text, [TextEdit])]
suggestGlobalSignature Bool
isQuickFix Maybe GlobalBindingTypeSigsResult
mGblSigs Diagnostic
diag forall a. Semigroup a => a -> a -> a
<> Bool
-> Maybe HscEnv
-> Maybe TcModuleResult
-> Maybe Bindings
-> Diagnostic
-> [(Text, [TextEdit])]
suggestLocalSignature Bool
isQuickFix Maybe HscEnv
env Maybe TcModuleResult
mTmr Maybe Bindings
mBindings Diagnostic
diag

suggestGlobalSignature :: Bool -> Maybe GlobalBindingTypeSigsResult -> Diagnostic -> [(T.Text, [TextEdit])]
suggestGlobalSignature :: Bool
-> Maybe GlobalBindingTypeSigsResult
-> Diagnostic
-> [(Text, [TextEdit])]
suggestGlobalSignature Bool
isQuickFix Maybe GlobalBindingTypeSigsResult
mGblSigs Diagnostic{Text
$sel:_message:Diagnostic :: Diagnostic -> Text
_message :: Text
_message, Range
_range :: Range
$sel:_range:Diagnostic :: Diagnostic -> Range
_range}
  | 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)
    , 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 TextEdit
gblBindingTypeSigToEdit GlobalBindingTypeSig
sig =
    [(Text
title, [TextEdit
action])]
  | Bool
otherwise = []

suggestLocalSignature :: Bool -> Maybe HscEnv -> Maybe TcModuleResult -> Maybe Bindings -> Diagnostic -> [(T.Text, [TextEdit])]
suggestLocalSignature :: Bool
-> Maybe HscEnv
-> Maybe TcModuleResult
-> Maybe Bindings
-> Diagnostic
-> [(Text, [TextEdit])]
suggestLocalSignature Bool
isQuickFix Maybe HscEnv
mEnv Maybe TcModuleResult
mTmr Maybe Bindings
mBindings Diagnostic{Text
_message :: Text
$sel:_message:Diagnostic :: Diagnostic -> Text
_message, $sel:_range:Diagnostic :: Diagnostic -> Range
_range = _range :: Range
_range@Range{Position
_end :: Position
_start :: Position
_start :: Range -> Position
_end :: Range -> Position
..}}
  | Just (Text
_ :: T.Text, Text
_ :: T.Text, Text
_ :: T.Text, [Text
identifier]) <-
      ([Text] -> Text
T.unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words forall a b. (a -> b) -> a -> b
$ Text
_message)
        forall source source1 target (m :: * -> *).
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target, MonadFail m) =>
source1 -> source -> m target
=~~ (Text
"Polymorphic local binding with no type signature: (.*) ::" :: T.Text)
    , Just Bindings
bindings <- Maybe Bindings
mBindings
    , Just HscEnv
env <- Maybe HscEnv
mEnv
    , [(Name, Maybe Type)]
localScope <- Bindings -> Position -> Position -> [(Name, Maybe Type)]
getFuzzyScope Bindings
bindings Position
_start Position
_end
    , -- we can't use srcspan to lookup scoped bindings, because the error message reported by GHC includes the entire binding, instead of simply the name
      Just (Name
name, Type
ty) <- forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Name
x, Maybe Type
_) -> Name -> String
printName Name
x forall a. Eq a => a -> a -> Bool
== Text -> String
T.unpack Text
identifier) [(Name, Maybe Type)]
localScope forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Name
name, Maybe Type
mTy) -> (Name
name,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Type
mTy
    , Just TcModuleResult{tmrTypechecked :: TcModuleResult -> TcGblEnv
tmrTypechecked = TcGblEnv{GlobalRdrEnv
tcg_rdr_env :: TcGblEnv -> GlobalRdrEnv
tcg_rdr_env :: GlobalRdrEnv
tcg_rdr_env, NameSet
tcg_sigs :: TcGblEnv -> NameSet
tcg_sigs :: NameSet
tcg_sigs}} <- Maybe TcModuleResult
mTmr
    , -- not a top-level thing, to avoid duplication
      Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Name
name Name -> NameSet -> Bool
`elemNameSet` NameSet
tcg_sigs
    , String
tyMsg <- PrintUnqualified -> SDoc -> String
printSDocQualifiedUnsafe (HscEnv -> GlobalRdrEnv -> PrintUnqualified
mkPrintUnqualifiedDefault HscEnv
env GlobalRdrEnv
tcg_rdr_env) forall a b. (a -> b) -> a -> b
$ Type -> SDoc
pprSigmaType Type
ty
    , Text
signature <- String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Name -> String
printName Name
name forall a. Semigroup a => a -> a -> a
<> String
" :: " forall a. Semigroup a => a -> a -> a
<> String
tyMsg
    , UInt
startCharacter <- Position -> UInt
_character Position
_start
    , Position
startOfLine <- UInt -> UInt -> Position
Position (Position -> UInt
_line Position
_start) UInt
startCharacter
    , Range
beforeLine <- Position -> Position -> Range
Range Position
startOfLine Position
startOfLine
    , Text
title <- if Bool
isQuickFix then Text
"add signature: " forall a. Semigroup a => a -> a -> a
<> Text
signature else Text
signature
    , TextEdit
action <- Range -> Text -> TextEdit
TextEdit Range
beforeLine forall a b. (a -> b) -> a -> b
$ Text
signature forall a. Semigroup a => a -> a -> a
<> Text
"\n" forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate (forall a b. (Integral a, Num b) => a -> b
fromIntegral UInt
startCharacter) Text
" " =
    [(Text
title, [TextEdit
action])]
  | Bool
otherwise = []

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 TextEdit
gblBindingTypeSigToEdit :: GlobalBindingTypeSig -> Maybe TextEdit
gblBindingTypeSigToEdit GlobalBindingTypeSig{Bool
String
Name
gbExported :: Bool
gbRendered :: String
gbName :: Name
gbExported :: GlobalBindingTypeSig -> Bool
gbRendered :: GlobalBindingTypeSig -> String
gbName :: GlobalBindingTypeSig -> Name
..}
  | Just Range{Position
_end :: Position
_start :: Position
_start :: Range -> Position
_end :: 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 =
    forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Range -> Text -> TextEdit
TextEdit Range
beforeLine forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
gbRendered forall a. Semigroup a => a -> a -> a
<> Text
"\n"
  | Bool
otherwise = forall a. Maybe a
Nothing

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
id = do
        let name :: Name
name = Id -> Name
idName Id
id
        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
id)
          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