aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/HaskellCodeExplorer/AST/RenamedSource.hs72
-rw-r--r--src/HaskellCodeExplorer/AST/TypecheckedSource.hs79
-rw-r--r--src/HaskellCodeExplorer/GhcUtils.hs110
-rw-r--r--src/HaskellCodeExplorer/ModuleInfo.hs5
-rw-r--r--src/HaskellCodeExplorer/Types.hs20
5 files changed, 245 insertions, 41 deletions
diff --git a/src/HaskellCodeExplorer/AST/RenamedSource.hs b/src/HaskellCodeExplorer/AST/RenamedSource.hs
index ea5a87a..592c8f7 100644
--- a/src/HaskellCodeExplorer/AST/RenamedSource.hs
+++ b/src/HaskellCodeExplorer/AST/RenamedSource.hs
@@ -56,6 +56,8 @@ import GHC
, Sig(..)
, TyClDecl(..)
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+ , FamEqn(..)
+ , HsDataDefn(..)
#else
, TyFamEqn(..)
#endif
@@ -94,6 +96,8 @@ namesFromRenamedSource =
tyClDeclNames `extQ`
familyDeclNames `extQ`
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+ familyEqNames `extQ`
+ dataEqNames `extQ`
#else
tyFamilyEqNames `extQ`
tyFamilyDefEqNames `extQ`
@@ -111,6 +115,8 @@ namesFromRenamedSource =
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
fieldOccName :: Bool -> FieldOcc GhcRn -> NameOccurrence
+#else
+fieldOccName :: Bool -> FieldOcc Name -> NameOccurrence
#endif
fieldOccName isBinder (FieldOcc (L span _) name) =
NameOccurrence
@@ -121,17 +127,23 @@ fieldOccName isBinder (FieldOcc (L span _) name) =
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
conDeclFieldNames :: ConDeclField GhcRn -> [NameOccurrence]
+#else
+conDeclFieldNames :: ConDeclField Name -> [NameOccurrence]
#endif
conDeclFieldNames ConDeclField {..} =
map (fieldOccName True . unLoc) cd_fld_names
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
hsRecFieldExprNames :: HsRecField' (FieldOcc GhcRn) (LHsExpr GhcRn) -> [NameOccurrence]
+#else
+hsRecFieldExprNames :: HsRecField' (FieldOcc Name) (LHsExpr Name) -> [NameOccurrence]
#endif
hsRecFieldExprNames HsRecField {..} = [fieldOccName False $ unLoc hsRecFieldLbl]
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
hsRecAmbFieldExprNames :: HsRecField' (AmbiguousFieldOcc GhcRn) (LHsExpr GhcRn) -> [NameOccurrence]
+#else
+hsRecAmbFieldExprNames :: HsRecField' (AmbiguousFieldOcc Name) (LHsExpr Name) -> [NameOccurrence]
#endif
hsRecAmbFieldExprNames HsRecField {..} =
let (L span recField) = hsRecFieldLbl
@@ -148,11 +160,15 @@ hsRecAmbFieldExprNames HsRecField {..} =
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
hsRecFieldPatNames :: HsRecField' (FieldOcc GhcRn) (LPat GhcRn) -> [NameOccurrence]
-#endif
+#else
+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
hsExprNames (L _span (HsVar name)) =
[ NameOccurrence
@@ -195,9 +211,11 @@ 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)
+#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
mapMaybe (fmap toNameOcc . matchContextName . m_ctxt . unLoc) .
#else
mapMaybe (fmap toNameOcc . matchFixityName . m_fixity . unLoc) .
@@ -216,10 +234,12 @@ matchGroupNames =
--toNameOcc :: Located Name -> NameOccurrence
toNameOcc n =
NameOccurrence
- {locatedName = Just <$> n, description = "Match", isBinder = True}
+ {locatedName = Just <$> 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
bindNames (L _span (PatSynBind PSB {..})) =
[ NameOccurrence
@@ -230,6 +250,7 @@ bindNames (L _span (PatSynBind PSB {..})) =
]
bindNames _ = []
+hsPatSynDetailsNames :: HsPatSynDetails (Located Name) -> [NameOccurrence]
hsPatSynDetailsNames =
map
(\name ->
@@ -240,9 +261,10 @@ hsPatSynDetailsNames =
}) .
hsPatSynDetails
-
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
importNames :: IE GhcRn -> [NameOccurrence]
+#else
+importNames :: IE Name -> [NameOccurrence]
#endif
importNames =
map
@@ -257,6 +279,8 @@ importNames =
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
patNames :: LPat GhcRn -> [NameOccurrence]
+#else
+patNames :: LPat Name -> [NameOccurrence]
#endif
patNames (L _span (VarPat name)) =
[ NameOccurrence
@@ -291,6 +315,8 @@ patNames _ = []
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
sigNames :: LSig GhcRn -> [NameOccurrence]
+#else
+sigNames :: LSig Name -> [NameOccurrence]
#endif
sigNames (L _span (TypeSig names _)) =
map
@@ -363,9 +389,10 @@ 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,2,2,0)
hsTypeNames (L _span (HsTyVar _promoted name)) =
@@ -419,6 +446,8 @@ hsTypeNames _ = []
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
hsTyVarBndrNames :: HsTyVarBndr GhcRn -> [NameOccurrence]
+#else
+hsTyVarBndrNames :: HsTyVarBndr Name -> [NameOccurrence]
#endif
hsTyVarBndrNames (UserTyVar n) =
[ NameOccurrence
@@ -437,6 +466,8 @@ hsTyVarBndrNames (KindedTyVar n _) =
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
tyClDeclNames :: LTyClDecl GhcRn -> [NameOccurrence]
+#else
+tyClDeclNames :: LTyClDecl Name -> [NameOccurrence]
#endif
tyClDeclNames (L _span DataDecl {..}) =
[ NameOccurrence
@@ -473,6 +504,8 @@ tyClDeclNames _ = []
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
familyDeclNames :: FamilyDecl GhcRn -> [NameOccurrence]
+#else
+familyDeclNames :: FamilyDecl Name -> [NameOccurrence]
#endif
familyDeclNames FamilyDecl {..} =
[ NameOccurrence
@@ -483,10 +516,26 @@ familyDeclNames FamilyDecl {..} =
]
---TODO
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+familyEqNames :: FamEqn GhcRn (HsTyPats GhcRn) (LHsType GhcRn) -> [NameOccurrence]
+familyEqNames FamEqn {feqn_tycon = tyCon} =
+ [ NameOccurrence
+ { locatedName = Just <$> tyCon
+ , description = "FamEqn"
+ , isBinder = False
+ }
+ ]
+
+dataEqNames :: FamEqn GhcRn (HsTyPats GhcRn) (HsDataDefn GhcRn) -> [NameOccurrence]
+dataEqNames FamEqn {feqn_tycon = tyCon} =
+ [ NameOccurrence
+ { locatedName = Just <$> tyCon
+ , description = "FamEqn"
+ , isBinder = False
+ }
+ ]
#else
---tyFamilyEqNames :: TyFamEqn Name (HsTyPats Name) -> [NameOccurrence]
+tyFamilyEqNames :: TyFamEqn Name (HsTyPats Name) -> [NameOccurrence]
tyFamilyEqNames TyFamEqn {tfe_tycon = tyCon} =
[ NameOccurrence
{ locatedName = Just <$> tyCon
@@ -495,7 +544,7 @@ tyFamilyEqNames TyFamEqn {tfe_tycon = tyCon} =
}
]
---tyFamilyDefEqNames :: TyFamEqn Name (LHsQTyVars Name) -> [NameOccurrence]
+tyFamilyDefEqNames :: TyFamEqn Name (LHsQTyVars Name) -> [NameOccurrence]
tyFamilyDefEqNames TyFamEqn {tfe_tycon = tyCon} =
[ NameOccurrence
{ locatedName = Just <$> tyCon
@@ -504,8 +553,7 @@ tyFamilyDefEqNames TyFamEqn {tfe_tycon = tyCon} =
}
]
-
---dataFamInstDeclNames :: DataFamInstDecl Name -> [NameOccurrence]
+dataFamInstDeclNames :: DataFamInstDecl Name -> [NameOccurrence]
dataFamInstDeclNames DataFamInstDecl {dfid_tycon = tyCon} =
[ NameOccurrence
{ locatedName = Just <$> tyCon
@@ -517,6 +565,8 @@ dataFamInstDeclNames DataFamInstDecl {dfid_tycon = tyCon} =
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
conDeclNames :: ConDecl GhcRn -> [NameOccurrence]
+#else
+conDeclNames :: ConDecl Name -> [NameOccurrence]
#endif
conDeclNames con =
case con of
@@ -539,6 +589,8 @@ conDeclNames con =
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foreignDeclNames :: ForeignDecl GhcRn -> [NameOccurrence]
+#else
+foreignDeclNames :: ForeignDecl Name -> [NameOccurrence]
#endif
foreignDeclNames decl =
[ NameOccurrence
diff --git a/src/HaskellCodeExplorer/AST/TypecheckedSource.hs b/src/HaskellCodeExplorer/AST/TypecheckedSource.hs
index 4dfbd8b..6f9a4cf 100644
--- a/src/HaskellCodeExplorer/AST/TypecheckedSource.hs
+++ b/src/HaskellCodeExplorer/AST/TypecheckedSource.hs
@@ -80,7 +80,9 @@ import HsSyn
, selectorAmbiguousFieldOcc
)
import HscTypes (TypeEnv, lookupTypeEnv)
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
import HsExtension (GhcTc)
+#endif
import Id (idType)
import IdInfo (IdDetails(..))
import InstEnv
@@ -545,11 +547,15 @@ tidyType typ = do
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldTypecheckedSource :: LHsBinds GhcTc -> State ASTState ()
+#else
+foldTypecheckedSource :: LHsBinds Id -> State ASTState ()
#endif
foldTypecheckedSource = foldLHsBindsLR
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldLHsExpr :: LHsExpr GhcTc -> State ASTState (Maybe Type)
+#else
+foldLHsExpr :: LHsExpr Id -> State ASTState (Maybe Type)
#endif
foldLHsExpr (L span (HsVar (L _ identifier))) =
restoreTidyEnv $ do
@@ -809,6 +815,8 @@ foldLHsExpr (L span (HsWrap wrapper expr)) =
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldHsRecFields :: HsRecFields GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Type)
+#else
+foldHsRecFields :: HsRecFields Id (LHsExpr Id) -> State ASTState (Maybe Type)
#endif
foldHsRecFields HsRecFields {..} = do
let userWritten =
@@ -820,6 +828,8 @@ foldHsRecFields HsRecFields {..} = do
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldLHsRecField :: LHsRecField GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Type)
+#else
+foldLHsRecField :: LHsRecField Id (LHsExpr Id) -> State ASTState (Maybe Type)
#endif
foldLHsRecField (L span (HsRecField (L idSpan (FieldOcc _ identifier)) arg pun)) =
restoreTidyEnv $ do
@@ -831,6 +841,8 @@ foldLHsRecField (L span (HsRecField (L idSpan (FieldOcc _ identifier)) arg pun))
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldLHsRecUpdField :: LHsRecUpdField GhcTc -> State ASTState (Maybe Type)
+#else
+foldLHsRecUpdField :: LHsRecUpdField Id -> State ASTState (Maybe Type)
#endif
foldLHsRecUpdField (L span (HsRecField (L idSpan recField) arg pun)) =
restoreTidyEnv $ do
@@ -857,6 +869,8 @@ data TupArg
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldLHsTupArg :: LHsTupArg GhcTc -> State ASTState (Maybe Type, TupArg)
+#else
+foldLHsTupArg :: LHsTupArg Id -> State ASTState (Maybe Type, TupArg)
#endif
foldLHsTupArg (L _span (Present expr)) =
restoreTidyEnv $ do
@@ -873,6 +887,8 @@ foldLHsTupArg (L _ (Missing typ)) =
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldLMatch :: LMatch GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Type)
+#else
+foldLMatch :: LMatch Id (LHsExpr Id) -> State ASTState (Maybe Type)
#endif
foldLMatch (L _span Match {..}) = do
mapM_ foldLPat m_pats
@@ -881,6 +897,8 @@ foldLMatch (L _span Match {..}) = do
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldLMatchCmd :: LMatch GhcTc (LHsCmd GhcTc) -> State ASTState (Maybe Type)
+#else
+foldLMatchCmd :: LMatch Id (LHsCmd Id) -> State ASTState (Maybe Type)
#endif
foldLMatchCmd (L _span Match {..}) = do
mapM_ foldLPat m_pats
@@ -889,6 +907,8 @@ foldLMatchCmd (L _span Match {..}) = do
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldGRHSsCmd :: GRHSs GhcTc (LHsCmd GhcTc) -> State ASTState (Maybe Type)
+#else
+foldGRHSsCmd :: GRHSs Id (LHsCmd Id) -> State ASTState (Maybe Type)
#endif
foldGRHSsCmd GRHSs {..} = do
mapM_ foldLGRHSCmd grhssGRHSs
@@ -897,6 +917,8 @@ foldGRHSsCmd GRHSs {..} = do
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldGRHSs :: GRHSs GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Type)
+#else
+foldGRHSs :: GRHSs Id (LHsExpr Id) -> State ASTState (Maybe Type)
#endif
foldGRHSs GRHSs {..} = do
mapM_ foldLGRHS grhssGRHSs
@@ -905,6 +927,8 @@ foldGRHSs GRHSs {..} = do
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldLStmtLR :: LStmtLR GhcTc GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Type)
+#else
+foldLStmtLR :: LStmtLR Id Id (LHsExpr Id) -> State ASTState (Maybe Type)
#endif
foldLStmtLR (L span (LastStmt body _ _)) =
do typ <- foldLHsExpr body
@@ -941,6 +965,8 @@ foldLStmtLR (L span (ApplicativeStmt args _ typ)) =
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldApplicativeArg :: ApplicativeArg GhcTc GhcTc -> State ASTState (Maybe Type)
+#else
+foldApplicativeArg :: ApplicativeArg Id Id -> State ASTState (Maybe Type)
#endif
foldApplicativeArg appArg =
case appArg of
@@ -957,8 +983,10 @@ foldApplicativeArg appArg =
_ <- foldLPat pat
return Nothing
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
-foldLStmtLRCmd :: LStmtLR GhcTc GhcTc (LHsCmd GhcTc)
- -> State ASTState (Maybe Type)
+foldLStmtLRCmd ::
+ LStmtLR GhcTc GhcTc (LHsCmd GhcTc) -> State ASTState (Maybe Type)
+#else
+foldLStmtLRCmd :: LStmtLR Id Id (LHsCmd Id) -> State ASTState (Maybe Type)
#endif
foldLStmtLRCmd (L span (LastStmt body _syntaxExpr _)) = do
typ <- foldLHsCmd body
@@ -995,6 +1023,8 @@ foldLStmtLRCmd (L span (ApplicativeStmt args _ typ)) =
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldLGRHS :: LGRHS GhcTc (LHsExpr GhcTc) -> State ASTState (Maybe Type)
+#else
+foldLGRHS :: LGRHS Id (LHsExpr Id) -> State ASTState (Maybe Type)
#endif
foldLGRHS (L _span (GRHS guards body)) = do
typ <- foldLHsExpr body
@@ -1003,14 +1033,18 @@ foldLGRHS (L _span (GRHS guards body)) = do
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldLGRHSCmd :: LGRHS GhcTc (LHsCmd GhcTc) -> State ASTState (Maybe Type)
+#else
+foldLGRHSCmd :: LGRHS Id (LHsCmd Id) -> State ASTState (Maybe Type)
#endif
foldLGRHSCmd (L _span (GRHS guards body)) = do
typ <- foldLHsCmd body
mapM_ foldLStmtLR guards
return typ
-#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldParStmtBlock :: ParStmtBlock GhcTc GhcTc -> State ASTState (Maybe Type)
+#else
+foldParStmtBlock :: ParStmtBlock Id Id -> State ASTState (Maybe Type)
#endif
foldParStmtBlock (ParStmtBlock exprStmts _ids _syntaxExpr) = do
mapM_ foldLStmtLR exprStmts
@@ -1018,6 +1052,8 @@ foldParStmtBlock (ParStmtBlock exprStmts _ids _syntaxExpr) = do
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldHsLocalBindsLR :: HsLocalBindsLR GhcTc GhcTc -> State ASTState (Maybe Type)
+#else
+foldHsLocalBindsLR :: HsLocalBindsLR Id Id -> State ASTState (Maybe Type)
#endif
foldHsLocalBindsLR (HsValBinds binds) = do
_ <- foldHsValBindsLR binds
@@ -1027,6 +1063,8 @@ foldHsLocalBindsLR EmptyLocalBinds = return Nothing
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldHsValBindsLR :: HsValBindsLR GhcTc GhcTc -> State ASTState (Maybe Type)
+#else
+foldHsValBindsLR :: HsValBindsLR Id Id -> State ASTState (Maybe Type)
#endif
foldHsValBindsLR (ValBindsIn _ _) = return Nothing
foldHsValBindsLR (ValBindsOut binds _) = do
@@ -1035,6 +1073,8 @@ foldHsValBindsLR (ValBindsOut binds _) = do
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldLHsBindsLR :: LHsBinds GhcTc -> State ASTState ()
+#else
+foldLHsBindsLR :: LHsBinds Id -> State ASTState ()
#endif
foldLHsBindsLR = mapM_ (`foldLHsBindLR` Nothing) . bagToList
@@ -1042,7 +1082,11 @@ foldLHsBindsLR = mapM_ (`foldLHsBindLR` Nothing) . bagToList
foldLHsBindLR :: LHsBindLR GhcTc GhcTc
-> Maybe Id -- ^ Polymorphic id
-> State ASTState (Maybe Type)
-#endif
+#else
+foldLHsBindLR :: LHsBindLR Id Id
+ -> Maybe Id -- ^ Polymorphic id
+ -> State ASTState (Maybe Type)
+#endif
foldLHsBindLR (L _span FunBind {..}) mbPolyId
| mg_origin fun_matches == FromSource =
restoreTidyEnv $ do
@@ -1077,26 +1121,35 @@ foldLHsBindLR (L _ AbsBindsSig {..}) _ = do
foldLHsBindLR (L _ (PatSynBind PSB {..})) _ =
restoreTidyEnv $ do
_ <- foldLPat psb_def
-#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
-#else
_ <-
let addId :: GenLocated SrcSpan Id -> State ASTState ()
addId (L span i) = do
(i', _) <- tidyIdentifier i
addIdentifierToIdSrcSpanMap span i' Nothing
in case psb_args of
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+ InfixCon id1 id2 -> addId id1 >> addId id2
+ PrefixCon ids -> mapM_ addId ids
+ RecCon recs ->
+ mapM_
+ (\(RecordPatSynField selId patVar) ->
+ addId selId >> addId patVar)
+ recs
+#else
InfixPatSyn id1 id2 -> addId id1 >> addId id2
PrefixPatSyn ids -> mapM_ addId ids
RecordPatSyn recs ->
mapM_
(\(RecordPatSynField selId patVar) ->
addId selId >> addId patVar)
- recs
+ recs
#endif
return Nothing
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldLPat :: LPat GhcTc -> State ASTState (Maybe Type)
+#else
+foldLPat :: LPat Id -> State ASTState (Maybe Type)
#endif
foldLPat (L span (VarPat (L _ identifier))) = do
(identifier', _) <- tidyIdentifier identifier
@@ -1207,6 +1260,10 @@ foldLPat (L span p@(CoPat _ pat typ)) = do
foldHsConPatDetails
:: HsConPatDetails GhcTc
-> State ASTState (Maybe Type)
+#else
+foldHsConPatDetails
+ :: HsConPatDetails Id
+ -> State ASTState (Maybe Type)
#endif
foldHsConPatDetails (PrefixCon args) = do
_ <- mapM_ foldLPat args
@@ -1221,6 +1278,8 @@ foldHsConPatDetails (InfixCon arg1 arg2) = do
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldHsRecFieldsPat :: HsRecFields GhcTc (LPat GhcTc) -> State ASTState (Maybe Type)
+#else
+foldHsRecFieldsPat :: HsRecFields Id (LPat Id) -> State ASTState (Maybe Type)
#endif
foldHsRecFieldsPat HsRecFields {..} = do
let onlyUserWritten =
@@ -1232,6 +1291,8 @@ foldHsRecFieldsPat HsRecFields {..} = do
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldLHsRecFieldPat :: LHsRecField GhcTc (LPat GhcTc) -> State ASTState (Maybe Type)
+#else
+foldLHsRecFieldPat :: LHsRecField Id (LPat Id) -> State ASTState (Maybe Type)
#endif
foldLHsRecFieldPat (L _ (HsRecField (L idSpan (FieldOcc _ identifier)) arg pun)) = do
(identifier', mbTypes) <- tidyIdentifier identifier
@@ -1241,6 +1302,8 @@ foldLHsRecFieldPat (L _ (HsRecField (L idSpan (FieldOcc _ identifier)) arg pun))
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldLHsCmdTop :: LHsCmdTop GhcTc -> State ASTState (Maybe Type)
+#else
+foldLHsCmdTop :: LHsCmdTop Id -> State ASTState (Maybe Type)
#endif
foldLHsCmdTop (L span (HsCmdTop cmd _ _ _)) = do
mbTyp <- foldLHsCmd cmd
@@ -1249,6 +1312,8 @@ foldLHsCmdTop (L span (HsCmdTop cmd _ _ _)) = do
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
foldLHsCmd :: LHsCmd GhcTc -> State ASTState (Maybe Type)
+#else
+foldLHsCmd :: LHsCmd Id -> State ASTState (Maybe Type)
#endif
foldLHsCmd (L _ (HsCmdArrApp expr1 expr2 _ _ _)) = do
_ <- foldLHsExpr expr1
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
diff --git a/src/HaskellCodeExplorer/ModuleInfo.hs b/src/HaskellCodeExplorer/ModuleInfo.hs
index 5145fa5..ddd7e9f 100644
--- a/src/HaskellCodeExplorer/ModuleInfo.hs
+++ b/src/HaskellCodeExplorer/ModuleInfo.hs
@@ -6,6 +6,7 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StrictData #-}
module HaskellCodeExplorer.ModuleInfo
@@ -25,7 +26,9 @@ import qualified Data.IntervalMap.Strict as IVM
import qualified Data.List as L hiding (span)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Ord (comparing)
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
import HsExtension (GhcRn)
+#endif
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
@@ -475,6 +478,8 @@ createDeclarations ::
DynFlags
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
-> HsGroup GhcRn
+#else
+ -> HsGroup Name
#endif
-> TypeEnv
-> S.Set Name
diff --git a/src/HaskellCodeExplorer/Types.hs b/src/HaskellCodeExplorer/Types.hs
index 9e3667d..f94b3af 100644
--- a/src/HaskellCodeExplorer/Types.hs
+++ b/src/HaskellCodeExplorer/Types.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveDataTypeable #-}
@@ -47,6 +48,11 @@ import Documentation.Haddock.Types
, Header(..)
, Hyperlink(..)
, Picture(..)
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+ , Table(..)
+ , TableCell(..)
+ , TableRow(..)
+#endif
)
import GHC.Generics (Generic)
import Prelude hiding (id)
@@ -781,7 +787,7 @@ docToHtml modToHtml idToHtml = toStrict . renderHtml . toH
in htmlPrompt >> htmlExpression >>
mapM_ (Html.span . Html.toHtml) (unlines results))
examples
- toH (DocString str) = Html.span . Html.toHtml $ T.pack str
+ toH (DocString str) = Html.span . Html.toHtml $ T.pack str
toH (DocHeader (Header level doc)) = toHeader level $ toH doc
where
toHeader 1 = Html.h1
@@ -790,6 +796,18 @@ docToHtml modToHtml idToHtml = toStrict . renderHtml . toH
toHeader 4 = Html.h4
toHeader 5 = Html.h5
toHeader _ = Html.h6
+#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
+ toH (DocTable (Table hs bs)) =
+ let tableRowToH tdOrTh (TableRow cells) =
+ Html.tr $ mapM_ (tableCellToH tdOrTh) cells
+ tableCellToH tdOrTh (TableCell colspan rowspan doc) =
+ (tdOrTh $ toH doc) Html.!?
+ (colspan /= 1, (Attr.colspan (Html.stringValue $ show colspan))) Html.!?
+ (rowspan /= 1, (Attr.rowspan (Html.stringValue $ show rowspan)))
+ in Html.table $
+ Html.thead (mapM_ (tableRowToH Html.th) hs) >>
+ Html.tbody (mapM_ (tableRowToH Html.td) bs)
+#endif
instance A.ToJSON HaskellModuleName where
toJSON (HaskellModuleName name) = A.String name
generated by cgit v1.2.3 (git 2.39.1) at 2025-11-04 08:11:31 +0000