{-# 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 = [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_
[ FilePath -> FilePath -> IO ()
appendFile FilePath
file ((BuildReport -> FilePath) -> [BuildReport] -> FilePath
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' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: BuildReport -> FilePath
showBuildReport BuildReport
r FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\n"
separate :: [(BuildReport, Maybe Repo)]
-> [(Repo, [BuildReport])]
separate :: [(BuildReport, Maybe Repo)] -> [(Repo, [BuildReport])]
separate = ([(BuildReport, Repo, RemoteRepo)] -> (Repo, [BuildReport]))
-> [[(BuildReport, Repo, RemoteRepo)]] -> [(Repo, [BuildReport])]
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 ]))
([[(BuildReport, Repo, RemoteRepo)]] -> [(Repo, [BuildReport])])
-> ([(BuildReport, Maybe Repo)]
-> [[(BuildReport, Repo, RemoteRepo)]])
-> [(BuildReport, Maybe Repo)]
-> [(Repo, [BuildReport])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([NonEmpty (BuildReport, Repo, RemoteRepo)]
-> [(BuildReport, Repo, RemoteRepo)])
-> [[NonEmpty (BuildReport, Repo, RemoteRepo)]]
-> [[(BuildReport, Repo, RemoteRepo)]]
forall a b. (a -> b) -> [a] -> [b]
map ((NonEmpty (BuildReport, Repo, RemoteRepo)
-> [(BuildReport, Repo, RemoteRepo)])
-> [NonEmpty (BuildReport, Repo, RemoteRepo)]
-> [(BuildReport, Repo, RemoteRepo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap NonEmpty (BuildReport, Repo, RemoteRepo)
-> [(BuildReport, Repo, RemoteRepo)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList)
([[NonEmpty (BuildReport, Repo, RemoteRepo)]]
-> [[(BuildReport, Repo, RemoteRepo)]])
-> ([(BuildReport, Maybe Repo)]
-> [[NonEmpty (BuildReport, Repo, RemoteRepo)]])
-> [(BuildReport, Maybe Repo)]
-> [[(BuildReport, Repo, RemoteRepo)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty (BuildReport, Repo, RemoteRepo)
-> NonEmpty (BuildReport, Repo, RemoteRepo) -> Bool)
-> [NonEmpty (BuildReport, Repo, RemoteRepo)]
-> [[NonEmpty (BuildReport, Repo, RemoteRepo)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy ((NonEmpty (BuildReport, Repo, RemoteRepo) -> RepoName)
-> NonEmpty (BuildReport, Repo, RemoteRepo)
-> NonEmpty (BuildReport, Repo, RemoteRepo)
-> Bool
forall a b. Eq a => (b -> a) -> b -> b -> Bool
equating ((BuildReport, Repo, RemoteRepo) -> RepoName
forall a b. (a, b, RemoteRepo) -> RepoName
repoName' ((BuildReport, Repo, RemoteRepo) -> RepoName)
-> (NonEmpty (BuildReport, Repo, RemoteRepo)
-> (BuildReport, Repo, RemoteRepo))
-> NonEmpty (BuildReport, Repo, RemoteRepo)
-> RepoName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (BuildReport, Repo, RemoteRepo)
-> (BuildReport, Repo, RemoteRepo)
forall a. NonEmpty a -> a
head))
([NonEmpty (BuildReport, Repo, RemoteRepo)]
-> [[NonEmpty (BuildReport, Repo, RemoteRepo)]])
-> ([(BuildReport, Maybe Repo)]
-> [NonEmpty (BuildReport, Repo, RemoteRepo)])
-> [(BuildReport, Maybe Repo)]
-> [[NonEmpty (BuildReport, Repo, RemoteRepo)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty (BuildReport, Repo, RemoteRepo)
-> NonEmpty (BuildReport, Repo, RemoteRepo) -> Ordering)
-> [NonEmpty (BuildReport, Repo, RemoteRepo)]
-> [NonEmpty (BuildReport, Repo, RemoteRepo)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((NonEmpty (BuildReport, Repo, RemoteRepo) -> RepoName)
-> NonEmpty (BuildReport, Repo, RemoteRepo)
-> NonEmpty (BuildReport, Repo, RemoteRepo)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((BuildReport, Repo, RemoteRepo) -> RepoName
forall a b. (a, b, RemoteRepo) -> RepoName
repoName' ((BuildReport, Repo, RemoteRepo) -> RepoName)
-> (NonEmpty (BuildReport, Repo, RemoteRepo)
-> (BuildReport, Repo, RemoteRepo))
-> NonEmpty (BuildReport, Repo, RemoteRepo)
-> RepoName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (BuildReport, Repo, RemoteRepo)
-> (BuildReport, Repo, RemoteRepo)
forall a. NonEmpty a -> a
head))
([NonEmpty (BuildReport, Repo, RemoteRepo)]
-> [NonEmpty (BuildReport, Repo, RemoteRepo)])
-> ([(BuildReport, Maybe Repo)]
-> [NonEmpty (BuildReport, Repo, RemoteRepo)])
-> [(BuildReport, Maybe Repo)]
-> [NonEmpty (BuildReport, Repo, RemoteRepo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((BuildReport, Repo, RemoteRepo)
-> (BuildReport, Repo, RemoteRepo) -> Bool)
-> [(BuildReport, Repo, RemoteRepo)]
-> [NonEmpty (BuildReport, Repo, RemoteRepo)]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> Bool) -> f a -> [NonEmpty a]
groupBy (((BuildReport, Repo, RemoteRepo) -> RepoName)
-> (BuildReport, Repo, RemoteRepo)
-> (BuildReport, Repo, RemoteRepo)
-> Bool
forall a b. Eq a => (b -> a) -> b -> b -> Bool
equating (BuildReport, Repo, RemoteRepo) -> RepoName
forall a b. (a, b, RemoteRepo) -> RepoName
repoName')
([(BuildReport, Repo, RemoteRepo)]
-> [NonEmpty (BuildReport, Repo, RemoteRepo)])
-> ([(BuildReport, Maybe Repo)]
-> [(BuildReport, Repo, RemoteRepo)])
-> [(BuildReport, Maybe Repo)]
-> [NonEmpty (BuildReport, Repo, RemoteRepo)]
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 = [IO ()] -> IO ()
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') <- [(FilePath, BuildReport)] -> [(FilePath, [BuildReport])]
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 = (BuildReport -> FilePath) -> [BuildReport] -> FilePath
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' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: BuildReport -> FilePath
showBuildReport BuildReport
r FilePath -> FilePath -> FilePath
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)
(FilePath -> UnitId
forall a. HasCallStack => FilePath -> a
error FilePath
"storeLocal: package key not available")
CompilerInfo
cinfo
Platform
platform
groupByFileName :: [(FilePath, b)] -> [(FilePath, [b])]
groupByFileName = ([(FilePath, b)] -> (FilePath, [b]))
-> [[(FilePath, b)]] -> [(FilePath, [b])]
forall a b. (a -> b) -> [a] -> [b]
map (\grp :: [(FilePath, b)]
grp@((FilePath
filename,b
_):[(FilePath, b)]
_) -> (FilePath
filename, ((FilePath, b) -> b) -> [(FilePath, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath, b) -> b
forall a b. (a, b) -> b
snd [(FilePath, b)]
grp))
([[(FilePath, b)]] -> [(FilePath, [b])])
-> ([(FilePath, b)] -> [[(FilePath, b)]])
-> [(FilePath, b)]
-> [(FilePath, [b])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath, b) -> (FilePath, b) -> Bool)
-> [(FilePath, b)] -> [[(FilePath, b)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy (((FilePath, b) -> FilePath)
-> (FilePath, b) -> (FilePath, b) -> Bool
forall a b. Eq a => (b -> a) -> b -> b -> Bool
equating (FilePath, b) -> FilePath
forall a b. (a, b) -> a
fst)
([(FilePath, b)] -> [[(FilePath, b)]])
-> ([(FilePath, b)] -> [(FilePath, b)])
-> [(FilePath, b)]
-> [[(FilePath, b)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath, b) -> (FilePath, b) -> Ordering)
-> [(FilePath, b)] -> [(FilePath, b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((FilePath, b) -> FilePath)
-> (FilePath, b) -> (FilePath, b) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (FilePath, b) -> FilePath
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 =
(PlanPackage -> Maybe (BuildReport, Maybe Repo))
-> [PlanPackage] -> [(BuildReport, Maybe Repo)]
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
(PlanPackage -> BuildOutcomes -> Maybe BuildOutcome
forall pkg failure result.
HasUnitId pkg =>
pkg
-> BuildOutcomes failure result -> Maybe (Either failure result)
InstallPlan.lookupBuildOutcome PlanPackage
pkg BuildOutcomes
buildOutcomes))
([PlanPackage] -> [(BuildReport, Maybe Repo)])
-> (InstallPlan -> [PlanPackage])
-> InstallPlan
-> [(BuildReport, Maybe Repo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstallPlan -> [PlanPackage]
forall ipkg srcpkg.
GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg]
InstallPlan.toList
(InstallPlan -> [(BuildReport, Maybe Repo)])
-> InstallPlan -> [(BuildReport, Maybe Repo)]
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) =
(BuildReport, Maybe Repo) -> Maybe (BuildReport, Maybe Repo)
forall a. a -> Maybe a
Just ( OS
-> Arch
-> CompilerId
-> PackageIdentifier
-> FlagAssignment
-> [PackageIdentifier]
-> BuildOutcome
-> BuildReport
newBuildReport OS
os Arch
arch CompilerId
comp
(SourcePackage UnresolvedPkgLoc -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId SourcePackage UnresolvedPkgLoc
srcPkg) FlagAssignment
flags
((ConfiguredId -> PackageIdentifier)
-> [ConfiguredId] -> [PackageIdentifier]
forall a b. (a -> b) -> [a] -> [b]
map ConfiguredId -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId (ComponentDeps [ConfiguredId] -> [ConfiguredId]
forall a. Monoid a => ComponentDeps a -> a
CD.nonSetupDeps ComponentDeps [ConfiguredId]
deps))
BuildOutcome
buildResult
, SourcePackage UnresolvedPkgLoc -> Maybe Repo
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
_ })
= Repo -> Maybe Repo
forall a. a -> Maybe a
Just Repo
repo
extractRepo SourcePackage (PackageLocation local)
_ = Maybe Repo
forall a. Maybe a
Nothing
fromPlanPackage Platform
_ CompilerId
_ PlanPackage
_ Maybe BuildOutcome
_ = Maybe (BuildReport, Maybe Repo)
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 [] (BuildFailure -> BuildOutcome
forall a b. a -> Either a b
Left BuildFailure
PlanningFailed), Maybe Repo
forall a. Maybe a
Nothing)
| PackageIdentifier
pkgid <- [PackageIdentifier]
pkgids ]