@@ -1,1928 +0,0 @@
4−Forked from GHC v8.10.1 to work around the readFile side effect in mkHiefile
6−Main functions for .hie file generation
9−{-# LANGUAGE OverloadedStrings #-}
10−{-# LANGUAGE FlexibleInstances #-}
11−{-# LANGUAGE UndecidableInstances #-}
12−{-# LANGUAGE FlexibleContexts #-}
13−{-# LANGUAGE TypeSynonymInstances #-}
14−{-# LANGUAGE ScopedTypeVariables #-}
15−{-# LANGUAGE TypeFamilies #-}
16−{-# LANGUAGE TypeApplications #-}
17−{-# LANGUAGE AllowAmbiguousTypes #-}
18−{-# LANGUAGE ViewPatterns #-}
19−{-# LANGUAGE DeriveDataTypeable #-}
20−module Development.IDE.GHC.HieAst ( mkHieFile ) where
24−import Avail ( Avails )
25−import Bag ( Bag, bagToList )
28−import Class ( FunDep )
29−import CoreUtils ( exprType )
30−import ConLike ( conLikeName )
31−import Desugar ( deSugarExpr )
35−import Module ( ModuleName, ml_hs_file )
36−import MonadUtils ( concatMapM, liftIO )
37−import Name ( Name, nameSrcSpan, setNameLoc )
38−import NameEnv ( NameEnv, emptyNameEnv, extendNameEnv, lookupNameEnv )
40−import TcHsSyn ( hsLitType, hsPatType )
41−import Type ( mkVisFunTys, Type )
42−import TysWiredIn ( mkListTy, mkSumTy )
43−import Var ( Id, Var, setVarName, varName, varType )
45−import MkIface ( mkIfaceExports )
51−import qualified Data.Array as A
52−import qualified Data.ByteString as BS
53−import qualified Data.Map as M
54−import qualified Data.Set as S
55−import Data.Data ( Data, Typeable )
56−import Data.List ( foldl1' )
57−import Data.Maybe ( listToMaybe )
58−import Control.Monad.Trans.Reader
59−import Control.Monad.Trans.Class ( lift )
61−{- Note [Updating HieAst for changes in the GHC AST]
63−When updating the code in this file for changes in the GHC AST, you
64−need to pay attention to the following things:
66−1) Symbols (Names/Vars/Modules) in the following categories:
68− a) Symbols that appear in the source file that directly correspond to
69− something the user typed
70− b) Symbols that don't appear in the source, but should be in some sense
71− "visible" to a user, particularly via IDE tooling or the like. This
72− includes things like the names introduced by RecordWildcards (We record
73− all the names introduced by a (..) in HIE files), and will include implicit
74− parameters and evidence variables after one of my pending MRs lands.
76−2) Subtrees that may contain such symbols, or correspond to a SrcSpan in
77− the file. This includes all `Located` things
79−For 1), you need to call `toHie` for one of the following instances
81−instance ToHie (Context (Located Name)) where ...
82−instance ToHie (Context (Located Var)) where ...
83−instance ToHie (IEContext (Located ModuleName)) where ...
85−`Context` is a data type that looks like:
87−data Context a = C ContextInfo a -- Used for names and bindings
89−`ContextInfo` is defined in `HieTypes`, and looks like
92− = Use -- ^ regular variable
94− | IEThing IEType -- ^ import/export
98− BindType -- ^ whether or not the binding is in an instance
99− Scope -- ^ scope over which the value is bound
100− (Maybe Span) -- ^ span of entire binding
103−It is used to annotate symbols in the .hie files with some extra information on
104−the context in which they occur and should be fairly self explanatory. You need
105−to select one that looks appropriate for the symbol usage. In very rare cases,
106−you might need to extend this sum type if none of the cases seem appropriate.
108−So, given a `Located Name` that is just being "used", and not defined at a
109−particular location, you would do the following:
111− toHie $ C Use located_name
113−If you select one that corresponds to a binding site, you will need to
114−provide a `Scope` and a `Span` for your binding. Both of these are basically
117−The `SrcSpan` in the `Scope` is supposed to span over the part of the source
118−where the symbol can be legally allowed to occur. For more details on how to
119−calculate this, see Note [Capturing Scopes and other non local information]
122−The binding `Span` is supposed to be the span of the entire binding for
125−For a function definition `foo`:
130−The binding `Span` is the span of the entire function definition from `foo x`
131−to `x^2`. For a class definition, this is the span of the entire class, and
132−so on. If this isn't well defined for your bit of syntax (like a variable
133−bound by a lambda), then you can just supply a `Nothing`
135−There is a test that checks that all symbols in the resulting HIE file
136−occur inside their stated `Scope`. This can be turned on by passing the
137−-fvalidate-ide-info flag to ghc along with -fwrite-ide-info to generate the
140−You may also want to provide a test in testsuite/test/hiefile that includes
141−a file containing your new construction, and tests that the calculated scope
142−is valid (by using -fvalidate-ide-info)
144−For subtrees in the AST that may contain symbols, the procedure is fairly
145−straightforward. If you are extending the GHC AST, you will need to provide a
146−`ToHie` instance for any new types you may have introduced in the AST.
148−Here are is an extract from the `ToHie` instance for (LHsExpr (GhcPass p)):
150− toHie e@(L mspan oexpr) = concatM $ getTypeNode e : case oexpr of
151− HsVar _ (L _ var) ->
152− [ toHie $ C Use (L mspan var)
153− -- Patch up var location since typechecker removes it
155− HsConLikeOut _ con ->
156− [ toHie $ C Use $ L mspan $ conLikeName con
164−If your subtree is `Located` or has a `SrcSpan` available, the output list
165−should contain a HieAst `Node` corresponding to the subtree. You can use
166−either `makeNode` or `getTypeNode` for this purpose, depending on whether it
167−makes sense to assign a `Type` to the subtree. After this, you just need
168−to concatenate the result of calling `toHie` on all subexpressions and
169−appropriately annotated symbols contained in the subtree.
171−The code above from the ToHie instance of `LhsExpr (GhcPass p)` is supposed
172−to work for both the renamed and typechecked source. `getTypeNode` is from
173−the `HasType` class defined in this file, and it has different instances
174−for `GhcTc` and `GhcRn` that allow it to access the type of the expression
175−when given a typechecked AST:
177−class Data a => HasType a where
178− getTypeNode :: a -> HieM [HieAST Type]
179−instance HasType (LHsExpr GhcTc) where
180− getTypeNode e@(L spn e') = ... -- Actually get the type for this expression
181−instance HasType (LHsExpr GhcRn) where
182− getTypeNode (L spn e) = makeNode e spn -- Fallback to a regular `makeNode` without recording the type
184−If your subtree doesn't have a span available, you can omit the `makeNode`
185−call and just recurse directly in to the subexpressions.
189−-- These synonyms match those defined in main/GHC.hs
190−type RenamedSource = ( HsGroup GhcRn, [LImportDecl GhcRn]
191− , Maybe [(LIE GhcRn, Avails)]
192− , Maybe LHsDocString )
193−type TypecheckedSource = LHsBinds GhcTc
196−{- Note [Name Remapping]
197−The Typechecker introduces new names for mono names in AbsBinds.
198−We don't care about the distinction between mono and poly bindings,
199−so we replace all occurrences of the mono name with the poly name.
201−newtype HieState = HieState
202− { name_remapping :: NameEnv Id
205−initState :: HieState
206−initState = HieState emptyNameEnv
208−class ModifyState a where -- See Note [Name Remapping]
209− addSubstitution :: a -> a -> HieState -> HieState
211−instance ModifyState Name where
212− addSubstitution _ _ hs = hs
214−instance ModifyState Id where
215− addSubstitution mono poly hs =
216− hs{name_remapping = extendNameEnv (name_remapping hs) (varName mono) poly}
218−modifyState :: ModifyState (IdP p) => [ABExport p] -> HieState -> HieState
219−modifyState = foldr go id
221− go ABE{abe_poly=poly,abe_mono=mono} f = addSubstitution mono poly . f
224−type HieM = ReaderT HieState Hsc
226−-- | Construct an 'HieFile' from the outputs of the typechecker.
227−mkHieFile :: ModSummary
230− -> BS.ByteString -> Hsc HieFile
231−mkHieFile ms ts rs src = do
232− let tc_binds = tcg_binds ts
233− (asts', arr) <- getCompressedAsts tc_binds rs
234− let Just src_file = ml_hs_file $ ms_location ms
236− { hie_hs_file = src_file
237− , hie_module = ms_mod ms
240− -- mkIfaceExports sorts the AvailInfos for stability
241− , hie_exports = mkIfaceExports (tcg_exports ts)
245−getCompressedAsts :: TypecheckedSource -> RenamedSource
246− -> Hsc (HieASTs TypeIndex, A.Array TypeIndex HieTypeFlat)
247−getCompressedAsts ts rs = do
248− asts <- enrichHie ts rs
249− return $ compressTypes asts
251−enrichHie :: TypecheckedSource -> RenamedSource -> Hsc (HieASTs Type)
252−enrichHie ts (hsGrp, imports, exports, _) = flip runReaderT initState $ do
253− tasts <- toHie $ fmap (BC RegularBind ModuleScope) ts
254− rasts <- processGrp hsGrp
255− imps <- toHie $ filter (not . ideclImplicit . unLoc) imports
256− exps <- toHie $ fmap (map $ IEC Export . fst) exports
257− let spanFile children = case children of
258− [] -> mkRealSrcSpan (mkRealSrcLoc "" 1 1) (mkRealSrcLoc "" 1 1)
259− _ -> mkRealSrcSpan (realSrcSpanStart $ nodeSpan $ head children)
260− (realSrcSpanEnd $ nodeSpan $ last children)
263− Node (simpleNodeInfo "Module" "Module") (spanFile xs) xs
266− $ resolveTyVarScopes
267− $ M.map (modulify . mergeSortAsts)
268− $ M.fromListWith (++)
269− $ map (\x -> (srcSpanFile (nodeSpan x),[x])) flat_asts
279− processGrp grp = concatM
280− [ toHie $ fmap (RS ModuleScope ) hs_valds grp
281− , toHie $ hs_splcds grp
282− , toHie $ hs_tyclds grp
283− , toHie $ hs_derivds grp
284− , toHie $ hs_fixds grp
285− , toHie $ hs_defds grp
286− , toHie $ hs_fords grp
287− , toHie $ hs_warnds grp
288− , toHie $ hs_annds grp
289− , toHie $ hs_ruleds grp
292−getRealSpan :: SrcSpan -> Maybe Span
293−getRealSpan (RealSrcSpan sp) = Just sp
294−getRealSpan _ = Nothing
296−grhss_span :: GRHSs p body -> SrcSpan
297−grhss_span (GRHSs _ xs bs) = foldl' combineSrcSpans (getLoc bs) (map getLoc xs)
298−grhss_span (XGRHSs _) = panic "XGRHS has no span"
300−bindingsOnly :: [Context Name] -> [HieAST a]
302−bindingsOnly (C c n : xs) = case nameSrcSpan n of
303− RealSrcSpan span -> Node nodeinfo span [] : bindingsOnly xs
304− where nodeinfo = NodeInfo S.empty [] (M.singleton (Right n) info)
305− info = mempty{identInfo = S.singleton c}
306− _ -> bindingsOnly xs
308−concatM :: Monad m => [m [a]] -> m [a]
309−concatM xs = concat <$> sequence xs
311−{- Note [Capturing Scopes and other non local information]
312−toHie is a local tranformation, but scopes of bindings cannot be known locally,
313−hence we have to push the relevant info down into the binding nodes.
314−We use the following types (*Context and *Scoped) to wrap things and
315−carry the required info
316−(Maybe Span) always carries the span of the entire binding, including rhs
318−data Context a = C ContextInfo a -- Used for names and bindings
320−data RContext a = RC RecFieldContext a
321−data RFContext a = RFC RecFieldContext (Maybe Span) a
322−-- ^ context for record fields
324−data IEContext a = IEC IEType a
325−-- ^ context for imports/exports
327−data BindContext a = BC BindType Scope a
328−-- ^ context for imports/exports
330−data PatSynFieldContext a = PSC (Maybe Span) a
331−-- ^ context for pattern synonym fields.
333−data SigContext a = SC SigInfo a
334−-- ^ context for type signatures
336−data SigInfo = SI SigType (Maybe Span)
338−data SigType = BindSig | ClassSig | InstSig
340−data RScoped a = RS Scope a
341−-- ^ Scope spans over everything to the right of a, (mostly) not
342−-- including a itself
343−-- (Includes a in a few special cases like recursive do bindings) or
344−-- let/where bindings
347−data PScoped a = PS (Maybe Span)
348− Scope -- ^ use site of the pattern
349− Scope -- ^ pattern to the right of a, not including a
351− deriving (Typeable, Data) -- Pattern Scope
353−{- Note [TyVar Scopes]
354−Due to -XScopedTypeVariables, type variables can be in scope quite far from
355−their original binding. We resolve the scope of these type variables
358−data TScoped a = TS TyVarScope a -- TyVarScope
360−data TVScoped a = TVS TyVarScope Scope a -- TyVarScope
361−-- ^ First scope remains constant
362−-- Second scope is used to build up the scope of a tyvar over
363−-- things to its right, ala RScoped
365−-- | Each element scopes over the elements to the right
366−listScopes :: Scope -> [Located a] -> [RScoped (Located a)]
368−listScopes rhsScope [pat] = [RS rhsScope pat]
369−listScopes rhsScope (pat : pats) = RS sc pat : pats'
371− pats'@((RS scope p):_) = listScopes rhsScope pats
372− sc = combineScopes scope $ mkScope $ getLoc p
374−-- | 'listScopes' specialised to 'PScoped' things
379− -> [LPat (GhcPass p)]
380− -> [PScoped (LPat (GhcPass p))]
381−patScopes rsp useScope patScope xs =
382− map (\(RS sc a) -> PS rsp useScope sc (composeSrcSpan a)) $
383− listScopes patScope (map dL xs)
385−-- | 'listScopes' specialised to 'TVScoped' things
390− -> [TVScoped (LHsTyVarBndr a)]
391−tvScopes tvScope rhsScope xs =
392− map (\(RS sc a)-> TVS tvScope sc a) $ listScopes rhsScope xs
394−{- Note [Scoping Rules for SigPat]
395−Explicitly quantified variables in pattern type signatures are not
396−brought into scope in the rhs, but implicitly quantified variables
398−This is unlike other signatures, where explicitly quantified variables
399−are brought into the RHS Scope
401−foo :: forall a. ...;
402−foo = ... -- a is in scope here
404−bar (x :: forall a. a -> a) = ... -- a is not in scope here
405−-- ^ a is in scope here (pattern body)
407−bax (x :: a) = ... -- a is in scope here
408−Because of HsWC and HsIB pass on their scope to their children
409−we must wrap the LHsType in pattern signatures in a
410−Shielded explictly, so that the HsWC/HsIB scope is not passed
414−data Shielded a = SH Scope a -- Ignores its TScope, uses its own scope instead
416−type family ProtectedSig a where
417− ProtectedSig GhcRn = HsWildCardBndrs GhcRn (HsImplicitBndrs
419− (Shielded (LHsType GhcRn)))
420− ProtectedSig GhcTc = NoExtField
422−class ProtectSig a where
423− protectSig :: Scope -> LHsSigWcType (NoGhcTc a) -> ProtectedSig a
425−instance (HasLoc a) => HasLoc (Shielded a) where
426− loc (SH _ a) = loc a
428−instance (ToHie (TScoped a)) => ToHie (TScoped (Shielded a)) where
429− toHie (TS _ (SH sc a)) = toHie (TS (ResolvedScopes [sc]) a)
431−instance ProtectSig GhcTc where
432− protectSig _ _ = noExtField
434−instance ProtectSig GhcRn where
435− protectSig sc (HsWC a (HsIB b sig)) =
436− HsWC a (HsIB b (SH sc sig))
437− protectSig _ (HsWC _ (XHsImplicitBndrs nec)) = noExtCon nec
438− protectSig _ (XHsWildCardBndrs nec) = noExtCon nec
441− -- ^ defined so that HsImplicitBndrs and HsWildCardBndrs can
442− -- know what their implicit bindings are scoping over
445−instance HasLoc thing => HasLoc (TScoped thing) where
446− loc (TS _ a) = loc a
448−instance HasLoc thing => HasLoc (PScoped thing) where
449− loc (PS _ _ _ a) = loc a
451−instance HasLoc (LHsQTyVars GhcRn) where
452− loc (HsQTvs _ vs) = loc vs
455−instance HasLoc thing => HasLoc (HsImplicitBndrs a thing) where
456− loc (HsIB _ a) = loc a
459−instance HasLoc thing => HasLoc (HsWildCardBndrs a thing) where
460− loc (HsWC _ a) = loc a
463−instance HasLoc (Located a) where
466−instance HasLoc a => HasLoc [a] where
468− loc xs = foldl1' combineSrcSpans $ map loc xs
470−instance HasLoc a => HasLoc (FamEqn s a) where
471− loc (FamEqn _ a Nothing b _ c) = foldl1' combineSrcSpans [loc a, loc b, loc c]
472− loc (FamEqn _ a (Just tvs) b _ c) = foldl1' combineSrcSpans
473− [loc a, loc tvs, loc b, loc c]
475−instance (HasLoc tm, HasLoc ty) => HasLoc (HsArg tm ty) where
476− loc (HsValArg tm) = loc tm
477− loc (HsTypeArg _ ty) = loc ty
478− loc (HsArgPar sp) = sp
480−instance HasLoc (HsDataDefn GhcRn) where
481− loc def@(HsDataDefn{}) = loc $ dd_cons def
482− -- Only used for data family instances, so we only need rhs
483− -- Most probably the rest will be unhelpful anyway
486−{- Note [Real DataCon Name]
487−The typechecker subtitutes the conLikeWrapId for the name, but we don't want
488−this showing up in the hieFile, so we replace the name in the Id with the
489−original datacon name
490−See also Note [Data Constructor Naming]
492−class HasRealDataConName p where
493− getRealDataCon :: XRecordCon p -> Located (IdP p) -> Located (IdP p)
495−instance HasRealDataConName GhcRn where
496− getRealDataCon _ n = n
497−instance HasRealDataConName GhcTc where
498− getRealDataCon RecordConTc{rcon_con_like = con} (L sp var) =
499− L sp (setVarName var (conLikeName con))
501−-- | The main worker class
502−-- See Note [Updating HieAst for changes in the GHC AST] for more information
503−-- on how to add/modify instances for this.
505− toHie :: a -> HieM [HieAST Type]
507−-- | Used to collect type info
508−class Data a => HasType a where
509− getTypeNode :: a -> HieM [HieAST Type]
511−instance (ToHie a) => ToHie [a] where
512− toHie = concatMapM toHie
514−instance (ToHie a) => ToHie (Bag a) where
515− toHie = toHie . bagToList
517−instance (ToHie a) => ToHie (Maybe a) where
518− toHie = maybe (pure []) toHie
520−instance ToHie (Context (Located NoExtField)) where
523−instance ToHie (TScoped NoExtField) where
526−instance ToHie (IEContext (Located ModuleName)) where
527− toHie (IEC c (L (RealSrcSpan span) mname)) =
528− pure $ [Node (NodeInfo S.empty [] idents) span []]
529− where details = mempty{identInfo = S.singleton (IEThing c)}
530− idents = M.singleton (Left mname) details
533−instance ToHie (Context (Located Var)) where
535− C context (L (RealSrcSpan span) name')
537− m <- asks name_remapping
538− let name = case lookupNameEnv m (varName name') of
543− (NodeInfo S.empty [] $
544− M.singleton (Right $ varName name)
545− (IdentifierDetails (Just $ varType name')
546− (S.singleton context)))
551−instance ToHie (Context (Located Name)) where
553− C context (L (RealSrcSpan span) name') -> do
554− m <- asks name_remapping
555− let name = case lookupNameEnv m name' of
556− Just var -> varName var
560− (NodeInfo S.empty [] $
561− M.singleton (Right name)
562− (IdentifierDetails Nothing
563− (S.singleton context)))
568−-- | Dummy instances - never called
569−instance ToHie (TScoped (LHsSigWcType GhcTc)) where
571−instance ToHie (TScoped (LHsWcType GhcTc)) where
573−instance ToHie (SigContext (LSig GhcTc)) where
575−instance ToHie (TScoped Type) where
578−instance HasType (LHsBind GhcRn) where
579− getTypeNode (L spn bind) = makeNode bind spn
581−instance HasType (LHsBind GhcTc) where
582− getTypeNode (L spn bind) = case bind of
583− FunBind{fun_id = name} -> makeTypeNode bind spn (varType $ unLoc name)
584− _ -> makeNode bind spn
586−instance HasType (Located (Pat GhcRn)) where
587− getTypeNode (dL -> L spn pat) = makeNode pat spn
589−instance HasType (Located (Pat GhcTc)) where
590− getTypeNode (dL -> L spn opat) = makeTypeNode opat spn (hsPatType opat)
592−instance HasType (LHsExpr GhcRn) where
593− getTypeNode (L spn e) = makeNode e spn
595−-- | This instance tries to construct 'HieAST' nodes which include the type of
596−-- the expression. It is not yet possible to do this efficiently for all
597−-- expression forms, so we skip filling in the type for those inputs.
599−-- 'HsApp', for example, doesn't have any type information available directly on
600−-- the node. Our next recourse would be to desugar it into a 'CoreExpr' then
601−-- query the type of that. Yet both the desugaring call and the type query both
602−-- involve recursive calls to the function and argument! This is particularly
603−-- problematic when you realize that the HIE traversal will eventually visit
604−-- those nodes too and ask for their types again.
606−-- Since the above is quite costly, we just skip cases where computing the
607−-- expression's type is going to be expensive.
610−instance HasType (LHsExpr GhcTc) where
611− getTypeNode e@(L spn e') = lift $
612− -- Some expression forms have their type immediately available
613− let tyOpt = case e' of
614− HsLit _ l -> Just (hsLitType l)
615− HsOverLit _ o -> Just (overLitType o)
617− HsLam _ (MG { mg_ext = groupTy }) -> Just (matchGroupType groupTy)
618− HsLamCase _ (MG { mg_ext = groupTy }) -> Just (matchGroupType groupTy)
619− HsCase _ _ (MG { mg_ext = groupTy }) -> Just (mg_res_ty groupTy)
621− ExplicitList ty _ _ -> Just (mkListTy ty)
622− ExplicitSum ty _ _ _ -> Just (mkSumTy ty)
623− HsDo ty _ _ -> Just ty
624− HsMultiIf ty _ -> Just ty
630− Just t -> makeTypeNode e' spn t
632− | skipDesugaring e' -> fallback
634− hs_env <- Hsc $ \e w -> return (e,w)
635− (_,mbe) <- liftIO $ deSugarExpr hs_env e
636− maybe fallback (makeTypeNode e' spn . exprType) mbe
638− fallback = makeNode e' spn
640− matchGroupType :: MatchGroupTc -> Type
641− matchGroupType (MatchGroupTc args res) = mkVisFunTys args res
643− -- | Skip desugaring of these expressions for performance reasons.
645− -- See impact on Haddock output (esp. missing type annotations or links)
646− -- before marking more things here as 'False'. See impact on Haddock
647− -- performance before marking more things as 'True'.
648− skipDesugaring :: HsExpr a -> Bool
649− skipDesugaring e = case e of
651− HsUnboundVar{} -> False
652− HsConLikeOut{} -> False
654− HsOverLabel{} -> False
659−instance ( ToHie (Context (Located (IdP a)))
660− , ToHie (MatchGroup a (LHsExpr a))
661− , ToHie (PScoped (LPat a))
662− , ToHie (GRHSs a (LHsExpr a))
664− , ToHie (Located (PatSynBind a a))
665− , HasType (LHsBind a)
666− , ModifyState (IdP a)
668− ) => ToHie (BindContext (LHsBind a)) where
669− toHie (BC context scope b@(L span bind)) =
670− concatM $ getTypeNode b : case bind of
671− FunBind{fun_id = name, fun_matches = matches} ->
672− [ toHie $ C (ValBind context scope $ getRealSpan span) name
675− PatBind{pat_lhs = lhs, pat_rhs = rhs} ->
676− [ toHie $ PS (getRealSpan span) scope NoScope lhs
679− VarBind{var_rhs = expr} ->
682− AbsBinds{abs_exports = xs, abs_binds = binds} ->
683− [ local (modifyState xs) $ -- Note [Name Remapping]
684− toHie $ fmap (BC context scope) binds
687− [ toHie $ L span psb -- PatSynBinds only occur at the top level
691−instance ( ToHie (LMatch a body)
692− ) => ToHie (MatchGroup a body) where
693− toHie mg = concatM $ case mg of
694− MG{ mg_alts = (L span alts) , mg_origin = FromSource } ->
695− [ pure $ locOnly span
701−instance ( ToHie (Context (Located (IdP a)))
702− , ToHie (PScoped (LPat a))
703− , ToHie (HsPatSynDir a)
704− ) => ToHie (Located (PatSynBind a a)) where
705− toHie (L sp psb) = concatM $ case psb of
706− PSB{psb_id=var, psb_args=dets, psb_def=pat, psb_dir=dir} ->
707− [ toHie $ C (Decl PatSynDec $ getRealSpan sp) var
708− , toHie $ toBind dets
709− , toHie $ PS Nothing lhsScope NoScope pat
713− lhsScope = combineScopes varScope detScope
714− varScope = mkLScope var
715− detScope = case dets of
716− (PrefixCon args) -> foldr combineScopes NoScope $ map mkLScope args
717− (InfixCon a b) -> combineScopes (mkLScope a) (mkLScope b)
718− (RecCon r) -> foldr go NoScope r
719− go (RecordPatSynField a b) c = combineScopes c
720− $ combineScopes (mkLScope a) (mkLScope b)
721− detSpan = case detScope of
722− LocalScope a -> Just a
724− toBind (PrefixCon args) = PrefixCon $ map (C Use) args
725− toBind (InfixCon a b) = InfixCon (C Use a) (C Use b)
726− toBind (RecCon r) = RecCon $ map (PSC detSpan) r
729−instance ( ToHie (MatchGroup a (LHsExpr a))
730− ) => ToHie (HsPatSynDir a) where
731− toHie dir = case dir of
732− ExplicitBidirectional mg -> toHie mg
735−instance ( a ~ GhcPass p
737− , ToHie (HsMatchContext (NameOrRdrName (IdP a)))
738− , ToHie (PScoped (LPat a))
739− , ToHie (GRHSs a body)
740− , Data (Match a body)
741− ) => ToHie (LMatch (GhcPass p) body) where
742− toHie (L span m ) = concatM $ makeNode m span : case m of
743− Match{m_ctxt=mctx, m_pats = pats, m_grhss = grhss } ->
745− , let rhsScope = mkScope $ grhss_span grhss
746− in toHie $ patScopes Nothing rhsScope NoScope pats
751−instance ( ToHie (Context (Located a))
752− ) => ToHie (HsMatchContext a) where
753− toHie (FunRhs{mc_fun=name}) = toHie $ C MatchBind name
754− toHie (StmtCtxt a) = toHie a
757−instance ( ToHie (HsMatchContext a)
758− ) => ToHie (HsStmtContext a) where
759− toHie (PatGuard a) = toHie a
760− toHie (ParStmtCtxt a) = toHie a
761− toHie (TransStmtCtxt a) = toHie a
764−instance ( a ~ GhcPass p
765− , ToHie (Context (Located (IdP a)))
766− , ToHie (RContext (HsRecFields a (PScoped (LPat a))))
768− , ToHie (TScoped (LHsSigWcType a))
770− , ToHie (TScoped (ProtectedSig a))
773− ) => ToHie (PScoped (Located (Pat (GhcPass p)))) where
774− toHie (PS rsp scope pscope lpat@(dL -> L ospan opat)) =
775− concatM $ getTypeNode lpat : case opat of
779− [ toHie $ C (PatternBind scope pscope rsp) lname
782− [ toHie $ PS rsp scope pscope p
784− AsPat _ lname pat ->
785− [ toHie $ C (PatternBind scope
786− (combineScopes (mkLScope (dL pat)) pscope)
789− , toHie $ PS rsp scope pscope pat
792− [ toHie $ PS rsp scope pscope pat
795− [ toHie $ PS rsp scope pscope pat
798− [ toHie $ patScopes rsp scope pscope pats
800− TuplePat _ pats _ ->
801− [ toHie $ patScopes rsp scope pscope pats
804− [ toHie $ PS rsp scope pscope pat
808− , toHie $ contextify dets
810− ConPatOut {pat_con = con, pat_args = dets}->
811− [ toHie $ C Use $ fmap conLikeName con
812− , toHie $ contextify dets
814− ViewPat _ expr pat ->
816− , toHie $ PS rsp scope pscope pat
819− [ toHie $ L ospan sp
825− NPlusKPat _ n _ _ _ _ ->
826− [ toHie $ C (PatternBind scope pscope rsp) n
829− [ toHie $ PS rsp scope pscope pat
830− , let cscope = mkLScope (dL pat) in
831− toHie $ TS (ResolvedScopes [cscope, scope, pscope])
832− (protectSig @a cscope sig)
833− -- See Note [Scoping Rules for SigPat]
839− contextify (PrefixCon args) = PrefixCon $ patScopes rsp scope pscope args
840− contextify (InfixCon a b) = InfixCon a' b'
841− where [a', b'] = patScopes rsp scope pscope [a,b]
842− contextify (RecCon r) = RecCon $ RC RecFieldMatch $ contextify_rec r
843− contextify_rec (HsRecFields fds a) = HsRecFields (map go scoped_fds) a
845− go (RS fscope (L spn (HsRecField lbl pat pun))) =
846− L spn $ HsRecField lbl (PS rsp scope fscope pat) pun
847− scoped_fds = listScopes pscope fds
849−instance ( ToHie body
850− , ToHie (LGRHS a body)
851− , ToHie (RScoped (LHsLocalBinds a))
852− ) => ToHie (GRHSs a body) where
853− toHie grhs = concatM $ case grhs of
854− GRHSs _ grhss binds ->
856− , toHie $ RS (mkScope $ grhss_span grhs) binds
860−instance ( ToHie (Located body)
861− , ToHie (RScoped (GuardLStmt a))
862− , Data (GRHS a (Located body))
863− ) => ToHie (LGRHS a (Located body)) where
864− toHie (L span g) = concatM $ makeNode g span : case g of
865− GRHS _ guards body ->
866− [ toHie $ listScopes (mkLScope body) guards
871−instance ( a ~ GhcPass p
872− , ToHie (Context (Located (IdP a)))
873− , HasType (LHsExpr a)
874− , ToHie (PScoped (LPat a))
875− , ToHie (MatchGroup a (LHsExpr a))
876− , ToHie (LGRHS a (LHsExpr a))
877− , ToHie (RContext (HsRecordBinds a))
878− , ToHie (RFContext (Located (AmbiguousFieldOcc a)))
879− , ToHie (ArithSeqInfo a)
880− , ToHie (LHsCmdTop a)
881− , ToHie (RScoped (GuardLStmt a))
882− , ToHie (RScoped (LHsLocalBinds a))
883− , ToHie (TScoped (LHsWcType (NoGhcTc a)))
884− , ToHie (TScoped (LHsSigWcType (NoGhcTc a)))
888− , Data (AmbiguousFieldOcc a)
889− , (HasRealDataConName a)
890− ) => ToHie (LHsExpr (GhcPass p)) where
891− toHie e@(L mspan oexpr) = concatM $ getTypeNode e : case oexpr of
892− HsVar _ (L _ var) ->
893− [ toHie $ C Use (L mspan var)
894− -- Patch up var location since typechecker removes it
898− HsConLikeOut _ con ->
899− [ toHie $ C Use $ L mspan $ conLikeName con
902− [ toHie $ RFC RecFieldOcc Nothing (L mspan fld)
904− HsOverLabel _ _ _ -> []
918− HsAppType _ expr sig ->
920− , toHie $ TS (ResolvedScopes []) sig
941− ExplicitTuple _ args _ ->
944− ExplicitSum _ _ _ expr ->
947− HsCase _ expr matches ->
956− HsMultiIf _ grhss ->
959− HsLet _ binds expr ->
960− [ toHie $ RS (mkLScope expr) binds
963− HsDo _ _ (L ispan stmts) ->
964− [ pure $ locOnly ispan
965− , toHie $ listScopes NoScope stmts
967− ExplicitList _ _ exprs ->
970− RecordCon {rcon_ext = mrealcon, rcon_con_name = name, rcon_flds = binds} ->
971− [ toHie $ C Use (getRealDataCon @a mrealcon name)
972− -- See Note [Real DataCon Name]
973− , toHie $ RC RecFieldAssign $ binds
975− RecordUpd {rupd_expr = expr, rupd_flds = upds}->
977− , toHie $ map (RC RecFieldAssign) upds
979− ExprWithTySig _ expr sig ->
981− , toHie $ TS (ResolvedScopes [mkLScope expr]) sig
983− ArithSeq _ _ info ->
989− HsCoreAnn _ _ _ expr ->
992− HsProc _ pat cmdtop ->
993− [ toHie $ PS Nothing (mkLScope cmdtop) NoScope pat
1002− HsBinTick _ _ _ expr ->
1005− HsTickPragma _ _ _ _ expr ->
1009− [ toHie $ L mspan a
1014− HsRnBracketOut _ b p ->
1018− HsTcBracketOut _ b p ->
1023− [ toHie $ L mspan x
1027−instance ( a ~ GhcPass p
1028− , ToHie (LHsExpr a)
1029− , Data (HsTupArg a)
1030− ) => ToHie (LHsTupArg (GhcPass p)) where
1031− toHie (L span arg) = concatM $ makeNode arg span : case arg of
1038−instance ( a ~ GhcPass p
1039− , ToHie (PScoped (LPat a))
1040− , ToHie (LHsExpr a)
1041− , ToHie (SigContext (LSig a))
1042− , ToHie (RScoped (LHsLocalBinds a))
1043− , ToHie (RScoped (ApplicativeArg a))
1044− , ToHie (Located body)
1045− , Data (StmtLR a a (Located body))
1046− , Data (StmtLR a a (Located (HsExpr a)))
1047− ) => ToHie (RScoped (LStmt (GhcPass p) (Located body))) where
1048− toHie (RS scope (L span stmt)) = concatM $ makeNode stmt span : case stmt of
1049− LastStmt _ body _ _ ->
1052− BindStmt _ pat body _ _ ->
1053− [ toHie $ PS (getRealSpan $ getLoc body) scope NoScope pat
1056− ApplicativeStmt _ stmts _ ->
1057− [ concatMapM (toHie . RS scope . snd) stmts
1059− BodyStmt _ body _ _ ->
1063− [ toHie $ RS scope binds
1065− ParStmt _ parstmts _ _ ->
1066− [ concatMapM (\(ParStmtBlock _ stmts _ _) ->
1067− toHie $ listScopes NoScope stmts)
1070− TransStmt {trS_stmts = stmts, trS_using = using, trS_by = by} ->
1071− [ toHie $ listScopes scope stmts
1075− RecStmt {recS_stmts = stmts} ->
1076− [ toHie $ map (RS $ combineScopes scope (mkScope span)) stmts
1080−instance ( ToHie (LHsExpr a)
1081− , ToHie (PScoped (LPat a))
1082− , ToHie (BindContext (LHsBind a))
1083− , ToHie (SigContext (LSig a))
1084− , ToHie (RScoped (HsValBindsLR a a))
1085− , Data (HsLocalBinds a)
1086− ) => ToHie (RScoped (LHsLocalBinds a)) where
1087− toHie (RS scope (L sp binds)) = concatM $ makeNode binds sp : case binds of
1088− EmptyLocalBinds _ -> []
1089− HsIPBinds _ _ -> []
1090− HsValBinds _ valBinds ->
1091− [ toHie $ RS (combineScopes scope $ mkScope sp)
1094− XHsLocalBindsLR _ -> []
1096−instance ( ToHie (BindContext (LHsBind a))
1097− , ToHie (SigContext (LSig a))
1098− , ToHie (RScoped (XXValBindsLR a a))
1099− ) => ToHie (RScoped (HsValBindsLR a a)) where
1100− toHie (RS sc v) = concatM $ case v of
1101− ValBinds _ binds sigs ->
1102− [ toHie $ fmap (BC RegularBind sc) binds
1103− , toHie $ fmap (SC (SI BindSig Nothing)) sigs
1105− XValBindsLR x -> [ toHie $ RS sc x ]
1107−instance ToHie (RScoped (NHsValBindsLR GhcTc)) where
1108− toHie (RS sc (NValBinds binds sigs)) = concatM $
1109− [ toHie (concatMap (map (BC RegularBind sc) . bagToList . snd) binds)
1110− , toHie $ fmap (SC (SI BindSig Nothing)) sigs
1112−instance ToHie (RScoped (NHsValBindsLR GhcRn)) where
1113− toHie (RS sc (NValBinds binds sigs)) = concatM $
1114− [ toHie (concatMap (map (BC RegularBind sc) . bagToList . snd) binds)
1115− , toHie $ fmap (SC (SI BindSig Nothing)) sigs
1118−instance ( ToHie (RContext (LHsRecField a arg))
1119− ) => ToHie (RContext (HsRecFields a arg)) where
1120− toHie (RC c (HsRecFields fields _)) = toHie $ map (RC c) fields
1122−instance ( ToHie (RFContext (Located label))
1127− ) => ToHie (RContext (LHsRecField' label arg)) where
1128− toHie (RC c (L span recfld)) = concatM $ makeNode recfld span : case recfld of
1129− HsRecField label expr _ ->
1130− [ toHie $ RFC c (getRealSpan $ loc expr) label
1134−removeDefSrcSpan :: Name -> Name
1135−removeDefSrcSpan n = setNameLoc n noSrcSpan
1137−instance ToHie (RFContext (LFieldOcc GhcRn)) where
1138− toHie (RFC c rhs (L nspan f)) = concatM $ case f of
1140− [ toHie $ C (RecField c rhs) (L nspan $ removeDefSrcSpan name)
1144−instance ToHie (RFContext (LFieldOcc GhcTc)) where
1145− toHie (RFC c rhs (L nspan f)) = concatM $ case f of
1147− let var' = setVarName var (removeDefSrcSpan $ varName var)
1148− in [ toHie $ C (RecField c rhs) (L nspan var')
1152−instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcRn))) where
1153− toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of
1154− Unambiguous name _ ->
1155− [ toHie $ C (RecField c rhs) $ L nspan $ removeDefSrcSpan name
1157− Ambiguous _name _ ->
1159− XAmbiguousFieldOcc _ -> []
1161−instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcTc))) where
1162− toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of
1163− Unambiguous var _ ->
1164− let var' = setVarName var (removeDefSrcSpan $ varName var)
1165− in [ toHie $ C (RecField c rhs) (L nspan var')
1168− let var' = setVarName var (removeDefSrcSpan $ varName var)
1169− in [ toHie $ C (RecField c rhs) (L nspan var')
1171− XAmbiguousFieldOcc _ -> []
1173−instance ( a ~ GhcPass p
1174− , ToHie (PScoped (LPat a))
1175− , ToHie (BindContext (LHsBind a))
1176− , ToHie (LHsExpr a)
1177− , ToHie (SigContext (LSig a))
1178− , ToHie (RScoped (HsValBindsLR a a))
1179− , Data (StmtLR a a (Located (HsExpr a)))
1180− , Data (HsLocalBinds a)
1181− ) => ToHie (RScoped (ApplicativeArg (GhcPass p))) where
1182− toHie (RS sc (ApplicativeArgOne _ pat expr _ _)) = concatM
1183− [ toHie $ PS Nothing sc NoScope pat
1186− toHie (RS sc (ApplicativeArgMany _ stmts _ pat)) = concatM
1187− [ toHie $ listScopes NoScope stmts
1188− , toHie $ PS Nothing sc NoScope pat
1190− toHie (RS _ (XApplicativeArg _)) = pure []
1192−instance (ToHie arg, ToHie rec) => ToHie (HsConDetails arg rec) where
1193− toHie (PrefixCon args) = toHie args
1194− toHie (RecCon rec) = toHie rec
1195− toHie (InfixCon a b) = concatM [ toHie a, toHie b]
1197−instance ( ToHie (LHsCmd a)
1198− , Data (HsCmdTop a)
1199− ) => ToHie (LHsCmdTop a) where
1200− toHie (L span top) = concatM $ makeNode top span : case top of
1206−instance ( a ~ GhcPass p
1207− , ToHie (PScoped (LPat a))
1208− , ToHie (BindContext (LHsBind a))
1209− , ToHie (LHsExpr a)
1210− , ToHie (MatchGroup a (LHsCmd a))
1211− , ToHie (SigContext (LSig a))
1212− , ToHie (RScoped (HsValBindsLR a a))
1214− , Data (HsCmdTop a)
1215− , Data (StmtLR a a (Located (HsCmd a)))
1216− , Data (HsLocalBinds a)
1217− , Data (StmtLR a a (Located (HsExpr a)))
1218− ) => ToHie (LHsCmd (GhcPass p)) where
1219− toHie (L span cmd) = concatM $ makeNode cmd span : case cmd of
1220− HsCmdArrApp _ a b _ _ ->
1224− HsCmdArrForm _ a _ _ cmdtops ->
1238− HsCmdCase _ expr alts ->
1242− HsCmdIf _ _ a b c ->
1247− HsCmdLet _ binds cmd' ->
1248− [ toHie $ RS (mkLScope cmd') binds
1251− HsCmdDo _ (L ispan stmts) ->
1252− [ pure $ locOnly ispan
1253− , toHie $ listScopes NoScope stmts
1255− HsCmdWrap _ _ _ -> []
1258−instance ToHie (TyClGroup GhcRn) where
1259− toHie TyClGroup{ group_tyclds = classes
1260− , group_roles = roles
1261− , group_kisigs = sigs
1262− , group_instds = instances } =
1269− toHie (XTyClGroup _) = pure []
1271−instance ToHie (LTyClDecl GhcRn) where
1272− toHie (L span decl) = concatM $ makeNode decl span : case decl of
1273− FamDecl {tcdFam = fdecl} ->
1274− [ toHie (L span fdecl)
1276− SynDecl {tcdLName = name, tcdTyVars = vars, tcdRhs = typ} ->
1277− [ toHie $ C (Decl SynDec $ getRealSpan span) name
1278− , toHie $ TS (ResolvedScopes [mkScope $ getLoc typ]) vars
1281− DataDecl {tcdLName = name, tcdTyVars = vars, tcdDataDefn = defn} ->
1282− [ toHie $ C (Decl DataDec $ getRealSpan span) name
1283− , toHie $ TS (ResolvedScopes [quant_scope, rhs_scope]) vars
1287− quant_scope = mkLScope $ dd_ctxt defn
1288− rhs_scope = sig_sc `combineScopes` con_sc `combineScopes` deriv_sc
1289− sig_sc = maybe NoScope mkLScope $ dd_kindSig defn
1290− con_sc = foldr combineScopes NoScope $ map mkLScope $ dd_cons defn
1291− deriv_sc = mkLScope $ dd_derivs defn
1292− ClassDecl { tcdCtxt = context
1299− , tcdATDefs = deftyps
1301− [ toHie $ C (Decl ClassDec $ getRealSpan span) name
1303− , toHie $ TS (ResolvedScopes [context_scope, rhs_scope]) vars
1305− , toHie $ map (SC $ SI ClassSig $ getRealSpan span) sigs
1306− , toHie $ fmap (BC InstanceBind ModuleScope) meths
1308− , concatMapM (pure . locOnly . getLoc) deftyps
1312− context_scope = mkLScope context
1313− rhs_scope = foldl1' combineScopes $ map mkScope
1314− [ loc deps, loc sigs, loc (bagToList meths), loc typs, loc deftyps]
1317−instance ToHie (LFamilyDecl GhcRn) where
1318− toHie (L span decl) = concatM $ makeNode decl span : case decl of
1319− FamilyDecl _ info name vars _ sig inj ->
1320− [ toHie $ C (Decl FamDec $ getRealSpan span) name
1321− , toHie $ TS (ResolvedScopes [rhsSpan]) vars
1323− , toHie $ RS injSpan sig
1327− rhsSpan = sigSpan `combineScopes` injSpan
1328− sigSpan = mkScope $ getLoc sig
1329− injSpan = maybe NoScope (mkScope . getLoc) inj
1330− XFamilyDecl _ -> []
1332−instance ToHie (FamilyInfo GhcRn) where
1333− toHie (ClosedTypeFamily (Just eqns)) = concatM $
1334− [ concatMapM (pure . locOnly . getLoc) eqns
1335− , toHie $ map go eqns
1338− go (L l ib) = TS (ResolvedScopes [mkScope l]) ib
1341−instance ToHie (RScoped (LFamilyResultSig GhcRn)) where
1342− toHie (RS sc (L span sig)) = concatM $ makeNode sig span : case sig of
1349− [ toHie $ TVS (ResolvedScopes [sc]) NoScope bndr
1351− XFamilyResultSig _ -> []
1353−instance ToHie (Located (FunDep (Located Name))) where
1354− toHie (L span fd@(lhs, rhs)) = concatM $
1356− , toHie $ map (C Use) lhs
1357− , toHie $ map (C Use) rhs
1360−instance (ToHie rhs, HasLoc rhs)
1361− => ToHie (TScoped (FamEqn GhcRn rhs)) where
1362− toHie (TS _ f) = toHie f
1364−instance (ToHie rhs, HasLoc rhs)
1365− => ToHie (FamEqn GhcRn rhs) where
1366− toHie fe@(FamEqn _ var tybndrs pats _ rhs) = concatM $
1367− [ toHie $ C (Decl InstDec $ getRealSpan $ loc fe) var
1368− , toHie $ fmap (tvScopes (ResolvedScopes []) scope) tybndrs
1372− where scope = combineScopes patsScope rhsScope
1373− patsScope = mkScope (loc pats)
1374− rhsScope = mkScope (loc rhs)
1375− toHie (XFamEqn _) = pure []
1377−instance ToHie (LInjectivityAnn GhcRn) where
1378− toHie (L span ann) = concatM $ makeNode ann span : case ann of
1379− InjectivityAnn lhs rhs ->
1380− [ toHie $ C Use lhs
1381− , toHie $ map (C Use) rhs
1384−instance ToHie (HsDataDefn GhcRn) where
1385− toHie (HsDataDefn _ _ ctx _ mkind cons derivs) = concatM
1391− toHie (XHsDataDefn _) = pure []
1393−instance ToHie (HsDeriving GhcRn) where
1394− toHie (L span clauses) = concatM
1395− [ pure $ locOnly span
1399−instance ToHie (LHsDerivingClause GhcRn) where
1400− toHie (L span cl) = concatM $ makeNode cl span : case cl of
1401− HsDerivingClause _ strat (L ispan tys) ->
1403− , pure $ locOnly ispan
1404− , toHie $ map (TS (ResolvedScopes [])) tys
1406− XHsDerivingClause _ -> []
1408−instance ToHie (Located (DerivStrategy GhcRn)) where
1409− toHie (L span strat) = concatM $ makeNode strat span : case strat of
1410− StockStrategy -> []
1411− AnyclassStrategy -> []
1412− NewtypeStrategy -> []
1413− ViaStrategy s -> [ toHie $ TS (ResolvedScopes []) s ]
1415−instance ToHie (Located OverlapMode) where
1416− toHie (L span _) = pure $ locOnly span
1418−instance ToHie (LConDecl GhcRn) where
1419− toHie (L span decl) = concatM $ makeNode decl span : case decl of
1420− ConDeclGADT { con_names = names, con_qvars = qvars
1421− , con_mb_cxt = ctx, con_args = args, con_res_ty = typ } ->
1422− [ toHie $ map (C (Decl ConDec $ getRealSpan span)) names
1423− , toHie $ TS (ResolvedScopes [ctxScope, rhsScope]) qvars
1429− rhsScope = combineScopes argsScope tyScope
1430− ctxScope = maybe NoScope mkLScope ctx
1431− argsScope = condecl_scope args
1432− tyScope = mkLScope typ
1433− ConDeclH98 { con_name = name, con_ex_tvs = qvars
1434− , con_mb_cxt = ctx, con_args = dets } ->
1435− [ toHie $ C (Decl ConDec $ getRealSpan span) name
1436− , toHie $ tvScopes (ResolvedScopes []) rhsScope qvars
1441− rhsScope = combineScopes ctxScope argsScope
1442− ctxScope = maybe NoScope mkLScope ctx
1443− argsScope = condecl_scope dets
1445− where condecl_scope args = case args of
1446− PrefixCon xs -> foldr combineScopes NoScope $ map mkLScope xs
1447− InfixCon a b -> combineScopes (mkLScope a) (mkLScope b)
1448− RecCon x -> mkLScope x
1450−instance ToHie (Located [LConDeclField GhcRn]) where
1451− toHie (L span decls) = concatM $
1452− [ pure $ locOnly span
1456−instance ( HasLoc thing
1457− , ToHie (TScoped thing)
1458− ) => ToHie (TScoped (HsImplicitBndrs GhcRn thing)) where
1459− toHie (TS sc (HsIB ibrn a)) = concatM $
1460− [ pure $ bindingsOnly $ map (C $ TyVarBind (mkScope span) sc) ibrn
1464− toHie (TS _ (XHsImplicitBndrs _)) = pure []
1466−instance ( HasLoc thing
1467− , ToHie (TScoped thing)
1468− ) => ToHie (TScoped (HsWildCardBndrs GhcRn thing)) where
1469− toHie (TS sc (HsWC names a)) = concatM $
1470− [ pure $ bindingsOnly $ map (C $ TyVarBind (mkScope span) sc) names
1474− toHie (TS _ (XHsWildCardBndrs _)) = pure []
1476−instance ToHie (LStandaloneKindSig GhcRn) where
1477− toHie (L sp sig) = concatM [makeNode sig sp, toHie sig]
1479−instance ToHie (StandaloneKindSig GhcRn) where
1480− toHie sig = concatM $ case sig of
1481− StandaloneKindSig _ name typ ->
1482− [ toHie $ C TyDecl name
1483− , toHie $ TS (ResolvedScopes []) typ
1485− XStandaloneKindSig _ -> []
1487−instance ToHie (SigContext (LSig GhcRn)) where
1488− toHie (SC (SI styp msp) (L sp sig)) = concatM $ makeNode sig sp : case sig of
1489− TypeSig _ names typ ->
1490− [ toHie $ map (C TyDecl) names
1491− , toHie $ TS (UnresolvedScope (map unLoc names) Nothing) typ
1493− PatSynSig _ names typ ->
1494− [ toHie $ map (C TyDecl) names
1495− , toHie $ TS (UnresolvedScope (map unLoc names) Nothing) typ
1497− ClassOpSig _ _ names typ ->
1499− ClassSig -> toHie $ map (C $ ClassTyDecl $ getRealSpan sp) names
1500− _ -> toHie $ map (C $ TyDecl) names
1501− , toHie $ TS (UnresolvedScope (map unLoc names) msp) typ
1505− [ toHie $ L sp fsig
1507− InlineSig _ name _ ->
1508− [ toHie $ (C Use) name
1510− SpecSig _ name typs _ ->
1511− [ toHie $ (C Use) name
1512− , toHie $ map (TS (ResolvedScopes [])) typs
1514− SpecInstSig _ _ typ ->
1515− [ toHie $ TS (ResolvedScopes []) typ
1517− MinimalSig _ _ form ->
1520− SCCFunSig _ _ name mtxt ->
1521− [ toHie $ (C Use) name
1522− , pure $ maybe [] (locOnly . getLoc) mtxt
1524− CompleteMatchSig _ _ (L ispan names) typ ->
1525− [ pure $ locOnly ispan
1526− , toHie $ map (C Use) names
1527− , toHie $ fmap (C Use) typ
1531−instance ToHie (LHsType GhcRn) where
1532− toHie x = toHie $ TS (ResolvedScopes []) x
1534−instance ToHie (TScoped (LHsType GhcRn)) where
1535− toHie (TS tsc (L span t)) = concatM $ makeNode t span : case t of
1536− HsForAllTy _ _ bndrs body ->
1537− [ toHie $ tvScopes tsc (mkScope $ getLoc body) bndrs
1540− HsQualTy _ ctx body ->
1545− [ toHie $ C Use var
1551− HsAppKindTy _ ty ki ->
1553− , toHie $ TS (ResolvedScopes []) ki
1562− HsTupleTy _ _ tys ->
1576− HsIParamTy _ ip ty ->
1593− HsRecTy _ fields ->
1596− HsExplicitListTy _ _ tys ->
1599− HsExplicitTupleTy _ tys ->
1603− HsWildCardTy _ -> []
1607−instance (ToHie tm, ToHie ty) => ToHie (HsArg tm ty) where
1608− toHie (HsValArg tm) = toHie tm
1609− toHie (HsTypeArg _ ty) = toHie ty
1610− toHie (HsArgPar sp) = pure $ locOnly sp
1612−instance ToHie (TVScoped (LHsTyVarBndr GhcRn)) where
1613− toHie (TVS tsc sc (L span bndr)) = concatM $ makeNode bndr span : case bndr of
1615− [ toHie $ C (TyVarBind sc tsc) var
1617− KindedTyVar _ var kind ->
1618− [ toHie $ C (TyVarBind sc tsc) var
1623−instance ToHie (TScoped (LHsQTyVars GhcRn)) where
1624− toHie (TS sc (HsQTvs implicits vars)) = concatM $
1625− [ pure $ bindingsOnly bindings
1626− , toHie $ tvScopes sc NoScope vars
1630− bindings = map (C $ TyVarBind (mkScope varLoc) sc) implicits
1631− toHie (TS _ (XLHsQTyVars _)) = pure []
1633−instance ToHie (LHsContext GhcRn) where
1634− toHie (L span tys) = concatM $
1635− [ pure $ locOnly span
1639−instance ToHie (LConDeclField GhcRn) where
1640− toHie (L span field) = concatM $ makeNode field span : case field of
1641− ConDeclField _ fields typ _ ->
1642− [ toHie $ map (RFC RecFieldDecl (getRealSpan $ loc typ)) fields
1645− XConDeclField _ -> []
1647−instance ToHie (LHsExpr a) => ToHie (ArithSeqInfo a) where
1648− toHie (From expr) = toHie expr
1649− toHie (FromThen a b) = concatM $
1653− toHie (FromTo a b) = concatM $
1657− toHie (FromThenTo a b c) = concatM $
1663−instance ToHie (LSpliceDecl GhcRn) where
1664− toHie (L span decl) = concatM $ makeNode decl span : case decl of
1665− SpliceDecl _ splice _ ->
1668− XSpliceDecl _ -> []
1670−instance ToHie (HsBracket a) where
1673−instance ToHie PendingRnSplice where
1676−instance ToHie PendingTcSplice where
1679−instance ToHie (LBooleanFormula (Located Name)) where
1680− toHie (L span form) = concatM $ makeNode form span : case form of
1694−instance ToHie (Located HsIPName) where
1695− toHie (L span e) = makeNode e span
1697−instance ( ToHie (LHsExpr a)
1698− , Data (HsSplice a)
1699− ) => ToHie (Located (HsSplice a)) where
1700− toHie (L span sp) = concatM $ makeNode sp span : case sp of
1701− HsTypedSplice _ _ _ expr ->
1704− HsUntypedSplice _ _ _ expr ->
1707− HsQuasiQuote _ _ _ ispan _ ->
1708− [ pure $ locOnly ispan
1716−instance ToHie (LRoleAnnotDecl GhcRn) where
1717− toHie (L span annot) = concatM $ makeNode annot span : case annot of
1718− RoleAnnotDecl _ var roles ->
1719− [ toHie $ C Use var
1720− , concatMapM (pure . locOnly . getLoc) roles
1722− XRoleAnnotDecl _ -> []
1724−instance ToHie (LInstDecl GhcRn) where
1725− toHie (L span decl) = concatM $ makeNode decl span : case decl of
1729− DataFamInstD _ d ->
1737−instance ToHie (LClsInstDecl GhcRn) where
1738− toHie (L span decl) = concatM
1739− [ toHie $ TS (ResolvedScopes [mkScope span]) $ cid_poly_ty decl
1740− , toHie $ fmap (BC InstanceBind ModuleScope) $ cid_binds decl
1741− , toHie $ map (SC $ SI InstSig $ getRealSpan span) $ cid_sigs decl
1742− , pure $ concatMap (locOnly . getLoc) $ cid_tyfam_insts decl
1743− , toHie $ cid_tyfam_insts decl
1744− , pure $ concatMap (locOnly . getLoc) $ cid_datafam_insts decl
1745− , toHie $ cid_datafam_insts decl
1746− , toHie $ cid_overlap_mode decl
1749−instance ToHie (LDataFamInstDecl GhcRn) where
1750− toHie (L sp (DataFamInstDecl d)) = toHie $ TS (ResolvedScopes [mkScope sp]) d
1752−instance ToHie (LTyFamInstDecl GhcRn) where
1753− toHie (L sp (TyFamInstDecl d)) = toHie $ TS (ResolvedScopes [mkScope sp]) d
1755−instance ToHie (Context a)
1756− => ToHie (PatSynFieldContext (RecordPatSynField a)) where
1757− toHie (PSC sp (RecordPatSynField a b)) = concatM $
1758− [ toHie $ C (RecField RecFieldDecl sp) a
1762−instance ToHie (LDerivDecl GhcRn) where
1763− toHie (L span decl) = concatM $ makeNode decl span : case decl of
1764− DerivDecl _ typ strat overlap ->
1765− [ toHie $ TS (ResolvedScopes []) typ
1771−instance ToHie (LFixitySig GhcRn) where
1772− toHie (L span sig) = concatM $ makeNode sig span : case sig of
1773− FixitySig _ vars _ ->
1774− [ toHie $ map (C Use) vars
1778−instance ToHie (LDefaultDecl GhcRn) where
1779− toHie (L span decl) = concatM $ makeNode decl span : case decl of
1780− DefaultDecl _ typs ->
1783− XDefaultDecl _ -> []
1785−instance ToHie (LForeignDecl GhcRn) where
1786− toHie (L span decl) = concatM $ makeNode decl span : case decl of
1787− ForeignImport {fd_name = name, fd_sig_ty = sig, fd_fi = fi} ->
1788− [ toHie $ C (ValBind RegularBind ModuleScope $ getRealSpan span) name
1789− , toHie $ TS (ResolvedScopes []) sig
1792− ForeignExport {fd_name = name, fd_sig_ty = sig, fd_fe = fe} ->
1793− [ toHie $ C Use name
1794− , toHie $ TS (ResolvedScopes []) sig
1797− XForeignDecl _ -> []
1799−instance ToHie ForeignImport where
1800− toHie (CImport (L a _) (L b _) _ _ (L c _)) = pure $ concat $
1806−instance ToHie ForeignExport where
1807− toHie (CExport (L a _) (L b _)) = pure $ concat $
1812−instance ToHie (LWarnDecls GhcRn) where
1813− toHie (L span decl) = concatM $ makeNode decl span : case decl of
1814− Warnings _ _ warnings ->
1819−instance ToHie (LWarnDecl GhcRn) where
1820− toHie (L span decl) = concatM $ makeNode decl span : case decl of
1821− Warning _ vars _ ->
1822− [ toHie $ map (C Use) vars
1826−instance ToHie (LAnnDecl GhcRn) where
1827− toHie (L span decl) = concatM $ makeNode decl span : case decl of
1828− HsAnnotation _ _ prov expr ->
1834−instance ToHie (Context (Located a)) => ToHie (AnnProvenance a) where
1835− toHie (ValueAnnProvenance a) = toHie $ C Use a
1836− toHie (TypeAnnProvenance a) = toHie $ C Use a
1837− toHie ModuleAnnProvenance = pure []
1839−instance ToHie (LRuleDecls GhcRn) where
1840− toHie (L span decl) = concatM $ makeNode decl span : case decl of
1841− HsRules _ _ rules ->
1846−instance ToHie (LRuleDecl GhcRn) where
1847− toHie (L _ (XRuleDecl _)) = pure []
1848− toHie (L span r@(HsRule _ rname _ tybndrs bndrs exprA exprB)) = concatM
1850− , pure $ locOnly $ getLoc rname
1851− , toHie $ fmap (tvScopes (ResolvedScopes []) scope) tybndrs
1852− , toHie $ map (RS $ mkScope span) bndrs
1856− where scope = bndrs_sc `combineScopes` exprA_sc `combineScopes` exprB_sc
1857− bndrs_sc = maybe NoScope mkLScope (listToMaybe bndrs)
1858− exprA_sc = mkLScope exprA
1859− exprB_sc = mkLScope exprB
1861−instance ToHie (RScoped (LRuleBndr GhcRn)) where
1862− toHie (RS sc (L span bndr)) = concatM $ makeNode bndr span : case bndr of
1864− [ toHie $ C (ValBind RegularBind sc Nothing) var
1866− RuleBndrSig _ var typ ->
1867− [ toHie $ C (ValBind RegularBind sc Nothing) var
1868− , toHie $ TS (ResolvedScopes [sc]) typ
1872−instance ToHie (LImportDecl GhcRn) where
1873− toHie (L span decl) = concatM $ makeNode decl span : case decl of
1874− ImportDecl { ideclName = name, ideclAs = as, ideclHiding = hidden } ->
1875− [ toHie $ IEC Import name
1876− , toHie $ fmap (IEC ImportAs) as
1877− , maybe (pure []) goIE hidden
1879− XImportDecl _ -> []
1881− goIE (hiding, (L sp liens)) = concatM $
1882− [ pure $ locOnly sp
1883− , toHie $ map (IEC c) liens
1886− c = if hiding then ImportHiding else Import
1888−instance ToHie (IEContext (LIE GhcRn)) where
1889− toHie (IEC c (L span ie)) = concatM $ makeNode ie span : case ie of
1899− IEThingWith _ n _ ns flds ->
1901− , toHie $ map (IEC c) ns
1902− , toHie $ map (IEC c) flds
1904− IEModuleContents _ n ->
1907− IEGroup _ _ _ -> []
1909− IEDocNamed _ _ -> []
1912−instance ToHie (IEContext (LIEWrappedName Name)) where
1913− toHie (IEC c (L span iewn)) = concatM $ makeNode iewn span : case iewn of
1915− [ toHie $ C (IEThing c) n
1918− [ toHie $ C (IEThing c) p
1921− [ toHie $ C (IEThing c) n
1924−instance ToHie (IEContext (Located (FieldLbl Name))) where
1925− toHie (IEC c (L span lbl)) = concatM $ makeNode lbl span : case lbl of
1926− FieldLabel _ _ n ->
1927− [ toHie $ C (IEThing c) $ L span n