    {-# 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 System.Posix.Files
    import GHC.IO.Exception (ioe_type, IOErrorType(NoSuchThing))
    #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 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 compid srcpkgid srcpkgname uid modulename mod = GenericUnitInfo
       { forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> uid
    unitId             :: uid
          -- ^ Unique unit identifier that is used during compilation (e.g. to
          -- generate symbols).

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

       , forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid 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 compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid 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 compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> srcpkgname
    unitPackageName    :: srcpkgname
          -- ^ Source package name

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

       , forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid 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 compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid 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 compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [uid]
    unitDepends        :: [uid]
          -- ^ Identifiers of the units this one depends on

       , forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid 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 compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitImportDirs     :: [FilePathST]
          -- ^ Directories containing module interfaces

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

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

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

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

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

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

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

       , forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid 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 compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid 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 compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid 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 compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid 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 compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> Bool
    unitIsTrusted      :: Bool
          -- ^ True if the unit is trusted (cf Safe Haskell)

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

    type FilePathST = ST.ShortText

    -- | 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 :: forall uid1 uid2 cid1 cid2 srcpkg1 srcpkg2 srcpkgname1 srcpkgname2
           modname1 modname2 mod1 mod2.
    (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 uid1 -> uid2
    fuid cid1 -> cid2
    fcid srcpkg1 -> srcpkg2
    fsrcpkg srcpkgname1 -> srcpkgname2
    fsrcpkgname modname1 -> modname2
    fmodname mod1 -> mod2
    fmod g :: GenericUnitInfo cid1 srcpkg1 srcpkgname1 uid1 modname1 mod1
    g@(GenericUnitInfo {uid1
    cid1
    srcpkg1
    srcpkgname1
    Bool
    [uid1]
    [modname1]
    [(uid1, ShortText)]
    [(modname1, mod1)]
    [(modname1, Maybe mod1)]
    [ShortText]
    Maybe srcpkgname1
    Version
    ShortText
    unitIsTrusted :: Bool
    unitIsExposed :: Bool
    unitIsIndefinite :: Bool
    unitHiddenModules :: [modname1]
    unitExposedModules :: [(modname1, Maybe mod1)]
    unitHaddockHTMLs :: [ShortText]
    unitHaddockInterfaces :: [ShortText]
    unitIncludeDirs :: [ShortText]
    unitIncludes :: [ShortText]
    unitCcOptions :: [ShortText]
    unitLinkerOptions :: [ShortText]
    unitExtDepFrameworkDirs :: [ShortText]
    unitExtDepFrameworks :: [ShortText]
    unitLibraryDynDirs :: [ShortText]
    unitLibraryDirs :: [ShortText]
    unitExtDepLibsGhc :: [ShortText]
    unitExtDepLibsSys :: [ShortText]
    unitLibraries :: [ShortText]
    unitImportDirs :: [ShortText]
    unitAbiDepends :: [(uid1, ShortText)]
    unitDepends :: [uid1]
    unitAbiHash :: ShortText
    unitComponentName :: Maybe srcpkgname1
    unitPackageVersion :: Version
    unitPackageName :: srcpkgname1
    unitPackageId :: srcpkg1
    unitInstantiations :: [(modname1, mod1)]
    unitInstanceOf :: cid1
    unitId :: uid1
    unitIsTrusted :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> Bool
    unitIsExposed :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> Bool
    unitIsIndefinite :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> Bool
    unitHiddenModules :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [modulename]
    unitExposedModules :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [(modulename, Maybe mod)]
    unitHaddockHTMLs :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitHaddockInterfaces :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitIncludeDirs :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitIncludes :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitCcOptions :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitLinkerOptions :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitExtDepFrameworkDirs :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitExtDepFrameworks :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitLibraryDynDirs :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitLibraryDirs :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitExtDepLibsGhc :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitExtDepLibsSys :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitLibraries :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitImportDirs :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitAbiDepends :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [(uid, ShortText)]
    unitDepends :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [uid]
    unitAbiHash :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> ShortText
    unitComponentName :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> Maybe srcpkgname
    unitPackageVersion :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> Version
    unitPackageName :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> srcpkgname
    unitPackageId :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> srcpkgid
    unitInstantiations :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [(modulename, mod)]
    unitInstanceOf :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> compid
    unitId :: forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> uid
    ..}) =
       GenericUnitInfo cid1 srcpkg1 srcpkgname1 uid1 modname1 mod1
    g { unitId :: uid2
    unitId              = uid1 -> uid2
    fuid uid1
    unitId
         , unitInstanceOf :: cid2
    unitInstanceOf      = cid1 -> cid2
    fcid cid1
    unitInstanceOf
         , unitInstantiations :: [(modname2, mod2)]
    unitInstantiations  = ((modname1, mod1) -> (modname2, mod2))
    -> [(modname1, mod1)] -> [(modname2, mod2)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((modname1 -> modname2)
    -> (mod1 -> mod2) -> (modname1, mod1) -> (modname2, mod2)
    forall (p :: * -> * -> *) a b c d.
    Bifunctor p =>
    (a -> b) -> (c -> d) -> p a c -> p b d
    bimap modname1 -> modname2
    fmodname mod1 -> mod2
    fmod) [(modname1, mod1)]
    unitInstantiations
         , unitPackageId :: srcpkg2
    unitPackageId       = srcpkg1 -> srcpkg2
    fsrcpkg srcpkg1
    unitPackageId
         , unitPackageName :: srcpkgname2
    unitPackageName     = srcpkgname1 -> srcpkgname2
    fsrcpkgname srcpkgname1
    unitPackageName
         , unitComponentName :: Maybe srcpkgname2
    unitComponentName   = (srcpkgname1 -> srcpkgname2)
    -> Maybe srcpkgname1 -> Maybe srcpkgname2
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap srcpkgname1 -> srcpkgname2
    fsrcpkgname Maybe srcpkgname1
    unitComponentName
         , unitDepends :: [uid2]
    unitDepends         = (uid1 -> uid2) -> [uid1] -> [uid2]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap uid1 -> uid2
    fuid [uid1]
    unitDepends
         , unitAbiDepends :: [(uid2, ShortText)]
    unitAbiDepends      = ((uid1, ShortText) -> (uid2, ShortText))
    -> [(uid1, ShortText)] -> [(uid2, ShortText)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((uid1 -> uid2) -> (uid1, ShortText) -> (uid2, ShortText)
    forall (p :: * -> * -> *) a b c.
    Bifunctor p =>
    (a -> b) -> p a c -> p b c
    first uid1 -> uid2
    fuid) [(uid1, ShortText)]
    unitAbiDepends
         , unitExposedModules :: [(modname2, Maybe mod2)]
    unitExposedModules  = ((modname1, Maybe mod1) -> (modname2, Maybe mod2))
    -> [(modname1, Maybe mod1)] -> [(modname2, Maybe mod2)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((modname1 -> modname2)
    -> (Maybe mod1 -> Maybe mod2)
    -> (modname1, Maybe mod1)
    -> (modname2, Maybe mod2)
    forall (p :: * -> * -> *) a b c d.
    Bifunctor p =>
    (a -> b) -> (c -> d) -> p a c -> p b d
    bimap modname1 -> modname2
    fmodname ((mod1 -> mod2) -> Maybe mod1 -> Maybe mod2
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap mod1 -> mod2
    fmod)) [(modname1, Maybe mod1)]
    unitExposedModules
         , unitHiddenModules :: [modname2]
    unitHiddenModules   = (modname1 -> modname2) -> [modname1] -> [modname2]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap modname1 -> modname2
    fmodname [modname1]
    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
    /= :: DbModule -> DbModule -> Bool
    $c/= :: DbModule -> DbModule -> Bool
    == :: DbModule -> DbModule -> Bool
    $c== :: 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
    showList :: [DbModule] -> ShowS
    $cshowList :: [DbModule] -> ShowS
    show :: DbModule -> String
    $cshow :: DbModule -> String
    showsPrec :: Int -> DbModule -> ShowS
    $cshowsPrec :: Int -> 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
    /= :: DbInstUnitId -> DbInstUnitId -> Bool
    $c/= :: DbInstUnitId -> DbInstUnitId -> Bool
    == :: DbInstUnitId -> DbInstUnitId -> Bool
    $c== :: 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
    showList :: [DbInstUnitId] -> ShowS
    $cshowList :: [DbInstUnitId] -> ShowS
    show :: DbInstUnitId -> String
    $cshow :: DbInstUnitId -> String
    showsPrec :: Int -> DbInstUnitId -> ShowS
    $cshowsPrec :: Int -> 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 (m :: * -> *) a. Monad m => a -> m a
    return ()
                       PackageDbLock -> IO PackageDbLock
    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 Any
    -> 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 Any
    forall t. DbOpenMode 'DbReadOnly t
    DbOpenReadOnly Get [DbUnitInfo]
    getDbForGhc IO ([DbUnitInfo], DbOpenMode 'DbReadOnly PackageDbLock)
    -> (([DbUnitInfo], DbOpenMode 'DbReadOnly PackageDbLock)
        -> IO [DbUnitInfo])
    -> IO [DbUnitInfo]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
        ([DbUnitInfo]
    pkgs, DbOpenMode 'DbReadOnly PackageDbLock
    DbOpenReadOnly) -> [DbUnitInfo] -> IO [DbUnitInfo]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [DbUnitInfo]
    pkgs
      where
        getDbForGhc :: Get [DbUnitInfo]
    getDbForGhc = do
          (Word32, Word32)
    _version    <- Get (Word32, Word32)
    getHeader
          Word32
    _ghcPartLen <- Get Word32
    forall t. Binary t => Get t
    get :: Get Word32
          [DbUnitInfo]
    ghcPart     <- Get [DbUnitInfo]
    forall t. Binary t => Get t
    get
          -- the next part is for ghc-pkg, but we stop here.
          [DbUnitInfo] -> Get [DbUnitInfo]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [DbUnitInfo]
    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
          (Word32, Word32)
    _version    <- Get (Word32, Word32)
    getHeader
          -- skip over the ghc part
          Word32
    ghcPartLen  <- Get Word32
    forall t. Binary t => Get t
    get :: Get Word32
          ()
    _ghcPart    <- Int -> Get ()
    skip (Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    ghcPartLen)
          -- the next part is for ghc-pkg
          pkgs
    ghcPkgPart  <- Get pkgs
    forall t. Binary t => Get t
    get
          pkgs -> Get pkgs
    forall (m :: * -> *) a. Monad m => a -> m a
    return pkgs
    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 =
      String -> ByteString -> IO ()
    writeFileAtomic String
    file (Put -> ByteString
    runPut Put
    putDbForGhcPkg)
      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

    getHeader :: Get (Word32, Word32)
    getHeader :: Get (Word32, Word32)
    getHeader = do
        ByteString
    magic <- Int -> Get ByteString
    getByteString (ByteString -> Int
    BS.length ByteString
    headerMagic)
        Bool -> Get () -> Get ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ByteString
    magic ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ByteString
    headerMagic) (Get () -> Get ()) -> Get () -> Get ()
    forall a b. (a -> b) -> a -> b
    $
          String -> Get ()
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "not a ghc-pkg db file, wrong file magic number"

        Word32
    majorVersion <- Get Word32
    forall t. Binary t => Get t
    get :: Get Word32
        -- The major version is for incompatible changes

        Word32
    minorVersion <- Get Word32
    forall t. Binary t => Get t
    get :: Get Word32
        -- The minor version is for compatible extensions

        Bool -> Get () -> Get ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Word32
    majorVersion Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Word32
    1) (Get () -> Get ()) -> Get () -> Get ()
    forall a b. (a -> b) -> a -> b
    $
          String -> Get ()
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "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).
        Word32
    headerExtraLen <- Get Word32
    forall t. Binary t => Get t
    get :: Get Word32
        Int -> Get ()
    skip (Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    headerExtraLen)

        (Word32, Word32) -> Get (Word32, Word32)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Word32
    majorVersion, Word32
    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 ByteString
    chunk <- Handle -> Int -> IO ByteString
    BS.hGet Handle
    hnd Int
    BS.Lazy.defaultChunkSize
                                   if ByteString -> Bool
    BS.null ByteString
    chunk
                                     then Handle -> Decoder pkgs -> IO pkgs
    feed Handle
    hnd (Maybe ByteString -> Decoder pkgs
    k Maybe ByteString
    forall a. Maybe a
    Nothing)
                                     else Handle -> Decoder pkgs -> IO pkgs
    feed Handle
    hnd (Maybe ByteString -> Decoder pkgs
    k (ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    chunk))
        feed Handle
    _ (Done ByteString
    _ Int64
    _ pkgs
    res) = pkgs -> IO pkgs
    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
      -- Figure out how to update the file mode after we create the temporary file
      let no_update :: p -> m ()
    no_update p
    _path = () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    #if !defined(mingw32_HOST_OS)
      let on_error :: IOError -> IO (p -> m ())
    on_error IOError
    ioe =
              -- If the file doesn't yet exist then just use the default owner and
              -- mode.
              case IOError -> IOErrorType
    ioe_type IOError
    ioe of
                IOErrorType
    NoSuchThing -> (p -> m ()) -> IO (p -> m ())
    forall (m :: * -> *) a. Monad m => a -> m a
    return p -> m ()
    forall {m :: * -> *} {p}. Monad m => p -> m ()
    no_update
                IOErrorType
    _ -> IOError -> IO (p -> m ())
    forall a. IOError -> IO a
    ioError IOError
    ioe
      let handleIO :: (IOException -> IO a) -> IO a -> IO a
          handleIO :: forall a. (IOError -> IO a) -> IO a -> IO a
    handleIO = (IO a -> (IOError -> IO a) -> IO a)
    -> (IOError -> IO a) -> IO a -> IO a
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip IO a -> (IOError -> IO a) -> IO a
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    catch
      String -> IO ()
    set_metadata <- (IOError -> IO (String -> IO ()))
    -> IO (String -> IO ()) -> IO (String -> IO ())
    forall a. (IOError -> IO a) -> IO a -> IO a
    handleIO IOError -> IO (String -> IO ())
    forall {m :: * -> *} {p}. Monad m => IOError -> IO (p -> m ())
    on_error (IO (String -> IO ()) -> IO (String -> IO ()))
    -> IO (String -> IO ()) -> IO (String -> IO ())
    forall a b. (a -> b) -> a -> b
    $ do
          FileStatus
    status <- String -> IO FileStatus
    getFileStatus String
    targetPath
          (String -> IO ()) -> IO (String -> IO ())
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((String -> IO ()) -> IO (String -> IO ()))
    -> (String -> IO ()) -> IO (String -> IO ())
    forall a b. (a -> b) -> a -> b
    $ \String
    path -> do
            String -> FileMode -> IO ()
    setFileMode String
    path (FileStatus -> FileMode
    fileMode FileStatus
    status)
            String -> UserID -> GroupID -> IO ()
    setOwnerAndGroup String
    path (FileStatus -> UserID
    fileOwner FileStatus
    status) (FileStatus -> GroupID
    fileGroup FileStatus
    status)
    #else
      let set_metadata = no_update
    #endif

      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 (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 -> IO ()
    set_metadata String
    tmpPath
            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
        ByteString
    unitPackageId      <- Get ByteString
    forall t. Binary t => Get t
    get
        ByteString
    unitPackageName    <- Get ByteString
    forall t. Binary t => Get t
    get
        Version
    unitPackageVersion <- Get Version
    forall t. Binary t => Get t
    get
        Maybe ByteString
    unitComponentName  <- Get (Maybe ByteString)
    forall t. Binary t => Get t
    get
        ByteString
    unitId             <- Get ByteString
    forall t. Binary t => Get t
    get
        ByteString
    unitInstanceOf     <- Get ByteString
    forall t. Binary t => Get t
    get
        [(ByteString, DbModule)]
    unitInstantiations <- Get [(ByteString, DbModule)]
    forall t. Binary t => Get t
    get
        ShortText
    unitAbiHash        <- Get ShortText
    forall t. Binary t => Get t
    get
        [ByteString]
    unitDepends        <- Get [ByteString]
    forall t. Binary t => Get t
    get
        [(ByteString, ShortText)]
    unitAbiDepends     <- Get [(ByteString, ShortText)]
    forall t. Binary t => Get t
    get
        [ShortText]
    unitImportDirs     <- Get [ShortText]
    forall t. Binary t => Get t
    get
        [ShortText]
    unitLibraries      <- Get [ShortText]
    forall t. Binary t => Get t
    get
        [ShortText]
    unitExtDepLibsSys  <- Get [ShortText]
    forall t. Binary t => Get t
    get
        [ShortText]
    unitExtDepLibsGhc  <- Get [ShortText]
    forall t. Binary t => Get t
    get
        [ShortText]
    libraryDirs        <- Get [ShortText]
    forall t. Binary t => Get t
    get
        [ShortText]
    libraryDynDirs     <- Get [ShortText]
    forall t. Binary t => Get t
    get
        [ShortText]
    frameworks         <- Get [ShortText]
    forall t. Binary t => Get t
    get
        [ShortText]
    frameworkDirs      <- Get [ShortText]
    forall t. Binary t => Get t
    get
        [ShortText]
    unitLinkerOptions  <- Get [ShortText]
    forall t. Binary t => Get t
    get
        [ShortText]
    unitCcOptions      <- Get [ShortText]
    forall t. Binary t => Get t
    get
        [ShortText]
    unitIncludes       <- Get [ShortText]
    forall t. Binary t => Get t
    get
        [ShortText]
    unitIncludeDirs    <- Get [ShortText]
    forall t. Binary t => Get t
    get
        [ShortText]
    unitHaddockInterfaces <- Get [ShortText]
    forall t. Binary t => Get t
    get
        [ShortText]
    unitHaddockHTMLs   <- Get [ShortText]
    forall t. Binary t => Get t
    get
        [(ByteString, Maybe DbModule)]
    unitExposedModules <- Get [(ByteString, Maybe DbModule)]
    forall t. Binary t => Get t
    get
        [ByteString]
    unitHiddenModules  <- Get [ByteString]
    forall t. Binary t => Get t
    get
        Bool
    unitIsIndefinite   <- Get Bool
    forall t. Binary t => Get t
    get
        Bool
    unitIsExposed      <- Get Bool
    forall t. Binary t => Get t
    get
        Bool
    unitIsTrusted      <- Get Bool
    forall t. Binary t => Get t
    get
        DbUnitInfo -> Get DbUnitInfo
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ByteString
    -> ByteString
    -> [(ByteString, DbModule)]
    -> ByteString
    -> ByteString
    -> Version
    -> Maybe ByteString
    -> ShortText
    -> [ByteString]
    -> [(ByteString, ShortText)]
    -> [ShortText]
    -> [ShortText]
    -> [ShortText]
    -> [ShortText]
    -> [ShortText]
    -> [ShortText]
    -> [ShortText]
    -> [ShortText]
    -> [ShortText]
    -> [ShortText]
    -> [ShortText]
    -> [ShortText]
    -> [ShortText]
    -> [ShortText]
    -> [(ByteString, Maybe DbModule)]
    -> [ByteString]
    -> Bool
    -> Bool
    -> Bool
    -> DbUnitInfo
    forall compid srcpkgid srcpkgname uid modulename mod.
    uid
    -> compid
    -> [(modulename, mod)]
    -> srcpkgid
    -> srcpkgname
    -> Version
    -> Maybe srcpkgname
    -> ShortText
    -> [uid]
    -> [(uid, ShortText)]
    -> [ShortText]
    -> [ShortText]
    -> [ShortText]
    -> [ShortText]
    -> [ShortText]
    -> [ShortText]
    -> [ShortText]
    -> [ShortText]
    -> [ShortText]
    -> [ShortText]
    -> [ShortText]
    -> [ShortText]
    -> [ShortText]
    -> [ShortText]
    -> [(modulename, Maybe mod)]
    -> [modulename]
    -> Bool
    -> Bool
    -> Bool
    -> GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    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]
    libraryDirs [ShortText]
    libraryDynDirs
                  [ShortText]
    frameworks [ShortText]
    frameworkDirs
                  [ShortText]
    unitLinkerOptions [ShortText]
    unitCcOptions
                  [ShortText]
    unitIncludes [ShortText]
    unitIncludeDirs
                  [ShortText]
    unitHaddockInterfaces [ShortText]
    unitHaddockHTMLs
                  [(ByteString, Maybe DbModule)]
    unitExposedModules
                  [ByteString]
    unitHiddenModules
                  Bool
    unitIsIndefinite Bool
    unitIsExposed Bool
    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
        Word8
    b <- Get Word8
    getWord8
        case Word8
    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 (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
        Word8
    b <- Get Word8
    getWord8
        case Word8
    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 (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 f -> GenericUnitInfo a b c d e f
    mungeUnitInfoPaths :: forall a b c d e f.
    ShortText
    -> ShortText
    -> GenericUnitInfo a b c d e f
    -> GenericUnitInfo a b c d e f
    mungeUnitInfoPaths ShortText
    top_dir ShortText
    pkgroot GenericUnitInfo a b c d e f
    pkg =
       -- TODO: similar code is duplicated in utils/ghc-pkg/Main.hs
        GenericUnitInfo a b c d e f
    pkg
          { unitImportDirs :: [ShortText]
    unitImportDirs          = [ShortText] -> [ShortText]
    munge_paths (GenericUnitInfo a b c d e f -> [ShortText]
    forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitImportDirs GenericUnitInfo a b c d e f
    pkg)
          , unitIncludeDirs :: [ShortText]
    unitIncludeDirs         = [ShortText] -> [ShortText]
    munge_paths (GenericUnitInfo a b c d e f -> [ShortText]
    forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitIncludeDirs GenericUnitInfo a b c d e f
    pkg)
          , unitLibraryDirs :: [ShortText]
    unitLibraryDirs         = [ShortText] -> [ShortText]
    munge_paths (GenericUnitInfo a b c d e f -> [ShortText]
    forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitLibraryDirs GenericUnitInfo a b c d e f
    pkg)
          , unitLibraryDynDirs :: [ShortText]
    unitLibraryDynDirs      = [ShortText] -> [ShortText]
    munge_paths (GenericUnitInfo a b c d e f -> [ShortText]
    forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitLibraryDynDirs GenericUnitInfo a b c d e f
    pkg)
          , unitExtDepFrameworkDirs :: [ShortText]
    unitExtDepFrameworkDirs = [ShortText] -> [ShortText]
    munge_paths (GenericUnitInfo a b c d e f -> [ShortText]
    forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitExtDepFrameworkDirs GenericUnitInfo a b c d e f
    pkg)
          , unitHaddockInterfaces :: [ShortText]
    unitHaddockInterfaces   = [ShortText] -> [ShortText]
    munge_paths (GenericUnitInfo a b c d e f -> [ShortText]
    forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitHaddockInterfaces GenericUnitInfo a b c d e f
    pkg)
            -- haddock-html is allowed to be either a URL or a file
          , unitHaddockHTMLs :: [ShortText]
    unitHaddockHTMLs        = [ShortText] -> [ShortText]
    munge_paths ([ShortText] -> [ShortText]
    munge_urls (GenericUnitInfo a b c d e f -> [ShortText]
    forall compid srcpkgid srcpkgname uid modulename mod.
    GenericUnitInfo compid srcpkgid srcpkgname uid modulename mod
    -> [ShortText]
    unitHaddockHTMLs GenericUnitInfo a b c d e f
    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