{-# LANGUAGE Trustworthy #-}
{-|
Module      : Github.Data.Webhooks.Payload
Copyright   : (c) Cuedo Control Engineering 2017-2022
License     : MIT
Maintainer  : Kyle Van Berendonck <foss@cuedo.com.au>

This module contains types that represent GitHub webhook's payload contents.
-}
module GitHub.Data.Webhooks.Payload
    ( -- * Construction Types

      URL(..)
    , getUrl
    , OwnerType(..)
      -- * Webhook Types

    , HookIssue(..)
    , HookRepository(..)
    , HookRepositorySimple(..)
    , HookRepositoryLabel(..)
    , HookUser(..)
    , HookSimpleUser(..)
    , HookOrganization(..)
    , HookOrganizationInvitation(..)
    , HookOrganizationMembership(..)
    , HookTeam(..)
    , HookMarketplaceAccount(..)
    , HookMarketplaceBillingCycle(..)
    , HookMarketplacePlan(..)
    , HookMarketplacePlanPriceModel(..)
    , HookMarketplacePurchase(..)
    , HookMilestone(..)
    , HookMembership(..)
    , HookProject(..)
    , HookProjectCard(..)
    , HookProjectColumn(..)
    , HookIssueLabels(..)
    , HookCommit(..)
    , HookCheckSuiteStatus(..)
    , HookCheckSuiteConclusion(..)
    , HookCheckSuite(..)
    , HookCheckSuiteCommit(..)
    , HookCheckRunStatus(..)
    , HookCheckRunConclusion(..)
    , HookCheckRun(..)
    , HookCheckRunOutput(..)
    , HookCheckRunRequestedAction(..)
    , HookChecksInstallation(..)
    , HookChecksPullRequest(..)
    , HookChecksPullRequestRepository(..)
    , HookChecksPullRequestTarget(..)
    , HookRelease(..)
    , HookPullRequest(..)
    , PullRequestTarget(..)
    , HookPullRequestReview(..)
    , HookInstallation(..)
    , HookDeployment(..)
    , HookDeploymentStatus(..)
    , HookWikiPage(..)
    , HookPageBuildResult(..)
    , HookIssueComment(..)
    , HookCommitComment(..)
    , HookPullRequestReviewComment(..)
    ) where

import           Data.Aeson               (FromJSON(..), withObject, withText, (.!=), (.:), (.:?))
import           Control.DeepSeq          (NFData (..))
import           Control.DeepSeq.Generics (genericRnf)
import           Control.Applicative      ((<|>), (<*>), pure)
import           Data.Data                (Data, Typeable)
import           Data.Functor             ((<$>))
import           Data.Time                (UTCTime)
import           Data.Time.LocalTime      (zonedTimeToUTC)
import           Data.Time.Clock.POSIX    (posixSecondsToUTCTime)
import           Data.Text                (Text)
import qualified Data.Text                as T
import           Data.Vector              (Vector)
import           GHC.Generics             (Generic)


-- Types lifted from the @github@ package.


-- | Represents the owner of a repository, pull request or similar.

--

-- A bot is a "special type of user which takes actions on behalf of GitHub Apps".

-- See also https://developer.github.com/v4/object/bot/

data OwnerType = OwnerUser | OwnerOrganization | OwnerBot
    deriving (OwnerType -> OwnerType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OwnerType -> OwnerType -> Bool
$c/= :: OwnerType -> OwnerType -> Bool
== :: OwnerType -> OwnerType -> Bool
$c== :: OwnerType -> OwnerType -> Bool
Eq, Eq OwnerType
OwnerType -> OwnerType -> Bool
OwnerType -> OwnerType -> Ordering
OwnerType -> OwnerType -> OwnerType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: OwnerType -> OwnerType -> OwnerType
$cmin :: OwnerType -> OwnerType -> OwnerType
max :: OwnerType -> OwnerType -> OwnerType
$cmax :: OwnerType -> OwnerType -> OwnerType
>= :: OwnerType -> OwnerType -> Bool
$c>= :: OwnerType -> OwnerType -> Bool
> :: OwnerType -> OwnerType -> Bool
$c> :: OwnerType -> OwnerType -> Bool
<= :: OwnerType -> OwnerType -> Bool
$c<= :: OwnerType -> OwnerType -> Bool
< :: OwnerType -> OwnerType -> Bool
$c< :: OwnerType -> OwnerType -> Bool
compare :: OwnerType -> OwnerType -> Ordering
$ccompare :: OwnerType -> OwnerType -> Ordering
Ord, Int -> OwnerType
OwnerType -> Int
OwnerType -> [OwnerType]
OwnerType -> OwnerType
OwnerType -> OwnerType -> [OwnerType]
OwnerType -> OwnerType -> OwnerType -> [OwnerType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: OwnerType -> OwnerType -> OwnerType -> [OwnerType]
$cenumFromThenTo :: OwnerType -> OwnerType -> OwnerType -> [OwnerType]
enumFromTo :: OwnerType -> OwnerType -> [OwnerType]
$cenumFromTo :: OwnerType -> OwnerType -> [OwnerType]
enumFromThen :: OwnerType -> OwnerType -> [OwnerType]
$cenumFromThen :: OwnerType -> OwnerType -> [OwnerType]
enumFrom :: OwnerType -> [OwnerType]
$cenumFrom :: OwnerType -> [OwnerType]
fromEnum :: OwnerType -> Int
$cfromEnum :: OwnerType -> Int
toEnum :: Int -> OwnerType
$ctoEnum :: Int -> OwnerType
pred :: OwnerType -> OwnerType
$cpred :: OwnerType -> OwnerType
succ :: OwnerType -> OwnerType
$csucc :: OwnerType -> OwnerType
Enum, OwnerType
forall a. a -> a -> Bounded a
maxBound :: OwnerType
$cmaxBound :: OwnerType
minBound :: OwnerType
$cminBound :: OwnerType
Bounded, Int -> OwnerType -> ShowS
[OwnerType] -> ShowS
OwnerType -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [OwnerType] -> ShowS
$cshowList :: [OwnerType] -> ShowS
show :: OwnerType -> [Char]
$cshow :: OwnerType -> [Char]
showsPrec :: Int -> OwnerType -> ShowS
$cshowsPrec :: Int -> OwnerType -> ShowS
Show, ReadPrec [OwnerType]
ReadPrec OwnerType
Int -> ReadS OwnerType
ReadS [OwnerType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OwnerType]
$creadListPrec :: ReadPrec [OwnerType]
readPrec :: ReadPrec OwnerType
$creadPrec :: ReadPrec OwnerType
readList :: ReadS [OwnerType]
$creadList :: ReadS [OwnerType]
readsPrec :: Int -> ReadS OwnerType
$creadsPrec :: Int -> ReadS OwnerType
Read, forall x. Rep OwnerType x -> OwnerType
forall x. OwnerType -> Rep OwnerType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OwnerType x -> OwnerType
$cfrom :: forall x. OwnerType -> Rep OwnerType x
Generic, Typeable, Typeable OwnerType
OwnerType -> DataType
OwnerType -> Constr
(forall b. Data b => b -> b) -> OwnerType -> OwnerType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> OwnerType -> u
forall u. (forall d. Data d => d -> u) -> OwnerType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OwnerType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OwnerType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OwnerType -> m OwnerType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OwnerType -> m OwnerType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OwnerType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OwnerType -> c OwnerType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OwnerType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OwnerType)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OwnerType -> m OwnerType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OwnerType -> m OwnerType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OwnerType -> m OwnerType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OwnerType -> m OwnerType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OwnerType -> m OwnerType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OwnerType -> m OwnerType
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OwnerType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OwnerType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> OwnerType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OwnerType -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OwnerType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OwnerType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OwnerType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OwnerType -> r
gmapT :: (forall b. Data b => b -> b) -> OwnerType -> OwnerType
$cgmapT :: (forall b. Data b => b -> b) -> OwnerType -> OwnerType
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OwnerType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OwnerType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OwnerType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OwnerType)
dataTypeOf :: OwnerType -> DataType
$cdataTypeOf :: OwnerType -> DataType
toConstr :: OwnerType -> Constr
$ctoConstr :: OwnerType -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OwnerType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OwnerType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OwnerType -> c OwnerType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OwnerType -> c OwnerType
Data)

instance NFData OwnerType

instance FromJSON OwnerType where
  parseJSON :: Value -> Parser OwnerType
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"Owner type" forall a b. (a -> b) -> a -> b
$ \Text
t ->
      case Text -> Text
T.toLower Text
t of
          Text
"user"          -> forall (f :: * -> *) a. Applicative f => a -> f a
pure OwnerType
OwnerUser
          Text
"organization"  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure OwnerType
OwnerOrganization
          Text
"bot"           -> forall (f :: * -> *) a. Applicative f => a -> f a
pure OwnerType
OwnerBot
          Text
_               -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ [Char]
"Unknown owner type: " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
t


-- | Represents an internet address that would be suitable to query

-- for more information. The GitHub API only returns valid 'URL's.

newtype URL = URL Text
    deriving (URL -> URL -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: URL -> URL -> Bool
$c/= :: URL -> URL -> Bool
== :: URL -> URL -> Bool
$c== :: URL -> URL -> Bool
Eq, Eq URL
URL -> URL -> Bool
URL -> URL -> Ordering
URL -> URL -> URL
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: URL -> URL -> URL
$cmin :: URL -> URL -> URL
max :: URL -> URL -> URL
$cmax :: URL -> URL -> URL
>= :: URL -> URL -> Bool
$c>= :: URL -> URL -> Bool
> :: URL -> URL -> Bool
$c> :: URL -> URL -> Bool
<= :: URL -> URL -> Bool
$c<= :: URL -> URL -> Bool
< :: URL -> URL -> Bool
$c< :: URL -> URL -> Bool
compare :: URL -> URL -> Ordering
$ccompare :: URL -> URL -> Ordering
Ord, Int -> URL -> ShowS
[URL] -> ShowS
URL -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [URL] -> ShowS
$cshowList :: [URL] -> ShowS
show :: URL -> [Char]
$cshow :: URL -> [Char]
showsPrec :: Int -> URL -> ShowS
$cshowsPrec :: Int -> URL -> ShowS
Show, forall x. Rep URL x -> URL
forall x. URL -> Rep URL x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep URL x -> URL
$cfrom :: forall x. URL -> Rep URL x
Generic, Typeable, Typeable URL
URL -> DataType
URL -> Constr
(forall b. Data b => b -> b) -> URL -> URL
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> URL -> u
forall u. (forall d. Data d => d -> u) -> URL -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> URL -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> URL -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> URL -> m URL
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> URL -> m URL
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c URL
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> URL -> c URL
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c URL)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c URL)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> URL -> m URL
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> URL -> m URL
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> URL -> m URL
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> URL -> m URL
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> URL -> m URL
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> URL -> m URL
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> URL -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> URL -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> URL -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> URL -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> URL -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> URL -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> URL -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> URL -> r
gmapT :: (forall b. Data b => b -> b) -> URL -> URL
$cgmapT :: (forall b. Data b => b -> b) -> URL -> URL
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c URL)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c URL)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c URL)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c URL)
dataTypeOf :: URL -> DataType
$cdataTypeOf :: URL -> DataType
toConstr :: URL -> Constr
$ctoConstr :: URL -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c URL
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c URL
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> URL -> c URL
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> URL -> c URL
Data)

instance NFData URL where rnf :: URL -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

instance FromJSON URL where
  parseJSON :: Value -> Parser URL
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"URL" (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> URL
URL)

-- | Demote GitHub URL to Text.

getUrl :: URL -> Text
getUrl :: URL -> Text
getUrl (URL Text
url) = Text
url


-- Hooks


type IssueState = Text

-- | Represents the "issue" field in the 'IssueCommentEvent'

-- and 'IssueEvent' payload.

data HookIssue = HookIssue
    { HookIssue -> URL
whIssueUrl                :: !URL
    , HookIssue -> URL
whIssueLabelsUrl          :: !URL
    , HookIssue -> URL
whIssueCommentsUrl        :: !URL
    , HookIssue -> URL
whIssueEventsUrl          :: !URL
    , HookIssue -> URL
whIssueHtmlUrl            :: !URL
    , HookIssue -> Int
whIssueId                 :: !Int
    , HookIssue -> Text
whIssueNodeId             :: !Text
    , HookIssue -> Int
whIssueNumber             :: !Int
    , HookIssue -> Text
whIssueTitle              :: !Text
    , HookIssue -> HookUser
whIssueUser               :: !HookUser
    , HookIssue -> Vector HookIssueLabels
whIssueLabels             :: !(Vector HookIssueLabels)
    , HookIssue -> Text
whIssueState              :: IssueState
    , HookIssue -> Bool
whIssueIsLocked           :: !Bool
    , HookIssue -> Maybe HookUser
whIssueAssignee           :: !(Maybe HookUser)
    , HookIssue -> Maybe HookMilestone
whIssueMilestone          :: !(Maybe HookMilestone)
    , HookIssue -> Int
whIssueCommentCount       :: !Int
    , HookIssue -> UTCTime
whIssueCreatedAt          :: !UTCTime
    , HookIssue -> UTCTime
whIssueUpdatedAt          :: !UTCTime
    , HookIssue -> Maybe UTCTime
whIssueClosedAt           :: !(Maybe UTCTime)
    , HookIssue -> Text
whIssueBody               :: !Text
    }
    deriving (HookIssue -> HookIssue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookIssue -> HookIssue -> Bool
$c/= :: HookIssue -> HookIssue -> Bool
== :: HookIssue -> HookIssue -> Bool
$c== :: HookIssue -> HookIssue -> Bool
Eq, Int -> HookIssue -> ShowS
[HookIssue] -> ShowS
HookIssue -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookIssue] -> ShowS
$cshowList :: [HookIssue] -> ShowS
show :: HookIssue -> [Char]
$cshow :: HookIssue -> [Char]
showsPrec :: Int -> HookIssue -> ShowS
$cshowsPrec :: Int -> HookIssue -> ShowS
Show, Typeable, Typeable HookIssue
HookIssue -> DataType
HookIssue -> Constr
(forall b. Data b => b -> b) -> HookIssue -> HookIssue
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> HookIssue -> u
forall u. (forall d. Data d => d -> u) -> HookIssue -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookIssue -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookIssue -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookIssue -> m HookIssue
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookIssue -> m HookIssue
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookIssue
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookIssue -> c HookIssue
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookIssue)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HookIssue)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookIssue -> m HookIssue
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookIssue -> m HookIssue
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookIssue -> m HookIssue
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookIssue -> m HookIssue
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookIssue -> m HookIssue
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookIssue -> m HookIssue
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HookIssue -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HookIssue -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HookIssue -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HookIssue -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookIssue -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookIssue -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookIssue -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookIssue -> r
gmapT :: (forall b. Data b => b -> b) -> HookIssue -> HookIssue
$cgmapT :: (forall b. Data b => b -> b) -> HookIssue -> HookIssue
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HookIssue)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HookIssue)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookIssue)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookIssue)
dataTypeOf :: HookIssue -> DataType
$cdataTypeOf :: HookIssue -> DataType
toConstr :: HookIssue -> Constr
$ctoConstr :: HookIssue -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookIssue
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookIssue
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookIssue -> c HookIssue
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookIssue -> c HookIssue
Data, forall x. Rep HookIssue x -> HookIssue
forall x. HookIssue -> Rep HookIssue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookIssue x -> HookIssue
$cfrom :: forall x. HookIssue -> Rep HookIssue x
Generic)

instance NFData HookIssue where rnf :: HookIssue -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "repository" field in all types of payload.

data HookRepository = HookRepository
    { HookRepository -> Int
whRepoId                  :: !Int
    , HookRepository -> Text
whRepoNodeId              :: !Text
    , HookRepository -> Text
whRepoName                :: !Text
    , HookRepository -> Text
whRepoFullName            :: !Text
    , HookRepository -> Either HookSimpleUser HookUser
whRepoOwner               :: !(Either HookSimpleUser HookUser)
    , HookRepository -> Bool
whRepoIsPrivate           :: !Bool
    , HookRepository -> URL
whRepoHtmlUrl             :: !URL
    , HookRepository -> Text
whRepoDescription         :: !Text
    , HookRepository -> Bool
whRepoIsAFork             :: !Bool
    , HookRepository -> URL
whRepoUrl                 :: !URL
    , HookRepository -> URL
whRepoForksUrl            :: !URL
    , HookRepository -> URL
whRepoKeysUrl             :: !URL
    , HookRepository -> URL
whRepoCollaboratorsUrl    :: !URL
    , HookRepository -> URL
whRepoTeamsUrl            :: !URL
    , HookRepository -> URL
whRepoHooksUrl            :: !URL
    , HookRepository -> URL
whRepoIssueEventsUrl      :: !URL
    , HookRepository -> URL
whRepoEventsUrl           :: !URL
    , HookRepository -> URL
whRepoAssigneesUrl        :: !URL
    , HookRepository -> URL
whRepoBranchesUrl         :: !URL
    , HookRepository -> URL
whRepoTagsUrl             :: !URL
    , HookRepository -> URL
whRepoBlobsUrl            :: !URL
    , HookRepository -> URL
whRepoGitTagsUrl          :: !URL
    , HookRepository -> URL
whRepoGitRefsUrl          :: !URL
    , HookRepository -> URL
whRepoTreesUrl            :: !URL
    , HookRepository -> URL
whRepoStatusesUrl         :: !URL
    , HookRepository -> URL
whRepoLanguagesUrl        :: !URL
    , HookRepository -> URL
whRepoStargazersUrl       :: !URL
    , HookRepository -> URL
whRepoContributorsUrl     :: !URL
    , HookRepository -> URL
whRepoSubscribersUrl      :: !URL
    , HookRepository -> URL
whRepoSubscriptionUrl     :: !URL
    , HookRepository -> URL
whRepoCommitsUrl          :: !URL
    , HookRepository -> URL
whRepoGitCommitsUrl       :: !URL
    , HookRepository -> URL
whRepoCommentsUrl         :: !URL
    , HookRepository -> URL
whRepoIssueCommentsUrl    :: !URL
    , HookRepository -> URL
whRepoContentsUrl         :: !URL
    , HookRepository -> URL
whRepoCompareUrl          :: !URL
    , HookRepository -> URL
whRepoMergesUrl           :: !URL
    , HookRepository -> URL
whRepoArchiveUrl          :: !URL
    , HookRepository -> URL
whRepoDownloadsUrl        :: !URL
    , HookRepository -> URL
whRepoIssuesUrl           :: !URL
    , HookRepository -> URL
whRepoPullsUrl            :: !URL
    , HookRepository -> URL
whRepoMilestonesUrl       :: !URL
    , HookRepository -> URL
whRepoNotificationsUrl    :: !URL
    , HookRepository -> URL
whRepoLabelsUrl           :: !URL
    , HookRepository -> URL
whRepoReleasesUrl         :: !URL
    , HookRepository -> UTCTime
whRepoCreatedAt           :: !UTCTime
    , HookRepository -> UTCTime
whRepoUpdatedAt           :: !UTCTime
    , HookRepository -> UTCTime
whRepoPushedAt            :: !UTCTime
    , HookRepository -> URL
whRepoGitUrl              :: !URL
    , HookRepository -> URL
whRepoSshUrl              :: !URL
    , HookRepository -> URL
whRepoCloneUrl            :: !URL
    , HookRepository -> URL
whRepoSvnUrl              :: !URL
    , HookRepository -> Maybe URL
whRepoHomepage            :: !(Maybe URL)
    , HookRepository -> Int
whRepoSize                :: !Int
    , HookRepository -> Int
whRepoStargazersCount     :: !Int
    , HookRepository -> Int
whRepoWatchersCount       :: !Int
    , HookRepository -> Maybe Text
whRepoLanguage            :: !(Maybe Text)
    , HookRepository -> Bool
whRepoHasIssues           :: !Bool
    , HookRepository -> Bool
whRepoHasDownloads        :: !Bool
    , HookRepository -> Bool
whRepoHasWiki             :: !Bool
    , HookRepository -> Bool
whRepoHasPages            :: !Bool
    , HookRepository -> Int
whRepoForkCount           :: !Int
    , HookRepository -> Maybe URL
whRepoMirrorUrl           :: !(Maybe URL)
    , HookRepository -> Int
whRepoOpenIssuesCount     :: !Int
    , HookRepository -> Text
whRepoDefaultBranchName   :: !Text
    }
    deriving (HookRepository -> HookRepository -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookRepository -> HookRepository -> Bool
$c/= :: HookRepository -> HookRepository -> Bool
== :: HookRepository -> HookRepository -> Bool
$c== :: HookRepository -> HookRepository -> Bool
Eq, Int -> HookRepository -> ShowS
[HookRepository] -> ShowS
HookRepository -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookRepository] -> ShowS
$cshowList :: [HookRepository] -> ShowS
show :: HookRepository -> [Char]
$cshow :: HookRepository -> [Char]
showsPrec :: Int -> HookRepository -> ShowS
$cshowsPrec :: Int -> HookRepository -> ShowS
Show, Typeable, Typeable HookRepository
HookRepository -> DataType
HookRepository -> Constr
(forall b. Data b => b -> b) -> HookRepository -> HookRepository
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookRepository -> u
forall u. (forall d. Data d => d -> u) -> HookRepository -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookRepository -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookRepository -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookRepository -> m HookRepository
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookRepository -> m HookRepository
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookRepository
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookRepository -> c HookRepository
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookRepository)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookRepository)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookRepository -> m HookRepository
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookRepository -> m HookRepository
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookRepository -> m HookRepository
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookRepository -> m HookRepository
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookRepository -> m HookRepository
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookRepository -> m HookRepository
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookRepository -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookRepository -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HookRepository -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HookRepository -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookRepository -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookRepository -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookRepository -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookRepository -> r
gmapT :: (forall b. Data b => b -> b) -> HookRepository -> HookRepository
$cgmapT :: (forall b. Data b => b -> b) -> HookRepository -> HookRepository
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookRepository)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookRepository)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookRepository)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookRepository)
dataTypeOf :: HookRepository -> DataType
$cdataTypeOf :: HookRepository -> DataType
toConstr :: HookRepository -> Constr
$ctoConstr :: HookRepository -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookRepository
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookRepository
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookRepository -> c HookRepository
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookRepository -> c HookRepository
Data, forall x. Rep HookRepository x -> HookRepository
forall x. HookRepository -> Rep HookRepository x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookRepository x -> HookRepository
$cfrom :: forall x. HookRepository -> Rep HookRepository x
Generic)

instance NFData HookRepository where rnf :: HookRepository -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "repositories_added" and "repositories_removed"

-- field in the 'InstallationRepositoriesEvent' payload.

data HookRepositorySimple = HookRepositorySimple
  { HookRepositorySimple -> Int
whSimplRepoId               :: !Int
  , HookRepositorySimple -> Text
whSimplRepoNodeId           :: !Text
  , HookRepositorySimple -> Text
whSimplRepoName             :: !Text
  , HookRepositorySimple -> Text
whSimplRepoFullName         :: !Text
  , HookRepositorySimple -> Bool
whSimplRepoIsPrivate        :: !Bool
  }
  deriving (HookRepositorySimple -> HookRepositorySimple -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookRepositorySimple -> HookRepositorySimple -> Bool
$c/= :: HookRepositorySimple -> HookRepositorySimple -> Bool
== :: HookRepositorySimple -> HookRepositorySimple -> Bool
$c== :: HookRepositorySimple -> HookRepositorySimple -> Bool
Eq, Int -> HookRepositorySimple -> ShowS
[HookRepositorySimple] -> ShowS
HookRepositorySimple -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookRepositorySimple] -> ShowS
$cshowList :: [HookRepositorySimple] -> ShowS
show :: HookRepositorySimple -> [Char]
$cshow :: HookRepositorySimple -> [Char]
showsPrec :: Int -> HookRepositorySimple -> ShowS
$cshowsPrec :: Int -> HookRepositorySimple -> ShowS
Show, Typeable, Typeable HookRepositorySimple
HookRepositorySimple -> DataType
HookRepositorySimple -> Constr
(forall b. Data b => b -> b)
-> HookRepositorySimple -> HookRepositorySimple
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookRepositorySimple -> u
forall u.
(forall d. Data d => d -> u) -> HookRepositorySimple -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookRepositorySimple -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookRepositorySimple -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookRepositorySimple -> m HookRepositorySimple
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookRepositorySimple -> m HookRepositorySimple
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookRepositorySimple
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookRepositorySimple
-> c HookRepositorySimple
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookRepositorySimple)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookRepositorySimple)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookRepositorySimple -> m HookRepositorySimple
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookRepositorySimple -> m HookRepositorySimple
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookRepositorySimple -> m HookRepositorySimple
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookRepositorySimple -> m HookRepositorySimple
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookRepositorySimple -> m HookRepositorySimple
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookRepositorySimple -> m HookRepositorySimple
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookRepositorySimple -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookRepositorySimple -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> HookRepositorySimple -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> HookRepositorySimple -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookRepositorySimple -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookRepositorySimple -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookRepositorySimple -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookRepositorySimple -> r
gmapT :: (forall b. Data b => b -> b)
-> HookRepositorySimple -> HookRepositorySimple
$cgmapT :: (forall b. Data b => b -> b)
-> HookRepositorySimple -> HookRepositorySimple
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookRepositorySimple)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookRepositorySimple)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookRepositorySimple)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookRepositorySimple)
dataTypeOf :: HookRepositorySimple -> DataType
$cdataTypeOf :: HookRepositorySimple -> DataType
toConstr :: HookRepositorySimple -> Constr
$ctoConstr :: HookRepositorySimple -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookRepositorySimple
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookRepositorySimple
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookRepositorySimple
-> c HookRepositorySimple
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookRepositorySimple
-> c HookRepositorySimple
Data, forall x. Rep HookRepositorySimple x -> HookRepositorySimple
forall x. HookRepositorySimple -> Rep HookRepositorySimple x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookRepositorySimple x -> HookRepositorySimple
$cfrom :: forall x. HookRepositorySimple -> Rep HookRepositorySimple x
Generic)

instance NFData HookRepositorySimple where rnf :: HookRepositorySimple -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "label" field in the 'LabelEvent' payload.

data HookRepositoryLabel = HookRepositoryLabel
    { HookRepositoryLabel -> Maybe Text
whRepoLabelNodeId         :: !(Maybe Text)
    , HookRepositoryLabel -> URL
whRepoLabelUrl            :: !URL
    , HookRepositoryLabel -> Text
whRepoLabelName           :: !Text
    , HookRepositoryLabel -> Text
whRepoLabelColor          :: !Text
    }
    deriving (HookRepositoryLabel -> HookRepositoryLabel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookRepositoryLabel -> HookRepositoryLabel -> Bool
$c/= :: HookRepositoryLabel -> HookRepositoryLabel -> Bool
== :: HookRepositoryLabel -> HookRepositoryLabel -> Bool
$c== :: HookRepositoryLabel -> HookRepositoryLabel -> Bool
Eq, Int -> HookRepositoryLabel -> ShowS
[HookRepositoryLabel] -> ShowS
HookRepositoryLabel -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookRepositoryLabel] -> ShowS
$cshowList :: [HookRepositoryLabel] -> ShowS
show :: HookRepositoryLabel -> [Char]
$cshow :: HookRepositoryLabel -> [Char]
showsPrec :: Int -> HookRepositoryLabel -> ShowS
$cshowsPrec :: Int -> HookRepositoryLabel -> ShowS
Show, Typeable, Typeable HookRepositoryLabel
HookRepositoryLabel -> DataType
HookRepositoryLabel -> Constr
(forall b. Data b => b -> b)
-> HookRepositoryLabel -> HookRepositoryLabel
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookRepositoryLabel -> u
forall u.
(forall d. Data d => d -> u) -> HookRepositoryLabel -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookRepositoryLabel -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookRepositoryLabel -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookRepositoryLabel -> m HookRepositoryLabel
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookRepositoryLabel -> m HookRepositoryLabel
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookRepositoryLabel
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookRepositoryLabel
-> c HookRepositoryLabel
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookRepositoryLabel)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookRepositoryLabel)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookRepositoryLabel -> m HookRepositoryLabel
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookRepositoryLabel -> m HookRepositoryLabel
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookRepositoryLabel -> m HookRepositoryLabel
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookRepositoryLabel -> m HookRepositoryLabel
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookRepositoryLabel -> m HookRepositoryLabel
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookRepositoryLabel -> m HookRepositoryLabel
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookRepositoryLabel -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookRepositoryLabel -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> HookRepositoryLabel -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> HookRepositoryLabel -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookRepositoryLabel -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookRepositoryLabel -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookRepositoryLabel -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookRepositoryLabel -> r
gmapT :: (forall b. Data b => b -> b)
-> HookRepositoryLabel -> HookRepositoryLabel
$cgmapT :: (forall b. Data b => b -> b)
-> HookRepositoryLabel -> HookRepositoryLabel
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookRepositoryLabel)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookRepositoryLabel)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookRepositoryLabel)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookRepositoryLabel)
dataTypeOf :: HookRepositoryLabel -> DataType
$cdataTypeOf :: HookRepositoryLabel -> DataType
toConstr :: HookRepositoryLabel -> Constr
$ctoConstr :: HookRepositoryLabel -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookRepositoryLabel
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookRepositoryLabel
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookRepositoryLabel
-> c HookRepositoryLabel
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookRepositoryLabel
-> c HookRepositoryLabel
Data, forall x. Rep HookRepositoryLabel x -> HookRepositoryLabel
forall x. HookRepositoryLabel -> Rep HookRepositoryLabel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookRepositoryLabel x -> HookRepositoryLabel
$cfrom :: forall x. HookRepositoryLabel -> Rep HookRepositoryLabel x
Generic)

instance NFData HookRepositoryLabel where rnf :: HookRepositoryLabel -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "user" field in all types of payload.

data HookUser = HookUser
    { HookUser -> Text
whUserLogin               :: !Text
    , HookUser -> Int
whUserId                  :: !Int
    , HookUser -> Text
whUserNodeId              :: !Text
    , HookUser -> URL
whUserAvatarUrl           :: !URL
    , HookUser -> URL
whUserGravatarId          :: !URL
    , HookUser -> URL
whUserUrl                 :: !URL
    , HookUser -> URL
whUserHtmlUrl             :: !URL
    , HookUser -> URL
whUserFollowersUrl        :: !URL
    , HookUser -> URL
whUserFollowingUrl        :: !URL
    , HookUser -> URL
whUserGistsUrl            :: !URL
    , HookUser -> URL
whUserStarredUrl          :: !URL
    , HookUser -> URL
whUserSubscriptionsUrl    :: !URL
    , HookUser -> URL
whUserOrganizationsUrl    :: !URL
    , HookUser -> URL
whUserReposUrl            :: !URL
    , HookUser -> URL
whUserEventsUrl           :: !URL
    , HookUser -> URL
whUserReceivedEventsUrl   :: !URL
    , HookUser -> OwnerType
whUserType                :: !OwnerType
    , HookUser -> Bool
whUserIsAdminOfSite       :: !Bool
    }
    deriving (HookUser -> HookUser -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookUser -> HookUser -> Bool
$c/= :: HookUser -> HookUser -> Bool
== :: HookUser -> HookUser -> Bool
$c== :: HookUser -> HookUser -> Bool
Eq, Int -> HookUser -> ShowS
[HookUser] -> ShowS
HookUser -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookUser] -> ShowS
$cshowList :: [HookUser] -> ShowS
show :: HookUser -> [Char]
$cshow :: HookUser -> [Char]
showsPrec :: Int -> HookUser -> ShowS
$cshowsPrec :: Int -> HookUser -> ShowS
Show, Typeable, Typeable HookUser
HookUser -> DataType
HookUser -> Constr
(forall b. Data b => b -> b) -> HookUser -> HookUser
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> HookUser -> u
forall u. (forall d. Data d => d -> u) -> HookUser -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookUser -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookUser -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookUser -> m HookUser
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookUser -> m HookUser
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookUser
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookUser -> c HookUser
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookUser)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HookUser)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookUser -> m HookUser
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookUser -> m HookUser
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookUser -> m HookUser
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookUser -> m HookUser
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookUser -> m HookUser
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookUser -> m HookUser
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HookUser -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HookUser -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HookUser -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HookUser -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookUser -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookUser -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookUser -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookUser -> r
gmapT :: (forall b. Data b => b -> b) -> HookUser -> HookUser
$cgmapT :: (forall b. Data b => b -> b) -> HookUser -> HookUser
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HookUser)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HookUser)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookUser)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookUser)
dataTypeOf :: HookUser -> DataType
$cdataTypeOf :: HookUser -> DataType
toConstr :: HookUser -> Constr
$ctoConstr :: HookUser -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookUser
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookUser
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookUser -> c HookUser
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookUser -> c HookUser
Data, forall x. Rep HookUser x -> HookUser
forall x. HookUser -> Rep HookUser x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookUser x -> HookUser
$cfrom :: forall x. HookUser -> Rep HookUser x
Generic)

instance NFData HookUser where rnf :: HookUser -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- FIXME: Not sure where this is.

data HookSimpleUser = HookSimpleUser
    { HookSimpleUser -> Text
whSimplUserName           :: !Text
    , HookSimpleUser -> Text
whSimplUserEmail          :: !Text
    , HookSimpleUser -> Maybe Text
whSimplUserLogin          :: !(Maybe Text)
    }
    deriving (HookSimpleUser -> HookSimpleUser -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookSimpleUser -> HookSimpleUser -> Bool
$c/= :: HookSimpleUser -> HookSimpleUser -> Bool
== :: HookSimpleUser -> HookSimpleUser -> Bool
$c== :: HookSimpleUser -> HookSimpleUser -> Bool
Eq, Int -> HookSimpleUser -> ShowS
[HookSimpleUser] -> ShowS
HookSimpleUser -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookSimpleUser] -> ShowS
$cshowList :: [HookSimpleUser] -> ShowS
show :: HookSimpleUser -> [Char]
$cshow :: HookSimpleUser -> [Char]
showsPrec :: Int -> HookSimpleUser -> ShowS
$cshowsPrec :: Int -> HookSimpleUser -> ShowS
Show, Typeable, Typeable HookSimpleUser
HookSimpleUser -> DataType
HookSimpleUser -> Constr
(forall b. Data b => b -> b) -> HookSimpleUser -> HookSimpleUser
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookSimpleUser -> u
forall u. (forall d. Data d => d -> u) -> HookSimpleUser -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookSimpleUser -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookSimpleUser -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookSimpleUser -> m HookSimpleUser
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookSimpleUser -> m HookSimpleUser
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookSimpleUser
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookSimpleUser -> c HookSimpleUser
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookSimpleUser)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookSimpleUser)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookSimpleUser -> m HookSimpleUser
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookSimpleUser -> m HookSimpleUser
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookSimpleUser -> m HookSimpleUser
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookSimpleUser -> m HookSimpleUser
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookSimpleUser -> m HookSimpleUser
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookSimpleUser -> m HookSimpleUser
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookSimpleUser -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookSimpleUser -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HookSimpleUser -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HookSimpleUser -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookSimpleUser -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookSimpleUser -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookSimpleUser -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookSimpleUser -> r
gmapT :: (forall b. Data b => b -> b) -> HookSimpleUser -> HookSimpleUser
$cgmapT :: (forall b. Data b => b -> b) -> HookSimpleUser -> HookSimpleUser
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookSimpleUser)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookSimpleUser)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookSimpleUser)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookSimpleUser)
dataTypeOf :: HookSimpleUser -> DataType
$cdataTypeOf :: HookSimpleUser -> DataType
toConstr :: HookSimpleUser -> Constr
$ctoConstr :: HookSimpleUser -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookSimpleUser
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookSimpleUser
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookSimpleUser -> c HookSimpleUser
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookSimpleUser -> c HookSimpleUser
Data, forall x. Rep HookSimpleUser x -> HookSimpleUser
forall x. HookSimpleUser -> Rep HookSimpleUser x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookSimpleUser x -> HookSimpleUser
$cfrom :: forall x. HookSimpleUser -> Rep HookSimpleUser x
Generic)

instance NFData HookSimpleUser where rnf :: HookSimpleUser -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "organization" field in all types of payload.

data HookOrganization = HookOrganization
    { HookOrganization -> Text
whOrgLogin                :: !Text
    , HookOrganization -> Int
whOrgId                   :: !Int
    , HookOrganization -> Text
whOrgNodeId               :: !Text
    , HookOrganization -> URL
whOrgUrl                  :: !URL
    , HookOrganization -> URL
whOrgReposUrl             :: !URL
    , HookOrganization -> URL
whOrgEventsUrl            :: !URL
    , HookOrganization -> Maybe URL
whOrgHooksUrl             :: !(Maybe URL)
    , HookOrganization -> Maybe URL
whOrgIssuesUrl            :: !(Maybe URL)
    , HookOrganization -> URL
whOrgMembersUrl           :: !URL
    , HookOrganization -> URL
whOrgPublicMembersUrl     :: !URL
    , HookOrganization -> URL
whOrgAvatarUrl            :: !URL
    , HookOrganization -> Text
whOrgDescription          :: !Text
    }
    deriving (HookOrganization -> HookOrganization -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookOrganization -> HookOrganization -> Bool
$c/= :: HookOrganization -> HookOrganization -> Bool
== :: HookOrganization -> HookOrganization -> Bool
$c== :: HookOrganization -> HookOrganization -> Bool
Eq, Int -> HookOrganization -> ShowS
[HookOrganization] -> ShowS
HookOrganization -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookOrganization] -> ShowS
$cshowList :: [HookOrganization] -> ShowS
show :: HookOrganization -> [Char]
$cshow :: HookOrganization -> [Char]
showsPrec :: Int -> HookOrganization -> ShowS
$cshowsPrec :: Int -> HookOrganization -> ShowS
Show, Typeable, Typeable HookOrganization
HookOrganization -> DataType
HookOrganization -> Constr
(forall b. Data b => b -> b)
-> HookOrganization -> HookOrganization
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookOrganization -> u
forall u. (forall d. Data d => d -> u) -> HookOrganization -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookOrganization -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookOrganization -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookOrganization -> m HookOrganization
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookOrganization -> m HookOrganization
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookOrganization
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookOrganization -> c HookOrganization
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookOrganization)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookOrganization)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookOrganization -> m HookOrganization
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookOrganization -> m HookOrganization
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookOrganization -> m HookOrganization
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookOrganization -> m HookOrganization
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookOrganization -> m HookOrganization
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookOrganization -> m HookOrganization
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookOrganization -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookOrganization -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HookOrganization -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HookOrganization -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookOrganization -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookOrganization -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookOrganization -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookOrganization -> r
gmapT :: (forall b. Data b => b -> b)
-> HookOrganization -> HookOrganization
$cgmapT :: (forall b. Data b => b -> b)
-> HookOrganization -> HookOrganization
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookOrganization)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookOrganization)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookOrganization)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookOrganization)
dataTypeOf :: HookOrganization -> DataType
$cdataTypeOf :: HookOrganization -> DataType
toConstr :: HookOrganization -> Constr
$ctoConstr :: HookOrganization -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookOrganization
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookOrganization
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookOrganization -> c HookOrganization
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookOrganization -> c HookOrganization
Data, forall x. Rep HookOrganization x -> HookOrganization
forall x. HookOrganization -> Rep HookOrganization x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookOrganization x -> HookOrganization
$cfrom :: forall x. HookOrganization -> Rep HookOrganization x
Generic)

instance NFData HookOrganization where rnf :: HookOrganization -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "invitation" field in the 'OrganizationEvent' payload.

data HookOrganizationInvitation = HookOrganizationInvitation
    { HookOrganizationInvitation -> Int
whOrgInvitationId         :: !Int
    , HookOrganizationInvitation -> Text
whOrgInvitationNodeId     :: !Text
    , HookOrganizationInvitation -> Text
whOrgInvitationLogin      :: !Text
    , HookOrganizationInvitation -> Maybe Text
whOrgInvitationEmail      :: !(Maybe Text)
    , HookOrganizationInvitation -> Text
whOrgInvitationRole       :: !Text
    }
    deriving (HookOrganizationInvitation -> HookOrganizationInvitation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookOrganizationInvitation -> HookOrganizationInvitation -> Bool
$c/= :: HookOrganizationInvitation -> HookOrganizationInvitation -> Bool
== :: HookOrganizationInvitation -> HookOrganizationInvitation -> Bool
$c== :: HookOrganizationInvitation -> HookOrganizationInvitation -> Bool
Eq, Int -> HookOrganizationInvitation -> ShowS
[HookOrganizationInvitation] -> ShowS
HookOrganizationInvitation -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookOrganizationInvitation] -> ShowS
$cshowList :: [HookOrganizationInvitation] -> ShowS
show :: HookOrganizationInvitation -> [Char]
$cshow :: HookOrganizationInvitation -> [Char]
showsPrec :: Int -> HookOrganizationInvitation -> ShowS
$cshowsPrec :: Int -> HookOrganizationInvitation -> ShowS
Show, Typeable, Typeable HookOrganizationInvitation
HookOrganizationInvitation -> DataType
HookOrganizationInvitation -> Constr
(forall b. Data b => b -> b)
-> HookOrganizationInvitation -> HookOrganizationInvitation
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> HookOrganizationInvitation -> u
forall u.
(forall d. Data d => d -> u) -> HookOrganizationInvitation -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookOrganizationInvitation
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookOrganizationInvitation
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookOrganizationInvitation -> m HookOrganizationInvitation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookOrganizationInvitation -> m HookOrganizationInvitation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookOrganizationInvitation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookOrganizationInvitation
-> c HookOrganizationInvitation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c HookOrganizationInvitation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookOrganizationInvitation)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookOrganizationInvitation -> m HookOrganizationInvitation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookOrganizationInvitation -> m HookOrganizationInvitation
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookOrganizationInvitation -> m HookOrganizationInvitation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookOrganizationInvitation -> m HookOrganizationInvitation
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookOrganizationInvitation -> m HookOrganizationInvitation
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookOrganizationInvitation -> m HookOrganizationInvitation
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> HookOrganizationInvitation -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> HookOrganizationInvitation -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> HookOrganizationInvitation -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> HookOrganizationInvitation -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookOrganizationInvitation
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookOrganizationInvitation
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookOrganizationInvitation
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookOrganizationInvitation
-> r
gmapT :: (forall b. Data b => b -> b)
-> HookOrganizationInvitation -> HookOrganizationInvitation
$cgmapT :: (forall b. Data b => b -> b)
-> HookOrganizationInvitation -> HookOrganizationInvitation
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookOrganizationInvitation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookOrganizationInvitation)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c HookOrganizationInvitation)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c HookOrganizationInvitation)
dataTypeOf :: HookOrganizationInvitation -> DataType
$cdataTypeOf :: HookOrganizationInvitation -> DataType
toConstr :: HookOrganizationInvitation -> Constr
$ctoConstr :: HookOrganizationInvitation -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookOrganizationInvitation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookOrganizationInvitation
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookOrganizationInvitation
-> c HookOrganizationInvitation
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookOrganizationInvitation
-> c HookOrganizationInvitation
Data, forall x.
Rep HookOrganizationInvitation x -> HookOrganizationInvitation
forall x.
HookOrganizationInvitation -> Rep HookOrganizationInvitation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep HookOrganizationInvitation x -> HookOrganizationInvitation
$cfrom :: forall x.
HookOrganizationInvitation -> Rep HookOrganizationInvitation x
Generic)

instance NFData HookOrganizationInvitation where rnf :: HookOrganizationInvitation -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "membership" field in the 'OrganizationEvent' payload.

data HookOrganizationMembership = HookOrganizationMembership
    { HookOrganizationMembership -> URL
whOrgMembershipUrl        :: !URL
    , HookOrganizationMembership -> Text
whOrgMembershipState      :: !Text
    , HookOrganizationMembership -> Text
whOrgMembershipRole       :: !Text
    , HookOrganizationMembership -> URL
whOrgMembershipOrgUrl     :: !URL
    , HookOrganizationMembership -> HookUser
whOrgMembershipUser       :: !HookUser
    }
    deriving (HookOrganizationMembership -> HookOrganizationMembership -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookOrganizationMembership -> HookOrganizationMembership -> Bool
$c/= :: HookOrganizationMembership -> HookOrganizationMembership -> Bool
== :: HookOrganizationMembership -> HookOrganizationMembership -> Bool
$c== :: HookOrganizationMembership -> HookOrganizationMembership -> Bool
Eq, Int -> HookOrganizationMembership -> ShowS
[HookOrganizationMembership] -> ShowS
HookOrganizationMembership -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookOrganizationMembership] -> ShowS
$cshowList :: [HookOrganizationMembership] -> ShowS
show :: HookOrganizationMembership -> [Char]
$cshow :: HookOrganizationMembership -> [Char]
showsPrec :: Int -> HookOrganizationMembership -> ShowS
$cshowsPrec :: Int -> HookOrganizationMembership -> ShowS
Show, Typeable, Typeable HookOrganizationMembership
HookOrganizationMembership -> DataType
HookOrganizationMembership -> Constr
(forall b. Data b => b -> b)
-> HookOrganizationMembership -> HookOrganizationMembership
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> HookOrganizationMembership -> u
forall u.
(forall d. Data d => d -> u) -> HookOrganizationMembership -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookOrganizationMembership
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookOrganizationMembership
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookOrganizationMembership -> m HookOrganizationMembership
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookOrganizationMembership -> m HookOrganizationMembership
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookOrganizationMembership
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookOrganizationMembership
-> c HookOrganizationMembership
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c HookOrganizationMembership)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookOrganizationMembership)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookOrganizationMembership -> m HookOrganizationMembership
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookOrganizationMembership -> m HookOrganizationMembership
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookOrganizationMembership -> m HookOrganizationMembership
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookOrganizationMembership -> m HookOrganizationMembership
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookOrganizationMembership -> m HookOrganizationMembership
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookOrganizationMembership -> m HookOrganizationMembership
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> HookOrganizationMembership -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> HookOrganizationMembership -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> HookOrganizationMembership -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> HookOrganizationMembership -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookOrganizationMembership
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookOrganizationMembership
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookOrganizationMembership
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookOrganizationMembership
-> r
gmapT :: (forall b. Data b => b -> b)
-> HookOrganizationMembership -> HookOrganizationMembership
$cgmapT :: (forall b. Data b => b -> b)
-> HookOrganizationMembership -> HookOrganizationMembership
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookOrganizationMembership)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookOrganizationMembership)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c HookOrganizationMembership)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c HookOrganizationMembership)
dataTypeOf :: HookOrganizationMembership -> DataType
$cdataTypeOf :: HookOrganizationMembership -> DataType
toConstr :: HookOrganizationMembership -> Constr
$ctoConstr :: HookOrganizationMembership -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookOrganizationMembership
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookOrganizationMembership
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookOrganizationMembership
-> c HookOrganizationMembership
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookOrganizationMembership
-> c HookOrganizationMembership
Data, forall x.
Rep HookOrganizationMembership x -> HookOrganizationMembership
forall x.
HookOrganizationMembership -> Rep HookOrganizationMembership x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep HookOrganizationMembership x -> HookOrganizationMembership
$cfrom :: forall x.
HookOrganizationMembership -> Rep HookOrganizationMembership x
Generic)

instance NFData HookOrganizationMembership where rnf :: HookOrganizationMembership -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "team" field in the 'TeamEvent' and

-- 'TeamAddEvent' payload.

data HookTeam = HookTeam
    { HookTeam -> Text
whTeamName                :: !Text
    , HookTeam -> Int
whTeamId                  :: !Int
    , HookTeam -> Text
whTeamNodeId              :: !Text
    , HookTeam -> Text
whTeamSlug                :: !Text
    , HookTeam -> Text
whTeamPermission          :: !Text
    , HookTeam -> URL
whTeamUrl                 :: !URL
    , HookTeam -> URL
whTeamMembersUrl          :: !URL
    , HookTeam -> URL
whTeamRepositoriesUrl     :: !URL
    }
    deriving (HookTeam -> HookTeam -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookTeam -> HookTeam -> Bool
$c/= :: HookTeam -> HookTeam -> Bool
== :: HookTeam -> HookTeam -> Bool
$c== :: HookTeam -> HookTeam -> Bool
Eq, Int -> HookTeam -> ShowS
[HookTeam] -> ShowS
HookTeam -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookTeam] -> ShowS
$cshowList :: [HookTeam] -> ShowS
show :: HookTeam -> [Char]
$cshow :: HookTeam -> [Char]
showsPrec :: Int -> HookTeam -> ShowS
$cshowsPrec :: Int -> HookTeam -> ShowS
Show, Typeable, Typeable HookTeam
HookTeam -> DataType
HookTeam -> Constr
(forall b. Data b => b -> b) -> HookTeam -> HookTeam
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> HookTeam -> u
forall u. (forall d. Data d => d -> u) -> HookTeam -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookTeam -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookTeam -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookTeam -> m HookTeam
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookTeam -> m HookTeam
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookTeam
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookTeam -> c HookTeam
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookTeam)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HookTeam)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookTeam -> m HookTeam
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookTeam -> m HookTeam
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookTeam -> m HookTeam
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookTeam -> m HookTeam
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookTeam -> m HookTeam
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookTeam -> m HookTeam
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HookTeam -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HookTeam -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HookTeam -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HookTeam -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookTeam -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookTeam -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookTeam -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookTeam -> r
gmapT :: (forall b. Data b => b -> b) -> HookTeam -> HookTeam
$cgmapT :: (forall b. Data b => b -> b) -> HookTeam -> HookTeam
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HookTeam)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HookTeam)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookTeam)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookTeam)
dataTypeOf :: HookTeam -> DataType
$cdataTypeOf :: HookTeam -> DataType
toConstr :: HookTeam -> Constr
$ctoConstr :: HookTeam -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookTeam
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookTeam
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookTeam -> c HookTeam
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookTeam -> c HookTeam
Data, forall x. Rep HookTeam x -> HookTeam
forall x. HookTeam -> Rep HookTeam x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookTeam x -> HookTeam
$cfrom :: forall x. HookTeam -> Rep HookTeam x
Generic)

instance NFData HookTeam where rnf :: HookTeam -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "billing_cycle" field in the

-- 'HookMarketplacePurchase' payload.

data HookMarketplaceBillingCycle
    -- | Decodes from "yearly"

    = HookMarketplaceBillingCycleYearly
    -- | Decodes from "monthly".

    | HookMarketplaceBillingCycleMonthly
    -- | The result of decoding an unknown marketplace purchase billing cycle type

    | HookMarketplaceBillingCycleOther !Text
    deriving (HookMarketplaceBillingCycle -> HookMarketplaceBillingCycle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookMarketplaceBillingCycle -> HookMarketplaceBillingCycle -> Bool
$c/= :: HookMarketplaceBillingCycle -> HookMarketplaceBillingCycle -> Bool
== :: HookMarketplaceBillingCycle -> HookMarketplaceBillingCycle -> Bool
$c== :: HookMarketplaceBillingCycle -> HookMarketplaceBillingCycle -> Bool
Eq, Eq HookMarketplaceBillingCycle
HookMarketplaceBillingCycle -> HookMarketplaceBillingCycle -> Bool
HookMarketplaceBillingCycle
-> HookMarketplaceBillingCycle -> Ordering
HookMarketplaceBillingCycle
-> HookMarketplaceBillingCycle -> HookMarketplaceBillingCycle
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HookMarketplaceBillingCycle
-> HookMarketplaceBillingCycle -> HookMarketplaceBillingCycle
$cmin :: HookMarketplaceBillingCycle
-> HookMarketplaceBillingCycle -> HookMarketplaceBillingCycle
max :: HookMarketplaceBillingCycle
-> HookMarketplaceBillingCycle -> HookMarketplaceBillingCycle
$cmax :: HookMarketplaceBillingCycle
-> HookMarketplaceBillingCycle -> HookMarketplaceBillingCycle
>= :: HookMarketplaceBillingCycle -> HookMarketplaceBillingCycle -> Bool
$c>= :: HookMarketplaceBillingCycle -> HookMarketplaceBillingCycle -> Bool
> :: HookMarketplaceBillingCycle -> HookMarketplaceBillingCycle -> Bool
$c> :: HookMarketplaceBillingCycle -> HookMarketplaceBillingCycle -> Bool
<= :: HookMarketplaceBillingCycle -> HookMarketplaceBillingCycle -> Bool
$c<= :: HookMarketplaceBillingCycle -> HookMarketplaceBillingCycle -> Bool
< :: HookMarketplaceBillingCycle -> HookMarketplaceBillingCycle -> Bool
$c< :: HookMarketplaceBillingCycle -> HookMarketplaceBillingCycle -> Bool
compare :: HookMarketplaceBillingCycle
-> HookMarketplaceBillingCycle -> Ordering
$ccompare :: HookMarketplaceBillingCycle
-> HookMarketplaceBillingCycle -> Ordering
Ord, Int -> HookMarketplaceBillingCycle -> ShowS
[HookMarketplaceBillingCycle] -> ShowS
HookMarketplaceBillingCycle -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookMarketplaceBillingCycle] -> ShowS
$cshowList :: [HookMarketplaceBillingCycle] -> ShowS
show :: HookMarketplaceBillingCycle -> [Char]
$cshow :: HookMarketplaceBillingCycle -> [Char]
showsPrec :: Int -> HookMarketplaceBillingCycle -> ShowS
$cshowsPrec :: Int -> HookMarketplaceBillingCycle -> ShowS
Show, forall x.
Rep HookMarketplaceBillingCycle x -> HookMarketplaceBillingCycle
forall x.
HookMarketplaceBillingCycle -> Rep HookMarketplaceBillingCycle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep HookMarketplaceBillingCycle x -> HookMarketplaceBillingCycle
$cfrom :: forall x.
HookMarketplaceBillingCycle -> Rep HookMarketplaceBillingCycle x
Generic, Typeable, Typeable HookMarketplaceBillingCycle
HookMarketplaceBillingCycle -> DataType
HookMarketplaceBillingCycle -> Constr
(forall b. Data b => b -> b)
-> HookMarketplaceBillingCycle -> HookMarketplaceBillingCycle
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> HookMarketplaceBillingCycle -> u
forall u.
(forall d. Data d => d -> u) -> HookMarketplaceBillingCycle -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookMarketplaceBillingCycle
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookMarketplaceBillingCycle
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookMarketplaceBillingCycle -> m HookMarketplaceBillingCycle
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMarketplaceBillingCycle -> m HookMarketplaceBillingCycle
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookMarketplaceBillingCycle
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookMarketplaceBillingCycle
-> c HookMarketplaceBillingCycle
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c HookMarketplaceBillingCycle)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookMarketplaceBillingCycle)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMarketplaceBillingCycle -> m HookMarketplaceBillingCycle
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMarketplaceBillingCycle -> m HookMarketplaceBillingCycle
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMarketplaceBillingCycle -> m HookMarketplaceBillingCycle
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMarketplaceBillingCycle -> m HookMarketplaceBillingCycle
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookMarketplaceBillingCycle -> m HookMarketplaceBillingCycle
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookMarketplaceBillingCycle -> m HookMarketplaceBillingCycle
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> HookMarketplaceBillingCycle -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> HookMarketplaceBillingCycle -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> HookMarketplaceBillingCycle -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> HookMarketplaceBillingCycle -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookMarketplaceBillingCycle
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookMarketplaceBillingCycle
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookMarketplaceBillingCycle
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookMarketplaceBillingCycle
-> r
gmapT :: (forall b. Data b => b -> b)
-> HookMarketplaceBillingCycle -> HookMarketplaceBillingCycle
$cgmapT :: (forall b. Data b => b -> b)
-> HookMarketplaceBillingCycle -> HookMarketplaceBillingCycle
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookMarketplaceBillingCycle)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookMarketplaceBillingCycle)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c HookMarketplaceBillingCycle)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c HookMarketplaceBillingCycle)
dataTypeOf :: HookMarketplaceBillingCycle -> DataType
$cdataTypeOf :: HookMarketplaceBillingCycle -> DataType
toConstr :: HookMarketplaceBillingCycle -> Constr
$ctoConstr :: HookMarketplaceBillingCycle -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookMarketplaceBillingCycle
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookMarketplaceBillingCycle
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookMarketplaceBillingCycle
-> c HookMarketplaceBillingCycle
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookMarketplaceBillingCycle
-> c HookMarketplaceBillingCycle
Data)

instance NFData HookMarketplaceBillingCycle where rnf :: HookMarketplaceBillingCycle -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

instance FromJSON HookMarketplaceBillingCycle where
  parseJSON :: Value -> Parser HookMarketplaceBillingCycle
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"Hook marketplace billing cycle" forall a b. (a -> b) -> a -> b
$ \Text
t ->
      case Text
t of
          Text
"yearly"          -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HookMarketplaceBillingCycle
HookMarketplaceBillingCycleYearly
          Text
"monthly"         -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HookMarketplaceBillingCycle
HookMarketplaceBillingCycleMonthly
          Text
_                 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> HookMarketplaceBillingCycle
HookMarketplaceBillingCycleOther Text
t)

-- | Represents the "marketplace_purchase" field in the 'MarketplacePurchaseEvent' payload.

data HookMarketplacePurchase = HookMarketplacePurchase
    { HookMarketplacePurchase -> HookMarketplaceAccount
whMarketplacePurchaseAccount         :: !HookMarketplaceAccount
    , HookMarketplacePurchase -> Maybe HookMarketplaceBillingCycle
whMarketplacePurchaseBillingCycle    :: !(Maybe HookMarketplaceBillingCycle)
    , HookMarketplacePurchase -> Int
whMarketplacePurchaseUnitCount       :: !Int
    , HookMarketplacePurchase -> Bool
whMarketplacePurchaseOnFreeTrial     :: !Bool
    , HookMarketplacePurchase -> Maybe UTCTime
whMarketplacePurchaseFreeTrialEndsOn :: !(Maybe UTCTime)
    , HookMarketplacePurchase -> Maybe UTCTime
whMarketplacePurchaseNextBillingDate :: !(Maybe UTCTime)
    , HookMarketplacePurchase -> HookMarketplacePlan
whMarketplacePurchasePlan            :: !HookMarketplacePlan
    }
    deriving (HookMarketplacePurchase -> HookMarketplacePurchase -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookMarketplacePurchase -> HookMarketplacePurchase -> Bool
$c/= :: HookMarketplacePurchase -> HookMarketplacePurchase -> Bool
== :: HookMarketplacePurchase -> HookMarketplacePurchase -> Bool
$c== :: HookMarketplacePurchase -> HookMarketplacePurchase -> Bool
Eq, Int -> HookMarketplacePurchase -> ShowS
[HookMarketplacePurchase] -> ShowS
HookMarketplacePurchase -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookMarketplacePurchase] -> ShowS
$cshowList :: [HookMarketplacePurchase] -> ShowS
show :: HookMarketplacePurchase -> [Char]
$cshow :: HookMarketplacePurchase -> [Char]
showsPrec :: Int -> HookMarketplacePurchase -> ShowS
$cshowsPrec :: Int -> HookMarketplacePurchase -> ShowS
Show, Typeable, Typeable HookMarketplacePurchase
HookMarketplacePurchase -> DataType
HookMarketplacePurchase -> Constr
(forall b. Data b => b -> b)
-> HookMarketplacePurchase -> HookMarketplacePurchase
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookMarketplacePurchase -> u
forall u.
(forall d. Data d => d -> u) -> HookMarketplacePurchase -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookMarketplacePurchase
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookMarketplacePurchase
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookMarketplacePurchase -> m HookMarketplacePurchase
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMarketplacePurchase -> m HookMarketplacePurchase
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookMarketplacePurchase
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookMarketplacePurchase
-> c HookMarketplacePurchase
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookMarketplacePurchase)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookMarketplacePurchase)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMarketplacePurchase -> m HookMarketplacePurchase
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMarketplacePurchase -> m HookMarketplacePurchase
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMarketplacePurchase -> m HookMarketplacePurchase
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMarketplacePurchase -> m HookMarketplacePurchase
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookMarketplacePurchase -> m HookMarketplacePurchase
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookMarketplacePurchase -> m HookMarketplacePurchase
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookMarketplacePurchase -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookMarketplacePurchase -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> HookMarketplacePurchase -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> HookMarketplacePurchase -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookMarketplacePurchase
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookMarketplacePurchase
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookMarketplacePurchase
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookMarketplacePurchase
-> r
gmapT :: (forall b. Data b => b -> b)
-> HookMarketplacePurchase -> HookMarketplacePurchase
$cgmapT :: (forall b. Data b => b -> b)
-> HookMarketplacePurchase -> HookMarketplacePurchase
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookMarketplacePurchase)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookMarketplacePurchase)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookMarketplacePurchase)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookMarketplacePurchase)
dataTypeOf :: HookMarketplacePurchase -> DataType
$cdataTypeOf :: HookMarketplacePurchase -> DataType
toConstr :: HookMarketplacePurchase -> Constr
$ctoConstr :: HookMarketplacePurchase -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookMarketplacePurchase
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookMarketplacePurchase
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookMarketplacePurchase
-> c HookMarketplacePurchase
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookMarketplacePurchase
-> c HookMarketplacePurchase
Data, forall x. Rep HookMarketplacePurchase x -> HookMarketplacePurchase
forall x. HookMarketplacePurchase -> Rep HookMarketplacePurchase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookMarketplacePurchase x -> HookMarketplacePurchase
$cfrom :: forall x. HookMarketplacePurchase -> Rep HookMarketplacePurchase x
Generic)

instance NFData HookMarketplacePurchase where rnf :: HookMarketplacePurchase -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "account" field in the 'HookMarketplacePurchase' payload.

data HookMarketplaceAccount = HookMarketplaceAccount
    { HookMarketplaceAccount -> OwnerType
whMarketplaceAccountType                     :: !OwnerType
    , HookMarketplaceAccount -> Int
whMarketplaceAccountId                       :: !Int
    , HookMarketplaceAccount -> Text
whMarketplaceAccountNodeId                   :: !Text
    , HookMarketplaceAccount -> Text
whMarketplaceAccountLogin                    :: !Text
    , HookMarketplaceAccount -> Maybe Text
whMarketplaceAccountOrganizationBillingEmail :: !(Maybe Text)
    }
    deriving (HookMarketplaceAccount -> HookMarketplaceAccount -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookMarketplaceAccount -> HookMarketplaceAccount -> Bool
$c/= :: HookMarketplaceAccount -> HookMarketplaceAccount -> Bool
== :: HookMarketplaceAccount -> HookMarketplaceAccount -> Bool
$c== :: HookMarketplaceAccount -> HookMarketplaceAccount -> Bool
Eq, Int -> HookMarketplaceAccount -> ShowS
[HookMarketplaceAccount] -> ShowS
HookMarketplaceAccount -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookMarketplaceAccount] -> ShowS
$cshowList :: [HookMarketplaceAccount] -> ShowS
show :: HookMarketplaceAccount -> [Char]
$cshow :: HookMarketplaceAccount -> [Char]
showsPrec :: Int -> HookMarketplaceAccount -> ShowS
$cshowsPrec :: Int -> HookMarketplaceAccount -> ShowS
Show, Typeable, Typeable HookMarketplaceAccount
HookMarketplaceAccount -> DataType
HookMarketplaceAccount -> Constr
(forall b. Data b => b -> b)
-> HookMarketplaceAccount -> HookMarketplaceAccount
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookMarketplaceAccount -> u
forall u.
(forall d. Data d => d -> u) -> HookMarketplaceAccount -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookMarketplaceAccount
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookMarketplaceAccount
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookMarketplaceAccount -> m HookMarketplaceAccount
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMarketplaceAccount -> m HookMarketplaceAccount
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookMarketplaceAccount
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookMarketplaceAccount
-> c HookMarketplaceAccount
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookMarketplaceAccount)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookMarketplaceAccount)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMarketplaceAccount -> m HookMarketplaceAccount
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMarketplaceAccount -> m HookMarketplaceAccount
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMarketplaceAccount -> m HookMarketplaceAccount
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMarketplaceAccount -> m HookMarketplaceAccount
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookMarketplaceAccount -> m HookMarketplaceAccount
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookMarketplaceAccount -> m HookMarketplaceAccount
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookMarketplaceAccount -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookMarketplaceAccount -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> HookMarketplaceAccount -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> HookMarketplaceAccount -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookMarketplaceAccount
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookMarketplaceAccount
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookMarketplaceAccount
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookMarketplaceAccount
-> r
gmapT :: (forall b. Data b => b -> b)
-> HookMarketplaceAccount -> HookMarketplaceAccount
$cgmapT :: (forall b. Data b => b -> b)
-> HookMarketplaceAccount -> HookMarketplaceAccount
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookMarketplaceAccount)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookMarketplaceAccount)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookMarketplaceAccount)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookMarketplaceAccount)
dataTypeOf :: HookMarketplaceAccount -> DataType
$cdataTypeOf :: HookMarketplaceAccount -> DataType
toConstr :: HookMarketplaceAccount -> Constr
$ctoConstr :: HookMarketplaceAccount -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookMarketplaceAccount
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookMarketplaceAccount
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookMarketplaceAccount
-> c HookMarketplaceAccount
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookMarketplaceAccount
-> c HookMarketplaceAccount
Data, forall x. Rep HookMarketplaceAccount x -> HookMarketplaceAccount
forall x. HookMarketplaceAccount -> Rep HookMarketplaceAccount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookMarketplaceAccount x -> HookMarketplaceAccount
$cfrom :: forall x. HookMarketplaceAccount -> Rep HookMarketplaceAccount x
Generic)

instance NFData HookMarketplaceAccount where rnf :: HookMarketplaceAccount -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "plan" field in the 'HookMarketplacePurchase' payload.

data HookMarketplacePlan = HookMarketplacePlan
    { HookMarketplacePlan -> Int
whMarketplacePlanId                  :: !Int
    , HookMarketplacePlan -> Text
whMarketplacePlanName                :: !Text
    , HookMarketplacePlan -> Text
whMarketplacePlanDescription         :: !Text
    , HookMarketplacePlan -> Int
whMarketplacePlanMonthlyPriceInCents :: !Int
    , HookMarketplacePlan -> Int
whMarketplacePlanYearlyPriceInCents  :: !Int
    , HookMarketplacePlan -> HookMarketplacePlanPriceModel
whMarketplacePlanPriceModel          :: !HookMarketplacePlanPriceModel
    , HookMarketplacePlan -> Bool
whMarketplacePlanHasFreeTrial        :: !Bool
    , HookMarketplacePlan -> Maybe Text
whMarketplacePlanUnitName            :: !(Maybe Text)
    , HookMarketplacePlan -> Vector Text
whMarketplacePlanBullet              :: !(Vector Text)
    }
    deriving (HookMarketplacePlan -> HookMarketplacePlan -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookMarketplacePlan -> HookMarketplacePlan -> Bool
$c/= :: HookMarketplacePlan -> HookMarketplacePlan -> Bool
== :: HookMarketplacePlan -> HookMarketplacePlan -> Bool
$c== :: HookMarketplacePlan -> HookMarketplacePlan -> Bool
Eq, Int -> HookMarketplacePlan -> ShowS
[HookMarketplacePlan] -> ShowS
HookMarketplacePlan -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookMarketplacePlan] -> ShowS
$cshowList :: [HookMarketplacePlan] -> ShowS
show :: HookMarketplacePlan -> [Char]
$cshow :: HookMarketplacePlan -> [Char]
showsPrec :: Int -> HookMarketplacePlan -> ShowS
$cshowsPrec :: Int -> HookMarketplacePlan -> ShowS
Show, Typeable, Typeable HookMarketplacePlan
HookMarketplacePlan -> DataType
HookMarketplacePlan -> Constr
(forall b. Data b => b -> b)
-> HookMarketplacePlan -> HookMarketplacePlan
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookMarketplacePlan -> u
forall u.
(forall d. Data d => d -> u) -> HookMarketplacePlan -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookMarketplacePlan -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookMarketplacePlan -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookMarketplacePlan -> m HookMarketplacePlan
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMarketplacePlan -> m HookMarketplacePlan
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookMarketplacePlan
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookMarketplacePlan
-> c HookMarketplacePlan
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookMarketplacePlan)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookMarketplacePlan)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMarketplacePlan -> m HookMarketplacePlan
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMarketplacePlan -> m HookMarketplacePlan
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMarketplacePlan -> m HookMarketplacePlan
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMarketplacePlan -> m HookMarketplacePlan
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookMarketplacePlan -> m HookMarketplacePlan
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookMarketplacePlan -> m HookMarketplacePlan
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookMarketplacePlan -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookMarketplacePlan -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> HookMarketplacePlan -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> HookMarketplacePlan -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookMarketplacePlan -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookMarketplacePlan -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookMarketplacePlan -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookMarketplacePlan -> r
gmapT :: (forall b. Data b => b -> b)
-> HookMarketplacePlan -> HookMarketplacePlan
$cgmapT :: (forall b. Data b => b -> b)
-> HookMarketplacePlan -> HookMarketplacePlan
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookMarketplacePlan)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookMarketplacePlan)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookMarketplacePlan)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookMarketplacePlan)
dataTypeOf :: HookMarketplacePlan -> DataType
$cdataTypeOf :: HookMarketplacePlan -> DataType
toConstr :: HookMarketplacePlan -> Constr
$ctoConstr :: HookMarketplacePlan -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookMarketplacePlan
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookMarketplacePlan
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookMarketplacePlan
-> c HookMarketplacePlan
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookMarketplacePlan
-> c HookMarketplacePlan
Data, forall x. Rep HookMarketplacePlan x -> HookMarketplacePlan
forall x. HookMarketplacePlan -> Rep HookMarketplacePlan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookMarketplacePlan x -> HookMarketplacePlan
$cfrom :: forall x. HookMarketplacePlan -> Rep HookMarketplacePlan x
Generic)

instance NFData HookMarketplacePlan where rnf :: HookMarketplacePlan -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "price_model" field in the

-- 'HookMarketplacePlan' payload.

data HookMarketplacePlanPriceModel
    -- | Decodes from "flat-rate"

    = HookMarketplacePlanPriceModelFlatRate
    -- | Decodes from "per-unit".

    | HookMarketplacePlanPriceModelPerUnit
    -- | Decodes from "free".

    | HookMarketplacePlanPriceModelFree
    -- | The result of decoding an unknown marketplace plan price model

    | HookMarketplacePlanPriceModelOther !Text
    deriving (HookMarketplacePlanPriceModel
-> HookMarketplacePlanPriceModel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookMarketplacePlanPriceModel
-> HookMarketplacePlanPriceModel -> Bool
$c/= :: HookMarketplacePlanPriceModel
-> HookMarketplacePlanPriceModel -> Bool
== :: HookMarketplacePlanPriceModel
-> HookMarketplacePlanPriceModel -> Bool
$c== :: HookMarketplacePlanPriceModel
-> HookMarketplacePlanPriceModel -> Bool
Eq, Eq HookMarketplacePlanPriceModel
HookMarketplacePlanPriceModel
-> HookMarketplacePlanPriceModel -> Bool
HookMarketplacePlanPriceModel
-> HookMarketplacePlanPriceModel -> Ordering
HookMarketplacePlanPriceModel
-> HookMarketplacePlanPriceModel -> HookMarketplacePlanPriceModel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HookMarketplacePlanPriceModel
-> HookMarketplacePlanPriceModel -> HookMarketplacePlanPriceModel
$cmin :: HookMarketplacePlanPriceModel
-> HookMarketplacePlanPriceModel -> HookMarketplacePlanPriceModel
max :: HookMarketplacePlanPriceModel
-> HookMarketplacePlanPriceModel -> HookMarketplacePlanPriceModel
$cmax :: HookMarketplacePlanPriceModel
-> HookMarketplacePlanPriceModel -> HookMarketplacePlanPriceModel
>= :: HookMarketplacePlanPriceModel
-> HookMarketplacePlanPriceModel -> Bool
$c>= :: HookMarketplacePlanPriceModel
-> HookMarketplacePlanPriceModel -> Bool
> :: HookMarketplacePlanPriceModel
-> HookMarketplacePlanPriceModel -> Bool
$c> :: HookMarketplacePlanPriceModel
-> HookMarketplacePlanPriceModel -> Bool
<= :: HookMarketplacePlanPriceModel
-> HookMarketplacePlanPriceModel -> Bool
$c<= :: HookMarketplacePlanPriceModel
-> HookMarketplacePlanPriceModel -> Bool
< :: HookMarketplacePlanPriceModel
-> HookMarketplacePlanPriceModel -> Bool
$c< :: HookMarketplacePlanPriceModel
-> HookMarketplacePlanPriceModel -> Bool
compare :: HookMarketplacePlanPriceModel
-> HookMarketplacePlanPriceModel -> Ordering
$ccompare :: HookMarketplacePlanPriceModel
-> HookMarketplacePlanPriceModel -> Ordering
Ord, Int -> HookMarketplacePlanPriceModel -> ShowS
[HookMarketplacePlanPriceModel] -> ShowS
HookMarketplacePlanPriceModel -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookMarketplacePlanPriceModel] -> ShowS
$cshowList :: [HookMarketplacePlanPriceModel] -> ShowS
show :: HookMarketplacePlanPriceModel -> [Char]
$cshow :: HookMarketplacePlanPriceModel -> [Char]
showsPrec :: Int -> HookMarketplacePlanPriceModel -> ShowS
$cshowsPrec :: Int -> HookMarketplacePlanPriceModel -> ShowS
Show, forall x.
Rep HookMarketplacePlanPriceModel x
-> HookMarketplacePlanPriceModel
forall x.
HookMarketplacePlanPriceModel
-> Rep HookMarketplacePlanPriceModel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep HookMarketplacePlanPriceModel x
-> HookMarketplacePlanPriceModel
$cfrom :: forall x.
HookMarketplacePlanPriceModel
-> Rep HookMarketplacePlanPriceModel x
Generic, Typeable, Typeable HookMarketplacePlanPriceModel
HookMarketplacePlanPriceModel -> DataType
HookMarketplacePlanPriceModel -> Constr
(forall b. Data b => b -> b)
-> HookMarketplacePlanPriceModel -> HookMarketplacePlanPriceModel
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> HookMarketplacePlanPriceModel
-> u
forall u.
(forall d. Data d => d -> u)
-> HookMarketplacePlanPriceModel -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookMarketplacePlanPriceModel
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookMarketplacePlanPriceModel
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookMarketplacePlanPriceModel -> m HookMarketplacePlanPriceModel
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMarketplacePlanPriceModel -> m HookMarketplacePlanPriceModel
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c HookMarketplacePlanPriceModel
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookMarketplacePlanPriceModel
-> c HookMarketplacePlanPriceModel
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c HookMarketplacePlanPriceModel)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookMarketplacePlanPriceModel)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMarketplacePlanPriceModel -> m HookMarketplacePlanPriceModel
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMarketplacePlanPriceModel -> m HookMarketplacePlanPriceModel
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMarketplacePlanPriceModel -> m HookMarketplacePlanPriceModel
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMarketplacePlanPriceModel -> m HookMarketplacePlanPriceModel
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookMarketplacePlanPriceModel -> m HookMarketplacePlanPriceModel
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookMarketplacePlanPriceModel -> m HookMarketplacePlanPriceModel
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> HookMarketplacePlanPriceModel
-> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> HookMarketplacePlanPriceModel
-> u
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> HookMarketplacePlanPriceModel -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> HookMarketplacePlanPriceModel -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookMarketplacePlanPriceModel
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookMarketplacePlanPriceModel
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookMarketplacePlanPriceModel
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookMarketplacePlanPriceModel
-> r
gmapT :: (forall b. Data b => b -> b)
-> HookMarketplacePlanPriceModel -> HookMarketplacePlanPriceModel
$cgmapT :: (forall b. Data b => b -> b)
-> HookMarketplacePlanPriceModel -> HookMarketplacePlanPriceModel
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookMarketplacePlanPriceModel)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookMarketplacePlanPriceModel)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c HookMarketplacePlanPriceModel)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c HookMarketplacePlanPriceModel)
dataTypeOf :: HookMarketplacePlanPriceModel -> DataType
$cdataTypeOf :: HookMarketplacePlanPriceModel -> DataType
toConstr :: HookMarketplacePlanPriceModel -> Constr
$ctoConstr :: HookMarketplacePlanPriceModel -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c HookMarketplacePlanPriceModel
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c HookMarketplacePlanPriceModel
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookMarketplacePlanPriceModel
-> c HookMarketplacePlanPriceModel
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookMarketplacePlanPriceModel
-> c HookMarketplacePlanPriceModel
Data)

instance NFData HookMarketplacePlanPriceModel where rnf :: HookMarketplacePlanPriceModel -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

instance FromJSON HookMarketplacePlanPriceModel where
  parseJSON :: Value -> Parser HookMarketplacePlanPriceModel
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"Hook marketplace plan price model" forall a b. (a -> b) -> a -> b
$ \Text
t ->
      case Text
t of
          Text
"flat-rate"       -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HookMarketplacePlanPriceModel
HookMarketplacePlanPriceModelFlatRate
          Text
"per-unit"        -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HookMarketplacePlanPriceModel
HookMarketplacePlanPriceModelPerUnit
          Text
"free"            -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HookMarketplacePlanPriceModel
HookMarketplacePlanPriceModelFree
          Text
_                 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> HookMarketplacePlanPriceModel
HookMarketplacePlanPriceModelOther Text
t)

type MilestoneState = Text

-- | Represents the "milestone" field in the 'MilestoneEvent' payload.

data HookMilestone = HookMilestone
    { HookMilestone -> URL
whMilestoneUrl            :: !URL
    , HookMilestone -> URL
whMilestoneHtmlUrl        :: !URL
    , HookMilestone -> URL
whMilestoneLabelsUrl      :: !URL
    , HookMilestone -> Int
whMilestoneId             :: !Int
    , HookMilestone -> Text
whMilestoneNodeId         :: !Text
    , HookMilestone -> Int
whMilestoneNumber         :: !Int
    , HookMilestone -> Text
whMilestoneTitle          :: !Text
    , HookMilestone -> Maybe Text
whMilestoneDescription    :: !(Maybe Text)
    , HookMilestone -> HookUser
whMilestoneCreator        :: !HookUser
    , HookMilestone -> Int
whMilestoneOpenIssues     :: !Int
    , HookMilestone -> Int
whMilestoneClosedIssues   :: !Int
    , HookMilestone -> Text
whMilestoneState          :: !MilestoneState
    , HookMilestone -> UTCTime
whMilestoneCreatedAt      :: !UTCTime
    , HookMilestone -> UTCTime
whMilestoneUpdatedAt      :: !UTCTime
    , HookMilestone -> Maybe UTCTime
whMilestoneDueOn          :: !(Maybe UTCTime)
    , HookMilestone -> Maybe UTCTime
whMilestoneClosedAt       :: !(Maybe UTCTime)
    }
    deriving (HookMilestone -> HookMilestone -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookMilestone -> HookMilestone -> Bool
$c/= :: HookMilestone -> HookMilestone -> Bool
== :: HookMilestone -> HookMilestone -> Bool
$c== :: HookMilestone -> HookMilestone -> Bool
Eq, Int -> HookMilestone -> ShowS
[HookMilestone] -> ShowS
HookMilestone -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookMilestone] -> ShowS
$cshowList :: [HookMilestone] -> ShowS
show :: HookMilestone -> [Char]
$cshow :: HookMilestone -> [Char]
showsPrec :: Int -> HookMilestone -> ShowS
$cshowsPrec :: Int -> HookMilestone -> ShowS
Show, Typeable, Typeable HookMilestone
HookMilestone -> DataType
HookMilestone -> Constr
(forall b. Data b => b -> b) -> HookMilestone -> HookMilestone
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> HookMilestone -> u
forall u. (forall d. Data d => d -> u) -> HookMilestone -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookMilestone -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookMilestone -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookMilestone -> m HookMilestone
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookMilestone -> m HookMilestone
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookMilestone
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookMilestone -> c HookMilestone
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookMilestone)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookMilestone)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookMilestone -> m HookMilestone
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookMilestone -> m HookMilestone
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookMilestone -> m HookMilestone
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookMilestone -> m HookMilestone
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookMilestone -> m HookMilestone
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookMilestone -> m HookMilestone
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HookMilestone -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HookMilestone -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HookMilestone -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HookMilestone -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookMilestone -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookMilestone -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookMilestone -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookMilestone -> r
gmapT :: (forall b. Data b => b -> b) -> HookMilestone -> HookMilestone
$cgmapT :: (forall b. Data b => b -> b) -> HookMilestone -> HookMilestone
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookMilestone)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookMilestone)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookMilestone)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookMilestone)
dataTypeOf :: HookMilestone -> DataType
$cdataTypeOf :: HookMilestone -> DataType
toConstr :: HookMilestone -> Constr
$ctoConstr :: HookMilestone -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookMilestone
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookMilestone
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookMilestone -> c HookMilestone
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookMilestone -> c HookMilestone
Data, forall x. Rep HookMilestone x -> HookMilestone
forall x. HookMilestone -> Rep HookMilestone x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookMilestone x -> HookMilestone
$cfrom :: forall x. HookMilestone -> Rep HookMilestone x
Generic)

instance NFData HookMilestone where rnf :: HookMilestone -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf


type MembershipState = Text
type MembershipRole = Text

-- FIXME: Not sure where this is.

data HookMembership = HookMembership
    { HookMembership -> URL
whMembershipUrl           :: !URL
    , HookMembership -> Text
whMembershipState         :: !MembershipState
    , HookMembership -> Text
whMembershipRole          :: !MembershipRole
    , HookMembership -> URL
whMembershipOrgUrl        :: !URL
    , HookMembership -> HookUser
whMembershipUser          :: !HookUser
    }
    deriving (HookMembership -> HookMembership -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookMembership -> HookMembership -> Bool
$c/= :: HookMembership -> HookMembership -> Bool
== :: HookMembership -> HookMembership -> Bool
$c== :: HookMembership -> HookMembership -> Bool
Eq, Int -> HookMembership -> ShowS
[HookMembership] -> ShowS
HookMembership -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookMembership] -> ShowS
$cshowList :: [HookMembership] -> ShowS
show :: HookMembership -> [Char]
$cshow :: HookMembership -> [Char]
showsPrec :: Int -> HookMembership -> ShowS
$cshowsPrec :: Int -> HookMembership -> ShowS
Show, Typeable, Typeable HookMembership
HookMembership -> DataType
HookMembership -> Constr
(forall b. Data b => b -> b) -> HookMembership -> HookMembership
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookMembership -> u
forall u. (forall d. Data d => d -> u) -> HookMembership -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookMembership -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookMembership -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookMembership -> m HookMembership
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMembership -> m HookMembership
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookMembership
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookMembership -> c HookMembership
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookMembership)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookMembership)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMembership -> m HookMembership
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMembership -> m HookMembership
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMembership -> m HookMembership
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookMembership -> m HookMembership
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookMembership -> m HookMembership
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookMembership -> m HookMembership
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookMembership -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookMembership -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HookMembership -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HookMembership -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookMembership -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookMembership -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookMembership -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookMembership -> r
gmapT :: (forall b. Data b => b -> b) -> HookMembership -> HookMembership
$cgmapT :: (forall b. Data b => b -> b) -> HookMembership -> HookMembership
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookMembership)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookMembership)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookMembership)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookMembership)
dataTypeOf :: HookMembership -> DataType
$cdataTypeOf :: HookMembership -> DataType
toConstr :: HookMembership -> Constr
$ctoConstr :: HookMembership -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookMembership
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookMembership
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookMembership -> c HookMembership
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookMembership -> c HookMembership
Data, forall x. Rep HookMembership x -> HookMembership
forall x. HookMembership -> Rep HookMembership x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookMembership x -> HookMembership
$cfrom :: forall x. HookMembership -> Rep HookMembership x
Generic)

instance NFData HookMembership where rnf :: HookMembership -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf


type ProjectState = Text

-- | Represents the "project" field in the 'ProjectEvent' payload.

data HookProject = HookProject
    { HookProject -> URL
whProjectOwnerUrl         :: !URL
    , HookProject -> URL
whProjectUrl              :: !URL
    , HookProject -> URL
whProjectColumnsUrl       :: !URL
    , HookProject -> Int
whProjectId               :: !Int
    , HookProject -> Text
whProjectNodeId           :: !Text
    , HookProject -> Text
whProjectName             :: !Text
    , HookProject -> Text
whProjectBody             :: !Text
    , HookProject -> Int
whProjectNumber           :: !Int
    , HookProject -> Text
whProjectState            :: !ProjectState
    , HookProject -> HookUser
whProjectCreator          :: !HookUser
    , HookProject -> UTCTime
whProjectCreatedAt        :: !UTCTime
    , HookProject -> UTCTime
whProjectUpdatedAt        :: !UTCTime
    }
    deriving (HookProject -> HookProject -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookProject -> HookProject -> Bool
$c/= :: HookProject -> HookProject -> Bool
== :: HookProject -> HookProject -> Bool
$c== :: HookProject -> HookProject -> Bool
Eq, Int -> HookProject -> ShowS
[HookProject] -> ShowS
HookProject -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookProject] -> ShowS
$cshowList :: [HookProject] -> ShowS
show :: HookProject -> [Char]
$cshow :: HookProject -> [Char]
showsPrec :: Int -> HookProject -> ShowS
$cshowsPrec :: Int -> HookProject -> ShowS
Show, Typeable, Typeable HookProject
HookProject -> DataType
HookProject -> Constr
(forall b. Data b => b -> b) -> HookProject -> HookProject
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> HookProject -> u
forall u. (forall d. Data d => d -> u) -> HookProject -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookProject -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookProject -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookProject -> m HookProject
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookProject -> m HookProject
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookProject
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookProject -> c HookProject
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookProject)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookProject)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookProject -> m HookProject
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookProject -> m HookProject
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookProject -> m HookProject
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookProject -> m HookProject
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookProject -> m HookProject
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookProject -> m HookProject
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HookProject -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HookProject -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HookProject -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HookProject -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookProject -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookProject -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookProject -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookProject -> r
gmapT :: (forall b. Data b => b -> b) -> HookProject -> HookProject
$cgmapT :: (forall b. Data b => b -> b) -> HookProject -> HookProject
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookProject)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookProject)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookProject)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookProject)
dataTypeOf :: HookProject -> DataType
$cdataTypeOf :: HookProject -> DataType
toConstr :: HookProject -> Constr
$ctoConstr :: HookProject -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookProject
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookProject
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookProject -> c HookProject
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookProject -> c HookProject
Data, forall x. Rep HookProject x -> HookProject
forall x. HookProject -> Rep HookProject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookProject x -> HookProject
$cfrom :: forall x. HookProject -> Rep HookProject x
Generic)

instance NFData HookProject where rnf :: HookProject -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "project_card" field in the 'ProjectCardEvent' payload.

data HookProjectCard = HookProjectCard
    { HookProjectCard -> URL
whProjectCardUrl          :: !URL
    , HookProjectCard -> URL
whProjectCardColumnUrl    :: !URL
    , HookProjectCard -> Int
whProjectCardColumnId     :: !Int
    , HookProjectCard -> Int
whProjectCardId           :: !Int
    , HookProjectCard -> Text
whProjectCardNodeId       :: !Text
    , HookProjectCard -> Maybe Text
whProjectCardNote         :: !(Maybe Text)
    , HookProjectCard -> HookUser
whProjectCardCreator      :: !HookUser
    , HookProjectCard -> UTCTime
whProjectCardCreatedAt    :: !UTCTime
    , HookProjectCard -> UTCTime
whProjectCardUpdatedAt    :: !UTCTime
    , HookProjectCard -> URL
whProjectCardContentUrl   :: !URL
    }
    deriving (HookProjectCard -> HookProjectCard -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookProjectCard -> HookProjectCard -> Bool
$c/= :: HookProjectCard -> HookProjectCard -> Bool
== :: HookProjectCard -> HookProjectCard -> Bool
$c== :: HookProjectCard -> HookProjectCard -> Bool
Eq, Int -> HookProjectCard -> ShowS
[HookProjectCard] -> ShowS
HookProjectCard -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookProjectCard] -> ShowS
$cshowList :: [HookProjectCard] -> ShowS
show :: HookProjectCard -> [Char]
$cshow :: HookProjectCard -> [Char]
showsPrec :: Int -> HookProjectCard -> ShowS
$cshowsPrec :: Int -> HookProjectCard -> ShowS
Show, Typeable, Typeable HookProjectCard
HookProjectCard -> DataType
HookProjectCard -> Constr
(forall b. Data b => b -> b) -> HookProjectCard -> HookProjectCard
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookProjectCard -> u
forall u. (forall d. Data d => d -> u) -> HookProjectCard -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookProjectCard -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookProjectCard -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookProjectCard -> m HookProjectCard
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookProjectCard -> m HookProjectCard
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookProjectCard
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookProjectCard -> c HookProjectCard
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookProjectCard)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookProjectCard)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookProjectCard -> m HookProjectCard
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookProjectCard -> m HookProjectCard
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookProjectCard -> m HookProjectCard
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookProjectCard -> m HookProjectCard
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookProjectCard -> m HookProjectCard
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookProjectCard -> m HookProjectCard
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookProjectCard -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookProjectCard -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HookProjectCard -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HookProjectCard -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookProjectCard -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookProjectCard -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookProjectCard -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookProjectCard -> r
gmapT :: (forall b. Data b => b -> b) -> HookProjectCard -> HookProjectCard
$cgmapT :: (forall b. Data b => b -> b) -> HookProjectCard -> HookProjectCard
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookProjectCard)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookProjectCard)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookProjectCard)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookProjectCard)
dataTypeOf :: HookProjectCard -> DataType
$cdataTypeOf :: HookProjectCard -> DataType
toConstr :: HookProjectCard -> Constr
$ctoConstr :: HookProjectCard -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookProjectCard
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookProjectCard
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookProjectCard -> c HookProjectCard
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookProjectCard -> c HookProjectCard
Data, forall x. Rep HookProjectCard x -> HookProjectCard
forall x. HookProjectCard -> Rep HookProjectCard x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookProjectCard x -> HookProjectCard
$cfrom :: forall x. HookProjectCard -> Rep HookProjectCard x
Generic)

instance NFData HookProjectCard where rnf :: HookProjectCard -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "project_column" field in the 'ProjectColumnEvent' payload.

data HookProjectColumn = HookProjectColumn
    { HookProjectColumn -> URL
whProjectColumnUrl        :: !URL
    , HookProjectColumn -> URL
whProjectColumnProjUrl    :: !URL
    , HookProjectColumn -> URL
whProjectColumnCardsUrl   :: !URL
    , HookProjectColumn -> Int
whProjectColumnId         :: !Int
    , HookProjectColumn -> Text
whProjectColumnNodeId     :: !Text
    , HookProjectColumn -> Text
whProjectColumnName       :: !Text
    , HookProjectColumn -> UTCTime
whProjectColumnCreatedAt  :: !UTCTime
    , HookProjectColumn -> UTCTime
whProjectColumnUpdatedAt  :: !UTCTime
    }
    deriving (HookProjectColumn -> HookProjectColumn -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookProjectColumn -> HookProjectColumn -> Bool
$c/= :: HookProjectColumn -> HookProjectColumn -> Bool
== :: HookProjectColumn -> HookProjectColumn -> Bool
$c== :: HookProjectColumn -> HookProjectColumn -> Bool
Eq, Int -> HookProjectColumn -> ShowS
[HookProjectColumn] -> ShowS
HookProjectColumn -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookProjectColumn] -> ShowS
$cshowList :: [HookProjectColumn] -> ShowS
show :: HookProjectColumn -> [Char]
$cshow :: HookProjectColumn -> [Char]
showsPrec :: Int -> HookProjectColumn -> ShowS
$cshowsPrec :: Int -> HookProjectColumn -> ShowS
Show, Typeable, Typeable HookProjectColumn
HookProjectColumn -> DataType
HookProjectColumn -> Constr
(forall b. Data b => b -> b)
-> HookProjectColumn -> HookProjectColumn
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookProjectColumn -> u
forall u. (forall d. Data d => d -> u) -> HookProjectColumn -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookProjectColumn -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookProjectColumn -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookProjectColumn -> m HookProjectColumn
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookProjectColumn -> m HookProjectColumn
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookProjectColumn
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookProjectColumn -> c HookProjectColumn
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookProjectColumn)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookProjectColumn)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookProjectColumn -> m HookProjectColumn
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookProjectColumn -> m HookProjectColumn
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookProjectColumn -> m HookProjectColumn
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookProjectColumn -> m HookProjectColumn
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookProjectColumn -> m HookProjectColumn
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookProjectColumn -> m HookProjectColumn
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookProjectColumn -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookProjectColumn -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HookProjectColumn -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HookProjectColumn -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookProjectColumn -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookProjectColumn -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookProjectColumn -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookProjectColumn -> r
gmapT :: (forall b. Data b => b -> b)
-> HookProjectColumn -> HookProjectColumn
$cgmapT :: (forall b. Data b => b -> b)
-> HookProjectColumn -> HookProjectColumn
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookProjectColumn)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookProjectColumn)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookProjectColumn)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookProjectColumn)
dataTypeOf :: HookProjectColumn -> DataType
$cdataTypeOf :: HookProjectColumn -> DataType
toConstr :: HookProjectColumn -> Constr
$ctoConstr :: HookProjectColumn -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookProjectColumn
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookProjectColumn
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookProjectColumn -> c HookProjectColumn
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookProjectColumn -> c HookProjectColumn
Data, forall x. Rep HookProjectColumn x -> HookProjectColumn
forall x. HookProjectColumn -> Rep HookProjectColumn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookProjectColumn x -> HookProjectColumn
$cfrom :: forall x. HookProjectColumn -> Rep HookProjectColumn x
Generic)

instance NFData HookProjectColumn where rnf :: HookProjectColumn -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "issue.labels" field in the

-- 'IssueCommentEvent' and 'IssueEvent' payloads.

data HookIssueLabels = HookIssueLabels
    { HookIssueLabels -> Maybe Int
whIssueLabelId            :: !(Maybe Int)   -- ^ Not always sent.

    , HookIssueLabels -> Maybe Text
whIssueLabelNodeId        :: !(Maybe Text)
    , HookIssueLabels -> URL
whIssueLabelUrl           :: !URL
    , HookIssueLabels -> Text
whIssueLabelName          :: !Text
    , HookIssueLabels -> Text
whIssueLabelColor         :: !Text
    , HookIssueLabels -> Bool
whIssueLabelIsDefault     :: !Bool          -- ^ Defaults to false when not present.

    }
    deriving (HookIssueLabels -> HookIssueLabels -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookIssueLabels -> HookIssueLabels -> Bool
$c/= :: HookIssueLabels -> HookIssueLabels -> Bool
== :: HookIssueLabels -> HookIssueLabels -> Bool
$c== :: HookIssueLabels -> HookIssueLabels -> Bool
Eq, Int -> HookIssueLabels -> ShowS
[HookIssueLabels] -> ShowS
HookIssueLabels -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookIssueLabels] -> ShowS
$cshowList :: [HookIssueLabels] -> ShowS
show :: HookIssueLabels -> [Char]
$cshow :: HookIssueLabels -> [Char]
showsPrec :: Int -> HookIssueLabels -> ShowS
$cshowsPrec :: Int -> HookIssueLabels -> ShowS
Show, Typeable, Typeable HookIssueLabels
HookIssueLabels -> DataType
HookIssueLabels -> Constr
(forall b. Data b => b -> b) -> HookIssueLabels -> HookIssueLabels
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookIssueLabels -> u
forall u. (forall d. Data d => d -> u) -> HookIssueLabels -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookIssueLabels -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookIssueLabels -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookIssueLabels -> m HookIssueLabels
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookIssueLabels -> m HookIssueLabels
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookIssueLabels
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookIssueLabels -> c HookIssueLabels
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookIssueLabels)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookIssueLabels)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookIssueLabels -> m HookIssueLabels
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookIssueLabels -> m HookIssueLabels
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookIssueLabels -> m HookIssueLabels
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookIssueLabels -> m HookIssueLabels
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookIssueLabels -> m HookIssueLabels
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookIssueLabels -> m HookIssueLabels
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookIssueLabels -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookIssueLabels -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HookIssueLabels -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HookIssueLabels -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookIssueLabels -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookIssueLabels -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookIssueLabels -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookIssueLabels -> r
gmapT :: (forall b. Data b => b -> b) -> HookIssueLabels -> HookIssueLabels
$cgmapT :: (forall b. Data b => b -> b) -> HookIssueLabels -> HookIssueLabels
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookIssueLabels)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookIssueLabels)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookIssueLabels)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookIssueLabels)
dataTypeOf :: HookIssueLabels -> DataType
$cdataTypeOf :: HookIssueLabels -> DataType
toConstr :: HookIssueLabels -> Constr
$ctoConstr :: HookIssueLabels -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookIssueLabels
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookIssueLabels
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookIssueLabels -> c HookIssueLabels
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookIssueLabels -> c HookIssueLabels
Data, forall x. Rep HookIssueLabels x -> HookIssueLabels
forall x. HookIssueLabels -> Rep HookIssueLabels x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookIssueLabels x -> HookIssueLabels
$cfrom :: forall x. HookIssueLabels -> Rep HookIssueLabels x
Generic)

instance NFData HookIssueLabels where rnf :: HookIssueLabels -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "status" field in the

-- 'HookCheckSuite' payload.

data HookCheckSuiteStatus
    -- | Decodes from "requested"

    = HookCheckSuiteStatusRequested
    -- | Decodes from "queued".

    | HookCheckSuiteStatusQueued
    -- | Decodes from "in_progress"

    | HookCheckSuiteStatusInProgress
    -- | Decodes from "completed"

    | HookCheckSuiteStatusCompleted
    -- | The result of decoding an unknown check suite status type

    | HookCheckSuiteStatusOther !Text
    deriving (HookCheckSuiteStatus -> HookCheckSuiteStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookCheckSuiteStatus -> HookCheckSuiteStatus -> Bool
$c/= :: HookCheckSuiteStatus -> HookCheckSuiteStatus -> Bool
== :: HookCheckSuiteStatus -> HookCheckSuiteStatus -> Bool
$c== :: HookCheckSuiteStatus -> HookCheckSuiteStatus -> Bool
Eq, Eq HookCheckSuiteStatus
HookCheckSuiteStatus -> HookCheckSuiteStatus -> Bool
HookCheckSuiteStatus -> HookCheckSuiteStatus -> Ordering
HookCheckSuiteStatus
-> HookCheckSuiteStatus -> HookCheckSuiteStatus
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HookCheckSuiteStatus
-> HookCheckSuiteStatus -> HookCheckSuiteStatus
$cmin :: HookCheckSuiteStatus
-> HookCheckSuiteStatus -> HookCheckSuiteStatus
max :: HookCheckSuiteStatus
-> HookCheckSuiteStatus -> HookCheckSuiteStatus
$cmax :: HookCheckSuiteStatus
-> HookCheckSuiteStatus -> HookCheckSuiteStatus
>= :: HookCheckSuiteStatus -> HookCheckSuiteStatus -> Bool
$c>= :: HookCheckSuiteStatus -> HookCheckSuiteStatus -> Bool
> :: HookCheckSuiteStatus -> HookCheckSuiteStatus -> Bool
$c> :: HookCheckSuiteStatus -> HookCheckSuiteStatus -> Bool
<= :: HookCheckSuiteStatus -> HookCheckSuiteStatus -> Bool
$c<= :: HookCheckSuiteStatus -> HookCheckSuiteStatus -> Bool
< :: HookCheckSuiteStatus -> HookCheckSuiteStatus -> Bool
$c< :: HookCheckSuiteStatus -> HookCheckSuiteStatus -> Bool
compare :: HookCheckSuiteStatus -> HookCheckSuiteStatus -> Ordering
$ccompare :: HookCheckSuiteStatus -> HookCheckSuiteStatus -> Ordering
Ord, Int -> HookCheckSuiteStatus -> ShowS
[HookCheckSuiteStatus] -> ShowS
HookCheckSuiteStatus -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookCheckSuiteStatus] -> ShowS
$cshowList :: [HookCheckSuiteStatus] -> ShowS
show :: HookCheckSuiteStatus -> [Char]
$cshow :: HookCheckSuiteStatus -> [Char]
showsPrec :: Int -> HookCheckSuiteStatus -> ShowS
$cshowsPrec :: Int -> HookCheckSuiteStatus -> ShowS
Show, forall x. Rep HookCheckSuiteStatus x -> HookCheckSuiteStatus
forall x. HookCheckSuiteStatus -> Rep HookCheckSuiteStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookCheckSuiteStatus x -> HookCheckSuiteStatus
$cfrom :: forall x. HookCheckSuiteStatus -> Rep HookCheckSuiteStatus x
Generic, Typeable, Typeable HookCheckSuiteStatus
HookCheckSuiteStatus -> DataType
HookCheckSuiteStatus -> Constr
(forall b. Data b => b -> b)
-> HookCheckSuiteStatus -> HookCheckSuiteStatus
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookCheckSuiteStatus -> u
forall u.
(forall d. Data d => d -> u) -> HookCheckSuiteStatus -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckSuiteStatus -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckSuiteStatus -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCheckSuiteStatus -> m HookCheckSuiteStatus
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckSuiteStatus -> m HookCheckSuiteStatus
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckSuiteStatus
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookCheckSuiteStatus
-> c HookCheckSuiteStatus
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCheckSuiteStatus)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckSuiteStatus)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckSuiteStatus -> m HookCheckSuiteStatus
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckSuiteStatus -> m HookCheckSuiteStatus
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckSuiteStatus -> m HookCheckSuiteStatus
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckSuiteStatus -> m HookCheckSuiteStatus
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCheckSuiteStatus -> m HookCheckSuiteStatus
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCheckSuiteStatus -> m HookCheckSuiteStatus
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookCheckSuiteStatus -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookCheckSuiteStatus -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> HookCheckSuiteStatus -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> HookCheckSuiteStatus -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckSuiteStatus -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckSuiteStatus -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckSuiteStatus -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckSuiteStatus -> r
gmapT :: (forall b. Data b => b -> b)
-> HookCheckSuiteStatus -> HookCheckSuiteStatus
$cgmapT :: (forall b. Data b => b -> b)
-> HookCheckSuiteStatus -> HookCheckSuiteStatus
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckSuiteStatus)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckSuiteStatus)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCheckSuiteStatus)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCheckSuiteStatus)
dataTypeOf :: HookCheckSuiteStatus -> DataType
$cdataTypeOf :: HookCheckSuiteStatus -> DataType
toConstr :: HookCheckSuiteStatus -> Constr
$ctoConstr :: HookCheckSuiteStatus -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckSuiteStatus
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckSuiteStatus
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookCheckSuiteStatus
-> c HookCheckSuiteStatus
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookCheckSuiteStatus
-> c HookCheckSuiteStatus
Data)

instance NFData HookCheckSuiteStatus where rnf :: HookCheckSuiteStatus -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

instance FromJSON HookCheckSuiteStatus where
  parseJSON :: Value -> Parser HookCheckSuiteStatus
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"Hook check suite status" forall a b. (a -> b) -> a -> b
$ \Text
t ->
      case Text
t of
          Text
"requested"          -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HookCheckSuiteStatus
HookCheckSuiteStatusRequested
          Text
"queued"             -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HookCheckSuiteStatus
HookCheckSuiteStatusQueued
          Text
"in_progress"        -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HookCheckSuiteStatus
HookCheckSuiteStatusInProgress
          Text
"completed"          -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HookCheckSuiteStatus
HookCheckSuiteStatusCompleted
          Text
_                    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> HookCheckSuiteStatus
HookCheckSuiteStatusOther Text
t)

-- | Represents the "conclusion" field in the

-- 'HookCheckSuite' payload.

data HookCheckSuiteConclusion
    -- | Decodes from "success"

    = HookCheckSuiteConclusionSuccess
    -- | Decodes from "failure"

    | HookCheckSuiteConclusionFailure
    -- | Decodes from "neutral"

    | HookCheckSuiteConclusionNeutral
    -- | Decodes from "cancelled"

    | HookCheckSuiteConclusionCancelled
    -- | Decodes from "timed_out"

    | HookCheckSuiteConclusionTimedOut
    -- | Decodes from "action_required"

    | HookCheckSuiteConclusionActionRequired
    -- | Decodes from "stale"

    | HookCheckSuiteConclusionStale
    -- | The result of decoding an unknown check suite conclusion type

    | HookCheckSuiteConclusionOther !Text
    deriving (HookCheckSuiteConclusion -> HookCheckSuiteConclusion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookCheckSuiteConclusion -> HookCheckSuiteConclusion -> Bool
$c/= :: HookCheckSuiteConclusion -> HookCheckSuiteConclusion -> Bool
== :: HookCheckSuiteConclusion -> HookCheckSuiteConclusion -> Bool
$c== :: HookCheckSuiteConclusion -> HookCheckSuiteConclusion -> Bool
Eq, Eq HookCheckSuiteConclusion
HookCheckSuiteConclusion -> HookCheckSuiteConclusion -> Bool
HookCheckSuiteConclusion -> HookCheckSuiteConclusion -> Ordering
HookCheckSuiteConclusion
-> HookCheckSuiteConclusion -> HookCheckSuiteConclusion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HookCheckSuiteConclusion
-> HookCheckSuiteConclusion -> HookCheckSuiteConclusion
$cmin :: HookCheckSuiteConclusion
-> HookCheckSuiteConclusion -> HookCheckSuiteConclusion
max :: HookCheckSuiteConclusion
-> HookCheckSuiteConclusion -> HookCheckSuiteConclusion
$cmax :: HookCheckSuiteConclusion
-> HookCheckSuiteConclusion -> HookCheckSuiteConclusion
>= :: HookCheckSuiteConclusion -> HookCheckSuiteConclusion -> Bool
$c>= :: HookCheckSuiteConclusion -> HookCheckSuiteConclusion -> Bool
> :: HookCheckSuiteConclusion -> HookCheckSuiteConclusion -> Bool
$c> :: HookCheckSuiteConclusion -> HookCheckSuiteConclusion -> Bool
<= :: HookCheckSuiteConclusion -> HookCheckSuiteConclusion -> Bool
$c<= :: HookCheckSuiteConclusion -> HookCheckSuiteConclusion -> Bool
< :: HookCheckSuiteConclusion -> HookCheckSuiteConclusion -> Bool
$c< :: HookCheckSuiteConclusion -> HookCheckSuiteConclusion -> Bool
compare :: HookCheckSuiteConclusion -> HookCheckSuiteConclusion -> Ordering
$ccompare :: HookCheckSuiteConclusion -> HookCheckSuiteConclusion -> Ordering
Ord, Int -> HookCheckSuiteConclusion -> ShowS
[HookCheckSuiteConclusion] -> ShowS
HookCheckSuiteConclusion -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookCheckSuiteConclusion] -> ShowS
$cshowList :: [HookCheckSuiteConclusion] -> ShowS
show :: HookCheckSuiteConclusion -> [Char]
$cshow :: HookCheckSuiteConclusion -> [Char]
showsPrec :: Int -> HookCheckSuiteConclusion -> ShowS
$cshowsPrec :: Int -> HookCheckSuiteConclusion -> ShowS
Show, forall x.
Rep HookCheckSuiteConclusion x -> HookCheckSuiteConclusion
forall x.
HookCheckSuiteConclusion -> Rep HookCheckSuiteConclusion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep HookCheckSuiteConclusion x -> HookCheckSuiteConclusion
$cfrom :: forall x.
HookCheckSuiteConclusion -> Rep HookCheckSuiteConclusion x
Generic, Typeable, Typeable HookCheckSuiteConclusion
HookCheckSuiteConclusion -> DataType
HookCheckSuiteConclusion -> Constr
(forall b. Data b => b -> b)
-> HookCheckSuiteConclusion -> HookCheckSuiteConclusion
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> HookCheckSuiteConclusion -> u
forall u.
(forall d. Data d => d -> u) -> HookCheckSuiteConclusion -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookCheckSuiteConclusion
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookCheckSuiteConclusion
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCheckSuiteConclusion -> m HookCheckSuiteConclusion
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckSuiteConclusion -> m HookCheckSuiteConclusion
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckSuiteConclusion
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookCheckSuiteConclusion
-> c HookCheckSuiteConclusion
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCheckSuiteConclusion)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckSuiteConclusion)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckSuiteConclusion -> m HookCheckSuiteConclusion
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckSuiteConclusion -> m HookCheckSuiteConclusion
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckSuiteConclusion -> m HookCheckSuiteConclusion
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckSuiteConclusion -> m HookCheckSuiteConclusion
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCheckSuiteConclusion -> m HookCheckSuiteConclusion
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCheckSuiteConclusion -> m HookCheckSuiteConclusion
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> HookCheckSuiteConclusion -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> HookCheckSuiteConclusion -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> HookCheckSuiteConclusion -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> HookCheckSuiteConclusion -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookCheckSuiteConclusion
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookCheckSuiteConclusion
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookCheckSuiteConclusion
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookCheckSuiteConclusion
-> r
gmapT :: (forall b. Data b => b -> b)
-> HookCheckSuiteConclusion -> HookCheckSuiteConclusion
$cgmapT :: (forall b. Data b => b -> b)
-> HookCheckSuiteConclusion -> HookCheckSuiteConclusion
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckSuiteConclusion)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckSuiteConclusion)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCheckSuiteConclusion)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCheckSuiteConclusion)
dataTypeOf :: HookCheckSuiteConclusion -> DataType
$cdataTypeOf :: HookCheckSuiteConclusion -> DataType
toConstr :: HookCheckSuiteConclusion -> Constr
$ctoConstr :: HookCheckSuiteConclusion -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckSuiteConclusion
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckSuiteConclusion
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookCheckSuiteConclusion
-> c HookCheckSuiteConclusion
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookCheckSuiteConclusion
-> c HookCheckSuiteConclusion
Data)

instance NFData HookCheckSuiteConclusion where rnf :: HookCheckSuiteConclusion -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

instance FromJSON HookCheckSuiteConclusion where
  parseJSON :: Value -> Parser HookCheckSuiteConclusion
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"Hook check suite status" forall a b. (a -> b) -> a -> b
$ \Text
t ->
      case Text
t of
          Text
"success"               -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HookCheckSuiteConclusion
HookCheckSuiteConclusionSuccess
          Text
"failure"               -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HookCheckSuiteConclusion
HookCheckSuiteConclusionFailure
          Text
"neutral"               -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HookCheckSuiteConclusion
HookCheckSuiteConclusionNeutral
          Text
"cancelled"             -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HookCheckSuiteConclusion
HookCheckSuiteConclusionCancelled
          Text
"timed_out"             -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HookCheckSuiteConclusion
HookCheckSuiteConclusionTimedOut
          Text
"action_required"       -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HookCheckSuiteConclusion
HookCheckSuiteConclusionActionRequired
          Text
"stale"                 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HookCheckSuiteConclusion
HookCheckSuiteConclusionStale
          Text
_                       -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> HookCheckSuiteConclusion
HookCheckSuiteConclusionOther Text
t)

-- FIXME: Missing nested "app", there are examples, but no documentation.

-- | Represents the "check_suite" field in the

-- 'CheckSuiteEvent' payload.

data HookCheckSuite = HookCheckSuite
    { HookCheckSuite -> Int
whCheckSuiteId                   :: !Int
    , HookCheckSuite -> Text
whCheckSuiteNodeId               :: !Text
    , HookCheckSuite -> Maybe Text
whCheckSuiteHeadBranch           :: !(Maybe Text) -- ^ The Checks API only looks for pushes in the repository where the check suite or check run were created. Pushes to a branch in a forked repository are not detected and return an empty pull_requests array and a null value for head_branch.

    , HookCheckSuite -> Text
whCheckSuiteHeadSha              :: !Text
    , HookCheckSuite -> HookCheckSuiteStatus
whCheckSuiteStatus               :: !HookCheckSuiteStatus
    , HookCheckSuite -> Maybe HookCheckSuiteConclusion
whCheckSuiteConclusion           :: !(Maybe HookCheckSuiteConclusion)
    , HookCheckSuite -> URL
whCheckSuiteUrl                  :: !URL
    , HookCheckSuite -> Maybe Text
whCheckSuiteBeforeSha            :: !(Maybe Text)
    , HookCheckSuite -> Maybe Text
whCheckSuiteAfterSha             :: !(Maybe Text)
    , HookCheckSuite -> Vector HookChecksPullRequest
whCheckSuitePullRequests         :: !(Vector HookChecksPullRequest)
    , HookCheckSuite -> UTCTime
whCheckSuiteCreatedAt            :: !UTCTime
    , HookCheckSuite -> UTCTime
whCheckSuiteUpdatedAt            :: !UTCTime
    , HookCheckSuite -> Maybe Int
whCheckSuiteLatestCheckRunsCount :: !(Maybe Int) -- not included in the check run nested payload

    , HookCheckSuite -> Maybe URL
whCheckSuiteCheckRunsUrl         :: !(Maybe URL) -- not included in the check run nested payload

    , HookCheckSuite -> Maybe HookCheckSuiteCommit
whCheckSuiteHeadCommit           :: !(Maybe HookCheckSuiteCommit) -- not included in the check run nested payload

    }
    deriving (HookCheckSuite -> HookCheckSuite -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookCheckSuite -> HookCheckSuite -> Bool
$c/= :: HookCheckSuite -> HookCheckSuite -> Bool
== :: HookCheckSuite -> HookCheckSuite -> Bool
$c== :: HookCheckSuite -> HookCheckSuite -> Bool
Eq, Int -> HookCheckSuite -> ShowS
[HookCheckSuite] -> ShowS
HookCheckSuite -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookCheckSuite] -> ShowS
$cshowList :: [HookCheckSuite] -> ShowS
show :: HookCheckSuite -> [Char]
$cshow :: HookCheckSuite -> [Char]
showsPrec :: Int -> HookCheckSuite -> ShowS
$cshowsPrec :: Int -> HookCheckSuite -> ShowS
Show, Typeable, Typeable HookCheckSuite
HookCheckSuite -> DataType
HookCheckSuite -> Constr
(forall b. Data b => b -> b) -> HookCheckSuite -> HookCheckSuite
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookCheckSuite -> u
forall u. (forall d. Data d => d -> u) -> HookCheckSuite -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckSuite -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckSuite -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCheckSuite -> m HookCheckSuite
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckSuite -> m HookCheckSuite
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckSuite
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookCheckSuite -> c HookCheckSuite
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCheckSuite)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckSuite)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckSuite -> m HookCheckSuite
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckSuite -> m HookCheckSuite
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckSuite -> m HookCheckSuite
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckSuite -> m HookCheckSuite
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCheckSuite -> m HookCheckSuite
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCheckSuite -> m HookCheckSuite
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookCheckSuite -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookCheckSuite -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HookCheckSuite -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HookCheckSuite -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckSuite -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckSuite -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckSuite -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckSuite -> r
gmapT :: (forall b. Data b => b -> b) -> HookCheckSuite -> HookCheckSuite
$cgmapT :: (forall b. Data b => b -> b) -> HookCheckSuite -> HookCheckSuite
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckSuite)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckSuite)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCheckSuite)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCheckSuite)
dataTypeOf :: HookCheckSuite -> DataType
$cdataTypeOf :: HookCheckSuite -> DataType
toConstr :: HookCheckSuite -> Constr
$ctoConstr :: HookCheckSuite -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckSuite
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckSuite
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookCheckSuite -> c HookCheckSuite
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookCheckSuite -> c HookCheckSuite
Data, forall x. Rep HookCheckSuite x -> HookCheckSuite
forall x. HookCheckSuite -> Rep HookCheckSuite x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookCheckSuite x -> HookCheckSuite
$cfrom :: forall x. HookCheckSuite -> Rep HookCheckSuite x
Generic)

instance NFData HookCheckSuite where rnf :: HookCheckSuite -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "head_commit" field in the

--  'CheckSuiteEvent' payload.

data HookCheckSuiteCommit = HookCheckSuiteCommit
    { HookCheckSuiteCommit -> Text
whCheckSuiteCommitSha               :: !Text          -- ^ Sometimes called the commit 'id'.

    , HookCheckSuiteCommit -> HookSimpleUser
whCheckSuiteCommitAuthor            :: !HookSimpleUser
    , HookCheckSuiteCommit -> HookSimpleUser
whCheckSuiteCommitCommitter         :: !HookSimpleUser
    }
    deriving (HookCheckSuiteCommit -> HookCheckSuiteCommit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookCheckSuiteCommit -> HookCheckSuiteCommit -> Bool
$c/= :: HookCheckSuiteCommit -> HookCheckSuiteCommit -> Bool
== :: HookCheckSuiteCommit -> HookCheckSuiteCommit -> Bool
$c== :: HookCheckSuiteCommit -> HookCheckSuiteCommit -> Bool
Eq, Int -> HookCheckSuiteCommit -> ShowS
[HookCheckSuiteCommit] -> ShowS
HookCheckSuiteCommit -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookCheckSuiteCommit] -> ShowS
$cshowList :: [HookCheckSuiteCommit] -> ShowS
show :: HookCheckSuiteCommit -> [Char]
$cshow :: HookCheckSuiteCommit -> [Char]
showsPrec :: Int -> HookCheckSuiteCommit -> ShowS
$cshowsPrec :: Int -> HookCheckSuiteCommit -> ShowS
Show, Typeable, Typeable HookCheckSuiteCommit
HookCheckSuiteCommit -> DataType
HookCheckSuiteCommit -> Constr
(forall b. Data b => b -> b)
-> HookCheckSuiteCommit -> HookCheckSuiteCommit
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookCheckSuiteCommit -> u
forall u.
(forall d. Data d => d -> u) -> HookCheckSuiteCommit -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckSuiteCommit -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckSuiteCommit -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCheckSuiteCommit -> m HookCheckSuiteCommit
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckSuiteCommit -> m HookCheckSuiteCommit
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckSuiteCommit
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookCheckSuiteCommit
-> c HookCheckSuiteCommit
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCheckSuiteCommit)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckSuiteCommit)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckSuiteCommit -> m HookCheckSuiteCommit
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckSuiteCommit -> m HookCheckSuiteCommit
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckSuiteCommit -> m HookCheckSuiteCommit
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckSuiteCommit -> m HookCheckSuiteCommit
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCheckSuiteCommit -> m HookCheckSuiteCommit
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCheckSuiteCommit -> m HookCheckSuiteCommit
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookCheckSuiteCommit -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookCheckSuiteCommit -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> HookCheckSuiteCommit -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> HookCheckSuiteCommit -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckSuiteCommit -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckSuiteCommit -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckSuiteCommit -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckSuiteCommit -> r
gmapT :: (forall b. Data b => b -> b)
-> HookCheckSuiteCommit -> HookCheckSuiteCommit
$cgmapT :: (forall b. Data b => b -> b)
-> HookCheckSuiteCommit -> HookCheckSuiteCommit
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckSuiteCommit)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckSuiteCommit)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCheckSuiteCommit)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCheckSuiteCommit)
dataTypeOf :: HookCheckSuiteCommit -> DataType
$cdataTypeOf :: HookCheckSuiteCommit -> DataType
toConstr :: HookCheckSuiteCommit -> Constr
$ctoConstr :: HookCheckSuiteCommit -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckSuiteCommit
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckSuiteCommit
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookCheckSuiteCommit
-> c HookCheckSuiteCommit
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookCheckSuiteCommit
-> c HookCheckSuiteCommit
Data, forall x. Rep HookCheckSuiteCommit x -> HookCheckSuiteCommit
forall x. HookCheckSuiteCommit -> Rep HookCheckSuiteCommit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookCheckSuiteCommit x -> HookCheckSuiteCommit
$cfrom :: forall x. HookCheckSuiteCommit -> Rep HookCheckSuiteCommit x
Generic)

instance NFData HookCheckSuiteCommit where rnf :: HookCheckSuiteCommit -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "status" field in the

--  'HookCheckRun' payload.

data HookCheckRunStatus
    -- | Decodes from "queued"

    = HookCheckRunStatusQueued
    -- | Decodes from "in_progress"

    | HookCheckRunStatusInProgress
    -- | Decodes from "completed"

    | HookCheckRunStatusCompleted
    -- | The result of decoding an unknown check run status type

    | HookCheckRunStatusOther !Text
    deriving (HookCheckRunStatus -> HookCheckRunStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookCheckRunStatus -> HookCheckRunStatus -> Bool
$c/= :: HookCheckRunStatus -> HookCheckRunStatus -> Bool
== :: HookCheckRunStatus -> HookCheckRunStatus -> Bool
$c== :: HookCheckRunStatus -> HookCheckRunStatus -> Bool
Eq, Eq HookCheckRunStatus
HookCheckRunStatus -> HookCheckRunStatus -> Bool
HookCheckRunStatus -> HookCheckRunStatus -> Ordering
HookCheckRunStatus -> HookCheckRunStatus -> HookCheckRunStatus
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HookCheckRunStatus -> HookCheckRunStatus -> HookCheckRunStatus
$cmin :: HookCheckRunStatus -> HookCheckRunStatus -> HookCheckRunStatus
max :: HookCheckRunStatus -> HookCheckRunStatus -> HookCheckRunStatus
$cmax :: HookCheckRunStatus -> HookCheckRunStatus -> HookCheckRunStatus
>= :: HookCheckRunStatus -> HookCheckRunStatus -> Bool
$c>= :: HookCheckRunStatus -> HookCheckRunStatus -> Bool
> :: HookCheckRunStatus -> HookCheckRunStatus -> Bool
$c> :: HookCheckRunStatus -> HookCheckRunStatus -> Bool
<= :: HookCheckRunStatus -> HookCheckRunStatus -> Bool
$c<= :: HookCheckRunStatus -> HookCheckRunStatus -> Bool
< :: HookCheckRunStatus -> HookCheckRunStatus -> Bool
$c< :: HookCheckRunStatus -> HookCheckRunStatus -> Bool
compare :: HookCheckRunStatus -> HookCheckRunStatus -> Ordering
$ccompare :: HookCheckRunStatus -> HookCheckRunStatus -> Ordering
Ord, Int -> HookCheckRunStatus -> ShowS
[HookCheckRunStatus] -> ShowS
HookCheckRunStatus -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookCheckRunStatus] -> ShowS
$cshowList :: [HookCheckRunStatus] -> ShowS
show :: HookCheckRunStatus -> [Char]
$cshow :: HookCheckRunStatus -> [Char]
showsPrec :: Int -> HookCheckRunStatus -> ShowS
$cshowsPrec :: Int -> HookCheckRunStatus -> ShowS
Show, forall x. Rep HookCheckRunStatus x -> HookCheckRunStatus
forall x. HookCheckRunStatus -> Rep HookCheckRunStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookCheckRunStatus x -> HookCheckRunStatus
$cfrom :: forall x. HookCheckRunStatus -> Rep HookCheckRunStatus x
Generic, Typeable, Typeable HookCheckRunStatus
HookCheckRunStatus -> DataType
HookCheckRunStatus -> Constr
(forall b. Data b => b -> b)
-> HookCheckRunStatus -> HookCheckRunStatus
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookCheckRunStatus -> u
forall u. (forall d. Data d => d -> u) -> HookCheckRunStatus -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckRunStatus -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckRunStatus -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCheckRunStatus -> m HookCheckRunStatus
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckRunStatus -> m HookCheckRunStatus
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckRunStatus
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookCheckRunStatus
-> c HookCheckRunStatus
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCheckRunStatus)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckRunStatus)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckRunStatus -> m HookCheckRunStatus
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckRunStatus -> m HookCheckRunStatus
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckRunStatus -> m HookCheckRunStatus
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckRunStatus -> m HookCheckRunStatus
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCheckRunStatus -> m HookCheckRunStatus
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCheckRunStatus -> m HookCheckRunStatus
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookCheckRunStatus -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookCheckRunStatus -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HookCheckRunStatus -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HookCheckRunStatus -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckRunStatus -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckRunStatus -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckRunStatus -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckRunStatus -> r
gmapT :: (forall b. Data b => b -> b)
-> HookCheckRunStatus -> HookCheckRunStatus
$cgmapT :: (forall b. Data b => b -> b)
-> HookCheckRunStatus -> HookCheckRunStatus
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckRunStatus)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckRunStatus)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCheckRunStatus)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCheckRunStatus)
dataTypeOf :: HookCheckRunStatus -> DataType
$cdataTypeOf :: HookCheckRunStatus -> DataType
toConstr :: HookCheckRunStatus -> Constr
$ctoConstr :: HookCheckRunStatus -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckRunStatus
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckRunStatus
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookCheckRunStatus
-> c HookCheckRunStatus
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookCheckRunStatus
-> c HookCheckRunStatus
Data)

instance NFData HookCheckRunStatus where rnf :: HookCheckRunStatus -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

instance FromJSON HookCheckRunStatus where
  parseJSON :: Value -> Parser HookCheckRunStatus
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"Hook check suite status" forall a b. (a -> b) -> a -> b
$ \Text
t ->
      case Text
t of
          Text
"queued"             -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HookCheckRunStatus
HookCheckRunStatusQueued
          Text
"in_progress"        -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HookCheckRunStatus
HookCheckRunStatusInProgress
          Text
"completed"          -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HookCheckRunStatus
HookCheckRunStatusCompleted
          Text
_                    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> HookCheckRunStatus
HookCheckRunStatusOther Text
t)

-- | Represents the "conclusion" field in the

--  'HookCheckRun' payload.

data HookCheckRunConclusion
    -- | Decodes from "success"

    = HookCheckRunConclusionSuccess
    -- | Decodes from "failure"

    | HookCheckRunConclusionFailure
    -- | Decodes from "neutral"

    | HookCheckRunConclusionNeutral
    -- | Decodes from "cancelled"

    | HookCheckRunConclusionCancelled
    -- | Decodes from "timed_out"

    | HookCheckRunConclusionTimedOut
    -- | Decodes from "action_required"

    | HookCheckRunConclusionActionRequired
    -- | Decodes from "stale"

    | HookCheckRunConclusionStale
    -- | The result of decoding an unknown check run conclusion type

    | HookCheckRunConclusionOther !Text
    deriving (HookCheckRunConclusion -> HookCheckRunConclusion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookCheckRunConclusion -> HookCheckRunConclusion -> Bool
$c/= :: HookCheckRunConclusion -> HookCheckRunConclusion -> Bool
== :: HookCheckRunConclusion -> HookCheckRunConclusion -> Bool
$c== :: HookCheckRunConclusion -> HookCheckRunConclusion -> Bool
Eq, Eq HookCheckRunConclusion
HookCheckRunConclusion -> HookCheckRunConclusion -> Bool
HookCheckRunConclusion -> HookCheckRunConclusion -> Ordering
HookCheckRunConclusion
-> HookCheckRunConclusion -> HookCheckRunConclusion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: HookCheckRunConclusion
-> HookCheckRunConclusion -> HookCheckRunConclusion
$cmin :: HookCheckRunConclusion
-> HookCheckRunConclusion -> HookCheckRunConclusion
max :: HookCheckRunConclusion
-> HookCheckRunConclusion -> HookCheckRunConclusion
$cmax :: HookCheckRunConclusion
-> HookCheckRunConclusion -> HookCheckRunConclusion
>= :: HookCheckRunConclusion -> HookCheckRunConclusion -> Bool
$c>= :: HookCheckRunConclusion -> HookCheckRunConclusion -> Bool
> :: HookCheckRunConclusion -> HookCheckRunConclusion -> Bool
$c> :: HookCheckRunConclusion -> HookCheckRunConclusion -> Bool
<= :: HookCheckRunConclusion -> HookCheckRunConclusion -> Bool
$c<= :: HookCheckRunConclusion -> HookCheckRunConclusion -> Bool
< :: HookCheckRunConclusion -> HookCheckRunConclusion -> Bool
$c< :: HookCheckRunConclusion -> HookCheckRunConclusion -> Bool
compare :: HookCheckRunConclusion -> HookCheckRunConclusion -> Ordering
$ccompare :: HookCheckRunConclusion -> HookCheckRunConclusion -> Ordering
Ord, Int -> HookCheckRunConclusion -> ShowS
[HookCheckRunConclusion] -> ShowS
HookCheckRunConclusion -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookCheckRunConclusion] -> ShowS
$cshowList :: [HookCheckRunConclusion] -> ShowS
show :: HookCheckRunConclusion -> [Char]
$cshow :: HookCheckRunConclusion -> [Char]
showsPrec :: Int -> HookCheckRunConclusion -> ShowS
$cshowsPrec :: Int -> HookCheckRunConclusion -> ShowS
Show, forall x. Rep HookCheckRunConclusion x -> HookCheckRunConclusion
forall x. HookCheckRunConclusion -> Rep HookCheckRunConclusion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookCheckRunConclusion x -> HookCheckRunConclusion
$cfrom :: forall x. HookCheckRunConclusion -> Rep HookCheckRunConclusion x
Generic, Typeable, Typeable HookCheckRunConclusion
HookCheckRunConclusion -> DataType
HookCheckRunConclusion -> Constr
(forall b. Data b => b -> b)
-> HookCheckRunConclusion -> HookCheckRunConclusion
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookCheckRunConclusion -> u
forall u.
(forall d. Data d => d -> u) -> HookCheckRunConclusion -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookCheckRunConclusion
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookCheckRunConclusion
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCheckRunConclusion -> m HookCheckRunConclusion
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckRunConclusion -> m HookCheckRunConclusion
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckRunConclusion
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookCheckRunConclusion
-> c HookCheckRunConclusion
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCheckRunConclusion)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckRunConclusion)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckRunConclusion -> m HookCheckRunConclusion
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckRunConclusion -> m HookCheckRunConclusion
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckRunConclusion -> m HookCheckRunConclusion
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckRunConclusion -> m HookCheckRunConclusion
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCheckRunConclusion -> m HookCheckRunConclusion
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCheckRunConclusion -> m HookCheckRunConclusion
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookCheckRunConclusion -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookCheckRunConclusion -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> HookCheckRunConclusion -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> HookCheckRunConclusion -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookCheckRunConclusion
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookCheckRunConclusion
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookCheckRunConclusion
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookCheckRunConclusion
-> r
gmapT :: (forall b. Data b => b -> b)
-> HookCheckRunConclusion -> HookCheckRunConclusion
$cgmapT :: (forall b. Data b => b -> b)
-> HookCheckRunConclusion -> HookCheckRunConclusion
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckRunConclusion)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckRunConclusion)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCheckRunConclusion)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCheckRunConclusion)
dataTypeOf :: HookCheckRunConclusion -> DataType
$cdataTypeOf :: HookCheckRunConclusion -> DataType
toConstr :: HookCheckRunConclusion -> Constr
$ctoConstr :: HookCheckRunConclusion -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckRunConclusion
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckRunConclusion
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookCheckRunConclusion
-> c HookCheckRunConclusion
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookCheckRunConclusion
-> c HookCheckRunConclusion
Data)

instance NFData HookCheckRunConclusion where rnf :: HookCheckRunConclusion -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

instance FromJSON HookCheckRunConclusion where
  parseJSON :: Value -> Parser HookCheckRunConclusion
parseJSON = forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"Hook check suite status" forall a b. (a -> b) -> a -> b
$ \Text
t ->
      case Text
t of
          Text
"success"               -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HookCheckRunConclusion
HookCheckRunConclusionSuccess
          Text
"failure"               -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HookCheckRunConclusion
HookCheckRunConclusionFailure
          Text
"neutral"               -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HookCheckRunConclusion
HookCheckRunConclusionNeutral
          Text
"cancelled"             -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HookCheckRunConclusion
HookCheckRunConclusionCancelled
          Text
"timed_out"             -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HookCheckRunConclusion
HookCheckRunConclusionTimedOut
          Text
"action_required"       -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HookCheckRunConclusion
HookCheckRunConclusionActionRequired
          Text
"stale"                 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure HookCheckRunConclusion
HookCheckRunConclusionStale
          Text
_                       -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> HookCheckRunConclusion
HookCheckRunConclusionOther Text
t)

-- FIXME: Missing nested "app", there are examples, but no documentation.

-- | Represents the "check_run" field in the

--  'CheckRunEvent' payload.

data HookCheckRun = HookCheckRun
    { HookCheckRun -> Int
whCheckRunId                   :: !Int
    , HookCheckRun -> Text
whCheckRunNodeId               :: !Text
    , HookCheckRun -> Text
whCheckRunHeadSha              :: !Text
    , HookCheckRun -> Text
whCheckRunExternalId           :: !Text
    , HookCheckRun -> URL
whCheckRunUrl                  :: !URL
    , HookCheckRun -> URL
whCheckRunHtmlUrl              :: !URL
    , HookCheckRun -> URL
whCheckRunDetailsUrl           :: !URL
    , HookCheckRun -> HookCheckRunStatus
whCheckRunStatus               :: !HookCheckRunStatus
    , HookCheckRun -> Maybe HookCheckRunConclusion
whCheckRunConclusion           :: !(Maybe HookCheckRunConclusion)
    , HookCheckRun -> UTCTime
whCheckRunStartedAt            :: !UTCTime
    , HookCheckRun -> Maybe UTCTime
whCheckRunCompletedAt          :: !(Maybe UTCTime)
    , HookCheckRun -> HookCheckRunOutput
whCheckRunOutput               :: !HookCheckRunOutput
    , HookCheckRun -> Text
whCheckRunName                 :: !Text
    , HookCheckRun -> HookCheckSuite
whCheckRunCheckSuite           :: !HookCheckSuite
    , HookCheckRun -> Vector HookChecksPullRequest
whCheckRunPullRequests         :: !(Vector HookChecksPullRequest)
    }
    deriving (HookCheckRun -> HookCheckRun -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookCheckRun -> HookCheckRun -> Bool
$c/= :: HookCheckRun -> HookCheckRun -> Bool
== :: HookCheckRun -> HookCheckRun -> Bool
$c== :: HookCheckRun -> HookCheckRun -> Bool
Eq, Int -> HookCheckRun -> ShowS
[HookCheckRun] -> ShowS
HookCheckRun -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookCheckRun] -> ShowS
$cshowList :: [HookCheckRun] -> ShowS
show :: HookCheckRun -> [Char]
$cshow :: HookCheckRun -> [Char]
showsPrec :: Int -> HookCheckRun -> ShowS
$cshowsPrec :: Int -> HookCheckRun -> ShowS
Show, Typeable, Typeable HookCheckRun
HookCheckRun -> DataType
HookCheckRun -> Constr
(forall b. Data b => b -> b) -> HookCheckRun -> HookCheckRun
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> HookCheckRun -> u
forall u. (forall d. Data d => d -> u) -> HookCheckRun -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckRun -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckRun -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookCheckRun -> m HookCheckRun
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookCheckRun -> m HookCheckRun
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckRun
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookCheckRun -> c HookCheckRun
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCheckRun)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckRun)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookCheckRun -> m HookCheckRun
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookCheckRun -> m HookCheckRun
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookCheckRun -> m HookCheckRun
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookCheckRun -> m HookCheckRun
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookCheckRun -> m HookCheckRun
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookCheckRun -> m HookCheckRun
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HookCheckRun -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HookCheckRun -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HookCheckRun -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HookCheckRun -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckRun -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckRun -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckRun -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckRun -> r
gmapT :: (forall b. Data b => b -> b) -> HookCheckRun -> HookCheckRun
$cgmapT :: (forall b. Data b => b -> b) -> HookCheckRun -> HookCheckRun
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckRun)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckRun)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCheckRun)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCheckRun)
dataTypeOf :: HookCheckRun -> DataType
$cdataTypeOf :: HookCheckRun -> DataType
toConstr :: HookCheckRun -> Constr
$ctoConstr :: HookCheckRun -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckRun
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckRun
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookCheckRun -> c HookCheckRun
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookCheckRun -> c HookCheckRun
Data, forall x. Rep HookCheckRun x -> HookCheckRun
forall x. HookCheckRun -> Rep HookCheckRun x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookCheckRun x -> HookCheckRun
$cfrom :: forall x. HookCheckRun -> Rep HookCheckRun x
Generic)

instance NFData HookCheckRun where rnf :: HookCheckRun -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "output" field in the

--  'HookCheckRun' payload.

data HookCheckRunOutput = HookCheckRunOutput
    { HookCheckRunOutput -> Maybe Text
whCheckRunOutputTitle            :: !(Maybe Text)
    , HookCheckRunOutput -> Maybe Text
whCheckRunOutputSummary          :: !(Maybe Text)
    , HookCheckRunOutput -> Maybe Text
whCheckRunOutputText             :: !(Maybe Text)
    , HookCheckRunOutput -> Int
whCheckRunOutputAnnotationsCount :: !Int
    , HookCheckRunOutput -> URL
whCheckRunOutputAnnotationsUrl   :: !URL
    }
    deriving (HookCheckRunOutput -> HookCheckRunOutput -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookCheckRunOutput -> HookCheckRunOutput -> Bool
$c/= :: HookCheckRunOutput -> HookCheckRunOutput -> Bool
== :: HookCheckRunOutput -> HookCheckRunOutput -> Bool
$c== :: HookCheckRunOutput -> HookCheckRunOutput -> Bool
Eq, Int -> HookCheckRunOutput -> ShowS
[HookCheckRunOutput] -> ShowS
HookCheckRunOutput -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookCheckRunOutput] -> ShowS
$cshowList :: [HookCheckRunOutput] -> ShowS
show :: HookCheckRunOutput -> [Char]
$cshow :: HookCheckRunOutput -> [Char]
showsPrec :: Int -> HookCheckRunOutput -> ShowS
$cshowsPrec :: Int -> HookCheckRunOutput -> ShowS
Show, Typeable, Typeable HookCheckRunOutput
HookCheckRunOutput -> DataType
HookCheckRunOutput -> Constr
(forall b. Data b => b -> b)
-> HookCheckRunOutput -> HookCheckRunOutput
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookCheckRunOutput -> u
forall u. (forall d. Data d => d -> u) -> HookCheckRunOutput -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckRunOutput -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckRunOutput -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCheckRunOutput -> m HookCheckRunOutput
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckRunOutput -> m HookCheckRunOutput
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckRunOutput
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookCheckRunOutput
-> c HookCheckRunOutput
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCheckRunOutput)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckRunOutput)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckRunOutput -> m HookCheckRunOutput
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckRunOutput -> m HookCheckRunOutput
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckRunOutput -> m HookCheckRunOutput
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckRunOutput -> m HookCheckRunOutput
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCheckRunOutput -> m HookCheckRunOutput
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCheckRunOutput -> m HookCheckRunOutput
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookCheckRunOutput -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookCheckRunOutput -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HookCheckRunOutput -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HookCheckRunOutput -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckRunOutput -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckRunOutput -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckRunOutput -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookCheckRunOutput -> r
gmapT :: (forall b. Data b => b -> b)
-> HookCheckRunOutput -> HookCheckRunOutput
$cgmapT :: (forall b. Data b => b -> b)
-> HookCheckRunOutput -> HookCheckRunOutput
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckRunOutput)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckRunOutput)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCheckRunOutput)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCheckRunOutput)
dataTypeOf :: HookCheckRunOutput -> DataType
$cdataTypeOf :: HookCheckRunOutput -> DataType
toConstr :: HookCheckRunOutput -> Constr
$ctoConstr :: HookCheckRunOutput -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckRunOutput
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckRunOutput
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookCheckRunOutput
-> c HookCheckRunOutput
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookCheckRunOutput
-> c HookCheckRunOutput
Data, forall x. Rep HookCheckRunOutput x -> HookCheckRunOutput
forall x. HookCheckRunOutput -> Rep HookCheckRunOutput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookCheckRunOutput x -> HookCheckRunOutput
$cfrom :: forall x. HookCheckRunOutput -> Rep HookCheckRunOutput x
Generic)

instance NFData HookCheckRunOutput where rnf :: HookCheckRunOutput -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "requested_action" field in the

--  'CheckRunEvent' payload.

newtype HookCheckRunRequestedAction = HookCheckRunRequestedAction
    { HookCheckRunRequestedAction -> Text
whCheckRunRequestedActionIdentifier       :: Text
    }
    deriving (HookCheckRunRequestedAction -> HookCheckRunRequestedAction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookCheckRunRequestedAction -> HookCheckRunRequestedAction -> Bool
$c/= :: HookCheckRunRequestedAction -> HookCheckRunRequestedAction -> Bool
== :: HookCheckRunRequestedAction -> HookCheckRunRequestedAction -> Bool
$c== :: HookCheckRunRequestedAction -> HookCheckRunRequestedAction -> Bool
Eq, Int -> HookCheckRunRequestedAction -> ShowS
[HookCheckRunRequestedAction] -> ShowS
HookCheckRunRequestedAction -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookCheckRunRequestedAction] -> ShowS
$cshowList :: [HookCheckRunRequestedAction] -> ShowS
show :: HookCheckRunRequestedAction -> [Char]
$cshow :: HookCheckRunRequestedAction -> [Char]
showsPrec :: Int -> HookCheckRunRequestedAction -> ShowS
$cshowsPrec :: Int -> HookCheckRunRequestedAction -> ShowS
Show, Typeable, Typeable HookCheckRunRequestedAction
HookCheckRunRequestedAction -> DataType
HookCheckRunRequestedAction -> Constr
(forall b. Data b => b -> b)
-> HookCheckRunRequestedAction -> HookCheckRunRequestedAction
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> HookCheckRunRequestedAction -> u
forall u.
(forall d. Data d => d -> u) -> HookCheckRunRequestedAction -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookCheckRunRequestedAction
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookCheckRunRequestedAction
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCheckRunRequestedAction -> m HookCheckRunRequestedAction
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckRunRequestedAction -> m HookCheckRunRequestedAction
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckRunRequestedAction
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookCheckRunRequestedAction
-> c HookCheckRunRequestedAction
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c HookCheckRunRequestedAction)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckRunRequestedAction)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckRunRequestedAction -> m HookCheckRunRequestedAction
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckRunRequestedAction -> m HookCheckRunRequestedAction
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckRunRequestedAction -> m HookCheckRunRequestedAction
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCheckRunRequestedAction -> m HookCheckRunRequestedAction
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCheckRunRequestedAction -> m HookCheckRunRequestedAction
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCheckRunRequestedAction -> m HookCheckRunRequestedAction
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> HookCheckRunRequestedAction -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> HookCheckRunRequestedAction -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> HookCheckRunRequestedAction -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> HookCheckRunRequestedAction -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookCheckRunRequestedAction
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookCheckRunRequestedAction
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookCheckRunRequestedAction
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookCheckRunRequestedAction
-> r
gmapT :: (forall b. Data b => b -> b)
-> HookCheckRunRequestedAction -> HookCheckRunRequestedAction
$cgmapT :: (forall b. Data b => b -> b)
-> HookCheckRunRequestedAction -> HookCheckRunRequestedAction
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckRunRequestedAction)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCheckRunRequestedAction)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c HookCheckRunRequestedAction)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c HookCheckRunRequestedAction)
dataTypeOf :: HookCheckRunRequestedAction -> DataType
$cdataTypeOf :: HookCheckRunRequestedAction -> DataType
toConstr :: HookCheckRunRequestedAction -> Constr
$ctoConstr :: HookCheckRunRequestedAction -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckRunRequestedAction
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCheckRunRequestedAction
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookCheckRunRequestedAction
-> c HookCheckRunRequestedAction
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookCheckRunRequestedAction
-> c HookCheckRunRequestedAction
Data, forall x.
Rep HookCheckRunRequestedAction x -> HookCheckRunRequestedAction
forall x.
HookCheckRunRequestedAction -> Rep HookCheckRunRequestedAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep HookCheckRunRequestedAction x -> HookCheckRunRequestedAction
$cfrom :: forall x.
HookCheckRunRequestedAction -> Rep HookCheckRunRequestedAction x
Generic)

instance NFData HookCheckRunRequestedAction where rnf :: HookCheckRunRequestedAction -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "installation" field in the checks payloads.

data HookChecksInstallation = HookChecksInstallation
    { HookChecksInstallation -> Int
whChecksInstallationId     :: Int
    , HookChecksInstallation -> Text
whChecksInstallationNodeId :: Text
    }
    deriving (HookChecksInstallation -> HookChecksInstallation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookChecksInstallation -> HookChecksInstallation -> Bool
$c/= :: HookChecksInstallation -> HookChecksInstallation -> Bool
== :: HookChecksInstallation -> HookChecksInstallation -> Bool
$c== :: HookChecksInstallation -> HookChecksInstallation -> Bool
Eq, Int -> HookChecksInstallation -> ShowS
[HookChecksInstallation] -> ShowS
HookChecksInstallation -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookChecksInstallation] -> ShowS
$cshowList :: [HookChecksInstallation] -> ShowS
show :: HookChecksInstallation -> [Char]
$cshow :: HookChecksInstallation -> [Char]
showsPrec :: Int -> HookChecksInstallation -> ShowS
$cshowsPrec :: Int -> HookChecksInstallation -> ShowS
Show, Typeable, Typeable HookChecksInstallation
HookChecksInstallation -> DataType
HookChecksInstallation -> Constr
(forall b. Data b => b -> b)
-> HookChecksInstallation -> HookChecksInstallation
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookChecksInstallation -> u
forall u.
(forall d. Data d => d -> u) -> HookChecksInstallation -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookChecksInstallation
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookChecksInstallation
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookChecksInstallation -> m HookChecksInstallation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookChecksInstallation -> m HookChecksInstallation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookChecksInstallation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookChecksInstallation
-> c HookChecksInstallation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookChecksInstallation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookChecksInstallation)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookChecksInstallation -> m HookChecksInstallation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookChecksInstallation -> m HookChecksInstallation
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookChecksInstallation -> m HookChecksInstallation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookChecksInstallation -> m HookChecksInstallation
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookChecksInstallation -> m HookChecksInstallation
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookChecksInstallation -> m HookChecksInstallation
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookChecksInstallation -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookChecksInstallation -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> HookChecksInstallation -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> HookChecksInstallation -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookChecksInstallation
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookChecksInstallation
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookChecksInstallation
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookChecksInstallation
-> r
gmapT :: (forall b. Data b => b -> b)
-> HookChecksInstallation -> HookChecksInstallation
$cgmapT :: (forall b. Data b => b -> b)
-> HookChecksInstallation -> HookChecksInstallation
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookChecksInstallation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookChecksInstallation)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookChecksInstallation)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookChecksInstallation)
dataTypeOf :: HookChecksInstallation -> DataType
$cdataTypeOf :: HookChecksInstallation -> DataType
toConstr :: HookChecksInstallation -> Constr
$ctoConstr :: HookChecksInstallation -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookChecksInstallation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookChecksInstallation
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookChecksInstallation
-> c HookChecksInstallation
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookChecksInstallation
-> c HookChecksInstallation
Data, forall x. Rep HookChecksInstallation x -> HookChecksInstallation
forall x. HookChecksInstallation -> Rep HookChecksInstallation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookChecksInstallation x -> HookChecksInstallation
$cfrom :: forall x. HookChecksInstallation -> Rep HookChecksInstallation x
Generic)

instance NFData HookChecksInstallation where rnf :: HookChecksInstallation -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "pull_requests" field in the checks payloads.

data HookChecksPullRequest = HookChecksPullRequest
    { HookChecksPullRequest -> URL
whChecksPullRequestUrl              :: !URL
    , HookChecksPullRequest -> Int
whChecksPullRequestId               :: !Int
    , HookChecksPullRequest -> Int
whChecksPullRequestNumber           :: !Int
    , HookChecksPullRequest -> HookChecksPullRequestTarget
whChecksPullRequestHead             :: !HookChecksPullRequestTarget
    , HookChecksPullRequest -> HookChecksPullRequestTarget
whChecksPullRequestBase             :: !HookChecksPullRequestTarget
    }
    deriving (HookChecksPullRequest -> HookChecksPullRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookChecksPullRequest -> HookChecksPullRequest -> Bool
$c/= :: HookChecksPullRequest -> HookChecksPullRequest -> Bool
== :: HookChecksPullRequest -> HookChecksPullRequest -> Bool
$c== :: HookChecksPullRequest -> HookChecksPullRequest -> Bool
Eq, Int -> HookChecksPullRequest -> ShowS
[HookChecksPullRequest] -> ShowS
HookChecksPullRequest -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookChecksPullRequest] -> ShowS
$cshowList :: [HookChecksPullRequest] -> ShowS
show :: HookChecksPullRequest -> [Char]
$cshow :: HookChecksPullRequest -> [Char]
showsPrec :: Int -> HookChecksPullRequest -> ShowS
$cshowsPrec :: Int -> HookChecksPullRequest -> ShowS
Show, Typeable, Typeable HookChecksPullRequest
HookChecksPullRequest -> DataType
HookChecksPullRequest -> Constr
(forall b. Data b => b -> b)
-> HookChecksPullRequest -> HookChecksPullRequest
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookChecksPullRequest -> u
forall u.
(forall d. Data d => d -> u) -> HookChecksPullRequest -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookChecksPullRequest -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookChecksPullRequest -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookChecksPullRequest -> m HookChecksPullRequest
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookChecksPullRequest -> m HookChecksPullRequest
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookChecksPullRequest
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookChecksPullRequest
-> c HookChecksPullRequest
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookChecksPullRequest)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookChecksPullRequest)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookChecksPullRequest -> m HookChecksPullRequest
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookChecksPullRequest -> m HookChecksPullRequest
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookChecksPullRequest -> m HookChecksPullRequest
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookChecksPullRequest -> m HookChecksPullRequest
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookChecksPullRequest -> m HookChecksPullRequest
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookChecksPullRequest -> m HookChecksPullRequest
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookChecksPullRequest -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookChecksPullRequest -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> HookChecksPullRequest -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> HookChecksPullRequest -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookChecksPullRequest -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookChecksPullRequest -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookChecksPullRequest -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookChecksPullRequest -> r
gmapT :: (forall b. Data b => b -> b)
-> HookChecksPullRequest -> HookChecksPullRequest
$cgmapT :: (forall b. Data b => b -> b)
-> HookChecksPullRequest -> HookChecksPullRequest
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookChecksPullRequest)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookChecksPullRequest)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookChecksPullRequest)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookChecksPullRequest)
dataTypeOf :: HookChecksPullRequest -> DataType
$cdataTypeOf :: HookChecksPullRequest -> DataType
toConstr :: HookChecksPullRequest -> Constr
$ctoConstr :: HookChecksPullRequest -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookChecksPullRequest
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookChecksPullRequest
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookChecksPullRequest
-> c HookChecksPullRequest
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookChecksPullRequest
-> c HookChecksPullRequest
Data, forall x. Rep HookChecksPullRequest x -> HookChecksPullRequest
forall x. HookChecksPullRequest -> Rep HookChecksPullRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookChecksPullRequest x -> HookChecksPullRequest
$cfrom :: forall x. HookChecksPullRequest -> Rep HookChecksPullRequest x
Generic)

instance NFData HookChecksPullRequest where rnf :: HookChecksPullRequest -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "repo" field in the checks pull_request payloads.

data HookChecksPullRequestRepository = HookChecksPullRequestRepository
    { HookChecksPullRequestRepository -> Int
whChecksPullRequestRepositoryId                  :: !Int
    , HookChecksPullRequestRepository -> URL
whChecksPullRequestRepositoryUrl                 :: !URL
    , HookChecksPullRequestRepository -> Text
whChecksPullRequestRepositoryName                :: !Text
    }
    deriving (HookChecksPullRequestRepository
-> HookChecksPullRequestRepository -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookChecksPullRequestRepository
-> HookChecksPullRequestRepository -> Bool
$c/= :: HookChecksPullRequestRepository
-> HookChecksPullRequestRepository -> Bool
== :: HookChecksPullRequestRepository
-> HookChecksPullRequestRepository -> Bool
$c== :: HookChecksPullRequestRepository
-> HookChecksPullRequestRepository -> Bool
Eq, Int -> HookChecksPullRequestRepository -> ShowS
[HookChecksPullRequestRepository] -> ShowS
HookChecksPullRequestRepository -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookChecksPullRequestRepository] -> ShowS
$cshowList :: [HookChecksPullRequestRepository] -> ShowS
show :: HookChecksPullRequestRepository -> [Char]
$cshow :: HookChecksPullRequestRepository -> [Char]
showsPrec :: Int -> HookChecksPullRequestRepository -> ShowS
$cshowsPrec :: Int -> HookChecksPullRequestRepository -> ShowS
Show, Typeable, Typeable HookChecksPullRequestRepository
HookChecksPullRequestRepository -> DataType
HookChecksPullRequestRepository -> Constr
(forall b. Data b => b -> b)
-> HookChecksPullRequestRepository
-> HookChecksPullRequestRepository
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> HookChecksPullRequestRepository
-> u
forall u.
(forall d. Data d => d -> u)
-> HookChecksPullRequestRepository -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookChecksPullRequestRepository
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookChecksPullRequestRepository
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookChecksPullRequestRepository
-> m HookChecksPullRequestRepository
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookChecksPullRequestRepository
-> m HookChecksPullRequestRepository
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c HookChecksPullRequestRepository
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookChecksPullRequestRepository
-> c HookChecksPullRequestRepository
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c HookChecksPullRequestRepository)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookChecksPullRequestRepository)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookChecksPullRequestRepository
-> m HookChecksPullRequestRepository
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookChecksPullRequestRepository
-> m HookChecksPullRequestRepository
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookChecksPullRequestRepository
-> m HookChecksPullRequestRepository
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookChecksPullRequestRepository
-> m HookChecksPullRequestRepository
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookChecksPullRequestRepository
-> m HookChecksPullRequestRepository
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookChecksPullRequestRepository
-> m HookChecksPullRequestRepository
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> HookChecksPullRequestRepository
-> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> HookChecksPullRequestRepository
-> u
gmapQ :: forall u.
(forall d. Data d => d -> u)
-> HookChecksPullRequestRepository -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u)
-> HookChecksPullRequestRepository -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookChecksPullRequestRepository
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookChecksPullRequestRepository
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookChecksPullRequestRepository
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookChecksPullRequestRepository
-> r
gmapT :: (forall b. Data b => b -> b)
-> HookChecksPullRequestRepository
-> HookChecksPullRequestRepository
$cgmapT :: (forall b. Data b => b -> b)
-> HookChecksPullRequestRepository
-> HookChecksPullRequestRepository
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookChecksPullRequestRepository)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookChecksPullRequestRepository)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c HookChecksPullRequestRepository)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c HookChecksPullRequestRepository)
dataTypeOf :: HookChecksPullRequestRepository -> DataType
$cdataTypeOf :: HookChecksPullRequestRepository -> DataType
toConstr :: HookChecksPullRequestRepository -> Constr
$ctoConstr :: HookChecksPullRequestRepository -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c HookChecksPullRequestRepository
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r)
-> Constr
-> c HookChecksPullRequestRepository
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookChecksPullRequestRepository
-> c HookChecksPullRequestRepository
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookChecksPullRequestRepository
-> c HookChecksPullRequestRepository
Data, forall x.
Rep HookChecksPullRequestRepository x
-> HookChecksPullRequestRepository
forall x.
HookChecksPullRequestRepository
-> Rep HookChecksPullRequestRepository x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep HookChecksPullRequestRepository x
-> HookChecksPullRequestRepository
$cfrom :: forall x.
HookChecksPullRequestRepository
-> Rep HookChecksPullRequestRepository x
Generic)

instance NFData HookChecksPullRequestRepository where rnf :: HookChecksPullRequestRepository -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the repo targets in

--  the checks pull requests repository payloads.

data  HookChecksPullRequestTarget = HookChecksPullRequestTarget
    { HookChecksPullRequestTarget -> Text
whChecksPullRequestTargetSha  :: !Text
    , HookChecksPullRequestTarget -> Text
whChecksPullRequestTargetRef  :: !Text -- ex "somebranch"

    , HookChecksPullRequestTarget -> HookChecksPullRequestRepository
whChecksPullRequestTargetRepo :: !HookChecksPullRequestRepository
    }
    deriving (HookChecksPullRequestTarget -> HookChecksPullRequestTarget -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookChecksPullRequestTarget -> HookChecksPullRequestTarget -> Bool
$c/= :: HookChecksPullRequestTarget -> HookChecksPullRequestTarget -> Bool
== :: HookChecksPullRequestTarget -> HookChecksPullRequestTarget -> Bool
$c== :: HookChecksPullRequestTarget -> HookChecksPullRequestTarget -> Bool
Eq, Int -> HookChecksPullRequestTarget -> ShowS
[HookChecksPullRequestTarget] -> ShowS
HookChecksPullRequestTarget -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookChecksPullRequestTarget] -> ShowS
$cshowList :: [HookChecksPullRequestTarget] -> ShowS
show :: HookChecksPullRequestTarget -> [Char]
$cshow :: HookChecksPullRequestTarget -> [Char]
showsPrec :: Int -> HookChecksPullRequestTarget -> ShowS
$cshowsPrec :: Int -> HookChecksPullRequestTarget -> ShowS
Show, Typeable, Typeable HookChecksPullRequestTarget
HookChecksPullRequestTarget -> DataType
HookChecksPullRequestTarget -> Constr
(forall b. Data b => b -> b)
-> HookChecksPullRequestTarget -> HookChecksPullRequestTarget
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u) -> HookChecksPullRequestTarget -> u
forall u.
(forall d. Data d => d -> u) -> HookChecksPullRequestTarget -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookChecksPullRequestTarget
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookChecksPullRequestTarget
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookChecksPullRequestTarget -> m HookChecksPullRequestTarget
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookChecksPullRequestTarget -> m HookChecksPullRequestTarget
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookChecksPullRequestTarget
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookChecksPullRequestTarget
-> c HookChecksPullRequestTarget
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c HookChecksPullRequestTarget)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookChecksPullRequestTarget)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookChecksPullRequestTarget -> m HookChecksPullRequestTarget
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookChecksPullRequestTarget -> m HookChecksPullRequestTarget
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookChecksPullRequestTarget -> m HookChecksPullRequestTarget
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookChecksPullRequestTarget -> m HookChecksPullRequestTarget
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookChecksPullRequestTarget -> m HookChecksPullRequestTarget
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookChecksPullRequestTarget -> m HookChecksPullRequestTarget
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> HookChecksPullRequestTarget -> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u) -> HookChecksPullRequestTarget -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> HookChecksPullRequestTarget -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> HookChecksPullRequestTarget -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookChecksPullRequestTarget
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookChecksPullRequestTarget
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookChecksPullRequestTarget
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookChecksPullRequestTarget
-> r
gmapT :: (forall b. Data b => b -> b)
-> HookChecksPullRequestTarget -> HookChecksPullRequestTarget
$cgmapT :: (forall b. Data b => b -> b)
-> HookChecksPullRequestTarget -> HookChecksPullRequestTarget
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookChecksPullRequestTarget)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookChecksPullRequestTarget)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c HookChecksPullRequestTarget)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c HookChecksPullRequestTarget)
dataTypeOf :: HookChecksPullRequestTarget -> DataType
$cdataTypeOf :: HookChecksPullRequestTarget -> DataType
toConstr :: HookChecksPullRequestTarget -> Constr
$ctoConstr :: HookChecksPullRequestTarget -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookChecksPullRequestTarget
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookChecksPullRequestTarget
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookChecksPullRequestTarget
-> c HookChecksPullRequestTarget
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookChecksPullRequestTarget
-> c HookChecksPullRequestTarget
Data, forall x.
Rep HookChecksPullRequestTarget x -> HookChecksPullRequestTarget
forall x.
HookChecksPullRequestTarget -> Rep HookChecksPullRequestTarget x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep HookChecksPullRequestTarget x -> HookChecksPullRequestTarget
$cfrom :: forall x.
HookChecksPullRequestTarget -> Rep HookChecksPullRequestTarget x
Generic)

instance NFData HookChecksPullRequestTarget where rnf :: HookChecksPullRequestTarget -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

--- FIXME: Missing nested metadata that provides commit description

--- FIXME: Missing property "parent" (no examples provided)

data HookCommit = HookCommit
    { HookCommit -> Text
whCommitSha               :: !Text          -- ^ Sometimes called the commit 'id'.

    , HookCommit -> URL
whCommitUrl               :: !URL
    , HookCommit -> Maybe URL
whCommitHtmlUrl           :: !(Maybe URL)   -- ^ Not always sent.

    , HookCommit -> Maybe URL
whCommitCommentsUrl       :: !(Maybe URL)   -- ^ Not always sent.

    , HookCommit -> Either HookSimpleUser HookUser
whCommitAuthor            :: !(Either HookSimpleUser HookUser)
    , HookCommit -> Either HookSimpleUser HookUser
whCommitCommitter         :: !(Either HookSimpleUser HookUser)
    }
    deriving (HookCommit -> HookCommit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookCommit -> HookCommit -> Bool
$c/= :: HookCommit -> HookCommit -> Bool
== :: HookCommit -> HookCommit -> Bool
$c== :: HookCommit -> HookCommit -> Bool
Eq, Int -> HookCommit -> ShowS
[HookCommit] -> ShowS
HookCommit -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookCommit] -> ShowS
$cshowList :: [HookCommit] -> ShowS
show :: HookCommit -> [Char]
$cshow :: HookCommit -> [Char]
showsPrec :: Int -> HookCommit -> ShowS
$cshowsPrec :: Int -> HookCommit -> ShowS
Show, Typeable, Typeable HookCommit
HookCommit -> DataType
HookCommit -> Constr
(forall b. Data b => b -> b) -> HookCommit -> HookCommit
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> HookCommit -> u
forall u. (forall d. Data d => d -> u) -> HookCommit -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookCommit -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookCommit -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookCommit -> m HookCommit
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookCommit -> m HookCommit
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCommit
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookCommit -> c HookCommit
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCommit)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HookCommit)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookCommit -> m HookCommit
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookCommit -> m HookCommit
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookCommit -> m HookCommit
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookCommit -> m HookCommit
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookCommit -> m HookCommit
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookCommit -> m HookCommit
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HookCommit -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HookCommit -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HookCommit -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HookCommit -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookCommit -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookCommit -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookCommit -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookCommit -> r
gmapT :: (forall b. Data b => b -> b) -> HookCommit -> HookCommit
$cgmapT :: (forall b. Data b => b -> b) -> HookCommit -> HookCommit
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HookCommit)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c HookCommit)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCommit)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCommit)
dataTypeOf :: HookCommit -> DataType
$cdataTypeOf :: HookCommit -> DataType
toConstr :: HookCommit -> Constr
$ctoConstr :: HookCommit -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCommit
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCommit
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookCommit -> c HookCommit
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookCommit -> c HookCommit
Data, forall x. Rep HookCommit x -> HookCommit
forall x. HookCommit -> Rep HookCommit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookCommit x -> HookCommit
$cfrom :: forall x. HookCommit -> Rep HookCommit x
Generic)

instance NFData HookCommit where rnf :: HookCommit -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- FIXME: Missing property "assets" (no examples provided)

data HookRelease = HookRelease
    { HookRelease -> URL
whReleaseUrl              :: !URL
    , HookRelease -> URL
whReleaseAssetsUrl        :: !URL
    , HookRelease -> URL
whReleaseUploadUrl        :: !URL
    , HookRelease -> URL
whReleaseHtmlUrl          :: !URL
    , HookRelease -> Int
whReleaseId               :: !Int
    , HookRelease -> Text
whReleaseNodeId           :: !Text
    , HookRelease -> Text
whReleaseTagName          :: !Text
    , HookRelease -> Text
whReleaseTargetCommitish  :: !Text
    , HookRelease -> Maybe Text
whReleaseName             :: !(Maybe Text)
    , HookRelease -> Bool
whReleaseIsDraft          :: !Bool
    , HookRelease -> HookUser
whReleaseAuthor           :: !HookUser
    , HookRelease -> Bool
whReleaseIsPreRelease     :: !Bool
    , HookRelease -> UTCTime
whReleaseCreatedAt        :: !UTCTime
    , HookRelease -> Maybe UTCTime
whReleasePublishedAt      :: !(Maybe UTCTime)
    , HookRelease -> URL
whReleaseTarballUrl       :: !URL
    , HookRelease -> URL
whReleaseZipballUrl       :: !URL
    , HookRelease -> Maybe Text
whReleaseBody             :: !(Maybe Text)
    }
    deriving (HookRelease -> HookRelease -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookRelease -> HookRelease -> Bool
$c/= :: HookRelease -> HookRelease -> Bool
== :: HookRelease -> HookRelease -> Bool
$c== :: HookRelease -> HookRelease -> Bool
Eq, Int -> HookRelease -> ShowS
[HookRelease] -> ShowS
HookRelease -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookRelease] -> ShowS
$cshowList :: [HookRelease] -> ShowS
show :: HookRelease -> [Char]
$cshow :: HookRelease -> [Char]
showsPrec :: Int -> HookRelease -> ShowS
$cshowsPrec :: Int -> HookRelease -> ShowS
Show, Typeable, Typeable HookRelease
HookRelease -> DataType
HookRelease -> Constr
(forall b. Data b => b -> b) -> HookRelease -> HookRelease
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> HookRelease -> u
forall u. (forall d. Data d => d -> u) -> HookRelease -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookRelease -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookRelease -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookRelease -> m HookRelease
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookRelease -> m HookRelease
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookRelease
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookRelease -> c HookRelease
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookRelease)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookRelease)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookRelease -> m HookRelease
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookRelease -> m HookRelease
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookRelease -> m HookRelease
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookRelease -> m HookRelease
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookRelease -> m HookRelease
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookRelease -> m HookRelease
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HookRelease -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HookRelease -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HookRelease -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HookRelease -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookRelease -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookRelease -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookRelease -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookRelease -> r
gmapT :: (forall b. Data b => b -> b) -> HookRelease -> HookRelease
$cgmapT :: (forall b. Data b => b -> b) -> HookRelease -> HookRelease
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookRelease)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookRelease)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookRelease)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookRelease)
dataTypeOf :: HookRelease -> DataType
$cdataTypeOf :: HookRelease -> DataType
toConstr :: HookRelease -> Constr
$ctoConstr :: HookRelease -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookRelease
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookRelease
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookRelease -> c HookRelease
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookRelease -> c HookRelease
Data, forall x. Rep HookRelease x -> HookRelease
forall x. HookRelease -> Rep HookRelease x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookRelease x -> HookRelease
$cfrom :: forall x. HookRelease -> Rep HookRelease x
Generic)

instance NFData HookRelease where rnf :: HookRelease -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

data HookPullRequest = HookPullRequest
    { HookPullRequest -> URL
whPullReqUrl              :: !URL
    , HookPullRequest -> Int
whPullReqId               :: !Int
    , HookPullRequest -> Text
whPullReqNodeId           :: !Text
    , HookPullRequest -> URL
whPullReqHtmlUrl          :: !URL
    , HookPullRequest -> URL
whPullReqDiffUrl          :: !URL
    , HookPullRequest -> URL
whPullReqPatchUrl         :: !URL
    , HookPullRequest -> URL
whPullReqIssueUrl         :: !URL
    , HookPullRequest -> Int
whPullReqNumber           :: !Int
    , HookPullRequest -> Text
whPullReqState            :: !Text -- FIXME: Smart constructor?

    , HookPullRequest -> Bool
whPullReqIsLocked         :: !Bool
    , HookPullRequest -> Text
whPullReqTitle            :: !Text
    , HookPullRequest -> HookUser
whPullReqUser             :: !HookUser
    , HookPullRequest -> Text
whPullReqBody             :: !Text
    , HookPullRequest -> UTCTime
whPullReqCreatedAt        :: !UTCTime
    , HookPullRequest -> UTCTime
whPullReqUpdatedAt        :: !UTCTime
    , HookPullRequest -> Maybe UTCTime
whPullReqClosedAt         :: !(Maybe UTCTime)
    , HookPullRequest -> Maybe UTCTime
whPullReqMergedAt         :: !(Maybe UTCTime)
    , HookPullRequest -> Maybe Text
whPullReqMergeCommitSha   :: !(Maybe Text)
    , HookPullRequest -> Maybe HookUser
whPullReqAssignee         :: !(Maybe HookUser)
    , HookPullRequest -> Maybe HookMilestone
whPullReqMilestone        :: !(Maybe HookMilestone)
    , HookPullRequest -> URL
whPullReqCommitsUrl       :: !URL
    , HookPullRequest -> URL
whPullReqRevCommentsUrl   :: !URL
    , HookPullRequest -> URL
whPullReqRevCommentUrl    :: !URL
    , HookPullRequest -> URL
whPullReqCommentsUrl      :: !URL
    , HookPullRequest -> URL
whPullReqStatusesUrl      :: !URL
    , HookPullRequest -> PullRequestTarget
whPullReqBase             :: !PullRequestTarget
    , HookPullRequest -> PullRequestTarget
whPullReqHead             :: !PullRequestTarget
    -- , whPullReqIsMerged         :: !Bool

    -- , whPullReqIsMergeable      :: !Bool

    , HookPullRequest -> Maybe Text
whPullReqMergeableState   :: !(Maybe Text)              -- ^ Not sent with all events.

    -- , whPullReqMergedBy         :: !(Maybe HookUser)

    , HookPullRequest -> Maybe Int
whPullReqCommentCount     :: !(Maybe Int)               -- ^ Not sent with all events.

    , HookPullRequest -> Maybe Int
whPullReqRevCommentCount  :: !(Maybe Int)               -- ^ Not sent with all events.

    , HookPullRequest -> Maybe Int
whPullReqCommitCount      :: !(Maybe Int)               -- ^ Not sent with all events.

    , HookPullRequest -> Maybe Int
whPullReqAdditionsCount   :: !(Maybe Int)               -- ^ Not sent with all events.

    , HookPullRequest -> Maybe Int
whPullReqDeletionsCount   :: !(Maybe Int)               -- ^ Not sent with all events.

    , HookPullRequest -> Maybe Int
whPullReqFileChangeCount  :: !(Maybe Int)               -- ^ Not sent with all events.

    }
    deriving (HookPullRequest -> HookPullRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookPullRequest -> HookPullRequest -> Bool
$c/= :: HookPullRequest -> HookPullRequest -> Bool
== :: HookPullRequest -> HookPullRequest -> Bool
$c== :: HookPullRequest -> HookPullRequest -> Bool
Eq, Int -> HookPullRequest -> ShowS
[HookPullRequest] -> ShowS
HookPullRequest -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookPullRequest] -> ShowS
$cshowList :: [HookPullRequest] -> ShowS
show :: HookPullRequest -> [Char]
$cshow :: HookPullRequest -> [Char]
showsPrec :: Int -> HookPullRequest -> ShowS
$cshowsPrec :: Int -> HookPullRequest -> ShowS
Show, Typeable, Typeable HookPullRequest
HookPullRequest -> DataType
HookPullRequest -> Constr
(forall b. Data b => b -> b) -> HookPullRequest -> HookPullRequest
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookPullRequest -> u
forall u. (forall d. Data d => d -> u) -> HookPullRequest -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookPullRequest -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookPullRequest -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookPullRequest -> m HookPullRequest
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookPullRequest -> m HookPullRequest
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookPullRequest
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookPullRequest -> c HookPullRequest
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookPullRequest)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookPullRequest)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookPullRequest -> m HookPullRequest
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookPullRequest -> m HookPullRequest
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookPullRequest -> m HookPullRequest
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookPullRequest -> m HookPullRequest
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookPullRequest -> m HookPullRequest
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookPullRequest -> m HookPullRequest
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookPullRequest -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookPullRequest -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HookPullRequest -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HookPullRequest -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookPullRequest -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookPullRequest -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookPullRequest -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookPullRequest -> r
gmapT :: (forall b. Data b => b -> b) -> HookPullRequest -> HookPullRequest
$cgmapT :: (forall b. Data b => b -> b) -> HookPullRequest -> HookPullRequest
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookPullRequest)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookPullRequest)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookPullRequest)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookPullRequest)
dataTypeOf :: HookPullRequest -> DataType
$cdataTypeOf :: HookPullRequest -> DataType
toConstr :: HookPullRequest -> Constr
$ctoConstr :: HookPullRequest -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookPullRequest
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookPullRequest
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookPullRequest -> c HookPullRequest
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookPullRequest -> c HookPullRequest
Data, forall x. Rep HookPullRequest x -> HookPullRequest
forall x. HookPullRequest -> Rep HookPullRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookPullRequest x -> HookPullRequest
$cfrom :: forall x. HookPullRequest -> Rep HookPullRequest x
Generic)

instance NFData HookPullRequest where rnf :: HookPullRequest -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

data PullRequestTarget = PullRequestTarget
    { PullRequestTarget -> Text
whPullReqTargetSha :: !Text
    , PullRequestTarget -> HookUser
whPullReqTargetUser :: !HookUser
    , PullRequestTarget -> Maybe HookRepository
whPullReqTargetRepo :: !(Maybe HookRepository) -- maybe null, see #47

    , PullRequestTarget -> Text
whPullReqTargetLabel :: !Text -- ex "user:branch"

    , PullRequestTarget -> Text
whPullReqTargetRef :: !Text -- ex "somebranch"

    }
    deriving (PullRequestTarget -> PullRequestTarget -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PullRequestTarget -> PullRequestTarget -> Bool
$c/= :: PullRequestTarget -> PullRequestTarget -> Bool
== :: PullRequestTarget -> PullRequestTarget -> Bool
$c== :: PullRequestTarget -> PullRequestTarget -> Bool
Eq, Int -> PullRequestTarget -> ShowS
[PullRequestTarget] -> ShowS
PullRequestTarget -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PullRequestTarget] -> ShowS
$cshowList :: [PullRequestTarget] -> ShowS
show :: PullRequestTarget -> [Char]
$cshow :: PullRequestTarget -> [Char]
showsPrec :: Int -> PullRequestTarget -> ShowS
$cshowsPrec :: Int -> PullRequestTarget -> ShowS
Show, Typeable, Typeable PullRequestTarget
PullRequestTarget -> DataType
PullRequestTarget -> Constr
(forall b. Data b => b -> b)
-> PullRequestTarget -> PullRequestTarget
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> PullRequestTarget -> u
forall u. (forall d. Data d => d -> u) -> PullRequestTarget -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PullRequestTarget -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PullRequestTarget -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PullRequestTarget -> m PullRequestTarget
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PullRequestTarget -> m PullRequestTarget
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PullRequestTarget
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PullRequestTarget -> c PullRequestTarget
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PullRequestTarget)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PullRequestTarget)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PullRequestTarget -> m PullRequestTarget
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PullRequestTarget -> m PullRequestTarget
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PullRequestTarget -> m PullRequestTarget
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PullRequestTarget -> m PullRequestTarget
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PullRequestTarget -> m PullRequestTarget
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PullRequestTarget -> m PullRequestTarget
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PullRequestTarget -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PullRequestTarget -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> PullRequestTarget -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PullRequestTarget -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PullRequestTarget -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PullRequestTarget -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PullRequestTarget -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PullRequestTarget -> r
gmapT :: (forall b. Data b => b -> b)
-> PullRequestTarget -> PullRequestTarget
$cgmapT :: (forall b. Data b => b -> b)
-> PullRequestTarget -> PullRequestTarget
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PullRequestTarget)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PullRequestTarget)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PullRequestTarget)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PullRequestTarget)
dataTypeOf :: PullRequestTarget -> DataType
$cdataTypeOf :: PullRequestTarget -> DataType
toConstr :: PullRequestTarget -> Constr
$ctoConstr :: PullRequestTarget -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PullRequestTarget
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PullRequestTarget
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PullRequestTarget -> c PullRequestTarget
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PullRequestTarget -> c PullRequestTarget
Data, forall x. Rep PullRequestTarget x -> PullRequestTarget
forall x. PullRequestTarget -> Rep PullRequestTarget x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PullRequestTarget x -> PullRequestTarget
$cfrom :: forall x. PullRequestTarget -> Rep PullRequestTarget x
Generic)

instance NFData PullRequestTarget where rnf :: PullRequestTarget -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "pull_request" field in the 'PullRequestReviewEvent' payload.

data HookPullRequestReview = HookPullRequestReview
    { HookPullRequestReview -> Int
whPullReqReviewId         :: !Int
    , HookPullRequestReview -> Text
whPullReqReviewNodeId     :: !Text
    , HookPullRequestReview -> HookUser
whPullReqReviewUser       :: !HookUser
    , HookPullRequestReview -> Text
whPullReqReviewBody       :: !Text
    , HookPullRequestReview -> UTCTime
whPullReqReviewSubmittedAt :: !UTCTime
    , HookPullRequestReview -> Text
whPullReqReviewState      :: !Text
    , HookPullRequestReview -> URL
whPullReqReviewHtmlUrl    :: !URL
    , HookPullRequestReview -> URL
whPullReqReviewPullUrl    :: !URL
    }
    deriving (HookPullRequestReview -> HookPullRequestReview -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookPullRequestReview -> HookPullRequestReview -> Bool
$c/= :: HookPullRequestReview -> HookPullRequestReview -> Bool
== :: HookPullRequestReview -> HookPullRequestReview -> Bool
$c== :: HookPullRequestReview -> HookPullRequestReview -> Bool
Eq, Int -> HookPullRequestReview -> ShowS
[HookPullRequestReview] -> ShowS
HookPullRequestReview -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookPullRequestReview] -> ShowS
$cshowList :: [HookPullRequestReview] -> ShowS
show :: HookPullRequestReview -> [Char]
$cshow :: HookPullRequestReview -> [Char]
showsPrec :: Int -> HookPullRequestReview -> ShowS
$cshowsPrec :: Int -> HookPullRequestReview -> ShowS
Show, Typeable, Typeable HookPullRequestReview
HookPullRequestReview -> DataType
HookPullRequestReview -> Constr
(forall b. Data b => b -> b)
-> HookPullRequestReview -> HookPullRequestReview
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookPullRequestReview -> u
forall u.
(forall d. Data d => d -> u) -> HookPullRequestReview -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookPullRequestReview -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookPullRequestReview -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookPullRequestReview -> m HookPullRequestReview
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookPullRequestReview -> m HookPullRequestReview
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookPullRequestReview
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookPullRequestReview
-> c HookPullRequestReview
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookPullRequestReview)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookPullRequestReview)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookPullRequestReview -> m HookPullRequestReview
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookPullRequestReview -> m HookPullRequestReview
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookPullRequestReview -> m HookPullRequestReview
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookPullRequestReview -> m HookPullRequestReview
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookPullRequestReview -> m HookPullRequestReview
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookPullRequestReview -> m HookPullRequestReview
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookPullRequestReview -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookPullRequestReview -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> HookPullRequestReview -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> HookPullRequestReview -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookPullRequestReview -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookPullRequestReview -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookPullRequestReview -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookPullRequestReview -> r
gmapT :: (forall b. Data b => b -> b)
-> HookPullRequestReview -> HookPullRequestReview
$cgmapT :: (forall b. Data b => b -> b)
-> HookPullRequestReview -> HookPullRequestReview
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookPullRequestReview)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookPullRequestReview)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookPullRequestReview)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookPullRequestReview)
dataTypeOf :: HookPullRequestReview -> DataType
$cdataTypeOf :: HookPullRequestReview -> DataType
toConstr :: HookPullRequestReview -> Constr
$ctoConstr :: HookPullRequestReview -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookPullRequestReview
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookPullRequestReview
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookPullRequestReview
-> c HookPullRequestReview
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookPullRequestReview
-> c HookPullRequestReview
Data, forall x. Rep HookPullRequestReview x -> HookPullRequestReview
forall x. HookPullRequestReview -> Rep HookPullRequestReview x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookPullRequestReview x -> HookPullRequestReview
$cfrom :: forall x. HookPullRequestReview -> Rep HookPullRequestReview x
Generic)

instance NFData HookPullRequestReview where rnf :: HookPullRequestReview -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "installation" field in the 'InstallationEvent' payload.

data HookInstallation = HookInstallation
    { HookInstallation -> Int
whInstallationId          :: !Int
    , HookInstallation -> HookUser
whInstallationAccount     :: !HookUser
    , HookInstallation -> Text
whInstallationRepoSel     :: !Text
    , HookInstallation -> URL
whInstallationTokenUrl    :: !URL
    , HookInstallation -> URL
whInstallationRepoUrl     :: !URL
    }
    deriving (HookInstallation -> HookInstallation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookInstallation -> HookInstallation -> Bool
$c/= :: HookInstallation -> HookInstallation -> Bool
== :: HookInstallation -> HookInstallation -> Bool
$c== :: HookInstallation -> HookInstallation -> Bool
Eq, Int -> HookInstallation -> ShowS
[HookInstallation] -> ShowS
HookInstallation -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookInstallation] -> ShowS
$cshowList :: [HookInstallation] -> ShowS
show :: HookInstallation -> [Char]
$cshow :: HookInstallation -> [Char]
showsPrec :: Int -> HookInstallation -> ShowS
$cshowsPrec :: Int -> HookInstallation -> ShowS
Show, Typeable, Typeable HookInstallation
HookInstallation -> DataType
HookInstallation -> Constr
(forall b. Data b => b -> b)
-> HookInstallation -> HookInstallation
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookInstallation -> u
forall u. (forall d. Data d => d -> u) -> HookInstallation -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookInstallation -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookInstallation -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookInstallation -> m HookInstallation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookInstallation -> m HookInstallation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookInstallation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookInstallation -> c HookInstallation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookInstallation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookInstallation)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookInstallation -> m HookInstallation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookInstallation -> m HookInstallation
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookInstallation -> m HookInstallation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookInstallation -> m HookInstallation
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookInstallation -> m HookInstallation
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookInstallation -> m HookInstallation
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookInstallation -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookInstallation -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HookInstallation -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HookInstallation -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookInstallation -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookInstallation -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookInstallation -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookInstallation -> r
gmapT :: (forall b. Data b => b -> b)
-> HookInstallation -> HookInstallation
$cgmapT :: (forall b. Data b => b -> b)
-> HookInstallation -> HookInstallation
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookInstallation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookInstallation)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookInstallation)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookInstallation)
dataTypeOf :: HookInstallation -> DataType
$cdataTypeOf :: HookInstallation -> DataType
toConstr :: HookInstallation -> Constr
$ctoConstr :: HookInstallation -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookInstallation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookInstallation
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookInstallation -> c HookInstallation
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookInstallation -> c HookInstallation
Data, forall x. Rep HookInstallation x -> HookInstallation
forall x. HookInstallation -> Rep HookInstallation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookInstallation x -> HookInstallation
$cfrom :: forall x. HookInstallation -> Rep HookInstallation x
Generic)

instance NFData HookInstallation where rnf :: HookInstallation -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "deployment" field in the

-- 'DeploymentEvent' and 'DeploymentStatusEvent' payload.

data HookDeployment = HookDeployment
    { HookDeployment -> URL
whDeploymentUrl           :: !URL
    , HookDeployment -> Int
whDeploymentId            :: !Int
    , HookDeployment -> Text
whDeploymentNodeId        :: !Text
    , HookDeployment -> Text
whDeploymentSha           :: !Text
    , HookDeployment -> Text
whDeploymentRef           :: !Text
    , HookDeployment -> Text
whDeploymentTask          :: !Text
    -- , whDeploymentPayload

    , HookDeployment -> Text
whDeploymentEnv           :: !Text
    , HookDeployment -> Maybe Text
whDeploymentDescription   :: !(Maybe Text)
    , HookDeployment -> HookUser
whDeploymentCreator       :: !HookUser
    , HookDeployment -> UTCTime
whDeploymentCreatedAt     :: !UTCTime
    , HookDeployment -> UTCTime
whDeploymentUpdatedAt     :: !UTCTime
    , HookDeployment -> URL
whDeploymentStatusesUrl   :: !URL
    , HookDeployment -> URL
whDeploymentRepoUrl       :: !URL
    }
    deriving (HookDeployment -> HookDeployment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookDeployment -> HookDeployment -> Bool
$c/= :: HookDeployment -> HookDeployment -> Bool
== :: HookDeployment -> HookDeployment -> Bool
$c== :: HookDeployment -> HookDeployment -> Bool
Eq, Int -> HookDeployment -> ShowS
[HookDeployment] -> ShowS
HookDeployment -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookDeployment] -> ShowS
$cshowList :: [HookDeployment] -> ShowS
show :: HookDeployment -> [Char]
$cshow :: HookDeployment -> [Char]
showsPrec :: Int -> HookDeployment -> ShowS
$cshowsPrec :: Int -> HookDeployment -> ShowS
Show, Typeable, Typeable HookDeployment
HookDeployment -> DataType
HookDeployment -> Constr
(forall b. Data b => b -> b) -> HookDeployment -> HookDeployment
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookDeployment -> u
forall u. (forall d. Data d => d -> u) -> HookDeployment -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookDeployment -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookDeployment -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookDeployment -> m HookDeployment
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookDeployment -> m HookDeployment
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookDeployment
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookDeployment -> c HookDeployment
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookDeployment)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookDeployment)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookDeployment -> m HookDeployment
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookDeployment -> m HookDeployment
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookDeployment -> m HookDeployment
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookDeployment -> m HookDeployment
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookDeployment -> m HookDeployment
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookDeployment -> m HookDeployment
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookDeployment -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookDeployment -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HookDeployment -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HookDeployment -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookDeployment -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookDeployment -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookDeployment -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookDeployment -> r
gmapT :: (forall b. Data b => b -> b) -> HookDeployment -> HookDeployment
$cgmapT :: (forall b. Data b => b -> b) -> HookDeployment -> HookDeployment
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookDeployment)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookDeployment)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookDeployment)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookDeployment)
dataTypeOf :: HookDeployment -> DataType
$cdataTypeOf :: HookDeployment -> DataType
toConstr :: HookDeployment -> Constr
$ctoConstr :: HookDeployment -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookDeployment
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookDeployment
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookDeployment -> c HookDeployment
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookDeployment -> c HookDeployment
Data, forall x. Rep HookDeployment x -> HookDeployment
forall x. HookDeployment -> Rep HookDeployment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookDeployment x -> HookDeployment
$cfrom :: forall x. HookDeployment -> Rep HookDeployment x
Generic)

instance NFData HookDeployment where rnf :: HookDeployment -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "deployment_status" field in the

-- 'DeploymentStatusEvent' payload.

data HookDeploymentStatus = HookDeploymentStatus
    { HookDeploymentStatus -> URL
whDeploymentStatusUrl     :: !URL
    , HookDeploymentStatus -> Int
whDeploymentStatusId      :: !Int
    , HookDeploymentStatus -> Text
whDeploymentStatusNodeId  :: !Text
    , HookDeploymentStatus -> Text
whDeploymentStatusState   :: !Text
    , HookDeploymentStatus -> HookUser
whDeploymentStatusCreator :: !HookUser
    , HookDeploymentStatus -> Maybe Text
whDeploymentStatusDesc    :: !(Maybe Text)
    , HookDeploymentStatus -> Maybe URL
whDeploymentStatusTargetUrl :: !(Maybe URL)
    , HookDeploymentStatus -> UTCTime
whDeploymentStatusCreatedAt :: !UTCTime
    , HookDeploymentStatus -> UTCTime
whDeploymentStatusUpdatedAt :: !UTCTime
    , HookDeploymentStatus -> URL
whDeploymentStatusDeplUrl   :: !URL
    , HookDeploymentStatus -> URL
whDeploymentStatusRepoUrl   :: !URL
    }
    deriving (HookDeploymentStatus -> HookDeploymentStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookDeploymentStatus -> HookDeploymentStatus -> Bool
$c/= :: HookDeploymentStatus -> HookDeploymentStatus -> Bool
== :: HookDeploymentStatus -> HookDeploymentStatus -> Bool
$c== :: HookDeploymentStatus -> HookDeploymentStatus -> Bool
Eq, Int -> HookDeploymentStatus -> ShowS
[HookDeploymentStatus] -> ShowS
HookDeploymentStatus -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookDeploymentStatus] -> ShowS
$cshowList :: [HookDeploymentStatus] -> ShowS
show :: HookDeploymentStatus -> [Char]
$cshow :: HookDeploymentStatus -> [Char]
showsPrec :: Int -> HookDeploymentStatus -> ShowS
$cshowsPrec :: Int -> HookDeploymentStatus -> ShowS
Show, Typeable, Typeable HookDeploymentStatus
HookDeploymentStatus -> DataType
HookDeploymentStatus -> Constr
(forall b. Data b => b -> b)
-> HookDeploymentStatus -> HookDeploymentStatus
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookDeploymentStatus -> u
forall u.
(forall d. Data d => d -> u) -> HookDeploymentStatus -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookDeploymentStatus -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookDeploymentStatus -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookDeploymentStatus -> m HookDeploymentStatus
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookDeploymentStatus -> m HookDeploymentStatus
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookDeploymentStatus
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookDeploymentStatus
-> c HookDeploymentStatus
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookDeploymentStatus)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookDeploymentStatus)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookDeploymentStatus -> m HookDeploymentStatus
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookDeploymentStatus -> m HookDeploymentStatus
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookDeploymentStatus -> m HookDeploymentStatus
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookDeploymentStatus -> m HookDeploymentStatus
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookDeploymentStatus -> m HookDeploymentStatus
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookDeploymentStatus -> m HookDeploymentStatus
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookDeploymentStatus -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookDeploymentStatus -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> HookDeploymentStatus -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> HookDeploymentStatus -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookDeploymentStatus -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookDeploymentStatus -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookDeploymentStatus -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookDeploymentStatus -> r
gmapT :: (forall b. Data b => b -> b)
-> HookDeploymentStatus -> HookDeploymentStatus
$cgmapT :: (forall b. Data b => b -> b)
-> HookDeploymentStatus -> HookDeploymentStatus
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookDeploymentStatus)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookDeploymentStatus)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookDeploymentStatus)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookDeploymentStatus)
dataTypeOf :: HookDeploymentStatus -> DataType
$cdataTypeOf :: HookDeploymentStatus -> DataType
toConstr :: HookDeploymentStatus -> Constr
$ctoConstr :: HookDeploymentStatus -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookDeploymentStatus
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookDeploymentStatus
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookDeploymentStatus
-> c HookDeploymentStatus
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookDeploymentStatus
-> c HookDeploymentStatus
Data, forall x. Rep HookDeploymentStatus x -> HookDeploymentStatus
forall x. HookDeploymentStatus -> Rep HookDeploymentStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookDeploymentStatus x -> HookDeploymentStatus
$cfrom :: forall x. HookDeploymentStatus -> Rep HookDeploymentStatus x
Generic)

instance NFData HookDeploymentStatus where rnf :: HookDeploymentStatus -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "pages" field in the 'GollumEvent' payload.

data HookWikiPage = HookWikiPage
    { HookWikiPage -> Text
whWikiPageName            :: !Text
    , HookWikiPage -> Text
whWikiPageTitle           :: !Text
    , HookWikiPage -> Maybe Text
whWikiPageSummary         :: !(Maybe Text)
    , HookWikiPage -> Text
wkWikiPageAction          :: !Text
    , HookWikiPage -> Text
whWikiPageSha             :: !Text
    , HookWikiPage -> URL
whWikiPageHtmlUrl         :: URL
    }
    deriving (HookWikiPage -> HookWikiPage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookWikiPage -> HookWikiPage -> Bool
$c/= :: HookWikiPage -> HookWikiPage -> Bool
== :: HookWikiPage -> HookWikiPage -> Bool
$c== :: HookWikiPage -> HookWikiPage -> Bool
Eq, Int -> HookWikiPage -> ShowS
[HookWikiPage] -> ShowS
HookWikiPage -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookWikiPage] -> ShowS
$cshowList :: [HookWikiPage] -> ShowS
show :: HookWikiPage -> [Char]
$cshow :: HookWikiPage -> [Char]
showsPrec :: Int -> HookWikiPage -> ShowS
$cshowsPrec :: Int -> HookWikiPage -> ShowS
Show, Typeable, Typeable HookWikiPage
HookWikiPage -> DataType
HookWikiPage -> Constr
(forall b. Data b => b -> b) -> HookWikiPage -> HookWikiPage
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> HookWikiPage -> u
forall u. (forall d. Data d => d -> u) -> HookWikiPage -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookWikiPage -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookWikiPage -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookWikiPage -> m HookWikiPage
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookWikiPage -> m HookWikiPage
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookWikiPage
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookWikiPage -> c HookWikiPage
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookWikiPage)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookWikiPage)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookWikiPage -> m HookWikiPage
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookWikiPage -> m HookWikiPage
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookWikiPage -> m HookWikiPage
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> HookWikiPage -> m HookWikiPage
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookWikiPage -> m HookWikiPage
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> HookWikiPage -> m HookWikiPage
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HookWikiPage -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> HookWikiPage -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HookWikiPage -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HookWikiPage -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookWikiPage -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookWikiPage -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookWikiPage -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookWikiPage -> r
gmapT :: (forall b. Data b => b -> b) -> HookWikiPage -> HookWikiPage
$cgmapT :: (forall b. Data b => b -> b) -> HookWikiPage -> HookWikiPage
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookWikiPage)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookWikiPage)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookWikiPage)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookWikiPage)
dataTypeOf :: HookWikiPage -> DataType
$cdataTypeOf :: HookWikiPage -> DataType
toConstr :: HookWikiPage -> Constr
$ctoConstr :: HookWikiPage -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookWikiPage
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookWikiPage
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookWikiPage -> c HookWikiPage
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookWikiPage -> c HookWikiPage
Data, forall x. Rep HookWikiPage x -> HookWikiPage
forall x. HookWikiPage -> Rep HookWikiPage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookWikiPage x -> HookWikiPage
$cfrom :: forall x. HookWikiPage -> Rep HookWikiPage x
Generic)

instance NFData HookWikiPage where rnf :: HookWikiPage -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "build" field in the 'PageBuildEvent' payload.

data HookPageBuildResult = HookPageBuildResult
    { HookPageBuildResult -> URL
whPageBuildUrl            :: !URL
    , HookPageBuildResult -> Text
whPageBuildStatus         :: !Text
    , HookPageBuildResult -> Maybe Text
whPageBuildError          :: !(Maybe Text)
    , HookPageBuildResult -> HookUser
whPageBuildPusher         :: !HookUser
    , HookPageBuildResult -> Text
whPageBuildCommitSha      :: !Text
    , HookPageBuildResult -> Int
whPageBuildDuration       :: !Int
    , HookPageBuildResult -> UTCTime
whPageBuildCreatedAt      :: !UTCTime
    , HookPageBuildResult -> UTCTime
whPageBuildUpdatedAt      :: !UTCTime
    }
    deriving (HookPageBuildResult -> HookPageBuildResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookPageBuildResult -> HookPageBuildResult -> Bool
$c/= :: HookPageBuildResult -> HookPageBuildResult -> Bool
== :: HookPageBuildResult -> HookPageBuildResult -> Bool
$c== :: HookPageBuildResult -> HookPageBuildResult -> Bool
Eq, Int -> HookPageBuildResult -> ShowS
[HookPageBuildResult] -> ShowS
HookPageBuildResult -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookPageBuildResult] -> ShowS
$cshowList :: [HookPageBuildResult] -> ShowS
show :: HookPageBuildResult -> [Char]
$cshow :: HookPageBuildResult -> [Char]
showsPrec :: Int -> HookPageBuildResult -> ShowS
$cshowsPrec :: Int -> HookPageBuildResult -> ShowS
Show, Typeable, Typeable HookPageBuildResult
HookPageBuildResult -> DataType
HookPageBuildResult -> Constr
(forall b. Data b => b -> b)
-> HookPageBuildResult -> HookPageBuildResult
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookPageBuildResult -> u
forall u.
(forall d. Data d => d -> u) -> HookPageBuildResult -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookPageBuildResult -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookPageBuildResult -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookPageBuildResult -> m HookPageBuildResult
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookPageBuildResult -> m HookPageBuildResult
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookPageBuildResult
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookPageBuildResult
-> c HookPageBuildResult
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookPageBuildResult)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookPageBuildResult)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookPageBuildResult -> m HookPageBuildResult
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookPageBuildResult -> m HookPageBuildResult
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookPageBuildResult -> m HookPageBuildResult
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookPageBuildResult -> m HookPageBuildResult
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookPageBuildResult -> m HookPageBuildResult
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookPageBuildResult -> m HookPageBuildResult
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookPageBuildResult -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookPageBuildResult -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> HookPageBuildResult -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> HookPageBuildResult -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookPageBuildResult -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookPageBuildResult -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookPageBuildResult -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookPageBuildResult -> r
gmapT :: (forall b. Data b => b -> b)
-> HookPageBuildResult -> HookPageBuildResult
$cgmapT :: (forall b. Data b => b -> b)
-> HookPageBuildResult -> HookPageBuildResult
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookPageBuildResult)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookPageBuildResult)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookPageBuildResult)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookPageBuildResult)
dataTypeOf :: HookPageBuildResult -> DataType
$cdataTypeOf :: HookPageBuildResult -> DataType
toConstr :: HookPageBuildResult -> Constr
$ctoConstr :: HookPageBuildResult -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookPageBuildResult
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookPageBuildResult
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookPageBuildResult
-> c HookPageBuildResult
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookPageBuildResult
-> c HookPageBuildResult
Data, forall x. Rep HookPageBuildResult x -> HookPageBuildResult
forall x. HookPageBuildResult -> Rep HookPageBuildResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookPageBuildResult x -> HookPageBuildResult
$cfrom :: forall x. HookPageBuildResult -> Rep HookPageBuildResult x
Generic)

instance NFData HookPageBuildResult where rnf :: HookPageBuildResult -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "issue" field in 'IssueComentEvent' payload.

data HookIssueComment = HookIssueComment
    { HookIssueComment -> URL
whIssueCommentUrl         :: !URL
    , HookIssueComment -> URL
whIssueCommentHtmlUrl     :: !URL
    , HookIssueComment -> URL
whIssueCommentIssueUrl    :: !URL
    , HookIssueComment -> Int
whIssueCommentId          :: !Int
    , HookIssueComment -> Text
whIssueCommentNodeId      :: !Text
    , HookIssueComment -> HookUser
whIssueCommentUser        :: !HookUser
    , HookIssueComment -> UTCTime
whIssueCommentCreatedAt   :: !UTCTime
    , HookIssueComment -> UTCTime
whIssueCommentUpdatedAt   :: !UTCTime
    , HookIssueComment -> Text
whIssueCommentBody        :: !Text
    }
    deriving (HookIssueComment -> HookIssueComment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookIssueComment -> HookIssueComment -> Bool
$c/= :: HookIssueComment -> HookIssueComment -> Bool
== :: HookIssueComment -> HookIssueComment -> Bool
$c== :: HookIssueComment -> HookIssueComment -> Bool
Eq, Int -> HookIssueComment -> ShowS
[HookIssueComment] -> ShowS
HookIssueComment -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookIssueComment] -> ShowS
$cshowList :: [HookIssueComment] -> ShowS
show :: HookIssueComment -> [Char]
$cshow :: HookIssueComment -> [Char]
showsPrec :: Int -> HookIssueComment -> ShowS
$cshowsPrec :: Int -> HookIssueComment -> ShowS
Show, Typeable, Typeable HookIssueComment
HookIssueComment -> DataType
HookIssueComment -> Constr
(forall b. Data b => b -> b)
-> HookIssueComment -> HookIssueComment
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookIssueComment -> u
forall u. (forall d. Data d => d -> u) -> HookIssueComment -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookIssueComment -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookIssueComment -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookIssueComment -> m HookIssueComment
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookIssueComment -> m HookIssueComment
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookIssueComment
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookIssueComment -> c HookIssueComment
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookIssueComment)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookIssueComment)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookIssueComment -> m HookIssueComment
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookIssueComment -> m HookIssueComment
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookIssueComment -> m HookIssueComment
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookIssueComment -> m HookIssueComment
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookIssueComment -> m HookIssueComment
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookIssueComment -> m HookIssueComment
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookIssueComment -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookIssueComment -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HookIssueComment -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HookIssueComment -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookIssueComment -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookIssueComment -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookIssueComment -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookIssueComment -> r
gmapT :: (forall b. Data b => b -> b)
-> HookIssueComment -> HookIssueComment
$cgmapT :: (forall b. Data b => b -> b)
-> HookIssueComment -> HookIssueComment
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookIssueComment)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookIssueComment)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookIssueComment)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookIssueComment)
dataTypeOf :: HookIssueComment -> DataType
$cdataTypeOf :: HookIssueComment -> DataType
toConstr :: HookIssueComment -> Constr
$ctoConstr :: HookIssueComment -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookIssueComment
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookIssueComment
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookIssueComment -> c HookIssueComment
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookIssueComment -> c HookIssueComment
Data, forall x. Rep HookIssueComment x -> HookIssueComment
forall x. HookIssueComment -> Rep HookIssueComment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookIssueComment x -> HookIssueComment
$cfrom :: forall x. HookIssueComment -> Rep HookIssueComment x
Generic)

instance NFData HookIssueComment where rnf :: HookIssueComment -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "comment" field in the 'CommitCommentEvent' payload.

data HookCommitComment = HookCommitComment
    { HookCommitComment -> URL
whCommitCommentUrl        :: !URL
    , HookCommitComment -> URL
whCommitCommentHtmlUrl    :: !URL
    , HookCommitComment -> Int
whCommitCommentId         :: !Int
    , HookCommitComment -> Text
whCommitCommentNodeId     :: !Text
    , HookCommitComment -> HookUser
whCommitCommentUser       :: !HookUser
    , HookCommitComment -> Maybe Int
whCommitCommentPos        :: !(Maybe Int)
    , HookCommitComment -> Maybe Int
whCommitCommentLine       :: !(Maybe Int)
    , HookCommitComment -> Maybe Text
whCommitCommentPath       :: !(Maybe Text)
    , HookCommitComment -> Text
whCommitCommentCommitSha  :: !Text
    , HookCommitComment -> UTCTime
whCommitCommentCreatedAt  :: !UTCTime
    , HookCommitComment -> UTCTime
whCommitCommentUpdatedAt  :: !UTCTime
    , HookCommitComment -> Text
whCommitCommentBody       :: !Text
    }
    deriving (HookCommitComment -> HookCommitComment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookCommitComment -> HookCommitComment -> Bool
$c/= :: HookCommitComment -> HookCommitComment -> Bool
== :: HookCommitComment -> HookCommitComment -> Bool
$c== :: HookCommitComment -> HookCommitComment -> Bool
Eq, Int -> HookCommitComment -> ShowS
[HookCommitComment] -> ShowS
HookCommitComment -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookCommitComment] -> ShowS
$cshowList :: [HookCommitComment] -> ShowS
show :: HookCommitComment -> [Char]
$cshow :: HookCommitComment -> [Char]
showsPrec :: Int -> HookCommitComment -> ShowS
$cshowsPrec :: Int -> HookCommitComment -> ShowS
Show, Typeable, Typeable HookCommitComment
HookCommitComment -> DataType
HookCommitComment -> Constr
(forall b. Data b => b -> b)
-> HookCommitComment -> HookCommitComment
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> HookCommitComment -> u
forall u. (forall d. Data d => d -> u) -> HookCommitComment -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookCommitComment -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookCommitComment -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCommitComment -> m HookCommitComment
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCommitComment -> m HookCommitComment
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCommitComment
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookCommitComment -> c HookCommitComment
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCommitComment)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCommitComment)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCommitComment -> m HookCommitComment
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCommitComment -> m HookCommitComment
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCommitComment -> m HookCommitComment
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookCommitComment -> m HookCommitComment
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCommitComment -> m HookCommitComment
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookCommitComment -> m HookCommitComment
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookCommitComment -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> HookCommitComment -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> HookCommitComment -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> HookCommitComment -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookCommitComment -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> HookCommitComment -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookCommitComment -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> HookCommitComment -> r
gmapT :: (forall b. Data b => b -> b)
-> HookCommitComment -> HookCommitComment
$cgmapT :: (forall b. Data b => b -> b)
-> HookCommitComment -> HookCommitComment
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCommitComment)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookCommitComment)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCommitComment)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c HookCommitComment)
dataTypeOf :: HookCommitComment -> DataType
$cdataTypeOf :: HookCommitComment -> DataType
toConstr :: HookCommitComment -> Constr
$ctoConstr :: HookCommitComment -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCommitComment
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookCommitComment
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookCommitComment -> c HookCommitComment
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> HookCommitComment -> c HookCommitComment
Data, forall x. Rep HookCommitComment x -> HookCommitComment
forall x. HookCommitComment -> Rep HookCommitComment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep HookCommitComment x -> HookCommitComment
$cfrom :: forall x. HookCommitComment -> Rep HookCommitComment x
Generic)

instance NFData HookCommitComment where rnf :: HookCommitComment -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

-- | Represents the "pull_request" field in the

-- 'PullRequestReviewCommentEvent' payload.

data HookPullRequestReviewComment = HookPullRequestReviewComment
    { HookPullRequestReviewComment -> URL
whPullReqRevComUrl        :: !URL
    , HookPullRequestReviewComment -> Int
whPullReqRevComId         :: !Int
    , HookPullRequestReviewComment -> Text
whPullReqRevComNodeId     :: !Text
    , HookPullRequestReviewComment -> Text
whPullReqRevComDiffHunk   :: !Text
    , HookPullRequestReviewComment -> Text
whPullReqRevComPath       :: !Text
    , HookPullRequestReviewComment -> Int
whPullReqRevComPos        :: !Int
    , HookPullRequestReviewComment -> Int
whPullReqRevComOrigPos    :: !Int
    , HookPullRequestReviewComment -> Text
whPullReqRevComCommitSha  :: !Text
    , HookPullRequestReviewComment -> Text
whPullReqRevComOrigSha    :: !Text
    , HookPullRequestReviewComment -> HookUser
whPullReqRevComUser       :: !HookUser
    , HookPullRequestReviewComment -> Text
whPullReqRevComBody       :: !Text
    , HookPullRequestReviewComment -> UTCTime
whPullReqRevComCreatedAt  :: !UTCTime
    , HookPullRequestReviewComment -> UTCTime
whPullReqRevComUpdatedAt  :: !UTCTime
    , HookPullRequestReviewComment -> URL
whPullReqRevComHtmlUrl    :: !URL
    , HookPullRequestReviewComment -> URL
whPullReqRevComPullReqUrl :: !URL
    }
    deriving (HookPullRequestReviewComment
-> HookPullRequestReviewComment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HookPullRequestReviewComment
-> HookPullRequestReviewComment -> Bool
$c/= :: HookPullRequestReviewComment
-> HookPullRequestReviewComment -> Bool
== :: HookPullRequestReviewComment
-> HookPullRequestReviewComment -> Bool
$c== :: HookPullRequestReviewComment
-> HookPullRequestReviewComment -> Bool
Eq, Int -> HookPullRequestReviewComment -> ShowS
[HookPullRequestReviewComment] -> ShowS
HookPullRequestReviewComment -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [HookPullRequestReviewComment] -> ShowS
$cshowList :: [HookPullRequestReviewComment] -> ShowS
show :: HookPullRequestReviewComment -> [Char]
$cshow :: HookPullRequestReviewComment -> [Char]
showsPrec :: Int -> HookPullRequestReviewComment -> ShowS
$cshowsPrec :: Int -> HookPullRequestReviewComment -> ShowS
Show, Typeable, Typeable HookPullRequestReviewComment
HookPullRequestReviewComment -> DataType
HookPullRequestReviewComment -> Constr
(forall b. Data b => b -> b)
-> HookPullRequestReviewComment -> HookPullRequestReviewComment
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int
-> (forall d. Data d => d -> u)
-> HookPullRequestReviewComment
-> u
forall u.
(forall d. Data d => d -> u) -> HookPullRequestReviewComment -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookPullRequestReviewComment
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookPullRequestReviewComment
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookPullRequestReviewComment -> m HookPullRequestReviewComment
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookPullRequestReviewComment -> m HookPullRequestReviewComment
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookPullRequestReviewComment
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookPullRequestReviewComment
-> c HookPullRequestReviewComment
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c HookPullRequestReviewComment)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookPullRequestReviewComment)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookPullRequestReviewComment -> m HookPullRequestReviewComment
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookPullRequestReviewComment -> m HookPullRequestReviewComment
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookPullRequestReviewComment -> m HookPullRequestReviewComment
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> HookPullRequestReviewComment -> m HookPullRequestReviewComment
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookPullRequestReviewComment -> m HookPullRequestReviewComment
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> HookPullRequestReviewComment -> m HookPullRequestReviewComment
gmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> HookPullRequestReviewComment
-> u
$cgmapQi :: forall u.
Int
-> (forall d. Data d => d -> u)
-> HookPullRequestReviewComment
-> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> HookPullRequestReviewComment -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> HookPullRequestReviewComment -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookPullRequestReviewComment
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookPullRequestReviewComment
-> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookPullRequestReviewComment
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> HookPullRequestReviewComment
-> r
gmapT :: (forall b. Data b => b -> b)
-> HookPullRequestReviewComment -> HookPullRequestReviewComment
$cgmapT :: (forall b. Data b => b -> b)
-> HookPullRequestReviewComment -> HookPullRequestReviewComment
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookPullRequestReviewComment)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c HookPullRequestReviewComment)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c HookPullRequestReviewComment)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d))
-> Maybe (c HookPullRequestReviewComment)
dataTypeOf :: HookPullRequestReviewComment -> DataType
$cdataTypeOf :: HookPullRequestReviewComment -> DataType
toConstr :: HookPullRequestReviewComment -> Constr
$ctoConstr :: HookPullRequestReviewComment -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookPullRequestReviewComment
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c HookPullRequestReviewComment
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookPullRequestReviewComment
-> c HookPullRequestReviewComment
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> HookPullRequestReviewComment
-> c HookPullRequestReviewComment
Data, forall x.
Rep HookPullRequestReviewComment x -> HookPullRequestReviewComment
forall x.
HookPullRequestReviewComment -> Rep HookPullRequestReviewComment x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep HookPullRequestReviewComment x -> HookPullRequestReviewComment
$cfrom :: forall x.
HookPullRequestReviewComment -> Rep HookPullRequestReviewComment x
Generic)

instance NFData HookPullRequestReviewComment where rnf :: HookPullRequestReviewComment -> ()
rnf = forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf


-- Aeson Instances


instance FromJSON HookIssue where
  parseJSON :: Value -> Parser HookIssue
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookIssue" forall a b. (a -> b) -> a -> b
$ \Object
o -> URL
-> URL
-> URL
-> URL
-> URL
-> Int
-> Text
-> Int
-> Text
-> HookUser
-> Vector HookIssueLabels
-> Text
-> Bool
-> Maybe HookUser
-> Maybe HookMilestone
-> Int
-> UTCTime
-> UTCTime
-> Maybe UTCTime
-> Text
-> HookIssue
HookIssue
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"labels_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"comments_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"events_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"html_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"number"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"title"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"labels"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"state"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"locked"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"assignee"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"milestone"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"comments"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"closed_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"body" forall a. Parser (Maybe a) -> a -> Parser a
.!= Text
""

instance FromJSON HookRepository where
  parseJSON :: Value -> Parser HookRepository
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookRepository" forall a b. (a -> b) -> a -> b
$ \Object
o -> Int
-> Text
-> Text
-> Text
-> Either HookSimpleUser HookUser
-> Bool
-> URL
-> Text
-> Bool
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> UTCTime
-> UTCTime
-> UTCTime
-> URL
-> URL
-> URL
-> URL
-> Maybe URL
-> Int
-> Int
-> Int
-> Maybe Text
-> Bool
-> Bool
-> Bool
-> Bool
-> Int
-> Maybe URL
-> Int
-> Text
-> HookRepository
HookRepository
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"full_name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"owner") forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"owner")) -- try complex form first

      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"private"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"html_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description" forall a. Parser (Maybe a) -> a -> Parser a
.!= Text
T.empty
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fork"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"forks_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"keys_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"collaborators_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"teams_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"hooks_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"issue_events_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"events_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"assignees_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"branches_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tags_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"blobs_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"git_tags_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"git_refs_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"trees_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"statuses_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"languages_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"stargazers_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"contributors_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"subscribers_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"subscription_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"commits_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"git_commits_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"comments_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"issue_comment_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"contents_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"compare_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"merges_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"archive_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"downloads_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"issues_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pulls_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"milestones_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"notifications_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"labels_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"releases_url"
      -- FIXME: Wrap optional number/stringified UTCTime in a helper function? See PushEvent fixture

      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at")  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (POSIXTime -> UTCTime
posixSecondsToUTCTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"))
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at")  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (POSIXTime -> UTCTime
posixSecondsToUTCTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"))
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pushed_at")   forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (POSIXTime -> UTCTime
posixSecondsToUTCTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => Integer -> a
fromInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pushed_at"))
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"git_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ssh_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"clone_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"svn_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"homepage"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"size"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"stargazers_count"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"watchers_count"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"language"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"has_issues"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"has_downloads"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"has_wiki"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"has_pages"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"forks_count"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mirror_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"open_issues_count"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"default_branch"

instance FromJSON HookRepositorySimple where
  parseJSON :: Value -> Parser HookRepositorySimple
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookRepositorySimple" forall a b. (a -> b) -> a -> b
$ \Object
o -> Int -> Text -> Text -> Text -> Bool -> HookRepositorySimple
HookRepositorySimple
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"full_name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"private"

instance FromJSON HookRepositoryLabel where
  parseJSON :: Value -> Parser HookRepositoryLabel
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookRepositoryLabel" forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe Text -> URL -> Text -> Text -> HookRepositoryLabel
HookRepositoryLabel
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"node_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"color"

instance FromJSON HookUser where
  parseJSON :: Value -> Parser HookUser
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookUser" forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Int
-> Text
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> URL
-> OwnerType
-> Bool
-> HookUser
HookUser
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"login"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"avatar_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"gravatar_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"html_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"followers_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"following_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"gists_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"starred_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"subscriptions_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"organizations_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"repos_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"events_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"received_events_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"site_admin"

instance FromJSON HookSimpleUser where
  parseJSON :: Value -> Parser HookSimpleUser
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookSimpleUser" forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> Maybe Text -> HookSimpleUser
HookSimpleUser
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"email"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"username"

instance FromJSON HookOrganization where
  parseJSON :: Value -> Parser HookOrganization
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookOrganization" forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Int
-> Text
-> URL
-> URL
-> URL
-> Maybe URL
-> Maybe URL
-> URL
-> URL
-> URL
-> Text
-> HookOrganization
HookOrganization
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"login"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"repos_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"events_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"hooks_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"issues_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"members_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"public_members_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"avatar_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description" forall a. Parser (Maybe a) -> a -> Parser a
.!= Text
T.empty

instance FromJSON HookOrganizationInvitation where
  parseJSON :: Value -> Parser HookOrganizationInvitation
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookOrganizationInvitation" forall a b. (a -> b) -> a -> b
$ \Object
o -> Int
-> Text -> Text -> Maybe Text -> Text -> HookOrganizationInvitation
HookOrganizationInvitation
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"login"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"email"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"role"

instance FromJSON HookOrganizationMembership where
  parseJSON :: Value -> Parser HookOrganizationMembership
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookOrganizationMembership" forall a b. (a -> b) -> a -> b
$ \Object
o -> URL
-> Text -> Text -> URL -> HookUser -> HookOrganizationMembership
HookOrganizationMembership
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"state"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"role"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"organization_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"

instance FromJSON HookTeam where
  parseJSON :: Value -> Parser HookTeam
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookTeam" forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Int -> Text -> Text -> Text -> URL -> URL -> URL -> HookTeam
HookTeam
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"slug"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"permission"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"members_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"repositories_url"

instance FromJSON HookMarketplacePurchase where
  parseJSON :: Value -> Parser HookMarketplacePurchase
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookMarketplacePurchase" forall a b. (a -> b) -> a -> b
$ \Object
o -> HookMarketplaceAccount
-> Maybe HookMarketplaceBillingCycle
-> Int
-> Bool
-> Maybe UTCTime
-> Maybe UTCTime
-> HookMarketplacePlan
-> HookMarketplacePurchase
HookMarketplacePurchase
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"account"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"billing_cycle"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"unit_count"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"on_free_trial"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ZonedTime -> UTCTime
zonedTimeToUTC forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"free_trial_ends_on")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ZonedTime -> UTCTime
zonedTimeToUTC forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"next_billing_date")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"plan"

instance FromJSON HookMarketplaceAccount where
  parseJSON :: Value -> Parser HookMarketplaceAccount
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookMarketplaceAccount" forall a b. (a -> b) -> a -> b
$ \Object
o -> OwnerType
-> Int -> Text -> Text -> Maybe Text -> HookMarketplaceAccount
HookMarketplaceAccount
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"login"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"organization_billing_email"

instance FromJSON HookMarketplacePlan where
  parseJSON :: Value -> Parser HookMarketplacePlan
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookMarketplacePlan" forall a b. (a -> b) -> a -> b
$ \Object
o -> Int
-> Text
-> Text
-> Int
-> Int
-> HookMarketplacePlanPriceModel
-> Bool
-> Maybe Text
-> Vector Text
-> HookMarketplacePlan
HookMarketplacePlan
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"monthly_price_in_cents"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"yearly_price_in_cents"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"price_model"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"has_free_trial"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"unit_name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"bullets"

instance FromJSON HookMilestone where
  parseJSON :: Value -> Parser HookMilestone
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookMilestone" forall a b. (a -> b) -> a -> b
$ \Object
o -> URL
-> URL
-> URL
-> Int
-> Text
-> Int
-> Text
-> Maybe Text
-> HookUser
-> Int
-> Int
-> Text
-> UTCTime
-> UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> HookMilestone
HookMilestone
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"html_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"labels_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"number"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"title"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"creator"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"open_issues"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"closed_issues"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"state"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"due_on"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"closed_at"

instance FromJSON HookMembership where
  parseJSON :: Value -> Parser HookMembership
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookMembership" forall a b. (a -> b) -> a -> b
$ \Object
o -> URL -> Text -> Text -> URL -> HookUser -> HookMembership
HookMembership
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"state"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"role"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"organization_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"

instance FromJSON HookProject where
  parseJSON :: Value -> Parser HookProject
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookProject" forall a b. (a -> b) -> a -> b
$ \Object
o -> URL
-> URL
-> URL
-> Int
-> Text
-> Text
-> Text
-> Int
-> Text
-> HookUser
-> UTCTime
-> UTCTime
-> HookProject
HookProject
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"owner_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"columns_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"body"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"number"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"state"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"creator"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"

instance FromJSON HookProjectCard where
  parseJSON :: Value -> Parser HookProjectCard
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookProjectCard" forall a b. (a -> b) -> a -> b
$ \Object
o -> URL
-> URL
-> Int
-> Int
-> Text
-> Maybe Text
-> HookUser
-> UTCTime
-> UTCTime
-> URL
-> HookProjectCard
HookProjectCard
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"column_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"column_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"note"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"creator"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"content_url"

instance FromJSON HookProjectColumn where
  parseJSON :: Value -> Parser HookProjectColumn
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookProjectColumn" forall a b. (a -> b) -> a -> b
$ \Object
o -> URL
-> URL
-> URL
-> Int
-> Text
-> Text
-> UTCTime
-> UTCTime
-> HookProjectColumn
HookProjectColumn
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"project_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"cards_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"

instance FromJSON HookIssueLabels where
  parseJSON :: Value -> Parser HookIssueLabels
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookIssueLabels" forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe Int
-> Maybe Text -> URL -> Text -> Text -> Bool -> HookIssueLabels
HookIssueLabels
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"node_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"color"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"default" forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False

instance FromJSON HookCheckSuite where
  parseJSON :: Value -> Parser HookCheckSuite
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookCheckSuite" forall a b. (a -> b) -> a -> b
$ \Object
o -> Int
-> Text
-> Maybe Text
-> Text
-> HookCheckSuiteStatus
-> Maybe HookCheckSuiteConclusion
-> URL
-> Maybe Text
-> Maybe Text
-> Vector HookChecksPullRequest
-> UTCTime
-> UTCTime
-> Maybe Int
-> Maybe URL
-> Maybe HookCheckSuiteCommit
-> HookCheckSuite
HookCheckSuite
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"head_branch"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"head_sha"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"conclusion"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"before"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"after"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pull_requests"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"latest_check_runs_count"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"check_runs_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"head_commit"

instance FromJSON HookCheckSuiteCommit where
  parseJSON :: Value -> Parser HookCheckSuiteCommit
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookCheckSuiteCommit" forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> HookSimpleUser -> HookSimpleUser -> HookCheckSuiteCommit
HookCheckSuiteCommit
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"author"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"committer"

instance FromJSON HookCheckRun where
  parseJSON :: Value -> Parser HookCheckRun
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookCheckRun" forall a b. (a -> b) -> a -> b
$ \Object
o -> Int
-> Text
-> Text
-> Text
-> URL
-> URL
-> URL
-> HookCheckRunStatus
-> Maybe HookCheckRunConclusion
-> UTCTime
-> Maybe UTCTime
-> HookCheckRunOutput
-> Text
-> HookCheckSuite
-> Vector HookChecksPullRequest
-> HookCheckRun
HookCheckRun
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"head_sha"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"external_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"html_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"details_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"conclusion"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"started_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"completed_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"output"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"check_suite"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pull_requests"

instance FromJSON HookCheckRunOutput where
  parseJSON :: Value -> Parser HookCheckRunOutput
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookCheckRunOutput" forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe Text
-> Maybe Text -> Maybe Text -> Int -> URL -> HookCheckRunOutput
HookCheckRunOutput
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"title"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"summary"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"text"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"annotations_count"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"annotations_url"

instance FromJSON HookCheckRunRequestedAction where
  parseJSON :: Value -> Parser HookCheckRunRequestedAction
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookCheckRunRequestedAction" forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> HookCheckRunRequestedAction
HookCheckRunRequestedAction
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"identifier"

instance FromJSON HookChecksInstallation where
  parseJSON :: Value -> Parser HookChecksInstallation
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookChecksInstallation" forall a b. (a -> b) -> a -> b
$ \Object
o -> Int -> Text -> HookChecksInstallation
HookChecksInstallation
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"

instance FromJSON HookChecksPullRequest where
  parseJSON :: Value -> Parser HookChecksPullRequest
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookChecksPullRequest" forall a b. (a -> b) -> a -> b
$ \Object
o -> URL
-> Int
-> Int
-> HookChecksPullRequestTarget
-> HookChecksPullRequestTarget
-> HookChecksPullRequest
HookChecksPullRequest
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"number"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"head"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"base"

instance FromJSON HookChecksPullRequestTarget where
    parseJSON :: Value -> Parser HookChecksPullRequestTarget
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"PullRequestTarget" forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> Text
-> HookChecksPullRequestRepository
-> HookChecksPullRequestTarget
HookChecksPullRequestTarget
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sha"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ref"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"repo"

instance FromJSON HookChecksPullRequestRepository where
  parseJSON :: Value -> Parser HookChecksPullRequestRepository
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookChecksPullRequestRepository" forall a b. (a -> b) -> a -> b
$ \Object
o -> Int -> URL -> Text -> HookChecksPullRequestRepository
HookChecksPullRequestRepository
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"

instance FromJSON HookCommit where
  parseJSON :: Value -> Parser HookCommit
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookCommit" forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> URL
-> Maybe URL
-> Maybe URL
-> Either HookSimpleUser HookUser
-> Either HookSimpleUser HookUser
-> HookCommit
HookCommit
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sha" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"html_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"comments_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"author")      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"author"))       -- try complex form first

      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"committer")   forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"committer"))    -- try complex form first


instance FromJSON HookRelease where
  parseJSON :: Value -> Parser HookRelease
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookRelease" forall a b. (a -> b) -> a -> b
$ \Object
o -> URL
-> URL
-> URL
-> URL
-> Int
-> Text
-> Text
-> Text
-> Maybe Text
-> Bool
-> HookUser
-> Bool
-> UTCTime
-> Maybe UTCTime
-> URL
-> URL
-> Maybe Text
-> HookRelease
HookRelease
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"assets_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"upload_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"html_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tag_name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"target_commitish"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"draft"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"author"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"prerelease"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"published_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"tarball_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"zipball_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"body"

instance FromJSON HookPullRequest where
  parseJSON :: Value -> Parser HookPullRequest
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookPullRequest" forall a b. (a -> b) -> a -> b
$ \Object
o -> URL
-> Int
-> Text
-> URL
-> URL
-> URL
-> URL
-> Int
-> Text
-> Bool
-> Text
-> HookUser
-> Text
-> UTCTime
-> UTCTime
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Text
-> Maybe HookUser
-> Maybe HookMilestone
-> URL
-> URL
-> URL
-> URL
-> URL
-> PullRequestTarget
-> PullRequestTarget
-> Maybe Text
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> HookPullRequest
HookPullRequest
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"html_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"diff_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"patch_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"issue_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"number"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"state"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"locked"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"title"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"body" forall a. Parser (Maybe a) -> a -> Parser a
.!= Text
""
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"closed_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"merged_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"merge_commit_sha"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"assignee"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"milestone"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"commits_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"review_comments_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"review_comment_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"comments_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"statuses_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"base"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"head"
      -- <*> o .: "merged"

      -- <*> o .: "mergeable"

      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mergeable_state"
      -- <*> o .: "merged_by"

      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"comments"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"review_comments"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"commits"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"additions"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"deletions"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"changed_files"

instance FromJSON PullRequestTarget where
    parseJSON :: Value -> Parser PullRequestTarget
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"PullRequestTarget" forall a b. (a -> b) -> a -> b
$ \Object
o -> Text
-> HookUser
-> Maybe HookRepository
-> Text
-> Text
-> PullRequestTarget
PullRequestTarget
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sha"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"repo"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"label"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ref"

instance FromJSON HookPullRequestReview where
  parseJSON :: Value -> Parser HookPullRequestReview
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookPullRequestReview" forall a b. (a -> b) -> a -> b
$ \Object
o -> Int
-> Text
-> HookUser
-> Text
-> UTCTime
-> Text
-> URL
-> URL
-> HookPullRequestReview
HookPullRequestReview
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"body"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"submitted_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"state"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"html_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pull_request_url"

instance FromJSON HookInstallation where
  parseJSON :: Value -> Parser HookInstallation
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookInstallation" forall a b. (a -> b) -> a -> b
$ \Object
o -> Int -> HookUser -> Text -> URL -> URL -> HookInstallation
HookInstallation
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"account"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"repository_selection"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"access_tokens_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"repositories_url"

instance FromJSON HookDeployment where
  parseJSON :: Value -> Parser HookDeployment
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookDeployment" forall a b. (a -> b) -> a -> b
$ \Object
o -> URL
-> Int
-> Text
-> Text
-> Text
-> Text
-> Text
-> Maybe Text
-> HookUser
-> UTCTime
-> UTCTime
-> URL
-> URL
-> HookDeployment
HookDeployment
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sha"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ref"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"task"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"environment"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"creator"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"statuses_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"repository_url"

instance FromJSON HookDeploymentStatus where
  parseJSON :: Value -> Parser HookDeploymentStatus
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookDeploymentStatus" forall a b. (a -> b) -> a -> b
$ \Object
o -> URL
-> Int
-> Text
-> Text
-> HookUser
-> Maybe Text
-> Maybe URL
-> UTCTime
-> UTCTime
-> URL
-> URL
-> HookDeploymentStatus
HookDeploymentStatus
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"state"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"creator"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"target_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"deployment_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"repository_url"

instance FromJSON HookWikiPage where
  parseJSON :: Value -> Parser HookWikiPage
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookWikiPage" forall a b. (a -> b) -> a -> b
$ \Object
o -> Text -> Text -> Maybe Text -> Text -> Text -> URL -> HookWikiPage
HookWikiPage
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"page_name"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"title"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"summary"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"action"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sha"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"html_url"

instance FromJSON HookPageBuildResult where
  parseJSON :: Value -> Parser HookPageBuildResult
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookPageBuildResult" forall a b. (a -> b) -> a -> b
$ \Object
o -> URL
-> Text
-> Maybe Text
-> HookUser
-> Text
-> Int
-> UTCTime
-> UTCTime
-> HookPageBuildResult
HookPageBuildResult
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"status"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"error" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Object
e -> Object
e forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"message")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pusher"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"commit"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"duration"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"

instance FromJSON HookIssueComment where
  parseJSON :: Value -> Parser HookIssueComment
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookIssueComment" forall a b. (a -> b) -> a -> b
$ \Object
o -> URL
-> URL
-> URL
-> Int
-> Text
-> HookUser
-> UTCTime
-> UTCTime
-> Text
-> HookIssueComment
HookIssueComment
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"html_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"issue_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"body"

instance FromJSON HookCommitComment where
  parseJSON :: Value -> Parser HookCommitComment
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookCommitComment" forall a b. (a -> b) -> a -> b
$ \Object
o -> URL
-> URL
-> Int
-> Text
-> HookUser
-> Maybe Int
-> Maybe Int
-> Maybe Text
-> Text
-> UTCTime
-> UTCTime
-> Text
-> HookCommitComment
HookCommitComment
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"html_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"position"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"line"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"path"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"commit_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"body"

instance FromJSON HookPullRequestReviewComment where
  parseJSON :: Value -> Parser HookPullRequestReviewComment
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
withObject [Char]
"HookPullRequestReviewComment" forall a b. (a -> b) -> a -> b
$ \Object
o -> URL
-> Int
-> Text
-> Text
-> Text
-> Int
-> Int
-> Text
-> Text
-> HookUser
-> Text
-> UTCTime
-> UTCTime
-> URL
-> URL
-> HookPullRequestReviewComment
HookPullRequestReviewComment
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"diff_hunk"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"position"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"original_position"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"commit_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"original_commit_id"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"body"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"html_url"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pull_request_url"