    {-# OPTIONS_GHC -fno-warn-name-shadowing #-}

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE DeriveTraversable #-}
    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE KindSignatures #-}
    {-# LANGUAGE StandaloneDeriving #-}
    {-# LANGUAGE TupleSections #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE TypeSynonymInstances #-}
    {-# LANGUAGE ExplicitNamespaces #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE OverloadedStrings #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  GHC.Unit.Database
    -- Copyright   :  (c) The University of Glasgow 2009, Duncan Coutts 2014
    --
    -- Maintainer  :  ghc-devs@haskell.org
    -- Portability :  portable
    --
    -- This module provides the view of GHC's database of registered packages that
    -- is shared between GHC the compiler\/library, and the ghc-pkg program. It
    -- defines the database format that is shared between GHC and ghc-pkg.
    --
    -- The database format, and this library are constructed so that GHC does not
    -- have to depend on the Cabal library. The ghc-pkg program acts as the
    -- gateway between the external package format (which is defined by Cabal) and
    -- the internal package format which is specialised just for GHC.
    --
    -- GHC the compiler only needs some of the information which is kept about
    -- registered packages, such as module names, various paths etc. On the other
    -- hand ghc-pkg has to keep all the information from Cabal packages and be able
    -- to regurgitate it for users and other tools.
    --
    -- The first trick is that we duplicate some of the information in the package
    -- database. We essentially keep two versions of the database in one file, one
    -- version used only by ghc-pkg which keeps the full information (using the
    -- serialised form of the 'InstalledPackageInfo' type defined by the Cabal
    -- library); and a second version written by ghc-pkg and read by GHC which has
    -- just the subset of information that GHC needs.
    --
    -- The second trick is that this module only defines in detail the format of
    -- the second version -- the bit GHC uses -- and the part managed by ghc-pkg
    -- is kept in the file but here we treat it as an opaque blob of data. That way
    -- this library avoids depending on Cabal.
    --
    module GHC.Unit.Database
       ( GenericUnitInfo(..)
       , type DbUnitInfo
       , DbModule (..)
       , DbInstUnitId (..)
       , mapGenericUnitInfo
       -- * Read and write
       , DbMode(..)
       , DbOpenMode(..)
       , isDbOpenReadMode
       , readPackageDbForGhc
       , readPackageDbForGhcPkg
       , writePackageDb
       -- * Locking
       , PackageDbLock
       , lockPackageDb
       , unlockPackageDb
       -- * Misc
       , mkMungePathUrl
       , mungeUnitInfoPaths
       )
    where

    import Prelude -- See note [Why do we import Prelude here?]
    import Data.Version (Version(..))
    import qualified Data.ByteString as BS
    import qualified Data.ByteString.Char8 as BS.Char8
    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
    import Data.List (intersperse)
    import Control.Exception as Exception
    import Control.Monad (when)
    import System.FilePath as FilePath
    #if !defined(mingw32_HOST_OS)
    import Data.Bits ((.|.))
    import System.Posix.Files
    import System.Posix.Types (FileMode)
    #endif
    import System.IO
    import System.IO.Error
    import GHC.IO.Exception (IOErrorType(InappropriateType))
    import qualified GHC.Data.ShortText as ST
    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 DbModule

    -- | Information about an unit (a unit is an installed module library).
    --
    -- This is a subset of Cabal's 'InstalledPackageInfo', with just the bits
    -- that GHC is interested in.
    --
    -- Some types are left as parameters to be instantiated differently in ghc-pkg
    -- and in ghc itself.
    --
    data GenericUnitInfo srcpkgid srcpkgname uid modulename mod = GenericUnitInfo
       { forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> uid
    unitId             :: uid
          -- ^ Unique unit identifier that is used during compilation (e.g. to
          -- generate symbols).

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> uid
    unitInstanceOf     :: uid
          -- ^ Identifier of an indefinite unit (i.e. with module holes) that this
          -- unit is an instance of.
          --
          -- For non instantiated units, unitInstanceOf=unitId

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [(modulename, mod)]
    unitInstantiations :: [(modulename, mod)]
          -- ^ How this unit instantiates some of its module holes. Map hole module
          -- names to actual module

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> srcpkgid
    unitPackageId      :: srcpkgid
          -- ^ Source package identifier.
          --
          -- Cabal instantiates this with Distribution.Types.PackageId.PackageId
          -- type which only contains the source package name and version. Notice
          -- that it doesn't contain the Hackage revision, nor any kind of hash.

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> srcpkgname
    unitPackageName    :: srcpkgname
          -- ^ Source package name

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Version
    unitPackageVersion :: Version
          -- ^ Source package version

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> Maybe srcpkgname
    unitComponentName  :: Maybe srcpkgname
          -- ^ Name of the component.
          --
          -- Cabal supports more than one components (libraries, executables,
          -- testsuites) in the same package. Each component has a name except the
          -- default one (that can only be a library component) for which we use
          -- "Nothing".
          --
          -- GHC only deals with "library" components as they are the only kind of
          -- components that can be registered in a database and used by other
          -- modules.

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> ShortText
    unitAbiHash        :: ST.ShortText
          -- ^ ABI hash used to avoid mixing up units compiled with different
          -- dependencies, compiler, options, etc.

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> [uid]
    unitDepends        :: [uid]
          -- ^ Identifiers of the units this one depends on

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [(uid, ShortText)]
    unitAbiDepends     :: [(uid, ST.ShortText)]
         -- ^ Like 'unitDepends', but each dependency is annotated with the ABI hash
         -- we expect the dependency to respect.

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitImportDirs     :: [FilePathST]
          -- ^ Directories containing module interfaces

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitLibraries      :: [ST.ShortText]
          -- ^ Names of the Haskell libraries provided by this unit

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitExtDepLibsSys  :: [ST.ShortText]
          -- ^ Names of the external system libraries that this unit depends on. See
          -- also `unitExtDepLibsGhc` field.

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitExtDepLibsGhc  :: [ST.ShortText]
          -- ^ Because of slight differences between the GHC dynamic linker (in
          -- GHC.Runtime.Linker) and the
          -- native system linker, some packages have to link with a different list
          -- of libraries when using GHC's. Examples include: libs that are actually
          -- gnu ld scripts, and the possibility that the .a libs do not exactly
          -- match the .so/.dll equivalents.
          --
          -- If this field is set, then we use that instead of the
          -- `unitExtDepLibsSys` field.

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitLibraryDirs    :: [FilePathST]
          -- ^ Directories containing libraries provided by this unit. See also
          -- `unitLibraryDynDirs`.
          --
          -- It seems to be used to store paths to external library dependencies
          -- too.

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitLibraryDynDirs :: [FilePathST]
          -- ^ Directories containing the dynamic libraries provided by this unit.
          -- See also `unitLibraryDirs`.
          --
          -- It seems to be used to store paths to external dynamic library
          -- dependencies too.

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitExtDepFrameworks :: [ST.ShortText]
          -- ^ Names of the external MacOS frameworks that this unit depends on.

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitExtDepFrameworkDirs :: [FilePathST]
          -- ^ Directories containing MacOS frameworks that this unit depends
          -- on.

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitLinkerOptions  :: [ST.ShortText]
          -- ^ Linker (e.g. ld) command line options

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitCcOptions      :: [ST.ShortText]
          -- ^ C compiler options that needs to be passed to the C compiler when we
          -- compile some C code against this unit.

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitIncludes       :: [ST.ShortText]
          -- ^ C header files that are required by this unit (provided by this unit
          -- or external)

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitIncludeDirs    :: [FilePathST]
          -- ^ Directories containing C header files that this unit depends
          -- on.

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitHaddockInterfaces :: [FilePathST]
          -- ^ Paths to Haddock interface files for this unit

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitHaddockHTMLs   :: [FilePathST]
          -- ^ Paths to Haddock directories containing HTML files

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [(modulename, Maybe mod)]
    unitExposedModules :: [(modulename, Maybe mod)]
          -- ^ Modules exposed by the unit.
          --
          -- A module can be re-exported from another package. In this case, we
          -- indicate the module origin in the second parameter.

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [modulename]
    unitHiddenModules  :: [modulename]
          -- ^ Hidden modules.
          --
          -- These are useful for error reporting (e.g. if a hidden module is
          -- imported)

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
    unitIsIndefinite   :: Bool
          -- ^ True if this unit has some module holes that need to be instantiated
          -- with real modules to make the unit usable (a.k.a. Backpack).

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
    unitIsExposed      :: Bool
          -- ^ True if the unit is exposed. A unit could be installed in a database
          -- by "disabled" by not being exposed.

       , forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
    unitIsTrusted      :: Bool
          -- ^ True if the unit is trusted (cf Safe Haskell)

       }
       deriving (GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
    (GenericUnitInfo srcpkgid srcpkgname uid modulename mod
     -> GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool)
    -> (GenericUnitInfo srcpkgid srcpkgname uid modulename mod
        -> GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool)
    -> Eq (GenericUnitInfo srcpkgid srcpkgname uid modulename mod)
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    forall srcpkgid srcpkgname uid modulename mod.
    (Eq uid, Eq modulename, Eq mod, Eq srcpkgid, Eq srcpkgname) =>
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
    $c== :: forall srcpkgid srcpkgname uid modulename mod.
    (Eq uid, Eq modulename, Eq mod, Eq srcpkgid, Eq srcpkgname) =>
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
    == :: GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
    $c/= :: forall srcpkgid srcpkgname uid modulename mod.
    (Eq uid, Eq modulename, Eq mod, Eq srcpkgid, Eq srcpkgname) =>
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
    /= :: GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
    Eq, Int
    -> GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> ShowS
    [GenericUnitInfo srcpkgid srcpkgname uid modulename mod] -> ShowS
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> String
    (Int
     -> GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> ShowS)
    -> (GenericUnitInfo srcpkgid srcpkgname uid modulename mod
        -> String)
    -> ([GenericUnitInfo srcpkgid srcpkgname uid modulename mod]
        -> ShowS)
    -> Show (GenericUnitInfo srcpkgid srcpkgname uid modulename mod)
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    forall srcpkgid srcpkgname uid modulename mod.
    (Show uid, Show modulename, Show mod, Show srcpkgid,
     Show srcpkgname) =>
    Int
    -> GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> ShowS
    forall srcpkgid srcpkgname uid modulename mod.
    (Show uid, Show modulename, Show mod, Show srcpkgid,
     Show srcpkgname) =>
    [GenericUnitInfo srcpkgid srcpkgname uid modulename mod] -> ShowS
    forall srcpkgid srcpkgname uid modulename mod.
    (Show uid, Show modulename, Show mod, Show srcpkgid,
     Show srcpkgname) =>
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> String
    $cshowsPrec :: forall srcpkgid srcpkgname uid modulename mod.
    (Show uid, Show modulename, Show mod, Show srcpkgid,
     Show srcpkgname) =>
    Int
    -> GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> ShowS
    showsPrec :: Int
    -> GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> ShowS
    $cshow :: forall srcpkgid srcpkgname uid modulename mod.
    (Show uid, Show modulename, Show mod, Show srcpkgid,
     Show srcpkgname) =>
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> String
    show :: GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> String
    $cshowList :: forall srcpkgid srcpkgname uid modulename mod.
    (Show uid, Show modulename, Show mod, Show srcpkgid,
     Show srcpkgname) =>
    [GenericUnitInfo srcpkgid srcpkgname uid modulename mod] -> ShowS
    showList :: [GenericUnitInfo srcpkgid srcpkgname uid modulename mod] -> ShowS
    Show)

    type FilePathST = ST.ShortText

    -- | Convert between GenericUnitInfo instances
    mapGenericUnitInfo
       :: (uid1 -> uid2)
       -> (srcpkg1 -> srcpkg2)
       -> (srcpkgname1 -> srcpkgname2)
       -> (modname1 -> modname2)
       -> (mod1 -> mod2)
       -> (GenericUnitInfo srcpkg1 srcpkgname1 uid1 modname1 mod1
           -> GenericUnitInfo srcpkg2 srcpkgname2 uid2 modname2 mod2)
    mapGenericUnitInfo :: forall uid1 uid2 srcpkg1 srcpkg2 srcpkgname1 srcpkgname2 modname1
           modname2 mod1 mod2.
    (uid1 -> uid2)
    -> (srcpkg1 -> srcpkg2)
    -> (srcpkgname1 -> srcpkgname2)
    -> (modname1 -> modname2)
    -> (mod1 -> mod2)
    -> GenericUnitInfo srcpkg1 srcpkgname1 uid1 modname1 mod1
    -> GenericUnitInfo srcpkg2 srcpkgname2 uid2 modname2 mod2
    mapGenericUnitInfo uid1 -> uid2
    fuid srcpkg1 -> srcpkg2
    fsrcpkg srcpkgname1 -> srcpkgname2
    fsrcpkgname modname1 -> modname2
    fmodname mod1 -> mod2
    fmod g :: GenericUnitInfo srcpkg1 srcpkgname1 uid1 modname1 mod1
    g@(GenericUnitInfo {uid1
    srcpkg1
    srcpkgname1
    Bool
    [uid1]
    [modname1]
    [(uid1, ShortText)]
    [(modname1, mod1)]
    [(modname1, Maybe mod1)]
    [ShortText]
    Maybe srcpkgname1
    Version
    ShortText
    unitId :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> uid
    unitInstanceOf :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> uid
    unitInstantiations :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [(modulename, mod)]
    unitPackageId :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> srcpkgid
    unitPackageName :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> srcpkgname
    unitPackageVersion :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Version
    unitComponentName :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> Maybe srcpkgname
    unitAbiHash :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> ShortText
    unitDepends :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> [uid]
    unitAbiDepends :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [(uid, ShortText)]
    unitImportDirs :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitLibraries :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitExtDepLibsSys :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitExtDepLibsGhc :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitLibraryDirs :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitLibraryDynDirs :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitExtDepFrameworks :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitExtDepFrameworkDirs :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitLinkerOptions :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitCcOptions :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitIncludes :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitIncludeDirs :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitHaddockInterfaces :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitHaddockHTMLs :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitExposedModules :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [(modulename, Maybe mod)]
    unitHiddenModules :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod
    -> [modulename]
    unitIsIndefinite :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
    unitIsExposed :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
    unitIsTrusted :: forall srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo srcpkgid srcpkgname uid modulename mod -> Bool
    unitId :: uid1
    unitInstanceOf :: uid1
    unitInstantiations :: [(modname1, mod1)]
    unitPackageId :: srcpkg1
    unitPackageName :: srcpkgname1
    unitPackageVersion :: Version
    unitComponentName :: Maybe srcpkgname1
    unitAbiHash :: ShortText
    unitDepends :: [uid1]
    unitAbiDepends :: [(uid1, ShortText)]
    unitImportDirs :: [ShortText]
    unitLibraries :: [ShortText]
    unitExtDepLibsSys :: [ShortText]
    unitExtDepLibsGhc :: [ShortText]
    unitLibraryDirs :: [ShortText]
    unitLibraryDynDirs :: [ShortText]
    unitExtDepFrameworks :: [ShortText]
    unitExtDepFrameworkDirs :: [ShortText]
    unitLinkerOptions :: [ShortText]
    unitCcOptions :: [ShortText]
    unitIncludes :: [ShortText]
    unitIncludeDirs :: [ShortText]
    unitHaddockInterfaces :: [ShortText]
    unitHaddockHTMLs :: [ShortText]
    unitExposedModules :: [(modname1, Maybe mod1)]
    unitHiddenModules :: [modname1]
    unitIsIndefinite :: Bool
    unitIsExposed :: Bool
    unitIsTrusted :: Bool
    ..}) =
       GenericUnitInfo srcpkg1 srcpkgname1 uid1 modname1 mod1
    g { unitId              = fuid unitId
         , unitInstanceOf      = fuid 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
         }

    -- | @ghc-boot@'s 'Module', serialized to the database.
    data DbModule
       = DbModule
          { DbModule -> DbInstUnitId
    dbModuleUnitId  :: DbInstUnitId
          , DbModule -> ByteString
    dbModuleName    :: BS.ByteString
          }
       | DbModuleVar
          { DbModule -> ByteString
    dbModuleVarName :: BS.ByteString
          }
       deriving (DbModule -> DbModule -> Bool
    (DbModule -> DbModule -> Bool)
    -> (DbModule -> DbModule -> Bool) -> Eq DbModule
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: DbModule -> DbModule -> Bool
    == :: DbModule -> DbModule -> Bool
    $c/= :: DbModule -> DbModule -> Bool
    /= :: DbModule -> DbModule -> Bool
    Eq, Int -> DbModule -> ShowS
    [DbModule] -> ShowS
    DbModule -> String
    (Int -> DbModule -> ShowS)
    -> (DbModule -> String) -> ([DbModule] -> ShowS) -> Show DbModule
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> DbModule -> ShowS
    showsPrec :: Int -> DbModule -> ShowS
    $cshow :: DbModule -> String
    show :: DbModule -> String
    $cshowList :: [DbModule] -> ShowS
    showList :: [DbModule] -> ShowS
    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)]

       -- | Uninstantiated unit
       | DbUnitId
          BS.ByteString               -- unit id
      deriving (DbInstUnitId -> DbInstUnitId -> Bool
    (DbInstUnitId -> DbInstUnitId -> Bool)
    -> (DbInstUnitId -> DbInstUnitId -> Bool) -> Eq DbInstUnitId
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: DbInstUnitId -> DbInstUnitId -> Bool
    == :: DbInstUnitId -> DbInstUnitId -> Bool
    $c/= :: DbInstUnitId -> DbInstUnitId -> Bool
    /= :: DbInstUnitId -> DbInstUnitId -> Bool
    Eq, Int -> DbInstUnitId -> ShowS
    [DbInstUnitId] -> ShowS
    DbInstUnitId -> String
    (Int -> DbInstUnitId -> ShowS)
    -> (DbInstUnitId -> String)
    -> ([DbInstUnitId] -> ShowS)
    -> Show DbInstUnitId
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> DbInstUnitId -> ShowS
    showsPrec :: Int -> DbInstUnitId -> ShowS
    $cshow :: DbInstUnitId -> String
    show :: DbInstUnitId -> String
    $cshowList :: [DbInstUnitId] -> ShowS
    showList :: [DbInstUnitId] -> ShowS
    Show)

    -- | Represents a lock of a package db.
    newtype PackageDbLock = PackageDbLock Handle

    -- | Acquire an exclusive lock related to package DB under given location.
    lockPackageDb :: FilePath -> IO PackageDbLock

    -- | Release the lock related to package DB.
    unlockPackageDb :: PackageDbLock -> IO ()

    -- | Acquire a lock of given type related to package DB under given location.
    lockPackageDbWith :: LockMode -> FilePath -> IO PackageDbLock
    lockPackageDbWith :: LockMode -> String -> IO PackageDbLock
    lockPackageDbWith LockMode
    mode String
    file = do
      -- We are trying to open the lock file and then lock it. Thus the lock file
      -- needs to either exist or we need to be able to create it. Ideally we
      -- would not assume that the lock file always exists in advance. When we are
      -- dealing with a package DB where we have write access then if the lock
      -- file does not exist then we can create it by opening the file in
      -- read/write mode. On the other hand if we are dealing with a package DB
      -- where we do not have write access (e.g. a global DB) then we can only
      -- open in read mode, and the lock file had better exist already or we're in
      -- trouble. So for global read-only DBs on platforms where we must lock the
      -- DB for reading then we will require that the installer/packaging has
      -- included the lock file.
      --
      -- Thus the logic here is to first try opening in read-write mode
      -- and if that fails we try read-only (to handle global read-only DBs).
      -- If either succeed then lock the file. IO exceptions (other than the first
      -- open attempt failing due to the file not existing) simply propagate.
      --
      -- Note that there is a complexity here which was discovered in #13945: some
      -- filesystems (e.g. NFS) will only allow exclusive locking if the fd was
      -- opened for write access. We would previously try opening the lockfile for
      -- read-only access first, however this failed when run on such filesystems.
      -- Consequently, we now try read-write access first, falling back to read-only
      -- if we are denied permission (e.g. in the case of a global database).
      (IOError -> Maybe ())
    -> IO PackageDbLock -> (() -> IO PackageDbLock) -> IO PackageDbLock
    forall e b a.
    Exception e =>
    (e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
    catchJust
        (\IOError
    e -> if IOError -> Bool
    isPermissionError IOError
    e then () -> Maybe ()
    forall a. a -> Maybe a
    Just () else Maybe ()
    forall a. Maybe a
    Nothing)
        (IOMode -> IO PackageDbLock
    lockFileOpenIn IOMode
    ReadWriteMode)
        (IO PackageDbLock -> () -> IO PackageDbLock
    forall a b. a -> b -> a
    const (IO PackageDbLock -> () -> IO PackageDbLock)
    -> IO PackageDbLock -> () -> IO PackageDbLock
    forall a b. (a -> b) -> a -> b
    $ IOMode -> IO PackageDbLock
    lockFileOpenIn IOMode
    ReadMode)
      where
        lock :: String
    lock = String
    file String -> ShowS
    <.> String
    "lock"

        lockFileOpenIn :: IOMode -> IO PackageDbLock
    lockFileOpenIn IOMode
    io_mode = IO Handle
    -> (Handle -> IO ())
    -> (Handle -> IO PackageDbLock)
    -> IO PackageDbLock
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracketOnError
          (String -> IOMode -> IO Handle
    openBinaryFile String
    lock IOMode
    io_mode)
          Handle -> IO ()
    hClose
          -- If file locking support is not available, ignore the error and proceed
          -- normally. Without it the only thing we lose on non-Windows platforms is
          -- the ability to safely issue concurrent updates to the same package db.
          ((Handle -> IO PackageDbLock) -> IO PackageDbLock)
    -> (Handle -> IO PackageDbLock) -> IO PackageDbLock
    forall a b. (a -> b) -> a -> b
    $ \Handle
    hnd -> do Handle -> LockMode -> IO ()
    hLock Handle
    hnd LockMode
    mode IO () -> (FileLockingNotSupported -> IO ()) -> IO ()
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `catch` \FileLockingNotSupported
    FileLockingNotSupported -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                       PackageDbLock -> IO PackageDbLock
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PackageDbLock -> IO PackageDbLock)
    -> PackageDbLock -> IO PackageDbLock
    forall a b. (a -> b) -> a -> b
    $ Handle -> PackageDbLock
    PackageDbLock Handle
    hnd

    lockPackageDb :: String -> IO PackageDbLock
    lockPackageDb = LockMode -> String -> IO PackageDbLock
    lockPackageDbWith LockMode
    ExclusiveLock
    unlockPackageDb :: PackageDbLock -> IO ()
    unlockPackageDb (PackageDbLock Handle
    hnd) = do
        Handle -> IO ()
    hUnlock Handle
    hnd
        Handle -> IO ()
    hClose Handle
    hnd

    -- | Mode to open a package db in.
    data DbMode = DbReadOnly | DbReadWrite

    -- | 'DbOpenMode' holds a value of type @t@ but only in 'DbReadWrite' mode.  So
    -- it is like 'Maybe' but with a type argument for the mode to enforce that the
    -- mode is used consistently.
    data DbOpenMode (mode :: DbMode) t where
      DbOpenReadOnly  ::      DbOpenMode 'DbReadOnly t
      DbOpenReadWrite :: t -> DbOpenMode 'DbReadWrite t

    deriving instance Functor (DbOpenMode mode)
    deriving instance F.Foldable (DbOpenMode mode)
    deriving instance F.Traversable (DbOpenMode mode)

    isDbOpenReadMode :: DbOpenMode mode t -> Bool
    isDbOpenReadMode :: forall (mode :: DbMode) a. DbOpenMode mode a -> Bool
    isDbOpenReadMode = \case
      DbOpenMode mode t
    DbOpenReadOnly    -> Bool
    True
      DbOpenReadWrite{} -> Bool
    False

    -- | Read the part of the package DB that GHC is interested in.
    --
    readPackageDbForGhc :: FilePath -> IO [DbUnitInfo]
    readPackageDbForGhc :: String -> IO [DbUnitInfo]
    readPackageDbForGhc String
    file =
      String
    -> DbOpenMode 'DbReadOnly (ZonkAny 0)
    -> Get [DbUnitInfo]
    -> IO ([DbUnitInfo], DbOpenMode 'DbReadOnly PackageDbLock)
    forall (mode :: DbMode) t pkgs.
    String
    -> DbOpenMode mode t
    -> Get pkgs
    -> IO (pkgs, DbOpenMode mode PackageDbLock)
    decodeFromFile String
    file DbOpenMode 'DbReadOnly (ZonkAny 0)
    forall t. DbOpenMode 'DbReadOnly t
    DbOpenReadOnly Get [DbUnitInfo]
    getDbForGhc IO ([DbUnitInfo], DbOpenMode 'DbReadOnly PackageDbLock)
    -> (([DbUnitInfo], DbOpenMode 'DbReadOnly PackageDbLock)
        -> IO [DbUnitInfo])
    -> IO [DbUnitInfo]
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        ([DbUnitInfo]
    pkgs, DbOpenMode 'DbReadOnly PackageDbLock
    DbOpenReadOnly) -> [DbUnitInfo] -> IO [DbUnitInfo]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [DbUnitInfo]
    pkgs
      where
        getDbForGhc :: Get [DbUnitInfo]
    getDbForGhc = do
          _version    <- Get (Word32, Word32)
    getHeader
          _ghcPartLen <- get :: Get Word32
          ghcPart     <- get
          -- the next part is for ghc-pkg, but we stop here.
          return ghcPart

    -- | Read the part of the package DB that ghc-pkg is interested in
    --
    -- Note that the Binary instance for ghc-pkg's representation of packages
    -- is not defined in this package. This is because ghc-pkg uses Cabal types
    -- (and Binary instances for these) which this package does not depend on.
    --
    -- If we open the package db in read only mode, we get its contents. Otherwise
    -- we additionally receive a PackageDbLock that represents a lock on the
    -- database, so that we can safely update it later.
    --
    readPackageDbForGhcPkg :: Binary pkgs => FilePath -> DbOpenMode mode t ->
                              IO (pkgs, DbOpenMode mode PackageDbLock)
    readPackageDbForGhcPkg :: forall pkgs (mode :: DbMode) t.
    Binary pkgs =>
    String
    -> DbOpenMode mode t -> IO (pkgs, DbOpenMode mode PackageDbLock)
    readPackageDbForGhcPkg String
    file DbOpenMode mode t
    mode =
        String
    -> DbOpenMode mode t
    -> Get pkgs
    -> IO (pkgs, DbOpenMode mode PackageDbLock)
    forall (mode :: DbMode) t pkgs.
    String
    -> DbOpenMode mode t
    -> Get pkgs
    -> IO (pkgs, DbOpenMode mode PackageDbLock)
    decodeFromFile String
    file DbOpenMode mode t
    mode Get pkgs
    getDbForGhcPkg
      where
        getDbForGhcPkg :: Get pkgs
    getDbForGhcPkg = do
          _version    <- Get (Word32, Word32)
    getHeader
          -- skip over the ghc part
          ghcPartLen  <- get :: Get Word32
          _ghcPart    <- skip (fromIntegral ghcPartLen)
          -- the next part is for ghc-pkg
          ghcPkgPart  <- get
          return ghcPkgPart

    -- | Write the whole of the package DB, both parts.
    --
    writePackageDb :: Binary pkgs => FilePath -> [DbUnitInfo] -> pkgs -> IO ()
    writePackageDb :: forall pkgs. Binary pkgs => String -> [DbUnitInfo] -> pkgs -> IO ()
    writePackageDb String
    file [DbUnitInfo]
    ghcPkgs pkgs
    ghcPkgPart = do
      String -> ByteString -> IO ()
    writeFileAtomic String
    file (Put -> ByteString
    runPut Put
    putDbForGhcPkg)
    #if !defined(mingw32_HOST_OS)
      String -> FileMode -> IO ()
    addFileMode String
    file FileMode
    0o444
      --  ^ In case the current umask is too restrictive force all read bits to
      --  allow access.
    #endif
      () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      where
        putDbForGhcPkg :: Put
    putDbForGhcPkg = do
            Put
    putHeader
            Word32 -> Put
    forall t. Binary t => t -> Put
    put               Word32
    ghcPartLen
            ByteString -> Put
    putLazyByteString ByteString
    ghcPart
            pkgs -> Put
    forall t. Binary t => t -> Put
    put               pkgs
    ghcPkgPart
          where
            ghcPartLen :: Word32
            ghcPartLen :: Word32
    ghcPartLen = Int64 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (ByteString -> Int64
    BS.Lazy.length ByteString
    ghcPart)
            ghcPart :: ByteString
    ghcPart    = [DbUnitInfo] -> ByteString
    forall a. Binary a => a -> ByteString
    encode [DbUnitInfo]
    ghcPkgs

    #if !defined(mingw32_HOST_OS)
    addFileMode :: FilePath -> FileMode -> IO ()
    addFileMode :: String -> FileMode -> IO ()
    addFileMode String
    file FileMode
    m = do
      o <- FileStatus -> FileMode
    fileMode (FileStatus -> FileMode) -> IO FileStatus -> IO FileMode
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO FileStatus
    getFileStatus String
    file
      setFileMode file (m .|. o)
    #endif

    getHeader :: Get (Word32, Word32)
    getHeader :: Get (Word32, Word32)
    getHeader = do
        magic <- Int -> Get ByteString
    getByteString (ByteString -> Int
    BS.length ByteString
    headerMagic)
        when (magic /= headerMagic) $
          fail "not a ghc-pkg db file, wrong file magic number"

        majorVersion <- get :: Get Word32
        -- The major version is for incompatible changes

        minorVersion <- get :: Get Word32
        -- The minor version is for compatible extensions

        when (majorVersion /= 1) $
          fail "unsupported ghc-pkg db format version"
        -- If we ever support multiple major versions then we'll have to change
        -- this code

        -- The header can be extended without incrementing the major version,
        -- we ignore fields we don't know about (currently all).
        headerExtraLen <- get :: Get Word32
        skip (fromIntegral headerExtraLen)

        return (majorVersion, minorVersion)

    putHeader :: Put
    putHeader :: Put
    putHeader = do
        ByteString -> Put
    putByteString ByteString
    headerMagic
        Word32 -> Put
    forall t. Binary t => t -> Put
    put Word32
    majorVersion
        Word32 -> Put
    forall t. Binary t => t -> Put
    put Word32
    minorVersion
        Word32 -> Put
    forall t. Binary t => t -> Put
    put Word32
    headerExtraLen
      where
        majorVersion :: Word32
    majorVersion   = Word32
    1 :: Word32
        minorVersion :: Word32
    minorVersion   = Word32
    0 :: Word32
        headerExtraLen :: Word32
    headerExtraLen = Word32
    0 :: Word32

    headerMagic :: BS.ByteString
    headerMagic :: ByteString
    headerMagic = String -> ByteString
    BS.Char8.pack String
    "\0ghcpkg\0"

    -- TODO: we may be able to replace the following with utils from the binary
    -- package in future.

    -- | Feed a 'Get' decoder with data chunks from a file.
    --
    decodeFromFile :: FilePath -> DbOpenMode mode t -> Get pkgs ->
                      IO (pkgs, DbOpenMode mode PackageDbLock)
    decodeFromFile :: forall (mode :: DbMode) t pkgs.
    String
    -> DbOpenMode mode t
    -> Get pkgs
    -> IO (pkgs, DbOpenMode mode PackageDbLock)
    decodeFromFile String
    file DbOpenMode mode t
    mode Get pkgs
    decoder = case DbOpenMode mode t
    mode of
      DbOpenMode mode t
    DbOpenReadOnly -> do
      -- Note [Locking package database on Windows]
      -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      -- When we open the package db in read only mode, there is no need to acquire
      -- shared lock on non-Windows platform because we update the database with an
      -- atomic rename, so readers will always see the database in a consistent
      -- state.
    #if defined(mingw32_HOST_OS)
        bracket (lockPackageDbWith SharedLock file) unlockPackageDb $ \_ -> do
    #endif
          (, DbOpenMode 'DbReadOnly PackageDbLock
    forall t. DbOpenMode 'DbReadOnly t
    DbOpenReadOnly) (pkgs -> (pkgs, DbOpenMode mode PackageDbLock))
    -> IO pkgs -> IO (pkgs, DbOpenMode mode PackageDbLock)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO pkgs
    decodeFileContents
      DbOpenReadWrite{} -> do
        -- When we open the package db in read/write mode, acquire an exclusive lock
        -- on the database and return it so we can keep it for the duration of the
        -- update.
        IO PackageDbLock
    -> (PackageDbLock -> IO ())
    -> (PackageDbLock -> IO (pkgs, DbOpenMode mode PackageDbLock))
    -> IO (pkgs, DbOpenMode mode PackageDbLock)
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    bracketOnError (String -> IO PackageDbLock
    lockPackageDb String
    file) PackageDbLock -> IO ()
    unlockPackageDb ((PackageDbLock -> IO (pkgs, DbOpenMode mode PackageDbLock))
     -> IO (pkgs, DbOpenMode mode PackageDbLock))
    -> (PackageDbLock -> IO (pkgs, DbOpenMode mode PackageDbLock))
    -> IO (pkgs, DbOpenMode mode PackageDbLock)
    forall a b. (a -> b) -> a -> b
    $ \PackageDbLock
    lock -> do
          (, PackageDbLock -> DbOpenMode 'DbReadWrite PackageDbLock
    forall t. t -> DbOpenMode 'DbReadWrite t
    DbOpenReadWrite PackageDbLock
    lock) (pkgs -> (pkgs, DbOpenMode mode PackageDbLock))
    -> IO pkgs -> IO (pkgs, DbOpenMode mode PackageDbLock)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO pkgs
    decodeFileContents
      where
        decodeFileContents :: IO pkgs
    decodeFileContents = String -> IOMode -> (Handle -> IO pkgs) -> IO pkgs
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
    withBinaryFile String
    file IOMode
    ReadMode ((Handle -> IO pkgs) -> IO pkgs) -> (Handle -> IO pkgs) -> IO pkgs
    forall a b. (a -> b) -> a -> b
    $ \Handle
    hnd ->
          Handle -> Decoder pkgs -> IO pkgs
    feed Handle
    hnd (Get pkgs -> Decoder pkgs
    forall a. Get a -> Decoder a
    runGetIncremental Get pkgs
    decoder)

        feed :: Handle -> Decoder pkgs -> IO pkgs
    feed Handle
    hnd (Partial Maybe ByteString -> Decoder pkgs
    k)  = do chunk <- Handle -> Int -> IO ByteString
    BS.hGet Handle
    hnd Int
    BS.Lazy.defaultChunkSize
                                   if BS.null chunk
                                     then feed hnd (k Nothing)
                                     else feed hnd (k (Just chunk))
        feed Handle
    _ (Done ByteString
    _ Int64
    _ pkgs
    res) = pkgs -> IO pkgs
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return pkgs
    res
        feed Handle
    _ (Fail ByteString
    _ Int64
    _ String
    msg) = IOError -> IO pkgs
    forall a. IOError -> IO a
    ioError IOError
    err
          where
            err :: IOError
    err = IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
    mkIOError IOErrorType
    InappropriateType String
    loc Maybe Handle
    forall a. Maybe a
    Nothing (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    file)
                  IOError -> String -> IOError
    `ioeSetErrorString` String
    msg
            loc :: String
    loc = String
    "GHC.Unit.Database.readPackageDb"

    -- Copied from Cabal's Distribution.Simple.Utils.
    writeFileAtomic :: FilePath -> BS.Lazy.ByteString -> IO ()
    writeFileAtomic :: String -> ByteString -> IO ()
    writeFileAtomic String
    targetPath ByteString
    content = do
      let (String
    targetDir, String
    targetFile) = String -> (String, String)
    splitFileName String
    targetPath
      IO (String, Handle)
    -> ((String, Handle) -> IO ())
    -> ((String, Handle) -> IO ())
    -> IO ()
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
    Exception.bracketOnError
        (String -> String -> IO (String, Handle)
    openBinaryTempFileWithDefaultPermissions String
    targetDir (String -> IO (String, Handle)) -> String -> IO (String, Handle)
    forall a b. (a -> b) -> a -> b
    $ String
    targetFile String -> ShowS
    <.> String
    "tmp")
        (\(String
    tmpPath, Handle
    handle) -> Handle -> IO ()
    hClose Handle
    handle IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> String -> IO ()
    removeFile String
    tmpPath)
        (\(String
    tmpPath, Handle
    handle) -> do
            Handle -> ByteString -> IO ()
    BS.Lazy.hPut Handle
    handle ByteString
    content
            Handle -> IO ()
    hClose Handle
    handle
            String -> String -> IO ()
    renameFile String
    tmpPath String
    targetPath)

    instance Binary DbUnitInfo where
      put :: DbUnitInfo -> Put
    put (GenericUnitInfo
             ByteString
    unitId ByteString
    unitInstanceOf [(ByteString, DbModule)]
    unitInstantiations
             ByteString
    unitPackageId
             ByteString
    unitPackageName Version
    unitPackageVersion
             Maybe ByteString
    unitComponentName
             ShortText
    unitAbiHash [ByteString]
    unitDepends [(ByteString, ShortText)]
    unitAbiDepends [ShortText]
    unitImportDirs
             [ShortText]
    unitLibraries [ShortText]
    unitExtDepLibsSys [ShortText]
    unitExtDepLibsGhc
             [ShortText]
    unitLibraryDirs [ShortText]
    unitLibraryDynDirs
             [ShortText]
    unitExtDepFrameworks [ShortText]
    unitExtDepFrameworkDirs
             [ShortText]
    unitLinkerOptions [ShortText]
    unitCcOptions
             [ShortText]
    unitIncludes [ShortText]
    unitIncludeDirs
             [ShortText]
    unitHaddockInterfaces [ShortText]
    unitHaddockHTMLs
             [(ByteString, Maybe DbModule)]
    unitExposedModules [ByteString]
    unitHiddenModules
             Bool
    unitIsIndefinite Bool
    unitIsExposed Bool
    unitIsTrusted) = do
        ByteString -> Put
    forall t. Binary t => t -> Put
    put ByteString
    unitPackageId
        ByteString -> Put
    forall t. Binary t => t -> Put
    put ByteString
    unitPackageName
        Version -> Put
    forall t. Binary t => t -> Put
    put Version
    unitPackageVersion
        Maybe ByteString -> Put
    forall t. Binary t => t -> Put
    put Maybe ByteString
    unitComponentName
        ByteString -> Put
    forall t. Binary t => t -> Put
    put ByteString
    unitId
        ByteString -> Put
    forall t. Binary t => t -> Put
    put ByteString
    unitInstanceOf
        [(ByteString, DbModule)] -> Put
    forall t. Binary t => t -> Put
    put [(ByteString, DbModule)]
    unitInstantiations
        ShortText -> Put
    forall t. Binary t => t -> Put
    put ShortText
    unitAbiHash
        [ByteString] -> Put
    forall t. Binary t => t -> Put
    put [ByteString]
    unitDepends
        [(ByteString, ShortText)] -> Put
    forall t. Binary t => t -> Put
    put [(ByteString, ShortText)]
    unitAbiDepends
        [ShortText] -> Put
    forall t. Binary t => t -> Put
    put [ShortText]
    unitImportDirs
        [ShortText] -> Put
    forall t. Binary t => t -> Put
    put [ShortText]
    unitLibraries
        [ShortText] -> Put
    forall t. Binary t => t -> Put
    put [ShortText]
    unitExtDepLibsSys
        [ShortText] -> Put
    forall t. Binary t => t -> Put
    put [ShortText]
    unitExtDepLibsGhc
        [ShortText] -> Put
    forall t. Binary t => t -> Put
    put [ShortText]
    unitLibraryDirs
        [ShortText] -> Put
    forall t. Binary t => t -> Put
    put [ShortText]
    unitLibraryDynDirs
        [ShortText] -> Put
    forall t. Binary t => t -> Put
    put [ShortText]
    unitExtDepFrameworks
        [ShortText] -> Put
    forall t. Binary t => t -> Put
    put [ShortText]
    unitExtDepFrameworkDirs
        [ShortText] -> Put
    forall t. Binary t => t -> Put
    put [ShortText]
    unitLinkerOptions
        [ShortText] -> Put
    forall t. Binary t => t -> Put
    put [ShortText]
    unitCcOptions
        [ShortText] -> Put
    forall t. Binary t => t -> Put
    put [ShortText]
    unitIncludes
        [ShortText] -> Put
    forall t. Binary t => t -> Put
    put [ShortText]
    unitIncludeDirs
        [ShortText] -> Put
    forall t. Binary t => t -> Put
    put [ShortText]
    unitHaddockInterfaces
        [ShortText] -> Put
    forall t. Binary t => t -> Put
    put [ShortText]
    unitHaddockHTMLs
        [(ByteString, Maybe DbModule)] -> Put
    forall t. Binary t => t -> Put
    put [(ByteString, Maybe DbModule)]
    unitExposedModules
        [ByteString] -> Put
    forall t. Binary t => t -> Put
    put [ByteString]
    unitHiddenModules
        Bool -> Put
    forall t. Binary t => t -> Put
    put Bool
    unitIsIndefinite
        Bool -> Put
    forall t. Binary t => t -> Put
    put Bool
    unitIsExposed
        Bool -> Put
    forall t. Binary t => t -> Put
    put Bool
    unitIsTrusted

      get :: Get DbUnitInfo
    get = do
        unitPackageId      <- Get ByteString
    forall t. Binary t => Get t
    get
        unitPackageName    <- get
        unitPackageVersion <- get
        unitComponentName  <- get
        unitId             <- get
        unitInstanceOf     <- get
        unitInstantiations <- get
        unitAbiHash        <- get
        unitDepends        <- get
        unitAbiDepends     <- get
        unitImportDirs     <- get
        unitLibraries      <- get
        unitExtDepLibsSys  <- get
        unitExtDepLibsGhc  <- get
        libraryDirs        <- get
        libraryDynDirs     <- get
        frameworks         <- get
        frameworkDirs      <- get
        unitLinkerOptions  <- get
        unitCcOptions      <- get
        unitIncludes       <- get
        unitIncludeDirs    <- get
        unitHaddockInterfaces <- get
        unitHaddockHTMLs   <- get
        unitExposedModules <- get
        unitHiddenModules  <- get
        unitIsIndefinite   <- get
        unitIsExposed      <- get
        unitIsTrusted      <- get
        return (GenericUnitInfo
                  unitId
                  unitInstanceOf
                  unitInstantiations
                  unitPackageId
                  unitPackageName
                  unitPackageVersion
                  unitComponentName
                  unitAbiHash
                  unitDepends
                  unitAbiDepends
                  unitImportDirs
                  unitLibraries unitExtDepLibsSys unitExtDepLibsGhc
                  libraryDirs libraryDynDirs
                  frameworks frameworkDirs
                  unitLinkerOptions unitCcOptions
                  unitIncludes unitIncludeDirs
                  unitHaddockInterfaces unitHaddockHTMLs
                  unitExposedModules
                  unitHiddenModules
                  unitIsIndefinite unitIsExposed unitIsTrusted)

    instance Binary DbModule where
      put :: DbModule -> Put
    put (DbModule DbInstUnitId
    dbModuleUnitId ByteString
    dbModuleName) = do
        Word8 -> Put
    putWord8 Word8
    0
        DbInstUnitId -> Put
    forall t. Binary t => t -> Put
    put DbInstUnitId
    dbModuleUnitId
        ByteString -> Put
    forall t. Binary t => t -> Put
    put ByteString
    dbModuleName
      put (DbModuleVar ByteString
    dbModuleVarName) = do
        Word8 -> Put
    putWord8 Word8
    1
        ByteString -> Put
    forall t. Binary t => t -> Put
    put ByteString
    dbModuleVarName
      get :: Get DbModule
    get = do
        b <- Get Word8
    getWord8
        case b of
          Word8
    0 -> DbInstUnitId -> ByteString -> DbModule
    DbModule (DbInstUnitId -> ByteString -> DbModule)
    -> Get DbInstUnitId -> Get (ByteString -> DbModule)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get DbInstUnitId
    forall t. Binary t => Get t
    get Get (ByteString -> DbModule) -> Get ByteString -> Get DbModule
    forall a b. Get (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Get ByteString
    forall t. Binary t => Get t
    get
          Word8
    _ -> ByteString -> DbModule
    DbModuleVar (ByteString -> DbModule) -> Get ByteString -> Get DbModule
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get ByteString
    forall t. Binary t => Get t
    get

    instance Binary DbInstUnitId where
      put :: DbInstUnitId -> Put
    put (DbUnitId ByteString
    uid) = do
        Word8 -> Put
    putWord8 Word8
    0
        ByteString -> Put
    forall t. Binary t => t -> Put
    put ByteString
    uid
      put (DbInstUnitId ByteString
    dbUnitIdComponentId [(ByteString, DbModule)]
    dbUnitIdInsts) = do
        Word8 -> Put
    putWord8 Word8
    1
        ByteString -> Put
    forall t. Binary t => t -> Put
    put ByteString
    dbUnitIdComponentId
        [(ByteString, DbModule)] -> Put
    forall t. Binary t => t -> Put
    put [(ByteString, DbModule)]
    dbUnitIdInsts

      get :: Get DbInstUnitId
    get = do
        b <- Get Word8
    getWord8
        case b of
          Word8
    0 -> ByteString -> DbInstUnitId
    DbUnitId (ByteString -> DbInstUnitId) -> Get ByteString -> Get DbInstUnitId
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get ByteString
    forall t. Binary t => Get t
    get
          Word8
    _ -> ByteString -> [(ByteString, DbModule)] -> DbInstUnitId
    DbInstUnitId (ByteString -> [(ByteString, DbModule)] -> DbInstUnitId)
    -> Get ByteString -> Get ([(ByteString, DbModule)] -> DbInstUnitId)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Get ByteString
    forall t. Binary t => Get t
    get Get ([(ByteString, DbModule)] -> DbInstUnitId)
    -> Get [(ByteString, DbModule)] -> Get DbInstUnitId
    forall a b. Get (a -> b) -> Get a -> Get b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Get [(ByteString, DbModule)]
    forall t. Binary t => Get t
    get

    -- | Return functions to perform path/URL variable substitution as per the Cabal
    -- ${pkgroot} spec
    -- (http://www.haskell.org/pipermail/libraries/2009-May/011772.html)
    --
    -- Paths/URLs can be relative to ${pkgroot} or ${pkgrooturl}.
    -- The "pkgroot" is the directory containing the package database.
    --
    -- Also perform a similar substitution for the older GHC-specific
    -- "$topdir" variable. The "topdir" is the location of the ghc
    -- installation (obtained from the -B option).
    mkMungePathUrl :: FilePathST -> FilePathST -> (FilePathST -> FilePathST, FilePathST -> FilePathST)
    mkMungePathUrl :: ShortText
    -> ShortText -> (ShortText -> ShortText, ShortText -> ShortText)
    mkMungePathUrl ShortText
    top_dir ShortText
    pkgroot = (ShortText -> ShortText
    munge_path, ShortText -> ShortText
    munge_url)
       where
        munge_path :: ShortText -> ShortText
    munge_path ShortText
    p
          | Just ShortText
    p' <- ShortText -> ShortText -> Maybe ShortText
    stripVarPrefix ShortText
    "${pkgroot}" ShortText
    p = ShortText -> ShortText -> ShortText
    forall a. Monoid a => a -> a -> a
    mappend ShortText
    pkgroot ShortText
    p'
          | Just ShortText
    p' <- ShortText -> ShortText -> Maybe ShortText
    stripVarPrefix ShortText
    "$topdir"    ShortText
    p = ShortText -> ShortText -> ShortText
    forall a. Monoid a => a -> a -> a
    mappend ShortText
    top_dir ShortText
    p'
          | Bool
    otherwise                                = ShortText
    p

        munge_url :: ShortText -> ShortText
    munge_url ShortText
    p
          | Just ShortText
    p' <- ShortText -> ShortText -> Maybe ShortText
    stripVarPrefix ShortText
    "${pkgrooturl}" ShortText
    p = ShortText -> ShortText -> ShortText
    toUrlPath ShortText
    pkgroot ShortText
    p'
          | Just ShortText
    p' <- ShortText -> ShortText -> Maybe ShortText
    stripVarPrefix ShortText
    "$httptopdir"   ShortText
    p = ShortText -> ShortText -> ShortText
    toUrlPath ShortText
    top_dir ShortText
    p'
          | Bool
    otherwise                                   = ShortText
    p

        toUrlPath :: ShortText -> ShortText -> ShortText
    toUrlPath ShortText
    r ShortText
    p = [ShortText] -> ShortText
    forall a. Monoid a => [a] -> a
    mconcat ([ShortText] -> ShortText) -> [ShortText] -> ShortText
    forall a b. (a -> b) -> a -> b
    $ ShortText
    "file:///" ShortText -> [ShortText] -> [ShortText]
    forall a. a -> [a] -> [a]
    : (ShortText -> [ShortText] -> [ShortText]
    forall a. a -> [a] -> [a]
    intersperse ShortText
    "/" (ShortText
    r ShortText -> [ShortText] -> [ShortText]
    forall a. a -> [a] -> [a]
    : (ShortText -> [ShortText]
    splitDirectories ShortText
    p)))
                                              -- URLs always use posix style '/' separators

        -- We need to drop a leading "/" or "\\" if there is one:
        splitDirectories :: FilePathST -> [FilePathST]
        splitDirectories :: ShortText -> [ShortText]
    splitDirectories ShortText
    p  = (ShortText -> Bool) -> [ShortText] -> [ShortText]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (ShortText -> Bool) -> ShortText -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShortText -> Bool
    ST.null) ([ShortText] -> [ShortText]) -> [ShortText] -> [ShortText]
    forall a b. (a -> b) -> a -> b
    $ ShortText -> [ShortText]
    ST.splitFilePath ShortText
    p

        -- We could drop the separator here, and then use </> above. However,
        -- by leaving it in and using ++ we keep the same path separator
        -- rather than letting FilePath change it to use \ as the separator
        stripVarPrefix :: ShortText -> ShortText -> Maybe ShortText
    stripVarPrefix ShortText
    var ShortText
    path = case ShortText -> ShortText -> Maybe ShortText
    ST.stripPrefix ShortText
    var ShortText
    path of
                                  Just ShortText
    "" -> ShortText -> Maybe ShortText
    forall a. a -> Maybe a
    Just ShortText
    ""
                                  Just ShortText
    cs | Char -> Bool
    isPathSeparator (ShortText -> Char
    ST.head ShortText
    cs) -> ShortText -> Maybe ShortText
    forall a. a -> Maybe a
    Just ShortText
    cs
                                  Maybe ShortText
    _ -> Maybe ShortText
    forall a. Maybe a
    Nothing

    -- | Perform path/URL variable substitution as per the Cabal ${pkgroot} spec
    -- (http://www.haskell.org/pipermail/libraries/2009-May/011772.html)
    -- Paths/URLs can be relative to ${pkgroot} or ${pkgrooturl}.
    -- The "pkgroot" is the directory containing the package database.
    --
    -- Also perform a similar substitution for the older GHC-specific
    -- "$topdir" variable. The "topdir" is the location of the ghc
    -- installation (obtained from the -B option).
    mungeUnitInfoPaths :: FilePathST -> FilePathST -> GenericUnitInfo a b c d e -> GenericUnitInfo a b c d e
    mungeUnitInfoPaths :: forall a b c d e.
    ShortText
    -> ShortText
    -> GenericUnitInfo a b c d e
    -> GenericUnitInfo a b c d e
    mungeUnitInfoPaths ShortText
    top_dir ShortText
    pkgroot GenericUnitInfo a b c d e
    pkg =
       -- TODO: similar code is duplicated in utils/ghc-pkg/Main.hs
        GenericUnitInfo a b c d e
    pkg
          { unitImportDirs          = munge_paths (unitImportDirs pkg)
          , unitIncludeDirs         = munge_paths (unitIncludeDirs pkg)
          , unitLibraryDirs         = munge_paths (unitLibraryDirs pkg)
          , unitLibraryDynDirs      = munge_paths (unitLibraryDynDirs pkg)
          , unitExtDepFrameworkDirs = munge_paths (unitExtDepFrameworkDirs pkg)
          , unitHaddockInterfaces   = munge_paths (unitHaddockInterfaces pkg)
            -- haddock-html is allowed to be either a URL or a file
          , unitHaddockHTMLs        = munge_paths (munge_urls (unitHaddockHTMLs pkg))
          }
       where
          munge_paths :: [ShortText] -> [ShortText]
    munge_paths = (ShortText -> ShortText) -> [ShortText] -> [ShortText]
    forall a b. (a -> b) -> [a] -> [b]
    map ShortText -> ShortText
    munge_path
          munge_urls :: [ShortText] -> [ShortText]
    munge_urls  = (ShortText -> ShortText) -> [ShortText] -> [ShortText]
    forall a b. (a -> b) -> [a] -> [b]
    map ShortText -> ShortText
    munge_url
          (ShortText -> ShortText
    munge_path,ShortText -> ShortText
    munge_url) = ShortText
    -> ShortText -> (ShortText -> ShortText, ShortText -> ShortText)
    mkMungePathUrl ShortText
    top_dir ShortText
    pkgroot