{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}

-----------------------------------------------------------------------------

-----------------------------------------------------------------------------

-- |
-- Module      :  Distribution.Client.Reporting
-- Copyright   :  (c) David Waern 2008
-- License     :  BSD-like
--
-- Maintainer  :  david.waern@gmail.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Anonymous build report data structure, printing and parsing
module Distribution.Client.BuildReports.Storage
  ( -- * Storing and retrieving build reports
    storeAnonymous
  , storeLocal
  --    retrieve,

    -- * 'InstallPlan' support
  , fromInstallPlan
  , fromPlanningFailure
  ) where

import Distribution.Client.Compat.Prelude
import Prelude ()

import Distribution.Client.BuildReports.Anonymous (BuildReport, newBuildReport, showBuildReport)
import qualified Distribution.Client.BuildReports.Anonymous as BuildReport

import Distribution.Client.InstallPlan
  ( InstallPlan
  )
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.Types

import qualified Distribution.Solver.Types.ComponentDeps as CD
import Distribution.Solver.Types.SourcePackage

import Distribution.Compiler
  ( CompilerId (..)
  , CompilerInfo (..)
  )
import Distribution.Package
  ( PackageId
  , packageId
  )
import Distribution.PackageDescription
  ( FlagAssignment
  )
import Distribution.Simple.InstallDirs
  ( PathTemplate
  , fromPathTemplate
  , initialPathTemplateEnv
  , substPathTemplate
  )
import Distribution.Simple.Utils
  ( equating
  )
import Distribution.System
  ( Platform (Platform)
  )

import qualified Data.List as L
import Data.List.NonEmpty
  ( groupBy
  )
import System.Directory
  ( createDirectoryIfMissing
  )
import System.FilePath
  ( takeDirectory
  , (</>)
  )

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
    -- TODO: make this concurrency safe, either lock the report file or make sure
    -- the writes for each report are atomic (under 4k and flush at boundaries)

    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 a. NonEmpty a -> [a]
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
    | -- TODO: make this concurrency safe, either lock the report file or make
    --      sure the writes for each report are atomic
    (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)
            -- TODO: In principle, we can support $pkgkey, but only
            -- if the configure step succeeds.  So add a Maybe field
            -- to the build report, and either use that or make up
            -- a fake identifier if it's not available.
            (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)

-- ------------------------------------------------------------

-- * InstallPlan support

-- ------------------------------------------------------------

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
  ]