{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  GHC.PackageDb
-- 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
-- registerd 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 datbase 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.PackageDb (
       InstalledPackageInfo(..),
       DbModule(..),
       DbUnitId(..),
       BinaryStringRep(..),
       DbUnitIdModuleRep(..),
       emptyInstalledPackageInfo,
       PackageDbLock,
       lockPackageDb,
       unlockPackageDb,
       DbMode(..),
       DbOpenMode(..),
       isDbOpenReadMode,
       readPackageDbForGhc,
       readPackageDbForGhcPkg,
       writePackageDb
  ) 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.Binary as Bin
import Data.Binary.Put as Bin
import Data.Binary.Get as Bin
import Control.Exception as Exception
import Control.Monad (when)
import System.FilePath
import System.IO
import System.IO.Error
import GHC.IO.Exception (IOErrorType(InappropriateType))
import GHC.IO.Handle.Lock
import System.Directory


-- | This is a subset of Cabal's 'InstalledPackageInfo', with just the bits
-- that GHC is interested in.  See Cabal's documentation for a more detailed
-- description of all of the fields.
--
data InstalledPackageInfo compid srcpkgid srcpkgname instunitid unitid modulename mod
   = InstalledPackageInfo {
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> instunitid
unitId             :: instunitid,
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> compid
componentId        :: compid,
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [(modulename, mod)]
instantiatedWith   :: [(modulename, mod)],
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> srcpkgid
sourcePackageId    :: srcpkgid,
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> srcpkgname
packageName        :: srcpkgname,
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> Version
packageVersion     :: Version,
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> Maybe srcpkgname
sourceLibName      :: Maybe srcpkgname,
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> String
abiHash            :: String,
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [instunitid]
depends            :: [instunitid],
       -- | Like 'depends', but each dependency is annotated with the
       -- ABI hash we expect the dependency to respect.
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [(instunitid, String)]
abiDepends         :: [(instunitid, String)],
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
importDirs         :: [FilePath],
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
hsLibraries        :: [String],
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
extraLibraries     :: [String],
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
extraGHCiLibraries :: [String],
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
libraryDirs        :: [FilePath],
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
libraryDynDirs     :: [FilePath],
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
frameworks         :: [String],
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
frameworkDirs      :: [FilePath],
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
ldOptions          :: [String],
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
ccOptions          :: [String],
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
includes           :: [String],
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
includeDirs        :: [FilePath],
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
haddockInterfaces  :: [FilePath],
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [String]
haddockHTMLs       :: [FilePath],
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [(modulename, Maybe mod)]
exposedModules     :: [(modulename, Maybe mod)],
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [modulename]
hiddenModules      :: [modulename],
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> Bool
indefinite         :: Bool,
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> Bool
exposed            :: Bool,
       InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> Bool
trusted            :: Bool
     }
  deriving (InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> InstalledPackageInfo
     compid srcpkgid srcpkgname instunitid unitid modulename mod
-> Bool
(InstalledPackageInfo
   compid srcpkgid srcpkgname instunitid unitid modulename mod
 -> InstalledPackageInfo
      compid srcpkgid srcpkgname instunitid unitid modulename mod
 -> Bool)
-> (InstalledPackageInfo
      compid srcpkgid srcpkgname instunitid unitid modulename mod
    -> InstalledPackageInfo
         compid srcpkgid srcpkgname instunitid unitid modulename mod
    -> Bool)
-> Eq
     (InstalledPackageInfo
        compid srcpkgid srcpkgname instunitid unitid modulename mod)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
(Eq instunitid, Eq compid, Eq modulename, Eq mod, Eq srcpkgid,
 Eq srcpkgname) =>
InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> InstalledPackageInfo
     compid srcpkgid srcpkgname instunitid unitid modulename mod
-> Bool
/= :: InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> InstalledPackageInfo
     compid srcpkgid srcpkgname instunitid unitid modulename mod
-> Bool
$c/= :: forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
(Eq instunitid, Eq compid, Eq modulename, Eq mod, Eq srcpkgid,
 Eq srcpkgname) =>
InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> InstalledPackageInfo
     compid srcpkgid srcpkgname instunitid unitid modulename mod
-> Bool
== :: InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> InstalledPackageInfo
     compid srcpkgid srcpkgname instunitid unitid modulename mod
-> Bool
$c== :: forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
(Eq instunitid, Eq compid, Eq modulename, Eq mod, Eq srcpkgid,
 Eq srcpkgname) =>
InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> InstalledPackageInfo
     compid srcpkgid srcpkgname instunitid unitid modulename mod
-> Bool
Eq, Int
-> InstalledPackageInfo
     compid srcpkgid srcpkgname instunitid unitid modulename mod
-> ShowS
[InstalledPackageInfo
   compid srcpkgid srcpkgname instunitid unitid modulename mod]
-> ShowS
InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> String
(Int
 -> InstalledPackageInfo
      compid srcpkgid srcpkgname instunitid unitid modulename mod
 -> ShowS)
-> (InstalledPackageInfo
      compid srcpkgid srcpkgname instunitid unitid modulename mod
    -> String)
-> ([InstalledPackageInfo
       compid srcpkgid srcpkgname instunitid unitid modulename mod]
    -> ShowS)
-> Show
     (InstalledPackageInfo
        compid srcpkgid srcpkgname instunitid unitid modulename mod)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
(Show instunitid, Show compid, Show modulename, Show mod,
 Show srcpkgid, Show srcpkgname) =>
Int
-> InstalledPackageInfo
     compid srcpkgid srcpkgname instunitid unitid modulename mod
-> ShowS
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
(Show instunitid, Show compid, Show modulename, Show mod,
 Show srcpkgid, Show srcpkgname) =>
[InstalledPackageInfo
   compid srcpkgid srcpkgname instunitid unitid modulename mod]
-> ShowS
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
(Show instunitid, Show compid, Show modulename, Show mod,
 Show srcpkgid, Show srcpkgname) =>
InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> String
showList :: [InstalledPackageInfo
   compid srcpkgid srcpkgname instunitid unitid modulename mod]
-> ShowS
$cshowList :: forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
(Show instunitid, Show compid, Show modulename, Show mod,
 Show srcpkgid, Show srcpkgname) =>
[InstalledPackageInfo
   compid srcpkgid srcpkgname instunitid unitid modulename mod]
-> ShowS
show :: InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> String
$cshow :: forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
(Show instunitid, Show compid, Show modulename, Show mod,
 Show srcpkgid, Show srcpkgname) =>
InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> String
showsPrec :: Int
-> InstalledPackageInfo
     compid srcpkgid srcpkgname instunitid unitid modulename mod
-> ShowS
$cshowsPrec :: forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
(Show instunitid, Show compid, Show modulename, Show mod,
 Show srcpkgid, Show srcpkgname) =>
Int
-> InstalledPackageInfo
     compid srcpkgid srcpkgname instunitid unitid modulename mod
-> ShowS
Show)

-- | A convenience constraint synonym for common constraints over parameters
-- to 'InstalledPackageInfo'.
type RepInstalledPackageInfo compid srcpkgid srcpkgname instunitid unitid modulename mod =
    (BinaryStringRep srcpkgid, BinaryStringRep srcpkgname,
     BinaryStringRep modulename, BinaryStringRep compid,
     BinaryStringRep instunitid,
     DbUnitIdModuleRep instunitid compid unitid modulename mod)

-- | A type-class for the types which can be converted into 'DbModule'/'DbUnitId'.
-- There is only one type class because these types are mutually recursive.
-- NB: The functional dependency helps out type inference in cases
-- where types would be ambiguous.
class DbUnitIdModuleRep instunitid compid unitid modulename mod
    | mod -> unitid, unitid -> mod, mod -> modulename, unitid -> compid, unitid -> instunitid
    where
  fromDbModule :: DbModule instunitid compid unitid modulename mod -> mod
  toDbModule :: mod -> DbModule instunitid compid unitid modulename mod
  fromDbUnitId :: DbUnitId instunitid compid unitid modulename mod -> unitid
  toDbUnitId :: unitid -> DbUnitId instunitid compid unitid modulename mod

-- | @ghc-boot@'s copy of 'Module', i.e. what is serialized to the database.
-- Use 'DbUnitIdModuleRep' to convert it into an actual 'Module'.
-- It has phantom type parameters as this is the most convenient way
-- to avoid undecidable instances.
data DbModule instunitid compid unitid modulename mod
   = DbModule {
       DbModule instunitid compid unitid modulename mod -> unitid
dbModuleUnitId :: unitid,
       DbModule instunitid compid unitid modulename mod -> modulename
dbModuleName :: modulename
     }
   | DbModuleVar {
       DbModule instunitid compid unitid modulename mod -> modulename
dbModuleVarName :: modulename
     }
  deriving (DbModule instunitid compid unitid modulename mod
-> DbModule instunitid compid unitid modulename mod -> Bool
(DbModule instunitid compid unitid modulename mod
 -> DbModule instunitid compid unitid modulename mod -> Bool)
-> (DbModule instunitid compid unitid modulename mod
    -> DbModule instunitid compid unitid modulename mod -> Bool)
-> Eq (DbModule instunitid compid unitid modulename mod)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall instunitid compid unitid modulename mod.
(Eq unitid, Eq modulename) =>
DbModule instunitid compid unitid modulename mod
-> DbModule instunitid compid unitid modulename mod -> Bool
/= :: DbModule instunitid compid unitid modulename mod
-> DbModule instunitid compid unitid modulename mod -> Bool
$c/= :: forall instunitid compid unitid modulename mod.
(Eq unitid, Eq modulename) =>
DbModule instunitid compid unitid modulename mod
-> DbModule instunitid compid unitid modulename mod -> Bool
== :: DbModule instunitid compid unitid modulename mod
-> DbModule instunitid compid unitid modulename mod -> Bool
$c== :: forall instunitid compid unitid modulename mod.
(Eq unitid, Eq modulename) =>
DbModule instunitid compid unitid modulename mod
-> DbModule instunitid compid unitid modulename mod -> Bool
Eq, Int -> DbModule instunitid compid unitid modulename mod -> ShowS
[DbModule instunitid compid unitid modulename mod] -> ShowS
DbModule instunitid compid unitid modulename mod -> String
(Int -> DbModule instunitid compid unitid modulename mod -> ShowS)
-> (DbModule instunitid compid unitid modulename mod -> String)
-> ([DbModule instunitid compid unitid modulename mod] -> ShowS)
-> Show (DbModule instunitid compid unitid modulename mod)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall instunitid compid unitid modulename mod.
(Show unitid, Show modulename) =>
Int -> DbModule instunitid compid unitid modulename mod -> ShowS
forall instunitid compid unitid modulename mod.
(Show unitid, Show modulename) =>
[DbModule instunitid compid unitid modulename mod] -> ShowS
forall instunitid compid unitid modulename mod.
(Show unitid, Show modulename) =>
DbModule instunitid compid unitid modulename mod -> String
showList :: [DbModule instunitid compid unitid modulename mod] -> ShowS
$cshowList :: forall instunitid compid unitid modulename mod.
(Show unitid, Show modulename) =>
[DbModule instunitid compid unitid modulename mod] -> ShowS
show :: DbModule instunitid compid unitid modulename mod -> String
$cshow :: forall instunitid compid unitid modulename mod.
(Show unitid, Show modulename) =>
DbModule instunitid compid unitid modulename mod -> String
showsPrec :: Int -> DbModule instunitid compid unitid modulename mod -> ShowS
$cshowsPrec :: forall instunitid compid unitid modulename mod.
(Show unitid, Show modulename) =>
Int -> DbModule instunitid compid unitid modulename mod -> ShowS
Show)

-- | @ghc-boot@'s copy of 'UnitId', i.e. what is serialized to the database.
-- Use 'DbUnitIdModuleRep' to convert it into an actual 'UnitId'.
-- It has phantom type parameters as this is the most convenient way
-- to avoid undecidable instances.
data DbUnitId instunitid compid unitid modulename mod
   = DbUnitId compid [(modulename, mod)]
   | DbInstalledUnitId instunitid
  deriving (DbUnitId instunitid compid unitid modulename mod
-> DbUnitId instunitid compid unitid modulename mod -> Bool
(DbUnitId instunitid compid unitid modulename mod
 -> DbUnitId instunitid compid unitid modulename mod -> Bool)
-> (DbUnitId instunitid compid unitid modulename mod
    -> DbUnitId instunitid compid unitid modulename mod -> Bool)
-> Eq (DbUnitId instunitid compid unitid modulename mod)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall instunitid compid unitid modulename mod.
(Eq compid, Eq modulename, Eq mod, Eq instunitid) =>
DbUnitId instunitid compid unitid modulename mod
-> DbUnitId instunitid compid unitid modulename mod -> Bool
/= :: DbUnitId instunitid compid unitid modulename mod
-> DbUnitId instunitid compid unitid modulename mod -> Bool
$c/= :: forall instunitid compid unitid modulename mod.
(Eq compid, Eq modulename, Eq mod, Eq instunitid) =>
DbUnitId instunitid compid unitid modulename mod
-> DbUnitId instunitid compid unitid modulename mod -> Bool
== :: DbUnitId instunitid compid unitid modulename mod
-> DbUnitId instunitid compid unitid modulename mod -> Bool
$c== :: forall instunitid compid unitid modulename mod.
(Eq compid, Eq modulename, Eq mod, Eq instunitid) =>
DbUnitId instunitid compid unitid modulename mod
-> DbUnitId instunitid compid unitid modulename mod -> Bool
Eq, Int -> DbUnitId instunitid compid unitid modulename mod -> ShowS
[DbUnitId instunitid compid unitid modulename mod] -> ShowS
DbUnitId instunitid compid unitid modulename mod -> String
(Int -> DbUnitId instunitid compid unitid modulename mod -> ShowS)
-> (DbUnitId instunitid compid unitid modulename mod -> String)
-> ([DbUnitId instunitid compid unitid modulename mod] -> ShowS)
-> Show (DbUnitId instunitid compid unitid modulename mod)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall instunitid compid unitid modulename mod.
(Show compid, Show modulename, Show mod, Show instunitid) =>
Int -> DbUnitId instunitid compid unitid modulename mod -> ShowS
forall instunitid compid unitid modulename mod.
(Show compid, Show modulename, Show mod, Show instunitid) =>
[DbUnitId instunitid compid unitid modulename mod] -> ShowS
forall instunitid compid unitid modulename mod.
(Show compid, Show modulename, Show mod, Show instunitid) =>
DbUnitId instunitid compid unitid modulename mod -> String
showList :: [DbUnitId instunitid compid unitid modulename mod] -> ShowS
$cshowList :: forall instunitid compid unitid modulename mod.
(Show compid, Show modulename, Show mod, Show instunitid) =>
[DbUnitId instunitid compid unitid modulename mod] -> ShowS
show :: DbUnitId instunitid compid unitid modulename mod -> String
$cshow :: forall instunitid compid unitid modulename mod.
(Show compid, Show modulename, Show mod, Show instunitid) =>
DbUnitId instunitid compid unitid modulename mod -> String
showsPrec :: Int -> DbUnitId instunitid compid unitid modulename mod -> ShowS
$cshowsPrec :: forall instunitid compid unitid modulename mod.
(Show compid, Show modulename, Show mod, Show instunitid) =>
Int -> DbUnitId instunitid compid unitid modulename mod -> ShowS
Show)

class BinaryStringRep a where
  fromStringRep :: BS.ByteString -> a
  toStringRep   :: a -> BS.ByteString

emptyInstalledPackageInfo :: RepInstalledPackageInfo a b c d e f g
                          => InstalledPackageInfo a b c d e f g
emptyInstalledPackageInfo :: InstalledPackageInfo a b c d e f g
emptyInstalledPackageInfo =
  InstalledPackageInfo :: forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
instunitid
-> compid
-> [(modulename, mod)]
-> srcpkgid
-> srcpkgname
-> Version
-> Maybe srcpkgname
-> String
-> [instunitid]
-> [(instunitid, String)]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [(modulename, Maybe mod)]
-> [modulename]
-> Bool
-> Bool
-> Bool
-> InstalledPackageInfo
     compid srcpkgid srcpkgname instunitid unitid modulename mod
InstalledPackageInfo {
       unitId :: d
unitId             = ByteString -> d
forall a. BinaryStringRep a => ByteString -> a
fromStringRep ByteString
BS.empty,
       componentId :: a
componentId        = ByteString -> a
forall a. BinaryStringRep a => ByteString -> a
fromStringRep ByteString
BS.empty,
       instantiatedWith :: [(f, g)]
instantiatedWith   = [],
       sourcePackageId :: b
sourcePackageId    = ByteString -> b
forall a. BinaryStringRep a => ByteString -> a
fromStringRep ByteString
BS.empty,
       packageName :: c
packageName        = ByteString -> c
forall a. BinaryStringRep a => ByteString -> a
fromStringRep ByteString
BS.empty,
       packageVersion :: Version
packageVersion     = [Int] -> [String] -> Version
Version [] [],
       sourceLibName :: Maybe c
sourceLibName      = Maybe c
forall a. Maybe a
Nothing,
       abiHash :: String
abiHash            = "",
       depends :: [d]
depends            = [],
       abiDepends :: [(d, String)]
abiDepends         = [],
       importDirs :: [String]
importDirs         = [],
       hsLibraries :: [String]
hsLibraries        = [],
       extraLibraries :: [String]
extraLibraries     = [],
       extraGHCiLibraries :: [String]
extraGHCiLibraries = [],
       libraryDirs :: [String]
libraryDirs        = [],
       libraryDynDirs :: [String]
libraryDynDirs     = [],
       frameworks :: [String]
frameworks         = [],
       frameworkDirs :: [String]
frameworkDirs      = [],
       ldOptions :: [String]
ldOptions          = [],
       ccOptions :: [String]
ccOptions          = [],
       includes :: [String]
includes           = [],
       includeDirs :: [String]
includeDirs        = [],
       haddockInterfaces :: [String]
haddockInterfaces  = [],
       haddockHTMLs :: [String]
haddockHTMLs       = [],
       exposedModules :: [(f, Maybe g)]
exposedModules     = [],
       hiddenModules :: [f]
hiddenModules      = [],
       indefinite :: Bool
indefinite         = Bool
False,
       exposed :: Bool
exposed            = Bool
False,
       trusted :: Bool
trusted            = Bool
False
  }

-- | 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 mode :: LockMode
mode file :: 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
    (\e :: 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
<.> "lock"

    lockFileOpenIn :: IOMode -> IO PackageDbLock
lockFileOpenIn io_mode :: 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
$ \hnd :: 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 -> () -> 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 hnd :: 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 :: DbOpenMode mode t -> Bool
isDbOpenReadMode = \case
  DbOpenReadOnly    -> Bool
True
  DbOpenReadWrite{} -> Bool
False

-- | Read the part of the package DB that GHC is interested in.
--
readPackageDbForGhc :: RepInstalledPackageInfo a b c d e f g =>
                       FilePath -> IO [InstalledPackageInfo a b c d e f g]
readPackageDbForGhc :: String -> IO [InstalledPackageInfo a b c d e f g]
readPackageDbForGhc file :: String
file =
  String
-> DbOpenMode 'DbReadOnly Any
-> Get [InstalledPackageInfo a b c d e f g]
-> IO
     ([InstalledPackageInfo a b c d e f g],
      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 [InstalledPackageInfo a b c d e f g]
getDbForGhc IO
  ([InstalledPackageInfo a b c d e f g],
   DbOpenMode 'DbReadOnly PackageDbLock)
-> (([InstalledPackageInfo a b c d e f g],
     DbOpenMode 'DbReadOnly PackageDbLock)
    -> IO [InstalledPackageInfo a b c d e f g])
-> IO [InstalledPackageInfo a b c d e f g]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (pkgs :: [InstalledPackageInfo a b c d e f g]
pkgs, DbOpenReadOnly) -> [InstalledPackageInfo a b c d e f g]
-> IO [InstalledPackageInfo a b c d e f g]
forall (m :: * -> *) a. Monad m => a -> m a
return [InstalledPackageInfo a b c d e f g]
pkgs
  where
    getDbForGhc :: Get [InstalledPackageInfo a b c d e f g]
getDbForGhc = do
      (Word32, Word32)
_version    <- Get (Word32, Word32)
getHeader
      Word32
_ghcPartLen <- Get Word32
forall t. Binary t => Get t
get :: Get Word32
      [InstalledPackageInfo a b c d e f g]
ghcPart     <- Get [InstalledPackageInfo a b c d e f g]
forall t. Binary t => Get t
get
      -- the next part is for ghc-pkg, but we stop here.
      [InstalledPackageInfo a b c d e f g]
-> Get [InstalledPackageInfo a b c d e f g]
forall (m :: * -> *) a. Monad m => a -> m a
return [InstalledPackageInfo a b c d e f g]
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 :: String
-> DbOpenMode mode t -> IO (pkgs, DbOpenMode mode PackageDbLock)
readPackageDbForGhcPkg file :: String
file mode :: 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, RepInstalledPackageInfo a b c d e f g) =>
                  FilePath -> [InstalledPackageInfo a b c d e f g] ->
                  pkgs -> IO ()
writePackageDb :: String -> [InstalledPackageInfo a b c d e f g] -> pkgs -> IO ()
writePackageDb file :: String
file ghcPkgs :: [InstalledPackageInfo a b c d e f g]
ghcPkgs ghcPkgPart :: 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    = [InstalledPackageInfo a b c d e f g] -> ByteString
forall a. Binary a => a -> ByteString
encode [InstalledPackageInfo a b c d e f g]
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 "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
/= 1) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
      String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
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).
    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   = 1 :: Word32
    minorVersion :: Word32
minorVersion   = 0 :: Word32
    headerExtraLen :: Word32
headerExtraLen = 0 :: Word32

headerMagic :: BS.ByteString
headerMagic :: ByteString
headerMagic = String -> ByteString
BS.Char8.pack "\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 :: String
-> DbOpenMode mode t
-> Get pkgs
-> IO (pkgs, DbOpenMode mode PackageDbLock)
decodeFromFile file :: String
file mode :: DbOpenMode mode t
mode decoder :: Get pkgs
decoder = case DbOpenMode mode t
mode of
  DbOpenReadOnly -> do
  -- 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 'DbReadOnly PackageDbLock))
-> IO pkgs -> IO (pkgs, DbOpenMode 'DbReadOnly 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 'DbReadWrite PackageDbLock))
-> IO (pkgs, DbOpenMode 'DbReadWrite 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 'DbReadWrite PackageDbLock))
 -> IO (pkgs, DbOpenMode mode PackageDbLock))
-> (PackageDbLock
    -> IO (pkgs, DbOpenMode 'DbReadWrite PackageDbLock))
-> IO (pkgs, DbOpenMode mode PackageDbLock)
forall a b. (a -> b) -> a -> b
$ \lock :: PackageDbLock
lock -> do
      (, PackageDbLock -> DbOpenMode 'DbReadWrite PackageDbLock
forall t. t -> DbOpenMode 'DbReadWrite t
DbOpenReadWrite PackageDbLock
lock) (pkgs -> (pkgs, DbOpenMode 'DbReadWrite PackageDbLock))
-> IO pkgs -> IO (pkgs, DbOpenMode 'DbReadWrite 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
$ \hnd :: 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 hnd :: Handle
hnd (Partial k :: 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 _ (Done _ _ res :: pkgs
res) = pkgs -> IO pkgs
forall (m :: * -> *) a. Monad m => a -> m a
return pkgs
res
    feed _ (Fail _ _ msg :: 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 = "GHC.PackageDb.readPackageDb"

-- Copied from Cabal's Distribution.Simple.Utils.
writeFileAtomic :: FilePath -> BS.Lazy.ByteString -> IO ()
writeFileAtomic :: String -> ByteString -> IO ()
writeFileAtomic targetPath :: String
targetPath content :: ByteString
content = do
  let (targetDir :: String
targetDir, targetFile :: 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
<.> "tmp")
    (\(tmpPath :: String
tmpPath, handle :: 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)
    (\(tmpPath :: String
tmpPath, handle :: 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 (RepInstalledPackageInfo a b c d e f g) =>
         Binary (InstalledPackageInfo a b c d e f g) where
  put :: InstalledPackageInfo a b c d e f g -> Put
put (InstalledPackageInfo
         unitId :: d
unitId componentId :: a
componentId instantiatedWith :: [(f, g)]
instantiatedWith sourcePackageId :: b
sourcePackageId
         packageName :: c
packageName packageVersion :: Version
packageVersion
         sourceLibName :: Maybe c
sourceLibName
         abiHash :: String
abiHash depends :: [d]
depends abiDepends :: [(d, String)]
abiDepends importDirs :: [String]
importDirs
         hsLibraries :: [String]
hsLibraries extraLibraries :: [String]
extraLibraries extraGHCiLibraries :: [String]
extraGHCiLibraries
         libraryDirs :: [String]
libraryDirs libraryDynDirs :: [String]
libraryDynDirs
         frameworks :: [String]
frameworks frameworkDirs :: [String]
frameworkDirs
         ldOptions :: [String]
ldOptions ccOptions :: [String]
ccOptions
         includes :: [String]
includes includeDirs :: [String]
includeDirs
         haddockInterfaces :: [String]
haddockInterfaces haddockHTMLs :: [String]
haddockHTMLs
         exposedModules :: [(f, Maybe g)]
exposedModules hiddenModules :: [f]
hiddenModules
         indefinite :: Bool
indefinite exposed :: Bool
exposed trusted :: Bool
trusted) = do
    ByteString -> Put
forall t. Binary t => t -> Put
put (b -> ByteString
forall a. BinaryStringRep a => a -> ByteString
toStringRep b
sourcePackageId)
    ByteString -> Put
forall t. Binary t => t -> Put
put (c -> ByteString
forall a. BinaryStringRep a => a -> ByteString
toStringRep c
packageName)
    Version -> Put
forall t. Binary t => t -> Put
put Version
packageVersion
    Maybe ByteString -> Put
forall t. Binary t => t -> Put
put ((c -> ByteString) -> Maybe c -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> ByteString
forall a. BinaryStringRep a => a -> ByteString
toStringRep Maybe c
sourceLibName)
    ByteString -> Put
forall t. Binary t => t -> Put
put (d -> ByteString
forall a. BinaryStringRep a => a -> ByteString
toStringRep d
unitId)
    ByteString -> Put
forall t. Binary t => t -> Put
put (a -> ByteString
forall a. BinaryStringRep a => a -> ByteString
toStringRep a
componentId)
    [(ByteString, DbModule d a e f g)] -> Put
forall t. Binary t => t -> Put
put (((f, g) -> (ByteString, DbModule d a e f g))
-> [(f, g)] -> [(ByteString, DbModule d a e f g)]
forall a b. (a -> b) -> [a] -> [b]
map (\(mod_name :: f
mod_name, mod :: g
mod) -> (f -> ByteString
forall a. BinaryStringRep a => a -> ByteString
toStringRep f
mod_name, g -> DbModule d a e f g
forall instunitid compid unitid modulename mod.
DbUnitIdModuleRep instunitid compid unitid modulename mod =>
mod -> DbModule instunitid compid unitid modulename mod
toDbModule g
mod))
             [(f, g)]
instantiatedWith)
    String -> Put
forall t. Binary t => t -> Put
put String
abiHash
    [ByteString] -> Put
forall t. Binary t => t -> Put
put ((d -> ByteString) -> [d] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map d -> ByteString
forall a. BinaryStringRep a => a -> ByteString
toStringRep [d]
depends)
    [(ByteString, String)] -> Put
forall t. Binary t => t -> Put
put (((d, String) -> (ByteString, String))
-> [(d, String)] -> [(ByteString, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\(k :: d
k,v :: String
v) -> (d -> ByteString
forall a. BinaryStringRep a => a -> ByteString
toStringRep d
k, String
v)) [(d, String)]
abiDepends)
    [String] -> Put
forall t. Binary t => t -> Put
put [String]
importDirs
    [String] -> Put
forall t. Binary t => t -> Put
put [String]
hsLibraries
    [String] -> Put
forall t. Binary t => t -> Put
put [String]
extraLibraries
    [String] -> Put
forall t. Binary t => t -> Put
put [String]
extraGHCiLibraries
    [String] -> Put
forall t. Binary t => t -> Put
put [String]
libraryDirs
    [String] -> Put
forall t. Binary t => t -> Put
put [String]
libraryDynDirs
    [String] -> Put
forall t. Binary t => t -> Put
put [String]
frameworks
    [String] -> Put
forall t. Binary t => t -> Put
put [String]
frameworkDirs
    [String] -> Put
forall t. Binary t => t -> Put
put [String]
ldOptions
    [String] -> Put
forall t. Binary t => t -> Put
put [String]
ccOptions
    [String] -> Put
forall t. Binary t => t -> Put
put [String]
includes
    [String] -> Put
forall t. Binary t => t -> Put
put [String]
includeDirs
    [String] -> Put
forall t. Binary t => t -> Put
put [String]
haddockInterfaces
    [String] -> Put
forall t. Binary t => t -> Put
put [String]
haddockHTMLs
    [(ByteString, Maybe (DbModule d a e f g))] -> Put
forall t. Binary t => t -> Put
put (((f, Maybe g) -> (ByteString, Maybe (DbModule d a e f g)))
-> [(f, Maybe g)] -> [(ByteString, Maybe (DbModule d a e f g))]
forall a b. (a -> b) -> [a] -> [b]
map (\(mod_name :: f
mod_name, mb_mod :: Maybe g
mb_mod) -> (f -> ByteString
forall a. BinaryStringRep a => a -> ByteString
toStringRep f
mod_name, (g -> DbModule d a e f g) -> Maybe g -> Maybe (DbModule d a e f g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g -> DbModule d a e f g
forall instunitid compid unitid modulename mod.
DbUnitIdModuleRep instunitid compid unitid modulename mod =>
mod -> DbModule instunitid compid unitid modulename mod
toDbModule Maybe g
mb_mod))
             [(f, Maybe g)]
exposedModules)
    [ByteString] -> Put
forall t. Binary t => t -> Put
put ((f -> ByteString) -> [f] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map f -> ByteString
forall a. BinaryStringRep a => a -> ByteString
toStringRep [f]
hiddenModules)
    Bool -> Put
forall t. Binary t => t -> Put
put Bool
indefinite
    Bool -> Put
forall t. Binary t => t -> Put
put Bool
exposed
    Bool -> Put
forall t. Binary t => t -> Put
put Bool
trusted

  get :: Get (InstalledPackageInfo a b c d e f g)
get = do
    ByteString
sourcePackageId    <- Get ByteString
forall t. Binary t => Get t
get
    ByteString
packageName        <- Get ByteString
forall t. Binary t => Get t
get
    Version
packageVersion     <- Get Version
forall t. Binary t => Get t
get
    Maybe ByteString
sourceLibName      <- Get (Maybe ByteString)
forall t. Binary t => Get t
get
    ByteString
unitId             <- Get ByteString
forall t. Binary t => Get t
get
    ByteString
componentId        <- Get ByteString
forall t. Binary t => Get t
get
    [(ByteString, DbModule d a e f g)]
instantiatedWith   <- Get [(ByteString, DbModule d a e f g)]
forall t. Binary t => Get t
get
    String
abiHash            <- Get String
forall t. Binary t => Get t
get
    [ByteString]
depends            <- Get [ByteString]
forall t. Binary t => Get t
get
    [(ByteString, String)]
abiDepends         <- Get [(ByteString, String)]
forall t. Binary t => Get t
get
    [String]
importDirs         <- Get [String]
forall t. Binary t => Get t
get
    [String]
hsLibraries        <- Get [String]
forall t. Binary t => Get t
get
    [String]
extraLibraries     <- Get [String]
forall t. Binary t => Get t
get
    [String]
extraGHCiLibraries <- Get [String]
forall t. Binary t => Get t
get
    [String]
libraryDirs        <- Get [String]
forall t. Binary t => Get t
get
    [String]
libraryDynDirs     <- Get [String]
forall t. Binary t => Get t
get
    [String]
frameworks         <- Get [String]
forall t. Binary t => Get t
get
    [String]
frameworkDirs      <- Get [String]
forall t. Binary t => Get t
get
    [String]
ldOptions          <- Get [String]
forall t. Binary t => Get t
get
    [String]
ccOptions          <- Get [String]
forall t. Binary t => Get t
get
    [String]
includes           <- Get [String]
forall t. Binary t => Get t
get
    [String]
includeDirs        <- Get [String]
forall t. Binary t => Get t
get
    [String]
haddockInterfaces  <- Get [String]
forall t. Binary t => Get t
get
    [String]
haddockHTMLs       <- Get [String]
forall t. Binary t => Get t
get
    [(ByteString, Maybe (DbModule d a e f g))]
exposedModules     <- Get [(ByteString, Maybe (DbModule d a e f g))]
forall t. Binary t => Get t
get
    [ByteString]
hiddenModules      <- Get [ByteString]
forall t. Binary t => Get t
get
    Bool
indefinite         <- Get Bool
forall t. Binary t => Get t
get
    Bool
exposed            <- Get Bool
forall t. Binary t => Get t
get
    Bool
trusted            <- Get Bool
forall t. Binary t => Get t
get
    InstalledPackageInfo a b c d e f g
-> Get (InstalledPackageInfo a b c d e f g)
forall (m :: * -> *) a. Monad m => a -> m a
return (d
-> a
-> [(f, g)]
-> b
-> c
-> Version
-> Maybe c
-> String
-> [d]
-> [(d, String)]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [(f, Maybe g)]
-> [f]
-> Bool
-> Bool
-> Bool
-> InstalledPackageInfo a b c d e f g
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
instunitid
-> compid
-> [(modulename, mod)]
-> srcpkgid
-> srcpkgname
-> Version
-> Maybe srcpkgname
-> String
-> [instunitid]
-> [(instunitid, String)]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [(modulename, Maybe mod)]
-> [modulename]
-> Bool
-> Bool
-> Bool
-> InstalledPackageInfo
     compid srcpkgid srcpkgname instunitid unitid modulename mod
InstalledPackageInfo
              (ByteString -> d
forall a. BinaryStringRep a => ByteString -> a
fromStringRep ByteString
unitId)
              (ByteString -> a
forall a. BinaryStringRep a => ByteString -> a
fromStringRep ByteString
componentId)
              (((ByteString, DbModule d a e f g) -> (f, g))
-> [(ByteString, DbModule d a e f g)] -> [(f, g)]
forall a b. (a -> b) -> [a] -> [b]
map (\(mod_name :: ByteString
mod_name, mod :: DbModule d a e f g
mod) -> (ByteString -> f
forall a. BinaryStringRep a => ByteString -> a
fromStringRep ByteString
mod_name, DbModule d a e f g -> g
forall instunitid compid unitid modulename mod.
DbUnitIdModuleRep instunitid compid unitid modulename mod =>
DbModule instunitid compid unitid modulename mod -> mod
fromDbModule DbModule d a e f g
mod))
                [(ByteString, DbModule d a e f g)]
instantiatedWith)
              (ByteString -> b
forall a. BinaryStringRep a => ByteString -> a
fromStringRep ByteString
sourcePackageId)
              (ByteString -> c
forall a. BinaryStringRep a => ByteString -> a
fromStringRep ByteString
packageName) Version
packageVersion
              ((ByteString -> c) -> Maybe ByteString -> Maybe c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> c
forall a. BinaryStringRep a => ByteString -> a
fromStringRep Maybe ByteString
sourceLibName)
              String
abiHash
              ((ByteString -> d) -> [ByteString] -> [d]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> d
forall a. BinaryStringRep a => ByteString -> a
fromStringRep [ByteString]
depends)
              (((ByteString, String) -> (d, String))
-> [(ByteString, String)] -> [(d, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\(k :: ByteString
k,v :: String
v) -> (ByteString -> d
forall a. BinaryStringRep a => ByteString -> a
fromStringRep ByteString
k, String
v)) [(ByteString, String)]
abiDepends)
              [String]
importDirs
              [String]
hsLibraries [String]
extraLibraries [String]
extraGHCiLibraries
              [String]
libraryDirs [String]
libraryDynDirs
              [String]
frameworks [String]
frameworkDirs
              [String]
ldOptions [String]
ccOptions
              [String]
includes [String]
includeDirs
              [String]
haddockInterfaces [String]
haddockHTMLs
              (((ByteString, Maybe (DbModule d a e f g)) -> (f, Maybe g))
-> [(ByteString, Maybe (DbModule d a e f g))] -> [(f, Maybe g)]
forall a b. (a -> b) -> [a] -> [b]
map (\(mod_name :: ByteString
mod_name, mb_mod :: Maybe (DbModule d a e f g)
mb_mod) ->
                        (ByteString -> f
forall a. BinaryStringRep a => ByteString -> a
fromStringRep ByteString
mod_name, (DbModule d a e f g -> g) -> Maybe (DbModule d a e f g) -> Maybe g
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DbModule d a e f g -> g
forall instunitid compid unitid modulename mod.
DbUnitIdModuleRep instunitid compid unitid modulename mod =>
DbModule instunitid compid unitid modulename mod -> mod
fromDbModule Maybe (DbModule d a e f g)
mb_mod))
                   [(ByteString, Maybe (DbModule d a e f g))]
exposedModules)
              ((ByteString -> f) -> [ByteString] -> [f]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> f
forall a. BinaryStringRep a => ByteString -> a
fromStringRep [ByteString]
hiddenModules)
              Bool
indefinite Bool
exposed Bool
trusted)

instance (BinaryStringRep modulename, BinaryStringRep compid,
          BinaryStringRep instunitid,
          DbUnitIdModuleRep instunitid compid unitid modulename mod) =>
         Binary (DbModule instunitid compid unitid modulename mod) where
  put :: DbModule instunitid compid unitid modulename mod -> Put
put (DbModule dbModuleUnitId :: unitid
dbModuleUnitId dbModuleName :: modulename
dbModuleName) = do
    Word8 -> Put
putWord8 0
    DbUnitId instunitid compid unitid modulename mod -> Put
forall t. Binary t => t -> Put
put (unitid -> DbUnitId instunitid compid unitid modulename mod
forall instunitid compid unitid modulename mod.
DbUnitIdModuleRep instunitid compid unitid modulename mod =>
unitid -> DbUnitId instunitid compid unitid modulename mod
toDbUnitId unitid
dbModuleUnitId)
    ByteString -> Put
forall t. Binary t => t -> Put
put (modulename -> ByteString
forall a. BinaryStringRep a => a -> ByteString
toStringRep modulename
dbModuleName)
  put (DbModuleVar dbModuleVarName :: modulename
dbModuleVarName) = do
    Word8 -> Put
putWord8 1
    ByteString -> Put
forall t. Binary t => t -> Put
put (modulename -> ByteString
forall a. BinaryStringRep a => a -> ByteString
toStringRep modulename
dbModuleVarName)
  get :: Get (DbModule instunitid compid unitid modulename mod)
get = do
    Word8
b <- Get Word8
getWord8
    case Word8
b of
      0 -> do DbUnitId instunitid compid unitid modulename mod
dbModuleUnitId <- Get (DbUnitId instunitid compid unitid modulename mod)
forall t. Binary t => Get t
get
              ByteString
dbModuleName <- Get ByteString
forall t. Binary t => Get t
get
              DbModule instunitid compid unitid modulename mod
-> Get (DbModule instunitid compid unitid modulename mod)
forall (m :: * -> *) a. Monad m => a -> m a
return (unitid
-> modulename -> DbModule instunitid compid unitid modulename mod
forall instunitid compid unitid modulename mod.
unitid
-> modulename -> DbModule instunitid compid unitid modulename mod
DbModule (DbUnitId instunitid compid unitid modulename mod -> unitid
forall instunitid compid unitid modulename mod.
DbUnitIdModuleRep instunitid compid unitid modulename mod =>
DbUnitId instunitid compid unitid modulename mod -> unitid
fromDbUnitId DbUnitId instunitid compid unitid modulename mod
dbModuleUnitId)
                               (ByteString -> modulename
forall a. BinaryStringRep a => ByteString -> a
fromStringRep ByteString
dbModuleName))
      _ -> do ByteString
dbModuleVarName <- Get ByteString
forall t. Binary t => Get t
get
              DbModule instunitid compid unitid modulename mod
-> Get (DbModule instunitid compid unitid modulename mod)
forall (m :: * -> *) a. Monad m => a -> m a
return (modulename -> DbModule instunitid compid unitid modulename mod
forall instunitid compid unitid modulename mod.
modulename -> DbModule instunitid compid unitid modulename mod
DbModuleVar (ByteString -> modulename
forall a. BinaryStringRep a => ByteString -> a
fromStringRep ByteString
dbModuleVarName))

instance (BinaryStringRep modulename, BinaryStringRep compid,
          BinaryStringRep instunitid,
          DbUnitIdModuleRep instunitid compid unitid modulename mod) =>
         Binary (DbUnitId instunitid compid unitid modulename mod) where
  put :: DbUnitId instunitid compid unitid modulename mod -> Put
put (DbInstalledUnitId instunitid :: instunitid
instunitid) = do
    Word8 -> Put
putWord8 0
    ByteString -> Put
forall t. Binary t => t -> Put
put (instunitid -> ByteString
forall a. BinaryStringRep a => a -> ByteString
toStringRep instunitid
instunitid)
  put (DbUnitId dbUnitIdComponentId :: compid
dbUnitIdComponentId dbUnitIdInsts :: [(modulename, mod)]
dbUnitIdInsts) = do
    Word8 -> Put
putWord8 1
    ByteString -> Put
forall t. Binary t => t -> Put
put (compid -> ByteString
forall a. BinaryStringRep a => a -> ByteString
toStringRep compid
dbUnitIdComponentId)
    [(ByteString, DbModule instunitid compid unitid modulename mod)]
-> Put
forall t. Binary t => t -> Put
put (((modulename, mod)
 -> (ByteString, DbModule instunitid compid unitid modulename mod))
-> [(modulename, mod)]
-> [(ByteString, DbModule instunitid compid unitid modulename mod)]
forall a b. (a -> b) -> [a] -> [b]
map (\(mod_name :: modulename
mod_name, mod :: mod
mod) -> (modulename -> ByteString
forall a. BinaryStringRep a => a -> ByteString
toStringRep modulename
mod_name, mod -> DbModule instunitid compid unitid modulename mod
forall instunitid compid unitid modulename mod.
DbUnitIdModuleRep instunitid compid unitid modulename mod =>
mod -> DbModule instunitid compid unitid modulename mod
toDbModule mod
mod)) [(modulename, mod)]
dbUnitIdInsts)
  get :: Get (DbUnitId instunitid compid unitid modulename mod)
get = do
    Word8
b <- Get Word8
getWord8
    case Word8
b of
      0 -> do
        ByteString
instunitid <- Get ByteString
forall t. Binary t => Get t
get
        DbUnitId instunitid compid unitid modulename mod
-> Get (DbUnitId instunitid compid unitid modulename mod)
forall (m :: * -> *) a. Monad m => a -> m a
return (instunitid -> DbUnitId instunitid compid unitid modulename mod
forall instunitid compid unitid modulename mod.
instunitid -> DbUnitId instunitid compid unitid modulename mod
DbInstalledUnitId (ByteString -> instunitid
forall a. BinaryStringRep a => ByteString -> a
fromStringRep ByteString
instunitid))
      _ -> do
        ByteString
dbUnitIdComponentId <- Get ByteString
forall t. Binary t => Get t
get
        [(ByteString, DbModule instunitid compid unitid modulename mod)]
dbUnitIdInsts <- Get
  [(ByteString, DbModule instunitid compid unitid modulename mod)]
forall t. Binary t => Get t
get
        DbUnitId instunitid compid unitid modulename mod
-> Get (DbUnitId instunitid compid unitid modulename mod)
forall (m :: * -> *) a. Monad m => a -> m a
return (compid
-> [(modulename, mod)]
-> DbUnitId instunitid compid unitid modulename mod
forall instunitid compid unitid modulename mod.
compid
-> [(modulename, mod)]
-> DbUnitId instunitid compid unitid modulename mod
DbUnitId
            (ByteString -> compid
forall a. BinaryStringRep a => ByteString -> a
fromStringRep ByteString
dbUnitIdComponentId)
            (((ByteString, DbModule instunitid compid unitid modulename mod)
 -> (modulename, mod))
-> [(ByteString, DbModule instunitid compid unitid modulename mod)]
-> [(modulename, mod)]
forall a b. (a -> b) -> [a] -> [b]
map (\(mod_name :: ByteString
mod_name, mod :: DbModule instunitid compid unitid modulename mod
mod) -> ( ByteString -> modulename
forall a. BinaryStringRep a => ByteString -> a
fromStringRep ByteString
mod_name
                                      , DbModule instunitid compid unitid modulename mod -> mod
forall instunitid compid unitid modulename mod.
DbUnitIdModuleRep instunitid compid unitid modulename mod =>
DbModule instunitid compid unitid modulename mod -> mod
fromDbModule DbModule instunitid compid unitid modulename mod
mod))
                 [(ByteString, DbModule instunitid compid unitid modulename mod)]
dbUnitIdInsts))