From 93825d12f0e3c97a5db4a48b4fe6ae4865256a67 Mon Sep 17 00:00:00 2001
From: Yuchen Pei <hi@ypei.me>
Date: Mon, 6 Jun 2022 18:30:40 +1000
Subject: fixing selectorDocs

---
 src/HaskellCodeExplorer/GhcUtils.hs | 43 ++++++++++++++++++-------------------
 1 file changed, 21 insertions(+), 22 deletions(-)

(limited to 'src/HaskellCodeExplorer/GhcUtils.hs')

diff --git a/src/HaskellCodeExplorer/GhcUtils.hs b/src/HaskellCodeExplorer/GhcUtils.hs
index a1b121c..0a106ad 100644
--- a/src/HaskellCodeExplorer/GhcUtils.hs
+++ b/src/HaskellCodeExplorer/GhcUtils.hs
@@ -99,6 +99,10 @@ import GHC.Data.FastString
   )
 import GHC
   ( DynFlags
+  , XRec
+  , getRecConArgs_maybe
+  , ConDeclField(..)
+  , LConDeclField
   , CollectFlag(..)
   , LHsBindLR
   , reLocN
@@ -1043,6 +1047,7 @@ tyVarsOfType = varSetElems . everything unionVarSet (emptyVarSet `mkQ` tyVar)
 -- #endif
 
 -- also available in GHC.HsToCore.Docs
+-- Take a field of declarations from a data structure and create HsDecls using the given constructor
 -- mkDecls :: (struct -> [GenLocated l decl]) -> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl]
 -- mkDecls :: (a -> [Located b]) -> (b -> c) -> a -> [Located c]
 -- mkDecls field con struct = [L loc (con decl) | L loc decl <- field struct]
@@ -1091,37 +1096,31 @@ conDeclDocs conDecl =
   getConNames $
   conDecl
 
--- no longer used by subordinateNamesWithDocs
--- extractRecCon :: ConDecl p -> Maybe (XRec p [LConDeclField p])
--- extractRecCon = undefined
-
--- no longer used by subordinateNamesWithDocs
--- selectorDocs :: ConDecl GhcRn -> [(Name, [HsDocString], SrcSpan)]
--- selectorDocs con =
---   case extractRecCon con of
---     Just (L _ flds) ->
---       concatMap
---         (\(L _ (ConDeclField _ fieldOccs _ mbDoc)) ->
---            map
---              (\(L span f) ->
---                 (extFieldOcc f, maybe [] ((: []) . unLoc) mbDoc, span))
---              fieldOccs)
---         flds
---     _ -> []
+selectorDocs :: ConDecl GhcRn -> [(Name, [HsDocString], SrcSpan)]
+selectorDocs con =
+  case getRecConArgs_maybe con of
+    Just (L _ flds) ->
+      concatMap
+        (\(L _ (ConDeclField _ fieldOccs _ mbDoc)) ->
+           map
+             (\(L span f) ->
+                (extFieldOcc f, maybe [] ((: []) . unLoc) mbDoc, span))
+             fieldOccs)
+        flds
+    _ -> []
 
 subordinateNamesWithDocs :: [LHsDecl GhcRn] -> [(Name, [HsDocString], SrcSpan)]
 subordinateNamesWithDocs =
     concatMap
     (\lhd ->
        case unLoc lhd of
-         TyClD _ classDecl ->
+         TyClD _ classDecl@ClassDecl {} ->
            concatMap
              (\(L _ decl, docs) -> map (, docs, getLocA lhd) $ getMainDeclBinder decl) $
            classDeclDocs classDecl
-    -- Pattern match is redundant
-    --      TyClD _ DataDecl {..} ->
-    --        concatMap (\(L _ con) -> conDeclDocs con ++ selectorDocs con) $
-    --        dd_cons tcdDataDefn
+         TyClD _ DataDecl {..} ->
+           concatMap (\(L _ con) -> conDeclDocs con ++ selectorDocs con) $
+           dd_cons tcdDataDefn
          InstD _ (DataFamInstD _ DataFamInstDecl {..}) ->
            concatMap (conDeclDocs . unLoc) . dd_cons . feqn_rhs $ dfid_eqn
          _ -> [])
-- 
cgit v1.2.3