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