{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
module StackTrace.Plugin (plugin) where

import Control.Arrow (first)
import Data.Monoid (Any(Any, getAny))
#if __GLASGOW_HASKELL__ >= 900
import GHC.Plugins
#else

import GhcPlugins
#endif
#if __GLASGOW_HASKELL__ >= 810
import GHC.Hs
#endif
#if __GLASGOW_HASKELL__ < 810
import HsSyn
#endif

type Traversal s t a b
   = forall f. Applicative f =>
                 (a -> f b) -> s -> f t

type Traversal' s a = Traversal s s a a

plugin :: Plugin
plugin :: Plugin
plugin = Plugin
defaultPlugin {parsedResultAction :: [CommandLineOption]
-> ModSummary -> HsParsedModule -> Hsc HsParsedModule
parsedResultAction = [CommandLineOption]
-> ModSummary -> HsParsedModule -> Hsc HsParsedModule
parsedPlugin, pluginRecompile :: [CommandLineOption] -> IO PluginRecompile
pluginRecompile = [CommandLineOption] -> IO PluginRecompile
purePlugin}

parsedPlugin ::
     [CommandLineOption] -> ModSummary -> HsParsedModule -> Hsc HsParsedModule
parsedPlugin :: [CommandLineOption]
-> ModSummary -> HsParsedModule -> Hsc HsParsedModule
parsedPlugin [CommandLineOption]
_ ModSummary
_ HsParsedModule
pm = do
  let m :: GenLocated SrcSpan (HsModule GhcPs)
m = HsModule GhcPs -> HsModule GhcPs
updateHsModule (HsModule GhcPs -> HsModule GhcPs)
-> GenLocated SrcSpan (HsModule GhcPs)
-> GenLocated SrcSpan (HsModule GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HsParsedModule -> GenLocated SrcSpan (HsModule GhcPs)
hpm_module HsParsedModule
pm
      pm' :: HsParsedModule
pm' = HsParsedModule
pm {hpm_module :: GenLocated SrcSpan (HsModule GhcPs)
hpm_module = GenLocated SrcSpan (HsModule GhcPs)
m}
  HsParsedModule -> Hsc HsParsedModule
forall (m :: * -> *) a. Monad m => a -> m a
return HsParsedModule
pm'

-- Use qualified import for GHC.Stack as "AutoImported.GHC.Stack"
-- ...this should not interfere with other imports...
ghcStackModuleName :: ModuleName
ghcStackModuleName :: ModuleName
ghcStackModuleName = CommandLineOption -> ModuleName
mkModuleName CommandLineOption
"AutoImported.GHC.Stack"

#if __GLASGOW_HASKELL__ < 810
importDeclQualified :: Bool
importDeclQualified = True
#else
importDeclQualified :: ImportDeclQualifiedStyle
importDeclQualified :: ImportDeclQualifiedStyle
importDeclQualified = ImportDeclQualifiedStyle
QualifiedPre
#endif

ghcStackImport :: Located (ImportDecl (GhcPass p))
ghcStackImport :: Located (ImportDecl (GhcPass p))
ghcStackImport =
  SrcSpanLess (Located (ImportDecl (GhcPass p)))
-> Located (ImportDecl (GhcPass p))
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (Located (ImportDecl (GhcPass p)))
 -> Located (ImportDecl (GhcPass p)))
-> SrcSpanLess (Located (ImportDecl (GhcPass p)))
-> Located (ImportDecl (GhcPass p))
forall a b. (a -> b) -> a -> b
$
  (ModuleName -> ImportDecl (GhcPass p)
forall (p :: Pass). ModuleName -> ImportDecl (GhcPass p)
simpleImportDecl (ModuleName -> ImportDecl (GhcPass p))
-> ModuleName -> ImportDecl (GhcPass p)
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> ModuleName
mkModuleName CommandLineOption
"GHC.Stack")
    {ideclQualified :: ImportDeclQualifiedStyle
ideclQualified = ImportDeclQualifiedStyle
importDeclQualified, ideclAs :: Maybe (Located ModuleName)
ideclAs = Located ModuleName -> Maybe (Located ModuleName)
forall a. a -> Maybe a
Just (Located ModuleName -> Maybe (Located ModuleName))
-> Located ModuleName -> Maybe (Located ModuleName)
forall a b. (a -> b) -> a -> b
$ SrcSpanLess (Located ModuleName) -> Located ModuleName
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (Located ModuleName)
ModuleName
ghcStackModuleName}

#if __GLASGOW_HASKELL__ >= 900
updateHsModule :: HsModule -> HsModule
#else
updateHsModule :: HsModule GhcPs -> HsModule GhcPs
#endif
updateHsModule :: HsModule GhcPs -> HsModule GhcPs
updateHsModule HsModule GhcPs
hsm =
  HsModule GhcPs
hsm {hsmodImports :: [LImportDecl GhcPs]
hsmodImports = [LImportDecl GhcPs]
hsmodImports', hsmodDecls :: [LHsDecl GhcPs]
hsmodDecls = [LHsDecl GhcPs]
hsmodDecls'}
  where
    -- Traverse the haskell AST; if we have to add some HasStack
    -- constraint we set a flag in a (Any,) functor.
    -- ...it'd be simpler to check if before == after, but Haskell AST
    -- doesn't have Eq instances.
    (Bool
updatedP, [LHsDecl GhcPs]
hsmodDecls') =
      (Any -> Bool) -> (Any, [LHsDecl GhcPs]) -> (Bool, [LHsDecl GhcPs])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Any -> Bool
getAny ((Any, [LHsDecl GhcPs]) -> (Bool, [LHsDecl GhcPs]))
-> (Any, [LHsDecl GhcPs]) -> (Bool, [LHsDecl GhcPs])
forall a b. (a -> b) -> a -> b
$
      ((LHsDecl GhcPs -> (Any, LHsDecl GhcPs))
-> [LHsDecl GhcPs] -> (Any, [LHsDecl GhcPs])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((LHsDecl GhcPs -> (Any, LHsDecl GhcPs))
 -> [LHsDecl GhcPs] -> (Any, [LHsDecl GhcPs]))
-> ((HsType GhcPs -> (Any, HsType GhcPs))
    -> LHsDecl GhcPs -> (Any, LHsDecl GhcPs))
-> (HsType GhcPs -> (Any, HsType GhcPs))
-> [LHsDecl GhcPs]
-> (Any, [LHsDecl GhcPs])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsType GhcPs -> (Any, HsType GhcPs))
-> LHsDecl GhcPs -> (Any, LHsDecl GhcPs)
Traversal' (LHsDecl GhcPs) (HsType GhcPs)
astTraversal) HsType GhcPs -> (Any, HsType GhcPs)
updateHsType (HsModule GhcPs -> [LHsDecl GhcPs]
forall pass. HsModule pass -> [LHsDecl pass]
hsmodDecls HsModule GhcPs
hsm)

    -- Only import GHC.Stack if needed for a constraint we introduced
    hsmodImports' :: [LImportDecl GhcPs]
hsmodImports' =
      (if Bool
updatedP
         then [LImportDecl GhcPs
forall (p :: Pass). Located (ImportDecl (GhcPass p))
ghcStackImport]
         else []) [LImportDecl GhcPs] -> [LImportDecl GhcPs] -> [LImportDecl GhcPs]
forall a. [a] -> [a] -> [a]
++
      HsModule GhcPs -> [LImportDecl GhcPs]
forall pass. HsModule pass -> [LImportDecl pass]
hsmodImports HsModule GhcPs
hsm

    astTraversal :: Traversal' (LHsDecl GhcPs) (HsType GhcPs)
    astTraversal :: (HsType GhcPs -> f (HsType GhcPs))
-> LHsDecl GhcPs -> f (LHsDecl GhcPs)
astTraversal = (HsDecl GhcPs -> f (HsDecl GhcPs))
-> LHsDecl GhcPs -> f (LHsDecl GhcPs)
Traversal' (LHsDecl GhcPs) (HsDecl GhcPs)
updateHsmodDecl
                 ((HsDecl GhcPs -> f (HsDecl GhcPs))
 -> LHsDecl GhcPs -> f (LHsDecl GhcPs))
-> ((HsType GhcPs -> f (HsType GhcPs))
    -> HsDecl GhcPs -> f (HsDecl GhcPs))
-> (HsType GhcPs -> f (HsType GhcPs))
-> LHsDecl GhcPs
-> f (LHsDecl GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> HsDecl GhcPs -> f (HsDecl GhcPs)
Traversal' (HsDecl GhcPs) (LHsSigWcType GhcPs)
updateHsDecl
                 ((LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
 -> HsDecl GhcPs -> f (HsDecl GhcPs))
-> ((HsType GhcPs -> f (HsType GhcPs))
    -> LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> (HsType GhcPs -> f (HsType GhcPs))
-> HsDecl GhcPs
-> f (HsDecl GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LHsSigType GhcPs -> f (LHsSigType GhcPs))
-> LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
Traversal' (LHsSigWcType GhcPs) (LHsSigType GhcPs)
updateLHsSigWsType
                 ((LHsSigType GhcPs -> f (LHsSigType GhcPs))
 -> LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> ((HsType GhcPs -> f (HsType GhcPs))
    -> LHsSigType GhcPs -> f (LHsSigType GhcPs))
-> (HsType GhcPs -> f (HsType GhcPs))
-> LHsSigWcType GhcPs
-> f (LHsSigWcType GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LHsType GhcPs -> f (LHsType GhcPs))
-> LHsSigType GhcPs -> f (LHsSigType GhcPs)
Traversal' (LHsSigType GhcPs) (LHsType GhcPs)
updateLHsSigType
                 ((LHsType GhcPs -> f (LHsType GhcPs))
 -> LHsSigType GhcPs -> f (LHsSigType GhcPs))
-> ((HsType GhcPs -> f (HsType GhcPs))
    -> LHsType GhcPs -> f (LHsType GhcPs))
-> (HsType GhcPs -> f (HsType GhcPs))
-> LHsSigType GhcPs
-> f (LHsSigType GhcPs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HsType GhcPs -> f (HsType GhcPs))
-> LHsType GhcPs -> f (LHsType GhcPs)
Traversal' (LHsType GhcPs) (HsType GhcPs)
updateLHsType

--------------
updateHsmodDecl :: Traversal' (LHsDecl GhcPs) (HsDecl GhcPs)
updateHsmodDecl :: (HsDecl GhcPs -> f (HsDecl GhcPs))
-> LHsDecl GhcPs -> f (LHsDecl GhcPs)
updateHsmodDecl = (HsDecl GhcPs -> f (HsDecl GhcPs))
-> LHsDecl GhcPs -> f (LHsDecl GhcPs)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse

updateHsDecl :: Traversal' (HsDecl GhcPs) (LHsSigWcType GhcPs)
updateHsDecl :: (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> HsDecl GhcPs -> f (HsDecl GhcPs)
updateHsDecl LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
f (SigD XSigD GhcPs
xSig Sig GhcPs
s) = XSigD GhcPs -> Sig GhcPs -> HsDecl GhcPs
forall p. XSigD p -> Sig p -> HsDecl p
SigD XSigD GhcPs
xSig (Sig GhcPs -> HsDecl GhcPs) -> f (Sig GhcPs) -> f (HsDecl GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> Sig GhcPs -> f (Sig GhcPs)
Traversal' (Sig GhcPs) (LHsSigWcType GhcPs)
updateSig LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
f Sig GhcPs
s
updateHsDecl LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
f (ValD XValD GhcPs
xVal HsBind GhcPs
hsBind) = XValD GhcPs -> HsBind GhcPs -> HsDecl GhcPs
forall p. XValD p -> HsBind p -> HsDecl p
ValD XValD GhcPs
xVal (HsBind GhcPs -> HsDecl GhcPs)
-> f (HsBind GhcPs) -> f (HsDecl GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> HsBind GhcPs -> f (HsBind GhcPs)
Traversal' (HsBind GhcPs) (LHsSigWcType GhcPs)
updateHsBind LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
f HsBind GhcPs
hsBind
updateHsDecl LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
_ HsDecl GhcPs
sig = HsDecl GhcPs -> f (HsDecl GhcPs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsDecl GhcPs
sig

updateHsBind :: Traversal' (HsBind GhcPs) (LHsSigWcType GhcPs)
updateHsBind :: (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> HsBind GhcPs -> f (HsBind GhcPs)
updateHsBind LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
f bind :: HsBind GhcPs
bind@FunBind {} = (\MatchGroup GhcPs (LHsExpr GhcPs)
x -> HsBind GhcPs
bind {fun_matches :: MatchGroup GhcPs (LHsExpr GhcPs)
fun_matches = MatchGroup GhcPs (LHsExpr GhcPs)
x}) (MatchGroup GhcPs (LHsExpr GhcPs) -> HsBind GhcPs)
-> f (MatchGroup GhcPs (LHsExpr GhcPs)) -> f (HsBind GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> f (MatchGroup GhcPs (LHsExpr GhcPs))
Traversal' (MatchGroup GhcPs (LHsExpr GhcPs)) (LHsSigWcType GhcPs)
updateMatchGroup LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
f (HsBind GhcPs -> MatchGroup GhcPs (LHsExpr GhcPs)
forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches HsBind GhcPs
bind)
updateHsBind LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
_ HsBind GhcPs
bind = HsBind GhcPs -> f (HsBind GhcPs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsBind GhcPs
bind

updateMatchGroup :: Traversal' (MatchGroup GhcPs (LHsExpr GhcPs)) (LHsSigWcType GhcPs)
updateMatchGroup :: (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> f (MatchGroup GhcPs (LHsExpr GhcPs))
updateMatchGroup LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
f mg :: MatchGroup GhcPs (LHsExpr GhcPs)
mg@MG {} = (\Located [LMatch GhcPs (LHsExpr GhcPs)]
x -> MatchGroup GhcPs (LHsExpr GhcPs)
mg {mg_alts :: Located [LMatch GhcPs (LHsExpr GhcPs)]
mg_alts = Located [LMatch GhcPs (LHsExpr GhcPs)]
x}) (Located [LMatch GhcPs (LHsExpr GhcPs)]
 -> MatchGroup GhcPs (LHsExpr GhcPs))
-> f (Located [LMatch GhcPs (LHsExpr GhcPs)])
-> f (MatchGroup GhcPs (LHsExpr GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> Located [LMatch GhcPs (LHsExpr GhcPs)]
-> f (Located [LMatch GhcPs (LHsExpr GhcPs)])
Traversal'
  (Located [LMatch GhcPs (LHsExpr GhcPs)]) (LHsSigWcType GhcPs)
updateLLMatch LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
f (MatchGroup GhcPs (LHsExpr GhcPs)
-> Located [LMatch GhcPs (LHsExpr GhcPs)]
forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts MatchGroup GhcPs (LHsExpr GhcPs)
mg)
#if __GLASGOW_HASKELL__ < 900
updateMatchGroup LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
_ MatchGroup GhcPs (LHsExpr GhcPs)
mg = MatchGroup GhcPs (LHsExpr GhcPs)
-> f (MatchGroup GhcPs (LHsExpr GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure MatchGroup GhcPs (LHsExpr GhcPs)
mg
#endif

updateLocated :: Functor f => (a -> b -> f c) -> a -> Located b -> f (Located c)
updateLocated :: (a -> b -> f c) -> a -> Located b -> f (Located c)
updateLocated a -> b -> f c
f a
g (L SrcSpan
l b
e) = SrcSpan -> c -> Located c
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (c -> Located c) -> f c -> f (Located c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> b -> f c
f a
g b
e

updateLLMatch :: Traversal' (Located [LMatch GhcPs (LHsExpr GhcPs)]) (LHsSigWcType GhcPs)
updateLLMatch :: (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> Located [LMatch GhcPs (LHsExpr GhcPs)]
-> f (Located [LMatch GhcPs (LHsExpr GhcPs)])
updateLLMatch = ((LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
 -> [LMatch GhcPs (LHsExpr GhcPs)]
 -> f [LMatch GhcPs (LHsExpr GhcPs)])
-> (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> Located [LMatch GhcPs (LHsExpr GhcPs)]
-> f (Located [LMatch GhcPs (LHsExpr GhcPs)])
forall (f :: * -> *) a b c.
Functor f =>
(a -> b -> f c) -> a -> Located b -> f (Located c)
updateLocated (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> f [LMatch GhcPs (LHsExpr GhcPs)]
Traversal' [LMatch GhcPs (LHsExpr GhcPs)] (LHsSigWcType GhcPs)
updateLMatches

updateLMatches :: Traversal' [LMatch GhcPs (LHsExpr GhcPs)] (LHsSigWcType GhcPs)
updateLMatches :: (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> f [LMatch GhcPs (LHsExpr GhcPs)]
updateLMatches LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
f = (LMatch GhcPs (LHsExpr GhcPs) -> f (LMatch GhcPs (LHsExpr GhcPs)))
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> f [LMatch GhcPs (LHsExpr GhcPs)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (((LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
 -> Match GhcPs (LHsExpr GhcPs) -> f (Match GhcPs (LHsExpr GhcPs)))
-> (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> LMatch GhcPs (LHsExpr GhcPs)
-> f (LMatch GhcPs (LHsExpr GhcPs))
forall (f :: * -> *) a b c.
Functor f =>
(a -> b -> f c) -> a -> Located b -> f (Located c)
updateLocated (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> Match GhcPs (LHsExpr GhcPs) -> f (Match GhcPs (LHsExpr GhcPs))
Traversal' (Match GhcPs (LHsExpr GhcPs)) (LHsSigWcType GhcPs)
updateMatch LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
f)

updateMatch :: Traversal' (Match GhcPs (LHsExpr GhcPs)) (LHsSigWcType GhcPs)
updateMatch :: (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> Match GhcPs (LHsExpr GhcPs) -> f (Match GhcPs (LHsExpr GhcPs))
updateMatch LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
f m :: Match GhcPs (LHsExpr GhcPs)
m@Match {} = (\GRHSs GhcPs (LHsExpr GhcPs)
x -> Match GhcPs (LHsExpr GhcPs)
m {m_grhss :: GRHSs GhcPs (LHsExpr GhcPs)
m_grhss = GRHSs GhcPs (LHsExpr GhcPs)
x}) (GRHSs GhcPs (LHsExpr GhcPs) -> Match GhcPs (LHsExpr GhcPs))
-> f (GRHSs GhcPs (LHsExpr GhcPs))
-> f (Match GhcPs (LHsExpr GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> GRHSs GhcPs (LHsExpr GhcPs) -> f (GRHSs GhcPs (LHsExpr GhcPs))
Traversal' (GRHSs GhcPs (LHsExpr GhcPs)) (LHsSigWcType GhcPs)
updateGrhss LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
f (Match GhcPs (LHsExpr GhcPs) -> GRHSs GhcPs (LHsExpr GhcPs)
forall p body. Match p body -> GRHSs p body
m_grhss Match GhcPs (LHsExpr GhcPs)
m)
#if __GLASGOW_HASKELL__ < 900
updateMatch LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
_ Match GhcPs (LHsExpr GhcPs)
m = Match GhcPs (LHsExpr GhcPs) -> f (Match GhcPs (LHsExpr GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Match GhcPs (LHsExpr GhcPs)
m
#endif

updateGrhss :: Traversal' (GRHSs GhcPs (LHsExpr GhcPs)) (LHsSigWcType GhcPs)
updateGrhss :: (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> GRHSs GhcPs (LHsExpr GhcPs) -> f (GRHSs GhcPs (LHsExpr GhcPs))
updateGrhss LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
f grhss :: GRHSs GhcPs (LHsExpr GhcPs)
grhss@GRHSs {} = (\LHsLocalBinds GhcPs
x -> GRHSs GhcPs (LHsExpr GhcPs)
grhss {grhssLocalBinds :: LHsLocalBinds GhcPs
grhssLocalBinds = LHsLocalBinds GhcPs
x}) (LHsLocalBinds GhcPs -> GRHSs GhcPs (LHsExpr GhcPs))
-> f (LHsLocalBinds GhcPs) -> f (GRHSs GhcPs (LHsExpr GhcPs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> LHsLocalBinds GhcPs -> f (LHsLocalBinds GhcPs)
Traversal' (LHsLocalBinds GhcPs) (LHsSigWcType GhcPs)
updateLHsLocalBinds LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
f (GRHSs GhcPs (LHsExpr GhcPs) -> LHsLocalBinds GhcPs
forall p body. GRHSs p body -> LHsLocalBinds p
grhssLocalBinds GRHSs GhcPs (LHsExpr GhcPs)
grhss)
#if __GLASGOW_HASKELL__ < 900
updateGrhss LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
_ GRHSs GhcPs (LHsExpr GhcPs)
grhss = GRHSs GhcPs (LHsExpr GhcPs) -> f (GRHSs GhcPs (LHsExpr GhcPs))
forall (f :: * -> *) a. Applicative f => a -> f a
pure GRHSs GhcPs (LHsExpr GhcPs)
grhss
#endif

updateLHsLocalBinds :: Traversal' (LHsLocalBinds GhcPs) (LHsSigWcType GhcPs)
updateLHsLocalBinds :: (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> LHsLocalBinds GhcPs -> f (LHsLocalBinds GhcPs)
updateLHsLocalBinds = ((LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
 -> HsLocalBinds GhcPs -> f (HsLocalBinds GhcPs))
-> (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> LHsLocalBinds GhcPs
-> f (LHsLocalBinds GhcPs)
forall (f :: * -> *) a b c.
Functor f =>
(a -> b -> f c) -> a -> Located b -> f (Located c)
updateLocated (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> HsLocalBinds GhcPs -> f (HsLocalBinds GhcPs)
Traversal' (HsLocalBinds GhcPs) (LHsSigWcType GhcPs)
updateLocalBinds

updateLocalBinds :: Traversal' (HsLocalBinds GhcPs) (LHsSigWcType GhcPs)
updateLocalBinds :: (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> HsLocalBinds GhcPs -> f (HsLocalBinds GhcPs)
updateLocalBinds LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
f (HsValBinds XHsValBinds GhcPs GhcPs
xHsValBinds HsValBindsLR GhcPs GhcPs
hsValBindsLR) = XHsValBinds GhcPs GhcPs
-> HsValBindsLR GhcPs GhcPs -> HsLocalBinds GhcPs
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
HsValBinds XHsValBinds GhcPs GhcPs
xHsValBinds (HsValBindsLR GhcPs GhcPs -> HsLocalBinds GhcPs)
-> f (HsValBindsLR GhcPs GhcPs) -> f (HsLocalBinds GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> HsValBindsLR GhcPs GhcPs -> f (HsValBindsLR GhcPs GhcPs)
Traversal' (HsValBindsLR GhcPs GhcPs) (LHsSigWcType GhcPs)
updateHsValBindsLR LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
f HsValBindsLR GhcPs GhcPs
hsValBindsLR
updateLocalBinds LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
_ HsLocalBinds GhcPs
hsValBinds = HsLocalBinds GhcPs -> f (HsLocalBinds GhcPs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsLocalBinds GhcPs
hsValBinds

updateHsValBindsLR :: Traversal' (HsValBindsLR GhcPs GhcPs) (LHsSigWcType GhcPs)
updateHsValBindsLR :: (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> HsValBindsLR GhcPs GhcPs -> f (HsValBindsLR GhcPs GhcPs)
updateHsValBindsLR LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
f (ValBinds XValBinds GhcPs GhcPs
xValBinds LHsBindsLR GhcPs GhcPs
lHsBindsLR [LSig GhcPs]
lSigs) = XValBinds GhcPs GhcPs
-> LHsBindsLR GhcPs GhcPs
-> [LSig GhcPs]
-> HsValBindsLR GhcPs GhcPs
forall idL idR.
XValBinds idL idR
-> LHsBindsLR idL idR -> [LSig idR] -> HsValBindsLR idL idR
ValBinds XValBinds GhcPs GhcPs
xValBinds LHsBindsLR GhcPs GhcPs
lHsBindsLR ([LSig GhcPs] -> HsValBindsLR GhcPs GhcPs)
-> f [LSig GhcPs] -> f (HsValBindsLR GhcPs GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> [LSig GhcPs] -> f [LSig GhcPs]
Traversal' [LSig GhcPs] (LHsSigWcType GhcPs)
updateLSigs LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
f [LSig GhcPs]
lSigs
updateHsValBindsLR LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
_ HsValBindsLR GhcPs GhcPs
valBinds = HsValBindsLR GhcPs GhcPs -> f (HsValBindsLR GhcPs GhcPs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsValBindsLR GhcPs GhcPs
valBinds

updateLSigs :: Traversal' [LSig GhcPs] (LHsSigWcType GhcPs)
updateLSigs :: (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> [LSig GhcPs] -> f [LSig GhcPs]
updateLSigs LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
f = (LSig GhcPs -> f (LSig GhcPs)) -> [LSig GhcPs] -> f [LSig GhcPs]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (((LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
 -> Sig GhcPs -> f (Sig GhcPs))
-> (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> LSig GhcPs
-> f (LSig GhcPs)
forall (f :: * -> *) a b c.
Functor f =>
(a -> b -> f c) -> a -> Located b -> f (Located c)
updateLocated (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> Sig GhcPs -> f (Sig GhcPs)
Traversal' (Sig GhcPs) (LHsSigWcType GhcPs)
updateSig LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
f)

updateSig :: Traversal' (Sig GhcPs) (LHsSigWcType GhcPs)
updateSig :: (LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs))
-> Sig GhcPs -> f (Sig GhcPs)
updateSig LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
f (TypeSig XTypeSig GhcPs
xSig [Located (IdP GhcPs)]
ls LHsSigWcType GhcPs
t) = XTypeSig GhcPs
-> [Located (IdP GhcPs)] -> LHsSigWcType GhcPs -> Sig GhcPs
forall pass.
XTypeSig pass
-> [Located (IdP pass)] -> LHsSigWcType pass -> Sig pass
TypeSig XTypeSig GhcPs
xSig [Located (IdP GhcPs)]
ls (LHsSigWcType GhcPs -> Sig GhcPs)
-> f (LHsSigWcType GhcPs) -> f (Sig GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
f LHsSigWcType GhcPs
t
updateSig LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
_ Sig GhcPs
sig = Sig GhcPs -> f (Sig GhcPs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Sig GhcPs
sig

updateLHsSigWsType :: Traversal' (LHsSigWcType GhcPs) (LHsSigType GhcPs)
updateLHsSigWsType :: (LHsSigType GhcPs -> f (LHsSigType GhcPs))
-> LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
updateLHsSigWsType LHsSigType GhcPs -> f (LHsSigType GhcPs)
f lhs :: LHsSigWcType GhcPs
lhs@HsWC {} =
  (\LHsSigType GhcPs
x -> LHsSigWcType GhcPs
lhs {hswc_body :: LHsSigType GhcPs
hswc_body = LHsSigType GhcPs
x}) (LHsSigType GhcPs -> LHsSigWcType GhcPs)
-> f (LHsSigType GhcPs) -> f (LHsSigWcType GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsSigType GhcPs -> f (LHsSigType GhcPs)
f (LHsSigWcType GhcPs -> LHsSigType GhcPs
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body LHsSigWcType GhcPs
lhs)
#if __GLASGOW_HASKELL__ < 900
updateLHsSigWsType LHsSigType GhcPs -> f (LHsSigType GhcPs)
_ LHsSigWcType GhcPs
lhs = LHsSigWcType GhcPs -> f (LHsSigWcType GhcPs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure LHsSigWcType GhcPs
lhs
#endif

updateLHsSigType :: Traversal' (LHsSigType GhcPs) (LHsType GhcPs)
updateLHsSigType :: (LHsType GhcPs -> f (LHsType GhcPs))
-> LHsSigType GhcPs -> f (LHsSigType GhcPs)
updateLHsSigType LHsType GhcPs -> f (LHsType GhcPs)
f lhs :: LHsSigType GhcPs
lhs@HsIB {} =
  (\LHsType GhcPs
x -> LHsSigType GhcPs
lhs {hsib_body :: LHsType GhcPs
hsib_body = LHsType GhcPs
x}) (LHsType GhcPs -> LHsSigType GhcPs)
-> f (LHsType GhcPs) -> f (LHsSigType GhcPs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LHsType GhcPs -> f (LHsType GhcPs)
f (LHsSigType GhcPs -> LHsType GhcPs
forall pass thing. HsImplicitBndrs pass thing -> thing
hsib_body LHsSigType GhcPs
lhs)
#if __GLASGOW_HASKELL__ < 900
updateLHsSigType LHsType GhcPs -> f (LHsType GhcPs)
_ LHsSigType GhcPs
lhs = LHsSigType GhcPs -> f (LHsSigType GhcPs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure LHsSigType GhcPs
lhs
#endif

updateLHsType :: Traversal' (LHsType GhcPs) (HsType GhcPs)
updateLHsType :: (HsType GhcPs -> f (HsType GhcPs))
-> LHsType GhcPs -> f (LHsType GhcPs)
updateLHsType = (HsType GhcPs -> f (HsType GhcPs))
-> LHsType GhcPs -> f (LHsType GhcPs)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse

-- Main process
updateHsType :: HsType GhcPs -> (Any, HsType GhcPs)
updateHsType :: HsType GhcPs -> (Any, HsType GhcPs)
updateHsType ty :: HsType GhcPs
ty@(HsQualTy XQualTy GhcPs
xty LHsContext GhcPs
ctxt LHsType GhcPs
body) =
  if HsContext GhcPs -> Bool
hasHasCallStack (LHsContext GhcPs -> SrcSpanLess (LHsContext GhcPs)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsContext GhcPs
ctxt)
    then HsType GhcPs -> (Any, HsType GhcPs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsType GhcPs
ty
    else HsType GhcPs -> (Any, HsType GhcPs)
forall a. a -> (Any, a)
flagASTModified (HsType GhcPs -> (Any, HsType GhcPs))
-> HsType GhcPs -> (Any, HsType GhcPs)
forall a b. (a -> b) -> a -> b
$ XQualTy GhcPs -> LHsContext GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass.
XQualTy pass -> LHsContext pass -> LHsType pass -> HsType pass
HsQualTy XQualTy GhcPs
xty ((HsContext GhcPs -> HsContext GhcPs)
-> LHsContext GhcPs -> LHsContext GhcPs
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HsContext GhcPs -> HsContext GhcPs
appendHSC LHsContext GhcPs
ctxt) LHsType GhcPs
body
updateHsType ty :: HsType GhcPs
ty@HsTyVar {} =
  HsType GhcPs -> (Any, HsType GhcPs)
forall a. a -> (Any, a)
flagASTModified (HsType GhcPs -> (Any, HsType GhcPs))
-> HsType GhcPs -> (Any, HsType GhcPs)
forall a b. (a -> b) -> a -> b
$ XQualTy GhcPs -> LHsContext GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass.
XQualTy pass -> LHsContext pass -> LHsType pass -> HsType pass
HsQualTy NoExtField
XQualTy GhcPs
xQualTy (SrcSpanLess (LHsContext GhcPs) -> LHsContext GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LHsContext GhcPs) -> LHsContext GhcPs)
-> SrcSpanLess (LHsContext GhcPs) -> LHsContext GhcPs
forall a b. (a -> b) -> a -> b
$ HsContext GhcPs -> HsContext GhcPs
appendHSC []) (SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc HsType GhcPs
SrcSpanLess (LHsType GhcPs)
ty)
updateHsType ty :: HsType GhcPs
ty@HsAppTy {} =
  HsType GhcPs -> (Any, HsType GhcPs)
forall a. a -> (Any, a)
flagASTModified (HsType GhcPs -> (Any, HsType GhcPs))
-> HsType GhcPs -> (Any, HsType GhcPs)
forall a b. (a -> b) -> a -> b
$ XQualTy GhcPs -> LHsContext GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass.
XQualTy pass -> LHsContext pass -> LHsType pass -> HsType pass
HsQualTy NoExtField
XQualTy GhcPs
xQualTy (SrcSpanLess (LHsContext GhcPs) -> LHsContext GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LHsContext GhcPs) -> LHsContext GhcPs)
-> SrcSpanLess (LHsContext GhcPs) -> LHsContext GhcPs
forall a b. (a -> b) -> a -> b
$ HsContext GhcPs -> HsContext GhcPs
appendHSC []) (SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc HsType GhcPs
SrcSpanLess (LHsType GhcPs)
ty)
updateHsType ty :: HsType GhcPs
ty@HsFunTy {} =
  HsType GhcPs -> (Any, HsType GhcPs)
forall a. a -> (Any, a)
flagASTModified (HsType GhcPs -> (Any, HsType GhcPs))
-> HsType GhcPs -> (Any, HsType GhcPs)
forall a b. (a -> b) -> a -> b
$ XQualTy GhcPs -> LHsContext GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass.
XQualTy pass -> LHsContext pass -> LHsType pass -> HsType pass
HsQualTy NoExtField
XQualTy GhcPs
xQualTy (SrcSpanLess (LHsContext GhcPs) -> LHsContext GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LHsContext GhcPs) -> LHsContext GhcPs)
-> SrcSpanLess (LHsContext GhcPs) -> LHsContext GhcPs
forall a b. (a -> b) -> a -> b
$ HsContext GhcPs -> HsContext GhcPs
appendHSC []) (SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc HsType GhcPs
SrcSpanLess (LHsType GhcPs)
ty)
updateHsType ty :: HsType GhcPs
ty@HsListTy {} = 
  HsType GhcPs -> (Any, HsType GhcPs)
forall a. a -> (Any, a)
flagASTModified (HsType GhcPs -> (Any, HsType GhcPs))
-> HsType GhcPs -> (Any, HsType GhcPs)
forall a b. (a -> b) -> a -> b
$ XQualTy GhcPs -> LHsContext GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass.
XQualTy pass -> LHsContext pass -> LHsType pass -> HsType pass
HsQualTy NoExtField
XQualTy GhcPs
xQualTy (SrcSpanLess (LHsContext GhcPs) -> LHsContext GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LHsContext GhcPs) -> LHsContext GhcPs)
-> SrcSpanLess (LHsContext GhcPs) -> LHsContext GhcPs
forall a b. (a -> b) -> a -> b
$ HsContext GhcPs -> HsContext GhcPs
appendHSC []) (SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc HsType GhcPs
SrcSpanLess (LHsType GhcPs)
ty)
updateHsType ty :: HsType GhcPs
ty@HsTupleTy {} =
  HsType GhcPs -> (Any, HsType GhcPs)
forall a. a -> (Any, a)
flagASTModified (HsType GhcPs -> (Any, HsType GhcPs))
-> HsType GhcPs -> (Any, HsType GhcPs)
forall a b. (a -> b) -> a -> b
$ XQualTy GhcPs -> LHsContext GhcPs -> LHsType GhcPs -> HsType GhcPs
forall pass.
XQualTy pass -> LHsContext pass -> LHsType pass -> HsType pass
HsQualTy NoExtField
XQualTy GhcPs
xQualTy (SrcSpanLess (LHsContext GhcPs) -> LHsContext GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LHsContext GhcPs) -> LHsContext GhcPs)
-> SrcSpanLess (LHsContext GhcPs) -> LHsContext GhcPs
forall a b. (a -> b) -> a -> b
$ HsContext GhcPs -> HsContext GhcPs
appendHSC []) (SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc HsType GhcPs
SrcSpanLess (LHsType GhcPs)
ty)
updateHsType HsType GhcPs
ty = HsType GhcPs -> (Any, HsType GhcPs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsType GhcPs
ty

#if __GLASGOW_HASKELL__ < 810
xQualTy :: NoExt
xQualTy = noExt
#else
xQualTy :: NoExtField
xQualTy :: NoExtField
xQualTy = NoExtField
NoExtField
#endif

flagASTModified :: a -> (Any, a)
flagASTModified :: a -> (Any, a)
flagASTModified a
a = (Bool -> Any
Any Bool
True, a
a)

appendHSC :: HsContext GhcPs -> HsContext GhcPs
appendHSC :: HsContext GhcPs -> HsContext GhcPs
appendHSC HsContext GhcPs
cs = LHsType GhcPs
mkHSC LHsType GhcPs -> HsContext GhcPs -> HsContext GhcPs
forall a. a -> [a] -> [a]
: HsContext GhcPs
cs

hasHasCallStack :: HsContext GhcPs -> Bool
hasHasCallStack :: HsContext GhcPs -> Bool
hasHasCallStack = (LHsType GhcPs -> Bool) -> HsContext GhcPs -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (HsType GhcPs -> Bool
checkHsType (HsType GhcPs -> Bool)
-> (LHsType GhcPs -> HsType GhcPs) -> LHsType GhcPs -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsType GhcPs -> HsType GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc)
  where
    checkHsType :: HsType GhcPs -> Bool
    checkHsType :: HsType GhcPs -> Bool
checkHsType (HsTyVar XTyVar GhcPs
_ PromotionFlag
_ Located (IdP GhcPs)
lid) = Located RdrName -> SrcSpanLess (Located RdrName)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP GhcPs)
Located RdrName
lid RdrName -> RdrName -> Bool
forall a. Eq a => a -> a -> Bool
== (OccName -> RdrName
mkRdrUnqual (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> OccName
mkClsOcc  CommandLineOption
"HasCallStack")
    checkHsType HsType GhcPs
_ = Bool
False

-- make HasCallStack => constraint
mkHSC :: LHsType GhcPs
mkHSC :: LHsType GhcPs
mkHSC = SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs)
-> SrcSpanLess (LHsType GhcPs) -> LHsType GhcPs
forall a b. (a -> b) -> a -> b
$ XTyVar GhcPs
-> PromotionFlag -> Located (IdP GhcPs) -> HsType GhcPs
forall pass.
XTyVar pass -> PromotionFlag -> Located (IdP pass) -> HsType pass
HsTyVar NoExtField
XTyVar GhcPs
xQualTy PromotionFlag
NotPromoted Located (IdP GhcPs)
lId

lId :: Located (IdP GhcPs)
lId :: Located (IdP GhcPs)
lId = SrcSpanLess (Located RdrName) -> Located RdrName
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (Located RdrName) -> Located RdrName)
-> SrcSpanLess (Located RdrName) -> Located RdrName
forall a b. (a -> b) -> a -> b
$ ModuleName -> OccName -> RdrName
mkRdrQual ModuleName
ghcStackModuleName (OccName -> RdrName) -> OccName -> RdrName
forall a b. (a -> b) -> a -> b
$ CommandLineOption -> OccName
mkClsOcc CommandLineOption
"HasCallStack"