diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/HaskellCodeExplorer/ModuleInfo.hs | 96 | 
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  | 
