module Distribution.Client.BuildReports.Lens (
    BuildReport,
    module Distribution.Client.BuildReports.Lens,
) where

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

import Distribution.Client.BuildReports.Types (BuildReport, InstallOutcome, Outcome)
import Distribution.Compiler                  (CompilerId)
import Distribution.System                    (Arch, OS)
import Distribution.Types.Flag                (FlagAssignment)
import Distribution.Types.PackageId           (PackageIdentifier)

import qualified Distribution.Client.BuildReports.Types as T

package :: Lens' BuildReport PackageIdentifier
package :: LensLike
  f BuildReport BuildReport PackageIdentifier PackageIdentifier
package PackageIdentifier -> f PackageIdentifier
f BuildReport
s = (PackageIdentifier -> BuildReport)
-> f PackageIdentifier -> f BuildReport
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\PackageIdentifier
x -> BuildReport
s { package :: PackageIdentifier
T.package = PackageIdentifier
x }) (PackageIdentifier -> f PackageIdentifier
f (BuildReport -> PackageIdentifier
T.package BuildReport
s))

os :: Lens' BuildReport OS
os :: LensLike f BuildReport BuildReport OS OS
os OS -> f OS
f BuildReport
s = (OS -> BuildReport) -> f OS -> f BuildReport
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\OS
x -> BuildReport
s { os :: OS
T.os = OS
x }) (OS -> f OS
f (BuildReport -> OS
T.os BuildReport
s))

arch :: Lens' BuildReport Arch
arch :: LensLike f BuildReport BuildReport Arch Arch
arch Arch -> f Arch
f BuildReport
s = (Arch -> BuildReport) -> f Arch -> f BuildReport
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Arch
x -> BuildReport
s { arch :: Arch
T.arch = Arch
x }) (Arch -> f Arch
f (BuildReport -> Arch
T.arch BuildReport
s))

compiler :: Lens' BuildReport CompilerId
compiler :: LensLike f BuildReport BuildReport CompilerId CompilerId
compiler CompilerId -> f CompilerId
f BuildReport
s = (CompilerId -> BuildReport) -> f CompilerId -> f BuildReport
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\CompilerId
x -> BuildReport
s { compiler :: CompilerId
T.compiler = CompilerId
x }) (CompilerId -> f CompilerId
f (BuildReport -> CompilerId
T.compiler BuildReport
s))

client :: Lens' BuildReport PackageIdentifier
client :: LensLike
  f BuildReport BuildReport PackageIdentifier PackageIdentifier
client PackageIdentifier -> f PackageIdentifier
f BuildReport
s = (PackageIdentifier -> BuildReport)
-> f PackageIdentifier -> f BuildReport
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\PackageIdentifier
x -> BuildReport
s { client :: PackageIdentifier
T.client = PackageIdentifier
x }) (PackageIdentifier -> f PackageIdentifier
f (BuildReport -> PackageIdentifier
T.client BuildReport
s))

flagAssignment :: Lens' BuildReport FlagAssignment
flagAssignment :: LensLike f BuildReport BuildReport FlagAssignment FlagAssignment
flagAssignment FlagAssignment -> f FlagAssignment
f BuildReport
s = (FlagAssignment -> BuildReport)
-> f FlagAssignment -> f BuildReport
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\FlagAssignment
x -> BuildReport
s { flagAssignment :: FlagAssignment
T.flagAssignment = FlagAssignment
x }) (FlagAssignment -> f FlagAssignment
f (BuildReport -> FlagAssignment
T.flagAssignment BuildReport
s))

dependencies :: Lens' BuildReport [PackageIdentifier]
dependencies :: LensLike
  f BuildReport BuildReport [PackageIdentifier] [PackageIdentifier]
dependencies [PackageIdentifier] -> f [PackageIdentifier]
f BuildReport
s = ([PackageIdentifier] -> BuildReport)
-> f [PackageIdentifier] -> f BuildReport
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[PackageIdentifier]
x -> BuildReport
s { dependencies :: [PackageIdentifier]
T.dependencies = [PackageIdentifier]
x }) ([PackageIdentifier] -> f [PackageIdentifier]
f (BuildReport -> [PackageIdentifier]
T.dependencies BuildReport
s))

installOutcome :: Lens' BuildReport InstallOutcome
installOutcome :: LensLike f BuildReport BuildReport InstallOutcome InstallOutcome
installOutcome InstallOutcome -> f InstallOutcome
f BuildReport
s = (InstallOutcome -> BuildReport)
-> f InstallOutcome -> f BuildReport
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\InstallOutcome
x -> BuildReport
s { installOutcome :: InstallOutcome
T.installOutcome = InstallOutcome
x }) (InstallOutcome -> f InstallOutcome
f (BuildReport -> InstallOutcome
T.installOutcome BuildReport
s))

docsOutcome :: Lens' BuildReport Outcome
docsOutcome :: LensLike f BuildReport BuildReport Outcome Outcome
docsOutcome Outcome -> f Outcome
f BuildReport
s = (Outcome -> BuildReport) -> f Outcome -> f BuildReport
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Outcome
x -> BuildReport
s { docsOutcome :: Outcome
T.docsOutcome = Outcome
x }) (Outcome -> f Outcome
f (BuildReport -> Outcome
T.docsOutcome BuildReport
s))

testsOutcome :: Lens' BuildReport Outcome
testsOutcome :: LensLike f BuildReport BuildReport Outcome Outcome
testsOutcome Outcome -> f Outcome
f BuildReport
s = (Outcome -> BuildReport) -> f Outcome -> f BuildReport
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Outcome
x -> BuildReport
s { testsOutcome :: Outcome
T.testsOutcome = Outcome
x }) (Outcome -> f Outcome
f (BuildReport -> Outcome
T.testsOutcome BuildReport
s))