Commit 9e2c8e0e authored by Sylvain Henry's avatar Sylvain Henry Committed by Marge Bot

Refactor UnitInfo load/store from databases

Converting between UnitInfo stored in package databases and UnitInfo as
they are used in ghc-pkg and ghc was done in a very convoluted way (via
BinaryStringRep and DbUnitModuleRep type classes using fun deps, etc.).
It was difficult to understand and even more to modify (I wanted to
try to use a GADT for UnitId but fun deps got in the way).

The new code uses much more straightforward functions to convert between
the different representations. Much simpler.
parent 69562e34
......@@ -592,7 +592,7 @@ readPackageDatabase dflags conf_file = do
conf_file' = dropTrailingPathSeparator conf_file
top_dir = topDir dflags
pkgroot = takeDirectory conf_file'
pkg_configs1 = map (mungeUnitInfo top_dir pkgroot)
pkg_configs1 = map (mungeUnitInfo top_dir pkgroot . toUnitInfo)
proto_pkg_configs
--
return $ PackageDatabase conf_file' pkg_configs1
......
......@@ -150,7 +150,6 @@ import GHC.Utils.Misc
import Data.List (sortBy, sort)
import Data.Ord
import Data.Version
import GHC.PackageDb
import GHC.Utils.Fingerprint
import qualified Data.ByteString as BS
......@@ -344,10 +343,6 @@ instance Binary ModuleName where
put_ bh (ModuleName fs) = put_ bh fs
get bh = do fs <- get bh; return (ModuleName fs)
instance BinaryStringRep ModuleName where
fromStringRep = mkModuleNameFS . mkFastStringByteString
toStringRep = bytesFS . moduleNameFS
instance Data ModuleName where
-- don't traverse?
toConstr _ = abstractConstr "ModuleName"
......@@ -492,15 +487,6 @@ class ContainsModule t where
class HasModule m where
getModule :: m Module
instance DbUnitIdModuleRep InstalledUnitId ComponentId UnitId ModuleName Module where
fromDbModule (DbModule uid mod_name) = mkModule uid mod_name
fromDbModule (DbModuleVar mod_name) = mkHoleModule mod_name
fromDbUnitId (DbUnitId cid insts) = newUnitId cid insts
fromDbUnitId (DbInstalledUnitId iuid) = DefiniteUnitId (DefUnitId iuid)
-- GHC never writes to the database, so it's not needed
toDbModule = error "toDbModule: not implemented"
toDbUnitId = error "toDbUnitId: not implemented"
{-
************************************************************************
* *
......@@ -535,10 +521,6 @@ data ComponentDetails = ComponentDetails
, componentSourcePkdId :: String
}
instance BinaryStringRep ComponentId where
fromStringRep bs = ComponentId (mkFastStringByteString bs) Nothing
toStringRep (ComponentId s _) = bytesFS s
instance Uniquable ComponentId where
getUnique (ComponentId n _) = getUnique n
......@@ -700,11 +682,6 @@ instance Binary InstalledUnitId where
put_ bh (InstalledUnitId fs) = put_ bh fs
get bh = do fs <- get bh; return (InstalledUnitId fs)
instance BinaryStringRep InstalledUnitId where
fromStringRep bs = InstalledUnitId (mkFastStringByteString bs)
-- GHC doesn't write to database
toStringRep = error "BinaryStringRep InstalledUnitId: not implemented"
instance Eq InstalledUnitId where
uid1 == uid2 = installedUnitIdKey uid1 == installedUnitIdKey uid2
......@@ -858,7 +835,7 @@ unitIdIsDefinite = isEmptyUniqDSet . unitIdFreeHoles
hashUnitId :: ComponentId -> [(ModuleName, Module)] -> FastString
hashUnitId cid sorted_holes =
mkFastStringByteString
. fingerprintUnitId (toStringRep cid)
. fingerprintUnitId (bytesFS (componentIdRaw cid))
$ rawHashUnitId sorted_holes
-- | Generate a hash for a sorted module substitution.
......@@ -867,9 +844,9 @@ rawHashUnitId sorted_holes =
fingerprintByteString
. BS.concat $ do
(m, b) <- sorted_holes
[ toStringRep m, BS.Char8.singleton ' ',
[ bytesFS (moduleNameFS m), BS.Char8.singleton ' ',
bytesFS (unitIdFS (moduleUnitId b)), BS.Char8.singleton ':',
toStringRep (moduleName b), BS.Char8.singleton '\n']
bytesFS (moduleNameFS (moduleName b)), BS.Char8.singleton '\n']
fingerprintUnitId :: BS.ByteString -> Fingerprint -> BS.ByteString
fingerprintUnitId prefix (Fingerprint a b)
......
......@@ -17,6 +17,7 @@ module GHC.Unit.Info (
-- * The UnitInfo type: information about a unit
UnitInfo,
toUnitInfo,
GenericUnitInfo(..),
ComponentId(..),
PackageId(..),
......@@ -33,6 +34,7 @@ import GHC.Prelude
import GHC.PackageDb
import Data.Version
import Data.Bifunctor
import GHC.Data.FastString
import GHC.Utils.Outputable
......@@ -48,10 +50,32 @@ type UnitInfo = GenericUnitInfo
PackageId
PackageName
Module.InstalledUnitId
Module.UnitId
Module.ModuleName
Module.Module
-- | Convert a DbUnitInfo (read from a package database) into `UnitInfo`
toUnitInfo :: DbUnitInfo -> UnitInfo
toUnitInfo = mapGenericUnitInfo
mkUnitId'
mkComponentId'
mkPackageIdentifier'
mkPackageName'
mkModuleName'
mkModule'
where
mkPackageIdentifier' = PackageId . mkFastStringByteString
mkPackageName' = PackageName . mkFastStringByteString
mkUnitId' = InstalledUnitId . mkFastStringByteString
mkModuleName' = mkModuleNameFS . mkFastStringByteString
mkComponentId' cid = ComponentId (mkFastStringByteString cid) Nothing
mkInstUnitId' i = case i of
DbInstUnitId cid insts -> newUnitId (mkComponentId' cid) (fmap (bimap mkModuleName' mkModule') insts)
DbUnitId uid -> DefiniteUnitId (DefUnitId (mkUnitId' uid))
mkModule' m = case m of
DbModule uid n -> mkModule (mkInstUnitId' uid) (mkModuleName' n)
DbModuleVar n -> mkHoleModule (mkModuleName' n)
-- TODO: there's no need for these to be FastString, as we don't need the uniq
-- feature, but ghc doesn't currently have convenient support for any
-- other compact string types, e.g. plain ByteString or Text.
......@@ -62,14 +86,6 @@ newtype PackageName = PackageName
}
deriving (Eq, Ord)
instance BinaryStringRep PackageId where
fromStringRep = PackageId . mkFastStringByteString
toStringRep (PackageId s) = bytesFS s
instance BinaryStringRep PackageName where
fromStringRep = PackageName . mkFastStringByteString
toStringRep (PackageName s) = bytesFS s
instance Uniquable PackageId where
getUnique (PackageId n) = getUnique n
......
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE RecordWildCards #-}
-----------------------------------------------------------------------------
-- |
-- Module : GHC.PackageDb
......@@ -48,6 +49,10 @@
--
module GHC.PackageDb
( GenericUnitInfo(..)
, type DbUnitInfo
, DbModule (..)
, DbInstUnitId (..)
, mapGenericUnitInfo
-- * Read and write
, DbMode(..)
, DbOpenMode(..)
......@@ -59,11 +64,6 @@ module GHC.PackageDb
, PackageDbLock
, lockPackageDb
, unlockPackageDb
-- * Misc
, DbModule(..)
, DbUnitId(..)
, BinaryStringRep(..)
, DbUnitIdModuleRep(..)
)
where
......@@ -75,6 +75,7 @@ import qualified Data.ByteString.Lazy as BS.Lazy
import qualified Data.ByteString.Lazy.Internal as BS.Lazy (defaultChunkSize)
import qualified Data.Foldable as F
import qualified Data.Traversable as F
import Data.Bifunctor
import Data.Binary as Bin
import Data.Binary.Put as Bin
import Data.Binary.Get as Bin
......@@ -87,6 +88,8 @@ import GHC.IO.Exception (IOErrorType(InappropriateType))
import GHC.IO.Handle.Lock
import System.Directory
-- | @ghc-boot@'s UnitInfo, serialized to the database.
type DbUnitInfo = GenericUnitInfo BS.ByteString BS.ByteString BS.ByteString BS.ByteString BS.ByteString DbModule
-- | Information about an unit (a unit is an installed module library).
--
......@@ -96,8 +99,8 @@ import System.Directory
-- Some types are left as parameters to be instantiated differently in ghc-pkg
-- and in ghc itself.
--
data GenericUnitInfo compid srcpkgid srcpkgname instunitid unitid modulename mod = GenericUnitInfo
{ unitId :: instunitid
data GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod = GenericUnitInfo
{ unitId :: uid
-- ^ Unique unit identifier that is used during compilation (e.g. to
-- generate symbols).
......@@ -138,10 +141,10 @@ data GenericUnitInfo compid srcpkgid srcpkgname instunitid unitid modulename mod
-- ^ ABI hash used to avoid mixing up units compiled with different
-- dependencies, compiler, options, etc.
, unitDepends :: [instunitid]
, unitDepends :: [uid]
-- ^ Identifiers of the units this one depends on
, unitAbiDepends :: [(instunitid, String)]
, unitAbiDepends :: [(uid, String)]
-- ^ Like 'unitDepends', but each dependency is annotated with the ABI hash
-- we expect the dependency to respect.
......@@ -234,52 +237,52 @@ data GenericUnitInfo compid srcpkgid srcpkgname instunitid unitid modulename mod
}
deriving (Eq, Show)
-- | A convenience constraint synonym for common constraints over parameters
-- to 'GenericUnitInfo'.
type RepGenericUnitInfo compid srcpkgid srcpkgname instunitid unitid modulename mod =
(BinaryStringRep srcpkgid, BinaryStringRep srcpkgname,
BinaryStringRep modulename, BinaryStringRep compid,
BinaryStringRep instunitid,
DbUnitIdModuleRep instunitid compid unitid modulename mod)
-- | A type-class for the types which can be converted into 'DbModule'/'DbUnitId'.
-- There is only one type class because these types are mutually recursive.
-- NB: The functional dependency helps out type inference in cases
-- where types would be ambiguous.
class DbUnitIdModuleRep instunitid compid unitid modulename mod
| mod -> unitid, unitid -> mod, mod -> modulename, unitid -> compid, unitid -> instunitid
where
fromDbModule :: DbModule instunitid compid unitid modulename mod -> mod
toDbModule :: mod -> DbModule instunitid compid unitid modulename mod
fromDbUnitId :: DbUnitId instunitid compid unitid modulename mod -> unitid
toDbUnitId :: unitid -> DbUnitId instunitid compid unitid modulename mod
-- | @ghc-boot@'s copy of 'Module', i.e. what is serialized to the database.
-- Use 'DbUnitIdModuleRep' to convert it into an actual 'Module'.
-- It has phantom type parameters as this is the most convenient way
-- to avoid undecidable instances.
data DbModule instunitid compid unitid modulename mod
= DbModule {
dbModuleUnitId :: unitid,
dbModuleName :: modulename
-- | Convert between GenericUnitInfo instances
mapGenericUnitInfo
:: (uid1 -> uid2)
-> (cid1 -> cid2)
-> (srcpkg1 -> srcpkg2)
-> (srcpkgname1 -> srcpkgname2)
-> (modname1 -> modname2)
-> (mod1 -> mod2)
-> (GenericUnitInfo cid1 srcpkg1 srcpkgname1 uid1 modname1 mod1
-> GenericUnitInfo cid2 srcpkg2 srcpkgname2 uid2 modname2 mod2)
mapGenericUnitInfo fuid fcid fsrcpkg fsrcpkgname fmodname fmod g@(GenericUnitInfo {..}) =
g { unitId = fuid unitId
, unitInstanceOf = fcid unitInstanceOf
, unitInstantiations = fmap (bimap fmodname fmod) unitInstantiations
, unitPackageId = fsrcpkg unitPackageId
, unitPackageName = fsrcpkgname unitPackageName
, unitComponentName = fmap fsrcpkgname unitComponentName
, unitDepends = fmap fuid unitDepends
, unitAbiDepends = fmap (first fuid) unitAbiDepends
, unitExposedModules = fmap (bimap fmodname (fmap fmod)) unitExposedModules
, unitHiddenModules = fmap fmodname unitHiddenModules
}
| DbModuleVar {
dbModuleVarName :: modulename
}
deriving (Eq, Show)
-- | @ghc-boot@'s copy of 'UnitId', i.e. what is serialized to the database.
-- Use 'DbUnitIdModuleRep' to convert it into an actual 'UnitId'.
-- It has phantom type parameters as this is the most convenient way
-- to avoid undecidable instances.
data DbUnitId instunitid compid unitid modulename mod
= DbUnitId compid [(modulename, mod)]
| DbInstalledUnitId instunitid
deriving (Eq, Show)
-- | @ghc-boot@'s 'Module', serialized to the database.
data DbModule
= DbModule
{ dbModuleUnitId :: DbInstUnitId
, dbModuleName :: BS.ByteString
}
| DbModuleVar
{ dbModuleVarName :: BS.ByteString
}
deriving (Eq, Show)
-- | @ghc-boot@'s instantiated unit id, serialized to the database.
data DbInstUnitId
-- | Instantiated unit
= DbInstUnitId
BS.ByteString -- component id
[(BS.ByteString, DbModule)] -- instantiations: [(modulename,module)]
class BinaryStringRep a where
fromStringRep :: BS.ByteString -> a
toStringRep :: a -> BS.ByteString
-- | Uninstantiated unit
| DbUnitId
BS.ByteString -- unit id
deriving (Eq, Show)
-- | Represents a lock of a package db.
newtype PackageDbLock = PackageDbLock Handle
......@@ -358,8 +361,7 @@ isDbOpenReadMode = \case
-- | Read the part of the package DB that GHC is interested in.
--
readPackageDbForGhc :: RepGenericUnitInfo a b c d e f g =>
FilePath -> IO [GenericUnitInfo a b c d e f g]
readPackageDbForGhc :: FilePath -> IO [DbUnitInfo]
readPackageDbForGhc file =
decodeFromFile file DbOpenReadOnly getDbForGhc >>= \case
(pkgs, DbOpenReadOnly) -> return pkgs
......@@ -397,9 +399,7 @@ readPackageDbForGhcPkg file mode =
-- | Write the whole of the package DB, both parts.
--
writePackageDb :: (Binary pkgs, RepGenericUnitInfo a b c d e f g) =>
FilePath -> [GenericUnitInfo a b c d e f g] ->
pkgs -> IO ()
writePackageDb :: Binary pkgs => FilePath -> [DbUnitInfo] -> pkgs -> IO ()
writePackageDb file ghcPkgs ghcPkgPart =
writeFileAtomic file (runPut putDbForGhcPkg)
where
......@@ -504,8 +504,7 @@ writeFileAtomic targetPath content = do
hClose handle
renameFile tmpPath targetPath)
instance (RepGenericUnitInfo a b c d e f g) =>
Binary (GenericUnitInfo a b c d e f g) where
instance Binary DbUnitInfo where
put (GenericUnitInfo
unitId unitInstanceOf unitInstantiations
unitPackageId
......@@ -520,17 +519,16 @@ instance (RepGenericUnitInfo a b c d e f g) =>
unitHaddockInterfaces unitHaddockHTMLs
unitExposedModules unitHiddenModules
unitIsIndefinite unitIsExposed unitIsTrusted) = do
put (toStringRep unitPackageId)
put (toStringRep unitPackageName)
put unitPackageId
put unitPackageName
put unitPackageVersion
put (fmap toStringRep unitComponentName)
put (toStringRep unitId)
put (toStringRep unitInstanceOf)
put (map (\(mod_name, mod) -> (toStringRep mod_name, toDbModule mod))
unitInstantiations)
put unitComponentName
put unitId
put unitInstanceOf
put unitInstantiations
put unitAbiHash
put (map toStringRep unitDepends)
put (map (\(k,v) -> (toStringRep k, v)) unitAbiDepends)
put unitDepends
put unitAbiDepends
put unitImportDirs
put unitLibraries
put unitExtDepLibsSys
......@@ -545,9 +543,8 @@ instance (RepGenericUnitInfo a b c d e f g) =>
put unitIncludeDirs
put unitHaddockInterfaces
put unitHaddockHTMLs
put (map (\(mod_name, mb_mod) -> (toStringRep mod_name, fmap toDbModule mb_mod))
unitExposedModules)
put (map toStringRep unitHiddenModules)
put unitExposedModules
put unitHiddenModules
put unitIsIndefinite
put unitIsExposed
put unitIsTrusted
......@@ -583,16 +580,16 @@ instance (RepGenericUnitInfo a b c d e f g) =>
unitIsExposed <- get
unitIsTrusted <- get
return (GenericUnitInfo
(fromStringRep unitId)
(fromStringRep unitInstanceOf)
(map (\(mod_name, mod) -> (fromStringRep mod_name, fromDbModule mod))
unitInstantiations)
(fromStringRep unitPackageId)
(fromStringRep unitPackageName) unitPackageVersion
(fmap fromStringRep unitComponentName)
unitId
unitInstanceOf
unitInstantiations
unitPackageId
unitPackageName
unitPackageVersion
unitComponentName
unitAbiHash
(map fromStringRep unitDepends)
(map (\(k,v) -> (fromStringRep k, v)) unitAbiDepends)
unitDepends
unitAbiDepends
unitImportDirs
unitLibraries unitExtDepLibsSys unitExtDepLibsGhc
libraryDirs libraryDynDirs
......@@ -600,55 +597,35 @@ instance (RepGenericUnitInfo a b c d e f g) =>
unitLinkerOptions unitCcOptions
unitIncludes unitIncludeDirs
unitHaddockInterfaces unitHaddockHTMLs
(map (\(mod_name, mb_mod) ->
(fromStringRep mod_name, fmap fromDbModule mb_mod))
unitExposedModules)
(map fromStringRep unitHiddenModules)
unitExposedModules
unitHiddenModules
unitIsIndefinite unitIsExposed unitIsTrusted)
instance (BinaryStringRep modulename, BinaryStringRep compid,
BinaryStringRep instunitid,
DbUnitIdModuleRep instunitid compid unitid modulename mod) =>
Binary (DbModule instunitid compid unitid modulename mod) where
instance Binary DbModule where
put (DbModule dbModuleUnitId dbModuleName) = do
putWord8 0
put (toDbUnitId dbModuleUnitId)
put (toStringRep dbModuleName)
put dbModuleUnitId
put dbModuleName
put (DbModuleVar dbModuleVarName) = do
putWord8 1
put (toStringRep dbModuleVarName)
put dbModuleVarName
get = do
b <- getWord8
case b of
0 -> do dbModuleUnitId <- get
dbModuleName <- get
return (DbModule (fromDbUnitId dbModuleUnitId)
(fromStringRep dbModuleName))
_ -> do dbModuleVarName <- get
return (DbModuleVar (fromStringRep dbModuleVarName))
instance (BinaryStringRep modulename, BinaryStringRep compid,
BinaryStringRep instunitid,
DbUnitIdModuleRep instunitid compid unitid modulename mod) =>
Binary (DbUnitId instunitid compid unitid modulename mod) where
put (DbInstalledUnitId instunitid) = do
0 -> DbModule <$> get <*> get
_ -> DbModuleVar <$> get
instance Binary DbInstUnitId where
put (DbUnitId uid) = do
putWord8 0
put (toStringRep instunitid)
put (DbUnitId dbUnitIdComponentId dbUnitIdInsts) = do
put uid
put (DbInstUnitId dbUnitIdComponentId dbUnitIdInsts) = do
putWord8 1
put (toStringRep dbUnitIdComponentId)
put (map (\(mod_name, mod) -> (toStringRep mod_name, toDbModule mod)) dbUnitIdInsts)
put dbUnitIdComponentId
put dbUnitIdInsts
get = do
b <- getWord8
case b of
0 -> do
instunitid <- get
return (DbInstalledUnitId (fromStringRep instunitid))
_ -> do
dbUnitIdComponentId <- get
dbUnitIdInsts <- get
return (DbUnitId
(fromStringRep dbUnitIdComponentId)
(map (\(mod_name, mod) -> ( fromStringRep mod_name
, fromDbModule mod))
dbUnitIdInsts))
0 -> DbUnitId <$> get
_ -> DbInstUnitId <$> get <*> get
......@@ -31,7 +31,7 @@
module Main (main) where
import qualified GHC.PackageDb as GhcPkg
import GHC.PackageDb (BinaryStringRep(..))
import GHC.PackageDb
import GHC.HandleEncoding
import GHC.BaseDir (getBaseDir)
import GHC.Settings.Platform (getTargetPlatform)
......@@ -50,11 +50,12 @@ import Distribution.Package hiding (installedUnitId)
import Distribution.Text
import Distribution.Version
import Distribution.Backpack
import Distribution.Pretty (Pretty (..))
import Distribution.Types.UnqualComponentName
import Distribution.Types.LibraryName
import Distribution.Types.MungedPackageName
import Distribution.Types.MungedPackageId
import Distribution.Simple.Utils (fromUTF8BS, toUTF8BS, writeUTF8File, readUTF8File)
import Distribution.Simple.Utils (toUTF8BS, writeUTF8File, readUTF8File)
import qualified Data.Version as Version
import System.FilePath as FilePath
import qualified System.FilePath.Posix as FilePath.Posix
......@@ -67,6 +68,7 @@ import Prelude
import System.Console.GetOpt
import qualified Control.Exception as Exception
import Data.Maybe
import Data.Bifunctor
import Data.Char ( toLower )
import Control.Monad
......@@ -1297,7 +1299,8 @@ updateDBCache verbosity db db_stack = do
when (verbosity > Normal) $
infoLn ("writing cache " ++ filename)
GhcPkg.writePackageDb filename (map fst pkgsGhcCacheFormat) pkgsCabalFormat
let d = fmap (fromPackageCacheFormat . fst) pkgsGhcCacheFormat
GhcPkg.writePackageDb filename d pkgsCabalFormat
`catchIO` \e ->
if isPermissionError e
then die $ filename ++ ": you don't have permission to modify this file"
......@@ -1311,7 +1314,6 @@ type PackageCacheFormat = GhcPkg.GenericUnitInfo
PackageIdentifier
PackageName
UnitId
OpenUnitId
ModuleName
OpenModule
......@@ -1363,6 +1365,28 @@ recomputeValidAbiDeps db pkg =
abiDepsUpdated =
GhcPkg.unitAbiDepends pkg /= newAbiDeps
-- | Convert from PackageCacheFormat to DbUnitInfo (the format used in
-- Ghc.PackageDb to store into the database)
fromPackageCacheFormat :: PackageCacheFormat -> GhcPkg.DbUnitInfo
fromPackageCacheFormat = GhcPkg.mapGenericUnitInfo
mkUnitId' mkComponentId' mkPackageIdentifier' mkPackageName' mkModuleName' mkModule'
where
displayBS :: Pretty a => a -> BS.ByteString
displayBS = toUTF8BS . display
mkPackageIdentifier' = displayBS
mkPackageName' = displayBS
mkComponentId' = displayBS
mkUnitId' = displayBS
mkModuleName' = displayBS
mkInstUnitId' i = case i of
IndefFullUnitId cid insts -> DbInstUnitId (mkComponentId' cid)
(fmap (bimap mkModuleName' mkModule') (Map.toList insts))
DefiniteUnitId uid -> DbUnitId (mkUnitId' (unDefUnitId uid))
mkModule' m = case m of
OpenModule uid n -> DbModule (mkInstUnitId' uid) (mkModuleName' n)
OpenModuleVar n -> DbModuleVar (mkModuleName' n)
convertPackageInfoToCacheFormat :: InstalledPackageInfo -> PackageCacheFormat
convertPackageInfoToCacheFormat pkg =
GhcPkg.GenericUnitInfo {
......@@ -1400,43 +1424,6 @@ convertPackageInfoToCacheFormat pkg =
where
convertExposed (ExposedModule n reexport) = (n, reexport)
instance GhcPkg.BinaryStringRep ComponentId where
fromStringRep = mkComponentId . fromStringRep
toStringRep = toStringRep . display
instance GhcPkg.BinaryStringRep PackageName where
fromStringRep = mkPackageName . fromStringRep
toStringRep = toStringRep . display
instance GhcPkg.BinaryStringRep PackageIdentifier where
fromStringRep = fromMaybe (error "BinaryStringRep PackageIdentifier")
. simpleParse . fromStringRep
toStringRep = toStringRep . display
instance GhcPkg.BinaryStringRep ModuleName where
fromStringRep = ModuleName.fromString . fromStringRep
toStringRep = toStringRep . display
instance GhcPkg.BinaryStringRep String where
fromStringRep = fromUTF8BS
toStringRep = toUTF8BS
instance GhcPkg.BinaryStringRep UnitId where
fromStringRep = mkUnitId . fromStringRep
toStringRep = toStringRep . display
instance GhcPkg.DbUnitIdModuleRep UnitId ComponentId OpenUnitId ModuleName OpenModule where
fromDbModule (GhcPkg.DbModule uid mod_name) = OpenModule uid mod_name
fromDbModule (GhcPkg.DbModuleVar mod_name) = OpenModuleVar mod_name
toDbModule (OpenModule uid mod_name) = GhcPkg.DbModule uid mod_name
toDbModule (OpenModuleVar mod_name) = GhcPkg.DbModuleVar mod_name
fromDbUnitId (GhcPkg.DbUnitId cid insts) = IndefFullUnitId cid (Map.fromList insts)
fromDbUnitId (GhcPkg.DbInstalledUnitId uid)
= DefiniteUnitId (unsafeMkDefUnitId uid)
toDbUnitId (IndefFullUnitId cid insts) = GhcPkg.DbUnitId cid (Map.toList insts)
toDbUnitId (DefiniteUnitId def_uid)
= GhcPkg.DbInstalledUnitId (unDefUnitId def_uid)
-- -----------------------------------------------------------------------------
-- Exposing, Hiding, Trusting, Distrusting, Unregistering are all similar
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment