{-# LANGUAGE BangPatterns, RecordWildCards, NamedFieldPuns,
DeriveGeneric, DeriveDataTypeable, GeneralizedNewtypeDeriving,
ScopedTypeVariables #-}
module Distribution.Client.ProjectPlanOutput (
writePlanExternalRepresentation,
PostBuildProjectStatus(..),
updatePostBuildProjectStatus,
createPackageEnvironment,
writePlanGhcEnvironment,
argsEquivalentOfGhcEnvironmentFile,
) where
import Distribution.Client.ProjectPlanning.Types
import Distribution.Client.ProjectBuilding.Types
import Distribution.Client.DistDirLayout
import Distribution.Client.Types.Repo (Repo(..), RemoteRepo(..))
import Distribution.Client.Types.PackageLocation (PackageLocation(..))
import Distribution.Client.Types.ConfiguredId (confInstId)
import Distribution.Client.Types.SourceRepo (SourceRepoMaybe, SourceRepositoryPackage (..))
import Distribution.Client.HashValue (showHashValue, hashValue)
import Distribution.Client.Version (cabalInstallVersion)
import qualified Distribution.Client.InstallPlan as InstallPlan
import qualified Distribution.Client.Utils.Json as J
import qualified Distribution.Simple.InstallDirs as InstallDirs
import qualified Distribution.Solver.Types.ComponentDeps as ComponentDeps
import Distribution.Package
import Distribution.System
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import qualified Distribution.PackageDescription as PD
import Distribution.Compiler (CompilerFlavor(GHC, GHCJS))
import Distribution.Simple.Compiler
( PackageDBStack, PackageDB(..)
, compilerVersion, compilerFlavor, showCompilerId
, compilerId, CompilerId(..), Compiler )
import Distribution.Simple.GHC
( getImplInfo, GhcImplInfo(supportsPkgEnvFiles)
, GhcEnvironmentFileEntry(..), simpleGhcEnvironmentFile
, writeGhcEnvironmentFile )
import Distribution.Simple.BuildPaths
( dllExtension, exeExtension, buildInfoPref )
import qualified Distribution.Compat.Graph as Graph
import Distribution.Compat.Graph (Graph, Node)
import qualified Distribution.Compat.Binary as Binary
import Distribution.Simple.Utils
import Distribution.Types.Version
( mkVersion )
import Distribution.Verbosity
import Prelude ()
import Distribution.Client.Compat.Prelude
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Lazy as BS
import qualified Data.ByteString.Builder as BB
import System.FilePath
import System.IO
import Distribution.Simple.Program.GHC (packageDbArgsDb)
writePlanExternalRepresentation :: DistDirLayout
-> ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> IO ()
writePlanExternalRepresentation :: DistDirLayout
-> ElaboratedInstallPlan -> ElaboratedSharedConfig -> IO ()
writePlanExternalRepresentation DistDirLayout
distDirLayout ElaboratedInstallPlan
elaboratedInstallPlan
ElaboratedSharedConfig
elaboratedSharedConfig =
FilePath -> ByteString -> IO ()
writeFileAtomic (DistDirLayout -> FilePath -> FilePath
distProjectCacheFile DistDirLayout
distDirLayout FilePath
"plan.json") (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$
Builder -> ByteString
BB.toLazyByteString
(Builder -> ByteString)
-> (Value -> Builder) -> Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Builder
forall a. ToJSON a => a -> Builder
J.encodeToBuilder
(Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ DistDirLayout
-> ElaboratedInstallPlan -> ElaboratedSharedConfig -> Value
encodePlanAsJson DistDirLayout
distDirLayout ElaboratedInstallPlan
elaboratedInstallPlan ElaboratedSharedConfig
elaboratedSharedConfig
encodePlanAsJson :: DistDirLayout -> ElaboratedInstallPlan -> ElaboratedSharedConfig -> J.Value
encodePlanAsJson :: DistDirLayout
-> ElaboratedInstallPlan -> ElaboratedSharedConfig -> Value
encodePlanAsJson DistDirLayout
distDirLayout ElaboratedInstallPlan
elaboratedInstallPlan ElaboratedSharedConfig
elaboratedSharedConfig =
[Pair] -> Value
J.object [ FilePath
"cabal-version" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= Version -> Value
forall a. Pretty a => a -> Value
jdisplay Version
cabalInstallVersion
, FilePath
"cabal-lib-version" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= Version -> Value
forall a. Pretty a => a -> Value
jdisplay Version
cabalVersion
, FilePath
"compiler-id" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= (FilePath -> Value
J.String (FilePath -> Value)
-> (ElaboratedSharedConfig -> FilePath)
-> ElaboratedSharedConfig
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compiler -> FilePath
showCompilerId (Compiler -> FilePath)
-> (ElaboratedSharedConfig -> Compiler)
-> ElaboratedSharedConfig
-> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedSharedConfig -> Compiler
pkgConfigCompiler)
ElaboratedSharedConfig
elaboratedSharedConfig
, FilePath
"os" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= OS -> Value
forall a. Pretty a => a -> Value
jdisplay OS
os
, FilePath
"arch" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= Arch -> Value
forall a. Pretty a => a -> Value
jdisplay Arch
arch
, FilePath
"install-plan" FilePath -> [Value] -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= ElaboratedInstallPlan -> [Value]
installPlanToJ ElaboratedInstallPlan
elaboratedInstallPlan
]
where
plat :: Platform
plat :: Platform
plat@(Platform Arch
arch OS
os) = ElaboratedSharedConfig -> Platform
pkgConfigPlatform ElaboratedSharedConfig
elaboratedSharedConfig
installPlanToJ :: ElaboratedInstallPlan -> [J.Value]
installPlanToJ :: ElaboratedInstallPlan -> [Value]
installPlanToJ = (ElaboratedPlanPackage -> Value)
-> [ElaboratedPlanPackage] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ElaboratedPlanPackage -> Value
planPackageToJ ([ElaboratedPlanPackage] -> [Value])
-> (ElaboratedInstallPlan -> [ElaboratedPlanPackage])
-> ElaboratedInstallPlan
-> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedInstallPlan -> [ElaboratedPlanPackage]
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.toList
planPackageToJ :: ElaboratedPlanPackage -> J.Value
planPackageToJ :: ElaboratedPlanPackage -> Value
planPackageToJ ElaboratedPlanPackage
pkg =
case ElaboratedPlanPackage
pkg of
InstallPlan.PreExisting InstalledPackageInfo
ipi -> InstalledPackageInfo -> Value
installedPackageInfoToJ InstalledPackageInfo
ipi
InstallPlan.Configured ElaboratedConfiguredPackage
elab -> Bool -> ElaboratedConfiguredPackage -> Value
elaboratedPackageToJ Bool
False ElaboratedConfiguredPackage
elab
InstallPlan.Installed ElaboratedConfiguredPackage
elab -> Bool -> ElaboratedConfiguredPackage -> Value
elaboratedPackageToJ Bool
True ElaboratedConfiguredPackage
elab
installedPackageInfoToJ :: InstalledPackageInfo -> J.Value
installedPackageInfoToJ :: InstalledPackageInfo -> Value
installedPackageInfoToJ InstalledPackageInfo
ipi =
[Pair] -> Value
J.object
[ FilePath
"type" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= FilePath -> Value
J.String FilePath
"pre-existing"
, FilePath
"id" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= (UnitId -> Value
forall a. Pretty a => a -> Value
jdisplay (UnitId -> Value)
-> (InstalledPackageInfo -> UnitId)
-> InstalledPackageInfo
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageInfo -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId) InstalledPackageInfo
ipi
, FilePath
"pkg-name" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= (PackageName -> Value
forall a. Pretty a => a -> Value
jdisplay (PackageName -> Value)
-> (InstalledPackageInfo -> PackageName)
-> InstalledPackageInfo
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> PackageName
pkgName (PackageIdentifier -> PackageName)
-> (InstalledPackageInfo -> PackageIdentifier)
-> InstalledPackageInfo
-> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageInfo -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId) InstalledPackageInfo
ipi
, FilePath
"pkg-version" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= (Version -> Value
forall a. Pretty a => a -> Value
jdisplay (Version -> Value)
-> (InstalledPackageInfo -> Version)
-> InstalledPackageInfo
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> Version
pkgVersion (PackageIdentifier -> Version)
-> (InstalledPackageInfo -> PackageIdentifier)
-> InstalledPackageInfo
-> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageInfo -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId) InstalledPackageInfo
ipi
, FilePath
"depends" FilePath -> [Value] -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= (UnitId -> Value) -> [UnitId] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map UnitId -> Value
forall a. Pretty a => a -> Value
jdisplay (InstalledPackageInfo -> [UnitId]
forall pkg. PackageInstalled pkg => pkg -> [UnitId]
installedDepends InstalledPackageInfo
ipi)
]
elaboratedPackageToJ :: Bool -> ElaboratedConfiguredPackage -> J.Value
elaboratedPackageToJ :: Bool -> ElaboratedConfiguredPackage -> Value
elaboratedPackageToJ Bool
isInstalled ElaboratedConfiguredPackage
elab =
[Pair] -> Value
J.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
[ FilePath
"type" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= FilePath -> Value
J.String (if Bool
isInstalled then FilePath
"installed"
else FilePath
"configured")
, FilePath
"id" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= (UnitId -> Value
forall a. Pretty a => a -> Value
jdisplay (UnitId -> Value)
-> (ElaboratedConfiguredPackage -> UnitId)
-> ElaboratedConfiguredPackage
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedConfiguredPackage -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId) ElaboratedConfiguredPackage
elab
, FilePath
"pkg-name" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= (PackageName -> Value
forall a. Pretty a => a -> Value
jdisplay (PackageName -> Value)
-> (ElaboratedConfiguredPackage -> PackageName)
-> ElaboratedConfiguredPackage
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> PackageName
pkgName (PackageIdentifier -> PackageName)
-> (ElaboratedConfiguredPackage -> PackageIdentifier)
-> ElaboratedConfiguredPackage
-> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedConfiguredPackage -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId) ElaboratedConfiguredPackage
elab
, FilePath
"pkg-version" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= (Version -> Value
forall a. Pretty a => a -> Value
jdisplay (Version -> Value)
-> (ElaboratedConfiguredPackage -> Version)
-> ElaboratedConfiguredPackage
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> Version
pkgVersion (PackageIdentifier -> Version)
-> (ElaboratedConfiguredPackage -> PackageIdentifier)
-> ElaboratedConfiguredPackage
-> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedConfiguredPackage -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId) ElaboratedConfiguredPackage
elab
, FilePath
"flags" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= [Pair] -> Value
J.object [ FlagName -> FilePath
PD.unFlagName FlagName
fn FilePath -> Bool -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= Bool
v
| (FlagName
fn,Bool
v) <- FlagAssignment -> [(FlagName, Bool)]
PD.unFlagAssignment (ElaboratedConfiguredPackage -> FlagAssignment
elabFlagAssignment ElaboratedConfiguredPackage
elab) ]
, FilePath
"style" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= FilePath -> Value
J.String (Bool -> BuildStyle -> FilePath
style2str (ElaboratedConfiguredPackage -> Bool
elabLocalToProject ElaboratedConfiguredPackage
elab) (ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
elab))
, FilePath
"pkg-src" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= PackageLocation (Maybe FilePath) -> Value
packageLocationToJ (ElaboratedConfiguredPackage -> PackageLocation (Maybe FilePath)
elabPkgSourceLocation ElaboratedConfiguredPackage
elab)
] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
[ FilePath
"pkg-cabal-sha256" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= FilePath -> Value
J.String (HashValue -> FilePath
showHashValue HashValue
hash)
| Just HashValue
hash <- [ (ByteString -> HashValue) -> Maybe ByteString -> Maybe HashValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> HashValue
hashValue (ElaboratedConfiguredPackage -> Maybe ByteString
elabPkgDescriptionOverride ElaboratedConfiguredPackage
elab) ] ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
[ FilePath
"pkg-src-sha256" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= FilePath -> Value
J.String (HashValue -> FilePath
showHashValue HashValue
hash)
| Just HashValue
hash <- [ElaboratedConfiguredPackage -> Maybe HashValue
elabPkgSourceHash ElaboratedConfiguredPackage
elab] ] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
(case ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
elab of
BuildStyle
BuildInplaceOnly ->
[FilePath
"dist-dir" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= FilePath -> Value
J.String FilePath
dist_dir] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair
buildInfoFileLocation]
BuildStyle
BuildAndInstall ->
[]
) [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
case ElaboratedConfiguredPackage -> ElaboratedPackageOrComponent
elabPkgOrComp ElaboratedConfiguredPackage
elab of
ElabPackage ElaboratedPackage
pkg ->
let components :: Value
components = [Pair] -> Value
J.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
[ Component -> FilePath
comp2str Component
c FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= ([Pair] -> Value
J.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
[ FilePath
"depends" FilePath -> [Value] -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= (ConfiguredId -> Value) -> [ConfiguredId] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (ComponentId -> Value
forall a. Pretty a => a -> Value
jdisplay (ComponentId -> Value)
-> (ConfiguredId -> ComponentId) -> ConfiguredId -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfiguredId -> ComponentId
confInstId) [ConfiguredId]
ldeps
, FilePath
"exe-depends" FilePath -> [Value] -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= (ConfiguredId -> Value) -> [ConfiguredId] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (ComponentId -> Value
forall a. Pretty a => a -> Value
jdisplay (ComponentId -> Value)
-> (ConfiguredId -> ComponentId) -> ConfiguredId -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfiguredId -> ComponentId
confInstId) [ConfiguredId]
edeps
] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
Component -> [Pair]
bin_file Component
c)
| (Component
c,([ConfiguredId]
ldeps,[ConfiguredId]
edeps))
<- ComponentDeps ([ConfiguredId], [ConfiguredId])
-> [(Component, ([ConfiguredId], [ConfiguredId]))]
forall a. ComponentDeps a -> [ComponentDep a]
ComponentDeps.toList (ComponentDeps ([ConfiguredId], [ConfiguredId])
-> [(Component, ([ConfiguredId], [ConfiguredId]))])
-> ComponentDeps ([ConfiguredId], [ConfiguredId])
-> [(Component, ([ConfiguredId], [ConfiguredId]))]
forall a b. (a -> b) -> a -> b
$
ComponentDeps [ConfiguredId]
-> ComponentDeps [ConfiguredId]
-> ComponentDeps ([ConfiguredId], [ConfiguredId])
forall a b.
(Monoid a, Monoid b) =>
ComponentDeps a -> ComponentDeps b -> ComponentDeps (a, b)
ComponentDeps.zip (ElaboratedPackage -> ComponentDeps [ConfiguredId]
pkgLibDependencies ElaboratedPackage
pkg)
(ElaboratedPackage -> ComponentDeps [ConfiguredId]
pkgExeDependencies ElaboratedPackage
pkg) ]
in [FilePath
"components" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= Value
components]
ElabComponent ElaboratedComponent
comp ->
[FilePath
"depends" FilePath -> [Value] -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= (ConfiguredId -> Value) -> [ConfiguredId] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (ComponentId -> Value
forall a. Pretty a => a -> Value
jdisplay (ComponentId -> Value)
-> (ConfiguredId -> ComponentId) -> ConfiguredId -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfiguredId -> ComponentId
confInstId) (ElaboratedConfiguredPackage -> [ConfiguredId]
elabLibDependencies ElaboratedConfiguredPackage
elab)
,FilePath
"exe-depends" FilePath -> [Value] -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= (ComponentId -> Value) -> [ComponentId] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ComponentId -> Value
forall a. Pretty a => a -> Value
jdisplay (ElaboratedConfiguredPackage -> [ComponentId]
elabExeDependencies ElaboratedConfiguredPackage
elab)
,FilePath
"component-name" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= FilePath -> Value
J.String (Component -> FilePath
comp2str (ElaboratedComponent -> Component
compSolverName ElaboratedComponent
comp))
] [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++
Component -> [Pair]
bin_file (ElaboratedComponent -> Component
compSolverName ElaboratedComponent
comp)
where
buildInfoFileLocation :: J.Pair
buildInfoFileLocation :: Pair
buildInfoFileLocation
| ElaboratedConfiguredPackage -> Version
elabSetupScriptCliVersion ElaboratedConfiguredPackage
elab Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
3, Int
7, Int
0, Int
0]
= FilePath
"build-info" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= Value
J.Null
| Bool
otherwise
= FilePath
"build-info" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= FilePath -> Value
J.String (FilePath -> FilePath
buildInfoPref FilePath
dist_dir)
packageLocationToJ :: PackageLocation (Maybe FilePath) -> J.Value
packageLocationToJ :: PackageLocation (Maybe FilePath) -> Value
packageLocationToJ PackageLocation (Maybe FilePath)
pkgloc =
case PackageLocation (Maybe FilePath)
pkgloc of
LocalUnpackedPackage FilePath
local ->
[Pair] -> Value
J.object [ FilePath
"type" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= FilePath -> Value
J.String FilePath
"local"
, FilePath
"path" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= FilePath -> Value
J.String FilePath
local
]
LocalTarballPackage FilePath
local ->
[Pair] -> Value
J.object [ FilePath
"type" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= FilePath -> Value
J.String FilePath
"local-tar"
, FilePath
"path" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= FilePath -> Value
J.String FilePath
local
]
RemoteTarballPackage URI
uri Maybe FilePath
_ ->
[Pair] -> Value
J.object [ FilePath
"type" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= FilePath -> Value
J.String FilePath
"remote-tar"
, FilePath
"uri" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= FilePath -> Value
J.String (URI -> FilePath
forall a. Show a => a -> FilePath
show URI
uri)
]
RepoTarballPackage Repo
repo PackageIdentifier
_ Maybe FilePath
_ ->
[Pair] -> Value
J.object [ FilePath
"type" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= FilePath -> Value
J.String FilePath
"repo-tar"
, FilePath
"repo" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= Repo -> Value
repoToJ Repo
repo
]
RemoteSourceRepoPackage SourceRepoMaybe
srcRepo Maybe FilePath
_ ->
[Pair] -> Value
J.object [ FilePath
"type" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= FilePath -> Value
J.String FilePath
"source-repo"
, FilePath
"source-repo" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= SourceRepoMaybe -> Value
sourceRepoToJ SourceRepoMaybe
srcRepo
]
repoToJ :: Repo -> J.Value
repoToJ :: Repo -> Value
repoToJ Repo
repo =
case Repo
repo of
RepoLocalNoIndex{FilePath
LocalRepo
repoLocalDir :: Repo -> FilePath
repoLocal :: Repo -> LocalRepo
repoLocalDir :: FilePath
repoLocal :: LocalRepo
..} ->
[Pair] -> Value
J.object [ FilePath
"type" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= FilePath -> Value
J.String FilePath
"local-repo-no-index"
, FilePath
"path" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= FilePath -> Value
J.String FilePath
repoLocalDir
]
RepoRemote{FilePath
RemoteRepo
repoRemote :: Repo -> RemoteRepo
repoLocalDir :: FilePath
repoRemote :: RemoteRepo
repoLocalDir :: Repo -> FilePath
..} ->
[Pair] -> Value
J.object [ FilePath
"type" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= FilePath -> Value
J.String FilePath
"remote-repo"
, FilePath
"uri" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= FilePath -> Value
J.String (URI -> FilePath
forall a. Show a => a -> FilePath
show (RemoteRepo -> URI
remoteRepoURI RemoteRepo
repoRemote))
]
RepoSecure{FilePath
RemoteRepo
repoLocalDir :: FilePath
repoRemote :: RemoteRepo
repoRemote :: Repo -> RemoteRepo
repoLocalDir :: Repo -> FilePath
..} ->
[Pair] -> Value
J.object [ FilePath
"type" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= FilePath -> Value
J.String FilePath
"secure-repo"
, FilePath
"uri" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= FilePath -> Value
J.String (URI -> FilePath
forall a. Show a => a -> FilePath
show (RemoteRepo -> URI
remoteRepoURI RemoteRepo
repoRemote))
]
sourceRepoToJ :: SourceRepoMaybe -> J.Value
sourceRepoToJ :: SourceRepoMaybe -> Value
sourceRepoToJ SourceRepositoryPackage{FilePath
[FilePath]
Maybe FilePath
RepoType
srpCommand :: forall (f :: * -> *). SourceRepositoryPackage f -> [FilePath]
srpSubdir :: forall (f :: * -> *). SourceRepositoryPackage f -> f FilePath
srpBranch :: forall (f :: * -> *). SourceRepositoryPackage f -> Maybe FilePath
srpTag :: forall (f :: * -> *). SourceRepositoryPackage f -> Maybe FilePath
srpLocation :: forall (f :: * -> *). SourceRepositoryPackage f -> FilePath
srpType :: forall (f :: * -> *). SourceRepositoryPackage f -> RepoType
srpCommand :: [FilePath]
srpSubdir :: Maybe FilePath
srpBranch :: Maybe FilePath
srpTag :: Maybe FilePath
srpLocation :: FilePath
srpType :: RepoType
..} =
[Pair] -> Value
J.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (Pair -> Bool) -> [Pair] -> [Pair]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value
J.Null) (Value -> Bool) -> (Pair -> Value) -> Pair -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pair -> Value
forall a b. (a, b) -> b
snd) ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall a b. (a -> b) -> a -> b
$
[ FilePath
"type" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= RepoType -> Value
forall a. Pretty a => a -> Value
jdisplay RepoType
srpType
, FilePath
"location" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= FilePath -> Value
J.String FilePath
srpLocation
, FilePath
"branch" FilePath -> Maybe Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= (FilePath -> Value) -> Maybe FilePath -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Value
J.String Maybe FilePath
srpBranch
, FilePath
"tag" FilePath -> Maybe Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= (FilePath -> Value) -> Maybe FilePath -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Value
J.String Maybe FilePath
srpTag
, FilePath
"subdir" FilePath -> Maybe Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= (FilePath -> Value) -> Maybe FilePath -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Value
J.String Maybe FilePath
srpSubdir
]
dist_dir :: FilePath
dist_dir :: FilePath
dist_dir = DistDirLayout -> DistDirParams -> FilePath
distBuildDirectory DistDirLayout
distDirLayout
(ElaboratedSharedConfig
-> ElaboratedConfiguredPackage -> DistDirParams
elabDistDirParams ElaboratedSharedConfig
elaboratedSharedConfig ElaboratedConfiguredPackage
elab)
bin_file :: ComponentDeps.Component -> [J.Pair]
bin_file :: Component -> [Pair]
bin_file Component
c = case Component
c of
ComponentDeps.ComponentExe UnqualComponentName
s -> UnqualComponentName -> [Pair]
forall a. Pretty a => a -> [Pair]
bin_file' UnqualComponentName
s
ComponentDeps.ComponentTest UnqualComponentName
s -> UnqualComponentName -> [Pair]
forall a. Pretty a => a -> [Pair]
bin_file' UnqualComponentName
s
ComponentDeps.ComponentBench UnqualComponentName
s -> UnqualComponentName -> [Pair]
forall a. Pretty a => a -> [Pair]
bin_file' UnqualComponentName
s
ComponentDeps.ComponentFLib UnqualComponentName
s -> UnqualComponentName -> [Pair]
forall a. (Pretty a, Show a) => a -> [Pair]
flib_file' UnqualComponentName
s
Component
_ -> []
bin_file' :: a -> [Pair]
bin_file' a
s =
[FilePath
"bin-file" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= FilePath -> Value
J.String FilePath
bin]
where
bin :: FilePath
bin = if ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
elab BuildStyle -> BuildStyle -> Bool
forall a. Eq a => a -> a -> Bool
== BuildStyle
BuildInplaceOnly
then FilePath
dist_dir FilePath -> FilePath -> FilePath
</> FilePath
"build" FilePath -> FilePath -> FilePath
</> a -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow a
s FilePath -> FilePath -> FilePath
</> a -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow a
s FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
exeExtension Platform
plat
else InstallDirs FilePath -> FilePath
forall dir. InstallDirs dir -> dir
InstallDirs.bindir (ElaboratedConfiguredPackage -> InstallDirs FilePath
elabInstallDirs ElaboratedConfiguredPackage
elab) FilePath -> FilePath -> FilePath
</> a -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow a
s FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
exeExtension Platform
plat
flib_file' :: (Pretty a, Show a) => a -> [J.Pair]
flib_file' :: a -> [Pair]
flib_file' a
s =
[FilePath
"bin-file" FilePath -> Value -> Pair
forall v. ToJSON v => FilePath -> v -> Pair
J..= FilePath -> Value
J.String FilePath
bin]
where
bin :: FilePath
bin = if ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
elab BuildStyle -> BuildStyle -> Bool
forall a. Eq a => a -> a -> Bool
== BuildStyle
BuildInplaceOnly
then FilePath
dist_dir FilePath -> FilePath -> FilePath
</> FilePath
"build" FilePath -> FilePath -> FilePath
</> a -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow a
s FilePath -> FilePath -> FilePath
</> (FilePath
"lib" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow a
s) FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
dllExtension Platform
plat
else InstallDirs FilePath -> FilePath
forall dir. InstallDirs dir -> dir
InstallDirs.bindir (ElaboratedConfiguredPackage -> InstallDirs FilePath
elabInstallDirs ElaboratedConfiguredPackage
elab) FilePath -> FilePath -> FilePath
</> (FilePath
"lib" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ a -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow a
s) FilePath -> FilePath -> FilePath
<.> Platform -> FilePath
dllExtension Platform
plat
comp2str :: ComponentDeps.Component -> String
comp2str :: Component -> FilePath
comp2str = Component -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow
style2str :: Bool -> BuildStyle -> String
style2str :: Bool -> BuildStyle -> FilePath
style2str Bool
True BuildStyle
_ = FilePath
"local"
style2str Bool
False BuildStyle
BuildInplaceOnly = FilePath
"inplace"
style2str Bool
False BuildStyle
BuildAndInstall = FilePath
"global"
jdisplay :: Pretty a => a -> J.Value
jdisplay :: a -> Value
jdisplay = FilePath -> Value
J.String (FilePath -> Value) -> (a -> FilePath) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow
type PackageIdSet = Set UnitId
type PackagesUpToDate = PackageIdSet
data PostBuildProjectStatus = PostBuildProjectStatus {
PostBuildProjectStatus -> PackageIdSet
packagesDefinitelyUpToDate :: PackageIdSet,
PostBuildProjectStatus -> PackageIdSet
packagesProbablyUpToDate :: PackageIdSet,
PostBuildProjectStatus -> PackageIdSet
packagesOutOfDate :: PackageIdSet,
PostBuildProjectStatus -> PackageIdSet
packagesInvalidByChangedLibDeps :: PackageIdSet,
PostBuildProjectStatus -> PackageIdSet
packagesInvalidByFailedBuild :: PackageIdSet,
PostBuildProjectStatus -> Graph (Node UnitId ElaboratedPlanPackage)
packagesLibDepGraph :: Graph (Node UnitId ElaboratedPlanPackage),
PostBuildProjectStatus -> PackageIdSet
packagesBuildLocal :: PackageIdSet,
PostBuildProjectStatus -> PackageIdSet
packagesBuildInplace :: PackageIdSet,
PostBuildProjectStatus -> PackageIdSet
packagesAlreadyInStore :: PackageIdSet
}
postBuildProjectStatus :: ElaboratedInstallPlan
-> PackagesUpToDate
-> BuildStatusMap
-> BuildOutcomes
-> PostBuildProjectStatus
postBuildProjectStatus :: ElaboratedInstallPlan
-> PackageIdSet
-> BuildStatusMap
-> BuildOutcomes
-> PostBuildProjectStatus
postBuildProjectStatus ElaboratedInstallPlan
plan PackageIdSet
previousPackagesUpToDate
BuildStatusMap
pkgBuildStatus BuildOutcomes
buildOutcomes =
PostBuildProjectStatus :: PackageIdSet
-> PackageIdSet
-> PackageIdSet
-> PackageIdSet
-> PackageIdSet
-> Graph (Node UnitId ElaboratedPlanPackage)
-> PackageIdSet
-> PackageIdSet
-> PackageIdSet
-> PostBuildProjectStatus
PostBuildProjectStatus {
PackageIdSet
packagesDefinitelyUpToDate :: PackageIdSet
packagesDefinitelyUpToDate :: PackageIdSet
packagesDefinitelyUpToDate,
PackageIdSet
packagesProbablyUpToDate :: PackageIdSet
packagesProbablyUpToDate :: PackageIdSet
packagesProbablyUpToDate,
PackageIdSet
packagesOutOfDate :: PackageIdSet
packagesOutOfDate :: PackageIdSet
packagesOutOfDate,
PackageIdSet
packagesInvalidByChangedLibDeps :: PackageIdSet
packagesInvalidByChangedLibDeps :: PackageIdSet
packagesInvalidByChangedLibDeps,
PackageIdSet
packagesInvalidByFailedBuild :: PackageIdSet
packagesInvalidByFailedBuild :: PackageIdSet
packagesInvalidByFailedBuild,
Graph (Node UnitId ElaboratedPlanPackage)
packagesLibDepGraph :: Graph (Node UnitId ElaboratedPlanPackage)
packagesLibDepGraph :: Graph (Node UnitId ElaboratedPlanPackage)
packagesLibDepGraph,
PackageIdSet
packagesBuildLocal :: PackageIdSet
packagesBuildLocal :: PackageIdSet
packagesBuildLocal,
PackageIdSet
packagesBuildInplace :: PackageIdSet
packagesBuildInplace :: PackageIdSet
packagesBuildInplace,
PackageIdSet
packagesAlreadyInStore :: PackageIdSet
packagesAlreadyInStore :: PackageIdSet
packagesAlreadyInStore
}
where
packagesDefinitelyUpToDate :: PackageIdSet
packagesDefinitelyUpToDate =
PackageIdSet
packagesUpToDatePreBuild
PackageIdSet -> PackageIdSet -> PackageIdSet
forall a. Ord a => Set a -> Set a -> Set a
`Set.union`
PackageIdSet
packagesSuccessfulPostBuild
packagesProbablyUpToDate :: PackageIdSet
packagesProbablyUpToDate =
PackageIdSet
packagesDefinitelyUpToDate
PackageIdSet -> PackageIdSet -> PackageIdSet
forall a. Ord a => Set a -> Set a -> Set a
`Set.union`
(PackageIdSet
previousPackagesUpToDate' PackageIdSet -> PackageIdSet -> PackageIdSet
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` PackageIdSet
packagesOutOfDatePreBuild)
packagesOutOfDate :: PackageIdSet
packagesOutOfDate =
PackageIdSet
packagesOutOfDatePreBuild PackageIdSet -> PackageIdSet -> PackageIdSet
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` PackageIdSet
packagesSuccessfulPostBuild
packagesInvalidByChangedLibDeps :: PackageIdSet
packagesInvalidByChangedLibDeps =
PackageIdSet
packagesDepOnChangedLib PackageIdSet -> PackageIdSet -> PackageIdSet
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` PackageIdSet
packagesSuccessfulPostBuild
packagesInvalidByFailedBuild :: PackageIdSet
packagesInvalidByFailedBuild =
PackageIdSet
packagesFailurePostBuild
previousPackagesUpToDate' :: PackageIdSet
previousPackagesUpToDate' =
PackageIdSet -> PackageIdSet -> PackageIdSet
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection
PackageIdSet
previousPackagesUpToDate
(ElaboratedInstallPlan -> PackageIdSet
forall ipkg srcpkg. GenericInstallPlan ipkg srcpkg -> PackageIdSet
InstallPlan.keysSet ElaboratedInstallPlan
plan)
packagesUpToDatePreBuild :: PackageIdSet
packagesUpToDatePreBuild =
(UnitId -> Bool) -> PackageIdSet -> PackageIdSet
forall a. (a -> Bool) -> Set a -> Set a
Set.filter
(\UnitId
ipkgid -> Bool -> Bool
not (Bool -> UnitId -> Bool
lookupBuildStatusRequiresBuild Bool
True UnitId
ipkgid))
(ElaboratedInstallPlan -> PackageIdSet
forall ipkg srcpkg. GenericInstallPlan ipkg srcpkg -> PackageIdSet
InstallPlan.keysSet ElaboratedInstallPlan
plan)
packagesOutOfDatePreBuild :: PackageIdSet
packagesOutOfDatePreBuild =
[UnitId] -> PackageIdSet
forall a. Ord a => [a] -> Set a
Set.fromList ([UnitId] -> PackageIdSet)
-> ([ElaboratedPlanPackage] -> [UnitId])
-> [ElaboratedPlanPackage]
-> PackageIdSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ElaboratedPlanPackage -> UnitId)
-> [ElaboratedPlanPackage] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map ElaboratedPlanPackage -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ([ElaboratedPlanPackage] -> PackageIdSet)
-> [ElaboratedPlanPackage] -> PackageIdSet
forall a b. (a -> b) -> a -> b
$
ElaboratedInstallPlan -> [UnitId] -> [ElaboratedPlanPackage]
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg
-> [UnitId] -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.reverseDependencyClosure ElaboratedInstallPlan
plan
[ UnitId
ipkgid
| ElaboratedPlanPackage
pkg <- ElaboratedInstallPlan -> [ElaboratedPlanPackage]
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.toList ElaboratedInstallPlan
plan
, let ipkgid :: UnitId
ipkgid = ElaboratedPlanPackage -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedPlanPackage
pkg
, Bool -> UnitId -> Bool
lookupBuildStatusRequiresBuild Bool
False UnitId
ipkgid
]
packagesSuccessfulPostBuild :: PackageIdSet
packagesSuccessfulPostBuild =
[UnitId] -> PackageIdSet
forall a. Ord a => [a] -> Set a
Set.fromList
[ UnitId
ikgid | (UnitId
ikgid, Right BuildResult
_) <- BuildOutcomes -> [(UnitId, BuildOutcome)]
forall k a. Map k a -> [(k, a)]
Map.toList BuildOutcomes
buildOutcomes ]
packagesFailurePostBuild :: PackageIdSet
packagesFailurePostBuild =
[UnitId] -> PackageIdSet
forall a. Ord a => [a] -> Set a
Set.fromList
[ UnitId
ikgid
| (UnitId
ikgid, Left BuildFailure
failure) <- BuildOutcomes -> [(UnitId, BuildOutcome)]
forall k a. Map k a -> [(k, a)]
Map.toList BuildOutcomes
buildOutcomes
, case BuildFailure -> BuildFailureReason
buildFailureReason BuildFailure
failure of
DependentFailed PackageIdentifier
_ -> Bool
False
BuildFailureReason
_ -> Bool
True
]
packagesDepOnChangedLib :: PackageIdSet
packagesDepOnChangedLib =
[UnitId] -> PackageIdSet
forall a. Ord a => [a] -> Set a
Set.fromList ([UnitId] -> PackageIdSet)
-> ([Node UnitId ElaboratedPlanPackage] -> [UnitId])
-> [Node UnitId ElaboratedPlanPackage]
-> PackageIdSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node UnitId ElaboratedPlanPackage -> UnitId)
-> [Node UnitId ElaboratedPlanPackage] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map Node UnitId ElaboratedPlanPackage -> UnitId
forall a. IsNode a => a -> Key a
Graph.nodeKey ([Node UnitId ElaboratedPlanPackage] -> PackageIdSet)
-> [Node UnitId ElaboratedPlanPackage] -> PackageIdSet
forall a b. (a -> b) -> a -> b
$
[Node UnitId ElaboratedPlanPackage]
-> Maybe [Node UnitId ElaboratedPlanPackage]
-> [Node UnitId ElaboratedPlanPackage]
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> [Node UnitId ElaboratedPlanPackage]
forall a. HasCallStack => FilePath -> a
error FilePath
"packagesBuildStatusAfterBuild: broken dep closure") (Maybe [Node UnitId ElaboratedPlanPackage]
-> [Node UnitId ElaboratedPlanPackage])
-> Maybe [Node UnitId ElaboratedPlanPackage]
-> [Node UnitId ElaboratedPlanPackage]
forall a b. (a -> b) -> a -> b
$
Graph (Node UnitId ElaboratedPlanPackage)
-> [Key (Node UnitId ElaboratedPlanPackage)]
-> Maybe [Node UnitId ElaboratedPlanPackage]
forall a. Graph a -> [Key a] -> Maybe [a]
Graph.revClosure Graph (Node UnitId ElaboratedPlanPackage)
packagesLibDepGraph
( Map UnitId (BuildStatus, BuildOutcome) -> [UnitId]
forall k a. Map k a -> [k]
Map.keys
(Map UnitId (BuildStatus, BuildOutcome) -> [UnitId])
-> (Map UnitId (BuildStatus, BuildOutcome)
-> Map UnitId (BuildStatus, BuildOutcome))
-> Map UnitId (BuildStatus, BuildOutcome)
-> [UnitId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((BuildStatus, BuildOutcome) -> Bool)
-> Map UnitId (BuildStatus, BuildOutcome)
-> Map UnitId (BuildStatus, BuildOutcome)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter ((BuildStatus -> BuildOutcome -> Bool)
-> (BuildStatus, BuildOutcome) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry BuildStatus -> BuildOutcome -> Bool
buildAttempted)
(Map UnitId (BuildStatus, BuildOutcome) -> [UnitId])
-> Map UnitId (BuildStatus, BuildOutcome) -> [UnitId]
forall a b. (a -> b) -> a -> b
$ (BuildStatus -> BuildOutcome -> (BuildStatus, BuildOutcome))
-> BuildStatusMap
-> BuildOutcomes
-> Map UnitId (BuildStatus, BuildOutcome)
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith (,) BuildStatusMap
pkgBuildStatus BuildOutcomes
buildOutcomes
)
packagesLibDepGraph :: Graph (Node UnitId ElaboratedPlanPackage)
packagesLibDepGraph :: Graph (Node UnitId ElaboratedPlanPackage)
packagesLibDepGraph =
[Node UnitId ElaboratedPlanPackage]
-> Graph (Node UnitId ElaboratedPlanPackage)
forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
Graph.fromDistinctList
[ ElaboratedPlanPackage
-> UnitId -> [UnitId] -> Node UnitId ElaboratedPlanPackage
forall k a. a -> k -> [k] -> Node k a
Graph.N ElaboratedPlanPackage
pkg (ElaboratedPlanPackage -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedPlanPackage
pkg) [UnitId]
libdeps
| ElaboratedPlanPackage
pkg <- ElaboratedInstallPlan -> [ElaboratedPlanPackage]
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.toList ElaboratedInstallPlan
plan
, let libdeps :: [UnitId]
libdeps = case ElaboratedPlanPackage
pkg of
InstallPlan.PreExisting InstalledPackageInfo
ipkg -> InstalledPackageInfo -> [UnitId]
forall pkg. PackageInstalled pkg => pkg -> [UnitId]
installedDepends InstalledPackageInfo
ipkg
InstallPlan.Configured ElaboratedConfiguredPackage
srcpkg -> ElaboratedConfiguredPackage -> [UnitId]
elabLibDeps ElaboratedConfiguredPackage
srcpkg
InstallPlan.Installed ElaboratedConfiguredPackage
srcpkg -> ElaboratedConfiguredPackage -> [UnitId]
elabLibDeps ElaboratedConfiguredPackage
srcpkg
]
elabLibDeps :: ElaboratedConfiguredPackage -> [UnitId]
elabLibDeps :: ElaboratedConfiguredPackage -> [UnitId]
elabLibDeps = (ConfiguredId -> UnitId) -> [ConfiguredId] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map (ComponentId -> UnitId
newSimpleUnitId (ComponentId -> UnitId)
-> (ConfiguredId -> ComponentId) -> ConfiguredId -> UnitId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfiguredId -> ComponentId
confInstId) ([ConfiguredId] -> [UnitId])
-> (ElaboratedConfiguredPackage -> [ConfiguredId])
-> ElaboratedConfiguredPackage
-> [UnitId]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElaboratedConfiguredPackage -> [ConfiguredId]
elabLibDependencies
buildAttempted :: BuildStatus -> BuildOutcome -> Bool
buildAttempted :: BuildStatus -> BuildOutcome -> Bool
buildAttempted BuildStatus
buildStatus BuildOutcome
_buildOutcome
| Bool -> Bool
not (BuildStatus -> Bool
buildStatusRequiresBuild BuildStatus
buildStatus)
= Bool
False
buildAttempted BuildStatus
_ (Left BuildFailure {BuildFailureReason
buildFailureReason :: BuildFailureReason
buildFailureReason :: BuildFailure -> BuildFailureReason
buildFailureReason})
| DependentFailed PackageIdentifier
_ <- BuildFailureReason
buildFailureReason
= Bool
False
buildAttempted BuildStatus
_ (Left BuildFailure {}) = Bool
True
buildAttempted BuildStatus
_ (Right BuildResult
_) = Bool
True
lookupBuildStatusRequiresBuild :: Bool -> UnitId -> Bool
lookupBuildStatusRequiresBuild :: Bool -> UnitId -> Bool
lookupBuildStatusRequiresBuild Bool
def UnitId
ipkgid =
case UnitId -> BuildStatusMap -> Maybe BuildStatus
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UnitId
ipkgid BuildStatusMap
pkgBuildStatus of
Maybe BuildStatus
Nothing -> Bool
def
Just BuildStatus
buildStatus -> BuildStatus -> Bool
buildStatusRequiresBuild BuildStatus
buildStatus
packagesBuildLocal :: Set UnitId
packagesBuildLocal :: PackageIdSet
packagesBuildLocal =
(ElaboratedPlanPackage -> Bool) -> PackageIdSet
selectPlanPackageIdSet ((ElaboratedPlanPackage -> Bool) -> PackageIdSet)
-> (ElaboratedPlanPackage -> Bool) -> PackageIdSet
forall a b. (a -> b) -> a -> b
$ \ElaboratedPlanPackage
pkg ->
case ElaboratedPlanPackage
pkg of
InstallPlan.PreExisting InstalledPackageInfo
_ -> Bool
False
InstallPlan.Installed ElaboratedConfiguredPackage
_ -> Bool
False
InstallPlan.Configured ElaboratedConfiguredPackage
srcpkg -> ElaboratedConfiguredPackage -> Bool
elabLocalToProject ElaboratedConfiguredPackage
srcpkg
packagesBuildInplace :: Set UnitId
packagesBuildInplace :: PackageIdSet
packagesBuildInplace =
(ElaboratedPlanPackage -> Bool) -> PackageIdSet
selectPlanPackageIdSet ((ElaboratedPlanPackage -> Bool) -> PackageIdSet)
-> (ElaboratedPlanPackage -> Bool) -> PackageIdSet
forall a b. (a -> b) -> a -> b
$ \ElaboratedPlanPackage
pkg ->
case ElaboratedPlanPackage
pkg of
InstallPlan.PreExisting InstalledPackageInfo
_ -> Bool
False
InstallPlan.Installed ElaboratedConfiguredPackage
_ -> Bool
False
InstallPlan.Configured ElaboratedConfiguredPackage
srcpkg -> ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
srcpkg
BuildStyle -> BuildStyle -> Bool
forall a. Eq a => a -> a -> Bool
== BuildStyle
BuildInplaceOnly
packagesAlreadyInStore :: Set UnitId
packagesAlreadyInStore :: PackageIdSet
packagesAlreadyInStore =
(ElaboratedPlanPackage -> Bool) -> PackageIdSet
selectPlanPackageIdSet ((ElaboratedPlanPackage -> Bool) -> PackageIdSet)
-> (ElaboratedPlanPackage -> Bool) -> PackageIdSet
forall a b. (a -> b) -> a -> b
$ \ElaboratedPlanPackage
pkg ->
case ElaboratedPlanPackage
pkg of
InstallPlan.PreExisting InstalledPackageInfo
_ -> Bool
True
InstallPlan.Installed ElaboratedConfiguredPackage
_ -> Bool
True
InstallPlan.Configured ElaboratedConfiguredPackage
_ -> Bool
False
selectPlanPackageIdSet
:: (InstallPlan.GenericPlanPackage InstalledPackageInfo ElaboratedConfiguredPackage
-> Bool)
-> Set UnitId
selectPlanPackageIdSet :: (ElaboratedPlanPackage -> Bool) -> PackageIdSet
selectPlanPackageIdSet ElaboratedPlanPackage -> Bool
p = Map UnitId ElaboratedPlanPackage -> PackageIdSet
forall k a. Map k a -> Set k
Map.keysSet
(Map UnitId ElaboratedPlanPackage -> PackageIdSet)
-> (Map UnitId ElaboratedPlanPackage
-> Map UnitId ElaboratedPlanPackage)
-> Map UnitId ElaboratedPlanPackage
-> PackageIdSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ElaboratedPlanPackage -> Bool)
-> Map UnitId ElaboratedPlanPackage
-> Map UnitId ElaboratedPlanPackage
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter ElaboratedPlanPackage -> Bool
p
(Map UnitId ElaboratedPlanPackage -> PackageIdSet)
-> Map UnitId ElaboratedPlanPackage -> PackageIdSet
forall a b. (a -> b) -> a -> b
$ ElaboratedInstallPlan -> Map UnitId ElaboratedPlanPackage
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg
-> Map UnitId (GenericPlanPackage ipkg srcpkg)
InstallPlan.toMap ElaboratedInstallPlan
plan
updatePostBuildProjectStatus :: Verbosity
-> DistDirLayout
-> ElaboratedInstallPlan
-> BuildStatusMap
-> BuildOutcomes
-> IO PostBuildProjectStatus
updatePostBuildProjectStatus :: Verbosity
-> DistDirLayout
-> ElaboratedInstallPlan
-> BuildStatusMap
-> BuildOutcomes
-> IO PostBuildProjectStatus
updatePostBuildProjectStatus Verbosity
verbosity DistDirLayout
distDirLayout
ElaboratedInstallPlan
elaboratedInstallPlan
BuildStatusMap
pkgsBuildStatus BuildOutcomes
buildOutcomes = do
PackageIdSet
previousUpToDate <- DistDirLayout -> IO PackageIdSet
readPackagesUpToDateCacheFile DistDirLayout
distDirLayout
let currentBuildStatus :: PostBuildProjectStatus
currentBuildStatus@PostBuildProjectStatus{Graph (Node UnitId ElaboratedPlanPackage)
PackageIdSet
packagesAlreadyInStore :: PackageIdSet
packagesBuildInplace :: PackageIdSet
packagesBuildLocal :: PackageIdSet
packagesLibDepGraph :: Graph (Node UnitId ElaboratedPlanPackage)
packagesInvalidByFailedBuild :: PackageIdSet
packagesInvalidByChangedLibDeps :: PackageIdSet
packagesOutOfDate :: PackageIdSet
packagesProbablyUpToDate :: PackageIdSet
packagesDefinitelyUpToDate :: PackageIdSet
packagesAlreadyInStore :: PostBuildProjectStatus -> PackageIdSet
packagesBuildInplace :: PostBuildProjectStatus -> PackageIdSet
packagesBuildLocal :: PostBuildProjectStatus -> PackageIdSet
packagesLibDepGraph :: PostBuildProjectStatus -> Graph (Node UnitId ElaboratedPlanPackage)
packagesInvalidByFailedBuild :: PostBuildProjectStatus -> PackageIdSet
packagesInvalidByChangedLibDeps :: PostBuildProjectStatus -> PackageIdSet
packagesOutOfDate :: PostBuildProjectStatus -> PackageIdSet
packagesProbablyUpToDate :: PostBuildProjectStatus -> PackageIdSet
packagesDefinitelyUpToDate :: PostBuildProjectStatus -> PackageIdSet
..}
= ElaboratedInstallPlan
-> PackageIdSet
-> BuildStatusMap
-> BuildOutcomes
-> PostBuildProjectStatus
postBuildProjectStatus
ElaboratedInstallPlan
elaboratedInstallPlan
PackageIdSet
previousUpToDate
BuildStatusMap
pkgsBuildStatus
BuildOutcomes
buildOutcomes
let currentUpToDate :: PackageIdSet
currentUpToDate = PackageIdSet
packagesProbablyUpToDate
DistDirLayout -> PackageIdSet -> IO ()
writePackagesUpToDateCacheFile DistDirLayout
distDirLayout PackageIdSet
currentUpToDate
Verbosity -> FilePath -> IO ()
debugNoWrap Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"packages definitely up to date: "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PackageIdSet -> FilePath
displayPackageIdSet (PackageIdSet
packagesDefinitelyUpToDate
PackageIdSet -> PackageIdSet -> PackageIdSet
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` PackageIdSet
packagesBuildInplace)
Verbosity -> FilePath -> IO ()
debugNoWrap Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"packages previously probably up to date: "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PackageIdSet -> FilePath
displayPackageIdSet (PackageIdSet
previousUpToDate
PackageIdSet -> PackageIdSet -> PackageIdSet
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` PackageIdSet
packagesBuildInplace)
Verbosity -> FilePath -> IO ()
debugNoWrap Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"packages now probably up to date: "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PackageIdSet -> FilePath
displayPackageIdSet (PackageIdSet
packagesProbablyUpToDate
PackageIdSet -> PackageIdSet -> PackageIdSet
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` PackageIdSet
packagesBuildInplace)
Verbosity -> FilePath -> IO ()
debugNoWrap Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"packages newly up to date: "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PackageIdSet -> FilePath
displayPackageIdSet (PackageIdSet
packagesDefinitelyUpToDate
PackageIdSet -> PackageIdSet -> PackageIdSet
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` PackageIdSet
previousUpToDate
PackageIdSet -> PackageIdSet -> PackageIdSet
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` PackageIdSet
packagesBuildInplace)
Verbosity -> FilePath -> IO ()
debugNoWrap Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"packages out to date: "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PackageIdSet -> FilePath
displayPackageIdSet (PackageIdSet
packagesOutOfDate
PackageIdSet -> PackageIdSet -> PackageIdSet
forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` PackageIdSet
packagesBuildInplace)
Verbosity -> FilePath -> IO ()
debugNoWrap Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"packages invalid due to dep change: "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PackageIdSet -> FilePath
displayPackageIdSet PackageIdSet
packagesInvalidByChangedLibDeps
Verbosity -> FilePath -> IO ()
debugNoWrap Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"packages invalid due to build failure: "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ PackageIdSet -> FilePath
displayPackageIdSet PackageIdSet
packagesInvalidByFailedBuild
PostBuildProjectStatus -> IO PostBuildProjectStatus
forall (m :: * -> *) a. Monad m => a -> m a
return PostBuildProjectStatus
currentBuildStatus
where
displayPackageIdSet :: PackageIdSet -> FilePath
displayPackageIdSet = FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
", " ([FilePath] -> FilePath)
-> (PackageIdSet -> [FilePath]) -> PackageIdSet -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnitId -> FilePath) -> [UnitId] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map UnitId -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow ([UnitId] -> [FilePath])
-> (PackageIdSet -> [UnitId]) -> PackageIdSet -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdSet -> [UnitId]
forall a. Set a -> [a]
Set.toList
readPackagesUpToDateCacheFile :: DistDirLayout -> IO PackagesUpToDate
readPackagesUpToDateCacheFile :: DistDirLayout -> IO PackageIdSet
readPackagesUpToDateCacheFile DistDirLayout{FilePath -> FilePath
distProjectCacheFile :: FilePath -> FilePath
distProjectCacheFile :: DistDirLayout -> FilePath -> FilePath
distProjectCacheFile} =
PackageIdSet -> IO PackageIdSet -> IO PackageIdSet
forall a. a -> IO a -> IO a
handleDoesNotExist PackageIdSet
forall a. Set a
Set.empty (IO PackageIdSet -> IO PackageIdSet)
-> IO PackageIdSet -> IO PackageIdSet
forall a b. (a -> b) -> a -> b
$
IO (Either FilePath PackageIdSet) -> IO PackageIdSet
forall b a. IO (Either b (Set a)) -> IO (Set a)
handleDecodeFailure (IO (Either FilePath PackageIdSet) -> IO PackageIdSet)
-> IO (Either FilePath PackageIdSet) -> IO PackageIdSet
forall a b. (a -> b) -> a -> b
$
FilePath
-> IOMode
-> (Handle -> IO (Either FilePath PackageIdSet))
-> IO (Either FilePath PackageIdSet)
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile (FilePath -> FilePath
distProjectCacheFile FilePath
"up-to-date") IOMode
ReadMode ((Handle -> IO (Either FilePath PackageIdSet))
-> IO (Either FilePath PackageIdSet))
-> (Handle -> IO (Either FilePath PackageIdSet))
-> IO (Either FilePath PackageIdSet)
forall a b. (a -> b) -> a -> b
$ \Handle
hnd ->
ByteString -> IO (Either FilePath PackageIdSet)
forall a. Binary a => ByteString -> IO (Either FilePath a)
Binary.decodeOrFailIO (ByteString -> IO (Either FilePath PackageIdSet))
-> IO ByteString -> IO (Either FilePath PackageIdSet)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Handle -> IO ByteString
BS.hGetContents Handle
hnd
where
handleDecodeFailure :: IO (Either b (Set a)) -> IO (Set a)
handleDecodeFailure = (Either b (Set a) -> Set a) -> IO (Either b (Set a)) -> IO (Set a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> Set a) -> (Set a -> Set a) -> Either b (Set a) -> Set a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Set a -> b -> Set a
forall a b. a -> b -> a
const Set a
forall a. Set a
Set.empty) Set a -> Set a
forall a. a -> a
id)
writePackagesUpToDateCacheFile :: DistDirLayout -> PackagesUpToDate -> IO ()
writePackagesUpToDateCacheFile :: DistDirLayout -> PackageIdSet -> IO ()
writePackagesUpToDateCacheFile DistDirLayout{FilePath -> FilePath
distProjectCacheFile :: FilePath -> FilePath
distProjectCacheFile :: DistDirLayout -> FilePath -> FilePath
distProjectCacheFile} PackageIdSet
upToDate =
FilePath -> ByteString -> IO ()
writeFileAtomic (FilePath -> FilePath
distProjectCacheFile FilePath
"up-to-date") (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$
PackageIdSet -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode PackageIdSet
upToDate
createPackageEnvironment :: Verbosity
-> FilePath
-> ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> PostBuildProjectStatus
-> IO [(String, Maybe String)]
createPackageEnvironment :: Verbosity
-> FilePath
-> ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> PostBuildProjectStatus
-> IO [(FilePath, Maybe FilePath)]
createPackageEnvironment Verbosity
verbosity
FilePath
path
ElaboratedInstallPlan
elaboratedPlan
ElaboratedSharedConfig
elaboratedShared
PostBuildProjectStatus
buildStatus
| Compiler -> CompilerFlavor
compilerFlavor (ElaboratedSharedConfig -> Compiler
pkgConfigCompiler ElaboratedSharedConfig
elaboratedShared) CompilerFlavor -> CompilerFlavor -> Bool
forall a. Eq a => a -> a -> Bool
== CompilerFlavor
GHC
= do
Maybe FilePath
envFileM <- FilePath
-> ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> PostBuildProjectStatus
-> IO (Maybe FilePath)
writePlanGhcEnvironment
FilePath
path
ElaboratedInstallPlan
elaboratedPlan
ElaboratedSharedConfig
elaboratedShared
PostBuildProjectStatus
buildStatus
case Maybe FilePath
envFileM of
Just FilePath
envFile -> [(FilePath, Maybe FilePath)] -> IO [(FilePath, Maybe FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(FilePath
"GHC_ENVIRONMENT", FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
envFile)]
Maybe FilePath
Nothing -> do
Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity FilePath
"the configured version of GHC does not support reading package lists from the environment; commands that need the current project's package database are likely to fail"
[(FilePath, Maybe FilePath)] -> IO [(FilePath, Maybe FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
| Bool
otherwise
= do
Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity FilePath
"package environment configuration is not supported for the currently configured compiler; commands that need the current project's package database are likely to fail"
[(FilePath, Maybe FilePath)] -> IO [(FilePath, Maybe FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
writePlanGhcEnvironment :: FilePath
-> ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> PostBuildProjectStatus
-> IO (Maybe FilePath)
writePlanGhcEnvironment :: FilePath
-> ElaboratedInstallPlan
-> ElaboratedSharedConfig
-> PostBuildProjectStatus
-> IO (Maybe FilePath)
writePlanGhcEnvironment FilePath
path
ElaboratedInstallPlan
elaboratedInstallPlan
ElaboratedSharedConfig {
pkgConfigCompiler :: ElaboratedSharedConfig -> Compiler
pkgConfigCompiler = Compiler
compiler,
pkgConfigPlatform :: ElaboratedSharedConfig -> Platform
pkgConfigPlatform = Platform
platform
}
PostBuildProjectStatus
postBuildStatus
| Compiler -> CompilerFlavor
compilerFlavor Compiler
compiler CompilerFlavor -> CompilerFlavor -> Bool
forall a. Eq a => a -> a -> Bool
== CompilerFlavor
GHC
, GhcImplInfo -> Bool
supportsPkgEnvFiles (Compiler -> GhcImplInfo
getImplInfo Compiler
compiler)
= (FilePath -> Maybe FilePath) -> IO FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (IO FilePath -> IO (Maybe FilePath))
-> IO FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath
-> Platform -> Version -> [GhcEnvironmentFileEntry] -> IO FilePath
writeGhcEnvironmentFile
FilePath
path
Platform
platform (Compiler -> Version
compilerVersion Compiler
compiler)
(FilePath
-> ElaboratedInstallPlan
-> PostBuildProjectStatus
-> [GhcEnvironmentFileEntry]
renderGhcEnvironmentFile FilePath
path
ElaboratedInstallPlan
elaboratedInstallPlan
PostBuildProjectStatus
postBuildStatus)
writePlanGhcEnvironment FilePath
_ ElaboratedInstallPlan
_ ElaboratedSharedConfig
_ PostBuildProjectStatus
_ = Maybe FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FilePath
forall a. Maybe a
Nothing
renderGhcEnvironmentFile :: FilePath
-> ElaboratedInstallPlan
-> PostBuildProjectStatus
-> [GhcEnvironmentFileEntry]
renderGhcEnvironmentFile :: FilePath
-> ElaboratedInstallPlan
-> PostBuildProjectStatus
-> [GhcEnvironmentFileEntry]
renderGhcEnvironmentFile FilePath
projectRootDir ElaboratedInstallPlan
elaboratedInstallPlan
PostBuildProjectStatus
postBuildStatus =
GhcEnvironmentFileEntry
headerComment
GhcEnvironmentFileEntry
-> [GhcEnvironmentFileEntry] -> [GhcEnvironmentFileEntry]
forall a. a -> [a] -> [a]
: PackageDBStack -> [UnitId] -> [GhcEnvironmentFileEntry]
simpleGhcEnvironmentFile PackageDBStack
packageDBs [UnitId]
unitIds
where
headerComment :: GhcEnvironmentFileEntry
headerComment =
FilePath -> GhcEnvironmentFileEntry
GhcEnvFileComment
(FilePath -> GhcEnvironmentFileEntry)
-> FilePath -> GhcEnvironmentFileEntry
forall a b. (a -> b) -> a -> b
$ FilePath
"This is a GHC environment file written by cabal. This means you can\n"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"run ghc or ghci and get the environment of the project as a whole.\n"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"But you still need to use cabal repl $target to get the environment\n"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"of specific components (libs, exes, tests etc) because each one can\n"
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"have its own source dirs, cpp flags etc.\n\n"
unitIds :: [UnitId]
unitIds = PostBuildProjectStatus -> [UnitId]
selectGhcEnvironmentFileLibraries PostBuildProjectStatus
postBuildStatus
packageDBs :: PackageDBStack
packageDBs = FilePath -> PackageDBStack -> PackageDBStack
relativePackageDBPaths FilePath
projectRootDir (PackageDBStack -> PackageDBStack)
-> PackageDBStack -> PackageDBStack
forall a b. (a -> b) -> a -> b
$
ElaboratedInstallPlan -> PackageDBStack
selectGhcEnvironmentFilePackageDbs ElaboratedInstallPlan
elaboratedInstallPlan
argsEquivalentOfGhcEnvironmentFile
:: Compiler
-> DistDirLayout
-> ElaboratedInstallPlan
-> PostBuildProjectStatus
-> [String]
argsEquivalentOfGhcEnvironmentFile :: Compiler
-> DistDirLayout
-> ElaboratedInstallPlan
-> PostBuildProjectStatus
-> [FilePath]
argsEquivalentOfGhcEnvironmentFile Compiler
compiler =
case Compiler -> CompilerId
compilerId Compiler
compiler
of CompilerId CompilerFlavor
GHC Version
_ -> DistDirLayout
-> ElaboratedInstallPlan -> PostBuildProjectStatus -> [FilePath]
argsEquivalentOfGhcEnvironmentFileGhc
CompilerId CompilerFlavor
GHCJS Version
_ -> DistDirLayout
-> ElaboratedInstallPlan -> PostBuildProjectStatus -> [FilePath]
argsEquivalentOfGhcEnvironmentFileGhc
CompilerId CompilerFlavor
_ Version
_ -> FilePath
-> DistDirLayout
-> ElaboratedInstallPlan
-> PostBuildProjectStatus
-> [FilePath]
forall a. HasCallStack => FilePath -> a
error FilePath
"Only GHC and GHCJS are supported"
argsEquivalentOfGhcEnvironmentFileGhc
:: DistDirLayout
-> ElaboratedInstallPlan
-> PostBuildProjectStatus
-> [String]
argsEquivalentOfGhcEnvironmentFileGhc :: DistDirLayout
-> ElaboratedInstallPlan -> PostBuildProjectStatus -> [FilePath]
argsEquivalentOfGhcEnvironmentFileGhc
DistDirLayout
distDirLayout
ElaboratedInstallPlan
elaboratedInstallPlan
PostBuildProjectStatus
postBuildStatus =
[FilePath]
clearPackageDbStackFlag
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ PackageDBStack -> [FilePath]
packageDbArgsDb PackageDBStack
packageDBs
[FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (UnitId -> [FilePath]) -> [UnitId] -> [FilePath]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap UnitId -> [FilePath]
forall a. Pretty a => a -> [FilePath]
packageIdFlag [UnitId]
packageIds
where
projectRootDir :: FilePath
projectRootDir = DistDirLayout -> FilePath
distProjectRootDirectory DistDirLayout
distDirLayout
packageIds :: [UnitId]
packageIds = PostBuildProjectStatus -> [UnitId]
selectGhcEnvironmentFileLibraries PostBuildProjectStatus
postBuildStatus
packageDBs :: PackageDBStack
packageDBs = FilePath -> PackageDBStack -> PackageDBStack
relativePackageDBPaths FilePath
projectRootDir (PackageDBStack -> PackageDBStack)
-> PackageDBStack -> PackageDBStack
forall a b. (a -> b) -> a -> b
$
ElaboratedInstallPlan -> PackageDBStack
selectGhcEnvironmentFilePackageDbs ElaboratedInstallPlan
elaboratedInstallPlan
clearPackageDbStackFlag :: [FilePath]
clearPackageDbStackFlag = [FilePath
"-clear-package-db", FilePath
"-global-package-db"]
packageIdFlag :: a -> [FilePath]
packageIdFlag a
uid = [FilePath
"-package-id", a -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow a
uid]
selectGhcEnvironmentFileLibraries :: PostBuildProjectStatus -> [UnitId]
selectGhcEnvironmentFileLibraries :: PostBuildProjectStatus -> [UnitId]
selectGhcEnvironmentFileLibraries PostBuildProjectStatus{Graph (Node UnitId ElaboratedPlanPackage)
PackageIdSet
packagesAlreadyInStore :: PackageIdSet
packagesBuildInplace :: PackageIdSet
packagesBuildLocal :: PackageIdSet
packagesLibDepGraph :: Graph (Node UnitId ElaboratedPlanPackage)
packagesInvalidByFailedBuild :: PackageIdSet
packagesInvalidByChangedLibDeps :: PackageIdSet
packagesOutOfDate :: PackageIdSet
packagesProbablyUpToDate :: PackageIdSet
packagesDefinitelyUpToDate :: PackageIdSet
packagesAlreadyInStore :: PostBuildProjectStatus -> PackageIdSet
packagesBuildInplace :: PostBuildProjectStatus -> PackageIdSet
packagesBuildLocal :: PostBuildProjectStatus -> PackageIdSet
packagesLibDepGraph :: PostBuildProjectStatus -> Graph (Node UnitId ElaboratedPlanPackage)
packagesInvalidByFailedBuild :: PostBuildProjectStatus -> PackageIdSet
packagesInvalidByChangedLibDeps :: PostBuildProjectStatus -> PackageIdSet
packagesOutOfDate :: PostBuildProjectStatus -> PackageIdSet
packagesProbablyUpToDate :: PostBuildProjectStatus -> PackageIdSet
packagesDefinitelyUpToDate :: PostBuildProjectStatus -> PackageIdSet
..} =
case Graph (Node UnitId ElaboratedPlanPackage)
-> [Key (Node UnitId ElaboratedPlanPackage)]
-> Maybe [Node UnitId ElaboratedPlanPackage]
forall a. Graph a -> [Key a] -> Maybe [a]
Graph.closure Graph (Node UnitId ElaboratedPlanPackage)
packagesLibDepGraph (PackageIdSet -> [UnitId]
forall a. Set a -> [a]
Set.toList PackageIdSet
packagesBuildLocal) of
Maybe [Node UnitId ElaboratedPlanPackage]
Nothing -> FilePath -> [UnitId]
forall a. HasCallStack => FilePath -> a
error FilePath
"renderGhcEnvironmentFile: broken dep closure"
Just [Node UnitId ElaboratedPlanPackage]
nodes -> [ UnitId
pkgid | Graph.N ElaboratedPlanPackage
pkg UnitId
pkgid [UnitId]
_ <- [Node UnitId ElaboratedPlanPackage]
nodes
, ElaboratedPlanPackage -> Bool
forall ipkg.
GenericPlanPackage ipkg ElaboratedConfiguredPackage -> Bool
hasUpToDateLib ElaboratedPlanPackage
pkg ]
where
hasUpToDateLib :: GenericPlanPackage ipkg ElaboratedConfiguredPackage -> Bool
hasUpToDateLib GenericPlanPackage ipkg ElaboratedConfiguredPackage
planpkg = case GenericPlanPackage ipkg ElaboratedConfiguredPackage
planpkg of
InstallPlan.PreExisting ipkg
_ -> Bool
True
InstallPlan.Installed ElaboratedConfiguredPackage
pkg -> ElaboratedConfiguredPackage -> Bool
elabRequiresRegistration ElaboratedConfiguredPackage
pkg
InstallPlan.Configured ElaboratedConfiguredPackage
pkg ->
ElaboratedConfiguredPackage -> Bool
elabRequiresRegistration ElaboratedConfiguredPackage
pkg
Bool -> Bool -> Bool
&& ElaboratedConfiguredPackage -> UnitId
forall pkg. HasUnitId pkg => pkg -> UnitId
installedUnitId ElaboratedConfiguredPackage
pkg UnitId -> PackageIdSet -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` PackageIdSet
packagesProbablyUpToDate
selectGhcEnvironmentFilePackageDbs :: ElaboratedInstallPlan -> PackageDBStack
selectGhcEnvironmentFilePackageDbs :: ElaboratedInstallPlan -> PackageDBStack
selectGhcEnvironmentFilePackageDbs ElaboratedInstallPlan
elaboratedInstallPlan =
case ([ElaboratedConfiguredPackage]
inplacePackages, [ElaboratedConfiguredPackage]
sourcePackages) of
([], [ElaboratedConfiguredPackage]
pkgs) -> [ElaboratedConfiguredPackage] -> PackageDBStack
checkSamePackageDBs [ElaboratedConfiguredPackage]
pkgs
([ElaboratedConfiguredPackage]
pkgs, [ElaboratedConfiguredPackage]
_) -> [ElaboratedConfiguredPackage] -> PackageDBStack
checkSamePackageDBs [ElaboratedConfiguredPackage]
pkgs
where
checkSamePackageDBs :: [ElaboratedConfiguredPackage] -> PackageDBStack
checkSamePackageDBs :: [ElaboratedConfiguredPackage] -> PackageDBStack
checkSamePackageDBs [ElaboratedConfiguredPackage]
pkgs =
case [PackageDBStack] -> [PackageDBStack]
forall a. Ord a => [a] -> [a]
ordNub ((ElaboratedConfiguredPackage -> PackageDBStack)
-> [ElaboratedConfiguredPackage] -> [PackageDBStack]
forall a b. (a -> b) -> [a] -> [b]
map ElaboratedConfiguredPackage -> PackageDBStack
elabBuildPackageDBStack [ElaboratedConfiguredPackage]
pkgs) of
[PackageDBStack
packageDbs] -> PackageDBStack
packageDbs
[] -> []
[PackageDBStack]
_ -> FilePath -> PackageDBStack
forall a. HasCallStack => FilePath -> a
error (FilePath -> PackageDBStack) -> FilePath -> PackageDBStack
forall a b. (a -> b) -> a -> b
$ FilePath
"renderGhcEnvironmentFile: packages with "
FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"different package db stacks"
inplacePackages :: [ElaboratedConfiguredPackage]
inplacePackages :: [ElaboratedConfiguredPackage]
inplacePackages =
[ ElaboratedConfiguredPackage
srcpkg
| ElaboratedConfiguredPackage
srcpkg <- [ElaboratedConfiguredPackage]
sourcePackages
, ElaboratedConfiguredPackage -> BuildStyle
elabBuildStyle ElaboratedConfiguredPackage
srcpkg BuildStyle -> BuildStyle -> Bool
forall a. Eq a => a -> a -> Bool
== BuildStyle
BuildInplaceOnly ]
sourcePackages :: [ElaboratedConfiguredPackage]
sourcePackages :: [ElaboratedConfiguredPackage]
sourcePackages =
[ ElaboratedConfiguredPackage
srcpkg
| ElaboratedPlanPackage
pkg <- ElaboratedInstallPlan -> [ElaboratedPlanPackage]
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.toList ElaboratedInstallPlan
elaboratedInstallPlan
, ElaboratedConfiguredPackage
srcpkg <- Maybe ElaboratedConfiguredPackage -> [ElaboratedConfiguredPackage]
forall a. Maybe a -> [a]
maybeToList (Maybe ElaboratedConfiguredPackage
-> [ElaboratedConfiguredPackage])
-> Maybe ElaboratedConfiguredPackage
-> [ElaboratedConfiguredPackage]
forall a b. (a -> b) -> a -> b
$ case ElaboratedPlanPackage
pkg of
InstallPlan.Configured ElaboratedConfiguredPackage
srcpkg -> ElaboratedConfiguredPackage -> Maybe ElaboratedConfiguredPackage
forall a. a -> Maybe a
Just ElaboratedConfiguredPackage
srcpkg
InstallPlan.Installed ElaboratedConfiguredPackage
srcpkg -> ElaboratedConfiguredPackage -> Maybe ElaboratedConfiguredPackage
forall a. a -> Maybe a
Just ElaboratedConfiguredPackage
srcpkg
InstallPlan.PreExisting InstalledPackageInfo
_ -> Maybe ElaboratedConfiguredPackage
forall a. Maybe a
Nothing
]
relativePackageDBPaths :: FilePath -> PackageDBStack -> PackageDBStack
relativePackageDBPaths :: FilePath -> PackageDBStack -> PackageDBStack
relativePackageDBPaths FilePath
relroot = (PackageDB -> PackageDB) -> PackageDBStack -> PackageDBStack
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> PackageDB -> PackageDB
relativePackageDBPath FilePath
relroot)
relativePackageDBPath :: FilePath -> PackageDB -> PackageDB
relativePackageDBPath :: FilePath -> PackageDB -> PackageDB
relativePackageDBPath FilePath
relroot PackageDB
pkgdb =
case PackageDB
pkgdb of
PackageDB
GlobalPackageDB -> PackageDB
GlobalPackageDB
PackageDB
UserPackageDB -> PackageDB
UserPackageDB
SpecificPackageDB FilePath
path -> FilePath -> PackageDB
SpecificPackageDB FilePath
relpath
where relpath :: FilePath
relpath = FilePath -> FilePath -> FilePath
makeRelative FilePath
relroot FilePath
path