{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}
module Distribution.Client.BuildReports.Storage (
storeAnonymous,
storeLocal,
fromInstallPlan,
fromPlanningFailure,
) where
import Distribution.Client.Compat.Prelude
import Prelude ()
import Distribution.Client.BuildReports.Anonymous (BuildReport, showBuildReport, newBuildReport)
import qualified Distribution.Client.BuildReports.Anonymous as BuildReport
import Distribution.Client.Types
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.InstallPlan
( InstallPlan )
import qualified Distribution.Solver.Types.ComponentDeps as CD
import Distribution.Solver.Types.SourcePackage
import Distribution.Package
( PackageId, packageId )
import Distribution.PackageDescription
( FlagAssignment )
import Distribution.Simple.InstallDirs
( PathTemplate, fromPathTemplate
, initialPathTemplateEnv, substPathTemplate )
import Distribution.System
( Platform(Platform) )
import Distribution.Compiler
( CompilerId(..), CompilerInfo(..) )
import Distribution.Simple.Utils
( equating )
import Data.List.NonEmpty
( groupBy )
import qualified Data.List as L
import System.FilePath
( (</>), takeDirectory )
import System.Directory
( createDirectoryIfMissing )
storeAnonymous :: [(BuildReport, Maybe Repo)] -> IO ()
storeAnonymous :: [(BuildReport, Maybe Repo)] -> IO ()
storeAnonymous [(BuildReport, Maybe Repo)]
reports = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ FilePath -> FilePath -> IO ()
appendFile FilePath
file (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildReport -> FilePath
format [BuildReport]
reports')
| (Repo
repo, [BuildReport]
reports') <- [(BuildReport, Maybe Repo)] -> [(Repo, [BuildReport])]
separate [(BuildReport, Maybe Repo)]
reports
, let file :: FilePath
file = Repo -> FilePath
repoLocalDir Repo
repo FilePath -> FilePath -> FilePath
</> FilePath
"build-reports.log" ]
where
format :: BuildReport -> FilePath
format BuildReport
r = Char
'\n' forall a. a -> [a] -> [a]
: BuildReport -> FilePath
showBuildReport BuildReport
r forall a. [a] -> [a] -> [a]
++ FilePath
"\n"
separate :: [(BuildReport, Maybe Repo)]
-> [(Repo, [BuildReport])]
separate :: [(BuildReport, Maybe Repo)] -> [(Repo, [BuildReport])]
separate = forall a b. (a -> b) -> [a] -> [b]
map (\rs :: [(BuildReport, Repo, RemoteRepo)]
rs@((BuildReport
_,Repo
repo,RemoteRepo
_):[(BuildReport, Repo, RemoteRepo)]
_) -> (Repo
repo, [ BuildReport
r | (BuildReport
r,Repo
_,RemoteRepo
_) <- [(BuildReport, Repo, RemoteRepo)]
rs ]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall (t :: * -> *) a. Foldable t => t a -> [a]
toList)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy (forall a b. Eq a => (b -> a) -> b -> b -> Bool
equating (forall {a} {b}. (a, b, RemoteRepo) -> RepoName
repoName' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> a
head))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (forall {a} {b}. (a, b, RemoteRepo) -> RepoName
repoName' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> a
head))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
groupBy (forall a b. Eq a => (b -> a) -> b -> b -> Bool
equating forall {a} {b}. (a, b, RemoteRepo) -> RepoName
repoName')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(BuildReport, Maybe Repo)] -> [(BuildReport, Repo, RemoteRepo)]
onlyRemote
repoName' :: (a, b, RemoteRepo) -> RepoName
repoName' (a
_,b
_,RemoteRepo
rrepo) = RemoteRepo -> RepoName
remoteRepoName RemoteRepo
rrepo
onlyRemote :: [(BuildReport, Maybe Repo)]
-> [(BuildReport, Repo, RemoteRepo)]
onlyRemote :: [(BuildReport, Maybe Repo)] -> [(BuildReport, Repo, RemoteRepo)]
onlyRemote [(BuildReport, Maybe Repo)]
rs =
[ (BuildReport
report, Repo
repo, RemoteRepo
remoteRepo)
| (BuildReport
report, Just Repo
repo) <- [(BuildReport, Maybe Repo)]
rs
, Just RemoteRepo
remoteRepo <- [Repo -> Maybe RemoteRepo
maybeRepoRemote Repo
repo]
]
storeLocal :: CompilerInfo -> [PathTemplate] -> [(BuildReport, Maybe Repo)]
-> Platform -> IO ()
storeLocal :: CompilerInfo
-> [PathTemplate]
-> [(BuildReport, Maybe Repo)]
-> Platform
-> IO ()
storeLocal CompilerInfo
cinfo [PathTemplate]
templates [(BuildReport, Maybe Repo)]
reports Platform
platform = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ do Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> FilePath
takeDirectory FilePath
file)
FilePath -> FilePath -> IO ()
appendFile FilePath
file FilePath
output
| (FilePath
file, [BuildReport]
reports') <- forall {b}. [(FilePath, b)] -> [(FilePath, [b])]
groupByFileName
[ (PathTemplate -> BuildReport -> FilePath
reportFileName PathTemplate
template BuildReport
report, BuildReport
report)
| PathTemplate
template <- [PathTemplate]
templates
, (BuildReport
report, Maybe Repo
_repo) <- [(BuildReport, Maybe Repo)]
reports ]
, let output :: FilePath
output = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildReport -> FilePath
format [BuildReport]
reports'
]
where
format :: BuildReport -> FilePath
format BuildReport
r = Char
'\n' forall a. a -> [a] -> [a]
: BuildReport -> FilePath
showBuildReport BuildReport
r forall a. [a] -> [a] -> [a]
++ FilePath
"\n"
reportFileName :: PathTemplate -> BuildReport -> FilePath
reportFileName PathTemplate
template BuildReport
report =
PathTemplate -> FilePath
fromPathTemplate (PathTemplateEnv -> PathTemplate -> PathTemplate
substPathTemplate PathTemplateEnv
env PathTemplate
template)
where env :: PathTemplateEnv
env = PackageIdentifier
-> UnitId -> CompilerInfo -> Platform -> PathTemplateEnv
initialPathTemplateEnv
(BuildReport -> PackageIdentifier
BuildReport.package BuildReport
report)
(forall a. HasCallStack => FilePath -> a
error FilePath
"storeLocal: package key not available")
CompilerInfo
cinfo
Platform
platform
groupByFileName :: [(FilePath, b)] -> [(FilePath, [b])]
groupByFileName = forall a b. (a -> b) -> [a] -> [b]
map (\grp :: [(FilePath, b)]
grp@((FilePath
filename,b
_):[(FilePath, b)]
_) -> (FilePath
filename, forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(FilePath, b)]
grp))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy (forall a b. Eq a => (b -> a) -> b -> b -> Bool
equating forall a b. (a, b) -> a
fst)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing forall a b. (a, b) -> a
fst)
fromInstallPlan :: Platform -> CompilerId
-> InstallPlan
-> BuildOutcomes
-> [(BuildReport, Maybe Repo)]
fromInstallPlan :: Platform
-> CompilerId
-> InstallPlan
-> BuildOutcomes
-> [(BuildReport, Maybe Repo)]
fromInstallPlan Platform
platform CompilerId
comp InstallPlan
plan BuildOutcomes
buildOutcomes =
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\PlanPackage
pkg -> Platform
-> CompilerId
-> PlanPackage
-> Maybe BuildOutcome
-> Maybe (BuildReport, Maybe Repo)
fromPlanPackage
Platform
platform CompilerId
comp PlanPackage
pkg
(forall pkg failure result.
HasUnitId pkg =>
pkg
-> BuildOutcomes failure result -> Maybe (Either failure result)
InstallPlan.lookupBuildOutcome PlanPackage
pkg BuildOutcomes
buildOutcomes))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.toList
forall a b. (a -> b) -> a -> b
$ InstallPlan
plan
fromPlanPackage :: Platform -> CompilerId
-> InstallPlan.PlanPackage
-> Maybe BuildOutcome
-> Maybe (BuildReport, Maybe Repo)
fromPlanPackage :: Platform
-> CompilerId
-> PlanPackage
-> Maybe BuildOutcome
-> Maybe (BuildReport, Maybe Repo)
fromPlanPackage (Platform Arch
arch OS
os) CompilerId
comp
(InstallPlan.Configured (ConfiguredPackage InstalledPackageId
_ SourcePackage UnresolvedPkgLoc
srcPkg FlagAssignment
flags OptionalStanzaSet
_ ComponentDeps [ConfiguredId]
deps))
(Just BuildOutcome
buildResult) =
forall a. a -> Maybe a
Just ( OS
-> Arch
-> CompilerId
-> PackageIdentifier
-> FlagAssignment
-> [PackageIdentifier]
-> BuildOutcome
-> BuildReport
newBuildReport OS
os Arch
arch CompilerId
comp
(forall pkg. Package pkg => pkg -> PackageIdentifier
packageId SourcePackage UnresolvedPkgLoc
srcPkg) FlagAssignment
flags
(forall a b. (a -> b) -> [a] -> [b]
map forall pkg. Package pkg => pkg -> PackageIdentifier
packageId (forall a. Monoid a => ComponentDeps a -> a
CD.nonSetupDeps ComponentDeps [ConfiguredId]
deps))
BuildOutcome
buildResult
, forall {local}. SourcePackage (PackageLocation local) -> Maybe Repo
extractRepo SourcePackage UnresolvedPkgLoc
srcPkg)
where
extractRepo :: SourcePackage (PackageLocation local) -> Maybe Repo
extractRepo (SourcePackage { srcpkgSource :: forall loc. SourcePackage loc -> loc
srcpkgSource = RepoTarballPackage Repo
repo PackageIdentifier
_ local
_ })
= forall a. a -> Maybe a
Just Repo
repo
extractRepo SourcePackage (PackageLocation local)
_ = forall a. Maybe a
Nothing
fromPlanPackage Platform
_ CompilerId
_ PlanPackage
_ Maybe BuildOutcome
_ = forall a. Maybe a
Nothing
fromPlanningFailure :: Platform -> CompilerId
-> [PackageId] -> FlagAssignment -> [(BuildReport, Maybe Repo)]
fromPlanningFailure :: Platform
-> CompilerId
-> [PackageIdentifier]
-> FlagAssignment
-> [(BuildReport, Maybe Repo)]
fromPlanningFailure (Platform Arch
arch OS
os) CompilerId
comp [PackageIdentifier]
pkgids FlagAssignment
flags =
[ (OS
-> Arch
-> CompilerId
-> PackageIdentifier
-> FlagAssignment
-> [PackageIdentifier]
-> BuildOutcome
-> BuildReport
newBuildReport OS
os Arch
arch CompilerId
comp PackageIdentifier
pkgid FlagAssignment
flags [] (forall a b. a -> Either a b
Left BuildFailure
PlanningFailed), forall a. Maybe a
Nothing)
| PackageIdentifier
pkgid <- [PackageIdentifier]
pkgids ]