aboutsummaryrefslogtreecommitdiff
path: root/src/HaskellCodeExplorer/ModuleInfo.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/HaskellCodeExplorer/ModuleInfo.hs')
-rw-r--r--src/HaskellCodeExplorer/ModuleInfo.hs96
1 files changed, 54 insertions, 42 deletions
diff --git a/src/HaskellCodeExplorer/ModuleInfo.hs b/src/HaskellCodeExplorer/ModuleInfo.hs
index fd8f61a..8942e6f 100644
--- a/src/HaskellCodeExplorer/ModuleInfo.hs
+++ b/src/HaskellCodeExplorer/ModuleInfo.hs
@@ -25,17 +25,15 @@ import qualified Data.IntMap.Strict as IM
import qualified Data.IntervalMap.Strict as IVM
import qualified Data.List as L hiding (span)
import Data.Maybe (fromMaybe, mapMaybe)
-#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
-import HsExtension (GhcRn)
-#endif
+import GHC.Hs.Extension (GhcRn)
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Text.Lazy (toStrict)
import Documentation.Haddock.Types (DocH)
-import DynFlags(DynFlags)
import GHC
( GenLocated(..)
+ , DynFlags
, ModSummary
, ModuleInfo
, ModuleName
@@ -55,18 +53,20 @@ import GHC
, tm_internals_
, tm_typechecked_source
, unLoc
+ , LHsDecl
)
-import Type(expandTypeSynonyms)
-import TyCon (isFamInstTyCon,tyConName)
+import GHC.Parser.Annotation (sortLocatedA, getLocA)
+import GHC.Core.Type(expandTypeSynonyms)
+import GHC.Core.TyCon (isFamInstTyCon,tyConName)
import HaskellCodeExplorer.AST.RenamedSource
import HaskellCodeExplorer.AST.TypecheckedSource
import HaskellCodeExplorer.GhcUtils
import HaskellCodeExplorer.Preprocessor (createSourceCodeTransformation)
import qualified HaskellCodeExplorer.Types as HCE
#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
-import HsBinds (HsBindLR)
+import GHC.Hs.Binds (HsBindLR)
#endif
-import HsDecls
+import GHC.Hs.Decls
( ForeignDecl(..)
, HsDecl(..)
, HsGroup(..)
@@ -82,37 +82,45 @@ import HsDecls
, hsGroupInstDecls
#endif
)
-import HsDoc(HsDocString)
-import HsImpExp (IE(..), ImportDecl(..))
-import HsUtils(collectHsBindBinders)
-import HscTypes
+import GHC.Hs.Doc(HsDocString)
+import GHC.Hs.ImpExp (IE(..), ImportDecl(..))
+import GHC.Hs.Utils(collectHsBindBinders)
+import GHC.Unit.State (UnitState)
+import GHC.Unit.Module.ModDetails
+ ( md_types
+ )
+import GHC.Unit.External
( ExternalPackageState
- , HomePackageTable
- , TypeEnv
, eps_PTE
, eps_inst_env
+ )
+import GHC.Unit.Home.ModInfo
+ ( HomePackageTable
, hm_details
- , md_types
- , mkTypeEnv
- , typeEnvElts
)
-import InstEnv (InstEnvs(..), is_dfun)
-import Module(Module(..))
-import Name (Name, OccName, getSrcSpan, nameOccName, nameSrcSpan, nameUnique)
+import GHC.Core.InstEnv (InstEnvs(..), is_dfun)
+import GHC.Unit.Module
+ ( Module(..)
+ )
+import GHC.Unit.Types
+ ( GenModule(..)
+ )
+import GHC.Types.Name (Name, OccName, getSrcSpan, nameOccName, nameSrcSpan, nameUnique)
import Prelude hiding(id,span)
-import RdrName(GlobalRdrEnv)
-import SrcLoc (isOneLineSpan)
-import TcRnTypes (tcVisibleOrphanMods, tcg_inst_env, tcg_rdr_env, tcg_type_env)
+import GHC.Types.TypeEnv
+ ( TypeEnv
+ , typeEnvElts
+ , mkTypeEnv
+ )
+import GHC.Types.Name.Reader (GlobalRdrEnv)
+import GHC.Types.SrcLoc (isOneLineSpan)
+import GHC.Tc.Types (tcVisibleOrphanMods, tcg_inst_env, tcg_rdr_env, tcg_type_env)
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
-#if MIN_VERSION_GLASGOW_HASKELL(8,2,2,0)
-import UniqDFM (eltsUDFM)
-#else
-import UniqFM (eltsUFM)
-#endif
-import Unique (getKey)
-import Var (varName, varType,Id)
-import VarEnv (emptyTidyEnv)
+import GHC.Types.Unique.DFM (eltsUDFM)
+import GHC.Types.Unique (getKey)
+import GHC.Types.Var (varName, varType,Id)
+import GHC.Types.Var.Env (emptyTidyEnv)
type ModuleDependencies
= ( HM.HashMap HCE.HaskellFilePath HCE.HaskellModulePath
@@ -121,6 +129,7 @@ type ModuleDependencies
type ModuleGhcData
= ( DynFlags
+ , UnitState
, TypecheckedModule
, HomePackageTable
, ExternalPackageState
@@ -134,7 +143,7 @@ createModuleInfo ::
-> HCE.ComponentId -- ^ Current build component id
-> (T.Text, HCE.SourceCodePreprocessing) -- ^ Source code
-> (HCE.ModuleInfo, ModuleDependencies, [TypeError])
-createModuleInfo (fileMap, defSiteMap, moduleNameMap) (flags, typecheckedModule, homePackageTable, externalPackageState, modSum) modulePath currentPackageId compId (originalSourceCode, sourceCodePreprocessing) =
+createModuleInfo (fileMap, defSiteMap, moduleNameMap) (flags, unitState, typecheckedModule, homePackageTable, externalPackageState, modSum) modulePath currentPackageId compId (originalSourceCode, sourceCodePreprocessing) =
let globalRdrEnv = tcg_rdr_env . fst . tm_internals_ $ typecheckedModule
modInfo = moduleInfo typecheckedModule
(Just (hsGroup, _, _, _)) = renamedSource typecheckedModule
@@ -179,6 +188,7 @@ createModuleInfo (fileMap, defSiteMap, moduleNameMap) (flags, typecheckedModule,
(defSites, allNames) =
createDefinitionSiteMap
flags
+ unitState
currentPackageId
compId
defSiteMap
@@ -201,6 +211,7 @@ createModuleInfo (fileMap, defSiteMap, moduleNameMap) (flags, typecheckedModule,
environment =
Environment
{ envDynFlags = flags
+ , envUnitState = unitState
, envInstEnv = instEnv
, envTypeEnv = typeEnv
, envTransformation = transformation
@@ -308,6 +319,7 @@ prepareSourceCode sourceCodePreprocessing originalSourceCode modSum modulePath =
createDefinitionSiteMap ::
DynFlags
+ -> UnitState
-> HCE.PackageId
-> HCE.ComponentId
-> HM.HashMap HCE.HaskellModulePath HCE.DefinitionSiteMap
@@ -322,12 +334,10 @@ createDefinitionSiteMap ::
-> HsGroup Name
#endif
-> (HCE.DefinitionSiteMap, [Name])
-createDefinitionSiteMap flags currentPackageId compId defSiteMap fileMap globalRdrEnv transformation modInfo dataFamTyCons hsGroup =
+createDefinitionSiteMap flags unitState currentPackageId compId defSiteMap fileMap globalRdrEnv transformation modInfo dataFamTyCons hsGroup =
let
-#if MIN_VERSION_GLASGOW_HASKELL(8,4,3,0)
- allDecls :: [GenLocated SrcSpan (HsDecl GhcRn)]
-#endif
- allDecls = L.sortOn getLoc . ungroup $ hsGroup
+ allDecls :: [LHsDecl GhcRn]
+ allDecls = sortLocatedA . ungroup $ hsGroup
(instanceDeclsWithDocs, valueAndTypeDeclsWithDocs) =
L.partition
(\(L _ decl, _) ->
@@ -355,7 +365,7 @@ createDefinitionSiteMap flags currentPackageId compId defSiteMap fileMap globalR
nameLocation :: Maybe SrcSpan -> Name -> HCE.LocationInfo
nameLocation =
nameLocationInfo
- flags
+ unitState
currentPackageId
compId
transformation
@@ -377,7 +387,7 @@ createDefinitionSiteMap flags currentPackageId compId defSiteMap fileMap globalR
(\clsInst ->
( instanceToText flags clsInst
, let location =
- nameLocation Nothing (Var.varName . is_dfun $ clsInst)
+ nameLocation Nothing (varName . is_dfun $ clsInst)
in case M.lookup (getSrcSpan clsInst) instanceDocMap of
Just hsDocString ->
HCE.DefinitionSite
@@ -391,13 +401,15 @@ createDefinitionSiteMap flags currentPackageId compId defSiteMap fileMap globalR
--------------------------------------------------------------------------------
mainDeclNamesWithDocumentation =
concatMap
- (\(L span decl, docs) -> map (, docs, span) $ getMainDeclBinder decl)
+ (\dec@(L _ decl, docs) ->
+ map (, docs, getLocA dec) $ getMainDeclBinder decl)
valueAndTypeDeclsWithDocs
dataFamTyConsWithoutDocs =
map (\name -> (name, [], nameSrcSpan name)) dataFamTyCons
allNamesWithDocumentation =
mainDeclNamesWithDocumentation ++
- subordinateNamesWithDocs allDecls ++ dataFamTyConsWithoutDocs
+ subordinateNamesWithDocs allDecls ++
+ dataFamTyConsWithoutDocs
(valuesWithDocumentation, typesWithDocumentation) =
L.partition
(\(name, _doc, _srcSpan) ->
@@ -687,7 +699,7 @@ addIdentifierToMaps environment idSrcSpanMap idMaps@(idInfoMap, idOccMap) nameOc
Just (identifier, mbTypes) ->
let name =
fromMaybe
- (Var.varName identifier)
+ (varName identifier)
(unLoc $ locatedName nameOcc)
identifierType = varType identifier
identifierTypeExpanded = expandTypeSynonyms identifierType
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-26 05:31:48 +0000