diff options
Diffstat (limited to 'src/HaskellCodeExplorer/GhcUtils.hs')
| -rw-r--r-- | src/HaskellCodeExplorer/GhcUtils.hs | 152 |
1 files changed, 3 insertions, 149 deletions
diff --git a/src/HaskellCodeExplorer/GhcUtils.hs b/src/HaskellCodeExplorer/GhcUtils.hs index 0a106ad..f8a2b06 100644 --- a/src/HaskellCodeExplorer/GhcUtils.hs +++ b/src/HaskellCodeExplorer/GhcUtils.hs @@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} @@ -61,9 +60,7 @@ module HaskellCodeExplorer.GhcUtils , hsDocsToDocH , subordinateNamesWithDocs ) where --- import Bag (bagToList) import GHC.Data.Bag (bagToList) --- import ConLike (ConLike(..)) import GHC.Core.ConLike (ConLike(..)) import GHC.HsToCore.Docs ( collectDocs @@ -81,7 +78,6 @@ import qualified Data.HashMap.Strict as HM import qualified Data.List as L import Data.Maybe (fromMaybe, isJust, mapMaybe) import qualified Data.Text as T --- import DataCon (dataConWorkId, flSelector) import GHC.Core.DataCon (dataConWorkId) import Documentation.Haddock.Parser (overIdentifier, parseParas) import Documentation.Haddock.Types @@ -90,19 +86,15 @@ import Documentation.Haddock.Types , _doc , Namespace ) --- import DynFlags () --- import FastString (mkFastString, unpackFS) import GHC.Data.FastString ( mkFastString , unpackFS - , FastString ) import GHC ( DynFlags - , XRec + , sortLocatedA , getRecConArgs_maybe , ConDeclField(..) - , LConDeclField , CollectFlag(..) , LHsBindLR , reLocN @@ -110,19 +102,11 @@ import GHC , UnXRec , GhcPass , recordPatSynField -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) , HsDocString -#else - , HsDocString (..) -#endif , InstDecl(..) , Name , SrcSpan(..) - , srcSpanStart - , srcSpanEnd - , SrcLoc(..) , RealSrcSpan(..) - , SrcSpanAnnA , ClsInstDecl(..) , TyClDecl(..) , HsDataDefn(..) @@ -131,11 +115,7 @@ import GHC , rdrNameFieldOcc , HsGroup(..) , HsValBindsLR(..) -#if MIN_VERSION_GLASGOW_HASKELL(8,4,1,0) , HsPatSynDetails -#else - , HsPatSynDetails(..) -#endif , Located , IE(..) , TyThing(..) @@ -150,28 +130,14 @@ import GHC , tcdName , collectHsBindBinders , getLocA --- , hsSigType , getConNames -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) , NHsValBindsLR(..) --- , getConArgs , unpackHDS , NoExtField(..) --- , NoExt(..) , extFieldOcc -#else - , getConDetails - , selectorFieldOcc -#endif -#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0) , LIEWrappedName , ieLWrappedName -#else - , tyClGroupConcat -#endif -#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) , FamEqn(..) -#endif , tyConKind , nameSrcSpan , srcSpanFile @@ -180,46 +146,26 @@ import GHC , srcSpanStartCol , srcSpanEndCol , isExternalName --- , recordPatSynSelectorId , recordPatSynPatVar , isGoodSrcSpan , isLocalId , isDataFamilyDecl , tyFamInstDeclName , idType --- , hsib_body -#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) -#else - , tfe_pats -#endif , tfid_eqn -#if MIN_VERSION_ghc(8,8,0) --- , dL --- , HasSrcSpan --- , SrcSpanLess -#endif ) import qualified HaskellCodeExplorer.Types as HCE --- import HscTypes (TypeEnv, lookupTypeEnv) import GHC.Types.TypeEnv (TypeEnv, lookupTypeEnv) -#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) --- import HsExtension (GhcRn,IdP) import GHC.Hs.Extension (GhcRn) import Language.Haskell.Syntax.Extension (IdP) -#endif --- import IdInfo (IdDetails(..)) import GHC.Types.Id.Info (IdDetails(..)) --- import InstEnv (ClsInst(..)) import GHC.Core.InstEnv (ClsInst(..)) --- import GHC.Parser.Lexer (ParseResult(POk), mkPState, unP) import GHC.Parser.Lexer ( ParseResult(POk) , initParserState , unP ) --- import Module (Module(..)) --- import Name import GHC.Types.Name ( isDataConNameSpace , isDerivedOccName @@ -239,49 +185,33 @@ import GHC.Types.Name , occNameString , wiredInNameTyThing_maybe ) --- import OccName (OccName) import GHC.Types.Name.Occurrence (OccName) --- import Outputable (Outputable, ppr, showPpr, showSDoc) import GHC.Utils.Outputable (Outputable, ppr) -import GHC.Utils.Misc (thenCmp) import GHC.Driver.Config (initParserOpts) import GHC.Driver.Ppr (showPpr, showSDoc) --- import PackageConfig (packageVersion) --- import Packages import GHC.Unit.State ( LookupResult(..) , lookupModuleWithSuggestions , lookupUnit --- , lookupPackage --- , packageNameString ) --- import Pair (pSnd) import GHC.Data.Pair (pSnd) --- import Parser (parseIdentifier) import GHC.Parser (parseIdentifier) --- import PatSyn (PatSyn, patSynMatcher, patSynSig) import GHC.Core.PatSyn (PatSyn, patSynMatcher, patSynSig) import Prelude hiding (id, span) --- import RdrName (GlobalRdrEnv, RdrName(..), gre_name, lookupGRE_RdrName) import GHC.Types.Name.Reader ( GlobalRdrEnv , RdrName(..) , grePrintableName , lookupGRE_RdrName) --- import RnEnv (dataTcOccs) import GHC.Rename.Env (dataTcOccs) --- import SrcLoc (GenLocated(..), mkRealSrcLoc, unLoc) import GHC.Types.SrcLoc ( GenLocated(..) , mkRealSrcLoc , unLoc ) --- import StringBuffer (StringBuffer(..), stringToStringBuffer) import GHC.Data.StringBuffer (StringBuffer(..), stringToStringBuffer) import System.FilePath (normalise) --- import TcEvidence (HsWrapper(..), tcCoercionKind) import GHC.Tc.Types.Evidence (HsWrapper(..), tcCoercionKind) --- import TcType (evVarPred) import GHC.Tc.Utils.TcType (evVarPred) import GHC.Core.TyCo.Rep ( Type(..) @@ -290,39 +220,24 @@ import GHC.Core.TyCo.Rep , mkVisFunTysMany , scaledThing ) --- import TyCon (tyConName) import GHC.Core.TyCon (tyConName) --- import Type import GHC.Core.Type ( coreView , expandTypeSynonyms , mkForAllTy , mkTyCoInvForAllTys --- , mkFunTys --- , mkInvForAllTys , piResultTy , splitFunTy_maybe , tidyOpenType ) import GHC.Core.TyCo.Ppr (pprSigmaType) -#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0) import GHC.CoreToIface --- import IfaceType import GHC.Iface.Type -#endif --- import TysWiredIn (unitTy) import GHC.Builtin.Types (unitTy) --- import UniqSet (emptyUniqSet, unionUniqSets, import GHC.Types.Unique.Set (emptyUniqSet, unionUniqSets, -#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0) nonDetEltsUniqSet -#else - uniqSetToList -#endif ) --- import Unique (getKey) import GHC.Types.Unique (getKey) --- import Var import GHC.Types.Var ( idDetails , isId @@ -333,14 +248,8 @@ import GHC.Types.Var , varType , varUnique ) --- import VarEnv (TidyEnv) import GHC.Types.Var.Env (TidyEnv) --- import VarSet (VarSet, emptyVarSet, unionVarSet, unitVarSet import GHC.Types.Var.Set (VarSet, emptyVarSet, unionVarSet, unitVarSet -#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0) -#else - ,varSetElems -#endif ) import GHC.Unit @@ -1036,61 +945,23 @@ tyVarsOfType = varSetElems . everything unionVarSet (emptyVarSet `mkQ` tyVar) -- Some functions are copied from haddock-api package -------------------------------------------------------------------------------- --- collectDocs is available in GHC.HsToCore.Docs --- collectDocs :: [LHsDecl p] -> [(LHsDecl p, [HsDocString])] - -- available in GHC.HsToCore.Docs --- #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) +-- collectDocs :: [LHsDecl p] -> [(LHsDecl p, [HsDocString])] -- ungroup :: HsGroup GhcRn -> [LHsDecl GhcRn] --- #else --- ungroup :: HsGroup Name -> [LHsDecl Name] --- #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] - -instance Ord FastString where - a `compare` b = unpackFS a `compare` unpackFS b - -deriving instance () => Ord SrcLoc - -instance Ord SrcSpan where - a `compare` b = - (srcSpanStart a `compare` srcSpanStart b) `thenCmp` - (srcSpanEnd a `compare` srcSpanEnd b) -sortByLoc :: [GenLocated SrcSpanAnnA a] -> [GenLocated SrcSpanAnnA a] -sortByLoc = L.sortOn getLocA - -#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 +classDeclDocs class_ = collectDocs . sortLocatedA $ decls where decls = docs ++ defs ++ sigs ++ ats -#if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) docs = mkDecls tcdDocs (DocD NoExtField) class_ defs = mkDecls (bagToList . tcdMeths) (ValD NoExtField) class_ sigs = mkDecls tcdSigs (SigD NoExtField) class_ ats = mkDecls tcdATs ((TyClD NoExtField) . (FamDecl NoExtField)) class_ -#else - docs = mkDecls tcdDocs DocD class_ - defs = mkDecls (bagToList . tcdMeths) ValD class_ - sigs = mkDecls tcdSigs SigD class_ - ats = mkDecls tcdATs (TyClD . FamDecl) class_ -#endif -#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 (\con -> (unLoc con, maybe [] ((: []) . unLoc) $ con_doc conDecl, getLocA con)) . getConNames $ @@ -1126,13 +997,6 @@ subordinateNamesWithDocs = _ -> []) --- no longer needed by ungroup --- isUserLSig :: forall p. UnXRec p => LSig p -> Bool --- isUserLSig sig = case unXRec @p sig of --- TypeSig {} -> True --- ClassOpSig {} -> True --- _ -> False - #if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0) getMainDeclBinder :: HsDecl GhcRn -> [IdP GhcRn] #else @@ -1180,10 +1044,6 @@ sigNameNoLoc _ = [] clsInstDeclSrcSpan :: ClsInstDecl (GhcPass p) -> SrcSpan clsInstDeclSrcSpan ClsInstDecl {cid_poly_ty = ty} = getLocA ty --- Pattern match is redundant --- #if MIN_VERSION_GLASGOW_HASKELL(8,6,1,0) --- clsInstDeclSrcSpan (XClsInstDecl _) = UnhelpfulSpan (UnhelpfulOther "XClsinstdecl") --- #endif hsDocsToDocH :: DynFlags -> GlobalRdrEnv -> [HsDocString] -> Doc Name hsDocsToDocH flags rdrEnv = @@ -1305,11 +1165,5 @@ makeAnchorId (f:r) = escape isAlpha f ++ concatMap (escape isLegal) r isLegal '.' = True isLegal c = isAscii c && isAlphaNum c --- no more HasSrcSpan or SrcSpanLess --- #if MIN_VERSION_ghc(8,8,0) --- ghcDL :: GHC.HasSrcSpan a => a -> GHC.Located (GHC.SrcSpanLess a) --- ghcDL = GHC.dL --- #else ghcDL :: GHC.Located a -> GHC.Located a ghcDL x = x --- #endif |