{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module Compat.HieAst ( enrichHie ) where
import GHC.Utils.Outputable(ppr)
import GHC.Prelude
import GHC.Types.Avail ( Avails )
import GHC.Data.Bag ( Bag, bagToList )
import GHC.Types.Basic
import GHC.Data.BooleanFormula
import GHC.Core.Class ( className, classSCSelIds )
import GHC.Core.Utils ( exprType )
import GHC.Core.ConLike ( conLikeName, ConLike(RealDataCon) )
import GHC.Core.TyCon ( TyCon, tyConClass_maybe )
import GHC.Core.FVs
import GHC.Core.DataCon ( dataConNonlinearType )
import GHC.Types.FieldLabel
import GHC.Hs
import GHC.Driver.Env
import GHC.Utils.Monad ( concatMapM, liftIO )
import GHC.Types.Id ( isDataConId_maybe )
import GHC.Types.Name ( Name, nameSrcSpan, nameUnique )
import GHC.Types.Name.Env ( NameEnv, emptyNameEnv, extendNameEnv, lookupNameEnv )
import GHC.Types.SrcLoc
import GHC.Tc.Utils.Zonk ( hsLitType, hsPatType )
import GHC.Core.Type ( mkVisFunTys, Type )
import GHC.Core.Predicate
import GHC.Core.InstEnv
import GHC.Builtin.Types ( mkListTy, mkSumTy )
import GHC.Tc.Types
import GHC.Tc.Types.Evidence
import GHC.Types.Var ( Id, Var, EvId, varName, varType, varUnique )
import GHC.Types.Var.Env
import GHC.Builtin.Uniques
import GHC.Iface.Make ( mkIfaceExports )
import GHC.Utils.Panic
import GHC.Utils.Misc
import GHC.Data.Maybe
import GHC.Data.FastString
import GHC.Iface.Ext.Types
import GHC.Iface.Ext.Utils
import GHC.Unit.Module ( ModuleName, ml_hs_file )
import GHC.Unit.Module.ModSummary
import qualified Data.Array as A
import qualified Data.ByteString as BS
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Data ( Data, Typeable )
import Data.Void ( Void, absurd )
import Control.Monad ( forM_ )
import Control.Monad.Trans.State.Strict
import Control.Monad.Trans.Reader
import Control.Monad.Trans.Class ( lift )
import GHC.HsToCore.Types
import GHC.HsToCore.Expr
import GHC.HsToCore.Monad
type RenamedSource = ( HsGroup GhcRn, [LImportDecl GhcRn]
, Maybe [(LIE GhcRn, Avails)]
, Maybe LHsDocString )
type TypecheckedSource = LHsBinds GhcTc
type VarMap a = DVarEnv (Var,a)
data HieState = HieState
{ HieState -> NameEnv Id
name_remapping :: NameEnv Id
, HieState -> VarMap (Set ContextInfo)
unlocated_ev_binds :: VarMap (S.Set ContextInfo)
}
addUnlocatedEvBind :: Var -> ContextInfo -> HieM ()
addUnlocatedEvBind :: Id -> ContextInfo -> HieM ()
addUnlocatedEvBind Id
var ContextInfo
ci = do
let go :: (a, Set a) -> (a, Set a) -> (a, Set a)
go (a
a,Set a
b) (a
_,Set a
c) = (a
a,forall a. Ord a => Set a -> Set a -> Set a
S.union Set a
b Set a
c)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' forall a b. (a -> b) -> a -> b
$ \HieState
s ->
HieState
s { unlocated_ev_binds :: VarMap (Set ContextInfo)
unlocated_ev_binds =
forall a. (a -> a -> a) -> DVarEnv a -> Id -> a -> DVarEnv a
extendDVarEnv_C forall {a} {a} {a}. Ord a => (a, Set a) -> (a, Set a) -> (a, Set a)
go (HieState -> VarMap (Set ContextInfo)
unlocated_ev_binds HieState
s)
Id
var (Id
var,forall a. a -> Set a
S.singleton ContextInfo
ci)
}
getUnlocatedEvBinds :: FastString -> HieM (NodeIdentifiers Type,[HieAST Type])
getUnlocatedEvBinds :: FastString -> HieM (NodeIdentifiers Type, [HieAST Type])
getUnlocatedEvBinds FastString
file = do
VarMap (Set ContextInfo)
binds <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets HieState -> VarMap (Set ContextInfo)
unlocated_ev_binds
NodeOrigin
org <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
let elts :: [(Id, Set ContextInfo)]
elts = forall a. DVarEnv a -> [a]
dVarEnvElts VarMap (Set ContextInfo)
binds
mkNodeInfo :: (Id, Set ContextInfo) -> (Either a Name, IdentifierDetails Type)
mkNodeInfo (Id
n,Set ContextInfo
ci) = (forall a b. b -> Either a b
Right (Id -> Name
varName Id
n), forall a. Maybe a -> Set ContextInfo -> IdentifierDetails a
IdentifierDetails (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Id -> Type
varType Id
n) Set ContextInfo
ci)
go :: (Id, Set ContextInfo)
-> ([(Identifier, IdentifierDetails Type)], [HieAST Type])
-> ([(Identifier, IdentifierDetails Type)], [HieAST Type])
go e :: (Id, Set ContextInfo)
e@(Id
v,Set ContextInfo
_) ([(Identifier, IdentifierDetails Type)]
xs,[HieAST Type]
ys) = case Name -> SrcSpan
nameSrcSpan forall a b. (a -> b) -> a -> b
$ Id -> Name
varName Id
v of
RealSrcSpan Span
spn Maybe BufSpan
_
| Span -> FastString
srcSpanFile Span
spn forall a. Eq a => a -> a -> Bool
== FastString
file ->
let node :: HieAST Type
node = forall a. SourcedNodeInfo a -> Span -> [HieAST a] -> HieAST a
Node (forall a. NodeOrigin -> NodeInfo a -> SourcedNodeInfo a
mkSourcedNodeInfo NodeOrigin
org NodeInfo Type
ni) Span
spn []
ni :: NodeInfo Type
ni = forall a.
Set NodeAnnotation -> [a] -> NodeIdentifiers a -> NodeInfo a
NodeInfo forall a. Monoid a => a
mempty [] forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [forall {a}.
(Id, Set ContextInfo) -> (Either a Name, IdentifierDetails Type)
mkNodeInfo (Id, Set ContextInfo)
e]
in ([(Identifier, IdentifierDetails Type)]
xs,HieAST Type
nodeforall a. a -> [a] -> [a]
:[HieAST Type]
ys)
SrcSpan
_ -> (forall {a}.
(Id, Set ContextInfo) -> (Either a Name, IdentifierDetails Type)
mkNodeInfo (Id, Set ContextInfo)
e forall a. a -> [a] -> [a]
: [(Identifier, IdentifierDetails Type)]
xs,[HieAST Type]
ys)
([(Identifier, IdentifierDetails Type)]
nis,[HieAST Type]
asts) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Id, Set ContextInfo)
-> ([(Identifier, IdentifierDetails Type)], [HieAST Type])
-> ([(Identifier, IdentifierDetails Type)], [HieAST Type])
go ([],[]) [(Id, Set ContextInfo)]
elts
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Identifier, IdentifierDetails Type)]
nis, [HieAST Type]
asts)
initState :: HieState
initState :: HieState
initState = NameEnv Id -> VarMap (Set ContextInfo) -> HieState
HieState forall a. NameEnv a
emptyNameEnv forall a. DVarEnv a
emptyDVarEnv
class ModifyState a where
addSubstitution :: a -> a -> HieState -> HieState
instance ModifyState Name where
addSubstitution :: Name -> Name -> HieState -> HieState
addSubstitution Name
_ Name
_ HieState
hs = HieState
hs
instance ModifyState Id where
addSubstitution :: Id -> Id -> HieState -> HieState
addSubstitution Id
mono Id
poly HieState
hs =
HieState
hs{name_remapping :: NameEnv Id
name_remapping = forall a. NameEnv a -> Name -> a -> NameEnv a
extendNameEnv (HieState -> NameEnv Id
name_remapping HieState
hs) (Id -> Name
varName Id
mono) Id
poly}
modifyState :: ModifyState (IdP p) => [ABExport p] -> HieState -> HieState
modifyState :: forall p.
ModifyState (IdP p) =>
[ABExport p] -> HieState -> HieState
modifyState = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {p} {a}.
ModifyState (IdP p) =>
ABExport p -> (a -> HieState) -> a -> HieState
go forall a. a -> a
id
where
go :: ABExport p -> (a -> HieState) -> a -> HieState
go ABE{abe_poly :: forall p. ABExport p -> IdP p
abe_poly=IdP p
poly,abe_mono :: forall p. ABExport p -> IdP p
abe_mono=IdP p
mono} a -> HieState
f
= forall a. ModifyState a => a -> a -> HieState -> HieState
addSubstitution IdP p
mono IdP p
poly forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> HieState
f
go ABExport p
_ a -> HieState
f = a -> HieState
f
type HieM = ReaderT NodeOrigin (StateT HieState DsM)
mkHieFile :: ModSummary
-> TcGblEnv
-> RenamedSource -> Hsc HieFile
mkHieFile :: ModSummary -> TcGblEnv -> RenamedSource -> Hsc HieFile
mkHieFile ModSummary
ms TcGblEnv
ts RenamedSource
rs = do
let src_file :: FilePath
src_file = forall a. HasCallStack => FilePath -> Maybe a -> a
expectJust FilePath
"mkHieFile" (ModLocation -> Maybe FilePath
ml_hs_file forall a b. (a -> b) -> a -> b
$ ModSummary -> ModLocation
ms_location ModSummary
ms)
ByteString
src <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
BS.readFile FilePath
src_file
FilePath
-> ByteString
-> ModSummary
-> TcGblEnv
-> RenamedSource
-> Hsc HieFile
mkHieFileWithSource FilePath
src_file ByteString
src ModSummary
ms TcGblEnv
ts RenamedSource
rs
mkHieFileWithSource :: FilePath
-> BS.ByteString
-> ModSummary
-> TcGblEnv
-> RenamedSource -> Hsc HieFile
mkHieFileWithSource :: FilePath
-> ByteString
-> ModSummary
-> TcGblEnv
-> RenamedSource
-> Hsc HieFile
mkHieFileWithSource FilePath
src_file ByteString
src ModSummary
ms TcGblEnv
ts RenamedSource
rs = do
let tc_binds :: LHsBinds GhcTc
tc_binds = TcGblEnv -> LHsBinds GhcTc
tcg_binds TcGblEnv
ts
top_ev_binds :: Bag EvBind
top_ev_binds = TcGblEnv -> Bag EvBind
tcg_ev_binds TcGblEnv
ts
insts :: [ClsInst]
insts = TcGblEnv -> [ClsInst]
tcg_insts TcGblEnv
ts
tcs :: [TyCon]
tcs = TcGblEnv -> [TyCon]
tcg_tcs TcGblEnv
ts
HscEnv
hsc_env <- forall a.
(HscEnv -> WarningMessages -> IO (a, WarningMessages)) -> Hsc a
Hsc forall a b. (a -> b) -> a -> b
$ \HscEnv
e WarningMessages
w -> forall (m :: * -> *) a. Monad m => a -> m a
return (HscEnv
e, WarningMessages
w)
(Messages DecoratedSDoc
_msgs, Maybe (HieASTs TypeIndex, Array TypeIndex HieTypeFlat)
res) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a.
HscEnv -> TcGblEnv -> DsM a -> IO (Messages DecoratedSDoc, Maybe a)
initDs HscEnv
hsc_env TcGblEnv
ts forall a b. (a -> b) -> a -> b
$ LHsBinds GhcTc
-> RenamedSource
-> Bag EvBind
-> [ClsInst]
-> [TyCon]
-> DsM (HieASTs TypeIndex, Array TypeIndex HieTypeFlat)
getCompressedAsts LHsBinds GhcTc
tc_binds RenamedSource
rs Bag EvBind
top_ev_binds [ClsInst]
insts [TyCon]
tcs
let (HieASTs TypeIndex
asts',Array TypeIndex HieTypeFlat
arr) = forall a. HasCallStack => FilePath -> Maybe a -> a
expectJust FilePath
"mkHieFileWithSource" Maybe (HieASTs TypeIndex, Array TypeIndex HieTypeFlat)
res
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ HieFile
{ hie_hs_file :: FilePath
hie_hs_file = FilePath
src_file
, hie_module :: Module
hie_module = ModSummary -> Module
ms_mod ModSummary
ms
, hie_types :: Array TypeIndex HieTypeFlat
hie_types = Array TypeIndex HieTypeFlat
arr
, hie_asts :: HieASTs TypeIndex
hie_asts = HieASTs TypeIndex
asts'
, hie_exports :: [AvailInfo]
hie_exports = [AvailInfo] -> [AvailInfo]
mkIfaceExports (TcGblEnv -> [AvailInfo]
tcg_exports TcGblEnv
ts)
, hie_hs_src :: ByteString
hie_hs_src = ByteString
src
}
getCompressedAsts :: TypecheckedSource -> RenamedSource -> Bag EvBind -> [ClsInst] -> [TyCon]
-> DsM (HieASTs TypeIndex, A.Array TypeIndex HieTypeFlat)
getCompressedAsts :: LHsBinds GhcTc
-> RenamedSource
-> Bag EvBind
-> [ClsInst]
-> [TyCon]
-> DsM (HieASTs TypeIndex, Array TypeIndex HieTypeFlat)
getCompressedAsts LHsBinds GhcTc
ts RenamedSource
rs Bag EvBind
top_ev_binds [ClsInst]
insts [TyCon]
tcs = do
HieASTs Type
asts <- LHsBinds GhcTc
-> RenamedSource
-> Bag EvBind
-> [ClsInst]
-> [TyCon]
-> DsM (HieASTs Type)
enrichHie LHsBinds GhcTc
ts RenamedSource
rs Bag EvBind
top_ev_binds [ClsInst]
insts [TyCon]
tcs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ HieASTs Type -> (HieASTs TypeIndex, Array TypeIndex HieTypeFlat)
compressTypes HieASTs Type
asts
enrichHie :: TypecheckedSource -> RenamedSource -> Bag EvBind -> [ClsInst] -> [TyCon]
-> DsM (HieASTs Type)
enrichHie :: LHsBinds GhcTc
-> RenamedSource
-> Bag EvBind
-> [ClsInst]
-> [TyCon]
-> DsM (HieASTs Type)
enrichHie LHsBinds GhcTc
ts (HsGroup GhcRn
hsGrp, [LImportDecl GhcRn]
imports, Maybe [(LIE GhcRn, [AvailInfo])]
exports, Maybe LHsDocString
_) Bag EvBind
ev_bs [ClsInst]
insts [TyCon]
tcs =
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT HieState
initState forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT NodeOrigin
SourceInfo forall a b. (a -> b) -> a -> b
$ do
[HieAST Type]
tasts <- forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. BindType -> Scope -> a -> BindContext a
BC BindType
RegularBind Scope
ModuleScope) LHsBinds GhcTc
ts
[HieAST Type]
rasts <- forall {p}.
(ToHie (XRec p (SpliceDecl p)), ToHie (XRec p (DerivDecl p)),
ToHie (XRec p (FixitySig p)), ToHie (XRec p (DefaultDecl p)),
ToHie (XRec p (ForeignDecl p)), ToHie (XRec p (WarnDecls p)),
ToHie (XRec p (AnnDecl p)), ToHie (XRec p (RuleDecls p)),
ToHie (RScoped (HsValBinds p)), ToHie (TyClGroup p)) =>
HsGroup p -> HieM [HieAST Type]
processGrp HsGroup GhcRn
hsGrp
[HieAST Type]
imps <- forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass. ImportDecl pass -> Bool
ideclImplicit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> e
unLoc) [LImportDecl GhcRn]
imports
[HieAST Type]
exps <- forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ forall a. IEType -> a -> IEContext a
IEC IEType
Export forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) Maybe [(LIE GhcRn, [AvailInfo])]
exports
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ClsInst]
insts forall a b. (a -> b) -> a -> b
$ \ClsInst
i ->
Id -> ContextInfo -> HieM ()
addUnlocatedEvBind (ClsInst -> Id
is_dfun ClsInst
i) (EvVarSource -> Scope -> Maybe Span -> ContextInfo
EvidenceVarBind (Bool -> Name -> EvVarSource
EvInstBind Bool
False (ClsInst -> Name
is_cls_nm ClsInst
i)) Scope
ModuleScope forall a. Maybe a
Nothing)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TyCon]
tcs forall a b. (a -> b) -> a -> b
$ \TyCon
tc ->
case TyCon -> Maybe Class
tyConClass_maybe TyCon
tc of
Maybe Class
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just Class
c -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Class -> [Id]
classSCSelIds Class
c) forall a b. (a -> b) -> a -> b
$ \Id
v ->
Id -> ContextInfo -> HieM ()
addUnlocatedEvBind Id
v (EvVarSource -> Scope -> Maybe Span -> ContextInfo
EvidenceVarBind (Bool -> Name -> EvVarSource
EvInstBind Bool
True (Class -> Name
className Class
c)) Scope
ModuleScope forall a. Maybe a
Nothing)
let spanFile :: FastString -> [HieAST a] -> Span
spanFile FastString
file [HieAST a]
children = case [HieAST a]
children of
[] -> RealSrcLoc -> Span
realSrcLocSpan (FastString -> TypeIndex -> TypeIndex -> RealSrcLoc
mkRealSrcLoc FastString
file TypeIndex
1 TypeIndex
1)
[HieAST a]
_ -> RealSrcLoc -> RealSrcLoc -> Span
mkRealSrcSpan (Span -> RealSrcLoc
realSrcSpanStart forall a b. (a -> b) -> a -> b
$ forall a. HieAST a -> Span
nodeSpan forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [HieAST a]
children)
(Span -> RealSrcLoc
realSrcSpanEnd forall a b. (a -> b) -> a -> b
$ forall a. HieAST a -> Span
nodeSpan forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
last [HieAST a]
children)
flat_asts :: [HieAST Type]
flat_asts = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [HieAST Type]
tasts
, [HieAST Type]
rasts
, [HieAST Type]
imps
, [HieAST Type]
exps
]
modulify :: HiePath
-> [HieAST Type]
-> ReaderT NodeOrigin (StateT HieState DsM) (HieAST Type)
modulify (HiePath FastString
file) [HieAST Type]
xs' = do
[HieAST Type]
top_ev_asts :: [HieAST Type] <- do
let
l :: SrcSpanAnnA
l :: SrcSpanAnnA
l = forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan (Span -> Maybe BufSpan -> SrcSpan
RealSrcSpan (RealSrcLoc -> Span
realSrcLocSpan forall a b. (a -> b) -> a -> b
$ FastString -> TypeIndex -> TypeIndex -> RealSrcLoc
mkRealSrcLoc FastString
file TypeIndex
1 TypeIndex
1) forall a. Maybe a
Nothing)
forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Scope -> Maybe Span -> a -> EvBindContext a
EvBindContext Scope
ModuleScope forall a. Maybe a
Nothing
forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
l (Bag EvBind -> TcEvBinds
EvBinds Bag EvBind
ev_bs)
(NodeIdentifiers Type
uloc_evs,[HieAST Type]
more_ev_asts) <- FastString -> HieM (NodeIdentifiers Type, [HieAST Type])
getUnlocatedEvBinds FastString
file
let xs :: [HieAST Type]
xs = [HieAST Type] -> [HieAST Type]
mergeSortAsts forall a b. (a -> b) -> a -> b
$ [HieAST Type]
xs' forall a. [a] -> [a] -> [a]
++ [HieAST Type]
top_ev_asts forall a. [a] -> [a] -> [a]
++ [HieAST Type]
more_ev_asts
span :: Span
span = forall {a}. FastString -> [HieAST a] -> Span
spanFile FastString
file [HieAST Type]
xs
moduleInfo :: SourcedNodeInfo Type
moduleInfo = forall a. Map NodeOrigin (NodeInfo a) -> SourcedNodeInfo a
SourcedNodeInfo
forall a b. (a -> b) -> a -> b
$ forall k a. k -> a -> Map k a
M.singleton NodeOrigin
SourceInfo
forall a b. (a -> b) -> a -> b
$ (forall a. FastString -> FastString -> NodeInfo a
simpleNodeInfo FastString
"Module" FastString
"Module")
{nodeIdentifiers :: NodeIdentifiers Type
nodeIdentifiers = NodeIdentifiers Type
uloc_evs}
moduleNode :: HieAST Type
moduleNode = forall a. SourcedNodeInfo a -> Span -> [HieAST a] -> HieAST a
Node SourcedNodeInfo Type
moduleInfo Span
span []
case [HieAST Type] -> [HieAST Type]
mergeSortAsts forall a b. (a -> b) -> a -> b
$ HieAST Type
moduleNode forall a. a -> [a] -> [a]
: [HieAST Type]
xs of
[HieAST Type
x] -> forall (m :: * -> *) a. Monad m => a -> m a
return HieAST Type
x
[HieAST Type]
xs -> forall a. FilePath -> SDoc -> a
panicDoc FilePath
"enrichHie: mergeSortAsts retur:ed more than one result" (forall a. Outputable a => a -> SDoc
ppr forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. HieAST a -> Span
nodeSpan [HieAST Type]
xs)
Map HiePath (HieAST Type)
asts' <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
forall a b. (a -> b) -> a -> b
$ forall k a b. (k -> a -> b) -> Map k a -> Map k b
M.mapWithKey HiePath
-> [HieAST Type]
-> ReaderT NodeOrigin (StateT HieState DsM) (HieAST Type)
modulify
forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith forall a. [a] -> [a] -> [a]
(++)
forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\HieAST Type
x -> (FastString -> HiePath
HiePath (Span -> FastString
srcSpanFile (forall a. HieAST a -> Span
nodeSpan HieAST Type
x)),[HieAST Type
x])) [HieAST Type]
flat_asts
let asts :: HieASTs Type
asts = forall a. Map HiePath (HieAST a) -> HieASTs a
HieASTs forall a b. (a -> b) -> a -> b
$ forall a. Map HiePath (HieAST a) -> Map HiePath (HieAST a)
resolveTyVarScopes Map HiePath (HieAST Type)
asts'
forall (m :: * -> *) a. Monad m => a -> m a
return HieASTs Type
asts
where
processGrp :: HsGroup p -> HieM [HieAST Type]
processGrp HsGroup p
grp = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Scope -> a -> RScoped a
RS Scope
ModuleScope ) forall p. HsGroup p -> HsValBinds p
hs_valds HsGroup p
grp
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall p. HsGroup p -> [LSpliceDecl p]
hs_splcds HsGroup p
grp
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall p. HsGroup p -> [TyClGroup p]
hs_tyclds HsGroup p
grp
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall p. HsGroup p -> [LDerivDecl p]
hs_derivds HsGroup p
grp
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall p. HsGroup p -> [LFixitySig p]
hs_fixds HsGroup p
grp
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall p. HsGroup p -> [LDefaultDecl p]
hs_defds HsGroup p
grp
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall p. HsGroup p -> [LForeignDecl p]
hs_fords HsGroup p
grp
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall p. HsGroup p -> [LWarnDecls p]
hs_warnds HsGroup p
grp
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall p. HsGroup p -> [LAnnDecl p]
hs_annds HsGroup p
grp
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall p. HsGroup p -> [LRuleDecls p]
hs_ruleds HsGroup p
grp
]
getRealSpanA :: SrcSpanAnn' ann -> Maybe Span
getRealSpanA :: forall ann. SrcSpanAnn' ann -> Maybe Span
getRealSpanA SrcSpanAnn' ann
la = SrcSpan -> Maybe Span
getRealSpan (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' ann
la)
getRealSpan :: SrcSpan -> Maybe Span
getRealSpan :: SrcSpan -> Maybe Span
getRealSpan (RealSrcSpan Span
sp Maybe BufSpan
_) = forall a. a -> Maybe a
Just Span
sp
getRealSpan SrcSpan
_ = forall a. Maybe a
Nothing
grhss_span :: (Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ SrcSpan
, Data (HsLocalBinds (GhcPass p)))
=> GRHSs (GhcPass p) (LocatedA (body (GhcPass p))) -> SrcSpan
grhss_span :: forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ SrcSpan,
Data (HsLocalBinds (GhcPass p))) =>
GRHSs (GhcPass p) (LocatedA (body (GhcPass p))) -> SrcSpan
grhss_span (GRHSs XCGRHSs (GhcPass p) (LocatedA (body (GhcPass p)))
_ [LGRHS (GhcPass p) (LocatedA (body (GhcPass p)))]
xs HsLocalBinds (GhcPass p)
bs) = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans (forall (p :: Pass).
Data (HsLocalBinds (GhcPass p)) =>
HsLocalBinds (GhcPass p) -> SrcSpan
spanHsLocaLBinds HsLocalBinds (GhcPass p)
bs) (forall a b. (a -> b) -> [a] -> [b]
map forall l e. GenLocated l e -> l
getLoc [LGRHS (GhcPass p) (LocatedA (body (GhcPass p)))]
xs)
bindingsOnly :: [Context Name] -> HieM [HieAST a]
bindingsOnly :: forall a. [Context Name] -> HieM [HieAST a]
bindingsOnly [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
bindingsOnly (C ContextInfo
c Name
n : [Context Name]
xs) = do
NodeOrigin
org <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
[HieAST a]
rest <- forall a. [Context Name] -> HieM [HieAST a]
bindingsOnly [Context Name]
xs
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Name -> SrcSpan
nameSrcSpan Name
n of
RealSrcSpan Span
span Maybe BufSpan
_ -> forall a. SourcedNodeInfo a -> Span -> [HieAST a] -> HieAST a
Node (forall a. NodeOrigin -> NodeInfo a -> SourcedNodeInfo a
mkSourcedNodeInfo NodeOrigin
org NodeInfo a
nodeinfo) Span
span [] forall a. a -> [a] -> [a]
: [HieAST a]
rest
where nodeinfo :: NodeInfo a
nodeinfo = forall a.
Set NodeAnnotation -> [a] -> NodeIdentifiers a -> NodeInfo a
NodeInfo forall a. Set a
S.empty [] (forall k a. k -> a -> Map k a
M.singleton (forall a b. b -> Either a b
Right Name
n) IdentifierDetails a
info)
info :: IdentifierDetails a
info = forall a. Monoid a => a
mempty{identInfo :: Set ContextInfo
identInfo = forall a. a -> Set a
S.singleton ContextInfo
c}
SrcSpan
_ -> [HieAST a]
rest
concatM :: Monad m => [m [a]] -> m [a]
concatM :: forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM [m [a]]
xs = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [m [a]]
xs
data Context a = C ContextInfo a
data RContext a = RC RecFieldContext a
data RFContext a = RFC RecFieldContext (Maybe Span) a
data IEContext a = IEC IEType a
data BindContext a = BC BindType Scope a
data PatSynFieldContext a = PSC (Maybe Span) a
data SigContext a = SC SigInfo a
data SigInfo = SI SigType (Maybe Span)
data SigType = BindSig | ClassSig | InstSig
data EvBindContext a = EvBindContext Scope (Maybe Span) a
data RScoped a = RS Scope a
data PScoped a = PS (Maybe Span)
Scope
Scope
a
deriving (Typeable, PScoped a -> DataType
PScoped a -> Constr
forall {a}. Data a => Typeable (PScoped a)
forall a. Data a => PScoped a -> DataType
forall a. Data a => PScoped a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> PScoped a -> PScoped a
forall a u.
Data a =>
TypeIndex -> (forall d. Data d => d -> u) -> PScoped a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> PScoped a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PScoped a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PScoped a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> PScoped a -> m (PScoped a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> PScoped a -> m (PScoped a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (PScoped a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PScoped a -> c (PScoped a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (PScoped a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (PScoped a))
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. TypeIndex -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (PScoped a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PScoped a -> c (PScoped a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (PScoped a))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PScoped a -> m (PScoped a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> PScoped a -> m (PScoped a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PScoped a -> m (PScoped a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> PScoped a -> m (PScoped a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PScoped a -> m (PScoped a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> PScoped a -> m (PScoped a)
gmapQi :: forall u.
TypeIndex -> (forall d. Data d => d -> u) -> PScoped a -> u
$cgmapQi :: forall a u.
Data a =>
TypeIndex -> (forall d. Data d => d -> u) -> PScoped a -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> PScoped a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> PScoped a -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PScoped a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PScoped a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PScoped a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PScoped a -> r
gmapT :: (forall b. Data b => b -> b) -> PScoped a -> PScoped a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> PScoped a -> PScoped a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (PScoped a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (PScoped a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (PScoped a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (PScoped a))
dataTypeOf :: PScoped a -> DataType
$cdataTypeOf :: forall a. Data a => PScoped a -> DataType
toConstr :: PScoped a -> Constr
$ctoConstr :: forall a. Data a => PScoped a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (PScoped a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (PScoped a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PScoped a -> c (PScoped a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PScoped a -> c (PScoped a)
Data)
data TScoped a = TS TyVarScope a
data TVScoped a = TVS TyVarScope Scope a
listScopes :: Scope -> [LocatedA a] -> [RScoped (LocatedA a)]
listScopes :: forall a. Scope -> [LocatedA a] -> [RScoped (LocatedA a)]
listScopes Scope
_ [] = []
listScopes Scope
rhsScope [LocatedA a
pat] = [forall a. Scope -> a -> RScoped a
RS Scope
rhsScope LocatedA a
pat]
listScopes Scope
rhsScope (LocatedA a
pat : [LocatedA a]
pats) = forall a. Scope -> a -> RScoped a
RS Scope
sc LocatedA a
pat forall a. a -> [a] -> [a]
: [RScoped (LocatedA a)]
pats'
where
pats' :: [RScoped (LocatedA a)]
pats'@((RS Scope
scope LocatedA a
p):[RScoped (LocatedA a)]
_) = forall a. Scope -> [LocatedA a] -> [RScoped (LocatedA a)]
listScopes Scope
rhsScope [LocatedA a]
pats
sc :: Scope
sc = Scope -> Scope -> Scope
combineScopes Scope
scope forall a b. (a -> b) -> a -> b
$ SrcSpan -> Scope
mkScope forall a b. (a -> b) -> a -> b
$ forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedA a
p
patScopes
:: Maybe Span
-> Scope
-> Scope
-> [LPat (GhcPass p)]
-> [PScoped (LPat (GhcPass p))]
patScopes :: forall (p :: Pass).
Maybe Span
-> Scope
-> Scope
-> [LPat (GhcPass p)]
-> [PScoped (LPat (GhcPass p))]
patScopes Maybe Span
rsp Scope
useScope Scope
patScope [LPat (GhcPass p)]
xs =
forall a b. (a -> b) -> [a] -> [b]
map (\(RS Scope
sc LocatedA (Pat (GhcPass p))
a) -> forall a. Maybe Span -> Scope -> Scope -> a -> PScoped a
PS Maybe Span
rsp Scope
useScope Scope
sc LocatedA (Pat (GhcPass p))
a) forall a b. (a -> b) -> a -> b
$
forall a. Scope -> [LocatedA a] -> [RScoped (LocatedA a)]
listScopes Scope
patScope [LPat (GhcPass p)]
xs
tScopes
:: Scope
-> Scope
-> [HsPatSigType (GhcPass a)]
-> [TScoped (HsPatSigType (GhcPass a))]
tScopes :: forall (a :: Pass).
Scope
-> Scope
-> [HsPatSigType (GhcPass a)]
-> [TScoped (HsPatSigType (GhcPass a))]
tScopes Scope
scope Scope
rhsScope [HsPatSigType (GhcPass a)]
xs =
forall a b. (a -> b) -> [a] -> [b]
map (\(RS Scope
sc GenLocated SrcSpanAnnA (HsPatSigType (GhcPass a))
a) -> forall a. TyVarScope -> a -> TScoped a
TS ([Scope] -> TyVarScope
ResolvedScopes [Scope
scope, Scope
sc]) (forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpanAnnA (HsPatSigType (GhcPass a))
a)) forall a b. (a -> b) -> a -> b
$
forall a. Scope -> [LocatedA a] -> [RScoped (LocatedA a)]
listScopes Scope
rhsScope (forall a b. (a -> b) -> [a] -> [b]
map (\HsPatSigType (GhcPass a)
hsps -> forall l e. l -> e -> GenLocated l e
L (forall l e. GenLocated l e -> l
getLoc forall a b. (a -> b) -> a -> b
$ forall pass. HsPatSigType pass -> LHsType pass
hsps_body HsPatSigType (GhcPass a)
hsps) HsPatSigType (GhcPass a)
hsps) [HsPatSigType (GhcPass a)]
xs)
tvScopes
:: TyVarScope
-> Scope
-> [LHsTyVarBndr flag (GhcPass a)]
-> [TVScoped (LHsTyVarBndr flag (GhcPass a))]
tvScopes :: forall flag (a :: Pass).
TyVarScope
-> Scope
-> [LHsTyVarBndr flag (GhcPass a)]
-> [TVScoped (LHsTyVarBndr flag (GhcPass a))]
tvScopes TyVarScope
tvScope Scope
rhsScope [LHsTyVarBndr flag (GhcPass a)]
xs =
forall a b. (a -> b) -> [a] -> [b]
map (\(RS Scope
sc LocatedA (HsTyVarBndr flag (GhcPass a))
a)-> forall a. TyVarScope -> Scope -> a -> TVScoped a
TVS TyVarScope
tvScope Scope
sc LocatedA (HsTyVarBndr flag (GhcPass a))
a) forall a b. (a -> b) -> a -> b
$ forall a. Scope -> [LocatedA a] -> [RScoped (LocatedA a)]
listScopes Scope
rhsScope [LHsTyVarBndr flag (GhcPass a)]
xs
class HasLoc a where
loc :: a -> SrcSpan
instance HasLoc thing => HasLoc (PScoped thing) where
loc :: PScoped thing -> SrcSpan
loc (PS Maybe Span
_ Scope
_ Scope
_ thing
a) = forall a. HasLoc a => a -> SrcSpan
loc thing
a
instance HasLoc (Located a) where
loc :: Located a -> SrcSpan
loc (L SrcSpan
l a
_) = SrcSpan
l
instance HasLoc (LocatedA a) where
loc :: LocatedA a -> SrcSpan
loc (L SrcSpanAnnA
la a
_) = forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
la
instance HasLoc (LocatedN a) where
loc :: LocatedN a -> SrcSpan
loc (L SrcSpanAnnN
la a
_) = forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
la
instance HasLoc a => HasLoc [a] where
loc :: [a] -> SrcSpan
loc [] = SrcSpan
noSrcSpan
loc [a]
xs = forall a. (a -> a -> a) -> [a] -> a
foldl1' SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. HasLoc a => a -> SrcSpan
loc [a]
xs
instance (HasLoc a, HiePass p) => HasLoc (FamEqn (GhcPass p) a) where
loc :: FamEqn (GhcPass p) a -> SrcSpan
loc (FamEqn XCFamEqn (GhcPass p) a
_ LIdP (GhcPass p)
a HsOuterFamEqnTyVarBndrs (GhcPass p)
outer_bndrs HsTyPats (GhcPass p)
b LexicalFixity
_ a
c) = case HsOuterFamEqnTyVarBndrs (GhcPass p)
outer_bndrs of
HsOuterImplicit{} ->
forall a. (a -> a -> a) -> [a] -> a
foldl1' SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans [forall a. HasLoc a => a -> SrcSpan
loc LIdP (GhcPass p)
a, forall a. HasLoc a => a -> SrcSpan
loc HsTyPats (GhcPass p)
b, forall a. HasLoc a => a -> SrcSpan
loc a
c]
HsOuterExplicit{hso_bndrs :: forall flag pass.
HsOuterTyVarBndrs flag pass -> [LHsTyVarBndr flag (NoGhcTc pass)]
hso_bndrs = [LHsTyVarBndr () (NoGhcTc (GhcPass p))]
tvs} ->
forall a. (a -> a -> a) -> [a] -> a
foldl1' SrcSpan -> SrcSpan -> SrcSpan
combineSrcSpans [forall a. HasLoc a => a -> SrcSpan
loc LIdP (GhcPass p)
a, forall a. HasLoc a => a -> SrcSpan
loc [LHsTyVarBndr () (NoGhcTc (GhcPass p))]
tvs, forall a. HasLoc a => a -> SrcSpan
loc HsTyPats (GhcPass p)
b, forall a. HasLoc a => a -> SrcSpan
loc a
c]
instance (HasLoc tm, HasLoc ty) => HasLoc (HsArg tm ty) where
loc :: HsArg tm ty -> SrcSpan
loc (HsValArg tm
tm) = forall a. HasLoc a => a -> SrcSpan
loc tm
tm
loc (HsTypeArg SrcSpan
_ ty
ty) = forall a. HasLoc a => a -> SrcSpan
loc ty
ty
loc (HsArgPar SrcSpan
sp) = SrcSpan
sp
instance HasLoc (HsDataDefn GhcRn) where
loc :: HsDataDefn GhcRn -> SrcSpan
loc def :: HsDataDefn GhcRn
def@(HsDataDefn{}) = forall a. HasLoc a => a -> SrcSpan
loc forall a b. (a -> b) -> a -> b
$ forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons HsDataDefn GhcRn
def
class ToHie a where
toHie :: a -> HieM [HieAST Type]
class HasType a where
getTypeNode :: a -> HieM [HieAST Type]
instance ToHie Void where
toHie :: Void -> HieM [HieAST Type]
toHie Void
v = forall a. Void -> a
absurd Void
v
instance (ToHie a) => ToHie [a] where
toHie :: [a] -> HieM [HieAST Type]
toHie = forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM forall a. ToHie a => a -> HieM [HieAST Type]
toHie
instance (ToHie a) => ToHie (Bag a) where
toHie :: Bag a -> HieM [HieAST Type]
toHie = forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Bag a -> [a]
bagToList
instance (ToHie a) => ToHie (Maybe a) where
toHie :: Maybe a -> HieM [HieAST Type]
toHie = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure []) forall a. ToHie a => a -> HieM [HieAST Type]
toHie
instance ToHie (IEContext (LocatedA ModuleName)) where
toHie :: IEContext (LocatedA ModuleName) -> HieM [HieAST Type]
toHie (IEC IEType
c (L (SrcSpanAnn EpAnn AnnListItem
_ (RealSrcSpan Span
span Maybe BufSpan
_)) ModuleName
mname)) = do
NodeOrigin
org <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [forall a. SourcedNodeInfo a -> Span -> [HieAST a] -> HieAST a
Node (forall a. NodeOrigin -> NodeInfo a -> SourcedNodeInfo a
mkSourcedNodeInfo NodeOrigin
org forall a b. (a -> b) -> a -> b
$ forall a.
Set NodeAnnotation -> [a] -> NodeIdentifiers a -> NodeInfo a
NodeInfo forall a. Set a
S.empty [] NodeIdentifiers Type
idents) Span
span []]
where details :: IdentifierDetails Type
details = forall a. Monoid a => a
mempty{identInfo :: Set ContextInfo
identInfo = forall a. a -> Set a
S.singleton (IEType -> ContextInfo
IEThing IEType
c)}
idents :: NodeIdentifiers Type
idents = forall k a. k -> a -> Map k a
M.singleton (forall a b. a -> Either a b
Left ModuleName
mname) IdentifierDetails Type
details
toHie IEContext (LocatedA ModuleName)
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
instance ToHie (Context (Located a)) => ToHie (Context (LocatedN a)) where
toHie :: Context (LocatedN a) -> HieM [HieAST Type]
toHie (C ContextInfo
c (L SrcSpanAnnN
l a
a)) = forall a. ToHie a => a -> HieM [HieAST Type]
toHie (forall a. ContextInfo -> a -> Context a
C ContextInfo
c (forall l e. l -> e -> GenLocated l e
L (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnN
l) a
a))
instance ToHie (Context (Located a)) => ToHie (Context (LocatedA a)) where
toHie :: Context (LocatedA a) -> HieM [HieAST Type]
toHie (C ContextInfo
c (L SrcSpanAnnA
l a
a)) = forall a. ToHie a => a -> HieM [HieAST Type]
toHie (forall a. ContextInfo -> a -> Context a
C ContextInfo
c (forall l e. l -> e -> GenLocated l e
L (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
l) a
a))
instance ToHie (Context (Located Var)) where
toHie :: Context (Located Id) -> HieM [HieAST Type]
toHie Context (Located Id)
c = case Context (Located Id)
c of
C ContextInfo
context (L (RealSrcSpan Span
span Maybe BufSpan
_) Id
name')
| Id -> Unique
varUnique Id
name' forall a. Eq a => a -> a -> Bool
== TypeIndex -> Unique
mkBuiltinUnique TypeIndex
1 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
| Bool
otherwise -> do
NameEnv Id
m <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets HieState -> NameEnv Id
name_remapping
NodeOrigin
org <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
let name :: Id
name = case forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv NameEnv Id
m (Id -> Name
varName Id
name') of
Just Id
var -> Id
var
Maybe Id
Nothing-> Id
name'
ty :: Type
ty = case Id -> Maybe DataCon
isDataConId_maybe Id
name' of
Maybe DataCon
Nothing -> Id -> Type
varType Id
name'
Just DataCon
dc -> DataCon -> Type
dataConNonlinearType DataCon
dc
forall (f :: * -> *) a. Applicative f => a -> f a
pure
[forall a. SourcedNodeInfo a -> Span -> [HieAST a] -> HieAST a
Node
(forall a. NodeOrigin -> NodeInfo a -> SourcedNodeInfo a
mkSourcedNodeInfo NodeOrigin
org forall a b. (a -> b) -> a -> b
$ forall a.
Set NodeAnnotation -> [a] -> NodeIdentifiers a -> NodeInfo a
NodeInfo forall a. Set a
S.empty [] forall a b. (a -> b) -> a -> b
$
forall k a. k -> a -> Map k a
M.singleton (forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Id -> Name
varName Id
name)
(forall a. Maybe a -> Set ContextInfo -> IdentifierDetails a
IdentifierDetails (forall a. a -> Maybe a
Just Type
ty)
(forall a. a -> Set a
S.singleton ContextInfo
context)))
Span
span
[]]
C (EvidenceVarBind EvVarSource
i Scope
_ Maybe Span
sp) (L SrcSpan
_ Id
name) -> do
Id -> ContextInfo -> HieM ()
addUnlocatedEvBind Id
name (EvVarSource -> Scope -> Maybe Span -> ContextInfo
EvidenceVarBind EvVarSource
i Scope
ModuleScope Maybe Span
sp)
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Context (Located Id)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
instance ToHie (Context (Located Name)) where
toHie :: Context (Located Name) -> HieM [HieAST Type]
toHie Context (Located Name)
c = case Context (Located Name)
c of
C ContextInfo
context (L (RealSrcSpan Span
span Maybe BufSpan
_) Name
name')
| Name -> Unique
nameUnique Name
name' forall a. Eq a => a -> a -> Bool
== TypeIndex -> Unique
mkBuiltinUnique TypeIndex
1 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
| Bool
otherwise -> do
NameEnv Id
m <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets HieState -> NameEnv Id
name_remapping
NodeOrigin
org <- forall (m :: * -> *) r. Monad m => ReaderT r m r
ask
let name :: Name
name = case forall a. NameEnv a -> Name -> Maybe a
lookupNameEnv NameEnv Id
m Name
name' of
Just Id
var -> Id -> Name
varName Id
var
Maybe Id
Nothing -> Name
name'
forall (f :: * -> *) a. Applicative f => a -> f a
pure
[forall a. SourcedNodeInfo a -> Span -> [HieAST a] -> HieAST a
Node
(forall a. NodeOrigin -> NodeInfo a -> SourcedNodeInfo a
mkSourcedNodeInfo NodeOrigin
org forall a b. (a -> b) -> a -> b
$ forall a.
Set NodeAnnotation -> [a] -> NodeIdentifiers a -> NodeInfo a
NodeInfo forall a. Set a
S.empty [] forall a b. (a -> b) -> a -> b
$
forall k a. k -> a -> Map k a
M.singleton (forall a b. b -> Either a b
Right Name
name)
(forall a. Maybe a -> Set ContextInfo -> IdentifierDetails a
IdentifierDetails forall a. Maybe a
Nothing
(forall a. a -> Set a
S.singleton ContextInfo
context)))
Span
span
[]]
Context (Located Name)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
evVarsOfTermList :: EvTerm -> [EvId]
evVarsOfTermList :: EvTerm -> [Id]
evVarsOfTermList (EvExpr EvExpr
e) = InterestingVarFun -> EvExpr -> [Id]
exprSomeFreeVarsList InterestingVarFun
isEvVar EvExpr
e
evVarsOfTermList (EvTypeable Type
_ EvTypeable
ev) =
case EvTypeable
ev of
EvTypeableTyCon TyCon
_ [EvTerm]
e -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap EvTerm -> [Id]
evVarsOfTermList [EvTerm]
e
EvTypeableTyApp EvTerm
e1 EvTerm
e2 -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap EvTerm -> [Id]
evVarsOfTermList [EvTerm
e1,EvTerm
e2]
EvTypeableTrFun EvTerm
e1 EvTerm
e2 EvTerm
e3 -> forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap EvTerm -> [Id]
evVarsOfTermList [EvTerm
e1,EvTerm
e2,EvTerm
e3]
EvTypeableTyLit EvTerm
e -> EvTerm -> [Id]
evVarsOfTermList EvTerm
e
evVarsOfTermList (EvFun{}) = []
instance ToHie (EvBindContext (LocatedA TcEvBinds)) where
toHie :: EvBindContext (GenLocated SrcSpanAnnA TcEvBinds)
-> HieM [HieAST Type]
toHie (EvBindContext Scope
sc Maybe Span
sp (L SrcSpanAnnA
span (EvBinds Bag EvBind
bs)))
= forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM EvBind -> HieM [HieAST Type]
go forall a b. (a -> b) -> a -> b
$ forall a. Bag a -> [a]
bagToList Bag EvBind
bs
where
go :: EvBind -> HieM [HieAST Type]
go EvBind
evbind = do
let evDeps :: [Id]
evDeps = EvTerm -> [Id]
evVarsOfTermList forall a b. (a -> b) -> a -> b
$ EvBind -> EvTerm
eb_rhs EvBind
evbind
depNames :: EvBindDeps
depNames = [Name] -> EvBindDeps
EvBindDeps forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Id -> Name
varName [Id]
evDeps
forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie (forall a. ContextInfo -> a -> Context a
C (EvVarSource -> Scope -> Maybe Span -> ContextInfo
EvidenceVarBind (EvBindDeps -> EvVarSource
EvLetBind EvBindDeps
depNames) (Scope -> Scope -> Scope
combineScopes Scope
sc (forall ann. SrcSpanAnn' ann -> Scope
mkScopeA SrcSpanAnnA
span)) Maybe Span
sp)
(forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
span forall a b. (a -> b) -> a -> b
$ EvBind -> Id
eb_lhs EvBind
evbind))
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. ContextInfo -> a -> Context a
C ContextInfo
EvidenceVarUse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
span) forall a b. (a -> b) -> a -> b
$ [Id]
evDeps
]
toHie EvBindContext (GenLocated SrcSpanAnnA TcEvBinds)
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
instance ToHie (LocatedA HsWrapper) where
toHie :: LocatedA HsWrapper -> HieM [HieAST Type]
toHie (L SrcSpanAnnA
osp HsWrapper
wrap)
= case HsWrapper
wrap of
(WpLet TcEvBinds
bs) -> forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Scope -> Maybe Span -> a -> EvBindContext a
EvBindContext (forall ann. SrcSpanAnn' ann -> Scope
mkScopeA SrcSpanAnnA
osp) (forall ann. SrcSpanAnn' ann -> Maybe Span
getRealSpanA SrcSpanAnnA
osp) (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
osp TcEvBinds
bs)
(WpCompose HsWrapper
a HsWrapper
b) -> forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$
[forall a. ToHie a => a -> HieM [HieAST Type]
toHie (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
osp HsWrapper
a), forall a. ToHie a => a -> HieM [HieAST Type]
toHie (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
osp HsWrapper
b)]
(WpFun HsWrapper
a HsWrapper
b Scaled Type
_ SDoc
_) -> forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$
[forall a. ToHie a => a -> HieM [HieAST Type]
toHie (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
osp HsWrapper
a), forall a. ToHie a => a -> HieM [HieAST Type]
toHie (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
osp HsWrapper
b)]
(WpEvLam Id
a) ->
forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C (EvVarSource -> Scope -> Maybe Span -> ContextInfo
EvidenceVarBind EvVarSource
EvWrapperBind (forall ann. SrcSpanAnn' ann -> Scope
mkScopeA SrcSpanAnnA
osp) (forall ann. SrcSpanAnn' ann -> Maybe Span
getRealSpanA SrcSpanAnnA
osp))
forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
osp Id
a
(WpEvApp EvTerm
a) ->
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ContextInfo -> a -> Context a
C ContextInfo
EvidenceVarUse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
osp) forall a b. (a -> b) -> a -> b
$ EvTerm -> [Id]
evVarsOfTermList EvTerm
a
HsWrapper
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
instance HiePass p => HasType (LocatedA (HsBind (GhcPass p))) where
getTypeNode :: LocatedA (HsBind (GhcPass p)) -> HieM [HieAST Type]
getTypeNode (L SrcSpanAnnA
spn HsBind (GhcPass p)
bind) =
case forall (p :: Pass). HiePass p => HiePassEv p
hiePass @p of
HiePassEv p
HieRn -> forall (m :: * -> *) a b.
(Monad m, Data a) =>
a -> SrcSpan -> ReaderT NodeOrigin m [HieAST b]
makeNode HsBind (GhcPass p)
bind (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
spn)
HiePassEv p
HieTc -> case HsBind (GhcPass p)
bind of
FunBind{fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id = LIdP (GhcPass p)
name} -> forall (m :: * -> *) a.
(Monad m, Data a) =>
a -> SrcSpan -> Type -> ReaderT NodeOrigin m [HieAST Type]
makeTypeNode HsBind (GhcPass p)
bind (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
spn) (Id -> Type
varType forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> e
unLoc LIdP (GhcPass p)
name)
HsBind (GhcPass p)
_ -> forall (m :: * -> *) a b.
(Monad m, Data a) =>
a -> SrcSpan -> ReaderT NodeOrigin m [HieAST b]
makeNode HsBind (GhcPass p)
bind (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
spn)
instance HiePass p => HasType (LocatedA (Pat (GhcPass p))) where
getTypeNode :: LocatedA (Pat (GhcPass p)) -> HieM [HieAST Type]
getTypeNode (L SrcSpanAnnA
spn Pat (GhcPass p)
pat) =
case forall (p :: Pass). HiePass p => HiePassEv p
hiePass @p of
HiePassEv p
HieRn -> forall (m :: * -> *) a ann b.
(Monad m, Data a) =>
a -> SrcSpanAnn' ann -> ReaderT NodeOrigin m [HieAST b]
makeNodeA Pat (GhcPass p)
pat SrcSpanAnnA
spn
HiePassEv p
HieTc -> forall (m :: * -> *) a.
(Monad m, Data a) =>
a -> SrcSpanAnnA -> Type -> ReaderT NodeOrigin m [HieAST Type]
makeTypeNodeA Pat (GhcPass p)
pat SrcSpanAnnA
spn (Pat GhcTc -> Type
hsPatType Pat (GhcPass p)
pat)
instance HiePass p => HasType (LocatedA (HsExpr (GhcPass p))) where
getTypeNode :: LocatedA (HsExpr (GhcPass p)) -> HieM [HieAST Type]
getTypeNode e :: LocatedA (HsExpr (GhcPass p))
e@(L SrcSpanAnnA
spn HsExpr (GhcPass p)
e') =
case forall (p :: Pass). HiePass p => HiePassEv p
hiePass @p of
HiePassEv p
HieRn -> forall (m :: * -> *) a ann b.
(Monad m, Data a) =>
a -> SrcSpanAnn' ann -> ReaderT NodeOrigin m [HieAST b]
makeNodeA HsExpr (GhcPass p)
e' SrcSpanAnnA
spn
HiePassEv p
HieTc ->
let tyOpt :: Maybe Type
tyOpt = case HsExpr (GhcPass p)
e' of
HsUnboundVar (HER IORef EvTerm
_ Type
ty Unique
_) OccName
_ -> forall a. a -> Maybe a
Just Type
ty
HsLit XLitE (GhcPass p)
_ HsLit (GhcPass p)
l -> forall a. a -> Maybe a
Just (forall (p :: Pass). HsLit (GhcPass p) -> Type
hsLitType HsLit (GhcPass p)
l)
HsOverLit XOverLitE (GhcPass p)
_ HsOverLit (GhcPass p)
o -> forall a. a -> Maybe a
Just (HsOverLit GhcTc -> Type
overLitType HsOverLit (GhcPass p)
o)
HsConLikeOut XConLikeOut (GhcPass p)
_ (RealDataCon DataCon
con) -> forall a. a -> Maybe a
Just (DataCon -> Type
dataConNonlinearType DataCon
con)
HsLam XLam (GhcPass p)
_ (MG { mg_ext :: forall p body. MatchGroup p body -> XMG p body
mg_ext = XMG (GhcPass p) (LHsExpr (GhcPass p))
groupTy }) -> forall a. a -> Maybe a
Just (MatchGroupTc -> Type
matchGroupType XMG (GhcPass p) (LHsExpr (GhcPass p))
groupTy)
HsLamCase XLamCase (GhcPass p)
_ (MG { mg_ext :: forall p body. MatchGroup p body -> XMG p body
mg_ext = XMG (GhcPass p) (LHsExpr (GhcPass p))
groupTy }) -> forall a. a -> Maybe a
Just (MatchGroupTc -> Type
matchGroupType XMG (GhcPass p) (LHsExpr (GhcPass p))
groupTy)
HsCase XCase (GhcPass p)
_ LHsExpr (GhcPass p)
_ (MG { mg_ext :: forall p body. MatchGroup p body -> XMG p body
mg_ext = XMG (GhcPass p) (LHsExpr (GhcPass p))
groupTy }) -> forall a. a -> Maybe a
Just (MatchGroupTc -> Type
mg_res_ty XMG (GhcPass p) (LHsExpr (GhcPass p))
groupTy)
ExplicitList XExplicitList (GhcPass p)
ty [LHsExpr (GhcPass p)]
_ -> forall a. a -> Maybe a
Just (Type -> Type
mkListTy XExplicitList (GhcPass p)
ty)
ExplicitSum XExplicitSum (GhcPass p)
ty TypeIndex
_ TypeIndex
_ LHsExpr (GhcPass p)
_ -> forall a. a -> Maybe a
Just ([Type] -> Type
mkSumTy XExplicitSum (GhcPass p)
ty)
HsDo XDo (GhcPass p)
ty HsStmtContext (HsDoRn (GhcPass p))
_ XRec (GhcPass p) [ExprLStmt (GhcPass p)]
_ -> forall a. a -> Maybe a
Just XDo (GhcPass p)
ty
HsMultiIf XMultiIf (GhcPass p)
ty [LGRHS (GhcPass p) (LHsExpr (GhcPass p))]
_ -> forall a. a -> Maybe a
Just XMultiIf (GhcPass p)
ty
HsExpr (GhcPass p)
_ -> forall a. Maybe a
Nothing
in
case Maybe Type
tyOpt of
Just Type
t -> forall (m :: * -> *) a.
(Monad m, Data a) =>
a -> SrcSpanAnnA -> Type -> ReaderT NodeOrigin m [HieAST Type]
makeTypeNodeA HsExpr (GhcPass p)
e' SrcSpanAnnA
spn Type
t
Maybe Type
Nothing
| HsExpr GhcTc -> Bool
skipDesugaring HsExpr (GhcPass p)
e' -> HieM [HieAST Type]
fallback
| Bool
otherwise -> do
(EvExpr
e, Bool
no_errs) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. DsM a -> DsM a
discardWarningsDs forall a b. (a -> b) -> a -> b
$ forall a. DsM a -> DsM (a, Bool)
askNoErrsDs forall a b. (a -> b) -> a -> b
$ LHsExpr GhcTc -> DsM EvExpr
dsLExpr LocatedA (HsExpr (GhcPass p))
e
if Bool
no_errs
then forall (m :: * -> *) a.
(Monad m, Data a) =>
a -> SrcSpanAnnA -> Type -> ReaderT NodeOrigin m [HieAST Type]
makeTypeNodeA HsExpr (GhcPass p)
e' SrcSpanAnnA
spn forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvExpr -> Type
exprType forall a b. (a -> b) -> a -> b
$ EvExpr
e
else HieM [HieAST Type]
fallback
where
fallback :: HieM [HieAST Type]
fallback = forall (m :: * -> *) a ann b.
(Monad m, Data a) =>
a -> SrcSpanAnn' ann -> ReaderT NodeOrigin m [HieAST b]
makeNodeA HsExpr (GhcPass p)
e' SrcSpanAnnA
spn
matchGroupType :: MatchGroupTc -> Type
matchGroupType :: MatchGroupTc -> Type
matchGroupType (MatchGroupTc [Scaled Type]
args Type
res) = [Scaled Type] -> Type -> Type
mkVisFunTys [Scaled Type]
args Type
res
skipDesugaring :: HsExpr GhcTc -> Bool
skipDesugaring :: HsExpr GhcTc -> Bool
skipDesugaring HsExpr GhcTc
e = case HsExpr GhcTc
e of
HsVar{} -> Bool
False
HsConLikeOut{} -> Bool
False
HsRecFld{} -> Bool
False
HsOverLabel{} -> Bool
False
HsIPVar{} -> Bool
False
XExpr (WrapExpr {}) -> Bool
False
XExpr (ExpansionExpr {}) -> Bool
False
HsExpr GhcTc
_ -> Bool
True
data HiePassEv p where
HieRn :: HiePassEv 'Renamed
HieTc :: HiePassEv 'Typechecked
class ( IsPass p
, HiePass (NoGhcTcPass p)
, ModifyState (IdGhcP p)
, Data (GRHS (GhcPass p) (LocatedA (HsExpr (GhcPass p))))
, Data (Match (GhcPass p) (LocatedA (HsExpr (GhcPass p))))
, Data (Match (GhcPass p) (LocatedA (HsCmd (GhcPass p))))
, Data (Stmt (GhcPass p) (LocatedA (HsExpr (GhcPass p))))
, Data (Stmt (GhcPass p) (LocatedA (HsCmd (GhcPass p))))
, Data (HsExpr (GhcPass p))
, Data (HsCmd (GhcPass p))
, Data (AmbiguousFieldOcc (GhcPass p))
, Data (HsCmdTop (GhcPass p))
, Data (GRHS (GhcPass p) (LocatedA (HsCmd (GhcPass p))))
, Data (HsSplice (GhcPass p))
, Data (HsLocalBinds (GhcPass p))
, Data (FieldOcc (GhcPass p))
, Data (HsTupArg (GhcPass p))
, Data (IPBind (GhcPass p))
, ToHie (Context (Located (IdGhcP p)))
, ToHie (RFContext (Located (AmbiguousFieldOcc (GhcPass p))))
, ToHie (RFContext (Located (FieldOcc (GhcPass p))))
, ToHie (TScoped (LHsWcType (GhcPass (NoGhcTcPass p))))
, ToHie (TScoped (LHsSigWcType (GhcPass (NoGhcTcPass p))))
, Anno (IdGhcP p) ~ SrcSpanAnnN
)
=> HiePass p where
hiePass :: HiePassEv p
instance HiePass 'Renamed where
hiePass :: HiePassEv 'Renamed
hiePass = HiePassEv 'Renamed
HieRn
instance HiePass 'Typechecked where
hiePass :: HiePassEv 'Typechecked
hiePass = HiePassEv 'Typechecked
HieTc
instance ToHie (Context (Located NoExtField)) where
toHie :: Context (Located NoExtField) -> HieM [HieAST Type]
toHie Context (Located NoExtField)
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
type AnnoBody p body
= ( Anno (Match (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpanAnnA
, Anno [LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
~ SrcSpanAnnL
, Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
~ SrcSpan
, Anno (StmtLR (GhcPass p) (GhcPass p) (LocatedA (body (GhcPass p)))) ~ SrcSpanAnnA
, Data (body (GhcPass p))
, Data (Match (GhcPass p) (LocatedA (body (GhcPass p))))
, Data (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
, Data (Stmt (GhcPass p) (LocatedA (body (GhcPass p))))
, IsPass p
)
instance HiePass p => ToHie (BindContext (LocatedA (HsBind (GhcPass p)))) where
toHie :: BindContext (LocatedA (HsBind (GhcPass p))) -> HieM [HieAST Type]
toHie (BC BindType
context Scope
scope b :: LocatedA (HsBind (GhcPass p))
b@(L SrcSpanAnnA
span HsBind (GhcPass p)
bind)) =
forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ forall a. HasType a => a -> HieM [HieAST Type]
getTypeNode LocatedA (HsBind (GhcPass p))
b forall a. a -> [a] -> [a]
: case HsBind (GhcPass p)
bind of
FunBind{fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_id = LIdP (GhcPass p)
name, fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches = MatchGroup (GhcPass p) (LHsExpr (GhcPass p))
matches, fun_ext :: forall idL idR. HsBindLR idL idR -> XFunBind idL idR
fun_ext = XFunBind (GhcPass p) (GhcPass p)
wrap} ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C (BindType -> Scope -> Maybe Span -> ContextInfo
ValBind BindType
context Scope
scope forall a b. (a -> b) -> a -> b
$ forall ann. SrcSpanAnn' ann -> Maybe Span
getRealSpanA SrcSpanAnnA
span) LIdP (GhcPass p)
name
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie MatchGroup (GhcPass p) (LHsExpr (GhcPass p))
matches
, case forall (p :: Pass). HiePass p => HiePassEv p
hiePass @p of
HiePassEv p
HieTc -> forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
span XFunBind (GhcPass p) (GhcPass p)
wrap
HiePassEv p
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
]
PatBind{pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs = LPat (GhcPass p)
lhs, pat_rhs :: forall idL idR. HsBindLR idL idR -> GRHSs idR (LHsExpr idR)
pat_rhs = GRHSs (GhcPass p) (LHsExpr (GhcPass p))
rhs} ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Maybe Span -> Scope -> Scope -> a -> PScoped a
PS (SrcSpan -> Maybe Span
getRealSpan (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
span)) Scope
scope Scope
NoScope LPat (GhcPass p)
lhs
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie GRHSs (GhcPass p) (LHsExpr (GhcPass p))
rhs
]
VarBind{var_rhs :: forall idL idR. HsBindLR idL idR -> LHsExpr idR
var_rhs = LHsExpr (GhcPass p)
expr} ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
expr
]
AbsBinds{ abs_exports :: forall idL idR. HsBindLR idL idR -> [ABExport idL]
abs_exports = [ABExport (GhcPass p)]
xs, abs_binds :: forall idL idR. HsBindLR idL idR -> LHsBinds idL
abs_binds = LHsBinds (GhcPass p)
binds
, abs_ev_binds :: forall idL idR. HsBindLR idL idR -> [TcEvBinds]
abs_ev_binds = [TcEvBinds]
ev_binds
, abs_ev_vars :: forall idL idR. HsBindLR idL idR -> [Id]
abs_ev_vars = [Id]
ev_vars } ->
[ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify (forall p.
ModifyState (IdP p) =>
[ABExport p] -> HieState -> HieState
modifyState [ABExport (GhcPass p)]
xs)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
(forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. BindType -> Scope -> a -> BindContext a
BC BindType
context Scope
scope) LHsBinds (GhcPass p)
binds)
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
span forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall p. ABExport p -> HsWrapper
abe_wrap) [ABExport (GhcPass p)]
xs
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (forall a. Scope -> Maybe Span -> a -> EvBindContext a
EvBindContext (forall ann. SrcSpanAnn' ann -> Scope
mkScopeA SrcSpanAnnA
span) (forall ann. SrcSpanAnn' ann -> Maybe Span
getRealSpanA SrcSpanAnnA
span)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
span) [TcEvBinds]
ev_binds
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (forall a. ContextInfo -> a -> Context a
C (EvVarSource -> Scope -> Maybe Span -> ContextInfo
EvidenceVarBind EvVarSource
EvSigBind
(forall ann. SrcSpanAnn' ann -> Scope
mkScopeA SrcSpanAnnA
span)
(forall ann. SrcSpanAnn' ann -> Maybe Span
getRealSpanA SrcSpanAnnA
span))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
span) [Id]
ev_vars
]
PatSynBind XPatSynBind (GhcPass p) (GhcPass p)
_ PatSynBind (GhcPass p) (GhcPass p)
psb ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
span) PatSynBind (GhcPass p) (GhcPass p)
psb
]
instance ( HiePass p
, AnnoBody p body
, ToHie (LocatedA (body (GhcPass p)))
) => ToHie (MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))) where
toHie :: MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
-> HieM [HieAST Type]
toHie MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mg = case MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mg of
MG{ mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = (L SrcSpanAnnL
span [GenLocated
SrcSpanAnnA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
alts) , mg_origin :: forall p body. MatchGroup p body -> Origin
mg_origin = Origin
origin} ->
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
local (Origin -> NodeOrigin -> NodeOrigin
setOrigin Origin
origin) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM
[ forall (m :: * -> *) a.
Monad m =>
SrcSpan -> ReaderT NodeOrigin m [HieAST a]
locOnly (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnL
span)
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie [GenLocated
SrcSpanAnnA (Match (GhcPass p) (LocatedA (body (GhcPass p))))]
alts
]
setOrigin :: Origin -> NodeOrigin -> NodeOrigin
setOrigin :: Origin -> NodeOrigin -> NodeOrigin
setOrigin Origin
FromSource NodeOrigin
_ = NodeOrigin
SourceInfo
setOrigin Origin
Generated NodeOrigin
_ = NodeOrigin
GeneratedInfo
instance HiePass p => ToHie (Located (PatSynBind (GhcPass p) (GhcPass p))) where
toHie :: Located (PatSynBind (GhcPass p) (GhcPass p)) -> HieM [HieAST Type]
toHie (L SrcSpan
sp PatSynBind (GhcPass p) (GhcPass p)
psb) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ case PatSynBind (GhcPass p) (GhcPass p)
psb of
PSB{psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
psb_id=XRec (GhcPass p) (IdP (GhcPass p))
var, psb_args :: forall idL idR. PatSynBind idL idR -> HsPatSynDetails idR
psb_args=HsPatSynDetails (GhcPass p)
dets, psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_def=LPat (GhcPass p)
pat, psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
psb_dir=HsPatSynDir (GhcPass p)
dir} ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C (DeclType -> Maybe Span -> ContextInfo
Decl DeclType
PatSynDec forall a b. (a -> b) -> a -> b
$ SrcSpan -> Maybe Span
getRealSpan SrcSpan
sp) XRec (GhcPass p) (IdP (GhcPass p))
var
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ HsConDetails
Void
(GenLocated SrcSpanAnnN (IdGhcP p))
[RecordPatSynField (GhcPass p)]
-> HsConDetails
Void
(Context (GenLocated SrcSpanAnnN (IdGhcP p)))
[PatSynFieldContext (RecordPatSynField (GhcPass p))]
toBind HsPatSynDetails (GhcPass p)
dets
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Maybe Span -> Scope -> Scope -> a -> PScoped a
PS forall a. Maybe a
Nothing Scope
lhsScope Scope
patScope LPat (GhcPass p)
pat
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie HsPatSynDir (GhcPass p)
dir
]
where
lhsScope :: Scope
lhsScope = Scope -> Scope -> Scope
combineScopes Scope
varScope Scope
detScope
varScope :: Scope
varScope = forall a. LocatedN a -> Scope
mkLScopeN XRec (GhcPass p) (IdP (GhcPass p))
var
patScope :: Scope
patScope = forall ann. SrcSpanAnn' ann -> Scope
mkScopeA forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> l
getLoc LPat (GhcPass p)
pat
detScope :: Scope
detScope = case HsPatSynDetails (GhcPass p)
dets of
(PrefixCon [Void]
_ [XRec (GhcPass p) (IdP (GhcPass p))]
args) -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Scope -> Scope -> Scope
combineScopes Scope
NoScope forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. LocatedN a -> Scope
mkLScopeN [XRec (GhcPass p) (IdP (GhcPass p))]
args
(InfixCon XRec (GhcPass p) (IdP (GhcPass p))
a XRec (GhcPass p) (IdP (GhcPass p))
b) -> Scope -> Scope -> Scope
combineScopes (forall a. LocatedN a -> Scope
mkLScopeN XRec (GhcPass p) (IdP (GhcPass p))
a) (forall a. LocatedN a -> Scope
mkLScopeN XRec (GhcPass p) (IdP (GhcPass p))
b)
(RecCon [RecordPatSynField (GhcPass p)]
r) -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {pass}.
(XRec pass (IdP pass) ~ GenLocated SrcSpanAnnN (IdP pass)) =>
RecordPatSynField pass -> Scope -> Scope
go Scope
NoScope [RecordPatSynField (GhcPass p)]
r
go :: RecordPatSynField pass -> Scope -> Scope
go (RecordPatSynField FieldOcc pass
a XRec pass (IdP pass)
b) Scope
c = Scope -> Scope -> Scope
combineScopes Scope
c
forall a b. (a -> b) -> a -> b
$ Scope -> Scope -> Scope
combineScopes (forall a. LocatedN a -> Scope
mkLScopeN (forall pass. FieldOcc pass -> LocatedN RdrName
rdrNameFieldOcc FieldOcc pass
a)) (forall a. LocatedN a -> Scope
mkLScopeN XRec pass (IdP pass)
b)
detSpan :: Maybe Span
detSpan = case Scope
detScope of
LocalScope Span
a -> forall a. a -> Maybe a
Just Span
a
Scope
_ -> forall a. Maybe a
Nothing
toBind :: HsConDetails
Void
(GenLocated SrcSpanAnnN (IdGhcP p))
[RecordPatSynField (GhcPass p)]
-> HsConDetails
Void
(Context (GenLocated SrcSpanAnnN (IdGhcP p)))
[PatSynFieldContext (RecordPatSynField (GhcPass p))]
toBind (PrefixCon [Void]
ts [GenLocated SrcSpanAnnN (IdGhcP p)]
args) = forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon [Void]
ts forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. ContextInfo -> a -> Context a
C ContextInfo
Use) [GenLocated SrcSpanAnnN (IdGhcP p)]
args
toBind (InfixCon GenLocated SrcSpanAnnN (IdGhcP p)
a GenLocated SrcSpanAnnN (IdGhcP p)
b) = forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
InfixCon (forall a. ContextInfo -> a -> Context a
C ContextInfo
Use GenLocated SrcSpanAnnN (IdGhcP p)
a) (forall a. ContextInfo -> a -> Context a
C ContextInfo
Use GenLocated SrcSpanAnnN (IdGhcP p)
b)
toBind (RecCon [RecordPatSynField (GhcPass p)]
r) = forall tyarg arg rec. rec -> HsConDetails tyarg arg rec
RecCon forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Maybe Span -> a -> PatSynFieldContext a
PSC Maybe Span
detSpan) [RecordPatSynField (GhcPass p)]
r
instance HiePass p => ToHie (HsPatSynDir (GhcPass p)) where
toHie :: HsPatSynDir (GhcPass p) -> HieM [HieAST Type]
toHie HsPatSynDir (GhcPass p)
dir = case HsPatSynDir (GhcPass p)
dir of
ExplicitBidirectional MatchGroup (GhcPass p) (LHsExpr (GhcPass p))
mg -> forall a. ToHie a => a -> HieM [HieAST Type]
toHie MatchGroup (GhcPass p) (LHsExpr (GhcPass p))
mg
HsPatSynDir (GhcPass p)
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
instance ( HiePass p
, Data (body (GhcPass p))
, AnnoBody p body
, ToHie (LocatedA (body (GhcPass p)))
) => ToHie (LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))) where
toHie :: LocatedA (Match (GhcPass p) (LocatedA (body (GhcPass p))))
-> HieM [HieAST Type]
toHie (L SrcSpanAnnA
span Match (GhcPass p) (LocatedA (body (GhcPass p)))
m ) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ HieM [HieAST Type]
node forall a. a -> [a] -> [a]
: case Match (GhcPass p) (LocatedA (body (GhcPass p)))
m of
Match{m_ctxt :: forall p body. Match p body -> HsMatchContext (NoGhcTc p)
m_ctxt=HsMatchContext (NoGhcTc (GhcPass p))
mctx, m_pats :: forall p body. Match p body -> [LPat p]
m_pats = [LPat (GhcPass p)]
pats, m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss = GRHSs (GhcPass p) (LocatedA (body (GhcPass p)))
grhss } ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie HsMatchContext (NoGhcTc (GhcPass p))
mctx
, let rhsScope :: Scope
rhsScope = SrcSpan -> Scope
mkScope forall a b. (a -> b) -> a -> b
$ forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ SrcSpan,
Data (HsLocalBinds (GhcPass p))) =>
GRHSs (GhcPass p) (LocatedA (body (GhcPass p))) -> SrcSpan
grhss_span GRHSs (GhcPass p) (LocatedA (body (GhcPass p)))
grhss
in forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall (p :: Pass).
Maybe Span
-> Scope
-> Scope
-> [LPat (GhcPass p)]
-> [PScoped (LPat (GhcPass p))]
patScopes forall a. Maybe a
Nothing Scope
rhsScope Scope
NoScope [LPat (GhcPass p)]
pats
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie GRHSs (GhcPass p) (LocatedA (body (GhcPass p)))
grhss
]
where
node :: HieM [HieAST Type]
node = case forall (p :: Pass). HiePass p => HiePassEv p
hiePass @p of
HiePassEv p
HieTc -> forall (m :: * -> *) a ann b.
(Monad m, Data a) =>
a -> SrcSpanAnn' ann -> ReaderT NodeOrigin m [HieAST b]
makeNodeA Match (GhcPass p) (LocatedA (body (GhcPass p)))
m SrcSpanAnnA
span
HiePassEv p
HieRn -> forall (m :: * -> *) a ann b.
(Monad m, Data a) =>
a -> SrcSpanAnn' ann -> ReaderT NodeOrigin m [HieAST b]
makeNodeA Match (GhcPass p) (LocatedA (body (GhcPass p)))
m SrcSpanAnnA
span
instance HiePass p => ToHie (HsMatchContext (GhcPass p)) where
toHie :: HsMatchContext (GhcPass p) -> HieM [HieAST Type]
toHie (FunRhs{mc_fun :: forall p. HsMatchContext p -> LIdP p
mc_fun=LIdP (GhcPass p)
name}) = forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C ContextInfo
MatchBind LIdP (GhcPass p)
name
toHie (StmtCtxt HsStmtContext (GhcPass p)
a) = forall a. ToHie a => a -> HieM [HieAST Type]
toHie HsStmtContext (GhcPass p)
a
toHie HsMatchContext (GhcPass p)
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
instance HiePass p => ToHie (HsStmtContext (GhcPass p)) where
toHie :: HsStmtContext (GhcPass p) -> HieM [HieAST Type]
toHie (PatGuard HsMatchContext (GhcPass p)
a) = forall a. ToHie a => a -> HieM [HieAST Type]
toHie HsMatchContext (GhcPass p)
a
toHie (ParStmtCtxt HsStmtContext (GhcPass p)
a) = forall a. ToHie a => a -> HieM [HieAST Type]
toHie HsStmtContext (GhcPass p)
a
toHie (TransStmtCtxt HsStmtContext (GhcPass p)
a) = forall a. ToHie a => a -> HieM [HieAST Type]
toHie HsStmtContext (GhcPass p)
a
toHie HsStmtContext (GhcPass p)
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
instance HiePass p => ToHie (PScoped (LocatedA (Pat (GhcPass p)))) where
toHie :: PScoped (LocatedA (Pat (GhcPass p))) -> HieM [HieAST Type]
toHie (PS Maybe Span
rsp Scope
scope Scope
pscope lpat :: LocatedA (Pat (GhcPass p))
lpat@(L SrcSpanAnnA
ospan Pat (GhcPass p)
opat)) =
forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ forall a. HasType a => a -> HieM [HieAST Type]
getTypeNode LocatedA (Pat (GhcPass p))
lpat forall a. a -> [a] -> [a]
: case Pat (GhcPass p)
opat of
WildPat XWildPat (GhcPass p)
_ ->
[]
VarPat XVarPat (GhcPass p)
_ LIdP (GhcPass p)
lname ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C (Scope -> Scope -> Maybe Span -> ContextInfo
PatternBind Scope
scope Scope
pscope Maybe Span
rsp) LIdP (GhcPass p)
lname
]
LazyPat XLazyPat (GhcPass p)
_ LPat (GhcPass p)
p ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Maybe Span -> Scope -> Scope -> a -> PScoped a
PS Maybe Span
rsp Scope
scope Scope
pscope LPat (GhcPass p)
p
]
AsPat XAsPat (GhcPass p)
_ LIdP (GhcPass p)
lname LPat (GhcPass p)
pat ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C (Scope -> Scope -> Maybe Span -> ContextInfo
PatternBind Scope
scope
(Scope -> Scope -> Scope
combineScopes (forall a e. GenLocated (SrcSpanAnn' a) e -> Scope
mkLScopeA LPat (GhcPass p)
pat) Scope
pscope)
Maybe Span
rsp)
LIdP (GhcPass p)
lname
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Maybe Span -> Scope -> Scope -> a -> PScoped a
PS Maybe Span
rsp Scope
scope Scope
pscope LPat (GhcPass p)
pat
]
ParPat XParPat (GhcPass p)
_ LPat (GhcPass p)
pat ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Maybe Span -> Scope -> Scope -> a -> PScoped a
PS Maybe Span
rsp Scope
scope Scope
pscope LPat (GhcPass p)
pat
]
BangPat XBangPat (GhcPass p)
_ LPat (GhcPass p)
pat ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Maybe Span -> Scope -> Scope -> a -> PScoped a
PS Maybe Span
rsp Scope
scope Scope
pscope LPat (GhcPass p)
pat
]
ListPat XListPat (GhcPass p)
_ [LPat (GhcPass p)]
pats ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall (p :: Pass).
Maybe Span
-> Scope
-> Scope
-> [LPat (GhcPass p)]
-> [PScoped (LPat (GhcPass p))]
patScopes Maybe Span
rsp Scope
scope Scope
pscope [LPat (GhcPass p)]
pats
]
TuplePat XTuplePat (GhcPass p)
_ [LPat (GhcPass p)]
pats Boxity
_ ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall (p :: Pass).
Maybe Span
-> Scope
-> Scope
-> [LPat (GhcPass p)]
-> [PScoped (LPat (GhcPass p))]
patScopes Maybe Span
rsp Scope
scope Scope
pscope [LPat (GhcPass p)]
pats
]
SumPat XSumPat (GhcPass p)
_ LPat (GhcPass p)
pat TypeIndex
_ TypeIndex
_ ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Maybe Span -> Scope -> Scope -> a -> PScoped a
PS Maybe Span
rsp Scope
scope Scope
pscope LPat (GhcPass p)
pat
]
ConPat {pat_con :: forall p. Pat p -> XRec p (ConLikeP p)
pat_con = XRec (GhcPass p) (ConLikeP (GhcPass p))
con, pat_args :: forall p. Pat p -> HsConPatDetails p
pat_args = HsConPatDetails (GhcPass p)
dets, pat_con_ext :: forall p. Pat p -> XConPat p
pat_con_ext = XConPat (GhcPass p)
ext} ->
case forall (p :: Pass). HiePass p => HiePassEv p
hiePass @p of
HiePassEv p
HieTc ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C ContextInfo
Use forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConLike -> Name
conLikeName XRec (GhcPass p) (ConLikeP (GhcPass p))
con
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a.
(a ~ LPat (GhcPass p)) =>
HsConDetails
(HsPatSigType (NoGhcTc (GhcPass p))) a (HsRecFields (GhcPass p) a)
-> HsConDetails
(TScoped (HsPatSigType (NoGhcTc (GhcPass p))))
(PScoped a)
(RContext (HsRecFields (GhcPass p) (PScoped a)))
contextify HsConPatDetails (GhcPass p)
dets
, let ev_binds :: TcEvBinds
ev_binds = ConPatTc -> TcEvBinds
cpt_binds XConPat (GhcPass p)
ext
ev_vars :: [Id]
ev_vars = ConPatTc -> [Id]
cpt_dicts XConPat (GhcPass p)
ext
wrap :: HsWrapper
wrap = ConPatTc -> HsWrapper
cpt_wrap XConPat (GhcPass p)
ext
evscope :: Scope
evscope = forall ann. SrcSpanAnn' ann -> Scope
mkScopeA SrcSpanAnnA
ospan Scope -> Scope -> Scope
`combineScopes` Scope
scope Scope -> Scope -> Scope
`combineScopes` Scope
pscope
in forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Scope -> Maybe Span -> a -> EvBindContext a
EvBindContext Scope
scope Maybe Span
rsp forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
ospan TcEvBinds
ev_binds
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
ospan HsWrapper
wrap
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. ContextInfo -> a -> Context a
C (EvVarSource -> Scope -> Maybe Span -> ContextInfo
EvidenceVarBind EvVarSource
EvPatternBind Scope
evscope Maybe Span
rsp)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
ospan) [Id]
ev_vars
]
]
HiePassEv p
HieRn ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C ContextInfo
Use XRec (GhcPass p) (ConLikeP (GhcPass p))
con
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a.
(a ~ LPat (GhcPass p)) =>
HsConDetails
(HsPatSigType (NoGhcTc (GhcPass p))) a (HsRecFields (GhcPass p) a)
-> HsConDetails
(TScoped (HsPatSigType (NoGhcTc (GhcPass p))))
(PScoped a)
(RContext (HsRecFields (GhcPass p) (PScoped a)))
contextify HsConPatDetails (GhcPass p)
dets
]
ViewPat XViewPat (GhcPass p)
_ LHsExpr (GhcPass p)
expr LPat (GhcPass p)
pat ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
expr
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Maybe Span -> Scope -> Scope -> a -> PScoped a
PS Maybe Span
rsp Scope
scope Scope
pscope LPat (GhcPass p)
pat
]
SplicePat XSplicePat (GhcPass p)
_ HsSplice (GhcPass p)
sp ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
ospan HsSplice (GhcPass p)
sp
]
LitPat XLitPat (GhcPass p)
_ HsLit (GhcPass p)
_ ->
[]
NPat XNPat (GhcPass p)
_ XRec (GhcPass p) (HsOverLit (GhcPass p))
_ Maybe (SyntaxExpr (GhcPass p))
_ SyntaxExpr (GhcPass p)
_ ->
[]
NPlusKPat XNPlusKPat (GhcPass p)
_ LIdP (GhcPass p)
n XRec (GhcPass p) (HsOverLit (GhcPass p))
_ HsOverLit (GhcPass p)
_ SyntaxExpr (GhcPass p)
_ SyntaxExpr (GhcPass p)
_ ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C (Scope -> Scope -> Maybe Span -> ContextInfo
PatternBind Scope
scope Scope
pscope Maybe Span
rsp) LIdP (GhcPass p)
n
]
SigPat XSigPat (GhcPass p)
_ LPat (GhcPass p)
pat HsPatSigType (NoGhcTc (GhcPass p))
sig ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Maybe Span -> Scope -> Scope -> a -> PScoped a
PS Maybe Span
rsp Scope
scope Scope
pscope LPat (GhcPass p)
pat
, case forall (p :: Pass). HiePass p => HiePassEv p
hiePass @p of
HiePassEv p
HieTc ->
let cscope :: Scope
cscope = forall a e. GenLocated (SrcSpanAnn' a) e -> Scope
mkLScopeA LPat (GhcPass p)
pat in
forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. TyVarScope -> a -> TScoped a
TS ([Scope] -> TyVarScope
ResolvedScopes [Scope
cscope, Scope
scope, Scope
pscope])
HsPatSigType (NoGhcTc (GhcPass p))
sig
HiePassEv p
HieRn -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
]
XPat XXPat (GhcPass p)
e ->
case forall (p :: Pass). HiePass p => HiePassEv p
hiePass @p of
HiePassEv p
HieTc ->
let CoPat HsWrapper
wrap Pat GhcTc
pat Type
_ = XXPat (GhcPass p)
e
in [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
ospan HsWrapper
wrap
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Maybe Span -> Scope -> Scope -> a -> PScoped a
PS Maybe Span
rsp Scope
scope Scope
pscope forall a b. (a -> b) -> a -> b
$ (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
ospan Pat GhcTc
pat)
]
where
contextify :: a ~ LPat (GhcPass p) => HsConDetails (HsPatSigType (NoGhcTc (GhcPass p))) a (HsRecFields (GhcPass p) a)
-> HsConDetails (TScoped (HsPatSigType (NoGhcTc (GhcPass p)))) (PScoped a) (RContext (HsRecFields (GhcPass p) (PScoped a)))
contextify :: forall a.
(a ~ LPat (GhcPass p)) =>
HsConDetails
(HsPatSigType (NoGhcTc (GhcPass p))) a (HsRecFields (GhcPass p) a)
-> HsConDetails
(TScoped (HsPatSigType (NoGhcTc (GhcPass p))))
(PScoped a)
(RContext (HsRecFields (GhcPass p) (PScoped a)))
contextify (PrefixCon [HsPatSigType (NoGhcTc (GhcPass p))]
tyargs [a]
args) = forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon (forall (a :: Pass).
Scope
-> Scope
-> [HsPatSigType (GhcPass a)]
-> [TScoped (HsPatSigType (GhcPass a))]
tScopes Scope
scope Scope
argscope [HsPatSigType (NoGhcTc (GhcPass p))]
tyargs) (forall (p :: Pass).
Maybe Span
-> Scope
-> Scope
-> [LPat (GhcPass p)]
-> [PScoped (LPat (GhcPass p))]
patScopes Maybe Span
rsp Scope
scope Scope
pscope [a]
args)
where argscope :: Scope
argscope = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Scope -> Scope -> Scope
combineScopes Scope
NoScope forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a e. GenLocated (SrcSpanAnn' a) e -> Scope
mkLScopeA [a]
args
contextify (InfixCon a
a a
b) = forall tyarg arg rec. arg -> arg -> HsConDetails tyarg arg rec
InfixCon PScoped (LPat (GhcPass p))
a' PScoped (LPat (GhcPass p))
b'
where [PScoped (LPat (GhcPass p))
a', PScoped (LPat (GhcPass p))
b'] = forall (p :: Pass).
Maybe Span
-> Scope
-> Scope
-> [LPat (GhcPass p)]
-> [PScoped (LPat (GhcPass p))]
patScopes Maybe Span
rsp Scope
scope Scope
pscope [a
a,a
b]
contextify (RecCon HsRecFields (GhcPass p) a
r) = forall tyarg arg rec. rec -> HsConDetails tyarg arg rec
RecCon forall a b. (a -> b) -> a -> b
$ forall a. RecFieldContext -> a -> RContext a
RC RecFieldContext
RecFieldMatch forall a b. (a -> b) -> a -> b
$ HsRecFields (GhcPass p) (LocatedA (Pat (GhcPass p)))
-> HsRecFields (GhcPass p) (PScoped (LocatedA (Pat (GhcPass p))))
contextify_rec HsRecFields (GhcPass p) a
r
contextify_rec :: HsRecFields (GhcPass p) (LocatedA (Pat (GhcPass p)))
-> HsRecFields (GhcPass p) (PScoped (LocatedA (Pat (GhcPass p))))
contextify_rec (HsRecFields [LHsRecField (GhcPass p) (LocatedA (Pat (GhcPass p)))]
fds Maybe (Located TypeIndex)
a) = forall p arg.
[LHsRecField p arg]
-> Maybe (Located TypeIndex) -> HsRecFields p arg
HsRecFields (forall a b. (a -> b) -> [a] -> [b]
map forall id a1.
RScoped (LocatedA (HsRecField' id a1))
-> LocatedA (HsRecField' id (PScoped a1))
go [RScoped
(LocatedA
(HsRecField' (FieldOcc (GhcPass p)) (LocatedA (Pat (GhcPass p)))))]
scoped_fds) Maybe (Located TypeIndex)
a
where
go :: RScoped (LocatedA (HsRecField' id a1))
-> LocatedA (HsRecField' id (PScoped a1))
go :: forall id a1.
RScoped (LocatedA (HsRecField' id a1))
-> LocatedA (HsRecField' id (PScoped a1))
go (RS Scope
fscope (L SrcSpanAnnA
spn (HsRecField XHsRecField id
x Located id
lbl a1
pat Bool
pun))) =
forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
spn forall a b. (a -> b) -> a -> b
$ forall id arg.
XHsRecField id -> Located id -> arg -> Bool -> HsRecField' id arg
HsRecField XHsRecField id
x Located id
lbl (forall a. Maybe Span -> Scope -> Scope -> a -> PScoped a
PS Maybe Span
rsp Scope
scope Scope
fscope a1
pat) Bool
pun
scoped_fds :: [RScoped
(LocatedA
(HsRecField' (FieldOcc (GhcPass p)) (LocatedA (Pat (GhcPass p)))))]
scoped_fds = forall a. Scope -> [LocatedA a] -> [RScoped (LocatedA a)]
listScopes Scope
pscope [LHsRecField (GhcPass p) (LocatedA (Pat (GhcPass p)))]
fds
instance ToHie (TScoped (HsPatSigType GhcRn)) where
toHie :: TScoped (HsPatSigType GhcRn) -> HieM [HieAST Type]
toHie (TS TyVarScope
sc (HsPS (HsPSRn [Name]
wcs [Name]
tvs) body :: LHsType GhcRn
body@(L SrcSpanAnnA
span HsType GhcRn
_))) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$
[ forall a. [Context Name] -> HieM [HieAST a]
bindingsOnly forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. ContextInfo -> a -> Context a
C forall a b. (a -> b) -> a -> b
$ Scope -> TyVarScope -> ContextInfo
TyVarBind (forall ann. SrcSpanAnn' ann -> Scope
mkScopeA SrcSpanAnnA
span) TyVarScope
sc) ([Name]
wcsforall a. [a] -> [a] -> [a]
++[Name]
tvs)
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsType GhcRn
body
]
instance ( ToHie (LocatedA (body (GhcPass p)))
, HiePass p
, AnnoBody p body
) => ToHie (GRHSs (GhcPass p) (LocatedA (body (GhcPass p)))) where
toHie :: GRHSs (GhcPass p) (LocatedA (body (GhcPass p)))
-> HieM [HieAST Type]
toHie GRHSs (GhcPass p) (LocatedA (body (GhcPass p)))
grhs = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ case GRHSs (GhcPass p) (LocatedA (body (GhcPass p)))
grhs of
GRHSs XCGRHSs (GhcPass p) (LocatedA (body (GhcPass p)))
_ [LGRHS (GhcPass p) (LocatedA (body (GhcPass p)))]
grhss HsLocalBinds (GhcPass p)
binds ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie [LGRHS (GhcPass p) (LocatedA (body (GhcPass p)))]
grhss
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Scope -> a -> RScoped a
RS (SrcSpan -> Scope
mkScope forall a b. (a -> b) -> a -> b
$ forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ SrcSpan,
Data (HsLocalBinds (GhcPass p))) =>
GRHSs (GhcPass p) (LocatedA (body (GhcPass p))) -> SrcSpan
grhss_span GRHSs (GhcPass p) (LocatedA (body (GhcPass p)))
grhs) HsLocalBinds (GhcPass p)
binds
]
instance ( ToHie (LocatedA (body (GhcPass p)))
, HiePass p
, AnnoBody p body
) => ToHie (Located (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))) where
toHie :: Located (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
-> HieM [HieAST Type]
toHie (L SrcSpan
span GRHS (GhcPass p) (LocatedA (body (GhcPass p)))
g) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ HieM [HieAST Type]
node forall a. a -> [a] -> [a]
: case GRHS (GhcPass p) (LocatedA (body (GhcPass p)))
g of
GRHS XCGRHS (GhcPass p) (LocatedA (body (GhcPass p)))
_ [GuardLStmt (GhcPass p)]
guards LocatedA (body (GhcPass p))
body ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Scope -> [LocatedA a] -> [RScoped (LocatedA a)]
listScopes (forall a e. GenLocated (SrcSpanAnn' a) e -> Scope
mkLScopeA LocatedA (body (GhcPass p))
body) [GuardLStmt (GhcPass p)]
guards
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie LocatedA (body (GhcPass p))
body
]
where
node :: HieM [HieAST Type]
node = case forall (p :: Pass). HiePass p => HiePassEv p
hiePass @p of
HiePassEv p
HieRn -> forall (m :: * -> *) a b.
(Monad m, Data a) =>
a -> SrcSpan -> ReaderT NodeOrigin m [HieAST b]
makeNode GRHS (GhcPass p) (LocatedA (body (GhcPass p)))
g SrcSpan
span
HiePassEv p
HieTc -> forall (m :: * -> *) a b.
(Monad m, Data a) =>
a -> SrcSpan -> ReaderT NodeOrigin m [HieAST b]
makeNode GRHS (GhcPass p) (LocatedA (body (GhcPass p)))
g SrcSpan
span
instance HiePass p => ToHie (LocatedA (HsExpr (GhcPass p))) where
toHie :: LocatedA (HsExpr (GhcPass p)) -> HieM [HieAST Type]
toHie e :: LocatedA (HsExpr (GhcPass p))
e@(L SrcSpanAnnA
mspan HsExpr (GhcPass p)
oexpr) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ forall a. HasType a => a -> HieM [HieAST Type]
getTypeNode LocatedA (HsExpr (GhcPass p))
e forall a. a -> [a] -> [a]
: case HsExpr (GhcPass p)
oexpr of
HsVar XVar (GhcPass p)
_ (L SrcSpanAnnN
_ IdGhcP p
var) ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C ContextInfo
Use (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
mspan IdGhcP p
var)
]
HsUnboundVar XUnboundVar (GhcPass p)
_ OccName
_ -> []
HsConLikeOut XConLikeOut (GhcPass p)
_ ConLike
con ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C ContextInfo
Use forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
mspan forall a b. (a -> b) -> a -> b
$ ConLike -> Name
conLikeName ConLike
con
]
HsRecFld XRecFld (GhcPass p)
_ AmbiguousFieldOcc (GhcPass p)
fld ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. RecFieldContext -> Maybe Span -> a -> RFContext a
RFC RecFieldContext
RecFieldOcc forall a. Maybe a
Nothing (forall l e. l -> e -> GenLocated l e
L (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
mspan) AmbiguousFieldOcc (GhcPass p)
fld)
]
HsOverLabel {} -> []
HsIPVar XIPVar (GhcPass p)
_ HsIPName
_ -> []
HsOverLit XOverLitE (GhcPass p)
_ HsOverLit (GhcPass p)
_ -> []
HsLit XLitE (GhcPass p)
_ HsLit (GhcPass p)
_ -> []
HsLam XLam (GhcPass p)
_ MatchGroup (GhcPass p) (LHsExpr (GhcPass p))
mg ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie MatchGroup (GhcPass p) (LHsExpr (GhcPass p))
mg
]
HsLamCase XLamCase (GhcPass p)
_ MatchGroup (GhcPass p) (LHsExpr (GhcPass p))
mg ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie MatchGroup (GhcPass p) (LHsExpr (GhcPass p))
mg
]
HsApp XApp (GhcPass p)
_ LHsExpr (GhcPass p)
a LHsExpr (GhcPass p)
b ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
a
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
b
]
HsAppType XAppTypeE (GhcPass p)
_ LHsExpr (GhcPass p)
expr LHsWcType (NoGhcTc (GhcPass p))
sig ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
expr
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. TyVarScope -> a -> TScoped a
TS ([Scope] -> TyVarScope
ResolvedScopes []) LHsWcType (NoGhcTc (GhcPass p))
sig
]
OpApp XOpApp (GhcPass p)
_ LHsExpr (GhcPass p)
a LHsExpr (GhcPass p)
b LHsExpr (GhcPass p)
c ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
a
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
b
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
c
]
NegApp XNegApp (GhcPass p)
_ LHsExpr (GhcPass p)
a SyntaxExpr (GhcPass p)
_ ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
a
]
HsPar XPar (GhcPass p)
_ LHsExpr (GhcPass p)
a ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
a
]
SectionL XSectionL (GhcPass p)
_ LHsExpr (GhcPass p)
a LHsExpr (GhcPass p)
b ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
a
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
b
]
SectionR XSectionR (GhcPass p)
_ LHsExpr (GhcPass p)
a LHsExpr (GhcPass p)
b ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
a
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
b
]
ExplicitTuple XExplicitTuple (GhcPass p)
_ [HsTupArg (GhcPass p)]
args Boxity
_ ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie [HsTupArg (GhcPass p)]
args
]
ExplicitSum XExplicitSum (GhcPass p)
_ TypeIndex
_ TypeIndex
_ LHsExpr (GhcPass p)
expr ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
expr
]
HsCase XCase (GhcPass p)
_ LHsExpr (GhcPass p)
expr MatchGroup (GhcPass p) (LHsExpr (GhcPass p))
matches ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
expr
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie MatchGroup (GhcPass p) (LHsExpr (GhcPass p))
matches
]
HsIf XIf (GhcPass p)
_ LHsExpr (GhcPass p)
a LHsExpr (GhcPass p)
b LHsExpr (GhcPass p)
c ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
a
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
b
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
c
]
HsMultiIf XMultiIf (GhcPass p)
_ [LGRHS (GhcPass p) (LHsExpr (GhcPass p))]
grhss ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie [LGRHS (GhcPass p) (LHsExpr (GhcPass p))]
grhss
]
HsLet XLet (GhcPass p)
_ HsLocalBinds (GhcPass p)
binds LHsExpr (GhcPass p)
expr ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Scope -> a -> RScoped a
RS (forall a e. GenLocated (SrcSpanAnn' a) e -> Scope
mkLScopeA LHsExpr (GhcPass p)
expr) HsLocalBinds (GhcPass p)
binds
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
expr
]
HsDo XDo (GhcPass p)
_ HsStmtContext (HsDoRn (GhcPass p))
_ (L SrcSpanAnnL
ispan [LocatedA
(StmtLR (GhcPass p) (GhcPass p) (LocatedA (HsExpr (GhcPass p))))]
stmts) ->
[ forall (m :: * -> *) a.
Monad m =>
SrcSpan -> ReaderT NodeOrigin m [HieAST a]
locOnly (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnL
ispan)
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Scope -> [LocatedA a] -> [RScoped (LocatedA a)]
listScopes Scope
NoScope [LocatedA
(StmtLR (GhcPass p) (GhcPass p) (LocatedA (HsExpr (GhcPass p))))]
stmts
]
ExplicitList XExplicitList (GhcPass p)
_ [LHsExpr (GhcPass p)]
exprs ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie [LHsExpr (GhcPass p)]
exprs
]
RecordCon { rcon_con :: forall p. HsExpr p -> XRec p (ConLikeP p)
rcon_con = XRec (GhcPass p) (ConLikeP (GhcPass p))
con, rcon_flds :: forall p. HsExpr p -> HsRecordBinds p
rcon_flds = HsRecordBinds (GhcPass p)
binds} ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C ContextInfo
Use forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN Name
con_name
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. RecFieldContext -> a -> RContext a
RC RecFieldContext
RecFieldAssign forall a b. (a -> b) -> a -> b
$ HsRecordBinds (GhcPass p)
binds
]
where
con_name :: LocatedN Name
con_name :: GenLocated SrcSpanAnnN Name
con_name = case forall (p :: Pass). HiePass p => HiePassEv p
hiePass @p of
HiePassEv p
HieRn -> XRec (GhcPass p) (ConLikeP (GhcPass p))
con
HiePassEv p
HieTc -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConLike -> Name
conLikeName XRec (GhcPass p) (ConLikeP (GhcPass p))
con
RecordUpd {rupd_expr :: forall p. HsExpr p -> LHsExpr p
rupd_expr = LHsExpr (GhcPass p)
expr, rupd_flds :: forall p. HsExpr p -> Either [LHsRecUpdField p] [LHsRecUpdProj p]
rupd_flds = Left [LHsRecUpdField (GhcPass p)]
upds}->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
expr
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. RecFieldContext -> a -> RContext a
RC RecFieldContext
RecFieldAssign) [LHsRecUpdField (GhcPass p)]
upds
]
RecordUpd {rupd_expr :: forall p. HsExpr p -> LHsExpr p
rupd_expr = LHsExpr (GhcPass p)
expr, rupd_flds :: forall p. HsExpr p -> Either [LHsRecUpdField p] [LHsRecUpdProj p]
rupd_flds = Right [LHsRecUpdProj (GhcPass p)]
_}->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
expr
]
ExprWithTySig XExprWithTySig (GhcPass p)
_ LHsExpr (GhcPass p)
expr LHsSigWcType (NoGhcTc (GhcPass p))
sig ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
expr
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. TyVarScope -> a -> TScoped a
TS ([Scope] -> TyVarScope
ResolvedScopes [forall a e. GenLocated (SrcSpanAnn' a) e -> Scope
mkLScopeA LHsExpr (GhcPass p)
expr]) LHsSigWcType (NoGhcTc (GhcPass p))
sig
]
ArithSeq XArithSeq (GhcPass p)
_ Maybe (SyntaxExpr (GhcPass p))
_ ArithSeqInfo (GhcPass p)
info ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie ArithSeqInfo (GhcPass p)
info
]
HsPragE XPragE (GhcPass p)
_ HsPragE (GhcPass p)
_ LHsExpr (GhcPass p)
expr ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
expr
]
HsProc XProc (GhcPass p)
_ LPat (GhcPass p)
pat LHsCmdTop (GhcPass p)
cmdtop ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Maybe Span -> Scope -> Scope -> a -> PScoped a
PS forall a. Maybe a
Nothing (forall a. Located a -> Scope
mkLScope LHsCmdTop (GhcPass p)
cmdtop) Scope
NoScope LPat (GhcPass p)
pat
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsCmdTop (GhcPass p)
cmdtop
]
HsStatic XStatic (GhcPass p)
_ LHsExpr (GhcPass p)
expr ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
expr
]
HsTick XTick (GhcPass p)
_ CoreTickish
_ LHsExpr (GhcPass p)
expr ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
expr
]
HsBinTick XBinTick (GhcPass p)
_ TypeIndex
_ TypeIndex
_ LHsExpr (GhcPass p)
expr ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
expr
]
HsBracket XBracket (GhcPass p)
_ HsBracket (GhcPass p)
b ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie HsBracket (GhcPass p)
b
]
HsRnBracketOut XRnBracketOut (GhcPass p)
_ HsBracket (HsBracketRn (GhcPass p))
b [PendingRnSplice' (GhcPass p)]
p ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie HsBracket (HsBracketRn (GhcPass p))
b
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie [PendingRnSplice' (GhcPass p)]
p
]
HsTcBracketOut XTcBracketOut (GhcPass p)
_ Maybe QuoteWrapper
_wrap HsBracket (HsBracketRn (GhcPass p))
b [PendingTcSplice' (GhcPass p)]
p ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie HsBracket (HsBracketRn (GhcPass p))
b
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie [PendingTcSplice' (GhcPass p)]
p
]
HsSpliceE XSpliceE (GhcPass p)
_ HsSplice (GhcPass p)
x ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
mspan HsSplice (GhcPass p)
x
]
HsGetField {} -> []
HsProjection {} -> []
XExpr XXExpr (GhcPass p)
x
| GhcPass p
GhcTc <- forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p
, WrapExpr (HsWrap HsWrapper
w HsExpr GhcTc
a) <- XXExpr (GhcPass p)
x
-> [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
mspan HsExpr GhcTc
a
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
mspan HsWrapper
w)
]
| GhcPass p
GhcTc <- forall (p :: Pass). IsPass p => GhcPass p
ghcPass @p
, ExpansionExpr (HsExpanded HsExpr GhcRn
_ HsExpr GhcTc
b) <- XXExpr (GhcPass p)
x
-> [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
mspan HsExpr GhcTc
b)
]
| Bool
otherwise -> []
instance HiePass p => ToHie (HsTupArg (GhcPass p)) where
toHie :: HsTupArg (GhcPass p) -> HieM [HieAST Type]
toHie HsTupArg (GhcPass p)
arg = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ case HsTupArg (GhcPass p)
arg of
Present XPresent (GhcPass p)
_ LHsExpr (GhcPass p)
expr ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
expr
]
Missing XMissing (GhcPass p)
_ -> []
instance ( ToHie (LocatedA (body (GhcPass p)))
, AnnoBody p body
, HiePass p
) => ToHie (RScoped (LocatedA (Stmt (GhcPass p) (LocatedA (body (GhcPass p)))))) where
toHie :: RScoped (LocatedA (Stmt (GhcPass p) (LocatedA (body (GhcPass p)))))
-> HieM [HieAST Type]
toHie (RS Scope
scope (L SrcSpanAnnA
span Stmt (GhcPass p) (LocatedA (body (GhcPass p)))
stmt)) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ HieM [HieAST Type]
node forall a. a -> [a] -> [a]
: case Stmt (GhcPass p) (LocatedA (body (GhcPass p)))
stmt of
LastStmt XLastStmt (GhcPass p) (GhcPass p) (LocatedA (body (GhcPass p)))
_ LocatedA (body (GhcPass p))
body Maybe Bool
_ SyntaxExpr (GhcPass p)
_ ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LocatedA (body (GhcPass p))
body
]
BindStmt XBindStmt (GhcPass p) (GhcPass p) (LocatedA (body (GhcPass p)))
_ LPat (GhcPass p)
pat LocatedA (body (GhcPass p))
body ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Maybe Span -> Scope -> Scope -> a -> PScoped a
PS (SrcSpan -> Maybe Span
getRealSpan forall a b. (a -> b) -> a -> b
$ forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LocatedA (body (GhcPass p))
body) Scope
scope Scope
NoScope LPat (GhcPass p)
pat
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie LocatedA (body (GhcPass p))
body
]
ApplicativeStmt XApplicativeStmt
(GhcPass p) (GhcPass p) (LocatedA (body (GhcPass p)))
_ [(SyntaxExpr (GhcPass p), ApplicativeArg (GhcPass p))]
stmts Maybe (SyntaxExpr (GhcPass p))
_ ->
[ forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Scope -> a -> RScoped a
RS Scope
scope forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(SyntaxExpr (GhcPass p), ApplicativeArg (GhcPass p))]
stmts
]
BodyStmt XBodyStmt (GhcPass p) (GhcPass p) (LocatedA (body (GhcPass p)))
_ LocatedA (body (GhcPass p))
body SyntaxExpr (GhcPass p)
_ SyntaxExpr (GhcPass p)
_ ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LocatedA (body (GhcPass p))
body
]
LetStmt XLetStmt (GhcPass p) (GhcPass p) (LocatedA (body (GhcPass p)))
_ HsLocalBindsLR (GhcPass p) (GhcPass p)
binds ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Scope -> a -> RScoped a
RS Scope
scope HsLocalBindsLR (GhcPass p) (GhcPass p)
binds
]
ParStmt XParStmt (GhcPass p) (GhcPass p) (LocatedA (body (GhcPass p)))
_ [ParStmtBlock (GhcPass p) (GhcPass p)]
parstmts HsExpr (GhcPass p)
_ SyntaxExpr (GhcPass p)
_ ->
[ forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (\(ParStmtBlock XParStmtBlock (GhcPass p) (GhcPass p)
_ [ExprLStmt (GhcPass p)]
stmts [IdP (GhcPass p)]
_ SyntaxExpr (GhcPass p)
_) ->
forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Scope -> [LocatedA a] -> [RScoped (LocatedA a)]
listScopes Scope
NoScope [ExprLStmt (GhcPass p)]
stmts)
[ParStmtBlock (GhcPass p) (GhcPass p)]
parstmts
]
TransStmt {trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_stmts = [ExprLStmt (GhcPass p)]
stmts, trS_using :: forall idL idR body. StmtLR idL idR body -> LHsExpr idR
trS_using = LHsExpr (GhcPass p)
using, trS_by :: forall idL idR body. StmtLR idL idR body -> Maybe (LHsExpr idR)
trS_by = Maybe (LHsExpr (GhcPass p))
by} ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Scope -> [LocatedA a] -> [RScoped (LocatedA a)]
listScopes Scope
scope [ExprLStmt (GhcPass p)]
stmts
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
using
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie Maybe (LHsExpr (GhcPass p))
by
]
RecStmt {recS_stmts :: forall idL idR body.
StmtLR idL idR body -> XRec idR [LStmtLR idL idR body]
recS_stmts = L SrcSpanAnnL
_ [LocatedA (Stmt (GhcPass p) (LocatedA (body (GhcPass p))))]
stmts} ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Scope -> a -> RScoped a
RS forall a b. (a -> b) -> a -> b
$ Scope -> Scope -> Scope
combineScopes Scope
scope (SrcSpan -> Scope
mkScope (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
span))) [LocatedA (Stmt (GhcPass p) (LocatedA (body (GhcPass p))))]
stmts
]
where
node :: HieM [HieAST Type]
node = case forall (p :: Pass). HiePass p => HiePassEv p
hiePass @p of
HiePassEv p
HieTc -> forall (m :: * -> *) a ann b.
(Monad m, Data a) =>
a -> SrcSpanAnn' ann -> ReaderT NodeOrigin m [HieAST b]
makeNodeA Stmt (GhcPass p) (LocatedA (body (GhcPass p)))
stmt SrcSpanAnnA
span
HiePassEv p
HieRn -> forall (m :: * -> *) a ann b.
(Monad m, Data a) =>
a -> SrcSpanAnn' ann -> ReaderT NodeOrigin m [HieAST b]
makeNodeA Stmt (GhcPass p) (LocatedA (body (GhcPass p)))
stmt SrcSpanAnnA
span
instance HiePass p => ToHie (RScoped (HsLocalBinds (GhcPass p))) where
toHie :: RScoped (HsLocalBinds (GhcPass p)) -> HieM [HieAST Type]
toHie (RS Scope
scope HsLocalBinds (GhcPass p)
binds) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
(Monad m, Data a) =>
a -> SrcSpan -> ReaderT NodeOrigin m [HieAST b]
makeNode HsLocalBinds (GhcPass p)
binds (forall (p :: Pass).
Data (HsLocalBinds (GhcPass p)) =>
HsLocalBinds (GhcPass p) -> SrcSpan
spanHsLocaLBinds HsLocalBinds (GhcPass p)
binds) forall a. a -> [a] -> [a]
: case HsLocalBinds (GhcPass p)
binds of
EmptyLocalBinds XEmptyLocalBinds (GhcPass p) (GhcPass p)
_ -> []
HsIPBinds XHsIPBinds (GhcPass p) (GhcPass p)
_ HsIPBinds (GhcPass p)
ipbinds -> case HsIPBinds (GhcPass p)
ipbinds of
IPBinds XIPBinds (GhcPass p)
evbinds [LIPBind (GhcPass p)]
xs -> let sc :: Scope
sc = Scope -> Scope -> Scope
combineScopes Scope
scope forall a b. (a -> b) -> a -> b
$ forall (p :: Pass). HsLocalBinds (GhcPass p) -> Scope
scopeHsLocaLBinds HsLocalBinds (GhcPass p)
binds
sp :: SrcSpanAnnA
sp :: SrcSpanAnnA
sp = forall ann. SrcSpan -> SrcAnn ann
noAnnSrcSpan forall a b. (a -> b) -> a -> b
$ forall (p :: Pass).
Data (HsLocalBinds (GhcPass p)) =>
HsLocalBinds (GhcPass p) -> SrcSpan
spanHsLocaLBinds HsLocalBinds (GhcPass p)
binds in
[
case forall (p :: Pass). HiePass p => HiePassEv p
hiePass @p of
HiePassEv p
HieTc -> forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Scope -> Maybe Span -> a -> EvBindContext a
EvBindContext Scope
sc (SrcSpan -> Maybe Span
getRealSpan forall a b. (a -> b) -> a -> b
$ forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
sp) forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
sp XIPBinds (GhcPass p)
evbinds
HiePassEv p
HieRn -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Scope -> a -> RScoped a
RS Scope
sc) [LIPBind (GhcPass p)]
xs
]
HsValBinds XHsValBinds (GhcPass p) (GhcPass p)
_ HsValBindsLR (GhcPass p) (GhcPass p)
valBinds ->
[
forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Scope -> a -> RScoped a
RS (Scope -> Scope -> Scope
combineScopes Scope
scope (forall (p :: Pass). HsLocalBinds (GhcPass p) -> Scope
scopeHsLocaLBinds HsLocalBinds (GhcPass p)
binds))
HsValBindsLR (GhcPass p) (GhcPass p)
valBinds
]
scopeHsLocaLBinds :: HsLocalBinds (GhcPass p) -> Scope
scopeHsLocaLBinds :: forall (p :: Pass). HsLocalBinds (GhcPass p) -> Scope
scopeHsLocaLBinds (HsValBinds XHsValBinds (GhcPass p) (GhcPass p)
_ (ValBinds XValBinds (GhcPass p) (GhcPass p)
_ LHsBindsLR (GhcPass p) (GhcPass p)
bs [LSig (GhcPass p)]
sigs))
= forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Scope -> Scope -> Scope
combineScopes Scope
NoScope ([Scope]
bsScope forall a. [a] -> [a] -> [a]
++ [Scope]
sigsScope)
where
bsScope :: [Scope]
bsScope :: [Scope]
bsScope = forall a b. (a -> b) -> [a] -> [b]
map (forall ann. SrcSpanAnn' ann -> Scope
mkScopeA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> l
getLoc) forall a b. (a -> b) -> a -> b
$ forall a. Bag a -> [a]
bagToList LHsBindsLR (GhcPass p) (GhcPass p)
bs
sigsScope :: [Scope]
sigsScope :: [Scope]
sigsScope = forall a b. (a -> b) -> [a] -> [b]
map (SrcSpan -> Scope
mkScope forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA) [LSig (GhcPass p)]
sigs
scopeHsLocaLBinds (HsValBinds XHsValBinds (GhcPass p) (GhcPass p)
_ (XValBindsLR (NValBinds [(RecFlag, LHsBindsLR (GhcPass p) (GhcPass p))]
bs [LSig GhcRn]
sigs)))
= forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Scope -> Scope -> Scope
combineScopes Scope
NoScope ([Scope]
bsScope forall a. [a] -> [a] -> [a]
++ [Scope]
sigsScope)
where
bsScope :: [Scope]
bsScope :: [Scope]
bsScope = forall a b. (a -> b) -> [a] -> [b]
map (forall ann. SrcSpanAnn' ann -> Scope
mkScopeA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> l
getLoc) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Bag a -> [a]
bagToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(RecFlag, LHsBindsLR (GhcPass p) (GhcPass p))]
bs
sigsScope :: [Scope]
sigsScope :: [Scope]
sigsScope = forall a b. (a -> b) -> [a] -> [b]
map (SrcSpan -> Scope
mkScope forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA) [LSig GhcRn]
sigs
scopeHsLocaLBinds (HsIPBinds XHsIPBinds (GhcPass p) (GhcPass p)
_ (IPBinds XIPBinds (GhcPass p)
_ [LIPBind (GhcPass p)]
bs))
= forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Scope -> Scope -> Scope
combineScopes Scope
NoScope (forall a b. (a -> b) -> [a] -> [b]
map (forall ann. SrcSpanAnn' ann -> Scope
mkScopeA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> l
getLoc) [LIPBind (GhcPass p)]
bs)
scopeHsLocaLBinds (EmptyLocalBinds XEmptyLocalBinds (GhcPass p) (GhcPass p)
_) = Scope
NoScope
instance HiePass p => ToHie (RScoped (LocatedA (IPBind (GhcPass p)))) where
toHie :: RScoped (LocatedA (IPBind (GhcPass p))) -> HieM [HieAST Type]
toHie (RS Scope
scope (L SrcSpanAnnA
sp IPBind (GhcPass p)
bind)) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a ann b.
(Monad m, Data a) =>
a -> SrcSpanAnn' ann -> ReaderT NodeOrigin m [HieAST b]
makeNodeA IPBind (GhcPass p)
bind SrcSpanAnnA
sp forall a. a -> [a] -> [a]
: case IPBind (GhcPass p)
bind of
IPBind XCIPBind (GhcPass p)
_ (Left XRec (GhcPass p) HsIPName
_) LHsExpr (GhcPass p)
expr -> [forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
expr]
IPBind XCIPBind (GhcPass p)
_ (Right IdP (GhcPass p)
v) LHsExpr (GhcPass p)
expr ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C (EvVarSource -> Scope -> Maybe Span -> ContextInfo
EvidenceVarBind EvVarSource
EvImplicitBind Scope
scope (forall ann. SrcSpanAnn' ann -> Maybe Span
getRealSpanA SrcSpanAnnA
sp))
forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
sp IdP (GhcPass p)
v
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
expr
]
instance HiePass p => ToHie (RScoped (HsValBindsLR (GhcPass p) (GhcPass p))) where
toHie :: RScoped (HsValBindsLR (GhcPass p) (GhcPass p))
-> HieM [HieAST Type]
toHie (RS Scope
sc HsValBindsLR (GhcPass p) (GhcPass p)
v) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ case HsValBindsLR (GhcPass p) (GhcPass p)
v of
ValBinds XValBinds (GhcPass p) (GhcPass p)
_ LHsBindsLR (GhcPass p) (GhcPass p)
binds [LSig (GhcPass p)]
sigs ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. BindType -> Scope -> a -> BindContext a
BC BindType
RegularBind Scope
sc) LHsBindsLR (GhcPass p) (GhcPass p)
binds
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. SigInfo -> a -> SigContext a
SC (SigType -> Maybe Span -> SigInfo
SI SigType
BindSig forall a. Maybe a
Nothing)) [LSig (GhcPass p)]
sigs
]
XValBindsLR XXValBindsLR (GhcPass p) (GhcPass p)
x -> [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Scope -> a -> RScoped a
RS Scope
sc XXValBindsLR (GhcPass p) (GhcPass p)
x ]
instance HiePass p => ToHie (RScoped (NHsValBindsLR (GhcPass p))) where
toHie :: RScoped (NHsValBindsLR (GhcPass p)) -> HieM [HieAST Type]
toHie (RS Scope
sc (NValBinds [(RecFlag, LHsBinds (GhcPass p))]
binds [LSig GhcRn]
sigs)) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a -> b) -> [a] -> [b]
map (forall a. BindType -> Scope -> a -> BindContext a
BC BindType
RegularBind Scope
sc) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Bag a -> [a]
bagToList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(RecFlag, LHsBinds (GhcPass p))]
binds)
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. SigInfo -> a -> SigContext a
SC (SigType -> Maybe Span -> SigInfo
SI SigType
BindSig forall a. Maybe a
Nothing)) [LSig GhcRn]
sigs
]
instance ( ToHie arg , HasLoc arg , Data arg
, HiePass p ) => ToHie (RContext (HsRecFields (GhcPass p) arg)) where
toHie :: RContext (HsRecFields (GhcPass p) arg) -> HieM [HieAST Type]
toHie (RC RecFieldContext
c (HsRecFields [LHsRecField (GhcPass p) arg]
fields Maybe (Located TypeIndex)
_)) = forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. RecFieldContext -> a -> RContext a
RC RecFieldContext
c) [LHsRecField (GhcPass p) arg]
fields
instance ( ToHie (RFContext (Located label))
, ToHie arg, HasLoc arg, Data arg
, Data label
) => ToHie (RContext (LocatedA (HsRecField' label arg))) where
toHie :: RContext (LocatedA (HsRecField' label arg)) -> HieM [HieAST Type]
toHie (RC RecFieldContext
c (L SrcSpanAnnA
span HsRecField' label arg
recfld)) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
(Monad m, Data a) =>
a -> SrcSpan -> ReaderT NodeOrigin m [HieAST b]
makeNode HsRecField' label arg
recfld (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
span) forall a. a -> [a] -> [a]
: case HsRecField' label arg
recfld of
HsRecField XHsRecField label
_ Located label
label arg
expr Bool
_ ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. RecFieldContext -> Maybe Span -> a -> RFContext a
RFC RecFieldContext
c (SrcSpan -> Maybe Span
getRealSpan forall a b. (a -> b) -> a -> b
$ forall a. HasLoc a => a -> SrcSpan
loc arg
expr) Located label
label
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie arg
expr
]
instance ToHie (RFContext (Located (FieldOcc GhcRn))) where
toHie :: RFContext (Located (FieldOcc GhcRn)) -> HieM [HieAST Type]
toHie (RFC RecFieldContext
c Maybe Span
rhs (L SrcSpan
nspan FieldOcc GhcRn
f)) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ case FieldOcc GhcRn
f of
FieldOcc XCFieldOcc GhcRn
name LocatedN RdrName
_ ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C (RecFieldContext -> Maybe Span -> ContextInfo
RecField RecFieldContext
c Maybe Span
rhs) (forall l e. l -> e -> GenLocated l e
L SrcSpan
nspan XCFieldOcc GhcRn
name)
]
instance ToHie (RFContext (Located (FieldOcc GhcTc))) where
toHie :: RFContext (Located (FieldOcc GhcTc)) -> HieM [HieAST Type]
toHie (RFC RecFieldContext
c Maybe Span
rhs (L SrcSpan
nspan FieldOcc GhcTc
f)) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ case FieldOcc GhcTc
f of
FieldOcc XCFieldOcc GhcTc
var LocatedN RdrName
_ ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C (RecFieldContext -> Maybe Span -> ContextInfo
RecField RecFieldContext
c Maybe Span
rhs) (forall l e. l -> e -> GenLocated l e
L SrcSpan
nspan XCFieldOcc GhcTc
var)
]
instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcRn))) where
toHie :: RFContext (Located (AmbiguousFieldOcc GhcRn)) -> HieM [HieAST Type]
toHie (RFC RecFieldContext
c Maybe Span
rhs (L SrcSpan
nspan AmbiguousFieldOcc GhcRn
afo)) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ case AmbiguousFieldOcc GhcRn
afo of
Unambiguous XUnambiguous GhcRn
name LocatedN RdrName
_ ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C (RecFieldContext -> Maybe Span -> ContextInfo
RecField RecFieldContext
c Maybe Span
rhs) forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpan
nspan XUnambiguous GhcRn
name
]
Ambiguous XAmbiguous GhcRn
_name LocatedN RdrName
_ ->
[ ]
instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcTc))) where
toHie :: RFContext (Located (AmbiguousFieldOcc GhcTc)) -> HieM [HieAST Type]
toHie (RFC RecFieldContext
c Maybe Span
rhs (L SrcSpan
nspan AmbiguousFieldOcc GhcTc
afo)) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ case AmbiguousFieldOcc GhcTc
afo of
Unambiguous XUnambiguous GhcTc
var LocatedN RdrName
_ ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C (RecFieldContext -> Maybe Span -> ContextInfo
RecField RecFieldContext
c Maybe Span
rhs) (forall l e. l -> e -> GenLocated l e
L SrcSpan
nspan XUnambiguous GhcTc
var)
]
Ambiguous XAmbiguous GhcTc
var LocatedN RdrName
_ ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C (RecFieldContext -> Maybe Span -> ContextInfo
RecField RecFieldContext
c Maybe Span
rhs) (forall l e. l -> e -> GenLocated l e
L SrcSpan
nspan XAmbiguous GhcTc
var)
]
instance HiePass p => ToHie (RScoped (ApplicativeArg (GhcPass p))) where
toHie :: RScoped (ApplicativeArg (GhcPass p)) -> HieM [HieAST Type]
toHie (RS Scope
sc (ApplicativeArgOne XApplicativeArgOne (GhcPass p)
_ LPat (GhcPass p)
pat LHsExpr (GhcPass p)
expr Bool
_)) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Maybe Span -> Scope -> Scope -> a -> PScoped a
PS forall a. Maybe a
Nothing Scope
sc Scope
NoScope LPat (GhcPass p)
pat
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
expr
]
toHie (RS Scope
sc (ApplicativeArgMany XApplicativeArgMany (GhcPass p)
_ [ExprLStmt (GhcPass p)]
stmts HsExpr (GhcPass p)
_ LPat (GhcPass p)
pat HsStmtContext (ApplicativeArgStmCtxPass (GhcPass p))
_)) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Scope -> [LocatedA a] -> [RScoped (LocatedA a)]
listScopes Scope
NoScope [ExprLStmt (GhcPass p)]
stmts
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Maybe Span -> Scope -> Scope -> a -> PScoped a
PS forall a. Maybe a
Nothing Scope
sc Scope
NoScope LPat (GhcPass p)
pat
]
instance (ToHie tyarg, ToHie arg, ToHie rec) => ToHie (HsConDetails tyarg arg rec) where
toHie :: HsConDetails tyarg arg rec -> HieM [HieAST Type]
toHie (PrefixCon [tyarg]
tyargs [arg]
args) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie [tyarg]
tyargs, forall a. ToHie a => a -> HieM [HieAST Type]
toHie [arg]
args ]
toHie (RecCon rec
rec) = forall a. ToHie a => a -> HieM [HieAST Type]
toHie rec
rec
toHie (InfixCon arg
a arg
b) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie arg
a, forall a. ToHie a => a -> HieM [HieAST Type]
toHie arg
b]
instance ToHie (HsConDeclGADTDetails GhcRn) where
toHie :: HsConDeclGADTDetails GhcRn -> HieM [HieAST Type]
toHie (PrefixConGADT [HsScaled GhcRn (LHsType GhcRn)]
args) = forall a. ToHie a => a -> HieM [HieAST Type]
toHie [HsScaled GhcRn (LHsType GhcRn)]
args
toHie (RecConGADT XRec GhcRn [LConDeclField GhcRn]
rec) = forall a. ToHie a => a -> HieM [HieAST Type]
toHie XRec GhcRn [LConDeclField GhcRn]
rec
instance HiePass p => ToHie (Located (HsCmdTop (GhcPass p))) where
toHie :: Located (HsCmdTop (GhcPass p)) -> HieM [HieAST Type]
toHie (L SrcSpan
span HsCmdTop (GhcPass p)
top) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
(Monad m, Data a) =>
a -> SrcSpan -> ReaderT NodeOrigin m [HieAST b]
makeNode HsCmdTop (GhcPass p)
top SrcSpan
span forall a. a -> [a] -> [a]
: case HsCmdTop (GhcPass p)
top of
HsCmdTop XCmdTop (GhcPass p)
_ LHsCmd (GhcPass p)
cmd ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsCmd (GhcPass p)
cmd
]
instance HiePass p => ToHie (LocatedA (HsCmd (GhcPass p))) where
toHie :: LocatedA (HsCmd (GhcPass p)) -> HieM [HieAST Type]
toHie (L SrcSpanAnnA
span HsCmd (GhcPass p)
cmd) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a ann b.
(Monad m, Data a) =>
a -> SrcSpanAnn' ann -> ReaderT NodeOrigin m [HieAST b]
makeNodeA HsCmd (GhcPass p)
cmd SrcSpanAnnA
span forall a. a -> [a] -> [a]
: case HsCmd (GhcPass p)
cmd of
HsCmdArrApp XCmdArrApp (GhcPass p)
_ LHsExpr (GhcPass p)
a LHsExpr (GhcPass p)
b HsArrAppType
_ Bool
_ ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
a
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
b
]
HsCmdArrForm XCmdArrForm (GhcPass p)
_ LHsExpr (GhcPass p)
a LexicalFixity
_ Maybe Fixity
_ [LHsCmdTop (GhcPass p)]
cmdtops ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
a
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie [LHsCmdTop (GhcPass p)]
cmdtops
]
HsCmdApp XCmdApp (GhcPass p)
_ LHsCmd (GhcPass p)
a LHsExpr (GhcPass p)
b ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsCmd (GhcPass p)
a
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
b
]
HsCmdLam XCmdLam (GhcPass p)
_ MatchGroup (GhcPass p) (LHsCmd (GhcPass p))
mg ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie MatchGroup (GhcPass p) (LHsCmd (GhcPass p))
mg
]
HsCmdPar XCmdPar (GhcPass p)
_ LHsCmd (GhcPass p)
a ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsCmd (GhcPass p)
a
]
HsCmdCase XCmdCase (GhcPass p)
_ LHsExpr (GhcPass p)
expr MatchGroup (GhcPass p) (LHsCmd (GhcPass p))
alts ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
expr
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie MatchGroup (GhcPass p) (LHsCmd (GhcPass p))
alts
]
HsCmdLamCase XCmdLamCase (GhcPass p)
_ MatchGroup (GhcPass p) (LHsCmd (GhcPass p))
alts ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie MatchGroup (GhcPass p) (LHsCmd (GhcPass p))
alts
]
HsCmdIf XCmdIf (GhcPass p)
_ SyntaxExpr (GhcPass p)
_ LHsExpr (GhcPass p)
a LHsCmd (GhcPass p)
b LHsCmd (GhcPass p)
c ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
a
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsCmd (GhcPass p)
b
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsCmd (GhcPass p)
c
]
HsCmdLet XCmdLet (GhcPass p)
_ HsLocalBinds (GhcPass p)
binds LHsCmd (GhcPass p)
cmd' ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Scope -> a -> RScoped a
RS (forall a e. GenLocated (SrcSpanAnn' a) e -> Scope
mkLScopeA LHsCmd (GhcPass p)
cmd') HsLocalBinds (GhcPass p)
binds
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsCmd (GhcPass p)
cmd'
]
HsCmdDo XCmdDo (GhcPass p)
_ (L SrcSpanAnnL
ispan [LocatedA
(StmtLR (GhcPass p) (GhcPass p) (LocatedA (HsCmd (GhcPass p))))]
stmts) ->
[ forall (m :: * -> *) a.
Monad m =>
SrcSpan -> ReaderT NodeOrigin m [HieAST a]
locOnly (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnL
ispan)
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Scope -> [LocatedA a] -> [RScoped (LocatedA a)]
listScopes Scope
NoScope [LocatedA
(StmtLR (GhcPass p) (GhcPass p) (LocatedA (HsCmd (GhcPass p))))]
stmts
]
XCmd XXCmd (GhcPass p)
_ -> []
instance ToHie (TyClGroup GhcRn) where
toHie :: TyClGroup GhcRn -> HieM [HieAST Type]
toHie TyClGroup{ group_tyclds :: forall pass. TyClGroup pass -> [LTyClDecl pass]
group_tyclds = [LTyClDecl GhcRn]
classes
, group_roles :: forall pass. TyClGroup pass -> [LRoleAnnotDecl pass]
group_roles = [LRoleAnnotDecl GhcRn]
roles
, group_kisigs :: forall pass. TyClGroup pass -> [LStandaloneKindSig pass]
group_kisigs = [LStandaloneKindSig GhcRn]
sigs
, group_instds :: forall pass. TyClGroup pass -> [LInstDecl pass]
group_instds = [LInstDecl GhcRn]
instances } =
forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie [LTyClDecl GhcRn]
classes
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie [LStandaloneKindSig GhcRn]
sigs
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie [LRoleAnnotDecl GhcRn]
roles
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie [LInstDecl GhcRn]
instances
]
instance ToHie (LocatedA (TyClDecl GhcRn)) where
toHie :: GenLocated SrcSpanAnnA (TyClDecl GhcRn) -> HieM [HieAST Type]
toHie (L SrcSpanAnnA
span TyClDecl GhcRn
decl) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a ann b.
(Monad m, Data a) =>
a -> SrcSpanAnn' ann -> ReaderT NodeOrigin m [HieAST b]
makeNodeA TyClDecl GhcRn
decl SrcSpanAnnA
span forall a. a -> [a] -> [a]
: case TyClDecl GhcRn
decl of
FamDecl {tcdFam :: forall pass. TyClDecl pass -> FamilyDecl pass
tcdFam = FamilyDecl GhcRn
fdecl} ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie ((forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
span FamilyDecl GhcRn
fdecl) :: LFamilyDecl GhcRn)
]
SynDecl {tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = LIdP GhcRn
name, tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars GhcRn
vars, tcdRhs :: forall pass. TyClDecl pass -> LHsType pass
tcdRhs = LHsType GhcRn
typ} ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C (DeclType -> Maybe Span -> ContextInfo
Decl DeclType
SynDec forall a b. (a -> b) -> a -> b
$ forall ann. SrcSpanAnn' ann -> Maybe Span
getRealSpanA SrcSpanAnnA
span) LIdP GhcRn
name
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. TyVarScope -> a -> TScoped a
TS ([Scope] -> TyVarScope
ResolvedScopes [SrcSpan -> Scope
mkScope forall a b. (a -> b) -> a -> b
$ forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LHsType GhcRn
typ]) LHsQTyVars GhcRn
vars
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsType GhcRn
typ
]
DataDecl {tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = LIdP GhcRn
name, tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars GhcRn
vars, tcdDataDefn :: forall pass. TyClDecl pass -> HsDataDefn pass
tcdDataDefn = HsDataDefn GhcRn
defn} ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C (DeclType -> Maybe Span -> ContextInfo
Decl DeclType
DataDec forall a b. (a -> b) -> a -> b
$ forall ann. SrcSpanAnn' ann -> Maybe Span
getRealSpanA SrcSpanAnnA
span) LIdP GhcRn
name
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. TyVarScope -> a -> TScoped a
TS ([Scope] -> TyVarScope
ResolvedScopes [Scope
quant_scope, Scope
rhs_scope]) LHsQTyVars GhcRn
vars
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie HsDataDefn GhcRn
defn
]
where
quant_scope :: Scope
quant_scope = forall a e. GenLocated (SrcSpanAnn' a) e -> Scope
mkLScopeA forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (forall a an. a -> LocatedAn an a
noLocA []) forall a b. (a -> b) -> a -> b
$ forall pass. HsDataDefn pass -> Maybe (LHsContext pass)
dd_ctxt HsDataDefn GhcRn
defn
rhs_scope :: Scope
rhs_scope = Scope
sig_sc Scope -> Scope -> Scope
`combineScopes` Scope
con_sc Scope -> Scope -> Scope
`combineScopes` Scope
deriv_sc
sig_sc :: Scope
sig_sc = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Scope
NoScope forall a e. GenLocated (SrcSpanAnn' a) e -> Scope
mkLScopeA forall a b. (a -> b) -> a -> b
$ forall pass. HsDataDefn pass -> Maybe (LHsKind pass)
dd_kindSig HsDataDefn GhcRn
defn
con_sc :: Scope
con_sc = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Scope -> Scope -> Scope
combineScopes Scope
NoScope forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a e. GenLocated (SrcSpanAnn' a) e -> Scope
mkLScopeA forall a b. (a -> b) -> a -> b
$ forall pass. HsDataDefn pass -> [LConDecl pass]
dd_cons HsDataDefn GhcRn
defn
deriv_sc :: Scope
deriv_sc = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Scope -> Scope -> Scope
combineScopes Scope
NoScope forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Located a -> Scope
mkLScope forall a b. (a -> b) -> a -> b
$ forall pass. HsDataDefn pass -> HsDeriving pass
dd_derivs HsDataDefn GhcRn
defn
ClassDecl { tcdCtxt :: forall pass. TyClDecl pass -> Maybe (LHsContext pass)
tcdCtxt = Maybe (LHsContext GhcRn)
context
, tcdLName :: forall pass. TyClDecl pass -> LIdP pass
tcdLName = LIdP GhcRn
name
, tcdTyVars :: forall pass. TyClDecl pass -> LHsQTyVars pass
tcdTyVars = LHsQTyVars GhcRn
vars
, tcdFDs :: forall pass. TyClDecl pass -> [LHsFunDep pass]
tcdFDs = [LHsFunDep GhcRn]
deps
, tcdSigs :: forall pass. TyClDecl pass -> [LSig pass]
tcdSigs = [LSig GhcRn]
sigs
, tcdMeths :: forall pass. TyClDecl pass -> LHsBinds pass
tcdMeths = LHsBinds GhcRn
meths
, tcdATs :: forall pass. TyClDecl pass -> [LFamilyDecl pass]
tcdATs = [LFamilyDecl GhcRn]
typs
, tcdATDefs :: forall pass. TyClDecl pass -> [LTyFamDefltDecl pass]
tcdATDefs = [LTyFamDefltDecl GhcRn]
deftyps
} ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C (DeclType -> Maybe Span -> ContextInfo
Decl DeclType
ClassDec forall a b. (a -> b) -> a -> b
$ forall ann. SrcSpanAnn' ann -> Maybe Span
getRealSpanA SrcSpanAnnA
span) LIdP GhcRn
name
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie Maybe (LHsContext GhcRn)
context
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. TyVarScope -> a -> TScoped a
TS ([Scope] -> TyVarScope
ResolvedScopes [Scope
context_scope, Scope
rhs_scope]) LHsQTyVars GhcRn
vars
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie [LHsFunDep GhcRn]
deps
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. SigInfo -> a -> SigContext a
SC forall a b. (a -> b) -> a -> b
$ SigType -> Maybe Span -> SigInfo
SI SigType
ClassSig forall a b. (a -> b) -> a -> b
$ forall ann. SrcSpanAnn' ann -> Maybe Span
getRealSpanA SrcSpanAnnA
span) [LSig GhcRn]
sigs
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. BindType -> Scope -> a -> BindContext a
BC BindType
InstanceBind Scope
ModuleScope) LHsBinds GhcRn
meths
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie [LFamilyDecl GhcRn]
typs
, forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (forall (m :: * -> *) a.
Monad m =>
SrcSpan -> ReaderT NodeOrigin m [HieAST a]
locOnly forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA) [LTyFamDefltDecl GhcRn]
deftyps
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie [LTyFamDefltDecl GhcRn]
deftyps
]
where
context_scope :: Scope
context_scope = forall a e. GenLocated (SrcSpanAnn' a) e -> Scope
mkLScopeA forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe (forall a an. a -> LocatedAn an a
noLocA []) Maybe (LHsContext GhcRn)
context
rhs_scope :: Scope
rhs_scope = forall a. (a -> a -> a) -> [a] -> a
foldl1' Scope -> Scope -> Scope
combineScopes forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map SrcSpan -> Scope
mkScope
[ forall a. HasLoc a => a -> SrcSpan
loc [LHsFunDep GhcRn]
deps, forall a. HasLoc a => a -> SrcSpan
loc [LSig GhcRn]
sigs, forall a. HasLoc a => a -> SrcSpan
loc (forall a. Bag a -> [a]
bagToList LHsBinds GhcRn
meths), forall a. HasLoc a => a -> SrcSpan
loc [LFamilyDecl GhcRn]
typs, forall a. HasLoc a => a -> SrcSpan
loc [LTyFamDefltDecl GhcRn]
deftyps]
instance ToHie (LocatedA (FamilyDecl GhcRn)) where
toHie :: GenLocated SrcSpanAnnA (FamilyDecl GhcRn) -> HieM [HieAST Type]
toHie (L SrcSpanAnnA
span FamilyDecl GhcRn
decl) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a ann b.
(Monad m, Data a) =>
a -> SrcSpanAnn' ann -> ReaderT NodeOrigin m [HieAST b]
makeNodeA FamilyDecl GhcRn
decl SrcSpanAnnA
span forall a. a -> [a] -> [a]
: case FamilyDecl GhcRn
decl of
FamilyDecl XCFamilyDecl GhcRn
_ FamilyInfo GhcRn
info TopLevelFlag
_ LIdP GhcRn
name LHsQTyVars GhcRn
vars LexicalFixity
_ LFamilyResultSig GhcRn
sig Maybe (LInjectivityAnn GhcRn)
inj ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C (DeclType -> Maybe Span -> ContextInfo
Decl DeclType
FamDec forall a b. (a -> b) -> a -> b
$ forall ann. SrcSpanAnn' ann -> Maybe Span
getRealSpanA SrcSpanAnnA
span) LIdP GhcRn
name
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. TyVarScope -> a -> TScoped a
TS ([Scope] -> TyVarScope
ResolvedScopes [Scope
rhsSpan]) LHsQTyVars GhcRn
vars
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie FamilyInfo GhcRn
info
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. Scope -> a -> RScoped a
RS Scope
injSpan LFamilyResultSig GhcRn
sig
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie Maybe (LInjectivityAnn GhcRn)
inj
]
where
rhsSpan :: Scope
rhsSpan = Scope
sigSpan Scope -> Scope -> Scope
`combineScopes` Scope
injSpan
sigSpan :: Scope
sigSpan = SrcSpan -> Scope
mkScope forall a b. (a -> b) -> a -> b
$ forall l e. GenLocated l e -> l
getLoc LFamilyResultSig GhcRn
sig
injSpan :: Scope
injSpan = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Scope
NoScope (SrcSpan -> Scope
mkScope forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l e. GenLocated l e -> l
getLoc) Maybe (LInjectivityAnn GhcRn)
inj
instance ToHie (FamilyInfo GhcRn) where
toHie :: FamilyInfo GhcRn -> HieM [HieAST Type]
toHie (ClosedTypeFamily (Just [LTyFamInstEqn GhcRn]
eqns)) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$
[ forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (forall (m :: * -> *) a.
Monad m =>
SrcSpan -> ReaderT NodeOrigin m [HieAST a]
locOnly forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA) [LTyFamInstEqn GhcRn]
eqns
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall {ann} {a}. GenLocated (SrcSpanAnn' ann) a -> TScoped a
go [LTyFamInstEqn GhcRn]
eqns
]
where
go :: GenLocated (SrcSpanAnn' ann) a -> TScoped a
go (L SrcSpanAnn' ann
l a
ib) = forall a. TyVarScope -> a -> TScoped a
TS ([Scope] -> TyVarScope
ResolvedScopes [forall ann. SrcSpanAnn' ann -> Scope
mkScopeA SrcSpanAnn' ann
l]) a
ib
toHie FamilyInfo GhcRn
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
instance ToHie (RScoped (Located (FamilyResultSig GhcRn))) where
toHie :: RScoped (GenLocated SrcSpan (FamilyResultSig GhcRn))
-> HieM [HieAST Type]
toHie (RS Scope
sc (L SrcSpan
span FamilyResultSig GhcRn
sig)) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
(Monad m, Data a) =>
a -> SrcSpan -> ReaderT NodeOrigin m [HieAST b]
makeNode FamilyResultSig GhcRn
sig SrcSpan
span forall a. a -> [a] -> [a]
: case FamilyResultSig GhcRn
sig of
NoSig XNoSig GhcRn
_ ->
[]
KindSig XCKindSig GhcRn
_ LHsType GhcRn
k ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsType GhcRn
k
]
TyVarSig XTyVarSig GhcRn
_ LHsTyVarBndr () GhcRn
bndr ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. TyVarScope -> Scope -> a -> TVScoped a
TVS ([Scope] -> TyVarScope
ResolvedScopes [Scope
sc]) Scope
NoScope LHsTyVarBndr () GhcRn
bndr
]
instance ToHie (LocatedA (FunDep GhcRn)) where
toHie :: GenLocated SrcSpanAnnA (FunDep GhcRn) -> HieM [HieAST Type]
toHie (L SrcSpanAnnA
span fd :: FunDep GhcRn
fd@(FunDep XCFunDep GhcRn
_ [LIdP GhcRn]
lhs [LIdP GhcRn]
rhs)) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$
[ forall (m :: * -> *) a b.
(Monad m, Data a) =>
a -> SrcSpan -> ReaderT NodeOrigin m [HieAST b]
makeNode FunDep GhcRn
fd (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
span)
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. ContextInfo -> a -> Context a
C ContextInfo
Use) [LIdP GhcRn]
lhs
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. ContextInfo -> a -> Context a
C ContextInfo
Use) [LIdP GhcRn]
rhs
]
instance ToHie (TScoped (FamEqn GhcRn (HsDataDefn GhcRn))) where
toHie :: TScoped (FamEqn GhcRn (HsDataDefn GhcRn)) -> HieM [HieAST Type]
toHie (TS TyVarScope
_ FamEqn GhcRn (HsDataDefn GhcRn)
f) = forall a. ToHie a => a -> HieM [HieAST Type]
toHie FamEqn GhcRn (HsDataDefn GhcRn)
f
instance ToHie (TScoped (FamEqn GhcRn (LocatedA (HsType GhcRn)))) where
toHie :: TScoped (FamEqn GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)))
-> HieM [HieAST Type]
toHie (TS TyVarScope
_ FamEqn GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
f) = forall a. ToHie a => a -> HieM [HieAST Type]
toHie FamEqn GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
f
instance (ToHie rhs, HasLoc rhs)
=> ToHie (FamEqn GhcRn rhs) where
toHie :: FamEqn GhcRn rhs -> HieM [HieAST Type]
toHie fe :: FamEqn GhcRn rhs
fe@(FamEqn XCFamEqn GhcRn rhs
_ LIdP GhcRn
var HsOuterFamEqnTyVarBndrs GhcRn
outer_bndrs HsTyPats GhcRn
pats LexicalFixity
_ rhs
rhs) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C (DeclType -> Maybe Span -> ContextInfo
Decl DeclType
InstDec forall a b. (a -> b) -> a -> b
$ SrcSpan -> Maybe Span
getRealSpan forall a b. (a -> b) -> a -> b
$ forall a. HasLoc a => a -> SrcSpan
loc FamEqn GhcRn rhs
fe) LIdP GhcRn
var
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. TyVarScope -> Scope -> a -> TVScoped a
TVS ([Scope] -> TyVarScope
ResolvedScopes []) Scope
scope HsOuterFamEqnTyVarBndrs GhcRn
outer_bndrs
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie HsTyPats GhcRn
pats
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie rhs
rhs
]
where scope :: Scope
scope = Scope -> Scope -> Scope
combineScopes Scope
patsScope Scope
rhsScope
patsScope :: Scope
patsScope = SrcSpan -> Scope
mkScope (forall a. HasLoc a => a -> SrcSpan
loc HsTyPats GhcRn
pats)
rhsScope :: Scope
rhsScope = SrcSpan -> Scope
mkScope (forall a. HasLoc a => a -> SrcSpan
loc rhs
rhs)
instance ToHie (Located (InjectivityAnn GhcRn)) where
toHie :: GenLocated SrcSpan (InjectivityAnn GhcRn) -> HieM [HieAST Type]
toHie (L SrcSpan
span InjectivityAnn GhcRn
ann) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
(Monad m, Data a) =>
a -> SrcSpan -> ReaderT NodeOrigin m [HieAST b]
makeNode InjectivityAnn GhcRn
ann SrcSpan
span forall a. a -> [a] -> [a]
: case InjectivityAnn GhcRn
ann of
InjectivityAnn XCInjectivityAnn GhcRn
_ LIdP GhcRn
lhs [LIdP GhcRn]
rhs ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C ContextInfo
Use LIdP GhcRn
lhs
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. ContextInfo -> a -> Context a
C ContextInfo
Use) [LIdP GhcRn]
rhs
]
instance ToHie (HsDataDefn GhcRn) where
toHie :: HsDataDefn GhcRn -> HieM [HieAST Type]
toHie (HsDataDefn XCHsDataDefn GhcRn
_ NewOrData
_ Maybe (LHsContext GhcRn)
ctx Maybe (XRec GhcRn CType)
_ Maybe (LHsType GhcRn)
mkind [LConDecl GhcRn]
cons HsDeriving GhcRn
derivs) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie Maybe (LHsContext GhcRn)
ctx
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie Maybe (LHsType GhcRn)
mkind
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie [LConDecl GhcRn]
cons
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie HsDeriving GhcRn
derivs
]
instance ToHie (Located [Located (HsDerivingClause GhcRn)]) where
toHie :: Located [GenLocated SrcSpan (HsDerivingClause GhcRn)]
-> HieM [HieAST Type]
toHie (L SrcSpan
span [GenLocated SrcSpan (HsDerivingClause GhcRn)]
clauses) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM
[ forall (m :: * -> *) a.
Monad m =>
SrcSpan -> ReaderT NodeOrigin m [HieAST a]
locOnly SrcSpan
span
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie [GenLocated SrcSpan (HsDerivingClause GhcRn)]
clauses
]
instance ToHie (Located (HsDerivingClause GhcRn)) where
toHie :: GenLocated SrcSpan (HsDerivingClause GhcRn) -> HieM [HieAST Type]
toHie (L SrcSpan
span HsDerivingClause GhcRn
cl) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
(Monad m, Data a) =>
a -> SrcSpan -> ReaderT NodeOrigin m [HieAST b]
makeNode HsDerivingClause GhcRn
cl SrcSpan
span forall a. a -> [a] -> [a]
: case HsDerivingClause GhcRn
cl of
HsDerivingClause XCHsDerivingClause GhcRn
_ Maybe (LDerivStrategy GhcRn)
strat LDerivClauseTys GhcRn
dct ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie Maybe (LDerivStrategy GhcRn)
strat
, forall a. ToHie a => a -> HieM [HieAST Type]
toHie LDerivClauseTys GhcRn
dct
]
instance ToHie (LocatedC (DerivClauseTys GhcRn)) where
toHie :: GenLocated SrcSpanAnnC (DerivClauseTys GhcRn) -> HieM [HieAST Type]
toHie (L SrcSpanAnnC
span DerivClauseTys GhcRn
dct) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a ann b.
(Monad m, Data a) =>
a -> SrcSpanAnn' ann -> ReaderT NodeOrigin m [HieAST b]
makeNodeA DerivClauseTys GhcRn
dct SrcSpanAnnC
span forall a. a -> [a] -> [a]
: case DerivClauseTys GhcRn
dct of
DctSingle XDctSingle GhcRn
_ LHsSigType GhcRn
ty -> [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. TyVarScope -> a -> TScoped a
TS ([Scope] -> TyVarScope
ResolvedScopes []) LHsSigType GhcRn
ty ]
DctMulti XDctMulti GhcRn
_ [LHsSigType GhcRn]
tys -> [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. TyVarScope -> a -> TScoped a
TS ([Scope] -> TyVarScope
ResolvedScopes [])) [LHsSigType GhcRn]
tys ]
instance ToHie (Located (DerivStrategy GhcRn)) where
toHie :: GenLocated SrcSpan (DerivStrategy GhcRn) -> HieM [HieAST Type]
toHie (L SrcSpan
span DerivStrategy GhcRn
strat) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
(Monad m, Data a) =>
a -> SrcSpan -> ReaderT NodeOrigin m [HieAST b]
makeNode DerivStrategy GhcRn
strat SrcSpan
span forall a. a -> [a] -> [a]
: case DerivStrategy GhcRn
strat of
StockStrategy XStockStrategy GhcRn
_ -> []
AnyclassStrategy XAnyClassStrategy GhcRn
_ -> []
NewtypeStrategy XNewtypeStrategy GhcRn
_ -> []
ViaStrategy XViaStrategy GhcRn
s -> [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie (forall a. TyVarScope -> a -> TScoped a
TS ([Scope] -> TyVarScope
ResolvedScopes []) XViaStrategy GhcRn
s) ]
instance ToHie (LocatedP OverlapMode) where
toHie :: LocatedP OverlapMode -> HieM [HieAST Type]
toHie (L SrcSpanAnnP
span OverlapMode
_) = forall (m :: * -> *) a.
Monad m =>
SrcSpan -> ReaderT NodeOrigin m [HieAST a]
locOnly (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnP
span)
instance ToHie a => ToHie (HsScaled GhcRn a) where
toHie :: HsScaled GhcRn a -> HieM [HieAST Type]
toHie (HsScaled HsArrow GhcRn
w a
t) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM [forall a. ToHie a => a -> HieM [HieAST Type]
toHie (HsArrow GhcRn -> LHsType GhcRn
arrowToHsType HsArrow GhcRn
w), forall a. ToHie a => a -> HieM [HieAST Type]
toHie a
t]
instance ToHie (LocatedA (ConDecl GhcRn)) where
toHie :: GenLocated SrcSpanAnnA (ConDecl GhcRn) -> HieM [HieAST Type]
toHie (L SrcSpanAnnA
span ConDecl GhcRn
decl) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
(Monad m, Data a) =>
a -> SrcSpan -> ReaderT NodeOrigin m [HieAST b]
makeNode ConDecl GhcRn
decl (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
span) forall a. a -> [a] -> [a]
: case ConDecl GhcRn
decl of
ConDeclGADT { con_names :: forall pass. ConDecl pass -> [LIdP pass]
con_names = [LIdP GhcRn]
names, con_bndrs :: forall pass. ConDecl pass -> XRec pass (HsOuterSigTyVarBndrs pass)
con_bndrs = L SrcSpanAnnA
outer_bndrs_loc HsOuterSigTyVarBndrs GhcRn
outer_bndrs
, con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt = Maybe (LHsContext GhcRn)
ctx, con_g_args :: forall pass. ConDecl pass -> HsConDeclGADTDetails pass
con_g_args = HsConDeclGADTDetails GhcRn
args, con_res_ty :: forall pass. ConDecl pass -> LHsType pass
con_res_ty = LHsType GhcRn
typ } ->
[ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. ContextInfo -> a -> Context a
C (DeclType -> Maybe Span -> ContextInfo
Decl DeclType
ConDec forall a b. (a -> b) -> a -> b
$ forall ann. SrcSpanAnn' ann -> Maybe Span
getRealSpanA SrcSpanAnnA
span)) [LIdP GhcRn]
names
, case HsOuterSigTyVarBndrs GhcRn
outer_bndrs of
HsOuterImplicit{hso_ximplicit :: forall flag pass.
HsOuterTyVarBndrs flag pass -> XHsOuterImplicit pass
hso_ximplicit = XHsOuterImplicit GhcRn
imp_vars} ->
forall a. [Context Name] -> HieM [HieAST a]
bindingsOnly forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. ContextInfo -> a -> Context a
C forall a b. (a -> b) -> a -> b
$ Scope -> TyVarScope -> ContextInfo
TyVarBind (forall ann. SrcSpanAnn' ann -> Scope
mkScopeA SrcSpanAnnA
outer_bndrs_loc) TyVarScope
resScope)
XHsOuterImplicit GhcRn
imp_vars
HsOuterExplicit{hso_bndrs :: forall flag pass.
HsOuterTyVarBndrs flag pass -> [LHsTyVarBndr flag (NoGhcTc pass)]
hso_bndrs = [LHsTyVarBndr Specificity (NoGhcTc GhcRn)]
exp_bndrs} ->
forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$