Skip to content

Commit bdd1945

Browse files
simonmarfacebook-github-bot
authored andcommitted
Refactor: switch to OverloadedRecordDot (#552)
Summary: Pull Request resolved: #552 Reviewed By: jjuliamolin Differential Revision: D77440704 Pulled By: pepeiborra fbshipit-source-id: 0e355382c0a27ff05415a1c41b60b65ee9c7247f
1 parent 2d0d3a6 commit bdd1945

1 file changed

Lines changed: 62 additions & 65 deletions

File tree

glean/lang/haskell/HieIndexer/Index.hs

Lines changed: 62 additions & 65 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,8 @@
88

99
{-# LANGUAGE CPP #-}
1010
{-# LANGUAGE TypeApplications #-}
11+
{-# LANGUAGE DuplicateRecordFields #-}
12+
{-# LANGUAGE OverloadedRecordDot #-}
1113
module HieIndexer.Index (indexHieFile) where
1214

1315
import 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

255252
nat :: Integral a => a -> Glean.Nat
256253
nat = Glean.toNat . fromIntegral
@@ -564,43 +561,43 @@ currently ignore Names that come from another source file (TODO).
564561

565562
data 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

584581
data 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

592589
data ConstrInfo =
593590
ConstrInfo {
594-
_constrName :: GHC.Name,
595-
_constrFields :: [GHC.Name]
591+
name :: GHC.Name,
592+
fields :: [GHC.Name]
596593
}
597594

598595
getDeclInfos :: HieAST TypeIndex -> [DeclInfo]
599596
getDeclInfos 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

Comments
 (0)