From 7ee8d0cb52b3e9c08474365db4466d94d478cd2b Mon Sep 17 00:00:00 2001
From: Yuchen Pei <hi@ypei.me>
Date: Thu, 2 Jun 2022 21:43:59 +1000
Subject: keep on hacking renamed
---
src/HaskellCodeExplorer/AST/RenamedSource.hs | 178 ++++++---------------------
src/HaskellCodeExplorer/GhcUtils.hs | 13 +-
2 files changed, 43 insertions(+), 148 deletions(-)
diff --git a/src/HaskellCodeExplorer/AST/RenamedSource.hs b/src/HaskellCodeExplorer/AST/RenamedSource.hs
index cb0f132..bdbed89 100644
--- a/src/HaskellCodeExplorer/AST/RenamedSource.hs
+++ b/src/HaskellCodeExplorer/AST/RenamedSource.hs
@@ -204,70 +204,46 @@ hsRecFieldPatNames :: HsRecField' (FieldOcc Name) (LPat Name) -> [NameOccurrence
#endif
hsRecFieldPatNames HsRecField {..} = [fieldOccName False $ unLoc hsRecFieldLbl]
-#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
hsExprNames :: LHsExpr GhcRn -> [NameOccurrence]
-#else
-hsExprNames :: LHsExpr Name -> [NameOccurrence]
-#endif
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
hsExprNames (L _span (HsVar _ name)) =
-#else
-hsExprNames (L _span (HsVar name)) =
-#endif
[ NameOccurrence
{ locatedName = Just <$> reLocN name
, description = "HsVar"
, isBinder = False
}
]
-hsExprNames (L span (ExplicitList _ exprs))
+hsExprNames lhe@(L _ (ExplicitList _ exprs))
| null exprs =
[ NameOccurrence
- { locatedName = L span $ Just nilDataConName
+ { locatedName = L (getLocA lhe) $ Just nilDataConName
, description = "ExplicitList"
, isBinder = False
}
]
| otherwise = []
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
hsExprNames (L _span (RecordCon _ name _)) =
-#else
-hsExprNames (L _span (RecordCon name _conLike _instFun _binds)) =
-#endif
[ NameOccurrence
- { locatedName = Just <$> name
+ { locatedName = Just <$> reLocN name
, description = "RecordCon"
, isBinder = False
}
]
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-hsExprNames (L _span (HsRecFld _ (Unambiguous name (L span _)))) =
-#else
-hsExprNames (L _span (HsRecFld (Unambiguous (L span _) name))) =
-#endif
+hsExprNames (L _span (HsRecFld _ (Unambiguous name located))) =
[ NameOccurrence
- { locatedName = L span (Just name)
+ { locatedName = L (getLocA located) (Just name)
, description = "HsRecFld"
, isBinder = False
}
]
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-hsExprNames (L _span (HsRecFld _ (Ambiguous _name (L span _)))) =
-#else
-hsExprNames (L _span (HsRecFld (Ambiguous (L span _) _name))) =
-#endif
+hsExprNames (L _span (HsRecFld _ (Ambiguous _name located))) =
[ NameOccurrence
- { locatedName = L span Nothing
+ { locatedName = L (getLocA located) Nothing
, description = "HsRecFld"
, isBinder = False
}
]
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-hsExprNames (L span (HsRnBracketOut _ (VarBr _ quote name) _)) =
-#else
-hsExprNames (L span (HsRnBracketOut (VarBr quote name) _)) =
-#endif
- case span of
+hsExprNames lhr@(L span (HsRnBracketOut _ (VarBr _ quote name) _)) =
+ case getLocA lhr of
RealSrcSpan realSpan _ ->
let start = realSrcSpanStart realSpan
end = realSrcSpanEnd realSpan
@@ -280,9 +256,9 @@ hsExprNames (L span (HsRnBracketOut (VarBr quote name) _)) =
(srcLocFile start)
(srcLocLine start)
(srcLocCol start + offset)
- span' = RealSrcSpan $ mkRealSrcSpan start' end
+ span' = RealSrcSpan (mkRealSrcSpan start' end) Nothing
in [ NameOccurrence
- { locatedName = L span' (Just name)
+ { locatedName = L span' (Just $ unLoc name)
, description = "VarBr"
, isBinder = False
}
@@ -290,52 +266,30 @@ hsExprNames (L span (HsRnBracketOut (VarBr quote name) _)) =
_ -> []
hsExprNames _ = []
-#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
matchGroupNames :: MatchGroup GhcRn (LHsExpr GhcRn) -> [NameOccurrence]
-#else
-matchGroupNames :: MatchGroup Name (LHsExpr Name) -> [NameOccurrence]
-#endif
matchGroupNames =
-#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
mapMaybe (fmap toNameOcc . matchContextName . m_ctxt . unLoc) .
-#else
- mapMaybe (fmap toNameOcc . matchFixityName . m_fixity . unLoc) .
-#endif
unLoc . mg_alts
where
-#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
--matchContextName :: HsMatchContext Name -> Maybe (Located Name)
matchContextName (FunRhs name _ _bool) = Just name
matchContextName _ = Nothing
-#else
- --matchFixityName :: MatchFixity Name -> Maybe (Located Name)
- matchFixityName NonFunBindMatch = Nothing
- matchFixityName (FunBindMatch name _bool) = Just name
-#endif
- --toNameOcc :: Located Name -> NameOccurrence
+ --toNameOcc :: LIdP GhcRn -> NameOccurrence
toNameOcc n =
NameOccurrence
- {locatedName = Just <$> n, description = "Match", isBinder = True}
+ {locatedName = Just <$> reLocN n, description = "Match", isBinder = True}
-#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
bindNames :: LHsBindLR GhcRn GhcRn -> [NameOccurrence]
-#else
-bindNames :: LHsBindLR Name Name -> [NameOccurrence]
-#endif
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
bindNames (L _span (PatSynBind _ PSB {..})) =
-#else
-bindNames (L _span (PatSynBind PSB {..})) =
-#endif
[ NameOccurrence
- { locatedName = Just <$> psb_id
+ { locatedName = Just <$> reLocN psb_id
, description = "PatSynBind"
, isBinder = True
}
]
bindNames _ = []
-hsPatSynDetailsNames :: HsPatSynDetails (Located Name) -> [NameOccurrence]
+hsPatSynDetailsNames :: HsPatSynDetails GhcRn -> [NameOccurrence]
hsPatSynDetailsNames =
map
(\name ->
@@ -363,30 +317,30 @@ importNames =
patNames :: LPat GhcRn -> [NameOccurrence]
-patNames (ghcDL -> (L _span (VarPat _ name))) =
+patNames (L _span (VarPat _ name)) =
[ NameOccurrence
- { locatedName = Just <$> name
+ { locatedName = Just <$> reLocN name
, description = "VarPat"
, isBinder = True
}
]
-patNames (ghcDL -> (L _span (ConPat _ name _))) =
+patNames (L _span (ConPat _ name _)) =
[ NameOccurrence
- { locatedName = Just <$> name
+ { locatedName = Just <$> reLocN name
, description = "ConPatIn"
, isBinder = False
}
]
-patNames (ghcDL -> (L _span (AsPat _ name _))) =
+patNames (L _span (AsPat _ name _)) =
[ NameOccurrence
- { locatedName = Just <$> name
+ { locatedName = Just <$> reLocN name
, description = "AsPat"
, isBinder = True
}
]
-patNames (ghcDL -> (L _span (NPlusKPat _ name _ _ _ _))) =
+patNames (L _span (NPlusKPat _ name _ _ _ _)) =
[ NameOccurrence
- { locatedName = Just <$> name
+ { locatedName = Just <$> reLocN name
, description = "NPlusKPat"
, isBinder = True
}
@@ -394,96 +348,56 @@ patNames (ghcDL -> (L _span (NPlusKPat _ name _ _ _ _))) =
patNames _ = []
-#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
sigNames :: LSig GhcRn -> [NameOccurrence]
-#else
-sigNames :: LSig Name -> [NameOccurrence]
-#endif
-
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
sigNames (L _span (TypeSig _ names _)) =
-#else
-sigNames (L _span (TypeSig names _)) =
-#endif
map
(\n ->
NameOccurrence
- { locatedName = Just <$> n
+ { locatedName = Just <$> reLocN n
, description = "TypeSig"
, isBinder = False
})
names
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-sigNames (L _span (PatSynSig _ names _)) = map (\name -> NameOccurrence (Just <$> name) "PatSynSig" False) names
-#elif MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
-sigNames (L _span (PatSynSig names _)) = map (\name -> NameOccurrence (Just <$> name) "PatSynSig" False) names
-#else
-sigNames (L _span (PatSynSig name _)) =
- [ NameOccurrence
- { locatedName = Just <$> name
- , description = "PatSynSig"
- , isBinder = False
- }
- ]
-#endif
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
+sigNames (L _span (PatSynSig _ names _)) =
+ map (\name -> NameOccurrence (Just <$> reLocN name) "PatSynSig" False) names
sigNames (L _span (ClassOpSig _ _ names _)) =
-#else
-sigNames (L _span (ClassOpSig _ names _)) =
-#endif
map
(\n ->
NameOccurrence
- { locatedName = Just <$> n
+ { locatedName = Just <$> reLocN n
, description = "ClassOpSig"
, isBinder = True
})
names
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
sigNames (L _span (FixSig _ (FixitySig _ names _))) =
-#else
-sigNames (L _span (FixSig (FixitySig names _))) =
-#endif
map
(\n ->
NameOccurrence
- { locatedName = Just <$> n
+ { locatedName = Just <$> reLocN n
, description = "FixitySig"
, isBinder = False
})
names
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
sigNames (L _span (InlineSig _ name _)) =
-#else
-sigNames (L _span (InlineSig name _)) =
-#endif
[ NameOccurrence
- { locatedName = Just <$> name
+ { locatedName = Just <$> reLocN name
, description = "InlineSig"
, isBinder = False
}
]
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
sigNames (L _span (SpecSig _ name _ _)) =
-#else
-sigNames (L _span (SpecSig name _ _)) =
-#endif
[ NameOccurrence
- { locatedName = Just <$> name
+ { locatedName = Just <$> reLocN name
, description = "SpecSig"
, isBinder = False
}
]
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
sigNames (L _span (MinimalSig _ _ (L _ boolFormula))) =
-#else
-sigNames (L _span (MinimalSig _ (L _ boolFormula))) =
-#endif
map
(\n ->
NameOccurrence
- { locatedName = Just <$> n
+ { locatedName = Just <$> reLocN n
, description = "MinimalSig"
, isBinder = False
}) .
@@ -497,55 +411,33 @@ sigNames (L _span (MinimalSig _ (L _ boolFormula))) =
boolFormulaNames (Parens (L _ f)) = boolFormulaNames f
sigNames (L _ _) = []
-#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
hsTypeNames :: LHsType GhcRn -> [NameOccurrence]
-#else
-hsTypeNames :: LHsType Name -> [NameOccurrence]
-#endif
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
hsTypeNames (L _span (HsTyVar _ _promoted name)) =
-#elif MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
-hsTypeNames (L _span (HsTyVar _promoted name)) =
-#else
-hsTypeNames (L _span (HsTyVar name)) =
-#endif
[ NameOccurrence
- { locatedName = Just <$> name
+ { locatedName = Just <$> reLocN name
, description = "HsTyVar"
, isBinder = False
}
]
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
-hsTypeNames (L span (HsTyLit _ lit)) =
-#else
-hsTypeNames (L span (HsTyLit lit)) =
-#endif
+hsTypeNames lht@(L span (HsTyLit _ lit)) =
let kind =
case lit of
HsNumTy _ _ -> naturalTy
HsStrTy _ _ -> typeSymbolKind
in [ TyLitOccurrence
- { locatedName = L span Nothing
+ { locatedName = L (getLocA lht) Nothing
, description = "HsTyLit"
, kind = kind
}
]
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
hsTypeNames (L _span (HsOpTy _ _ name _)) =
-#else
-hsTypeNames (L _span (HsOpTy _ name _)) =
-#endif
[ NameOccurrence
- { locatedName = Just <$> name
+ { locatedName = Just <$> reLocN name
, description = "HsOpTy"
, isBinder = False
}
]
-#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0)
hsTypeNames (L span (HsTupleTy _ tupleSort types))
-#else
-hsTypeNames (L span (HsTupleTy tupleSort types))
-#endif
| null types =
let sort =
case tupleSort of
diff --git a/src/HaskellCodeExplorer/GhcUtils.hs b/src/HaskellCodeExplorer/GhcUtils.hs
index 461344f..99cf7b4 100644
--- a/src/HaskellCodeExplorer/GhcUtils.hs
+++ b/src/HaskellCodeExplorer/GhcUtils.hs
@@ -123,6 +123,7 @@ import GHC
, HsDataDefn(..)
, NewOrData(..)
, Id
+ , rdrNameFieldOcc
, HsGroup(..)
, HsBindLR(..)
, HsValBindsLR(..)
@@ -480,14 +481,16 @@ hsGroupVals hsGroup =
XValBindsLR (NValBinds binds _) -> concatMap (bagToList . snd) binds
_ -> []
-hsPatSynDetails :: HsPatSynDetails GhcRn -> [Name]
+hsPatSynDetails :: HsPatSynDetails GhcRn -> [Located Name]
hsPatSynDetails patDetails =
case patDetails of
- InfixCon name1 name2 -> [unLoc name1, unLoc name2]
- PrefixCon _ fields -> unLoc <$> fields
+ InfixCon name1 name2 -> [reLocN name1, reLocN name2]
+ PrefixCon _ fields -> reLocN <$> fields
RecCon fields -> concatMap
- (\field -> [extFieldOcc $ recordPatSynField field,
- unLoc $ recordPatSynPatVar field])
+ (\field -> [
+ L ((getLocA . rdrNameFieldOcc . recordPatSynField) field)
+ (extFieldOcc $ recordPatSynField field),
+ reLocN $ recordPatSynPatVar field])
fields
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
--
cgit v1.2.3