77-}
88
99{-# LANGUAGE TypeApplications #-}
10+ {-# LANGUAGE DuplicateRecordFields #-}
11+ {-# LANGUAGE OverloadedRecordDot #-}
1012module HieIndexer.Index (indexHieFile ) where
1113
1214import Control.Applicative
@@ -186,58 +188,53 @@ produceDeclInfo fileFact toByteSpan getName_ infos =
186188 -> MaybeT (WriterT (Map (Glean. IdOf Hs. Name ) Hs. SigDecl ) m ) ()
187189 makeDecl info =
188190 case info of
189- SigDecl { sigDeclName = name, sigDeclSpan = span } -> do
190- hsName <- getName name
191+ SigDecl { } -> do
192+ hsName <- getName info . name
191193 decl <- glean $ Glean. makeFact @ Hs. SigDecl $
192194 Hs. SigDecl_key hsName (
193- Src. FileLocation fileFact (toByteSpan span ))
195+ Src. FileLocation fileFact (toByteSpan info . span ))
194196 -- collect SigDecls using WriterT
195197 Writer. tell (Map. singleton (Glean. getId hsName) decl)
196- DataDecl { dataDeclName = name, dataDeclConstrs = cs } -> do
197- hsName <- getName name
198- cons <- forM cs $ \ ( ConstrInfo cName fields) -> do
199- hsCName <- getName cName
200- fNames <- mapM getName fields
201- fDecls <- forM fNames $ \ fName ->
198+ DataDecl { } -> do
199+ hsName <- getName info . name
200+ cons <- forM info . constrs $ \ con -> do
201+ hsCName <- getName con . name
202+ fDecls <- forM con . fields $ \ fName -> do
203+ hsFName <- getName fName
202204 glean $ Glean. makeFact @ Hs. RecordFieldDecl $
203- Hs. RecordFieldDecl_key fName hsCName
205+ Hs. RecordFieldDecl_key hsFName hsCName
204206 glean $ Glean. makeFact @ Hs. ConstrDecl $
205207 Hs. ConstrDecl_key hsCName hsName fDecls
206208 glean $ Glean. makeFact_ @ Hs. DataDecl $
207209 Hs. DataDecl_key hsName cons
208- ClassDecl {
209- classDeclName = name,
210- classDeclMethods = meths,
211- classDeclDefaults = defs } -> do
212- hsName <- getName name
213- mNames <- mapM getName meths
214- mDecls <- forM mNames $ \ mName ->
210+ ClassDecl {} -> do
211+ hsName <- getName info. name
212+ mDecls <- forM info. methods $ \ mName -> do
213+ hsMName <- getName mName
215214 glean $ Glean. makeFact @ Hs. MethDecl $
216- Hs. MethDecl_key mName hsName
217- defaults <- mapM makeInstBind defs
215+ Hs. MethDecl_key hsMName hsName
216+ defaults <- mapM makeInstBind info . defaults
218217 decl <- glean $ Glean. makeFact @ Hs. ClassDecl $
219218 Hs. ClassDecl_key hsName mDecls defaults
220219 forM_ defaults $ \ bind ->
221220 glean $ Glean. makeFact_ @ Hs. InstanceBindToDecl $
222221 Hs. InstanceBindToDecl_key bind
223222 (Hs. InstanceBindToDecl_decl_class_ decl)
224- InstDecl {
225- instanceDeclBinds = instBinds,
226- instanceDeclSpan = span } -> do
227- binds <- mapM makeInstBind instBinds
223+ InstDecl {} -> do
224+ binds <- mapM makeInstBind info. binds
228225 decl <- glean $ Glean. makeFact @ Hs. InstDecl $
229226 Hs. InstDecl_key binds
230- (Src. FileLocation fileFact (toByteSpan span ))
227+ (Src. FileLocation fileFact (toByteSpan info . span ))
231228 forM_ binds $ \ bind ->
232229 glean $ Glean. makeFact_ @ Hs. InstanceBindToDecl $
233230 Hs. InstanceBindToDecl_key bind
234231 (Hs. InstanceBindToDecl_decl_inst decl)
235232
236- makeInstBind InstanceBindInfo { .. } = do
237- meth <- getName instBindMeth
233+ makeInstBind instBind = do
234+ meth <- getName instBind . method
238235 glean $ Glean. makeFact @ Hs. InstanceBind $
239236 Hs. InstanceBind_key meth {- (IntMap.lookup instBindTy typeMap)-}
240- (Src. FileLocation fileFact (toByteSpan instBindSpan ))
237+ (Src. FileLocation fileFact (toByteSpan instBind . span ))
241238
242239nat :: Integral a => a -> Glean. Nat
243240nat = Glean. toNat . fromIntegral
@@ -551,43 +548,43 @@ currently ignore Names that come from another source file (TODO).
551548
552549data DeclInfo
553550 = DataDecl {
554- dataDeclName :: GHC. Name ,
555- dataDeclConstrs :: [ConstrInfo ]
551+ name :: GHC. Name ,
552+ constrs :: [ConstrInfo ]
556553 }
557554 | ClassDecl {
558- classDeclName :: GHC. Name ,
559- classDeclMethods :: [GHC. Name ],
560- classDeclDefaults :: [InstanceBindInfo ]
555+ name :: GHC. Name ,
556+ methods :: [GHC. Name ],
557+ defaults :: [InstanceBindInfo ]
561558 }
562559 | SigDecl {
563- sigDeclName :: GHC. Name ,
564- sigDeclSpan :: GHC. RealSrcSpan
560+ name :: GHC. Name ,
561+ span :: GHC. RealSrcSpan
565562 }
566563 | InstDecl {
567- instanceDeclBinds :: [InstanceBindInfo ],
568- instanceDeclSpan :: GHC. RealSrcSpan
564+ binds :: [InstanceBindInfo ],
565+ span :: GHC. RealSrcSpan
569566 }
570567
571568data InstanceBindInfo = InstanceBindInfo {
572- instBindMeth :: GHC. Name ,
573- instBindSpan :: GHC. RealSrcSpan
569+ method :: GHC. Name ,
570+ span :: GHC. RealSrcSpan
574571 -- TODO: add type. The identifier with context ValBind InstanceBind
575572 -- doesn't have a type, but there is also a ValBind RegularBind
576573 -- identifier that does have the type attached.
577574 }
578575
579576data ConstrInfo =
580577 ConstrInfo {
581- _constrName :: GHC. Name ,
582- _constrFields :: [GHC. Name ]
578+ name :: GHC. Name ,
579+ fields :: [GHC. Name ]
583580 }
584581
585582getDeclInfos :: HieAST TypeIndex -> [DeclInfo ]
586583getDeclInfos node = snd $ State. runState (go node) []
587584 where
588- go node@ Node { .. } = do
585+ go node = do
589586 visit node
590- void $ traverse go nodeChildren
587+ void $ traverse go node . nodeChildren
591588
592589 visit node =
593590 {-
@@ -602,54 +599,54 @@ getDeclInfos node = snd $ State.runState (go node) []
602599 hasInfo
603600 | isDataDecl nodeInfo,
604601 [(name,_,_)] <- findIdent dataDeclCtx nodeInfo node =
605- Just ( DataDecl {
606- dataDeclName = name,
607- dataDeclConstrs = findConstrs node })
602+ Just $ DataDecl {
603+ name = name,
604+ constrs = findConstrs node }
608605 | isClassDecl nodeInfo,
609606 [(name,_,_)] <- findIdent classDeclCtx nodeInfo node =
610- Just ( ClassDecl {
611- classDeclName = name,
612- classDeclMethods = findMethods node,
613- classDeclDefaults = findInstBinds node })
607+ Just $ ClassDecl {
608+ name = name,
609+ methods = findMethods node,
610+ defaults = findInstBinds node }
614611 | isTypeSig nodeInfo,
615612 [(name,_,_)] <- findIdent tyDeclCtx nodeInfo node =
616- Just ( SigDecl {
617- sigDeclName = name,
618- sigDeclSpan = nodeSpan node })
613+ Just $ SigDecl {
614+ name = name,
615+ span = nodeSpan node }
619616 | isInstDecl nodeInfo =
620- Just ( InstDecl {
621- instanceDeclBinds = findInstBinds node,
622- instanceDeclSpan = nodeSpan node })
617+ Just $ InstDecl {
618+ binds = findInstBinds node,
619+ span = nodeSpan node }
623620 | otherwise =
624621 Nothing
625622
626623 -- The Name for a decl seems to be a child of the declaration Node
627- findIdent ctx ni Node { .. } =
624+ findIdent ctx ni node =
628625 concatMap (namesWithContext ctx) $
629- map nodeIdentifiers (ni : map getNodeInfo nodeChildren)
626+ map nodeIdentifiers (ni : map getNodeInfo node . nodeChildren)
630627
631- findMethods Node { .. } =
628+ findMethods node =
632629 [ meth
633- | n <- nodeChildren
630+ | n <- node . nodeChildren
634631 , let ni = getNodeInfo n
635632 , isMethodDecl ni
636633 , (meth,_,_) <- findIdent classTyDeclCtx ni n
637634 ]
638635
639- findInstBinds Node { .. } =
636+ findInstBinds node =
640637 [ InstanceBindInfo {
641- instBindMeth = meth,
642- instBindSpan = span
638+ method = meth,
639+ span = span
643640 }
644- | n <- nodeChildren
641+ | n <- node . nodeChildren
645642 , let ni = getNodeInfo n
646643 , isInstanceBind ni
647644 , (meth, _ty, ValBind _ _ (Just span )) <- findIdent instBindCtx ni n
648645 ]
649646
650- findConstrs Node { .. } =
647+ findConstrs node =
651648 [ ConstrInfo con (fields n)
652- | n <- nodeChildren
649+ | n <- node . nodeChildren
653650 , let ni = getNodeInfo n
654651 , isConstrDecl ni
655652 , (con,_,_) <- findIdent conDeclCtx ni n
0 commit comments