aboutsummaryrefslogtreecommitdiff
path: root/src/HaskellCodeExplorer/GhcUtils.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/HaskellCodeExplorer/GhcUtils.hs')
-rw-r--r--src/HaskellCodeExplorer/GhcUtils.hs110
1 files changed, 87 insertions, 23 deletions
diff --git a/src/HaskellCodeExplorer/GhcUtils.hs b/src/HaskellCodeExplorer/GhcUtils.hs
index 09be369..b25678d 100644
--- a/src/HaskellCodeExplorer/GhcUtils.hs
+++ b/src/HaskellCodeExplorer/GhcUtils.hs
@@ -73,7 +73,13 @@ import Data.Ord (comparing)
import qualified Data.Text as T
import DataCon (dataConWorkId, flSelector)
import Documentation.Haddock.Parser (overIdentifier, parseParas)
-import Documentation.Haddock.Types (DocH(..), Header(..), _doc)
+import Documentation.Haddock.Types (DocH(..),
+ Header(..),
+ _doc,
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+ Table(..)
+#endif
+ )
import DynFlags ()
import FastString (mkFastString, unpackFS)
import GHC
@@ -123,6 +129,9 @@ import GHC
#else
, tyClGroupConcat
#endif
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+ , FamEqn(..)
+#endif
, tyConKind
, nameSrcSpan
, srcSpanFile
@@ -150,7 +159,7 @@ import GHC
import qualified HaskellCodeExplorer.Types as HCE
import HscTypes (TypeEnv, lookupTypeEnv)
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
-import HsExtension (GhcPs, GhcRn, GhcTc, IdP(..), Pass(..))
+import HsExtension (GhcRn,IdP)
#endif
import IdInfo (IdDetails(..))
import InstEnv (ClsInst(..))
@@ -259,13 +268,28 @@ instanceToText :: DynFlags -> ClsInst -> T.Text
instanceToText flags ClsInst {..} =
T.append "instance " $ T.pack . showSDoc flags $ pprSigmaType (idType is_dfun)
---instanceDeclToText :: DynFlags -> InstDecl Name -> T.Text
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+instanceDeclToText :: DynFlags -> InstDecl GhcRn -> T.Text
+#else
+instanceDeclToText :: DynFlags -> InstDecl Name -> T.Text
+#endif
instanceDeclToText flags decl =
case decl of
-#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
- _ -> ""
-#else
ClsInstD ClsInstDecl {..} -> T.append "instance " (toText flags cid_poly_ty)
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+ DataFamInstD di ->
+ let args =
+ T.intercalate " " . map (toText flags) . feqn_pats .hsib_body . dfid_eqn $ di
+ in T.concat
+ ["data instance ", toText flags (unLoc $ feqn_tycon . hsib_body . dfid_eqn $ di), " ", args]
+ TyFamInstD ti ->
+ let args =
+ T.intercalate " " .
+ map (toText flags) . feqn_pats . hsib_body . tfid_eqn $
+ ti
+ in T.concat
+ ["type instance ", toText flags $ tyFamInstDeclName ti, " ", args]
+#else
DataFamInstD di ->
let args =
T.intercalate " " . map (toText flags) . hsib_body $ dfid_pats di
@@ -381,6 +405,8 @@ mbIdDetails _ = Nothing
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
hsGroupVals :: HsGroup GhcRn -> [GenLocated SrcSpan (HsBindLR GhcRn GhcRn)]
+#else
+hsGroupVals :: HsGroup Name -> [GenLocated SrcSpan (HsBindLR Name Name)]
#endif
hsGroupVals hsGroup =
filter (isGoodSrcSpan . getLoc) $
@@ -391,7 +417,12 @@ hsGroupVals hsGroup =
hsPatSynDetails :: HsPatSynDetails a -> [a]
hsPatSynDetails patDetails =
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
- []
+ case patDetails of
+ InfixCon name1 name2 -> [name1, name2]
+ PrefixCon fields -> fields
+ RecCon fields -> concatMap
+ (\field -> [recordPatSynSelectorId field, recordPatSynPatVar field])
+ fields
#else
case patDetails of
InfixPatSyn name1 name2 -> [name1, name2]
@@ -404,7 +435,7 @@ hsPatSynDetails patDetails =
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
---unwrapName :: LIEWrappedName n -> Located n
+unwrapName :: LIEWrappedName a -> Located a
unwrapName = ieLWrappedName
#elif MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
unwrapName :: LIEWrappedName Name -> Located Name
@@ -414,7 +445,11 @@ unwrapName :: Located Name -> Located Name
unwrapName n = n
#endif
---ieLocNames :: IE (IdP GhcTc) -> [Located Name]
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+ieLocNames :: IE pass -> [Located (IdP pass)]
+#else
+ieLocNames :: IE Name -> [Located Name]
+#endif
ieLocNames (IEVar n) = [unwrapName n]
ieLocNames (IEThingAbs n) = [unwrapName n]
ieLocNames (IEThingAll n) = [unwrapName n]
@@ -932,7 +967,11 @@ collectDocs = go Nothing []
go (Just prev) docs (d:ds) = finished prev docs (go (Just d) [] ds)
finished decl docs rest = (decl, reverse docs) : rest
---ungroup :: HsGroup Name -> [LHsDecl Name]
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+ungroup :: HsGroup GhcRn -> [LHsDecl GhcRn]
+#else
+ungroup :: HsGroup Name -> [LHsDecl Name]
+#endif
ungroup group_ =
#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
mkDecls (tyClGroupTyClDecls . hs_tyclds) TyClD group_ ++
@@ -962,7 +1001,11 @@ mkDecls field con struct = [L loc (con decl) | L loc decl <- field struct]
sortByLoc :: [Located a] -> [Located a]
sortByLoc = L.sortBy (comparing getLoc)
---classDeclDocs :: TyClDecl Name -> [(LHsDecl Name, [HsDocString])]
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+classDeclDocs :: TyClDecl GhcRn -> [(LHsDecl GhcRn, [HsDocString])]
+#else
+classDeclDocs :: TyClDecl Name -> [(LHsDecl Name, [HsDocString])]
+#endif
classDeclDocs class_ = collectDocs . sortByLoc $ decls
where
decls = docs ++ defs ++ sigs ++ ats
@@ -971,13 +1014,21 @@ classDeclDocs class_ = collectDocs . sortByLoc $ decls
sigs = mkDecls tcdSigs SigD class_
ats = mkDecls tcdATs (TyClD . FamDecl) class_
---conDeclDocs :: ConDecl Name -> [(Name, [HsDocString], SrcSpan)]
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+conDeclDocs :: ConDecl GhcRn -> [(Name, [HsDocString], SrcSpan)]
+#else
+conDeclDocs :: ConDecl Name -> [(Name, [HsDocString], SrcSpan)]
+#endif
conDeclDocs conDecl =
map (\(L span n) -> (n, maybe [] ((: []) . unLoc) $ con_doc conDecl, span)) .
getConNames $
conDecl
---selectorDocs :: ConDecl name -> [(PostRn name name, [HsDocString], SrcSpan)]
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+selectorDocs :: ConDecl pass -> [(PostRn pass (IdP pass), [HsDocString], SrcSpan)]
+#else
+selectorDocs :: ConDecl name -> [(PostRn name name, [HsDocString], SrcSpan)]
+#endif
selectorDocs con =
case getConDetails con of
RecCon (L _ flds) ->
@@ -990,15 +1041,13 @@ selectorDocs con =
flds
_ -> []
-
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
subordinateNamesWithDocs :: [GenLocated SrcSpan (HsDecl GhcRn)] -> [(Name, [HsDocString], SrcSpan)]
-#endif
-subordinateNamesWithDocs _ =
-#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
- []
#else
- concatMap
+subordinateNamesWithDocs :: [GenLocated SrcSpan (HsDecl Name)] -> [(Name, [HsDocString], SrcSpan)]
+#endif
+subordinateNamesWithDocs =
+ concatMap
(\(L span tyClDecl) ->
case tyClDecl of
TyClD classDecl@ClassDecl {..} ->
@@ -1009,16 +1058,24 @@ subordinateNamesWithDocs _ =
concatMap (\(L _ con) -> conDeclDocs con ++ selectorDocs con) $
dd_cons tcdDataDefn
InstD (DataFamInstD DataFamInstDecl {..}) ->
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+ concatMap (conDeclDocs . unLoc) . dd_cons . feqn_rhs . hsib_body $ dfid_eqn
+#else
concatMap (conDeclDocs . unLoc) . dd_cons $ dfid_defn
- _ -> [])
#endif
+ _ -> [])
+
isUserLSig :: LSig name -> Bool
isUserLSig (L _ TypeSig {}) = True
isUserLSig (L _ ClassOpSig {}) = True
isUserLSig _ = False
---getMainDeclBinder :: HsDecl name -> [name]
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+getMainDeclBinder :: HsDecl pass -> [IdP pass]
+#else
+getMainDeclBinder :: HsDecl name -> [name]
+#endif
getMainDeclBinder (TyClD d) = [tcdName d]
getMainDeclBinder (ValD d) =
case collectHsBindBinders d of
@@ -1029,7 +1086,11 @@ getMainDeclBinder (ForD (ForeignImport name _ _ _)) = [unLoc name]
getMainDeclBinder (ForD ForeignExport {}) = []
getMainDeclBinder _ = []
---sigNameNoLoc :: Sig name -> [name]
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+sigNameNoLoc :: Sig pass -> [IdP pass]
+#else
+sigNameNoLoc :: Sig name -> [name]
+#endif
sigNameNoLoc (TypeSig ns _) = map unLoc ns
sigNameNoLoc (ClassOpSig _ ns _) = map unLoc ns
#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
@@ -1042,7 +1103,7 @@ sigNameNoLoc (InlineSig n _) = [unLoc n]
sigNameNoLoc (FixSig (FixitySig ns _)) = map unLoc ns
sigNameNoLoc _ = []
-clsInstDeclSrcSpan :: ClsInstDecl name -> SrcSpan
+clsInstDeclSrcSpan :: ClsInstDecl a -> SrcSpan
clsInstDeclSrcSpan ClsInstDecl {cid_poly_ty = ty} = getLoc (hsSigType ty)
hsDocsToDocH :: DynFlags -> GlobalRdrEnv -> [HsDocString] -> Doc Name
@@ -1120,6 +1181,9 @@ rename dflags gre = rn
DocEmpty -> DocEmpty
DocString str -> DocString str
DocHeader (Header l t) -> DocHeader $ Header l (rn t)
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+ DocTable t -> DocTable (rn <$> t)
+#endif
-- | Wrap an identifier that's out of scope (i.e. wasn't found in
-- 'GlobalReaderEnv' during 'rename') in an appropriate doc. Currently
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-26 18:39:13 +0000