1{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-} 2----------------------------------------------------------------------------- 3-- | 4-- Module : Distribution.Client.Reporting 5-- Copyright : (c) David Waern 2008 6-- License : BSD-like 7-- 8-- Maintainer : david.waern@gmail.com 9-- Stability : experimental 10-- Portability : portable 11-- 12-- Anonymous build report data structure, printing and parsing 13-- 14----------------------------------------------------------------------------- 15module Distribution.Client.BuildReports.Storage ( 16 17 -- * Storing and retrieving build reports 18 storeAnonymous, 19 storeLocal, 20-- retrieve, 21 22 -- * 'InstallPlan' support 23 fromInstallPlan, 24 fromPlanningFailure, 25 ) where 26 27import Distribution.Client.Compat.Prelude 28import Prelude () 29 30import Distribution.Client.BuildReports.Anonymous (BuildReport, showBuildReport, newBuildReport) 31import qualified Distribution.Client.BuildReports.Anonymous as BuildReport 32 33import Distribution.Client.Types 34import qualified Distribution.Client.InstallPlan as InstallPlan 35import Distribution.Client.InstallPlan 36 ( InstallPlan ) 37 38import qualified Distribution.Solver.Types.ComponentDeps as CD 39import Distribution.Solver.Types.SourcePackage 40 41import Distribution.Package 42 ( PackageId, packageId ) 43import Distribution.PackageDescription 44 ( FlagAssignment ) 45import Distribution.Simple.InstallDirs 46 ( PathTemplate, fromPathTemplate 47 , initialPathTemplateEnv, substPathTemplate ) 48import Distribution.System 49 ( Platform(Platform) ) 50import Distribution.Compiler 51 ( CompilerId(..), CompilerInfo(..) ) 52import Distribution.Simple.Utils 53 ( equating ) 54 55import Data.List.NonEmpty 56 ( groupBy ) 57import qualified Data.List as L 58import System.FilePath 59 ( (</>), takeDirectory ) 60import System.Directory 61 ( createDirectoryIfMissing ) 62 63storeAnonymous :: [(BuildReport, Maybe Repo)] -> IO () 64storeAnonymous reports = sequence_ 65 [ appendFile file (concatMap format reports') 66 | (repo, reports') <- separate reports 67 , let file = repoLocalDir repo </> "build-reports.log" ] 68 --TODO: make this concurrency safe, either lock the report file or make sure 69 -- the writes for each report are atomic (under 4k and flush at boundaries) 70 71 where 72 format r = '\n' : showBuildReport r ++ "\n" 73 separate :: [(BuildReport, Maybe Repo)] 74 -> [(Repo, [BuildReport])] 75 separate = map (\rs@((_,repo,_):_) -> (repo, [ r | (r,_,_) <- rs ])) 76 . map (concatMap toList) 77 . L.groupBy (equating (repoName' . head)) 78 . sortBy (comparing (repoName' . head)) 79 . groupBy (equating repoName') 80 . onlyRemote 81 82 repoName' (_,_,rrepo) = remoteRepoName rrepo 83 84 onlyRemote :: [(BuildReport, Maybe Repo)] 85 -> [(BuildReport, Repo, RemoteRepo)] 86 onlyRemote rs = 87 [ (report, repo, remoteRepo) 88 | (report, Just repo) <- rs 89 , Just remoteRepo <- [maybeRepoRemote repo] 90 ] 91 92storeLocal :: CompilerInfo -> [PathTemplate] -> [(BuildReport, Maybe Repo)] 93 -> Platform -> IO () 94storeLocal cinfo templates reports platform = sequence_ 95 [ do createDirectoryIfMissing True (takeDirectory file) 96 appendFile file output 97 --TODO: make this concurrency safe, either lock the report file or make 98 -- sure the writes for each report are atomic 99 | (file, reports') <- groupByFileName 100 [ (reportFileName template report, report) 101 | template <- templates 102 , (report, _repo) <- reports ] 103 , let output = concatMap format reports' 104 ] 105 where 106 format r = '\n' : showBuildReport r ++ "\n" 107 108 reportFileName template report = 109 fromPathTemplate (substPathTemplate env template) 110 where env = initialPathTemplateEnv 111 (BuildReport.package report) 112 -- TODO: In principle, we can support $pkgkey, but only 113 -- if the configure step succeeds. So add a Maybe field 114 -- to the build report, and either use that or make up 115 -- a fake identifier if it's not available. 116 (error "storeLocal: package key not available") 117 cinfo 118 platform 119 120 groupByFileName = map (\grp@((filename,_):_) -> (filename, map snd grp)) 121 . L.groupBy (equating fst) 122 . sortBy (comparing fst) 123 124-- ------------------------------------------------------------ 125-- * InstallPlan support 126-- ------------------------------------------------------------ 127 128fromInstallPlan :: Platform -> CompilerId 129 -> InstallPlan 130 -> BuildOutcomes 131 -> [(BuildReport, Maybe Repo)] 132fromInstallPlan platform comp plan buildOutcomes = 133 mapMaybe (\pkg -> fromPlanPackage 134 platform comp pkg 135 (InstallPlan.lookupBuildOutcome pkg buildOutcomes)) 136 . InstallPlan.toList 137 $ plan 138 139fromPlanPackage :: Platform -> CompilerId 140 -> InstallPlan.PlanPackage 141 -> Maybe BuildOutcome 142 -> Maybe (BuildReport, Maybe Repo) 143fromPlanPackage (Platform arch os) comp 144 (InstallPlan.Configured (ConfiguredPackage _ srcPkg flags _ deps)) 145 (Just buildResult) = 146 Just ( newBuildReport os arch comp 147 (packageId srcPkg) flags 148 (map packageId (CD.nonSetupDeps deps)) 149 buildResult 150 , extractRepo srcPkg) 151 where 152 extractRepo (SourcePackage { srcpkgSource = RepoTarballPackage repo _ _ }) 153 = Just repo 154 extractRepo _ = Nothing 155 156fromPlanPackage _ _ _ _ = Nothing 157 158 159fromPlanningFailure :: Platform -> CompilerId 160 -> [PackageId] -> FlagAssignment -> [(BuildReport, Maybe Repo)] 161fromPlanningFailure (Platform arch os) comp pkgids flags = 162 [ (newBuildReport os arch comp pkgid flags [] (Left PlanningFailed), Nothing) 163 | pkgid <- pkgids ] 164