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