88
99{-# LANGUAGE CPP #-}
1010{-# LANGUAGE TypeApplications #-}
11+ {-# LANGUAGE DuplicateRecordFields #-}
12+ {-# LANGUAGE OverloadedRecordDot #-}
1113module HieIndexer.Index (indexHieFile ) where
1214
1315import Control.Applicative
@@ -199,58 +201,53 @@ produceDeclInfo fileFact toByteSpan getName_ infos =
199201 -> MaybeT (WriterT (Map (Glean. IdOf Hs. Name ) Hs. SigDecl ) m ) ()
200202 makeDecl info =
201203 case info of
202- SigDecl { sigDeclName = name, sigDeclSpan = span } -> do
203- hsName <- getName name
204+ SigDecl { } -> do
205+ hsName <- getName info . name
204206 decl <- glean $ Glean. makeFact @ Hs. SigDecl $
205207 Hs. SigDecl_key hsName (
206- Src. FileLocation fileFact (toByteSpan span ))
208+ Src. FileLocation fileFact (toByteSpan info . span ))
207209 -- collect SigDecls using WriterT
208210 Writer. tell (Map. singleton (Glean. getId hsName) decl)
209- DataDecl { dataDeclName = name, dataDeclConstrs = cs } -> do
210- hsName <- getName name
211- cons <- forM cs $ \ ( ConstrInfo cName fields) -> do
212- hsCName <- getName cName
213- fNames <- mapM getName fields
214- fDecls <- forM fNames $ \ fName ->
211+ DataDecl { } -> do
212+ hsName <- getName info . name
213+ cons <- forM info . constrs $ \ con -> do
214+ hsCName <- getName con . name
215+ fDecls <- forM con . fields $ \ fName -> do
216+ hsFName <- getName fName
215217 glean $ Glean. makeFact @ Hs. RecordFieldDecl $
216- Hs. RecordFieldDecl_key fName hsCName
218+ Hs. RecordFieldDecl_key hsFName hsCName
217219 glean $ Glean. makeFact @ Hs. ConstrDecl $
218220 Hs. ConstrDecl_key hsCName hsName fDecls
219221 glean $ Glean. makeFact_ @ Hs. DataDecl $
220222 Hs. DataDecl_key hsName cons
221- ClassDecl {
222- classDeclName = name,
223- classDeclMethods = meths,
224- classDeclDefaults = defs } -> do
225- hsName <- getName name
226- mNames <- mapM getName meths
227- mDecls <- forM mNames $ \ mName ->
223+ ClassDecl {} -> do
224+ hsName <- getName info. name
225+ mDecls <- forM info. methods $ \ mName -> do
226+ hsMName <- getName mName
228227 glean $ Glean. makeFact @ Hs. MethDecl $
229- Hs. MethDecl_key mName hsName
230- defaults <- mapM makeInstBind defs
228+ Hs. MethDecl_key hsMName hsName
229+ defaults <- mapM makeInstBind info . defaults
231230 decl <- glean $ Glean. makeFact @ Hs. ClassDecl $
232231 Hs. ClassDecl_key hsName mDecls defaults
233232 forM_ defaults $ \ bind ->
234233 glean $ Glean. makeFact_ @ Hs. InstanceBindToDecl $
235234 Hs. InstanceBindToDecl_key bind
236235 (Hs. InstanceBindToDecl_decl_class_ decl)
237- InstDecl {
238- instanceDeclBinds = instBinds,
239- instanceDeclSpan = span } -> do
240- binds <- mapM makeInstBind instBinds
236+ InstDecl {} -> do
237+ binds <- mapM makeInstBind info. binds
241238 decl <- glean $ Glean. makeFact @ Hs. InstDecl $
242239 Hs. InstDecl_key binds
243- (Src. FileLocation fileFact (toByteSpan span ))
240+ (Src. FileLocation fileFact (toByteSpan info . span ))
244241 forM_ binds $ \ bind ->
245242 glean $ Glean. makeFact_ @ Hs. InstanceBindToDecl $
246243 Hs. InstanceBindToDecl_key bind
247244 (Hs. InstanceBindToDecl_decl_inst decl)
248245
249- makeInstBind InstanceBindInfo { .. } = do
250- meth <- getName instBindMeth
246+ makeInstBind instBind = do
247+ meth <- getName instBind . method
251248 glean $ Glean. makeFact @ Hs. InstanceBind $
252249 Hs. InstanceBind_key meth {- (IntMap.lookup instBindTy typeMap)-}
253- (Src. FileLocation fileFact (toByteSpan instBindSpan ))
250+ (Src. FileLocation fileFact (toByteSpan instBind . span ))
254251
255252nat :: Integral a => a -> Glean. Nat
256253nat = Glean. toNat . fromIntegral
@@ -564,43 +561,43 @@ currently ignore Names that come from another source file (TODO).
564561
565562data DeclInfo
566563 = DataDecl {
567- dataDeclName :: GHC. Name ,
568- dataDeclConstrs :: [ConstrInfo ]
564+ name :: GHC. Name ,
565+ constrs :: [ConstrInfo ]
569566 }
570567 | ClassDecl {
571- classDeclName :: GHC. Name ,
572- classDeclMethods :: [GHC. Name ],
573- classDeclDefaults :: [InstanceBindInfo ]
568+ name :: GHC. Name ,
569+ methods :: [GHC. Name ],
570+ defaults :: [InstanceBindInfo ]
574571 }
575572 | SigDecl {
576- sigDeclName :: GHC. Name ,
577- sigDeclSpan :: GHC. RealSrcSpan
573+ name :: GHC. Name ,
574+ span :: GHC. RealSrcSpan
578575 }
579576 | InstDecl {
580- instanceDeclBinds :: [InstanceBindInfo ],
581- instanceDeclSpan :: GHC. RealSrcSpan
577+ binds :: [InstanceBindInfo ],
578+ span :: GHC. RealSrcSpan
582579 }
583580
584581data InstanceBindInfo = InstanceBindInfo {
585- instBindMeth :: GHC. Name ,
586- instBindSpan :: GHC. RealSrcSpan
582+ method :: GHC. Name ,
583+ span :: GHC. RealSrcSpan
587584 -- TODO: add type. The identifier with context ValBind InstanceBind
588585 -- doesn't have a type, but there is also a ValBind RegularBind
589586 -- identifier that does have the type attached.
590587 }
591588
592589data ConstrInfo =
593590 ConstrInfo {
594- _constrName :: GHC. Name ,
595- _constrFields :: [GHC. Name ]
591+ name :: GHC. Name ,
592+ fields :: [GHC. Name ]
596593 }
597594
598595getDeclInfos :: HieAST TypeIndex -> [DeclInfo ]
599596getDeclInfos node = snd $ State. runState (go node) []
600597 where
601- go node@ Node { .. } = do
598+ go node = do
602599 visit node
603- void $ traverse go nodeChildren
600+ void $ traverse go node . nodeChildren
604601
605602 visit node =
606603 {-
@@ -615,54 +612,54 @@ getDeclInfos node = snd $ State.runState (go node) []
615612 hasInfo
616613 | isDataDecl nodeInfo,
617614 [(name,_,_)] <- findIdent dataDeclCtx nodeInfo node =
618- Just ( DataDecl {
619- dataDeclName = name,
620- dataDeclConstrs = findConstrs node })
615+ Just $ DataDecl {
616+ name = name,
617+ constrs = findConstrs node }
621618 | isClassDecl nodeInfo,
622619 [(name,_,_)] <- findIdent classDeclCtx nodeInfo node =
623- Just ( ClassDecl {
624- classDeclName = name,
625- classDeclMethods = findMethods node,
626- classDeclDefaults = findInstBinds node })
620+ Just $ ClassDecl {
621+ name = name,
622+ methods = findMethods node,
623+ defaults = findInstBinds node }
627624 | isTypeSig nodeInfo,
628625 [(name,_,_)] <- findIdent tyDeclCtx nodeInfo node =
629- Just ( SigDecl {
630- sigDeclName = name,
631- sigDeclSpan = nodeSpan node })
626+ Just $ SigDecl {
627+ name = name,
628+ span = nodeSpan node }
632629 | isInstDecl nodeInfo =
633- Just ( InstDecl {
634- instanceDeclBinds = findInstBinds node,
635- instanceDeclSpan = nodeSpan node })
630+ Just $ InstDecl {
631+ binds = findInstBinds node,
632+ span = nodeSpan node }
636633 | otherwise =
637634 Nothing
638635
639636 -- The Name for a decl seems to be a child of the declaration Node
640- findIdent ctx ni Node { .. } =
637+ findIdent ctx ni node =
641638 concatMap (namesWithContext ctx) $
642- map nodeIdentifiers (ni : map getNodeInfo nodeChildren)
639+ map nodeIdentifiers (ni : map getNodeInfo node . nodeChildren)
643640
644- findMethods Node { .. } =
641+ findMethods node =
645642 [ meth
646- | n <- nodeChildren
643+ | n <- node . nodeChildren
647644 , let ni = getNodeInfo n
648645 , isMethodDecl ni
649646 , (meth,_,_) <- findIdent classTyDeclCtx ni n
650647 ]
651648
652- findInstBinds Node { .. } =
649+ findInstBinds node =
653650 [ InstanceBindInfo {
654- instBindMeth = meth,
655- instBindSpan = span
651+ method = meth,
652+ span = span
656653 }
657- | n <- nodeChildren
654+ | n <- node . nodeChildren
658655 , let ni = getNodeInfo n
659656 , isInstanceBind ni
660657 , (meth, _ty, ValBind _ _ (Just span )) <- findIdent instBindCtx ni n
661658 ]
662659
663- findConstrs Node { .. } =
660+ findConstrs node =
664661 [ ConstrInfo con (fields n)
665- | n <- nodeChildren
662+ | n <- node . nodeChildren
666663 , let ni = getNodeInfo n
667664 , isConstrDecl ni
668665 , (con,_,_) <- findIdent conDeclCtx ni n
0 commit comments