{-# 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 #-}

{-
Main functions for .hie file generation
-}

module GHC.Iface.Ext.Ast ( mkHieFile, mkHieFileWithSource, getCompressedAsts, 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.ConLike           ( conLikeName )
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.Hs.Syn.Type
import GHC.Utils.Monad            ( concatMapM, MonadIO(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.Core.Type              ( Type )
import GHC.Core.Predicate
import GHC.Core.InstEnv
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.Panic.Plain
import GHC.Utils.Misc
import GHC.Data.Maybe
import GHC.Data.FastString
import qualified GHC.Data.Strict as Strict

import GHC.Iface.Ext.Types
import GHC.Iface.Ext.Utils

import GHC.Unit.Module            ( 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.Functor.Identity      ( Identity(..) )
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 Control.Applicative        ( (<|>) )

{- Note [Updating HieAst for changes in the GHC AST]
   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
When updating the code in this file for changes in the GHC AST, you
need to pay attention to the following things:

1) Symbols (Names/Vars/Modules) in the following categories:

   a) Symbols that appear in the source file that directly correspond to
   something the user typed
   b) Symbols that don't appear in the source, but should be in some sense
   "visible" to a user, particularly via IDE tooling or the like. This
   includes things like the names introduced by RecordWildcards (We record
   all the names introduced by a (..) in HIE files), and will include implicit
   parameters and evidence variables after one of my pending MRs lands.

2) Subtrees that may contain such symbols, or correspond to a SrcSpan in
   the file. This includes all `Located` things

For 1), you need to call `toHie` for one of the following instances

instance ToHie (Context (Located Name)) where ...
instance ToHie (Context (Located Var)) where ...
instance ToHie (IEContext (Located ModuleName)) where ...

`Context` is a data type that looks like:

data Context a = C ContextInfo a -- Used for names and bindings

`ContextInfo` is defined in `GHC.Iface.Ext.Types`, and looks like

data ContextInfo
  = Use                -- ^ regular variable
  | MatchBind
  | IEThing IEType     -- ^ import/export
  | TyDecl
  -- | Value binding
  | ValBind
      BindType     -- ^ whether or not the binding is in an instance
      Scope        -- ^ scope over which the value is bound
      (Maybe Span) -- ^ span of entire binding
  ...

It is used to annotate symbols in the .hie files with some extra information on
the context in which they occur and should be fairly self explanatory. You need
to select one that looks appropriate for the symbol usage. In very rare cases,
you might need to extend this sum type if none of the cases seem appropriate.

So, given a `Located Name` that is just being "used", and not defined at a
particular location, you would do the following:

   toHie $ C Use located_name

If you select one that corresponds to a binding site, you will need to
provide a `Scope` and a `Span` for your binding. Both of these are basically
`SrcSpans`.

The `SrcSpan` in the `Scope` is supposed to span over the part of the source
where the symbol can be legally allowed to occur. For more details on how to
calculate this, see Note [Capturing Scopes and other non local information]
in GHC.Iface.Ext.Ast.

The binding `Span` is supposed to be the span of the entire binding for
the name.

For a function definition `foo`:

foo x = x + y
  where y = x^2

The binding `Span` is the span of the entire function definition from `foo x`
to `x^2`.  For a class definition, this is the span of the entire class, and
so on.  If this isn't well defined for your bit of syntax (like a variable
bound by a lambda), then you can just supply a `Nothing`

There is a test that checks that all symbols in the resulting HIE file
occur inside their stated `Scope`. This can be turned on by passing the
-fvalidate-ide-info flag to ghc along with -fwrite-ide-info to generate the
.hie file.

You may also want to provide a test in testsuite/test/hiefile that includes
a file containing your new construction, and tests that the calculated scope
is valid (by using -fvalidate-ide-info)

For subtrees in the AST that may contain symbols, the procedure is fairly
straightforward.  If you are extending the GHC AST, you will need to provide a
`ToHie` instance for any new types you may have introduced in the AST.

Here is an extract from the `ToHie` instance for (LHsExpr (GhcPass p)):

  toHie e@(L mspan oexpr) = concatM $ getTypeNode e : case oexpr of
      HsVar _ (L _ var) ->
        [ toHie $ C Use (L mspan var)
             -- Patch up var location since typechecker removes it
        ]
      ...
      HsApp _ a b ->
        [ toHie a
        , toHie b
        ]

If your subtree is `Located` or has a `SrcSpan` available, the output list
should contain a HieAst `Node` corresponding to the subtree. You can use
either `makeNode` or `getTypeNode` for this purpose, depending on whether it
makes sense to assign a `Type` to the subtree. After this, you just need
to concatenate the result of calling `toHie` on all subexpressions and
appropriately annotated symbols contained in the subtree.

The code above from the ToHie instance of `LhsExpr (GhcPass p)` is supposed
to work for both the renamed and typechecked source. `getTypeNode` is from
the `HasType` class defined in this file, and it has different instances
for `GhcTc` and `GhcRn` that allow it to access the type of the expression
when given a typechecked AST:

class Data a => HasType a where
  getTypeNode :: a -> HieM [HieAST Type]
instance HasType (LHsExpr GhcTc) where
  getTypeNode e@(L spn e') = ... -- Actually get the type for this expression
instance HasType (LHsExpr GhcRn) where
  getTypeNode (L spn e) = makeNode e spn -- Fallback to a regular `makeNode` without recording the type

If your subtree doesn't have a span available, you can omit the `makeNode`
call and just recurse directly in to the subexpressions.

-}

-- These synonyms match those defined in compiler/GHC.hs
type RenamedSource     = ( HsGroup GhcRn, [LImportDecl GhcRn]
                         , Maybe [(LIE GhcRn, Avails)]
                         , Maybe (LHsDoc GhcRn) )
type TypecheckedSource = LHsBinds GhcTc


{- Note [Name Remapping]
   ~~~~~~~~~~~~~~~~~~~~~
The Typechecker introduces new names for mono names in AbsBinds.
We don't care about the distinction between mono and poly bindings,
so we replace all occurrences of the mono name with the poly name.
-}
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)
  -- These contain evidence bindings that we don't have a location for
  -- These are placed at the top level Node in the HieAST after everything
  -- else has been generated
  -- This includes things like top level evidence bindings.
  }

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 -- See Note [Name Remapping]
  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 :: [ABExport] -> HieState -> HieState
modifyState :: [ABExport] -> HieState -> HieState
modifyState = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a}. ABExport -> (a -> HieState) -> a -> HieState
go forall a. a -> a
id
  where
    go :: ABExport -> (a -> HieState) -> a -> HieState
go ABE{abe_poly :: ABExport -> Id
abe_poly=Id
poly,abe_mono :: ABExport -> Id
abe_mono=Id
mono} a -> HieState
f
      = forall a. ModifyState a => a -> a -> HieState -> HieState
addSubstitution Id
mono Id
poly forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> HieState
f

type HieM = ReaderT NodeOrigin (State HieState)

-- | Construct an 'HieFile' from the outputs of the typechecker.
mkHieFile :: MonadIO m
          => ModSummary
          -> TcGblEnv
          -> RenamedSource -> m HieFile
mkHieFile :: forall (m :: * -> *).
MonadIO m =>
ModSummary -> TcGblEnv -> RenamedSource -> m 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
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath
-> ByteString -> ModSummary -> TcGblEnv -> RenamedSource -> HieFile
mkHieFileWithSource FilePath
src_file ByteString
src ModSummary
ms TcGblEnv
ts RenamedSource
rs

-- | Construct an 'HieFile' from the outputs of the typechecker but don't
-- read the source file again from disk.
mkHieFileWithSource :: FilePath
                    -> BS.ByteString
                    -> ModSummary
                    -> TcGblEnv
                    -> RenamedSource -> HieFile
mkHieFileWithSource :: FilePath
-> ByteString -> ModSummary -> TcGblEnv -> RenamedSource -> HieFile
mkHieFileWithSource FilePath
src_file ByteString
src ModSummary
ms TcGblEnv
ts RenamedSource
rs =
  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
      (HieASTs TypeIndex
asts',Array TypeIndex HieTypeFlat
arr) = LHsBinds GhcTc
-> RenamedSource
-> Bag EvBind
-> [ClsInst]
-> [TyCon]
-> (HieASTs TypeIndex, Array TypeIndex HieTypeFlat)
getCompressedAsts LHsBinds GhcTc
tc_binds RenamedSource
rs Bag EvBind
top_ev_binds [ClsInst]
insts [TyCon]
tcs in
  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'
      -- mkIfaceExports sorts the AvailInfos for stability
      , 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]
  -> (HieASTs TypeIndex, A.Array TypeIndex HieTypeFlat)
getCompressedAsts :: LHsBinds GhcTc
-> RenamedSource
-> Bag EvBind
-> [ClsInst]
-> [TyCon]
-> (HieASTs TypeIndex, Array TypeIndex HieTypeFlat)
getCompressedAsts LHsBinds GhcTc
ts RenamedSource
rs Bag EvBind
top_ev_binds [ClsInst]
insts [TyCon]
tcs =
  let asts :: HieASTs Type
asts = LHsBinds GhcTc
-> RenamedSource
-> Bag EvBind
-> [ClsInst]
-> [TyCon]
-> HieASTs Type
enrichHie LHsBinds GhcTc
ts RenamedSource
rs Bag EvBind
top_ev_binds [ClsInst]
insts [TyCon]
tcs in
  HieASTs Type -> (HieASTs TypeIndex, Array TypeIndex HieTypeFlat)
compressTypes HieASTs Type
asts

enrichHie :: TypecheckedSource -> RenamedSource -> Bag EvBind -> [ClsInst] -> [TyCon]
  -> HieASTs Type
enrichHie :: LHsBinds GhcTc
-> RenamedSource
-> Bag EvBind
-> [ClsInst]
-> [TyCon]
-> HieASTs Type
enrichHie LHsBinds GhcTc
ts (HsGroup GhcRn
hsGrp, [LImportDecl GhcRn]
imports, Maybe [(LIE GhcRn, [AvailInfo])]
exports, Maybe (LHsDoc GhcRn)
docs) Bag EvBind
ev_bs [ClsInst]
insts [TyCon]
tcs =
  forall a. Identity a -> a
runIdentity forall a b. (a -> b) -> a -> b
$ 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 <- HsGroup GhcRn -> 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
. XImportDeclPass -> Bool
ideclImplicit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass. ImportDecl pass -> XCImportDecl pass
ideclExt 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
    [HieAST Type]
docs <- forall a. ToHie a => a -> HieM [HieAST Type]
toHie Maybe (LHsDoc GhcRn)
docs
    -- Add Instance bindings
    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)
    -- Add class parent bindings
    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
          , [HieAST Type]
docs
          ]

        modulify :: HiePath
-> [HieAST Type]
-> ReaderT NodeOrigin (State HieState) (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
Strict.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 (State HieState) (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

processGrp :: HsGroup GhcRn -> HieM [HieAST Type]
processGrp :: HsGroup GhcRn -> HieM [HieAST Type]
processGrp HsGroup GhcRn
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 GhcRn
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 GhcRn
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 GhcRn
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 GhcRn
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 GhcRn
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 GhcRn
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 GhcRn
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 GhcRn
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 GhcRn
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 GhcRn
grp
      , forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall p. HsGroup p -> [LDocDecl p]
hs_docs HsGroup GhcRn
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)))) ~ SrcAnn NoEpAnns)
           => GRHSs (GhcPass p) (LocatedA (body (GhcPass p))) -> SrcSpan
grhss_span :: forall (p :: Pass) (body :: * -> *).
(Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
 ~ SrcAnn NoEpAnns) =>
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). HsLocalBinds (GhcPass p) -> SrcSpan
spanHsLocaLBinds HsLocalBinds (GhcPass p)
bs) (forall a b. (a -> b) -> [a] -> [b]
map forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA [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

{- Note [Capturing Scopes and other non local information]
   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
toHie is a local transformation, but scopes of bindings cannot be known locally,
hence we have to push the relevant info down into the binding nodes.
We use the following types (*Context and *Scoped) to wrap things and
carry the required info
(Maybe Span) always carries the span of the entire binding, including rhs
-}
data Context a = C ContextInfo a -- Used for names and bindings

data RContext a = RC RecFieldContext a
data RFContext a = RFC RecFieldContext (Maybe Span) a
-- ^ context for record fields

data IEContext a = IEC IEType a
-- ^ context for imports/exports

data BindContext a = BC BindType Scope a
-- ^ context for imports/exports

data PatSynFieldContext a = PSC (Maybe Span) a
-- ^ context for pattern synonym fields.

data SigContext a = SC SigInfo a
-- ^ context for type signatures

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
-- ^ Scope spans over everything to the right of a, (mostly) not
-- including a itself
-- (Includes a in a few special cases like recursive do bindings) or
-- let/where bindings

-- | Pattern scope
data PScoped a = PS (Maybe Span)
                    Scope       -- ^ use site of the pattern
                    Scope       -- ^ pattern to the right of a, not including a
                    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) -- Pattern Scope

{- Note [TyVar Scopes]
   ~~~~~~~~~~~~~~~~~~~
Due to -XScopedTypeVariables, type variables can be in scope quite far from
their original binding. We resolve the scope of these type variables
in a separate pass
-}
data TScoped a = TS TyVarScope a -- TyVarScope

data TVScoped a = TVS TyVarScope Scope a -- TyVarScope
-- ^ First scope remains constant
-- Second scope is used to build up the scope of a tyvar over
-- things to its right, ala RScoped

-- | Each element scopes over the elements to the right
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

-- | 'listScopes' specialised to 'PScoped' things
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

-- | 'listScopes' specialised to 'HsConPatTyArg'
taScopes
  :: Scope
  -> Scope
  -> [HsConPatTyArg (GhcPass a)]
  -> [TScoped (HsPatSigType (GhcPass a))]
taScopes :: forall (a :: Pass).
Scope
-> Scope
-> [HsConPatTyArg (GhcPass a)]
-> [TScoped (HsPatSigType (GhcPass a))]
taScopes Scope
scope Scope
rhsScope [HsConPatTyArg (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 (\(HsConPatTyArg LHsToken "@" (GhcPass a)
_ 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) [HsConPatTyArg (GhcPass a)]
xs)
  -- We make the HsPatSigType into a Located one by using the location of the underlying LHsType.
  -- We then strip off the redundant location information afterward, and take the union of the given scope and those to the right when forming the TS.

-- | 'listScopes' specialised to 'TVScoped' things
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

{- Note [Scoping Rules for SigPat]
   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Explicitly quantified variables in pattern type signatures are not
brought into scope in the rhs, but implicitly quantified variables
are (HsWC and HsIB).
This is unlike other signatures, where explicitly quantified variables
are brought into the RHS Scope
For example
foo :: forall a. ...;
foo = ... -- a is in scope here

bar (x :: forall a. a -> a) = ... -- a is not in scope here
--   ^ a is in scope here (pattern body)

bax (x :: a) = ... -- a is in scope here

This case in handled in the instance for HsPatSigType
-}

class HasLoc a where
  -- ^ conveniently calculate locations for things without locations attached
  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
    -- Only used for data family instances, so we only need rhs
    -- Most probably the rest will be unhelpful anyway

-- | The main worker class
-- See Note [Updating HieAst for changes in the GHC AST] for more information
-- on how to add/modify instances for this.
class ToHie a where
  toHie :: a -> HieM [HieAST Type]

-- | Used to collect type info
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 []
          -- `mkOneRecordSelector` makes a field var using this unique, which we ignore
        | 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 []
          -- `mkOneRecordSelector` makes a field var using this unique, which we ignore
        | 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
_)   -> 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)

-- | This instance tries to construct 'HieAST' nodes which include the type of
-- the expression. It is not yet possible to do this efficiently for all
-- expression forms, so we skip filling in the type for those inputs.
--
-- See Note [Computing the type of every node in the tree]
instance HiePass p => HasType (LocatedA (HsExpr (GhcPass p))) where
  getTypeNode :: LocatedA (HsExpr (GhcPass p)) -> HieM [HieAST Type]
getTypeNode (L SrcSpanAnnA
spn HsExpr (GhcPass p)
e) =
    case forall (p :: Pass). HiePass p => HiePassEv p
hiePass @p of
      HiePassEv p
HieRn -> HieM [HieAST Type]
fallback
      HiePassEv p
HieTc -> case HsExpr GhcTc -> Maybe Type
computeType HsExpr (GhcPass p)
e of
          Just Type
ty -> forall (m :: * -> *) a.
(Monad m, Data a) =>
a -> SrcSpanAnnA -> Type -> ReaderT NodeOrigin m [HieAST Type]
makeTypeNodeA HsExpr (GhcPass p)
e SrcSpanAnnA
spn Type
ty
          Maybe Type
Nothing -> HieM [HieAST Type]
fallback
    where
      fallback :: HieM [HieAST Type]
      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

      -- Skip computing the type of some expressions for performance reasons.
      --
      -- See impact on Haddock output (esp. missing type annotations or links)
      -- before skipping more kinds of expressions. See impact on Haddock
      -- performance before computing the types of more expressions.
      --
      -- See Note [Computing the type of every node in the tree]
      computeType :: HsExpr GhcTc -> Maybe Type
      computeType :: HsExpr GhcTc -> Maybe Type
computeType HsExpr GhcTc
e = case HsExpr GhcTc
e of
        HsApp{} -> forall a. Maybe a
Nothing
        HsAppType{} -> forall a. Maybe a
Nothing
        NegApp{} -> forall a. Maybe a
Nothing
        HsPar XPar GhcTc
_ LHsToken "(" GhcTc
_ LHsExpr GhcTc
e LHsToken ")" GhcTc
_ -> LHsExpr GhcTc -> Maybe Type
computeLType LHsExpr GhcTc
e
        ExplicitTuple{} -> forall a. Maybe a
Nothing
        HsIf XIf GhcTc
_ LHsExpr GhcTc
_ LHsExpr GhcTc
t LHsExpr GhcTc
f -> LHsExpr GhcTc -> Maybe Type
computeLType LHsExpr GhcTc
t forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LHsExpr GhcTc -> Maybe Type
computeLType LHsExpr GhcTc
f
        HsLet XLet GhcTc
_ LHsToken "let" GhcTc
_ HsLocalBinds GhcTc
_ LHsToken "in" GhcTc
_ LHsExpr GhcTc
body -> LHsExpr GhcTc -> Maybe Type
computeLType LHsExpr GhcTc
body
        RecordCon XRecordCon GhcTc
con_expr XRec GhcTc (ConLikeP GhcTc)
_ HsRecordBinds GhcTc
_ -> HsExpr GhcTc -> Maybe Type
computeType XRecordCon GhcTc
con_expr
        ExprWithTySig XExprWithTySig GhcTc
_ LHsExpr GhcTc
e LHsSigWcType (NoGhcTc GhcTc)
_ -> LHsExpr GhcTc -> Maybe Type
computeLType LHsExpr GhcTc
e
        HsPragE XPragE GhcTc
_ HsPragE GhcTc
_ LHsExpr GhcTc
e -> LHsExpr GhcTc -> Maybe Type
computeLType LHsExpr GhcTc
e
        XExpr (ExpansionExpr (HsExpanded (HsGetField XGetField GhcRn
_ LHsExpr GhcRn
_ XRec GhcRn (DotFieldOcc GhcRn)
_) HsExpr GhcTc
e)) -> forall a. a -> Maybe a
Just (HsExpr GhcTc -> Type
hsExprType HsExpr GhcTc
e) -- for record-dot-syntax
        XExpr (ExpansionExpr (HsExpanded HsExpr GhcRn
_ HsExpr GhcTc
e)) -> HsExpr GhcTc -> Maybe Type
computeType HsExpr GhcTc
e
        XExpr (HsTick CoreTickish
_ LHsExpr GhcTc
e) -> LHsExpr GhcTc -> Maybe Type
computeLType LHsExpr GhcTc
e
        XExpr (HsBinTick TypeIndex
_ TypeIndex
_ LHsExpr GhcTc
e) -> LHsExpr GhcTc -> Maybe Type
computeLType LHsExpr GhcTc
e
        HsExpr GhcTc
e -> forall a. a -> Maybe a
Just (HsExpr GhcTc -> Type
hsExprType HsExpr GhcTc
e)

      computeLType :: LHsExpr GhcTc -> Maybe Type
      computeLType :: LHsExpr GhcTc -> Maybe Type
computeLType (L SrcSpanAnnA
_ HsExpr GhcTc
e) = HsExpr GhcTc -> Maybe Type
computeType HsExpr GhcTc
e

{- Note [Computing the type of every node in the tree]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In GHC.Iface.Ext.Ast we decorate every node in the AST with its
type, computed by `hsExprType` applied to that node.  So it's
important that `hsExprType` takes roughly constant time per node.
There are three cases to consider:

1. For many nodes (e.g. HsVar, HsDo, HsCase) it is easy to get their
   type -- e.g. it is stored in the node, or in sub-node thereof.

2. For some nodes (e.g. HsPar, HsTick, HsIf) the type of the node is
   the type of a child, so we can recurse, fast.  We don't expect the
   nesting to be very deep, so while this is theoretically non-linear,
   we don't expect it to be a problem in practice.

3. A very few nodes (e.g. HsApp) are more troublesome because we need to
   take the type of a child, and then do some non-trivial processing.
   To be conservative on computation, we decline to decorate these
   nodes, using `fallback` instead.

The function `computeType e` returns `Just t` if we can find the type
of `e` cheaply, and `Nothing` otherwise.  The base `Nothing` cases
are the troublesome ones in (3) above. Hopefully we can ultimately
get rid of them all.

See #16233

-}

data HiePassEv p where
  HieRn :: HiePassEv 'Renamed
  HieTc :: HiePassEv 'Typechecked

class ( HiePass (NoGhcTcPass p)
      , NoGhcTcPass p ~ 'Renamed
      , 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 (HsUntypedSplice (GhcPass p))
      , Data (HsLocalBinds (GhcPass p))
      , Data (FieldOcc (GhcPass p))
      , Data (HsTupArg (GhcPass p))
      , Data (IPBind (GhcPass p))
      , ToHie (Context (Located (IdGhcP 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))))
                   ~ SrcAnn NoEpAnns
    , 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))))
    )

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)
ext} ->
        [ 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 | (HsWrapper
wrap, [CoreTickish]
_) <- XFunBind (GhcPass p) (GhcPass p)
ext -> 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 HsWrapper
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
        ]
      XHsBindsLR XXHsBindsLR (GhcPass p) (GhcPass p)
ext -> case forall (p :: Pass). HiePass p => HiePassEv p
hiePass @p of
#if __GLASGOW_HASKELL__ < 811
        HieRn -> dataConCantHappen ext
#endif
        HiePassEv p
HieTc
          | AbsBinds{ abs_exports :: AbsBinds -> [ABExport]
abs_exports = [ABExport]
xs, abs_binds :: AbsBinds -> LHsBinds GhcTc
abs_binds = LHsBinds GhcTc
binds
                    , abs_ev_binds :: AbsBinds -> [TcEvBinds]
abs_ev_binds = [TcEvBinds]
ev_binds
                    , abs_ev_vars :: AbsBinds -> [Id]
abs_ev_vars = [Id]
ev_vars } <- XXHsBindsLR (GhcPass p) (GhcPass p)
ext
          ->
            [  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 ([ABExport] -> HieState -> HieState
modifyState [ABExport]
xs)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> -- Note [Name Remapping]
                    (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 GhcTc
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
. ABExport -> HsWrapper
abe_wrap) [ABExport]
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 -- PatSynBinds only occur at the top level
        ]

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) } ->
      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
        ]
    where origin :: Origin
origin = case forall (p :: Pass). HiePass p => HiePassEv p
hiePass @p of
             HiePassEv p
HieRn -> forall p body. MatchGroup p body -> XMG p body
mg_ext MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mg
             HiePassEv p
HieTc -> MatchGroupTc -> Origin
mg_origin forall a b. (a -> b) -> a -> b
$ forall p body. MatchGroup p body -> XMG p body
mg_ext MatchGroup (GhcPass p) (LocatedA (body (GhcPass p)))
mg

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),
 XRec pass RdrName ~ GenLocated SrcSpanAnnN RdrName) =>
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 -> XRec pass RdrName
foLabel 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 a. HasCallStack => Bool -> a -> a
assert (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Void]
ts) forall a b. (a -> b) -> a -> b
$ 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
$ 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 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 p
m_ctxt=HsMatchContext (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 (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))))
 ~ SrcAnn NoEpAnns) =>
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
      ]

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 LocatedN Name
name'
    where
      -- See a paragraph about Haddock in #20415.
      name' :: LocatedN Name
      name' :: LocatedN Name
name' = case forall (p :: Pass). HiePass p => HiePassEv p
hiePass @p of
        HiePassEv p
HieRn -> LIdP (GhcPass p)
name
        HiePassEv p
HieTc -> forall a b l. (a -> b) -> GenLocated l a -> GenLocated l b
mapLoc Id -> Name
varName 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 LHsToken "@" (GhcPass p)
_ 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)
_ LHsToken "(" (GhcPass p)
_ LPat (GhcPass p)
pat LHsToken ")" (GhcPass 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)
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 (HsConPatTyArg GhcRn) a (HsRecFields (GhcPass p) a)
-> HsConDetails
     (TScoped (HsPatSigType GhcRn))
     (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 (HsConPatTyArg GhcRn) a (HsRecFields (GhcPass p) a)
-> HsConDetails
     (TScoped (HsPatSigType GhcRn))
     (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)
_ HsUntypedSplice (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 HsUntypedSplice (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
HieRn -> case XXPat (GhcPass p)
e of
            HsPatExpanded Pat GhcRn
_ Pat GhcRn
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 (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
ospan Pat GhcRn
p) ]
          HiePassEv p
HieTc -> case XXPat (GhcPass p)
e of
            CoPat HsWrapper
wrap Pat GhcTc
pat Type
_ ->
              [ 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)
              ]
            ExpansionPat Pat GhcRn
_ Pat GhcTc
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 (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
ospan Pat GhcTc
p) ]
    where
      contextify :: a ~ LPat (GhcPass p) => HsConDetails (HsConPatTyArg GhcRn) a (HsRecFields (GhcPass p) a)
                 -> HsConDetails (TScoped (HsPatSigType GhcRn)) (PScoped a) (RContext (HsRecFields (GhcPass p) (PScoped a)))
      contextify :: forall a.
(a ~ LPat (GhcPass p)) =>
HsConDetails (HsConPatTyArg GhcRn) a (HsRecFields (GhcPass p) a)
-> HsConDetails
     (TScoped (HsPatSigType GhcRn))
     (PScoped a)
     (RContext (HsRecFields (GhcPass p) (PScoped a)))
contextify (PrefixCon [HsConPatTyArg GhcRn]
tyargs [a]
args) =
        forall tyarg arg rec.
[tyarg] -> [arg] -> HsConDetails tyarg arg rec
PrefixCon (forall (a :: Pass).
Scope
-> Scope
-> [HsConPatTyArg (GhcPass a)]
-> [TScoped (HsPatSigType (GhcPass a))]
taScopes Scope
scope Scope
argscope [HsConPatTyArg GhcRn]
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 (XRec (GhcPass p) RecFieldsDotDot)
a) = forall p arg.
[LHsRecField p arg]
-> Maybe (XRec p RecFieldsDotDot) -> HsRecFields p arg
HsRecFields (forall a b. (a -> b) -> [a] -> [b]
map forall id a1.
RScoped (LocatedA (HsFieldBind id a1))
-> LocatedA (HsFieldBind id (PScoped a1))
go [RScoped
   (LocatedA
      (HsFieldBind
         (XRec (GhcPass p) (FieldOcc (GhcPass p)))
         (LocatedA (Pat (GhcPass p)))))]
scoped_fds) Maybe (XRec (GhcPass p) RecFieldsDotDot)
a
        where
          go :: RScoped (LocatedA (HsFieldBind id a1))
                      -> LocatedA (HsFieldBind id (PScoped a1)) -- AZ
          go :: forall id a1.
RScoped (LocatedA (HsFieldBind id a1))
-> LocatedA (HsFieldBind id (PScoped a1))
go (RS Scope
fscope (L SrcSpanAnnA
spn (HsFieldBind XHsFieldBind id
x 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 lhs rhs.
XHsFieldBind lhs -> lhs -> rhs -> Bool -> HsFieldBind lhs rhs
HsFieldBind XHsFieldBind id
x 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
      (HsFieldBind
         (XRec (GhcPass p) (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
      ]
  -- See Note [Scoping Rules for SigPat]

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))))
 ~ SrcAnn NoEpAnns) =>
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 (LocatedAn NoEpAnns (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))) where
  toHie :: LocatedAn NoEpAnns (GRHS (GhcPass p) (LocatedA (body (GhcPass p))))
-> HieM [HieAST Type]
toHie (L SrcAnn NoEpAnns
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
$ forall (m :: * -> *) a ann b.
(Monad m, Data a) =>
a -> SrcSpanAnn' ann -> ReaderT NodeOrigin m [HieAST b]
makeNodeA GRHS (GhcPass p) (LocatedA (body (GhcPass p)))
g SrcAnn NoEpAnns
span 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
      ]

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)
             -- Patch up var location since typechecker removes it
        ]
      HsUnboundVar XUnboundVar (GhcPass p)
_ OccName
_ -> []  -- there is an unbound name here, but that causes trouble
      HsRecSel XRecSel (GhcPass p)
_ FieldOcc (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 ann. SrcSpanAnn' a -> SrcAnn ann
l2l SrcSpanAnnA
mspan:: SrcAnn NoEpAnns) FieldOcc (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)
_ LamCaseVariant
_ 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 LHsToken "@" (GhcPass p)
_ 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)
_ LHsToken "(" (GhcPass p)
_ LHsExpr (GhcPass p)
a LHsToken ")" (GhcPass p)
_ ->
        [ 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)
_ LHsToken "let" (GhcPass p)
_ HsLocalBinds (GhcPass p)
binds LHsToken "in" (GhcPass p)
_ 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)
_ HsDoFlavour
_ (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
$ LocatedN 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 :: LocatedN Name
con_name = case forall (p :: Pass). HiePass p => HiePassEv p
hiePass @p of       -- Like ConPat
                       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 e. GenLocated (SrcSpanAnn' a) e -> Scope
mkLScopeA 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
        ]
      HsTypedBracket XTypedBracket (GhcPass p)
xbracket LHsExpr (GhcPass p)
b -> case forall (p :: Pass). HiePass p => HiePassEv p
hiePass @p of
        HiePassEv p
HieRn ->
          [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
b
          ]
        HiePassEv p
HieTc | HsBracketTc HsQuote GhcRn
_ Type
_ Maybe QuoteWrapper
_ [PendingTcSplice]
p <- XTypedBracket (GhcPass p)
xbracket ->
          [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
b
          , forall a. ToHie a => a -> HieM [HieAST Type]
toHie [PendingTcSplice]
p
          ]
      HsUntypedBracket XUntypedBracket (GhcPass p)
xbracket HsQuote (GhcPass p)
b -> case forall (p :: Pass). HiePass p => HiePassEv p
hiePass @p of
        HiePassEv p
HieRn ->
            [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie HsQuote (GhcPass p)
b
            , forall a. ToHie a => a -> HieM [HieAST Type]
toHie XUntypedBracket (GhcPass p)
xbracket
            ]
        HiePassEv p
HieTc | HsBracketTc HsQuote GhcRn
q Type
_ Maybe QuoteWrapper
_ [PendingTcSplice]
p <- XUntypedBracket (GhcPass p)
xbracket ->
          [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie HsQuote GhcRn
q
          , forall a. ToHie a => a -> HieM [HieAST Type]
toHie [PendingTcSplice]
p
          ]
      HsTypedSplice XTypedSplice (GhcPass p)
_ LHsExpr (GhcPass p)
x ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
x
        ]
      HsUntypedSplice XUntypedSplice (GhcPass p)
_ HsUntypedSplice (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 HsUntypedSplice (GhcPass p)
x
        ]
      HsGetField {} -> []
      HsProjection {} -> []
      XExpr XXExpr (GhcPass p)
x
        | HiePassEv p
HieTc <- forall (p :: Pass). HiePass p => HiePassEv p
hiePass @p
        -> case XXExpr (GhcPass p)
x of
             WrapExpr (HsWrap HsWrapper
w HsExpr GhcTc
a)
               -> [ 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) ]
             ExpansionExpr (HsExpanded HsExpr GhcRn
_ HsExpr GhcTc
b)
               -> [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnA
mspan HsExpr GhcTc
b) ]
             ConLikeTc ConLike
con [Id]
_ [Scaled Type]
_
               -> [ 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 ]
             HsTick CoreTickish
_ LHsExpr GhcTc
expr
               -> [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr GhcTc
expr
                  ]
             HsBinTick TypeIndex
_ TypeIndex
_ LHsExpr GhcTc
expr
               -> [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr GhcTc
expr
                  ]
        | Bool
otherwise -> []

-- NOTE: no longer have the location
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). 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). 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 bind :: IPBind (GhcPass p)
bind@(IPBind XCIPBind (GhcPass p)
v XRec (GhcPass p) HsIPName
_ LHsExpr (GhcPass p)
expr))) = 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 forall (p :: Pass). HiePass p => HiePassEv p
hiePass @p of
    HiePassEv p
HieRn -> [forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
expr]
    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 (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 XCIPBind (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 (XRec (GhcPass p) RecFieldsDotDot)
_)) = 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 label)
         , ToHie arg, HasLoc arg, Data arg
         , Data label
         ) => ToHie (RContext (LocatedA (HsFieldBind label arg))) where
  toHie :: RContext (LocatedA (HsFieldBind label arg)) -> HieM [HieAST Type]
toHie (RC RecFieldContext
c (L SrcSpanAnnA
span HsFieldBind 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 HsFieldBind label arg
recfld (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
span) forall a. a -> [a] -> [a]
: case HsFieldBind label arg
recfld of
    HsFieldBind XHsFieldBind label
_ 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) label
label
      , forall a. ToHie a => a -> HieM [HieAST Type]
toHie arg
expr
      ]

instance HiePass p => ToHie (RFContext (LocatedAn NoEpAnns (FieldOcc (GhcPass p)))) where
  toHie :: RFContext (LocatedAn NoEpAnns (FieldOcc (GhcPass p)))
-> HieM [HieAST Type]
toHie (RFC RecFieldContext
c Maybe Span
rhs (L SrcAnn NoEpAnns
nspan FieldOcc (GhcPass p)
f)) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ case FieldOcc (GhcPass p)
f of
    FieldOcc XCFieldOcc (GhcPass p)
fld XRec (GhcPass p) RdrName
_ ->
      case forall (p :: Pass). HiePass p => HiePassEv p
hiePass @p of
        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 (RecFieldContext -> Maybe Span -> ContextInfo
RecField RecFieldContext
c Maybe Span
rhs) (forall l e. l -> e -> GenLocated l e
L (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcAnn NoEpAnns
nspan) XCFieldOcc (GhcPass p)
fld)]
        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 (RecFieldContext -> Maybe Span -> ContextInfo
RecField RecFieldContext
c Maybe Span
rhs) (forall l e. l -> e -> GenLocated l e
L (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcAnn NoEpAnns
nspan) XCFieldOcc (GhcPass p)
fld)]

instance HiePass p => ToHie (RFContext (LocatedAn NoEpAnns (AmbiguousFieldOcc (GhcPass p)))) where
  toHie :: RFContext (LocatedAn NoEpAnns (AmbiguousFieldOcc (GhcPass p)))
-> HieM [HieAST Type]
toHie (RFC RecFieldContext
c Maybe Span
rhs (L SrcAnn NoEpAnns
nspan AmbiguousFieldOcc (GhcPass p)
afo)) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ case AmbiguousFieldOcc (GhcPass p)
afo of
    Unambiguous XUnambiguous (GhcPass p)
fld XRec (GhcPass p) RdrName
_ ->
      case forall (p :: Pass). HiePass p => HiePassEv p
hiePass @p of
        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 (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 (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcAnn NoEpAnns
nspan) XUnambiguous (GhcPass p)
fld]
        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 (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 (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcAnn NoEpAnns
nspan) XUnambiguous (GhcPass p)
fld]
    Ambiguous XAmbiguous (GhcPass p)
fld XRec (GhcPass p) RdrName
_ ->
      case forall (p :: Pass). HiePass p => HiePassEv p
hiePass @p of
        HiePassEv p
HieRn -> []
        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 (RecFieldContext -> Maybe Span -> ContextInfo
RecField RecFieldContext
c Maybe Span
rhs) (forall l e. l -> e -> GenLocated l e
L (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcAnn NoEpAnns
nspan) XAmbiguous (GhcPass p)
fld) ]

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 HsDoFlavour
_)) = 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 LHsUniToken "->" "\8594" GhcRn
_) = forall a. ToHie a => a -> HieM [HieAST Type]
toHie XRec GhcRn [LConDeclField GhcRn]
rec

instance HiePass p => ToHie (LocatedAn NoEpAnns (HsCmdTop (GhcPass p))) where
  toHie :: LocatedAn NoEpAnns (HsCmdTop (GhcPass p)) -> HieM [HieAST Type]
toHie (L SrcAnn NoEpAnns
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 ann b.
(Monad m, Data a) =>
a -> SrcSpanAnn' ann -> ReaderT NodeOrigin m [HieAST b]
makeNodeA HsCmdTop (GhcPass p)
top SrcAnn NoEpAnns
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)
_ LHsToken "(" (GhcPass p)
_ LHsCmd (GhcPass p)
a LHsToken ")" (GhcPass p)
_ ->
        [ 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)
_ LamCaseVariant
_ 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)
_ LHsToken "let" (GhcPass p)
_ HsLocalBinds (GhcPass p)
binds LHsToken "in" (GhcPass p)
_ 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 e. GenLocated (SrcSpanAnn' a) e -> Scope
mkLScopeA 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 a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA 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 a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA) 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 (LocatedAn NoEpAnns (FamilyResultSig GhcRn))) where
  toHie :: RScoped (GenLocated (SrcAnn NoEpAnns) (FamilyResultSig GhcRn))
-> HieM [HieAST Type]
toHie (RS Scope
sc (L SrcAnn NoEpAnns
span FamilyResultSig GhcRn
sig)) = 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 FamilyResultSig GhcRn
sig SrcAnn NoEpAnns
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 (LocatedAn NoEpAnns (InjectivityAnn GhcRn)) where
  toHie :: GenLocated (SrcAnn NoEpAnns) (InjectivityAnn GhcRn)
-> HieM [HieAST Type]
toHie (L SrcAnn NoEpAnns
span InjectivityAnn GhcRn
ann) = 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 InjectivityAnn GhcRn
ann SrcAnn NoEpAnns
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 [LocatedAn NoEpAnns (HsDerivingClause GhcRn)]) where
  toHie :: Located [GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcRn)]
-> HieM [HieAST Type]
toHie (L SrcSpan
span [GenLocated (SrcAnn NoEpAnns) (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 (SrcAnn NoEpAnns) (HsDerivingClause GhcRn)]
clauses
    ]

instance ToHie (LocatedAn NoEpAnns (HsDerivingClause GhcRn)) where
  toHie :: GenLocated (SrcAnn NoEpAnns) (HsDerivingClause GhcRn)
-> HieM [HieAST Type]
toHie (L SrcAnn NoEpAnns
span HsDerivingClause GhcRn
cl) = 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 HsDerivingClause GhcRn
cl SrcAnn NoEpAnns
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 (forall a. Scope -> a -> RScoped a
RS (forall a e. GenLocated (SrcSpanAnn' a) e -> Scope
mkLScopeA LDerivClauseTys GhcRn
dct) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (RScoped (LocatedAn NoEpAnns (DerivStrategy GhcRn))) where
  toHie :: RScoped (GenLocated (SrcAnn NoEpAnns) (DerivStrategy GhcRn))
-> HieM [HieAST Type]
toHie (RS Scope
sc (L SrcAnn NoEpAnns
span DerivStrategy GhcRn
strat)) = 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 DerivStrategy GhcRn
strat SrcAnn NoEpAnns
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 [Scope
sc]) 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 HsOuterTyVarBndrs Specificity 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
                  , con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
con_doc = Maybe (LHsDoc GhcRn)
doc} ->
        [ 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 HsOuterTyVarBndrs Specificity 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
$ forall flag (a :: Pass).
TyVarScope
-> Scope
-> [LHsTyVarBndr flag (GhcPass a)]
-> [TVScoped (LHsTyVarBndr flag (GhcPass a))]
tvScopes TyVarScope
resScope Scope
NoScope [LHsTyVarBndr Specificity (NoGhcTc GhcRn)]
exp_bndrs
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie Maybe (LHsContext GhcRn)
ctx
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie HsConDeclGADTDetails GhcRn
args
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsType GhcRn
typ
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie Maybe (LHsDoc GhcRn)
doc
        ]
        where
          rhsScope :: Scope
rhsScope = Scope -> Scope -> Scope
combineScopes Scope
argsScope Scope
tyScope
          ctxScope :: Scope
ctxScope = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Scope
NoScope forall a e. GenLocated (SrcSpanAnn' a) e -> Scope
mkLScopeA Maybe (LHsContext GhcRn)
ctx
          argsScope :: Scope
argsScope = case HsConDeclGADTDetails GhcRn
args of
            PrefixConGADT [HsScaled GhcRn (LHsType GhcRn)]
xs -> [HsScaled GhcRn (LHsType GhcRn)] -> Scope
scaled_args_scope [HsScaled GhcRn (LHsType GhcRn)]
xs
            RecConGADT XRec GhcRn [LConDeclField GhcRn]
x LHsUniToken "->" "\8594" GhcRn
_   -> forall a e. GenLocated (SrcSpanAnn' a) e -> Scope
mkLScopeA XRec GhcRn [LConDeclField GhcRn]
x
          tyScope :: Scope
tyScope = forall a e. GenLocated (SrcSpanAnn' a) e -> Scope
mkLScopeA LHsType GhcRn
typ
          resScope :: TyVarScope
resScope = [Scope] -> TyVarScope
ResolvedScopes [Scope
ctxScope, Scope
rhsScope]
      ConDeclH98 { con_name :: forall pass. ConDecl pass -> LIdP pass
con_name = LIdP GhcRn
name, con_ex_tvs :: forall pass. ConDecl pass -> [LHsTyVarBndr Specificity pass]
con_ex_tvs = [LHsTyVarBndr Specificity GhcRn]
qvars
                 , con_mb_cxt :: forall pass. ConDecl pass -> Maybe (LHsContext pass)
con_mb_cxt = Maybe (LHsContext GhcRn)
ctx, con_args :: forall pass. ConDecl pass -> HsConDeclH98Details pass
con_args = HsConDeclH98Details GhcRn
dets
                 , con_doc :: forall pass. ConDecl pass -> Maybe (LHsDoc pass)
con_doc = Maybe (LHsDoc GhcRn)
doc} ->
        [ 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
ConDec forall a b. (a -> b) -> a -> b
$ SrcSpan -> Maybe Span
getRealSpan (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
span)) LIdP GhcRn
name
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall flag (a :: Pass).
TyVarScope
-> Scope
-> [LHsTyVarBndr flag (GhcPass a)]
-> [TVScoped (LHsTyVarBndr flag (GhcPass a))]
tvScopes ([Scope] -> TyVarScope
ResolvedScopes []) Scope
rhsScope [LHsTyVarBndr Specificity GhcRn]
qvars
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie Maybe (LHsContext GhcRn)
ctx
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie HsConDeclH98Details GhcRn
dets
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie Maybe (LHsDoc GhcRn)
doc
        ]
        where
          rhsScope :: Scope
rhsScope = Scope -> Scope -> Scope
combineScopes Scope
ctxScope Scope
argsScope
          ctxScope :: Scope
ctxScope = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Scope
NoScope forall a e. GenLocated (SrcSpanAnn' a) e -> Scope
mkLScopeA Maybe (LHsContext GhcRn)
ctx
          argsScope :: Scope
argsScope = case HsConDeclH98Details GhcRn
dets of
            PrefixCon [Void]
_ [HsScaled GhcRn (LHsType GhcRn)]
xs -> [HsScaled GhcRn (LHsType GhcRn)] -> Scope
scaled_args_scope [HsScaled GhcRn (LHsType GhcRn)]
xs
            InfixCon HsScaled GhcRn (LHsType GhcRn)
a HsScaled GhcRn (LHsType GhcRn)
b   -> [HsScaled GhcRn (LHsType GhcRn)] -> Scope
scaled_args_scope [HsScaled GhcRn (LHsType GhcRn)
a, HsScaled GhcRn (LHsType GhcRn)
b]
            RecCon XRec GhcRn [LConDeclField GhcRn]
x       -> forall a e. GenLocated (SrcSpanAnn' a) e -> Scope
mkLScopeA XRec GhcRn [LConDeclField GhcRn]
x
    where scaled_args_scope :: [HsScaled GhcRn (LHsType GhcRn)] -> Scope
          scaled_args_scope :: [HsScaled GhcRn (LHsType GhcRn)] -> Scope
scaled_args_scope = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Scope -> Scope -> Scope
combineScopes Scope
NoScope forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a e. GenLocated (SrcSpanAnn' a) e -> Scope
mkLScopeA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pass a. HsScaled pass a -> a
hsScaledThing)

instance ToHie (LocatedL [LocatedA (ConDeclField GhcRn)]) where
  toHie :: GenLocated
  SrcSpanAnnL [GenLocated SrcSpanAnnA (ConDeclField GhcRn)]
-> HieM [HieAST Type]
toHie (L SrcSpanAnnL
span [GenLocated SrcSpanAnnA (ConDeclField GhcRn)]
decls) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$
    [ 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 (ConDeclField GhcRn)]
decls
    ]

instance ToHie (TScoped (HsWildCardBndrs GhcRn (LocatedA (HsSigType GhcRn)))) where
  toHie :: TScoped
  (HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn)))
-> HieM [HieAST Type]
toHie (TS TyVarScope
sc (HsWC XHsWC GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
names GenLocated SrcSpanAnnA (HsSigType GhcRn)
a)) = 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 (SrcSpan -> Scope
mkScope SrcSpan
span) TyVarScope
sc) XHsWC GhcRn (GenLocated SrcSpanAnnA (HsSigType GhcRn))
names
      , forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. TyVarScope -> a -> TScoped a
TS TyVarScope
sc GenLocated SrcSpanAnnA (HsSigType GhcRn)
a
      ]
    where span :: SrcSpan
span = forall a. HasLoc a => a -> SrcSpan
loc GenLocated SrcSpanAnnA (HsSigType GhcRn)
a

instance ToHie (TScoped (HsWildCardBndrs GhcRn (LocatedA (HsType GhcRn)))) where
  toHie :: TScoped
  (HsWildCardBndrs GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn)))
-> HieM [HieAST Type]
toHie (TS TyVarScope
sc (HsWC XHsWC GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
names GenLocated SrcSpanAnnA (HsType GhcRn)
a)) = 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 (SrcSpan -> Scope
mkScope SrcSpan
span) TyVarScope
sc) XHsWC GhcRn (GenLocated SrcSpanAnnA (HsType GhcRn))
names
      , forall a. ToHie a => a -> HieM [HieAST Type]
toHie GenLocated SrcSpanAnnA (HsType GhcRn)
a
      ]
    where span :: SrcSpan
span = forall a. HasLoc a => a -> SrcSpan
loc GenLocated SrcSpanAnnA (HsType GhcRn)
a

instance ToHie (LocatedA (StandaloneKindSig GhcRn)) where
  toHie :: GenLocated SrcSpanAnnA (StandaloneKindSig GhcRn)
-> HieM [HieAST Type]
toHie (L SrcSpanAnnA
sp StandaloneKindSig GhcRn
sig) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM [forall (m :: * -> *) a ann b.
(Monad m, Data a) =>
a -> SrcSpanAnn' ann -> ReaderT NodeOrigin m [HieAST b]
makeNodeA StandaloneKindSig GhcRn
sig SrcSpanAnnA
sp, forall a. ToHie a => a -> HieM [HieAST Type]
toHie StandaloneKindSig GhcRn
sig]

instance ToHie (StandaloneKindSig GhcRn) where
  toHie :: StandaloneKindSig GhcRn -> HieM [HieAST Type]
toHie StandaloneKindSig GhcRn
sig = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$ case StandaloneKindSig GhcRn
sig of
    StandaloneKindSig XStandaloneKindSig GhcRn
_ LIdP GhcRn
name LHsSigType 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 ContextInfo
TyDecl 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 []) LHsSigType GhcRn
typ
      ]

instance HiePass p => ToHie (SigContext (LocatedA (Sig (GhcPass p)))) where
  toHie :: SigContext (LocatedA (Sig (GhcPass p))) -> HieM [HieAST Type]
toHie (SC (SI SigType
styp Maybe Span
msp) (L SrcSpanAnnA
sp Sig (GhcPass p)
sig)) =
    case forall (p :: Pass). HiePass p => HiePassEv p
hiePass @p of
      HiePassEv p
HieTc -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      HiePassEv p
HieRn -> 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 Sig (GhcPass p)
sig SrcSpanAnnA
sp forall a. a -> [a] -> [a]
: case Sig (GhcPass p)
sig of
        TypeSig XTypeSig (GhcPass p)
_ [LIdP (GhcPass p)]
names LHsSigWcType (GhcPass p)
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 ContextInfo
TyDecl) [LIdP (GhcPass p)]
names
          , forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. TyVarScope -> a -> TScoped a
TS ([Name] -> Maybe Span -> TyVarScope
UnresolvedScope (forall a b. (a -> b) -> [a] -> [b]
map forall l e. GenLocated l e -> e
unLoc [LIdP (GhcPass p)]
names) forall a. Maybe a
Nothing) LHsSigWcType (GhcPass p)
typ
          ]
        PatSynSig XPatSynSig (GhcPass p)
_ [LIdP (GhcPass p)]
names LHsSigType (GhcPass p)
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 ContextInfo
TyDecl) [LIdP (GhcPass p)]
names
          , forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. TyVarScope -> a -> TScoped a
TS ([Name] -> Maybe Span -> TyVarScope
UnresolvedScope (forall a b. (a -> b) -> [a] -> [b]
map forall l e. GenLocated l e -> e
unLoc [LIdP (GhcPass p)]
names) forall a. Maybe a
Nothing) LHsSigType (GhcPass p)
typ
          ]
        ClassOpSig XClassOpSig (GhcPass p)
_ Bool
_ [LIdP (GhcPass p)]
names LHsSigType (GhcPass p)
typ ->
          [ case SigType
styp of
              SigType
ClassSig -> 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 forall a b. (a -> b) -> a -> b
$ Maybe Span -> ContextInfo
ClassTyDecl forall a b. (a -> b) -> a -> b
$ forall ann. SrcSpanAnn' ann -> Maybe Span
getRealSpanA SrcSpanAnnA
sp) [LIdP (GhcPass p)]
names
              SigType
_  -> 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 forall a b. (a -> b) -> a -> b
$ ContextInfo
TyDecl) [LIdP (GhcPass p)]
names
          , forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. TyVarScope -> a -> TScoped a
TS ([Name] -> Maybe Span -> TyVarScope
UnresolvedScope (forall a b. (a -> b) -> [a] -> [b]
map forall l e. GenLocated l e -> e
unLoc [LIdP (GhcPass p)]
names) Maybe Span
msp) LHsSigType (GhcPass p)
typ
          ]
        FixSig XFixSig (GhcPass p)
_ FixitySig (GhcPass p)
fsig ->
          [ 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
sp FixitySig (GhcPass p)
fsig
          ]
        InlineSig XInlineSig (GhcPass p)
_ LIdP (GhcPass p)
name InlinePragma
_ ->
          [ 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 (GhcPass p)
name
          ]
        SpecSig XSpecSig (GhcPass p)
_ LIdP (GhcPass p)
name [LHsSigType (GhcPass p)]
typs InlinePragma
_ ->
          [ 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 (GhcPass p)
name
          , 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 (GhcPass p)]
typs
          ]
        SpecInstSig XSpecInstSig (GhcPass p)
_ LHsSigType (GhcPass p)
typ ->
          [ 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 (GhcPass p)
typ
          ]
        MinimalSig XMinimalSig (GhcPass p)
_ LBooleanFormula (LIdP (GhcPass p))
form ->
          [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LBooleanFormula (LIdP (GhcPass p))
form
          ]
        SCCFunSig XSCCFunSig (GhcPass p)
_ LIdP (GhcPass p)
name Maybe (XRec (GhcPass p) StringLiteral)
mtxt ->
          [ 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 (GhcPass p)
name
          , forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (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) Maybe (XRec (GhcPass p) StringLiteral)
mtxt
          ]
        CompleteMatchSig XCompleteMatchSig (GhcPass p)
_ (L SrcSpan
ispan [LocatedN Name]
names) Maybe (LIdP (GhcPass p))
typ ->
          [ forall (m :: * -> *) a.
Monad m =>
SrcSpan -> ReaderT NodeOrigin m [HieAST a]
locOnly SrcSpan
ispan
          , 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) [LocatedN Name]
names
          , 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. ContextInfo -> a -> Context a
C ContextInfo
Use) Maybe (LIdP (GhcPass p))
typ
          ]
        XSig XXSig (GhcPass p)
_ -> []

instance ToHie (TScoped (LocatedA (HsSigType GhcRn))) where
  toHie :: TScoped (GenLocated SrcSpanAnnA (HsSigType GhcRn))
-> HieM [HieAST Type]
toHie (TS TyVarScope
tsc (L SrcSpanAnnA
span t :: HsSigType GhcRn
t@HsSig{sig_bndrs :: forall pass. HsSigType pass -> HsOuterSigTyVarBndrs pass
sig_bndrs=HsOuterTyVarBndrs Specificity GhcRn
bndrs,sig_body :: forall pass. HsSigType pass -> LHsType pass
sig_body=LHsType GhcRn
body})) = 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 HsSigType GhcRn
t SrcSpanAnnA
span forall a. a -> [a] -> [a]
:
      [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie (forall a. TyVarScope -> Scope -> a -> TVScoped a
TVS TyVarScope
tsc (forall ann. SrcSpanAnn' ann -> Scope
mkScopeA SrcSpanAnnA
span) HsOuterTyVarBndrs Specificity GhcRn
bndrs)
      , forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsType GhcRn
body
      ]

-- Check this
instance Data flag => ToHie (TVScoped (HsOuterTyVarBndrs flag GhcRn)) where
  toHie :: TVScoped (HsOuterTyVarBndrs flag GhcRn) -> HieM [HieAST Type]
toHie (TVS TyVarScope
tsc Scope
sc HsOuterTyVarBndrs flag GhcRn
bndrs) = case HsOuterTyVarBndrs flag GhcRn
bndrs of
    HsOuterImplicit XHsOuterImplicit GhcRn
xs -> 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 Scope
sc TyVarScope
tsc) XHsOuterImplicit GhcRn
xs
    HsOuterExplicit XHsOuterExplicit GhcRn flag
_ [LHsTyVarBndr flag (NoGhcTc GhcRn)]
xs -> forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall flag (a :: Pass).
TyVarScope
-> Scope
-> [LHsTyVarBndr flag (GhcPass a)]
-> [TVScoped (LHsTyVarBndr flag (GhcPass a))]
tvScopes TyVarScope
tsc Scope
sc [LHsTyVarBndr flag (NoGhcTc GhcRn)]
xs

instance ToHie (LocatedA (HsType GhcRn)) where
  toHie :: GenLocated SrcSpanAnnA (HsType GhcRn) -> HieM [HieAST Type]
toHie (L SrcSpanAnnA
span HsType GhcRn
t) = 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 HsType GhcRn
t (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
span) forall a. a -> [a] -> [a]
: case HsType GhcRn
t of
      HsForAllTy XForAllTy GhcRn
_ HsForAllTelescope GhcRn
tele LHsType GhcRn
body ->
        let scope :: Scope
scope = SrcSpan -> Scope
mkScope forall a b. (a -> b) -> a -> b
$ forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA LHsType GhcRn
body in
        [ case HsForAllTelescope GhcRn
tele of
            HsForAllVis { hsf_vis_bndrs :: forall pass. HsForAllTelescope pass -> [LHsTyVarBndr () pass]
hsf_vis_bndrs = [LHsTyVarBndr () GhcRn]
bndrs } ->
              forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall flag (a :: Pass).
TyVarScope
-> Scope
-> [LHsTyVarBndr flag (GhcPass a)]
-> [TVScoped (LHsTyVarBndr flag (GhcPass a))]
tvScopes ([Scope] -> TyVarScope
ResolvedScopes []) Scope
scope [LHsTyVarBndr () GhcRn]
bndrs
            HsForAllInvis { hsf_invis_bndrs :: forall pass.
HsForAllTelescope pass -> [LHsTyVarBndr Specificity pass]
hsf_invis_bndrs = [LHsTyVarBndr Specificity GhcRn]
bndrs } ->
              forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall flag (a :: Pass).
TyVarScope
-> Scope
-> [LHsTyVarBndr flag (GhcPass a)]
-> [TVScoped (LHsTyVarBndr flag (GhcPass a))]
tvScopes ([Scope] -> TyVarScope
ResolvedScopes []) Scope
scope [LHsTyVarBndr Specificity GhcRn]
bndrs
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsType GhcRn
body
        ]
      HsQualTy XQualTy GhcRn
_ LHsContext GhcRn
ctx LHsType GhcRn
body ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsContext GhcRn
ctx
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsType GhcRn
body
        ]
      HsTyVar XTyVar GhcRn
_ PromotionFlag
_ LIdP GhcRn
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 LIdP GhcRn
var
        ]
      HsAppTy XAppTy GhcRn
_ LHsType GhcRn
a LHsType GhcRn
b ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsType GhcRn
a
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsType GhcRn
b
        ]
      HsAppKindTy XAppKindTy GhcRn
_ LHsType GhcRn
ty LHsType GhcRn
ki ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsType GhcRn
ty
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsType GhcRn
ki
        ]
      HsFunTy XFunTy GhcRn
_ HsArrow GhcRn
w LHsType GhcRn
a LHsType GhcRn
b ->
        [ 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 LHsType GhcRn
a
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsType GhcRn
b
        ]
      HsListTy XListTy GhcRn
_ LHsType GhcRn
a ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsType GhcRn
a
        ]
      HsTupleTy XTupleTy GhcRn
_ HsTupleSort
_ [LHsType GhcRn]
tys ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie [LHsType GhcRn]
tys
        ]
      HsSumTy XSumTy GhcRn
_ [LHsType GhcRn]
tys ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie [LHsType GhcRn]
tys
        ]
      HsOpTy XOpTy GhcRn
_ PromotionFlag
_prom LHsType GhcRn
a LIdP GhcRn
op LHsType GhcRn
b ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsType GhcRn
a
        , 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
op
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsType GhcRn
b
        ]
      HsParTy XParTy GhcRn
_ LHsType GhcRn
a ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsType GhcRn
a
        ]
      HsIParamTy XIParamTy GhcRn
_ XRec GhcRn HsIPName
ip LHsType GhcRn
ty ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie XRec GhcRn HsIPName
ip
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsType GhcRn
ty
        ]
      HsKindSig XKindSig GhcRn
_ LHsType GhcRn
a LHsType GhcRn
b ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsType GhcRn
a
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsType GhcRn
b
        ]
      HsSpliceTy XSpliceTy GhcRn
_ HsUntypedSplice GhcRn
a ->
        [ 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 HsUntypedSplice GhcRn
a
        ]
      HsDocTy XDocTy GhcRn
_ LHsType GhcRn
a LHsDoc GhcRn
doc ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsType GhcRn
a
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsDoc GhcRn
doc
        ]
      HsBangTy XBangTy GhcRn
_ HsSrcBang
_ LHsType GhcRn
ty ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsType GhcRn
ty
        ]
      HsRecTy XRecTy GhcRn
_ [LConDeclField GhcRn]
fields ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie [LConDeclField GhcRn]
fields
        ]
      HsExplicitListTy XExplicitListTy GhcRn
_ PromotionFlag
_ [LHsType GhcRn]
tys ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie [LHsType GhcRn]
tys
        ]
      HsExplicitTupleTy XExplicitTupleTy GhcRn
_ [LHsType GhcRn]
tys ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie [LHsType GhcRn]
tys
        ]
      HsTyLit XTyLit GhcRn
_ HsTyLit GhcRn
_ -> []
      HsWildCardTy XWildCardTy GhcRn
_ -> []
      HsStarTy XStarTy GhcRn
_ Bool
_ -> []
      XHsType XXType GhcRn
_ -> []

instance (ToHie tm, ToHie ty) => ToHie (HsArg tm ty) where
  toHie :: HsArg tm ty -> HieM [HieAST Type]
toHie (HsValArg tm
tm) = forall a. ToHie a => a -> HieM [HieAST Type]
toHie tm
tm
  toHie (HsTypeArg SrcSpan
_ ty
ty) = forall a. ToHie a => a -> HieM [HieAST Type]
toHie ty
ty
  toHie (HsArgPar SrcSpan
sp) = forall (m :: * -> *) a.
Monad m =>
SrcSpan -> ReaderT NodeOrigin m [HieAST a]
locOnly SrcSpan
sp

instance Data flag => ToHie (TVScoped (LocatedA (HsTyVarBndr flag GhcRn))) where
  toHie :: TVScoped (LocatedA (HsTyVarBndr flag GhcRn)) -> HieM [HieAST Type]
toHie (TVS TyVarScope
tsc Scope
sc (L SrcSpanAnnA
span HsTyVarBndr flag GhcRn
bndr)) = 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 HsTyVarBndr flag GhcRn
bndr SrcSpanAnnA
span forall a. a -> [a] -> [a]
: case HsTyVarBndr flag GhcRn
bndr of
      UserTyVar XUserTyVar GhcRn
_ flag
_ LIdP GhcRn
var ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C (Scope -> TyVarScope -> ContextInfo
TyVarBind Scope
sc TyVarScope
tsc) LIdP GhcRn
var
        ]
      KindedTyVar XKindedTyVar GhcRn
_ flag
_ LIdP GhcRn
var LHsType GhcRn
kind ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C (Scope -> TyVarScope -> ContextInfo
TyVarBind Scope
sc TyVarScope
tsc) LIdP GhcRn
var
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsType GhcRn
kind
        ]

instance ToHie (TScoped (LHsQTyVars GhcRn)) where
  toHie :: TScoped (LHsQTyVars GhcRn) -> HieM [HieAST Type]
toHie (TS TyVarScope
sc (HsQTvs XHsQTvs GhcRn
implicits [LHsTyVarBndr () GhcRn]
vars)) = 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 [Context Name]
bindings
    , forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall flag (a :: Pass).
TyVarScope
-> Scope
-> [LHsTyVarBndr flag (GhcPass a)]
-> [TVScoped (LHsTyVarBndr flag (GhcPass a))]
tvScopes TyVarScope
sc Scope
NoScope [LHsTyVarBndr () GhcRn]
vars
    ]
    where
      varLoc :: SrcSpan
varLoc = forall a. HasLoc a => a -> SrcSpan
loc [LHsTyVarBndr () GhcRn]
vars
      bindings :: [Context Name]
bindings = 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 (SrcSpan -> Scope
mkScope SrcSpan
varLoc) TyVarScope
sc) XHsQTvs GhcRn
implicits

instance ToHie (LocatedC [LocatedA (HsType GhcRn)]) where
  toHie :: GenLocated SrcSpanAnnC [GenLocated SrcSpanAnnA (HsType GhcRn)]
-> HieM [HieAST Type]
toHie (L SrcSpanAnnC
span [GenLocated SrcSpanAnnA (HsType GhcRn)]
tys) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$
      [ forall (m :: * -> *) a.
Monad m =>
SrcSpan -> ReaderT NodeOrigin m [HieAST a]
locOnly (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnC
span)
      , forall a. ToHie a => a -> HieM [HieAST Type]
toHie [GenLocated SrcSpanAnnA (HsType GhcRn)]
tys
      ]

instance ToHie (LocatedA (ConDeclField GhcRn)) where
  toHie :: GenLocated SrcSpanAnnA (ConDeclField GhcRn) -> HieM [HieAST Type]
toHie (L SrcSpanAnnA
span ConDeclField GhcRn
field) = 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 ConDeclField GhcRn
field (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
span) forall a. a -> [a] -> [a]
: case ConDeclField GhcRn
field of
      ConDeclField XConDeclField GhcRn
_ [LFieldOcc GhcRn]
fields LHsType GhcRn
typ Maybe (LHsDoc GhcRn)
doc ->
        [ 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 -> Maybe Span -> a -> RFContext a
RFC RecFieldContext
RecFieldDecl (SrcSpan -> Maybe Span
getRealSpan forall a b. (a -> b) -> a -> b
$ forall a. HasLoc a => a -> SrcSpan
loc LHsType GhcRn
typ)) [LFieldOcc GhcRn]
fields
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsType GhcRn
typ
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie Maybe (LHsDoc GhcRn)
doc
        ]

instance ToHie (LHsExpr a) => ToHie (ArithSeqInfo a) where
  toHie :: ArithSeqInfo a -> HieM [HieAST Type]
toHie (From LHsExpr a
expr) = forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr a
expr
  toHie (FromThen LHsExpr a
a LHsExpr a
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 LHsExpr a
a
    , forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr a
b
    ]
  toHie (FromTo LHsExpr a
a LHsExpr a
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 LHsExpr a
a
    , forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr a
b
    ]
  toHie (FromThenTo LHsExpr a
a LHsExpr a
b LHsExpr a
c) = 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 LHsExpr a
a
    , forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr a
b
    , forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr a
c
    ]

instance ToHie (LocatedA (SpliceDecl GhcRn)) where
  toHie :: GenLocated SrcSpanAnnA (SpliceDecl GhcRn) -> HieM [HieAST Type]
toHie (L SrcSpanAnnA
span SpliceDecl 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 SpliceDecl GhcRn
decl SrcSpanAnnA
span forall a. a -> [a] -> [a]
: case SpliceDecl GhcRn
decl of
      SpliceDecl XSpliceDecl GhcRn
_ XRec GhcRn (HsUntypedSplice GhcRn)
splice SpliceDecoration
_ ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie XRec GhcRn (HsUntypedSplice GhcRn)
splice
        ]

instance ToHie (HsQuote GhcRn) where
  toHie :: HsQuote GhcRn -> HieM [HieAST Type]
toHie (ExpBr XExpBr GhcRn
_ LHsExpr GhcRn
e)  = forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr GhcRn
e
  toHie (PatBr XPatBr GhcRn
_ LPat GhcRn
b)  = forall a. ToHie a => a -> HieM [HieAST Type]
toHie (forall a. Maybe Span -> Scope -> Scope -> a -> PScoped a
PS forall a. Maybe a
Nothing Scope
NoScope Scope
NoScope LPat GhcRn
b)
  toHie (DecBrL {} ) = forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  toHie (DecBrG XDecBrG GhcRn
_ HsGroup GhcRn
decls) = HsGroup GhcRn -> HieM [HieAST Type]
processGrp HsGroup GhcRn
decls
  toHie (TypBr XTypBr GhcRn
_ LHsType GhcRn
ty) = forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsType GhcRn
ty
  toHie (VarBr {} )  = forall (f :: * -> *) a. Applicative f => a -> f a
pure []

instance ToHie PendingRnSplice where
  toHie :: PendingRnSplice -> HieM [HieAST Type]
toHie (PendingRnSplice UntypedSpliceFlavour
_ Name
_ LHsExpr GhcRn
e) = forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr GhcRn
e

instance ToHie PendingTcSplice where
  toHie :: PendingTcSplice -> HieM [HieAST Type]
toHie (PendingTcSplice Name
_ LHsExpr GhcTc
e) = forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr GhcTc
e

instance ToHie (LBooleanFormula (LocatedN Name)) where
  toHie :: LBooleanFormula (LocatedN Name) -> HieM [HieAST Type]
toHie (L SrcSpanAnnL
span BooleanFormula (LocatedN Name)
form) = 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 BooleanFormula (LocatedN Name)
form (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnL
span) forall a. a -> [a] -> [a]
: case BooleanFormula (LocatedN Name)
form of
      Var LocatedN Name
a ->
        [ 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 LocatedN Name
a
        ]
      And [LBooleanFormula (LocatedN Name)]
forms ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie [LBooleanFormula (LocatedN Name)]
forms
        ]
      Or [LBooleanFormula (LocatedN Name)]
forms ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie [LBooleanFormula (LocatedN Name)]
forms
        ]
      Parens LBooleanFormula (LocatedN Name)
f ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LBooleanFormula (LocatedN Name)
f
        ]

instance ToHie (LocatedAn NoEpAnns HsIPName) where
  toHie :: GenLocated (SrcAnn NoEpAnns) HsIPName -> HieM [HieAST Type]
toHie (L SrcAnn NoEpAnns
span HsIPName
e) = forall (m :: * -> *) a ann b.
(Monad m, Data a) =>
a -> SrcSpanAnn' ann -> ReaderT NodeOrigin m [HieAST b]
makeNodeA HsIPName
e SrcAnn NoEpAnns
span

instance HiePass p => ToHie (LocatedA (HsUntypedSplice (GhcPass p))) where
  toHie :: LocatedA (HsUntypedSplice (GhcPass p)) -> HieM [HieAST Type]
toHie (L SrcSpanAnnA
span HsUntypedSplice (GhcPass p)
sp) = 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 HsUntypedSplice (GhcPass p)
sp SrcSpanAnnA
span forall a. a -> [a] -> [a]
: case HsUntypedSplice (GhcPass p)
sp of
      HsUntypedSpliceExpr XUntypedSpliceExpr (GhcPass p)
_ LHsExpr (GhcPass p)
expr ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr (GhcPass p)
expr
        ]
      HsQuasiQuote XQuasiQuote (GhcPass p)
_ IdP (GhcPass p)
_ XRec (GhcPass p) FastString
ispanFs ->
        [ forall (m :: * -> *) a.
Monad m =>
SrcSpan -> ReaderT NodeOrigin m [HieAST a]
locOnly (forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA XRec (GhcPass p) FastString
ispanFs)
        ]

instance ToHie (LocatedA (RoleAnnotDecl GhcRn)) where
  toHie :: GenLocated SrcSpanAnnA (RoleAnnotDecl GhcRn) -> HieM [HieAST Type]
toHie (L SrcSpanAnnA
span RoleAnnotDecl GhcRn
annot) = 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 RoleAnnotDecl GhcRn
annot SrcSpanAnnA
span forall a. a -> [a] -> [a]
: case RoleAnnotDecl GhcRn
annot of
      RoleAnnotDecl XCRoleAnnotDecl GhcRn
_ LIdP GhcRn
var [XRec GhcRn (Maybe Role)]
roles ->
        [ 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
var
        , 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) [XRec GhcRn (Maybe Role)]
roles
        ]

instance ToHie (LocatedA (InstDecl GhcRn)) where
  toHie :: GenLocated SrcSpanAnnA (InstDecl GhcRn) -> HieM [HieAST Type]
toHie (L SrcSpanAnnA
span InstDecl 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 InstDecl GhcRn
decl SrcSpanAnnA
span forall a. a -> [a] -> [a]
: case InstDecl GhcRn
decl of
      ClsInstD XClsInstD GhcRn
_ ClsInstDecl GhcRn
d ->
        [ 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 ClsInstDecl GhcRn
d
        ]
      DataFamInstD XDataFamInstD GhcRn
_ DataFamInstDecl GhcRn
d ->
        [ 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 DataFamInstDecl GhcRn
d
        ]
      TyFamInstD XTyFamInstD GhcRn
_ TyFamInstDecl GhcRn
d ->
        [ 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 TyFamInstDecl GhcRn
d
        ]

instance ToHie (LocatedA (ClsInstDecl GhcRn)) where
  toHie :: GenLocated SrcSpanAnnA (ClsInstDecl GhcRn) -> HieM [HieAST Type]
toHie (L SrcSpanAnnA
span ClsInstDecl GhcRn
decl) = 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. TyVarScope -> a -> TScoped a
TS ([Scope] -> TyVarScope
ResolvedScopes [forall ann. SrcSpanAnn' ann -> Scope
mkScopeA SrcSpanAnnA
span]) forall a b. (a -> b) -> a -> b
$ forall pass. ClsInstDecl pass -> LHsSigType pass
cid_poly_ty ClsInstDecl GhcRn
decl
    , 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) forall a b. (a -> b) -> a -> b
$ forall pass. ClsInstDecl pass -> LHsBinds pass
cid_binds ClsInstDecl GhcRn
decl
    , 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
InstSig forall a b. (a -> b) -> a -> b
$ forall ann. SrcSpanAnn' ann -> Maybe Span
getRealSpanA SrcSpanAnnA
span) forall a b. (a -> b) -> a -> b
$ forall pass. ClsInstDecl pass -> [LSig pass]
cid_sigs ClsInstDecl GhcRn
decl
    , 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) forall a b. (a -> b) -> a -> b
$ forall pass. ClsInstDecl pass -> [LTyFamInstDecl pass]
cid_tyfam_insts ClsInstDecl GhcRn
decl
    , forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall pass. ClsInstDecl pass -> [LTyFamInstDecl pass]
cid_tyfam_insts ClsInstDecl GhcRn
decl
    , 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) forall a b. (a -> b) -> a -> b
$ forall pass. ClsInstDecl pass -> [LDataFamInstDecl pass]
cid_datafam_insts ClsInstDecl GhcRn
decl
    , forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall pass. ClsInstDecl pass -> [LDataFamInstDecl pass]
cid_datafam_insts ClsInstDecl GhcRn
decl
    , forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall pass. ClsInstDecl pass -> Maybe (XRec pass OverlapMode)
cid_overlap_mode ClsInstDecl GhcRn
decl
    ]

instance ToHie (LocatedA (DataFamInstDecl GhcRn)) where
  toHie :: GenLocated SrcSpanAnnA (DataFamInstDecl GhcRn)
-> HieM [HieAST Type]
toHie (L SrcSpanAnnA
sp (DataFamInstDecl FamEqn GhcRn (HsDataDefn GhcRn)
d)) = 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 ann. SrcSpanAnn' ann -> Scope
mkScopeA SrcSpanAnnA
sp]) FamEqn GhcRn (HsDataDefn GhcRn)
d

instance ToHie (LocatedA (TyFamInstDecl GhcRn)) where
  toHie :: GenLocated SrcSpanAnnA (TyFamInstDecl GhcRn) -> HieM [HieAST Type]
toHie (L SrcSpanAnnA
sp (TyFamInstDecl XCTyFamInstDecl GhcRn
_ TyFamInstEqn GhcRn
d)) = 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 ann. SrcSpanAnn' ann -> Scope
mkScopeA SrcSpanAnnA
sp]) TyFamInstEqn GhcRn
d

instance HiePass p => ToHie (Context (FieldOcc (GhcPass p))) where
  toHie :: Context (FieldOcc (GhcPass p)) -> HieM [HieAST Type]
toHie (C ContextInfo
c (FieldOcc XCFieldOcc (GhcPass p)
n (L SrcSpanAnnN
l RdrName
_))) = 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. ContextInfo -> a -> Context a
C ContextInfo
c (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
l XCFieldOcc (GhcPass p)
n))
    HiePassEv p
HieRn -> 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 SrcSpanAnnN
l XCFieldOcc (GhcPass p)
n))

instance HiePass p => ToHie (PatSynFieldContext (RecordPatSynField (GhcPass p))) where
  toHie :: PatSynFieldContext (RecordPatSynField (GhcPass p))
-> HieM [HieAST Type]
toHie (PSC Maybe Span
sp (RecordPatSynField FieldOcc (GhcPass p)
a LIdP (GhcPass p)
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 a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C (RecFieldContext -> Maybe Span -> ContextInfo
RecField RecFieldContext
RecFieldDecl Maybe Span
sp) FieldOcc (GhcPass p)
a
    , 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 (GhcPass p)
b
    ]

instance ToHie (LocatedA (DerivDecl GhcRn)) where
  toHie :: GenLocated SrcSpanAnnA (DerivDecl GhcRn) -> HieM [HieAST Type]
toHie (L SrcSpanAnnA
span DerivDecl 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 DerivDecl GhcRn
decl SrcSpanAnnA
span forall a. a -> [a] -> [a]
: case DerivDecl GhcRn
decl of
      DerivDecl XCDerivDecl GhcRn
_ LHsSigWcType GhcRn
typ Maybe (LDerivStrategy GhcRn)
strat Maybe (XRec GhcRn OverlapMode)
overlap ->
        [ 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 []) LHsSigWcType GhcRn
typ
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ (forall a. Scope -> a -> RScoped a
RS (forall ann. SrcSpanAnn' ann -> Scope
mkScopeA SrcSpanAnnA
span) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (LDerivStrategy GhcRn)
strat)
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie Maybe (XRec GhcRn OverlapMode)
overlap
        ]

instance ToHie (LocatedA (FixitySig GhcRn)) where
  toHie :: GenLocated SrcSpanAnnA (FixitySig GhcRn) -> HieM [HieAST Type]
toHie (L SrcSpanAnnA
span FixitySig GhcRn
sig) = 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 FixitySig GhcRn
sig SrcSpanAnnA
span forall a. a -> [a] -> [a]
: case FixitySig GhcRn
sig of
      FixitySig XFixitySig GhcRn
_ [LIdP GhcRn]
vars Fixity
_ ->
        [ 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]
vars
        ]

instance ToHie (LocatedA (DefaultDecl GhcRn)) where
  toHie :: GenLocated SrcSpanAnnA (DefaultDecl GhcRn) -> HieM [HieAST Type]
toHie (L SrcSpanAnnA
span DefaultDecl 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 DefaultDecl GhcRn
decl SrcSpanAnnA
span forall a. a -> [a] -> [a]
: case DefaultDecl GhcRn
decl of
      DefaultDecl XCDefaultDecl GhcRn
_ [LHsType GhcRn]
typs ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie [LHsType GhcRn]
typs
        ]

instance ToHie (LocatedA (ForeignDecl GhcRn)) where
  toHie :: GenLocated SrcSpanAnnA (ForeignDecl GhcRn) -> HieM [HieAST Type]
toHie (L SrcSpanAnnA
span ForeignDecl 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 ForeignDecl GhcRn
decl SrcSpanAnnA
span forall a. a -> [a] -> [a]
: case ForeignDecl GhcRn
decl of
      ForeignImport {fd_name :: forall pass. ForeignDecl pass -> LIdP pass
fd_name = LIdP GhcRn
name, fd_sig_ty :: forall pass. ForeignDecl pass -> LHsSigType pass
fd_sig_ty = LHsSigType GhcRn
sig, fd_fi :: forall pass. ForeignDecl pass -> ForeignImport pass
fd_fi = ForeignImport GhcRn
fi} ->
        [ 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
RegularBind Scope
ModuleScope 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 []) LHsSigType GhcRn
sig
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie ForeignImport GhcRn
fi
        ]
      ForeignExport {fd_name :: forall pass. ForeignDecl pass -> LIdP pass
fd_name = LIdP GhcRn
name, fd_sig_ty :: forall pass. ForeignDecl pass -> LHsSigType pass
fd_sig_ty = LHsSigType GhcRn
sig, fd_fe :: forall pass. ForeignDecl pass -> ForeignExport pass
fd_fe = ForeignExport GhcRn
fe} ->
        [ 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
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 []) LHsSigType GhcRn
sig
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie ForeignExport GhcRn
fe
        ]

instance ToHie (ForeignImport GhcRn) where
  toHie :: ForeignImport GhcRn -> HieM [HieAST Type]
toHie (CImport (L SrcSpan
c SourceText
_) (L SrcSpan
a CCallConv
_) (L SrcSpan
b Safety
_) Maybe Header
_ CImportSpec
_) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$
    [ forall (m :: * -> *) a.
Monad m =>
SrcSpan -> ReaderT NodeOrigin m [HieAST a]
locOnly SrcSpan
a
    , forall (m :: * -> *) a.
Monad m =>
SrcSpan -> ReaderT NodeOrigin m [HieAST a]
locOnly SrcSpan
b
    , forall (m :: * -> *) a.
Monad m =>
SrcSpan -> ReaderT NodeOrigin m [HieAST a]
locOnly SrcSpan
c
    ]

instance ToHie (ForeignExport GhcRn) where
  toHie :: ForeignExport GhcRn -> HieM [HieAST Type]
toHie (CExport (L SrcSpan
b SourceText
_) (L SrcSpan
a CExportSpec
_)) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$
    [ forall (m :: * -> *) a.
Monad m =>
SrcSpan -> ReaderT NodeOrigin m [HieAST a]
locOnly SrcSpan
a
    , forall (m :: * -> *) a.
Monad m =>
SrcSpan -> ReaderT NodeOrigin m [HieAST a]
locOnly SrcSpan
b
    ]

instance ToHie (LocatedA (WarnDecls GhcRn)) where
  toHie :: GenLocated SrcSpanAnnA (WarnDecls GhcRn) -> HieM [HieAST Type]
toHie (L SrcSpanAnnA
span WarnDecls 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 WarnDecls GhcRn
decl SrcSpanAnnA
span forall a. a -> [a] -> [a]
: case WarnDecls GhcRn
decl of
      Warnings XWarnings GhcRn
_ [LWarnDecl GhcRn]
warnings ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie [LWarnDecl GhcRn]
warnings
        ]

instance ToHie (LocatedA (WarnDecl GhcRn)) where
  toHie :: GenLocated SrcSpanAnnA (WarnDecl GhcRn) -> HieM [HieAST Type]
toHie (L SrcSpanAnnA
span WarnDecl 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 WarnDecl GhcRn
decl (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
span) forall a. a -> [a] -> [a]
: case WarnDecl GhcRn
decl of
      Warning XWarning GhcRn
_ [LIdP GhcRn]
vars WarningTxt GhcRn
_ ->
        [ 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]
vars
        ]

instance ToHie (LocatedA (AnnDecl GhcRn)) where
  toHie :: GenLocated SrcSpanAnnA (AnnDecl GhcRn) -> HieM [HieAST Type]
toHie (L SrcSpanAnnA
span AnnDecl 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 AnnDecl GhcRn
decl SrcSpanAnnA
span forall a. a -> [a] -> [a]
: case AnnDecl GhcRn
decl of
      HsAnnotation XHsAnnotation GhcRn
_ AnnProvenance GhcRn
prov LHsExpr GhcRn
expr ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie AnnProvenance GhcRn
prov
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr GhcRn
expr
        ]

instance ToHie (AnnProvenance GhcRn) where
  toHie :: AnnProvenance GhcRn -> HieM [HieAST Type]
toHie (ValueAnnProvenance LIdP GhcRn
a) = 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
a
  toHie (TypeAnnProvenance LIdP GhcRn
a) = 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
a
  toHie AnnProvenance GhcRn
ModuleAnnProvenance = forall (f :: * -> *) a. Applicative f => a -> f a
pure []

instance ToHie (LocatedA (RuleDecls GhcRn)) where
  toHie :: GenLocated SrcSpanAnnA (RuleDecls GhcRn) -> HieM [HieAST Type]
toHie (L SrcSpanAnnA
span RuleDecls 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 RuleDecls GhcRn
decl SrcSpanAnnA
span forall a. a -> [a] -> [a]
: case RuleDecls GhcRn
decl of
      HsRules XCRuleDecls GhcRn
_ [LRuleDecl GhcRn]
rules ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie [LRuleDecl GhcRn]
rules
        ]

instance ToHie (LocatedA (RuleDecl GhcRn)) where
  toHie :: GenLocated SrcSpanAnnA (RuleDecl GhcRn) -> HieM [HieAST Type]
toHie (L SrcSpanAnnA
span r :: RuleDecl GhcRn
r@(HsRule XHsRule GhcRn
_ XRec GhcRn FastString
rname Activation
_ Maybe [LHsTyVarBndr () (NoGhcTc GhcRn)]
tybndrs [LRuleBndr GhcRn]
bndrs LHsExpr GhcRn
exprA LHsExpr GhcRn
exprB)) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM
        [ forall (m :: * -> *) a ann b.
(Monad m, Data a) =>
a -> SrcSpanAnn' ann -> ReaderT NodeOrigin m [HieAST b]
makeNodeA RuleDecl GhcRn
r SrcSpanAnnA
span
        , forall (m :: * -> *) a.
Monad m =>
SrcSpan -> ReaderT NodeOrigin m [HieAST a]
locOnly forall a b. (a -> b) -> a -> b
$ forall a e. GenLocated (SrcSpanAnn' a) e -> SrcSpan
getLocA XRec GhcRn FastString
rname
        , 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 flag (a :: Pass).
TyVarScope
-> Scope
-> [LHsTyVarBndr flag (GhcPass a)]
-> [TVScoped (LHsTyVarBndr flag (GhcPass a))]
tvScopes ([Scope] -> TyVarScope
ResolvedScopes []) Scope
scope) Maybe [LHsTyVarBndr () (NoGhcTc GhcRn)]
tybndrs
        , 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
$ SrcSpan -> Scope
mkScope (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
span)) [LRuleBndr GhcRn]
bndrs
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr GhcRn
exprA
        , forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsExpr GhcRn
exprB
        ]
    where scope :: Scope
scope = Scope
bndrs_sc Scope -> Scope -> Scope
`combineScopes` Scope
exprA_sc Scope -> Scope -> Scope
`combineScopes` Scope
exprB_sc
          bndrs_sc :: Scope
bndrs_sc = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Scope
NoScope forall a e. GenLocated (SrcSpanAnn' a) e -> Scope
mkLScopeA (forall a. [a] -> Maybe a
listToMaybe [LRuleBndr GhcRn]
bndrs)
          exprA_sc :: Scope
exprA_sc = forall a e. GenLocated (SrcSpanAnn' a) e -> Scope
mkLScopeA LHsExpr GhcRn
exprA
          exprB_sc :: Scope
exprB_sc = forall a e. GenLocated (SrcSpanAnn' a) e -> Scope
mkLScopeA LHsExpr GhcRn
exprB

instance ToHie (RScoped (LocatedAn NoEpAnns (RuleBndr GhcRn))) where
  toHie :: RScoped (GenLocated (SrcAnn NoEpAnns) (RuleBndr GhcRn))
-> HieM [HieAST Type]
toHie (RS Scope
sc (L SrcAnn NoEpAnns
span RuleBndr GhcRn
bndr)) = 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 RuleBndr GhcRn
bndr SrcAnn NoEpAnns
span forall a. a -> [a] -> [a]
: case RuleBndr GhcRn
bndr of
      RuleBndr XCRuleBndr GhcRn
_ LIdP GhcRn
var ->
        [ 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
RegularBind Scope
sc forall a. Maybe a
Nothing) LIdP GhcRn
var
        ]
      RuleBndrSig XRuleBndrSig GhcRn
_ LIdP GhcRn
var HsPatSigType 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 (BindType -> Scope -> Maybe Span -> ContextInfo
ValBind BindType
RegularBind Scope
sc forall a. Maybe a
Nothing) LIdP GhcRn
var
        , 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
sc]) HsPatSigType GhcRn
typ
        ]

instance ToHie (LocatedA (ImportDecl GhcRn)) where
  toHie :: GenLocated SrcSpanAnnA (ImportDecl GhcRn) -> HieM [HieAST Type]
toHie (L SrcSpanAnnA
span ImportDecl 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 ImportDecl GhcRn
decl (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
span) forall a. a -> [a] -> [a]
: case ImportDecl GhcRn
decl of
      ImportDecl { ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclName = XRec GhcRn ModuleName
name, ideclAs :: forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclAs = Maybe (XRec GhcRn ModuleName)
as, ideclImportList :: forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclImportList = Maybe (ImportListInterpretation, XRec GhcRn [LIE GhcRn])
hidden } ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. IEType -> a -> IEContext a
IEC IEType
Import XRec GhcRn ModuleName
name
        , 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. IEType -> a -> IEContext a
IEC IEType
ImportAs) Maybe (XRec GhcRn ModuleName)
as
        , forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure []) forall {a} {a}.
ToHie (IEContext a) =>
(ImportListInterpretation, GenLocated (SrcSpanAnn' a) [a])
-> HieM [HieAST Type]
goIE Maybe (ImportListInterpretation, XRec GhcRn [LIE GhcRn])
hidden
        ]
    where
      goIE :: (ImportListInterpretation, GenLocated (SrcSpanAnn' a) [a])
-> HieM [HieAST Type]
goIE (ImportListInterpretation
hiding, (L SrcSpanAnn' a
sp [a]
liens)) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM forall a b. (a -> b) -> a -> b
$
        [ forall (m :: * -> *) a.
Monad m =>
SrcSpan -> ReaderT NodeOrigin m [HieAST a]
locOnly (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' a
sp)
        , 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. IEType -> a -> IEContext a
IEC IEType
c) [a]
liens
        ]
        where
         -- ROMES:TODO: I notice some overlap here with Iface types, eventually
         -- we could join these
         c :: IEType
c = case ImportListInterpretation
hiding of
               ImportListInterpretation
Exactly -> IEType
Import
               ImportListInterpretation
EverythingBut -> IEType
ImportHiding


instance ToHie (IEContext (LocatedA (IE GhcRn))) where
  toHie :: IEContext (GenLocated SrcSpanAnnA (IE GhcRn)) -> HieM [HieAST Type]
toHie (IEC IEType
c (L SrcSpanAnnA
span IE GhcRn
ie)) = 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 IE GhcRn
ie (forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnnA
span) forall a. a -> [a] -> [a]
: case IE GhcRn
ie of
      IEVar XIEVar GhcRn
_ LIEWrappedName GhcRn
n ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. IEType -> a -> IEContext a
IEC IEType
c LIEWrappedName GhcRn
n
        ]
      IEThingAbs XIEThingAbs GhcRn
_ LIEWrappedName GhcRn
n ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. IEType -> a -> IEContext a
IEC IEType
c LIEWrappedName GhcRn
n
        ]
      IEThingAll XIEThingAll GhcRn
_ LIEWrappedName GhcRn
n ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. IEType -> a -> IEContext a
IEC IEType
c LIEWrappedName GhcRn
n
        ]
      IEThingWith XIEThingWith GhcRn
flds LIEWrappedName GhcRn
n IEWildcard
_ [LIEWrappedName GhcRn]
ns ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. IEType -> a -> IEContext a
IEC IEType
c LIEWrappedName GhcRn
n
        , 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. IEType -> a -> IEContext a
IEC IEType
c) [LIEWrappedName GhcRn]
ns
        , 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. IEType -> a -> IEContext a
IEC IEType
c) XIEThingWith GhcRn
flds
        ]
      IEModuleContents XIEModuleContents GhcRn
_ XRec GhcRn ModuleName
n ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. IEType -> a -> IEContext a
IEC IEType
c XRec GhcRn ModuleName
n
        ]
      IEGroup XIEGroup GhcRn
_ TypeIndex
_ LHsDoc GhcRn
d -> [forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsDoc GhcRn
d]
      IEDoc XIEDoc GhcRn
_ LHsDoc GhcRn
d -> [forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsDoc GhcRn
d]
      IEDocNamed XIEDocNamed GhcRn
_ FilePath
_ -> []

instance ToHie (IEContext (LocatedA (IEWrappedName GhcRn))) where
  toHie :: IEContext (GenLocated SrcSpanAnnA (IEWrappedName GhcRn))
-> HieM [HieAST Type]
toHie (IEC IEType
c (L SrcSpanAnnA
span IEWrappedName GhcRn
iewn)) = 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 IEWrappedName GhcRn
iewn SrcSpanAnnA
span forall a. a -> [a] -> [a]
: case IEWrappedName GhcRn
iewn of
      IEName XIEName GhcRn
_ (L SrcSpanAnnN
l Name
n) ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C (IEType -> ContextInfo
IEThing IEType
c) (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
l Name
n)
        ]
      IEPattern XIEPattern GhcRn
_ (L SrcSpanAnnN
l Name
p) ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C (IEType -> ContextInfo
IEThing IEType
c) (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
l Name
p)
        ]
      IEType XIEType GhcRn
_ (L SrcSpanAnnN
l Name
n) ->
        [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C (IEType -> ContextInfo
IEThing IEType
c) (forall l e. l -> e -> GenLocated l e
L SrcSpanAnnN
l Name
n)
        ]

instance ToHie (IEContext (Located FieldLabel)) where
  toHie :: IEContext (Located FieldLabel) -> HieM [HieAST Type]
toHie (IEC IEType
c (L SrcSpan
span FieldLabel
lbl)) = forall (m :: * -> *) a. Monad m => [m [a]] -> m [a]
concatM
      [ forall (m :: * -> *) a b.
(Monad m, Data a) =>
a -> SrcSpan -> ReaderT NodeOrigin m [HieAST b]
makeNode FieldLabel
lbl SrcSpan
span
      , forall a. ToHie a => a -> HieM [HieAST Type]
toHie forall a b. (a -> b) -> a -> b
$ forall a. ContextInfo -> a -> Context a
C (IEType -> ContextInfo
IEThing IEType
c) forall a b. (a -> b) -> a -> b
$ forall l e. l -> e -> GenLocated l e
L SrcSpan
span (FieldLabel -> Name
flSelector FieldLabel
lbl)
      ]

instance ToHie (LocatedA (DocDecl GhcRn)) where
  toHie :: GenLocated SrcSpanAnnA (DocDecl GhcRn) -> HieM [HieAST Type]
toHie (L SrcSpanAnnA
span DocDecl GhcRn
d) = 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 DocDecl GhcRn
d SrcSpanAnnA
span forall a. a -> [a] -> [a]
: case DocDecl GhcRn
d of
    DocCommentNext LHsDoc GhcRn
d -> [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsDoc GhcRn
d ]
    DocCommentPrev LHsDoc GhcRn
d -> [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsDoc GhcRn
d ]
    DocCommentNamed FilePath
_ LHsDoc GhcRn
d -> [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsDoc GhcRn
d ]
    DocGroup TypeIndex
_ LHsDoc GhcRn
d -> [ forall a. ToHie a => a -> HieM [HieAST Type]
toHie LHsDoc GhcRn
d ]

instance ToHie (LHsDoc GhcRn) where
  toHie :: LHsDoc GhcRn -> HieM [HieAST Type]
toHie (L SrcSpan
span d :: HsDoc GhcRn
d@(WithHsDocIdentifiers HsDocString
_ [Located (IdP GhcRn)]
ids)) = 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 HsDoc GhcRn
d SrcSpan
span forall a. a -> [a] -> [a]
: [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) [Located (IdP GhcRn)]
ids]