{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
module Amazonka.CodeBuild.Types.ReportGroup where
import Amazonka.CodeBuild.Types.ReportExportConfig
import Amazonka.CodeBuild.Types.ReportGroupStatusType
import Amazonka.CodeBuild.Types.ReportType
import Amazonka.CodeBuild.Types.Tag
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
data ReportGroup = ReportGroup'
{
ReportGroup -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
ReportGroup -> Maybe POSIX
created :: Prelude.Maybe Data.POSIX,
ReportGroup -> Maybe ReportExportConfig
exportConfig :: Prelude.Maybe ReportExportConfig,
ReportGroup -> Maybe POSIX
lastModified :: Prelude.Maybe Data.POSIX,
ReportGroup -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
ReportGroup -> Maybe ReportGroupStatusType
status :: Prelude.Maybe ReportGroupStatusType,
ReportGroup -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
ReportGroup -> Maybe ReportType
type' :: Prelude.Maybe ReportType
}
deriving (ReportGroup -> ReportGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReportGroup -> ReportGroup -> Bool
$c/= :: ReportGroup -> ReportGroup -> Bool
== :: ReportGroup -> ReportGroup -> Bool
$c== :: ReportGroup -> ReportGroup -> Bool
Prelude.Eq, ReadPrec [ReportGroup]
ReadPrec ReportGroup
Int -> ReadS ReportGroup
ReadS [ReportGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReportGroup]
$creadListPrec :: ReadPrec [ReportGroup]
readPrec :: ReadPrec ReportGroup
$creadPrec :: ReadPrec ReportGroup
readList :: ReadS [ReportGroup]
$creadList :: ReadS [ReportGroup]
readsPrec :: Int -> ReadS ReportGroup
$creadsPrec :: Int -> ReadS ReportGroup
Prelude.Read, Int -> ReportGroup -> ShowS
[ReportGroup] -> ShowS
ReportGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReportGroup] -> ShowS
$cshowList :: [ReportGroup] -> ShowS
show :: ReportGroup -> String
$cshow :: ReportGroup -> String
showsPrec :: Int -> ReportGroup -> ShowS
$cshowsPrec :: Int -> ReportGroup -> ShowS
Prelude.Show, forall x. Rep ReportGroup x -> ReportGroup
forall x. ReportGroup -> Rep ReportGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReportGroup x -> ReportGroup
$cfrom :: forall x. ReportGroup -> Rep ReportGroup x
Prelude.Generic)
newReportGroup ::
ReportGroup
newReportGroup :: ReportGroup
newReportGroup =
ReportGroup'
{ $sel:arn:ReportGroup' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
$sel:created:ReportGroup' :: Maybe POSIX
created = forall a. Maybe a
Prelude.Nothing,
$sel:exportConfig:ReportGroup' :: Maybe ReportExportConfig
exportConfig = forall a. Maybe a
Prelude.Nothing,
$sel:lastModified:ReportGroup' :: Maybe POSIX
lastModified = forall a. Maybe a
Prelude.Nothing,
$sel:name:ReportGroup' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
$sel:status:ReportGroup' :: Maybe ReportGroupStatusType
status = forall a. Maybe a
Prelude.Nothing,
$sel:tags:ReportGroup' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
$sel:type':ReportGroup' :: Maybe ReportType
type' = forall a. Maybe a
Prelude.Nothing
}
reportGroup_arn :: Lens.Lens' ReportGroup (Prelude.Maybe Prelude.Text)
reportGroup_arn :: Lens' ReportGroup (Maybe Text)
reportGroup_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReportGroup' {Maybe Text
arn :: Maybe Text
$sel:arn:ReportGroup' :: ReportGroup -> Maybe Text
arn} -> Maybe Text
arn) (\s :: ReportGroup
s@ReportGroup' {} Maybe Text
a -> ReportGroup
s {$sel:arn:ReportGroup' :: Maybe Text
arn = Maybe Text
a} :: ReportGroup)
reportGroup_created :: Lens.Lens' ReportGroup (Prelude.Maybe Prelude.UTCTime)
reportGroup_created :: Lens' ReportGroup (Maybe UTCTime)
reportGroup_created = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReportGroup' {Maybe POSIX
created :: Maybe POSIX
$sel:created:ReportGroup' :: ReportGroup -> Maybe POSIX
created} -> Maybe POSIX
created) (\s :: ReportGroup
s@ReportGroup' {} Maybe POSIX
a -> ReportGroup
s {$sel:created:ReportGroup' :: Maybe POSIX
created = Maybe POSIX
a} :: ReportGroup) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time
reportGroup_exportConfig :: Lens.Lens' ReportGroup (Prelude.Maybe ReportExportConfig)
reportGroup_exportConfig :: Lens' ReportGroup (Maybe ReportExportConfig)
reportGroup_exportConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReportGroup' {Maybe ReportExportConfig
exportConfig :: Maybe ReportExportConfig
$sel:exportConfig:ReportGroup' :: ReportGroup -> Maybe ReportExportConfig
exportConfig} -> Maybe ReportExportConfig
exportConfig) (\s :: ReportGroup
s@ReportGroup' {} Maybe ReportExportConfig
a -> ReportGroup
s {$sel:exportConfig:ReportGroup' :: Maybe ReportExportConfig
exportConfig = Maybe ReportExportConfig
a} :: ReportGroup)
reportGroup_lastModified :: Lens.Lens' ReportGroup (Prelude.Maybe Prelude.UTCTime)
reportGroup_lastModified :: Lens' ReportGroup (Maybe UTCTime)
reportGroup_lastModified = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReportGroup' {Maybe POSIX
lastModified :: Maybe POSIX
$sel:lastModified:ReportGroup' :: ReportGroup -> Maybe POSIX
lastModified} -> Maybe POSIX
lastModified) (\s :: ReportGroup
s@ReportGroup' {} Maybe POSIX
a -> ReportGroup
s {$sel:lastModified:ReportGroup' :: Maybe POSIX
lastModified = Maybe POSIX
a} :: ReportGroup) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time
reportGroup_name :: Lens.Lens' ReportGroup (Prelude.Maybe Prelude.Text)
reportGroup_name :: Lens' ReportGroup (Maybe Text)
reportGroup_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReportGroup' {Maybe Text
name :: Maybe Text
$sel:name:ReportGroup' :: ReportGroup -> Maybe Text
name} -> Maybe Text
name) (\s :: ReportGroup
s@ReportGroup' {} Maybe Text
a -> ReportGroup
s {$sel:name:ReportGroup' :: Maybe Text
name = Maybe Text
a} :: ReportGroup)
reportGroup_status :: Lens.Lens' ReportGroup (Prelude.Maybe ReportGroupStatusType)
reportGroup_status :: Lens' ReportGroup (Maybe ReportGroupStatusType)
reportGroup_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReportGroup' {Maybe ReportGroupStatusType
status :: Maybe ReportGroupStatusType
$sel:status:ReportGroup' :: ReportGroup -> Maybe ReportGroupStatusType
status} -> Maybe ReportGroupStatusType
status) (\s :: ReportGroup
s@ReportGroup' {} Maybe ReportGroupStatusType
a -> ReportGroup
s {$sel:status:ReportGroup' :: Maybe ReportGroupStatusType
status = Maybe ReportGroupStatusType
a} :: ReportGroup)
reportGroup_tags :: Lens.Lens' ReportGroup (Prelude.Maybe [Tag])
reportGroup_tags :: Lens' ReportGroup (Maybe [Tag])
reportGroup_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReportGroup' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:ReportGroup' :: ReportGroup -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: ReportGroup
s@ReportGroup' {} Maybe [Tag]
a -> ReportGroup
s {$sel:tags:ReportGroup' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: ReportGroup) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced
reportGroup_type :: Lens.Lens' ReportGroup (Prelude.Maybe ReportType)
reportGroup_type :: Lens' ReportGroup (Maybe ReportType)
reportGroup_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReportGroup' {Maybe ReportType
type' :: Maybe ReportType
$sel:type':ReportGroup' :: ReportGroup -> Maybe ReportType
type'} -> Maybe ReportType
type') (\s :: ReportGroup
s@ReportGroup' {} Maybe ReportType
a -> ReportGroup
s {$sel:type':ReportGroup' :: Maybe ReportType
type' = Maybe ReportType
a} :: ReportGroup)
instance Data.FromJSON ReportGroup where
parseJSON :: Value -> Parser ReportGroup
parseJSON =
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
String
"ReportGroup"
( \Object
x ->
Maybe Text
-> Maybe POSIX
-> Maybe ReportExportConfig
-> Maybe POSIX
-> Maybe Text
-> Maybe ReportGroupStatusType
-> Maybe [Tag]
-> Maybe ReportType
-> ReportGroup
ReportGroup'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"arn")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"created")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"exportConfig")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"lastModified")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"name")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"status")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"tags" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"type")
)
instance Prelude.Hashable ReportGroup where
hashWithSalt :: Int -> ReportGroup -> Int
hashWithSalt Int
_salt ReportGroup' {Maybe [Tag]
Maybe Text
Maybe POSIX
Maybe ReportGroupStatusType
Maybe ReportType
Maybe ReportExportConfig
type' :: Maybe ReportType
tags :: Maybe [Tag]
status :: Maybe ReportGroupStatusType
name :: Maybe Text
lastModified :: Maybe POSIX
exportConfig :: Maybe ReportExportConfig
created :: Maybe POSIX
arn :: Maybe Text
$sel:type':ReportGroup' :: ReportGroup -> Maybe ReportType
$sel:tags:ReportGroup' :: ReportGroup -> Maybe [Tag]
$sel:status:ReportGroup' :: ReportGroup -> Maybe ReportGroupStatusType
$sel:name:ReportGroup' :: ReportGroup -> Maybe Text
$sel:lastModified:ReportGroup' :: ReportGroup -> Maybe POSIX
$sel:exportConfig:ReportGroup' :: ReportGroup -> Maybe ReportExportConfig
$sel:created:ReportGroup' :: ReportGroup -> Maybe POSIX
$sel:arn:ReportGroup' :: ReportGroup -> Maybe Text
..} =
Int
_salt
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
arn
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
created
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ReportExportConfig
exportConfig
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
lastModified
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ReportGroupStatusType
status
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ReportType
type'
instance Prelude.NFData ReportGroup where
rnf :: ReportGroup -> ()
rnf ReportGroup' {Maybe [Tag]
Maybe Text
Maybe POSIX
Maybe ReportGroupStatusType
Maybe ReportType
Maybe ReportExportConfig
type' :: Maybe ReportType
tags :: Maybe [Tag]
status :: Maybe ReportGroupStatusType
name :: Maybe Text
lastModified :: Maybe POSIX
exportConfig :: Maybe ReportExportConfig
created :: Maybe POSIX
arn :: Maybe Text
$sel:type':ReportGroup' :: ReportGroup -> Maybe ReportType
$sel:tags:ReportGroup' :: ReportGroup -> Maybe [Tag]
$sel:status:ReportGroup' :: ReportGroup -> Maybe ReportGroupStatusType
$sel:name:ReportGroup' :: ReportGroup -> Maybe Text
$sel:lastModified:ReportGroup' :: ReportGroup -> Maybe POSIX
$sel:exportConfig:ReportGroup' :: ReportGroup -> Maybe ReportExportConfig
$sel:created:ReportGroup' :: ReportGroup -> Maybe POSIX
$sel:arn:ReportGroup' :: ReportGroup -> Maybe Text
..} =
forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
created
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ReportExportConfig
exportConfig
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastModified
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ReportGroupStatusType
status
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ReportType
type'