{-# 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 #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.CodeCommit.Types.PullRequest
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.CodeCommit.Types.PullRequest where

import Amazonka.CodeCommit.Types.ApprovalRule
import Amazonka.CodeCommit.Types.PullRequestStatusEnum
import Amazonka.CodeCommit.Types.PullRequestTarget
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

-- | Returns information about a pull request.
--
-- /See:/ 'newPullRequest' smart constructor.
data PullRequest = PullRequest'
  { -- | The approval rules applied to the pull request.
    PullRequest -> Maybe [ApprovalRule]
approvalRules :: Prelude.Maybe [ApprovalRule],
    -- | The Amazon Resource Name (ARN) of the user who created the pull request.
    PullRequest -> Maybe Text
authorArn :: Prelude.Maybe Prelude.Text,
    -- | A unique, client-generated idempotency token that, when provided in a
    -- request, ensures the request cannot be repeated with a changed
    -- parameter. If a request is received with the same parameters and a token
    -- is included, the request returns information about the initial request
    -- that used that token.
    PullRequest -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | The date and time the pull request was originally created, in timestamp
    -- format.
    PullRequest -> Maybe POSIX
creationDate :: Prelude.Maybe Data.POSIX,
    -- | The user-defined description of the pull request. This description can
    -- be used to clarify what should be reviewed and other details of the
    -- request.
    PullRequest -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The day and time of the last user or system activity on the pull
    -- request, in timestamp format.
    PullRequest -> Maybe POSIX
lastActivityDate :: Prelude.Maybe Data.POSIX,
    -- | The system-generated ID of the pull request.
    PullRequest -> Maybe Text
pullRequestId :: Prelude.Maybe Prelude.Text,
    -- | The status of the pull request. Pull request status can only change from
    -- @OPEN@ to @CLOSED@.
    PullRequest -> Maybe PullRequestStatusEnum
pullRequestStatus :: Prelude.Maybe PullRequestStatusEnum,
    -- | The targets of the pull request, including the source branch and
    -- destination branch for the pull request.
    PullRequest -> Maybe [PullRequestTarget]
pullRequestTargets :: Prelude.Maybe [PullRequestTarget],
    -- | The system-generated revision ID for the pull request.
    PullRequest -> Maybe Text
revisionId :: Prelude.Maybe Prelude.Text,
    -- | The user-defined title of the pull request. This title is displayed in
    -- the list of pull requests to other repository users.
    PullRequest -> Maybe Text
title :: Prelude.Maybe Prelude.Text
  }
  deriving (PullRequest -> PullRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PullRequest -> PullRequest -> Bool
$c/= :: PullRequest -> PullRequest -> Bool
== :: PullRequest -> PullRequest -> Bool
$c== :: PullRequest -> PullRequest -> Bool
Prelude.Eq, ReadPrec [PullRequest]
ReadPrec PullRequest
Int -> ReadS PullRequest
ReadS [PullRequest]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PullRequest]
$creadListPrec :: ReadPrec [PullRequest]
readPrec :: ReadPrec PullRequest
$creadPrec :: ReadPrec PullRequest
readList :: ReadS [PullRequest]
$creadList :: ReadS [PullRequest]
readsPrec :: Int -> ReadS PullRequest
$creadsPrec :: Int -> ReadS PullRequest
Prelude.Read, Int -> PullRequest -> ShowS
[PullRequest] -> ShowS
PullRequest -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PullRequest] -> ShowS
$cshowList :: [PullRequest] -> ShowS
show :: PullRequest -> String
$cshow :: PullRequest -> String
showsPrec :: Int -> PullRequest -> ShowS
$cshowsPrec :: Int -> PullRequest -> ShowS
Prelude.Show, forall x. Rep PullRequest x -> PullRequest
forall x. PullRequest -> Rep PullRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PullRequest x -> PullRequest
$cfrom :: forall x. PullRequest -> Rep PullRequest x
Prelude.Generic)

-- |
-- Create a value of 'PullRequest' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'approvalRules', 'pullRequest_approvalRules' - The approval rules applied to the pull request.
--
-- 'authorArn', 'pullRequest_authorArn' - The Amazon Resource Name (ARN) of the user who created the pull request.
--
-- 'clientRequestToken', 'pullRequest_clientRequestToken' - A unique, client-generated idempotency token that, when provided in a
-- request, ensures the request cannot be repeated with a changed
-- parameter. If a request is received with the same parameters and a token
-- is included, the request returns information about the initial request
-- that used that token.
--
-- 'creationDate', 'pullRequest_creationDate' - The date and time the pull request was originally created, in timestamp
-- format.
--
-- 'description', 'pullRequest_description' - The user-defined description of the pull request. This description can
-- be used to clarify what should be reviewed and other details of the
-- request.
--
-- 'lastActivityDate', 'pullRequest_lastActivityDate' - The day and time of the last user or system activity on the pull
-- request, in timestamp format.
--
-- 'pullRequestId', 'pullRequest_pullRequestId' - The system-generated ID of the pull request.
--
-- 'pullRequestStatus', 'pullRequest_pullRequestStatus' - The status of the pull request. Pull request status can only change from
-- @OPEN@ to @CLOSED@.
--
-- 'pullRequestTargets', 'pullRequest_pullRequestTargets' - The targets of the pull request, including the source branch and
-- destination branch for the pull request.
--
-- 'revisionId', 'pullRequest_revisionId' - The system-generated revision ID for the pull request.
--
-- 'title', 'pullRequest_title' - The user-defined title of the pull request. This title is displayed in
-- the list of pull requests to other repository users.
newPullRequest ::
  PullRequest
newPullRequest :: PullRequest
newPullRequest =
  PullRequest'
    { $sel:approvalRules:PullRequest' :: Maybe [ApprovalRule]
approvalRules = forall a. Maybe a
Prelude.Nothing,
      $sel:authorArn:PullRequest' :: Maybe Text
authorArn = forall a. Maybe a
Prelude.Nothing,
      $sel:clientRequestToken:PullRequest' :: Maybe Text
clientRequestToken = forall a. Maybe a
Prelude.Nothing,
      $sel:creationDate:PullRequest' :: Maybe POSIX
creationDate = forall a. Maybe a
Prelude.Nothing,
      $sel:description:PullRequest' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:lastActivityDate:PullRequest' :: Maybe POSIX
lastActivityDate = forall a. Maybe a
Prelude.Nothing,
      $sel:pullRequestId:PullRequest' :: Maybe Text
pullRequestId = forall a. Maybe a
Prelude.Nothing,
      $sel:pullRequestStatus:PullRequest' :: Maybe PullRequestStatusEnum
pullRequestStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:pullRequestTargets:PullRequest' :: Maybe [PullRequestTarget]
pullRequestTargets = forall a. Maybe a
Prelude.Nothing,
      $sel:revisionId:PullRequest' :: Maybe Text
revisionId = forall a. Maybe a
Prelude.Nothing,
      $sel:title:PullRequest' :: Maybe Text
title = forall a. Maybe a
Prelude.Nothing
    }

-- | The approval rules applied to the pull request.
pullRequest_approvalRules :: Lens.Lens' PullRequest (Prelude.Maybe [ApprovalRule])
pullRequest_approvalRules :: Lens' PullRequest (Maybe [ApprovalRule])
pullRequest_approvalRules = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PullRequest' {Maybe [ApprovalRule]
approvalRules :: Maybe [ApprovalRule]
$sel:approvalRules:PullRequest' :: PullRequest -> Maybe [ApprovalRule]
approvalRules} -> Maybe [ApprovalRule]
approvalRules) (\s :: PullRequest
s@PullRequest' {} Maybe [ApprovalRule]
a -> PullRequest
s {$sel:approvalRules:PullRequest' :: Maybe [ApprovalRule]
approvalRules = Maybe [ApprovalRule]
a} :: PullRequest) 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

-- | The Amazon Resource Name (ARN) of the user who created the pull request.
pullRequest_authorArn :: Lens.Lens' PullRequest (Prelude.Maybe Prelude.Text)
pullRequest_authorArn :: Lens' PullRequest (Maybe Text)
pullRequest_authorArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PullRequest' {Maybe Text
authorArn :: Maybe Text
$sel:authorArn:PullRequest' :: PullRequest -> Maybe Text
authorArn} -> Maybe Text
authorArn) (\s :: PullRequest
s@PullRequest' {} Maybe Text
a -> PullRequest
s {$sel:authorArn:PullRequest' :: Maybe Text
authorArn = Maybe Text
a} :: PullRequest)

-- | A unique, client-generated idempotency token that, when provided in a
-- request, ensures the request cannot be repeated with a changed
-- parameter. If a request is received with the same parameters and a token
-- is included, the request returns information about the initial request
-- that used that token.
pullRequest_clientRequestToken :: Lens.Lens' PullRequest (Prelude.Maybe Prelude.Text)
pullRequest_clientRequestToken :: Lens' PullRequest (Maybe Text)
pullRequest_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PullRequest' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:PullRequest' :: PullRequest -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: PullRequest
s@PullRequest' {} Maybe Text
a -> PullRequest
s {$sel:clientRequestToken:PullRequest' :: Maybe Text
clientRequestToken = Maybe Text
a} :: PullRequest)

-- | The date and time the pull request was originally created, in timestamp
-- format.
pullRequest_creationDate :: Lens.Lens' PullRequest (Prelude.Maybe Prelude.UTCTime)
pullRequest_creationDate :: Lens' PullRequest (Maybe UTCTime)
pullRequest_creationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PullRequest' {Maybe POSIX
creationDate :: Maybe POSIX
$sel:creationDate:PullRequest' :: PullRequest -> Maybe POSIX
creationDate} -> Maybe POSIX
creationDate) (\s :: PullRequest
s@PullRequest' {} Maybe POSIX
a -> PullRequest
s {$sel:creationDate:PullRequest' :: Maybe POSIX
creationDate = Maybe POSIX
a} :: PullRequest) 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

-- | The user-defined description of the pull request. This description can
-- be used to clarify what should be reviewed and other details of the
-- request.
pullRequest_description :: Lens.Lens' PullRequest (Prelude.Maybe Prelude.Text)
pullRequest_description :: Lens' PullRequest (Maybe Text)
pullRequest_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PullRequest' {Maybe Text
description :: Maybe Text
$sel:description:PullRequest' :: PullRequest -> Maybe Text
description} -> Maybe Text
description) (\s :: PullRequest
s@PullRequest' {} Maybe Text
a -> PullRequest
s {$sel:description:PullRequest' :: Maybe Text
description = Maybe Text
a} :: PullRequest)

-- | The day and time of the last user or system activity on the pull
-- request, in timestamp format.
pullRequest_lastActivityDate :: Lens.Lens' PullRequest (Prelude.Maybe Prelude.UTCTime)
pullRequest_lastActivityDate :: Lens' PullRequest (Maybe UTCTime)
pullRequest_lastActivityDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PullRequest' {Maybe POSIX
lastActivityDate :: Maybe POSIX
$sel:lastActivityDate:PullRequest' :: PullRequest -> Maybe POSIX
lastActivityDate} -> Maybe POSIX
lastActivityDate) (\s :: PullRequest
s@PullRequest' {} Maybe POSIX
a -> PullRequest
s {$sel:lastActivityDate:PullRequest' :: Maybe POSIX
lastActivityDate = Maybe POSIX
a} :: PullRequest) 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

-- | The system-generated ID of the pull request.
pullRequest_pullRequestId :: Lens.Lens' PullRequest (Prelude.Maybe Prelude.Text)
pullRequest_pullRequestId :: Lens' PullRequest (Maybe Text)
pullRequest_pullRequestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PullRequest' {Maybe Text
pullRequestId :: Maybe Text
$sel:pullRequestId:PullRequest' :: PullRequest -> Maybe Text
pullRequestId} -> Maybe Text
pullRequestId) (\s :: PullRequest
s@PullRequest' {} Maybe Text
a -> PullRequest
s {$sel:pullRequestId:PullRequest' :: Maybe Text
pullRequestId = Maybe Text
a} :: PullRequest)

-- | The status of the pull request. Pull request status can only change from
-- @OPEN@ to @CLOSED@.
pullRequest_pullRequestStatus :: Lens.Lens' PullRequest (Prelude.Maybe PullRequestStatusEnum)
pullRequest_pullRequestStatus :: Lens' PullRequest (Maybe PullRequestStatusEnum)
pullRequest_pullRequestStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PullRequest' {Maybe PullRequestStatusEnum
pullRequestStatus :: Maybe PullRequestStatusEnum
$sel:pullRequestStatus:PullRequest' :: PullRequest -> Maybe PullRequestStatusEnum
pullRequestStatus} -> Maybe PullRequestStatusEnum
pullRequestStatus) (\s :: PullRequest
s@PullRequest' {} Maybe PullRequestStatusEnum
a -> PullRequest
s {$sel:pullRequestStatus:PullRequest' :: Maybe PullRequestStatusEnum
pullRequestStatus = Maybe PullRequestStatusEnum
a} :: PullRequest)

-- | The targets of the pull request, including the source branch and
-- destination branch for the pull request.
pullRequest_pullRequestTargets :: Lens.Lens' PullRequest (Prelude.Maybe [PullRequestTarget])
pullRequest_pullRequestTargets :: Lens' PullRequest (Maybe [PullRequestTarget])
pullRequest_pullRequestTargets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PullRequest' {Maybe [PullRequestTarget]
pullRequestTargets :: Maybe [PullRequestTarget]
$sel:pullRequestTargets:PullRequest' :: PullRequest -> Maybe [PullRequestTarget]
pullRequestTargets} -> Maybe [PullRequestTarget]
pullRequestTargets) (\s :: PullRequest
s@PullRequest' {} Maybe [PullRequestTarget]
a -> PullRequest
s {$sel:pullRequestTargets:PullRequest' :: Maybe [PullRequestTarget]
pullRequestTargets = Maybe [PullRequestTarget]
a} :: PullRequest) 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

-- | The system-generated revision ID for the pull request.
pullRequest_revisionId :: Lens.Lens' PullRequest (Prelude.Maybe Prelude.Text)
pullRequest_revisionId :: Lens' PullRequest (Maybe Text)
pullRequest_revisionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PullRequest' {Maybe Text
revisionId :: Maybe Text
$sel:revisionId:PullRequest' :: PullRequest -> Maybe Text
revisionId} -> Maybe Text
revisionId) (\s :: PullRequest
s@PullRequest' {} Maybe Text
a -> PullRequest
s {$sel:revisionId:PullRequest' :: Maybe Text
revisionId = Maybe Text
a} :: PullRequest)

-- | The user-defined title of the pull request. This title is displayed in
-- the list of pull requests to other repository users.
pullRequest_title :: Lens.Lens' PullRequest (Prelude.Maybe Prelude.Text)
pullRequest_title :: Lens' PullRequest (Maybe Text)
pullRequest_title = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PullRequest' {Maybe Text
title :: Maybe Text
$sel:title:PullRequest' :: PullRequest -> Maybe Text
title} -> Maybe Text
title) (\s :: PullRequest
s@PullRequest' {} Maybe Text
a -> PullRequest
s {$sel:title:PullRequest' :: Maybe Text
title = Maybe Text
a} :: PullRequest)

instance Data.FromJSON PullRequest where
  parseJSON :: Value -> Parser PullRequest
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"PullRequest"
      ( \Object
x ->
          Maybe [ApprovalRule]
-> Maybe Text
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe PullRequestStatusEnum
-> Maybe [PullRequestTarget]
-> Maybe Text
-> Maybe Text
-> PullRequest
PullRequest'
            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
"approvalRules" 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
"authorArn")
            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
"clientRequestToken")
            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
"creationDate")
            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
"description")
            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
"lastActivityDate")
            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
"pullRequestId")
            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
"pullRequestStatus")
            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
"pullRequestTargets"
                            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
"revisionId")
            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
"title")
      )

instance Prelude.Hashable PullRequest where
  hashWithSalt :: Int -> PullRequest -> Int
hashWithSalt Int
_salt PullRequest' {Maybe [ApprovalRule]
Maybe [PullRequestTarget]
Maybe Text
Maybe POSIX
Maybe PullRequestStatusEnum
title :: Maybe Text
revisionId :: Maybe Text
pullRequestTargets :: Maybe [PullRequestTarget]
pullRequestStatus :: Maybe PullRequestStatusEnum
pullRequestId :: Maybe Text
lastActivityDate :: Maybe POSIX
description :: Maybe Text
creationDate :: Maybe POSIX
clientRequestToken :: Maybe Text
authorArn :: Maybe Text
approvalRules :: Maybe [ApprovalRule]
$sel:title:PullRequest' :: PullRequest -> Maybe Text
$sel:revisionId:PullRequest' :: PullRequest -> Maybe Text
$sel:pullRequestTargets:PullRequest' :: PullRequest -> Maybe [PullRequestTarget]
$sel:pullRequestStatus:PullRequest' :: PullRequest -> Maybe PullRequestStatusEnum
$sel:pullRequestId:PullRequest' :: PullRequest -> Maybe Text
$sel:lastActivityDate:PullRequest' :: PullRequest -> Maybe POSIX
$sel:description:PullRequest' :: PullRequest -> Maybe Text
$sel:creationDate:PullRequest' :: PullRequest -> Maybe POSIX
$sel:clientRequestToken:PullRequest' :: PullRequest -> Maybe Text
$sel:authorArn:PullRequest' :: PullRequest -> Maybe Text
$sel:approvalRules:PullRequest' :: PullRequest -> Maybe [ApprovalRule]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ApprovalRule]
approvalRules
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
authorArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
creationDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
lastActivityDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
pullRequestId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PullRequestStatusEnum
pullRequestStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [PullRequestTarget]
pullRequestTargets
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
revisionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
title

instance Prelude.NFData PullRequest where
  rnf :: PullRequest -> ()
rnf PullRequest' {Maybe [ApprovalRule]
Maybe [PullRequestTarget]
Maybe Text
Maybe POSIX
Maybe PullRequestStatusEnum
title :: Maybe Text
revisionId :: Maybe Text
pullRequestTargets :: Maybe [PullRequestTarget]
pullRequestStatus :: Maybe PullRequestStatusEnum
pullRequestId :: Maybe Text
lastActivityDate :: Maybe POSIX
description :: Maybe Text
creationDate :: Maybe POSIX
clientRequestToken :: Maybe Text
authorArn :: Maybe Text
approvalRules :: Maybe [ApprovalRule]
$sel:title:PullRequest' :: PullRequest -> Maybe Text
$sel:revisionId:PullRequest' :: PullRequest -> Maybe Text
$sel:pullRequestTargets:PullRequest' :: PullRequest -> Maybe [PullRequestTarget]
$sel:pullRequestStatus:PullRequest' :: PullRequest -> Maybe PullRequestStatusEnum
$sel:pullRequestId:PullRequest' :: PullRequest -> Maybe Text
$sel:lastActivityDate:PullRequest' :: PullRequest -> Maybe POSIX
$sel:description:PullRequest' :: PullRequest -> Maybe Text
$sel:creationDate:PullRequest' :: PullRequest -> Maybe POSIX
$sel:clientRequestToken:PullRequest' :: PullRequest -> Maybe Text
$sel:authorArn:PullRequest' :: PullRequest -> Maybe Text
$sel:approvalRules:PullRequest' :: PullRequest -> Maybe [ApprovalRule]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ApprovalRule]
approvalRules
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
authorArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastActivityDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
pullRequestId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PullRequestStatusEnum
pullRequestStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [PullRequestTarget]
pullRequestTargets
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
revisionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
title