{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}

-- | Functions to calculate nix-style hashes for package ids.
--
-- The basic idea is simple, hash the combination of:
--
--   * the package tarball
--   * the ids of all the direct dependencies
--   * other local configuration (flags, profiling, etc)
--
module Distribution.Client.PackageHash (
    -- * Calculating package hashes
    PackageHashInputs(..),
    PackageHashConfigInputs(..),
    PackageSourceHash,
    hashedInstalledPackageId,
    hashPackageHashInputs,
    renderPackageHashInputs,
    -- ** Platform-specific variations
    hashedInstalledPackageIdLong,
    hashedInstalledPackageIdShort,
  ) where

import Prelude ()
import Distribution.Client.Compat.Prelude

import Distribution.Package
         ( PackageId, PackageIdentifier(..), mkComponentId
         , PkgconfigName )
import Distribution.System
         ( Platform, OS(Windows, OSX), buildOS )
import Distribution.Types.Flag
         ( FlagAssignment, showFlagAssignment )
import Distribution.Simple.Compiler
         ( CompilerId, OptimisationLevel(..), DebugInfoLevel(..)
         , ProfDetailLevel(..), PackageDB, showProfDetailLevel )
import Distribution.Simple.InstallDirs
         ( PathTemplate, fromPathTemplate )
import Distribution.Types.PkgconfigVersion (PkgconfigVersion)
import Distribution.Client.HashValue
import Distribution.Client.Types
         ( InstalledPackageId )
import qualified Distribution.Solver.Types.ComponentDeps as CD

import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.Map as Map
import qualified Data.Set as Set

-------------------------------
-- Calculating package hashes
--

-- | Calculate a 'InstalledPackageId' for a package using our nix-style
-- inputs hashing method.
--
-- Note that due to path length limitations on Windows, this function uses
-- a different method on Windows that produces shorted package ids.
-- See 'hashedInstalledPackageIdLong' vs 'hashedInstalledPackageIdShort'.
--
hashedInstalledPackageId :: PackageHashInputs -> InstalledPackageId
hashedInstalledPackageId :: PackageHashInputs -> InstalledPackageId
hashedInstalledPackageId
  | OS
buildOS forall a. Eq a => a -> a -> Bool
== OS
Windows = PackageHashInputs -> InstalledPackageId
hashedInstalledPackageIdShort
  | OS
buildOS forall a. Eq a => a -> a -> Bool
== OS
OSX     = PackageHashInputs -> InstalledPackageId
hashedInstalledPackageIdVeryShort
  | Bool
otherwise          = PackageHashInputs -> InstalledPackageId
hashedInstalledPackageIdLong

-- | Calculate a 'InstalledPackageId' for a package using our nix-style
-- inputs hashing method.
--
-- This produces large ids with big hashes. It is only suitable for systems
-- without significant path length limitations (ie not Windows).
--
hashedInstalledPackageIdLong :: PackageHashInputs -> InstalledPackageId
hashedInstalledPackageIdLong :: PackageHashInputs -> InstalledPackageId
hashedInstalledPackageIdLong
    pkghashinputs :: PackageHashInputs
pkghashinputs@PackageHashInputs{PackageId
pkgHashPkgId :: PackageHashInputs -> PackageId
pkgHashPkgId :: PackageId
pkgHashPkgId,Maybe Component
pkgHashComponent :: PackageHashInputs -> Maybe Component
pkgHashComponent :: Maybe Component
pkgHashComponent}
    = String -> InstalledPackageId
mkComponentId forall a b. (a -> b) -> a -> b
$
           forall a. Pretty a => a -> String
prettyShow PackageId
pkgHashPkgId   -- to be a bit user friendly
        forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" Component -> String
displayComponent Maybe Component
pkgHashComponent
        forall a. [a] -> [a] -> [a]
++ String
"-"
        forall a. [a] -> [a] -> [a]
++ HashValue -> String
showHashValue (PackageHashInputs -> HashValue
hashPackageHashInputs PackageHashInputs
pkghashinputs)
  where
    displayComponent :: CD.Component -> String
    displayComponent :: Component -> String
displayComponent Component
CD.ComponentLib        = String
""
    displayComponent (CD.ComponentSubLib UnqualComponentName
s) = String
"-l-" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow UnqualComponentName
s
    displayComponent (CD.ComponentFLib UnqualComponentName
s)   = String
"-f-" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow UnqualComponentName
s
    displayComponent (CD.ComponentExe UnqualComponentName
s)    = String
"-e-" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow UnqualComponentName
s
    displayComponent (CD.ComponentTest UnqualComponentName
s)   = String
"-t-" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow UnqualComponentName
s
    displayComponent (CD.ComponentBench UnqualComponentName
s)  = String
"-b-" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow UnqualComponentName
s
    displayComponent Component
CD.ComponentSetup      = String
"-setup"

-- | On Windows we have serious problems with path lengths. Windows imposes a
-- maximum path length of 260 chars, and even if we can use the windows long
-- path APIs ourselves, we cannot guarantee that ghc, gcc, ld, ar, etc etc all
-- do so too.
--
-- So our only choice is to limit the lengths of the paths, and the only real
-- way to do that is to limit the size of the 'InstalledPackageId's that we
-- generate. We do this by truncating the package names and versions and also
-- by truncating the hash sizes.
--
-- Truncating the package names and versions is technically ok because they are
-- just included for human convenience, the full source package id is included
-- in the hash.
--
-- Truncating the hash size is disappointing but also technically ok. We
-- rely on the hash primarily for collision avoidance not for any security
-- properties (at least for now).
--
hashedInstalledPackageIdShort :: PackageHashInputs -> InstalledPackageId
hashedInstalledPackageIdShort :: PackageHashInputs -> InstalledPackageId
hashedInstalledPackageIdShort pkghashinputs :: PackageHashInputs
pkghashinputs@PackageHashInputs{PackageId
pkgHashPkgId :: PackageId
pkgHashPkgId :: PackageHashInputs -> PackageId
pkgHashPkgId} =
    String -> InstalledPackageId
mkComponentId forall a b. (a -> b) -> a -> b
$
      forall a. [a] -> [[a]] -> [a]
intercalate String
"-"
        -- max length now 64
        [ Int -> String -> String
truncateStr Int
14 (forall a. Pretty a => a -> String
prettyShow PackageName
name)
        , Int -> String -> String
truncateStr  Int
8 (forall a. Pretty a => a -> String
prettyShow Version
version)
        , HashValue -> String
showHashValue (Int -> HashValue -> HashValue
truncateHash Int
20 (PackageHashInputs -> HashValue
hashPackageHashInputs PackageHashInputs
pkghashinputs))
        ]
  where
    PackageIdentifier PackageName
name Version
version = PackageId
pkgHashPkgId

    -- Truncate a string, with a visual indication that it is truncated.
    truncateStr :: Int -> String -> String
truncateStr Int
n String
s | forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s forall a. Ord a => a -> a -> Bool
<= Int
n = String
s
                    | Bool
otherwise     = forall a. Int -> [a] -> [a]
take (Int
nforall a. Num a => a -> a -> a
-Int
1) String
s forall a. [a] -> [a] -> [a]
++ String
"_"

-- | On macOS we shorten the name very aggressively.  The mach-o linker on
-- macOS has a limited load command size, to which the name of the library
-- as well as its relative path (\@rpath) entry count.  To circumvent this,
-- on macOS the libraries are not stored as
--  @store/<libraryname>/libHS<libraryname>.dylib@
-- where libraryname contains the libraries name, version and abi hash, but in
--  @store/lib/libHS<very short libraryname>.dylib@
-- where the very short library name drops all vowels from the package name,
-- and truncates the hash to 4 bytes.
--
-- We therefore we only need one \@rpath entry to @store/lib@ instead of one
-- \@rpath entry for each library. And the reduced library name saves some
-- additional space.
--
-- This however has two major drawbacks:
-- 1) Packages can collide more easily due to the shortened hash.
-- 2) The libraries are *not* prefix relocatable anymore as they all end up
--    in the same @store/lib@ folder.
--
-- The ultimate solution would have to include generating proxy dynamic
-- libraries on macOS, such that the proxy libraries and the linked libraries
-- stay under the load command limit, and the recursive linker is still able
-- to link all of them.
hashedInstalledPackageIdVeryShort :: PackageHashInputs -> InstalledPackageId
hashedInstalledPackageIdVeryShort :: PackageHashInputs -> InstalledPackageId
hashedInstalledPackageIdVeryShort pkghashinputs :: PackageHashInputs
pkghashinputs@PackageHashInputs{PackageId
pkgHashPkgId :: PackageId
pkgHashPkgId :: PackageHashInputs -> PackageId
pkgHashPkgId} =
  String -> InstalledPackageId
mkComponentId forall a b. (a -> b) -> a -> b
$
    forall a. [a] -> [[a]] -> [a]
intercalate String
"-"
      [ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
"aeiou") (forall a. Pretty a => a -> String
prettyShow PackageName
name)
      , forall a. Pretty a => a -> String
prettyShow Version
version
      , HashValue -> String
showHashValue (Int -> HashValue -> HashValue
truncateHash Int
4 (PackageHashInputs -> HashValue
hashPackageHashInputs PackageHashInputs
pkghashinputs))
      ]
  where
    PackageIdentifier PackageName
name Version
version = PackageId
pkgHashPkgId

-- | All the information that contributes to a package's hash, and thus its
-- 'InstalledPackageId'.
--
data PackageHashInputs = PackageHashInputs {
       PackageHashInputs -> PackageId
pkgHashPkgId         :: PackageId,
       PackageHashInputs -> Maybe Component
pkgHashComponent     :: Maybe CD.Component,
       PackageHashInputs -> HashValue
pkgHashSourceHash    :: PackageSourceHash,
       PackageHashInputs -> Set (PkgconfigName, Maybe PkgconfigVersion)
pkgHashPkgConfigDeps :: Set (PkgconfigName, Maybe PkgconfigVersion),
       PackageHashInputs -> Set InstalledPackageId
pkgHashDirectDeps    :: Set InstalledPackageId,
       PackageHashInputs -> PackageHashConfigInputs
pkgHashOtherConfig   :: PackageHashConfigInputs
     }

type PackageSourceHash = HashValue

-- | Those parts of the package configuration that contribute to the
-- package hash.
--
data PackageHashConfigInputs = PackageHashConfigInputs {
       PackageHashConfigInputs -> CompilerId
pkgHashCompilerId          :: CompilerId,
       PackageHashConfigInputs -> Platform
pkgHashPlatform            :: Platform,
       PackageHashConfigInputs -> FlagAssignment
pkgHashFlagAssignment      :: FlagAssignment, -- complete not partial
       PackageHashConfigInputs -> [String]
pkgHashConfigureScriptArgs :: [String], -- just ./configure for build-type Configure
       PackageHashConfigInputs -> Bool
pkgHashVanillaLib          :: Bool,
       PackageHashConfigInputs -> Bool
pkgHashSharedLib           :: Bool,
       PackageHashConfigInputs -> Bool
pkgHashDynExe              :: Bool,
       PackageHashConfigInputs -> Bool
pkgHashFullyStaticExe      :: Bool,
       PackageHashConfigInputs -> Bool
pkgHashGHCiLib             :: Bool,
       PackageHashConfigInputs -> Bool
pkgHashProfLib             :: Bool,
       PackageHashConfigInputs -> Bool
pkgHashProfExe             :: Bool,
       PackageHashConfigInputs -> ProfDetailLevel
pkgHashProfLibDetail       :: ProfDetailLevel,
       PackageHashConfigInputs -> ProfDetailLevel
pkgHashProfExeDetail       :: ProfDetailLevel,
       PackageHashConfigInputs -> Bool
pkgHashCoverage            :: Bool,
       PackageHashConfigInputs -> OptimisationLevel
pkgHashOptimization        :: OptimisationLevel,
       PackageHashConfigInputs -> Bool
pkgHashSplitObjs           :: Bool,
       PackageHashConfigInputs -> Bool
pkgHashSplitSections       :: Bool,
       PackageHashConfigInputs -> Bool
pkgHashStripLibs           :: Bool,
       PackageHashConfigInputs -> Bool
pkgHashStripExes           :: Bool,
       PackageHashConfigInputs -> DebugInfoLevel
pkgHashDebugInfo           :: DebugInfoLevel,
       PackageHashConfigInputs -> Map String [String]
pkgHashProgramArgs         :: Map String [String],
       PackageHashConfigInputs -> [String]
pkgHashExtraLibDirs        :: [FilePath],
       PackageHashConfigInputs -> [String]
pkgHashExtraLibDirsStatic  :: [FilePath],
       PackageHashConfigInputs -> [String]
pkgHashExtraFrameworkDirs  :: [FilePath],
       PackageHashConfigInputs -> [String]
pkgHashExtraIncludeDirs    :: [FilePath],
       PackageHashConfigInputs -> Maybe PathTemplate
pkgHashProgPrefix          :: Maybe PathTemplate,
       PackageHashConfigInputs -> Maybe PathTemplate
pkgHashProgSuffix          :: Maybe PathTemplate,
       PackageHashConfigInputs -> [Maybe PackageDB]
pkgHashPackageDbs          :: [Maybe PackageDB],

       -- Haddock options
       PackageHashConfigInputs -> Bool
pkgHashDocumentation       :: Bool,
       PackageHashConfigInputs -> Bool
pkgHashHaddockHoogle       :: Bool,
       PackageHashConfigInputs -> Bool
pkgHashHaddockHtml         :: Bool,
       PackageHashConfigInputs -> Maybe String
pkgHashHaddockHtmlLocation :: Maybe String,
       PackageHashConfigInputs -> Bool
pkgHashHaddockForeignLibs  :: Bool,
       PackageHashConfigInputs -> Bool
pkgHashHaddockExecutables  :: Bool,
       PackageHashConfigInputs -> Bool
pkgHashHaddockTestSuites   :: Bool,
       PackageHashConfigInputs -> Bool
pkgHashHaddockBenchmarks   :: Bool,
       PackageHashConfigInputs -> Bool
pkgHashHaddockInternal     :: Bool,
       PackageHashConfigInputs -> Maybe String
pkgHashHaddockCss          :: Maybe FilePath,
       PackageHashConfigInputs -> Bool
pkgHashHaddockLinkedSource :: Bool,
       PackageHashConfigInputs -> Bool
pkgHashHaddockQuickJump    :: Bool,
       PackageHashConfigInputs -> Maybe PathTemplate
pkgHashHaddockContents     :: Maybe PathTemplate,
       PackageHashConfigInputs -> Maybe PathTemplate
pkgHashHaddockIndex        :: Maybe PathTemplate,
       PackageHashConfigInputs -> Maybe String
pkgHashHaddockBaseUrl      :: Maybe String,
       PackageHashConfigInputs -> Maybe String
pkgHashHaddockLib          :: Maybe String

--     TODO: [required eventually] pkgHashToolsVersions     ?
--     TODO: [required eventually] pkgHashToolsExtraOptions ?
     }
  deriving Int -> PackageHashConfigInputs -> String -> String
[PackageHashConfigInputs] -> String -> String
PackageHashConfigInputs -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PackageHashConfigInputs] -> String -> String
$cshowList :: [PackageHashConfigInputs] -> String -> String
show :: PackageHashConfigInputs -> String
$cshow :: PackageHashConfigInputs -> String
showsPrec :: Int -> PackageHashConfigInputs -> String -> String
$cshowsPrec :: Int -> PackageHashConfigInputs -> String -> String
Show


-- | Calculate the overall hash to be used for an 'InstalledPackageId'.
--
hashPackageHashInputs :: PackageHashInputs -> HashValue
hashPackageHashInputs :: PackageHashInputs -> HashValue
hashPackageHashInputs = ByteString -> HashValue
hashValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageHashInputs -> ByteString
renderPackageHashInputs

-- | Render a textual representation of the 'PackageHashInputs'.
--
-- The 'hashValue' of this text is the overall package hash.
--
renderPackageHashInputs :: PackageHashInputs -> LBS.ByteString
renderPackageHashInputs :: PackageHashInputs -> ByteString
renderPackageHashInputs PackageHashInputs{
                          PackageId
pkgHashPkgId :: PackageId
pkgHashPkgId :: PackageHashInputs -> PackageId
pkgHashPkgId,
                          Maybe Component
pkgHashComponent :: Maybe Component
pkgHashComponent :: PackageHashInputs -> Maybe Component
pkgHashComponent,
                          HashValue
pkgHashSourceHash :: HashValue
pkgHashSourceHash :: PackageHashInputs -> HashValue
pkgHashSourceHash,
                          Set InstalledPackageId
pkgHashDirectDeps :: Set InstalledPackageId
pkgHashDirectDeps :: PackageHashInputs -> Set InstalledPackageId
pkgHashDirectDeps,
                          Set (PkgconfigName, Maybe PkgconfigVersion)
pkgHashPkgConfigDeps :: Set (PkgconfigName, Maybe PkgconfigVersion)
pkgHashPkgConfigDeps :: PackageHashInputs -> Set (PkgconfigName, Maybe PkgconfigVersion)
pkgHashPkgConfigDeps,
                          pkgHashOtherConfig :: PackageHashInputs -> PackageHashConfigInputs
pkgHashOtherConfig =
                            PackageHashConfigInputs{Bool
[String]
[Maybe PackageDB]
Maybe String
Maybe PathTemplate
Platform
CompilerId
Map String [String]
OptimisationLevel
DebugInfoLevel
ProfDetailLevel
FlagAssignment
pkgHashHaddockLib :: Maybe String
pkgHashHaddockBaseUrl :: Maybe String
pkgHashHaddockIndex :: Maybe PathTemplate
pkgHashHaddockContents :: Maybe PathTemplate
pkgHashHaddockQuickJump :: Bool
pkgHashHaddockLinkedSource :: Bool
pkgHashHaddockCss :: Maybe String
pkgHashHaddockInternal :: Bool
pkgHashHaddockBenchmarks :: Bool
pkgHashHaddockTestSuites :: Bool
pkgHashHaddockExecutables :: Bool
pkgHashHaddockForeignLibs :: Bool
pkgHashHaddockHtmlLocation :: Maybe String
pkgHashHaddockHtml :: Bool
pkgHashHaddockHoogle :: Bool
pkgHashDocumentation :: Bool
pkgHashPackageDbs :: [Maybe PackageDB]
pkgHashProgSuffix :: Maybe PathTemplate
pkgHashProgPrefix :: Maybe PathTemplate
pkgHashExtraIncludeDirs :: [String]
pkgHashExtraFrameworkDirs :: [String]
pkgHashExtraLibDirsStatic :: [String]
pkgHashExtraLibDirs :: [String]
pkgHashProgramArgs :: Map String [String]
pkgHashDebugInfo :: DebugInfoLevel
pkgHashStripExes :: Bool
pkgHashStripLibs :: Bool
pkgHashSplitSections :: Bool
pkgHashSplitObjs :: Bool
pkgHashOptimization :: OptimisationLevel
pkgHashCoverage :: Bool
pkgHashProfExeDetail :: ProfDetailLevel
pkgHashProfLibDetail :: ProfDetailLevel
pkgHashProfExe :: Bool
pkgHashProfLib :: Bool
pkgHashGHCiLib :: Bool
pkgHashFullyStaticExe :: Bool
pkgHashDynExe :: Bool
pkgHashSharedLib :: Bool
pkgHashVanillaLib :: Bool
pkgHashConfigureScriptArgs :: [String]
pkgHashFlagAssignment :: FlagAssignment
pkgHashPlatform :: Platform
pkgHashCompilerId :: CompilerId
pkgHashHaddockLib :: PackageHashConfigInputs -> Maybe String
pkgHashHaddockBaseUrl :: PackageHashConfigInputs -> Maybe String
pkgHashHaddockIndex :: PackageHashConfigInputs -> Maybe PathTemplate
pkgHashHaddockContents :: PackageHashConfigInputs -> Maybe PathTemplate
pkgHashHaddockQuickJump :: PackageHashConfigInputs -> Bool
pkgHashHaddockLinkedSource :: PackageHashConfigInputs -> Bool
pkgHashHaddockCss :: PackageHashConfigInputs -> Maybe String
pkgHashHaddockInternal :: PackageHashConfigInputs -> Bool
pkgHashHaddockBenchmarks :: PackageHashConfigInputs -> Bool
pkgHashHaddockTestSuites :: PackageHashConfigInputs -> Bool
pkgHashHaddockExecutables :: PackageHashConfigInputs -> Bool
pkgHashHaddockForeignLibs :: PackageHashConfigInputs -> Bool
pkgHashHaddockHtmlLocation :: PackageHashConfigInputs -> Maybe String
pkgHashHaddockHtml :: PackageHashConfigInputs -> Bool
pkgHashHaddockHoogle :: PackageHashConfigInputs -> Bool
pkgHashDocumentation :: PackageHashConfigInputs -> Bool
pkgHashPackageDbs :: PackageHashConfigInputs -> [Maybe PackageDB]
pkgHashProgSuffix :: PackageHashConfigInputs -> Maybe PathTemplate
pkgHashProgPrefix :: PackageHashConfigInputs -> Maybe PathTemplate
pkgHashExtraIncludeDirs :: PackageHashConfigInputs -> [String]
pkgHashExtraFrameworkDirs :: PackageHashConfigInputs -> [String]
pkgHashExtraLibDirsStatic :: PackageHashConfigInputs -> [String]
pkgHashExtraLibDirs :: PackageHashConfigInputs -> [String]
pkgHashProgramArgs :: PackageHashConfigInputs -> Map String [String]
pkgHashDebugInfo :: PackageHashConfigInputs -> DebugInfoLevel
pkgHashStripExes :: PackageHashConfigInputs -> Bool
pkgHashStripLibs :: PackageHashConfigInputs -> Bool
pkgHashSplitSections :: PackageHashConfigInputs -> Bool
pkgHashSplitObjs :: PackageHashConfigInputs -> Bool
pkgHashOptimization :: PackageHashConfigInputs -> OptimisationLevel
pkgHashCoverage :: PackageHashConfigInputs -> Bool
pkgHashProfExeDetail :: PackageHashConfigInputs -> ProfDetailLevel
pkgHashProfLibDetail :: PackageHashConfigInputs -> ProfDetailLevel
pkgHashProfExe :: PackageHashConfigInputs -> Bool
pkgHashProfLib :: PackageHashConfigInputs -> Bool
pkgHashGHCiLib :: PackageHashConfigInputs -> Bool
pkgHashFullyStaticExe :: PackageHashConfigInputs -> Bool
pkgHashDynExe :: PackageHashConfigInputs -> Bool
pkgHashSharedLib :: PackageHashConfigInputs -> Bool
pkgHashVanillaLib :: PackageHashConfigInputs -> Bool
pkgHashConfigureScriptArgs :: PackageHashConfigInputs -> [String]
pkgHashFlagAssignment :: PackageHashConfigInputs -> FlagAssignment
pkgHashPlatform :: PackageHashConfigInputs -> Platform
pkgHashCompilerId :: PackageHashConfigInputs -> CompilerId
..}
                        } =
    -- The purpose of this somewhat laboured rendering (e.g. why not just
    -- use show?) is so that existing package hashes do not change
    -- unnecessarily when new configuration inputs are added into the hash.

    -- In particular, the assumption is that when a new configuration input
    -- is included into the hash, that existing packages will typically get
    -- the default value for that feature. So if we avoid adding entries with
    -- the default value then most of the time adding new features will not
    -- change the hashes of existing packages and so fewer packages will need
    -- to be rebuilt.

    --TODO: [nice to have] ultimately we probably want to put this config info
    -- into the ghc-pkg db. At that point this should probably be changed to
    -- use the config file infrastructure so it can be read back in again.
    String -> ByteString
LBS.pack forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$
      [ forall {t}. String -> (t -> String) -> t -> Maybe String
entry String
"pkgid"       forall a. Pretty a => a -> String
prettyShow PackageId
pkgHashPkgId
      , forall {f :: * -> *} {t}.
Functor f =>
String -> (t -> String) -> f t -> f String
mentry String
"component"  forall a. Show a => a -> String
show Maybe Component
pkgHashComponent
      , forall {t}. String -> (t -> String) -> t -> Maybe String
entry String
"src"         HashValue -> String
showHashValue HashValue
pkgHashSourceHash
      , forall {t}. String -> (t -> String) -> t -> Maybe String
entry String
"pkg-config-deps"
                            (forall a. [a] -> [[a]] -> [a]
intercalate String
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(PkgconfigName
pn, Maybe PkgconfigVersion
mb_v) -> forall a. Pretty a => a -> String
prettyShow PkgconfigName
pn forall a. [a] -> [a] -> [a]
++
                                                    case Maybe PkgconfigVersion
mb_v of
                                                        Maybe PkgconfigVersion
Nothing -> String
""
                                                        Just PkgconfigVersion
v -> String
" " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow PkgconfigVersion
v)
                                              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toList) Set (PkgconfigName, Maybe PkgconfigVersion)
pkgHashPkgConfigDeps
      , forall {t}. String -> (t -> String) -> t -> Maybe String
entry String
"deps"        (forall a. [a] -> [[a]] -> [a]
intercalate String
", " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> String
prettyShow
                                              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toList) Set InstalledPackageId
pkgHashDirectDeps
        -- and then all the config
      , forall {t}. String -> (t -> String) -> t -> Maybe String
entry String
"compilerid"  forall a. Pretty a => a -> String
prettyShow CompilerId
pkgHashCompilerId
      , forall {t}. String -> (t -> String) -> t -> Maybe String
entry String
"platform" forall a. Pretty a => a -> String
prettyShow Platform
pkgHashPlatform
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"flags" forall a. Monoid a => a
mempty FlagAssignment -> String
showFlagAssignment FlagAssignment
pkgHashFlagAssignment
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"configure-script" [] [String] -> String
unwords [String]
pkgHashConfigureScriptArgs
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"vanilla-lib" Bool
True  forall a. Pretty a => a -> String
prettyShow Bool
pkgHashVanillaLib
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"shared-lib"  Bool
False forall a. Pretty a => a -> String
prettyShow Bool
pkgHashSharedLib
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"dynamic-exe" Bool
False forall a. Pretty a => a -> String
prettyShow Bool
pkgHashDynExe
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"fully-static-exe" Bool
False forall a. Pretty a => a -> String
prettyShow Bool
pkgHashFullyStaticExe
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"ghci-lib"    Bool
False forall a. Pretty a => a -> String
prettyShow Bool
pkgHashGHCiLib
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"prof-lib"    Bool
False forall a. Pretty a => a -> String
prettyShow Bool
pkgHashProfLib
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"prof-exe"    Bool
False forall a. Pretty a => a -> String
prettyShow Bool
pkgHashProfExe
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"prof-lib-detail" ProfDetailLevel
ProfDetailDefault ProfDetailLevel -> String
showProfDetailLevel ProfDetailLevel
pkgHashProfLibDetail
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"prof-exe-detail" ProfDetailLevel
ProfDetailDefault ProfDetailLevel -> String
showProfDetailLevel ProfDetailLevel
pkgHashProfExeDetail
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"hpc"          Bool
False forall a. Pretty a => a -> String
prettyShow Bool
pkgHashCoverage
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"optimisation" OptimisationLevel
NormalOptimisation (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum) OptimisationLevel
pkgHashOptimization
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"split-objs"   Bool
False forall a. Pretty a => a -> String
prettyShow Bool
pkgHashSplitObjs
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"split-sections" Bool
False forall a. Pretty a => a -> String
prettyShow Bool
pkgHashSplitSections
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"stripped-lib" Bool
False forall a. Pretty a => a -> String
prettyShow Bool
pkgHashStripLibs
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"stripped-exe" Bool
True  forall a. Pretty a => a -> String
prettyShow Bool
pkgHashStripExes
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"debug-info"   DebugInfoLevel
NormalDebugInfo (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum) DebugInfoLevel
pkgHashDebugInfo
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"extra-lib-dirs"     [] [String] -> String
unwords [String]
pkgHashExtraLibDirs
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"extra-lib-dirs-static" [] [String] -> String
unwords [String]
pkgHashExtraLibDirsStatic
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"extra-framework-dirs" [] [String] -> String
unwords [String]
pkgHashExtraFrameworkDirs
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"extra-include-dirs" [] [String] -> String
unwords [String]
pkgHashExtraIncludeDirs
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"prog-prefix" forall a. Maybe a
Nothing (forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" PathTemplate -> String
fromPathTemplate) Maybe PathTemplate
pkgHashProgPrefix
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"prog-suffix" forall a. Maybe a
Nothing (forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" PathTemplate -> String
fromPathTemplate) Maybe PathTemplate
pkgHashProgSuffix
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"package-dbs" [] ([String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show) [Maybe PackageDB]
pkgHashPackageDbs

      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"documentation"  Bool
False forall a. Pretty a => a -> String
prettyShow Bool
pkgHashDocumentation
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"haddock-hoogle" Bool
False forall a. Pretty a => a -> String
prettyShow Bool
pkgHashHaddockHoogle
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"haddock-html"   Bool
False forall a. Pretty a => a -> String
prettyShow Bool
pkgHashHaddockHtml
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"haddock-html-location" forall a. Maybe a
Nothing (forall a. a -> Maybe a -> a
fromMaybe String
"") Maybe String
pkgHashHaddockHtmlLocation
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"haddock-foreign-libraries" Bool
False forall a. Pretty a => a -> String
prettyShow Bool
pkgHashHaddockForeignLibs
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"haddock-executables" Bool
False forall a. Pretty a => a -> String
prettyShow Bool
pkgHashHaddockExecutables
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"haddock-tests" Bool
False forall a. Pretty a => a -> String
prettyShow Bool
pkgHashHaddockTestSuites
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"haddock-benchmarks" Bool
False forall a. Pretty a => a -> String
prettyShow Bool
pkgHashHaddockBenchmarks
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"haddock-internal" Bool
False forall a. Pretty a => a -> String
prettyShow Bool
pkgHashHaddockInternal
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"haddock-css" forall a. Maybe a
Nothing (forall a. a -> Maybe a -> a
fromMaybe String
"") Maybe String
pkgHashHaddockCss
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"haddock-hyperlink-source" Bool
False forall a. Pretty a => a -> String
prettyShow Bool
pkgHashHaddockLinkedSource
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"haddock-quickjump" Bool
False forall a. Pretty a => a -> String
prettyShow Bool
pkgHashHaddockQuickJump
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"haddock-contents-location" forall a. Maybe a
Nothing (forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" PathTemplate -> String
fromPathTemplate) Maybe PathTemplate
pkgHashHaddockContents
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"haddock-index-location" forall a. Maybe a
Nothing (forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" PathTemplate -> String
fromPathTemplate) Maybe PathTemplate
pkgHashHaddockIndex
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"haddock-base-url" forall a. Maybe a
Nothing (forall a. a -> Maybe a -> a
fromMaybe String
"") Maybe String
pkgHashHaddockBaseUrl
      , forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt   String
"haddock-lib" forall a. Maybe a
Nothing (forall a. a -> Maybe a -> a
fromMaybe String
"") Maybe String
pkgHashHaddockLib

      ] forall a. [a] -> [a] -> [a]
++ forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey (\String
prog [String]
args [Maybe String]
acc -> forall {t}.
Eq t =>
String -> t -> (t -> String) -> t -> Maybe String
opt (String
prog forall a. [a] -> [a] -> [a]
++ String
"-options") [] [String] -> String
unwords [String]
args forall a. a -> [a] -> [a]
: [Maybe String]
acc) [] Map String [String]
pkgHashProgramArgs
  where
    entry :: String -> (t -> String) -> t -> Maybe String
entry String
key     t -> String
format t
value = forall a. a -> Maybe a
Just (String
key forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ t -> String
format t
value)
    mentry :: String -> (t -> String) -> f t -> f String
mentry String
key    t -> String
format f t
value = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\t
v -> String
key forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ t -> String
format t
v) f t
value
    opt :: String -> t -> (t -> String) -> t -> Maybe String
opt   String
key t
def t -> String
format t
value
         | t
value forall a. Eq a => a -> a -> Bool
== t
def = forall a. Maybe a
Nothing
         | Bool
otherwise    = forall {t}. String -> (t -> String) -> t -> Maybe String
entry String
key t -> String
format t
value