aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2020-04-29 12:36:37 -0400
committerGitHub <noreply@github.com>2020-04-29 12:36:37 -0400
commit66faa532d4e3d93e87c5b042bef82d631dc74eb5 (patch)
tree971e9594725d0c6c798161aaee22054b9c696356 /haddock-api/src
parent7c34f89d801bafba3162bc091dd486cbb9e9fd5b (diff)
parenta61dbdb0a7420e15e978bce6c09de1ce99290f44 (diff)
Merge pull request #1183 from hsyl20/wip/hsyl20/unitid
Refactoring of Unit code
Diffstat (limited to 'haddock-api/src')
-rw-r--r--haddock-api/src/Haddock.hs13
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker.hs2
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs2
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Layout.hs2
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Types.hs2
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Utils.hs2
-rw-r--r--haddock-api/src/Haddock/GhcUtils.hs3
-rw-r--r--haddock-api/src/Haddock/Interface.hs2
-rw-r--r--haddock-api/src/Haddock/Interface/AttachInstances.hs2
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs16
-rw-r--r--haddock-api/src/Haddock/Interface/Json.hs2
-rw-r--r--haddock-api/src/Haddock/InterfaceFile.hs8
-rw-r--r--haddock-api/src/Haddock/ModuleTree.hs10
-rw-r--r--haddock-api/src/Haddock/Options.hs10
14 files changed, 37 insertions, 39 deletions
diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index 314458b2..85ccde3d 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -68,9 +68,8 @@ import GHC hiding (verbosity)
import Config
import GHC.Driver.Session hiding (projectVersion, verbosity)
import GHC.Utils.Error
-import GHC.Driver.Packages
+import GHC.Unit
import GHC.Utils.Panic (handleGhcException)
-import GHC.Types.Module
import GHC.Data.FastString
import qualified GHC.Runtime.Loader
@@ -294,8 +293,8 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do
allVisibleIfaces = [ i | i <- allIfaces, OptHide `notElem` instOptions i ]
pkgMod = fmap ifaceMod (listToMaybe ifaces)
- pkgKey = fmap moduleUnitId pkgMod
- pkgStr = fmap unitIdString pkgKey
+ pkgKey = fmap moduleUnit pkgMod
+ pkgStr = fmap unitString pkgKey
pkgNameVer = modulePackageInfo dflags flags pkgMod
pkgName = fmap (unpackFS . (\(PackageName n) -> n)) (fst pkgNameVer)
sincePkg = case sinceQual of
@@ -312,7 +311,7 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do
(Map.map SrcExternal extSrcMap)
(Map.fromList [ (ifaceMod iface, SrcLocal) | iface <- ifaces ])
- pkgSrcMap = Map.mapKeys moduleUnitId extSrcMap
+ pkgSrcMap = Map.mapKeys moduleUnit extSrcMap
pkgSrcMap'
| Flag_HyperlinkedSource `elem` flags
, Just k <- pkgKey
@@ -341,11 +340,11 @@ render dflags flags sinceQual qual ifaces installedIfaces extSrcMap = do
-- records the *wired in* identity base. So untranslate it
-- so that we can service the request.
unwire :: Module -> Module
- unwire m = m { moduleUnitId = unwireUnitId dflags (moduleUnitId m) }
+ unwire m = m { moduleUnit = unwireUnit dflags (moduleUnit m) }
reexportedIfaces <- concat `fmap` (for (reexportFlags flags) $ \mod_str -> do
let warn = hPutStrLn stderr . ("Warning: " ++)
- case readP_to_S parseModuleId mod_str of
+ case readP_to_S parseHoleyModule mod_str of
[(m, "")]
| Just iface <- Map.lookup m installedMap
-> return [iface]
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
index fb238995..7b66c566 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs
@@ -22,7 +22,7 @@ import GHC.Iface.Ext.Types ( HieFile(..), HieASTs(..) )
import GHC.Iface.Ext.Binary ( readHieFile, hie_file_result)
import Data.Map as M
import GHC.Data.FastString ( mkFastString )
-import GHC.Types.Module ( Module, moduleName )
+import GHC.Unit.Module ( Module, moduleName )
import GHC.Types.Name.Cache ( initNameCache )
import GHC.Types.Unique.Supply ( mkSplitUniqSupply )
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
index a6134cd2..e01d7114 100644
--- a/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
+++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Renderer.hs
@@ -13,7 +13,7 @@ import Haddock.Backends.Hyperlinker.Utils
import qualified Data.ByteString as BS
import GHC.Iface.Ext.Types
-import GHC.Types.Module ( ModuleName, moduleNameString )
+import GHC.Unit.Module ( ModuleName, moduleNameString )
import GHC.Types.Name ( getOccString, isInternalName, Name, nameModule, nameUnique )
import GHC.Types.SrcLoc
import GHC.Types.Unique ( getKey )
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index 21d544cd..dd8b0b18 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -306,7 +306,7 @@ links ((_,_,sourceMap,lineMap), (_,_,maybe_wiki_url)) loc splice mdl' docName@(D
-- 'mdl'' is a way of "overriding" the module. Without it, instances
-- will point to the module defining the class/family, which is wrong.
origMod = fromMaybe (nameModule n) mdl'
- origPkg = moduleUnitId origMod
+ origPkg = moduleUnit origMod
fname = case loc of
RealSrcSpan l _ -> unpackFS (srcSpanFile l)
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Types.hs b/haddock-api/src/Haddock/Backends/Xhtml/Types.hs
index d1561791..e3fd2d5a 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Types.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Types.hs
@@ -23,7 +23,7 @@ import GHC
-- the base, module and entity URLs for the source code and wiki links.
-type SourceURLs = (Maybe FilePath, Maybe FilePath, Map UnitId FilePath, Map UnitId FilePath)
+type SourceURLs = (Maybe FilePath, Maybe FilePath, Map Unit FilePath, Map Unit FilePath)
type WikiURLs = (Maybe FilePath, Maybe FilePath, Maybe FilePath)
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
index 56fb63fa..f5f64f51 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
@@ -39,7 +39,7 @@ import Text.XHtml hiding ( name, title, p, quote )
import qualified Text.XHtml as XHtml
import GHC ( SrcSpan(..), srcSpanStartLine, Name )
-import GHC.Types.Module ( Module, ModuleName, moduleName, moduleNameString )
+import GHC.Unit.Module ( Module, ModuleName, moduleName, moduleNameString )
import GHC.Types.Name ( getOccString, nameOccName, isValOcc )
diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs
index 8341faf5..f8f6f838 100644
--- a/haddock-api/src/Haddock/GhcUtils.hs
+++ b/haddock-api/src/Haddock/GhcUtils.hs
@@ -28,7 +28,7 @@ import GHC.Utils.FV as FV
import GHC.Utils.Outputable ( Outputable, panic, showPpr )
import GHC.Types.Name
import GHC.Types.Name.Set
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Driver.Types
import GHC
import GHC.Core.Class
@@ -41,7 +41,6 @@ import GHC.Types.Var.Env ( TyVarEnv, extendVarEnv, elemVarEnv, emptyVarEnv )
import GHC.Core.TyCo.Rep ( Type(..) )
import GHC.Core.Type ( isRuntimeRepVar )
import GHC.Builtin.Types( liftedRepDataConTyCon )
-import GHC.Hs.Utils (CollectPass(..))
import GHC.Data.StringBuffer ( StringBuffer )
import qualified GHC.Data.StringBuffer as S
diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs
index 80ce2b55..fa0f648f 100644
--- a/haddock-api/src/Haddock/Interface.hs
+++ b/haddock-api/src/Haddock/Interface.hs
@@ -50,7 +50,7 @@ import qualified Data.Set as Set
import Distribution.Verbosity
import Text.Printf
-import GHC.Types.Module (mkModuleSet, emptyModuleSet, unionModuleSet, ModuleSet)
+import GHC.Unit.Module.Env (mkModuleSet, emptyModuleSet, unionModuleSet, ModuleSet)
import GHC.Data.Graph.Directed
import GHC.Driver.Session hiding (verbosity)
import GHC hiding (verbosity)
diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs
index 7dba9d03..ec61fb37 100644
--- a/haddock-api/src/Haddock/Interface/AttachInstances.hs
+++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs
@@ -34,7 +34,7 @@ import GHC.Utils.Error
import GHC.Core.FamInstEnv
import GHC
import GHC.Core.InstEnv
-import GHC.Types.Module ( ModuleSet, moduleSetElts )
+import GHC.Unit.Module.Env ( ModuleSet, moduleSetElts )
import GHC.Utils.Monad (liftIO)
import GHC.Types.Name
import GHC.Types.Name.Env
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 7e05e669..786779c6 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -40,7 +40,7 @@ import Data.Traversable
import GHC.Types.Avail hiding (avail)
import qualified GHC.Types.Avail as Avail
-import qualified GHC.Types.Module as Module
+import qualified GHC.Unit.Module as Module
import qualified GHC.Types.SrcLoc as SrcLoc
import GHC.Core.ConLike (ConLike(..))
import GHC
@@ -48,7 +48,7 @@ import GHC.Driver.Types
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.Name.Env
-import GHC.Driver.Packages ( lookupModuleInAllPackages, PackageName(..) )
+import GHC.Unit.State ( lookupModuleInAllPackages, PackageName(..) )
import GHC.Data.Bag
import GHC.Types.Name.Reader
import GHC.Tc.Types
@@ -221,7 +221,7 @@ mkAliasMap dflags mRenamedSource =
-- them to the user. We should reuse that information;
-- or at least reuse the renamed imports, which know what
-- they import!
- (fmap Module.fsToUnitId $
+ (fmap Module.fsToUnit $
fmap sl_fs $ ideclPkgQual impDecl)
(case ideclName impDecl of SrcLoc.L _ name -> name),
alias))
@@ -265,7 +265,7 @@ unrestrictedModuleImports idecls =
-- Similar to GHC.lookupModule
-- ezyang: Not really...
lookupModuleDyn ::
- DynFlags -> Maybe UnitId -> ModuleName -> Module
+ DynFlags -> Maybe Unit -> ModuleName -> Module
lookupModuleDyn _ (Just pkgId) mdlName =
Module.mkModule pkgId mdlName
lookupModuleDyn dflags Nothing mdlName =
@@ -839,7 +839,7 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames
Just decl -> return ([decl], (noDocForDecl, availNoDocs avail))
| otherwise ->
return ([], (noDocForDecl, availNoDocs avail))
- | Just iface <- M.lookup (semToIdMod (moduleUnitId thisMod) m) modMap
+ | Just iface <- M.lookup (semToIdMod (moduleUnit thisMod) m) modMap
, Just ds <- M.lookup n (ifaceDeclMap iface) =
return (ds, lookupDocs avail warnings
(ifaceDocMap iface)
@@ -885,10 +885,10 @@ availNoDocs avail =
-- | Given a 'Module' from a 'Name', convert it into a 'Module' that
-- we can actually find in the 'IfaceMap'.
-semToIdMod :: UnitId -> Module -> Module
+semToIdMod :: Unit -> Module -> Module
semToIdMod this_uid m
| Module.isHoleModule m = mkModule this_uid (moduleName m)
- | otherwise = m
+ | otherwise = m
hiDecl :: DynFlags -> Name -> ErrMsgGhc (Maybe (LHsDecl GhcRn))
hiDecl dflags t = do
@@ -967,7 +967,7 @@ moduleExport thisMod dflags ifaceMap instIfaceMap expMod =
return []
where
m = mkModule unitId expMod -- Identity module!
- unitId = moduleUnitId thisMod
+ unitId = moduleUnit thisMod
-- Note [1]:
------------
diff --git a/haddock-api/src/Haddock/Interface/Json.hs b/haddock-api/src/Haddock/Interface/Json.hs
index 701c68bf..043a1530 100644
--- a/haddock-api/src/Haddock/Interface/Json.hs
+++ b/haddock-api/src/Haddock/Interface/Json.hs
@@ -7,7 +7,7 @@ module Haddock.Interface.Json (
import GHC.Types.Basic
import GHC.Utils.Json
-import GHC.Types.Module
+import GHC.Unit.Module
import GHC.Types.Name
import GHC.Utils.Outputable
diff --git a/haddock-api/src/Haddock/InterfaceFile.hs b/haddock-api/src/Haddock/InterfaceFile.hs
index 4be0bdde..c26ab762 100644
--- a/haddock-api/src/Haddock/InterfaceFile.hs
+++ b/haddock-api/src/Haddock/InterfaceFile.hs
@@ -58,11 +58,11 @@ ifModule if_ =
[] -> error "empty InterfaceFile"
iface:_ -> instMod iface
-ifUnitId :: InterfaceFile -> UnitId
+ifUnitId :: InterfaceFile -> Unit
ifUnitId if_ =
case ifInstalledIfaces if_ of
[] -> error "empty InterfaceFile"
- iface:_ -> moduleUnitId $ instMod iface
+ iface:_ -> moduleUnit $ instMod iface
binaryInterfaceMagic :: Word32
@@ -319,7 +319,7 @@ getSymbolTable bh namecache = do
return (namecache', arr)
-type OnDiskName = (UnitId, ModuleName, OccName)
+type OnDiskName = (Unit, ModuleName, OccName)
fromOnDiskName
@@ -349,7 +349,7 @@ fromOnDiskName _ nc (pid, mod_name, occ) =
serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO ()
serialiseName bh name _ = do
let modu = nameModule name
- put_ bh (moduleUnitId modu, moduleName modu, nameOccName name)
+ put_ bh (moduleUnit modu, moduleName modu, nameOccName name)
-------------------------------------------------------------------------------
diff --git a/haddock-api/src/Haddock/ModuleTree.hs b/haddock-api/src/Haddock/ModuleTree.hs
index 598e3f9a..688e3e71 100644
--- a/haddock-api/src/Haddock/ModuleTree.hs
+++ b/haddock-api/src/Haddock/ModuleTree.hs
@@ -15,9 +15,9 @@ module Haddock.ModuleTree ( ModuleTree(..), mkModuleTree ) where
import Haddock.Types ( MDoc )
import GHC ( Name )
-import GHC.Types.Module ( Module, moduleNameString, moduleName, moduleUnitId, unitIdString )
+import GHC.Unit.Module ( Module, moduleNameString, moduleName, moduleUnit, unitString )
import GHC.Driver.Session ( DynFlags )
-import GHC.Driver.Packages ( lookupUnit, sourcePackageIdString )
+import GHC.Unit.State ( lookupUnit, unitPackageIdString )
import qualified Control.Applicative as A
@@ -29,10 +29,10 @@ mkModuleTree :: DynFlags -> Bool -> [(Module, Maybe (MDoc Name))] -> [ModuleTree
mkModuleTree dflags showPkgs mods =
foldr fn [] [ (mdl, splitModule mdl, modPkg mdl, modSrcPkg mdl, short) | (mdl, short) <- mods ]
where
- modPkg mod_ | showPkgs = Just (unitIdString (moduleUnitId mod_))
+ modPkg mod_ | showPkgs = Just (unitString (moduleUnit mod_))
| otherwise = Nothing
- modSrcPkg mod_ | showPkgs = fmap sourcePackageIdString
- (lookupUnit dflags (moduleUnitId mod_))
+ modSrcPkg mod_ | showPkgs = fmap unitPackageIdString
+ (lookupUnit dflags (moduleUnit mod_))
| otherwise = Nothing
fn (m,mod_,pkg,srcPkg,short) = addToTrees mod_ m pkg srcPkg short
diff --git a/haddock-api/src/Haddock/Options.hs b/haddock-api/src/Haddock/Options.hs
index cccca201..011a361d 100644
--- a/haddock-api/src/Haddock/Options.hs
+++ b/haddock-api/src/Haddock/Options.hs
@@ -45,10 +45,10 @@ import Data.Version
import Control.Applicative
import Distribution.Verbosity
import GHC.Data.FastString
-import GHC ( DynFlags, Module, moduleUnitId )
+import GHC ( DynFlags, Module, moduleUnit )
import Haddock.Types
import Haddock.Utils
-import GHC.Driver.Packages
+import GHC.Unit.State
import System.Console.GetOpt
import qualified Text.ParserCombinators.ReadP as RP
@@ -378,8 +378,8 @@ modulePackageInfo :: DynFlags
-> (Maybe PackageName, Maybe Data.Version.Version)
modulePackageInfo _dflags _flags Nothing = (Nothing, Nothing)
modulePackageInfo dflags flags (Just modu) =
- ( optPackageName flags <|> fmap packageName pkgDb
- , optPackageVersion flags <|> fmap packageVersion pkgDb
+ ( optPackageName flags <|> fmap unitPackageName pkgDb
+ , optPackageVersion flags <|> fmap unitPackageVersion pkgDb
)
where
- pkgDb = lookupUnit dflags (moduleUnitId modu)
+ pkgDb = lookupUnit dflags (moduleUnit modu)