{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE OverloadedStrings #-}
module Distribution.Client.BuildReports.Anonymous (
BuildReport(..),
InstallOutcome(..),
Outcome(..),
newBuildReport,
parseBuildReport,
parseBuildReportList,
showBuildReport,
cabalInstallID
) where
import Distribution.Client.Compat.Prelude
import Prelude ()
import Distribution.CabalSpecVersion
import Distribution.Client.BuildReports.Types
import Distribution.Client.Version (cabalInstallVersion)
import Distribution.Compiler (CompilerId (..))
import Distribution.FieldGrammar
import Distribution.Fields
import Distribution.Package (PackageIdentifier (..), mkPackageName)
import Distribution.PackageDescription (FlagAssignment)
import Distribution.Parsec
import Distribution.System (Arch, OS)
import qualified Distribution.Client.BuildReports.Lens as L
import qualified Distribution.Client.Types as BR (BuildFailure (..), BuildOutcome, BuildResult (..), DocsResult (..), TestsResult (..))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
newBuildReport :: OS -> Arch -> CompilerId -> PackageIdentifier -> FlagAssignment
-> [PackageIdentifier] -> BR.BuildOutcome -> BuildReport
newBuildReport :: OS
-> Arch
-> CompilerId
-> PackageIdentifier
-> FlagAssignment
-> [PackageIdentifier]
-> BuildOutcome
-> BuildReport
newBuildReport OS
os' Arch
arch' CompilerId
comp PackageIdentifier
pkgid FlagAssignment
flags [PackageIdentifier]
deps BuildOutcome
result =
BuildReport :: PackageIdentifier
-> OS
-> Arch
-> CompilerId
-> PackageIdentifier
-> FlagAssignment
-> [PackageIdentifier]
-> InstallOutcome
-> Outcome
-> Outcome
-> BuildReport
BuildReport {
package :: PackageIdentifier
package = PackageIdentifier
pkgid,
os :: OS
os = OS
os',
arch :: Arch
arch = Arch
arch',
compiler :: CompilerId
compiler = CompilerId
comp,
client :: PackageIdentifier
client = PackageIdentifier
cabalInstallID,
flagAssignment :: FlagAssignment
flagAssignment = FlagAssignment
flags,
dependencies :: [PackageIdentifier]
dependencies = [PackageIdentifier]
deps,
installOutcome :: InstallOutcome
installOutcome = InstallOutcome
convertInstallOutcome,
docsOutcome :: Outcome
docsOutcome = Outcome
convertDocsOutcome,
testsOutcome :: Outcome
testsOutcome = Outcome
convertTestsOutcome
}
where
convertInstallOutcome :: InstallOutcome
convertInstallOutcome = case BuildOutcome
result of
Left BuildFailure
BR.PlanningFailed -> InstallOutcome
PlanningFailed
Left (BR.DependentFailed PackageIdentifier
p) -> PackageIdentifier -> InstallOutcome
DependencyFailed PackageIdentifier
p
Left (BR.DownloadFailed SomeException
_) -> InstallOutcome
DownloadFailed
Left (BR.UnpackFailed SomeException
_) -> InstallOutcome
UnpackFailed
Left (BR.ConfigureFailed SomeException
_) -> InstallOutcome
ConfigureFailed
Left (BR.BuildFailed SomeException
_) -> InstallOutcome
BuildFailed
Left (BR.TestsFailed SomeException
_) -> InstallOutcome
TestsFailed
Left (BR.InstallFailed SomeException
_) -> InstallOutcome
InstallFailed
Right (BR.BuildResult DocsResult
_ TestsResult
_ Maybe InstalledPackageInfo
_) -> InstallOutcome
InstallOk
convertDocsOutcome :: Outcome
convertDocsOutcome = case BuildOutcome
result of
Left BuildFailure
_ -> Outcome
NotTried
Right (BR.BuildResult DocsResult
BR.DocsNotTried TestsResult
_ Maybe InstalledPackageInfo
_) -> Outcome
NotTried
Right (BR.BuildResult DocsResult
BR.DocsFailed TestsResult
_ Maybe InstalledPackageInfo
_) -> Outcome
Failed
Right (BR.BuildResult DocsResult
BR.DocsOk TestsResult
_ Maybe InstalledPackageInfo
_) -> Outcome
Ok
convertTestsOutcome :: Outcome
convertTestsOutcome = case BuildOutcome
result of
Left (BR.TestsFailed SomeException
_) -> Outcome
Failed
Left BuildFailure
_ -> Outcome
NotTried
Right (BR.BuildResult DocsResult
_ TestsResult
BR.TestsNotTried Maybe InstalledPackageInfo
_) -> Outcome
NotTried
Right (BR.BuildResult DocsResult
_ TestsResult
BR.TestsOk Maybe InstalledPackageInfo
_) -> Outcome
Ok
cabalInstallID :: PackageIdentifier
cabalInstallID :: PackageIdentifier
cabalInstallID =
PackageName -> Version -> PackageIdentifier
PackageIdentifier (String -> PackageName
mkPackageName String
"cabal-install") Version
cabalInstallVersion
fieldDescrs
:: ( Applicative (g BuildReport), FieldGrammar c g
, c (Identity Arch)
, c (Identity CompilerId)
, c (Identity FlagAssignment)
, c (Identity InstallOutcome)
, c (Identity OS)
, c (Identity Outcome)
, c (Identity PackageIdentifier)
, c (List VCat (Identity PackageIdentifier) PackageIdentifier)
)
=> g BuildReport BuildReport
fieldDescrs :: g BuildReport BuildReport
fieldDescrs = PackageIdentifier
-> OS
-> Arch
-> CompilerId
-> PackageIdentifier
-> FlagAssignment
-> [PackageIdentifier]
-> InstallOutcome
-> Outcome
-> Outcome
-> BuildReport
BuildReport
(PackageIdentifier
-> OS
-> Arch
-> CompilerId
-> PackageIdentifier
-> FlagAssignment
-> [PackageIdentifier]
-> InstallOutcome
-> Outcome
-> Outcome
-> BuildReport)
-> g BuildReport PackageIdentifier
-> g BuildReport
(OS
-> Arch
-> CompilerId
-> PackageIdentifier
-> FlagAssignment
-> [PackageIdentifier]
-> InstallOutcome
-> Outcome
-> Outcome
-> BuildReport)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FieldName
-> ALens' BuildReport PackageIdentifier
-> g BuildReport PackageIdentifier
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s a -> g s a
uniqueField FieldName
"package" ALens' BuildReport PackageIdentifier
Lens' BuildReport PackageIdentifier
L.package
g BuildReport
(OS
-> Arch
-> CompilerId
-> PackageIdentifier
-> FlagAssignment
-> [PackageIdentifier]
-> InstallOutcome
-> Outcome
-> Outcome
-> BuildReport)
-> g BuildReport OS
-> g BuildReport
(Arch
-> CompilerId
-> PackageIdentifier
-> FlagAssignment
-> [PackageIdentifier]
-> InstallOutcome
-> Outcome
-> Outcome
-> BuildReport)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName -> ALens' BuildReport OS -> g BuildReport OS
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s a -> g s a
uniqueField FieldName
"os" ALens' BuildReport OS
Lens' BuildReport OS
L.os
g BuildReport
(Arch
-> CompilerId
-> PackageIdentifier
-> FlagAssignment
-> [PackageIdentifier]
-> InstallOutcome
-> Outcome
-> Outcome
-> BuildReport)
-> g BuildReport Arch
-> g BuildReport
(CompilerId
-> PackageIdentifier
-> FlagAssignment
-> [PackageIdentifier]
-> InstallOutcome
-> Outcome
-> Outcome
-> BuildReport)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName -> ALens' BuildReport Arch -> g BuildReport Arch
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s a -> g s a
uniqueField FieldName
"arch" ALens' BuildReport Arch
Lens' BuildReport Arch
L.arch
g BuildReport
(CompilerId
-> PackageIdentifier
-> FlagAssignment
-> [PackageIdentifier]
-> InstallOutcome
-> Outcome
-> Outcome
-> BuildReport)
-> g BuildReport CompilerId
-> g BuildReport
(PackageIdentifier
-> FlagAssignment
-> [PackageIdentifier]
-> InstallOutcome
-> Outcome
-> Outcome
-> BuildReport)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' BuildReport CompilerId -> g BuildReport CompilerId
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s a -> g s a
uniqueField FieldName
"compiler" ALens' BuildReport CompilerId
Lens' BuildReport CompilerId
L.compiler
g BuildReport
(PackageIdentifier
-> FlagAssignment
-> [PackageIdentifier]
-> InstallOutcome
-> Outcome
-> Outcome
-> BuildReport)
-> g BuildReport PackageIdentifier
-> g BuildReport
(FlagAssignment
-> [PackageIdentifier]
-> InstallOutcome
-> Outcome
-> Outcome
-> BuildReport)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' BuildReport PackageIdentifier
-> g BuildReport PackageIdentifier
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s a -> g s a
uniqueField FieldName
"client" ALens' BuildReport PackageIdentifier
Lens' BuildReport PackageIdentifier
L.client
g BuildReport
(FlagAssignment
-> [PackageIdentifier]
-> InstallOutcome
-> Outcome
-> Outcome
-> BuildReport)
-> g BuildReport FlagAssignment
-> g BuildReport
([PackageIdentifier]
-> InstallOutcome -> Outcome -> Outcome -> BuildReport)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' BuildReport FlagAssignment
-> g BuildReport FlagAssignment
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a), Monoid a) =>
FieldName -> ALens' s a -> g s a
monoidalField FieldName
"flags" ALens' BuildReport FlagAssignment
Lens' BuildReport FlagAssignment
L.flagAssignment
g BuildReport
([PackageIdentifier]
-> InstallOutcome -> Outcome -> Outcome -> BuildReport)
-> g BuildReport [PackageIdentifier]
-> g BuildReport
(InstallOutcome -> Outcome -> Outcome -> BuildReport)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ([PackageIdentifier]
-> List VCat (Identity PackageIdentifier) PackageIdentifier)
-> ALens' BuildReport [PackageIdentifier]
-> g BuildReport [PackageIdentifier]
forall (c :: * -> Constraint) (g :: * -> * -> *) b a s.
(FieldGrammar c g, c b, Monoid a, Newtype a b) =>
FieldName -> (a -> b) -> ALens' s a -> g s a
monoidalFieldAla FieldName
"dependencies" (VCat
-> [PackageIdentifier]
-> List VCat (Identity PackageIdentifier) PackageIdentifier
forall sep a. sep -> [a] -> List sep (Identity a) a
alaList VCat
VCat) ALens' BuildReport [PackageIdentifier]
Lens' BuildReport [PackageIdentifier]
L.dependencies
g BuildReport (InstallOutcome -> Outcome -> Outcome -> BuildReport)
-> g BuildReport InstallOutcome
-> g BuildReport (Outcome -> Outcome -> BuildReport)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName
-> ALens' BuildReport InstallOutcome
-> g BuildReport InstallOutcome
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s a -> g s a
uniqueField FieldName
"install-outcome" ALens' BuildReport InstallOutcome
Lens' BuildReport InstallOutcome
L.installOutcome
g BuildReport (Outcome -> Outcome -> BuildReport)
-> g BuildReport Outcome -> g BuildReport (Outcome -> BuildReport)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName -> ALens' BuildReport Outcome -> g BuildReport Outcome
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s a -> g s a
uniqueField FieldName
"docs-outcome" ALens' BuildReport Outcome
Lens' BuildReport Outcome
L.docsOutcome
g BuildReport (Outcome -> BuildReport)
-> g BuildReport Outcome -> g BuildReport BuildReport
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FieldName -> ALens' BuildReport Outcome -> g BuildReport Outcome
forall (c :: * -> Constraint) (g :: * -> * -> *) a s.
(FieldGrammar c g, c (Identity a)) =>
FieldName -> ALens' s a -> g s a
uniqueField FieldName
"tests-outcome" ALens' BuildReport Outcome
Lens' BuildReport Outcome
L.testsOutcome
parseBuildReport :: BS.ByteString -> Either String BuildReport
parseBuildReport :: FieldName -> Either String BuildReport
parseBuildReport FieldName
s = case ([PWarning], Either (Maybe Version, NonEmpty PError) BuildReport)
-> Either (Maybe Version, NonEmpty PError) BuildReport
forall a b. (a, b) -> b
snd (([PWarning], Either (Maybe Version, NonEmpty PError) BuildReport)
-> Either (Maybe Version, NonEmpty PError) BuildReport)
-> ([PWarning],
Either (Maybe Version, NonEmpty PError) BuildReport)
-> Either (Maybe Version, NonEmpty PError) BuildReport
forall a b. (a -> b) -> a -> b
$ ParseResult BuildReport
-> ([PWarning],
Either (Maybe Version, NonEmpty PError) BuildReport)
forall a.
ParseResult a
-> ([PWarning], Either (Maybe Version, NonEmpty PError) a)
runParseResult (ParseResult BuildReport
-> ([PWarning],
Either (Maybe Version, NonEmpty PError) BuildReport))
-> ParseResult BuildReport
-> ([PWarning],
Either (Maybe Version, NonEmpty PError) BuildReport)
forall a b. (a -> b) -> a -> b
$ FieldName -> ParseResult BuildReport
parseFields FieldName
s of
Left (Maybe Version
_, NonEmpty PError
perrors) -> String -> Either String BuildReport
forall a b. a -> Either a b
Left (String -> Either String BuildReport)
-> String -> Either String BuildReport
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [ String
err | PError Position
_ String
err <- NonEmpty PError -> [PError]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty PError
perrors ]
Right BuildReport
report -> BuildReport -> Either String BuildReport
forall a b. b -> Either a b
Right BuildReport
report
parseFields :: BS.ByteString -> ParseResult BuildReport
parseFields :: FieldName -> ParseResult BuildReport
parseFields FieldName
input = do
[Field Position]
fields <- (ParseError -> ParseResult [Field Position])
-> ([Field Position] -> ParseResult [Field Position])
-> Either ParseError [Field Position]
-> ParseResult [Field Position]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Position -> String -> ParseResult [Field Position]
forall a. Position -> String -> ParseResult a
parseFatalFailure Position
zeroPos (String -> ParseResult [Field Position])
-> (ParseError -> String)
-> ParseError
-> ParseResult [Field Position]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> String
forall a. Show a => a -> String
show) [Field Position] -> ParseResult [Field Position]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParseError [Field Position]
-> ParseResult [Field Position])
-> Either ParseError [Field Position]
-> ParseResult [Field Position]
forall a b. (a -> b) -> a -> b
$ FieldName -> Either ParseError [Field Position]
readFields FieldName
input
case [Field Position] -> (Fields Position, [[Section Position]])
forall ann. [Field ann] -> (Fields ann, [[Section ann]])
partitionFields [Field Position]
fields of
(Fields Position
fields', []) -> CabalSpecVersion
-> Fields Position
-> ParsecFieldGrammar BuildReport BuildReport
-> ParseResult BuildReport
forall s a.
CabalSpecVersion
-> Fields Position -> ParsecFieldGrammar s a -> ParseResult a
parseFieldGrammar CabalSpecVersion
CabalSpecV2_4 Fields Position
fields' ParsecFieldGrammar BuildReport BuildReport
forall (g :: * -> * -> *) (c :: * -> Constraint).
(Applicative (g BuildReport), FieldGrammar c g, c (Identity Arch),
c (Identity CompilerId), c (Identity FlagAssignment),
c (Identity InstallOutcome), c (Identity OS), c (Identity Outcome),
c (Identity PackageIdentifier),
c (List VCat (Identity PackageIdentifier) PackageIdentifier)) =>
g BuildReport BuildReport
fieldDescrs
(Fields Position, [[Section Position]])
_otherwise -> Position -> String -> ParseResult BuildReport
forall a. Position -> String -> ParseResult a
parseFatalFailure Position
zeroPos String
"found sections in BuildReport"
parseBuildReportList :: BS.ByteString -> [BuildReport]
parseBuildReportList :: FieldName -> [BuildReport]
parseBuildReportList FieldName
str =
[ BuildReport
report | Right BuildReport
report <- (FieldName -> Either String BuildReport)
-> [FieldName] -> [Either String BuildReport]
forall a b. (a -> b) -> [a] -> [b]
map FieldName -> Either String BuildReport
parseBuildReport (FieldName -> [FieldName]
split FieldName
str) ]
where
split :: BS.ByteString -> [BS.ByteString]
split :: FieldName -> [FieldName]
split = (FieldName -> Bool) -> [FieldName] -> [FieldName]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FieldName -> Bool) -> FieldName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldName -> Bool
BS.null) ([FieldName] -> [FieldName])
-> (FieldName -> [FieldName]) -> FieldName -> [FieldName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([FieldName] -> Maybe (FieldName, [FieldName]))
-> [FieldName] -> [FieldName]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr [FieldName] -> Maybe (FieldName, [FieldName])
chunk ([FieldName] -> [FieldName])
-> (FieldName -> [FieldName]) -> FieldName -> [FieldName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldName -> [FieldName]
BS8.lines
chunk :: [FieldName] -> Maybe (FieldName, [FieldName])
chunk [] = Maybe (FieldName, [FieldName])
forall a. Maybe a
Nothing
chunk [FieldName]
ls = case (FieldName -> Bool) -> [FieldName] -> ([FieldName], [FieldName])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break FieldName -> Bool
BS.null [FieldName]
ls of
([FieldName]
r, [FieldName]
rs) -> (FieldName, [FieldName]) -> Maybe (FieldName, [FieldName])
forall a. a -> Maybe a
Just ([FieldName] -> FieldName
BS8.unlines [FieldName]
r, (FieldName -> Bool) -> [FieldName] -> [FieldName]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile FieldName -> Bool
BS.null [FieldName]
rs)
showBuildReport :: BuildReport -> String
showBuildReport :: BuildReport -> String
showBuildReport = (() -> CommentPosition) -> [PrettyField ()] -> String
forall ann. (ann -> CommentPosition) -> [PrettyField ann] -> String
showFields (CommentPosition -> () -> CommentPosition
forall a b. a -> b -> a
const CommentPosition
NoComment) ([PrettyField ()] -> String)
-> (BuildReport -> [PrettyField ()]) -> BuildReport -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CabalSpecVersion
-> PrettyFieldGrammar BuildReport BuildReport
-> BuildReport
-> [PrettyField ()]
forall s a.
CabalSpecVersion -> PrettyFieldGrammar s a -> s -> [PrettyField ()]
prettyFieldGrammar CabalSpecVersion
CabalSpecV2_4 PrettyFieldGrammar BuildReport BuildReport
forall (g :: * -> * -> *) (c :: * -> Constraint).
(Applicative (g BuildReport), FieldGrammar c g, c (Identity Arch),
c (Identity CompilerId), c (Identity FlagAssignment),
c (Identity InstallOutcome), c (Identity OS), c (Identity Outcome),
c (Identity PackageIdentifier),
c (List VCat (Identity PackageIdentifier) PackageIdentifier)) =>
g BuildReport BuildReport
fieldDescrs