{-
   Gitea API

   This documentation describes the Gitea API.

   OpenAPI Version: 3.0.1
   Gitea API API version: 1.23.1
   Generated by OpenAPI Generator (https://openapi-generator.tech)
-}

{-|
Module : Gitea.Model
-}

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-unused-matches -fno-warn-unused-binds -fno-warn-unused-imports #-}

module Gitea.Model where

import Gitea.Core
import Gitea.MimeTypes

import Data.Aeson ((.:),(.:!),(.:?),(.=))

import qualified Control.Arrow as P (left)
import qualified Data.Aeson as A
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as BL
import qualified Data.Data as P (Typeable, TypeRep, typeOf, typeRep)
import qualified Data.Foldable as P
import qualified Data.HashMap.Lazy as HM
import qualified Data.Map as Map
import qualified Data.Maybe as P
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Time as TI
import qualified Lens.Micro as L
import qualified Web.FormUrlEncoded as WH
import qualified Web.HttpApiData as WH

import Control.Applicative ((<|>))
import Control.Applicative (Alternative)
import Data.Function ((&))
import Data.Monoid ((<>))
import Data.Text (Text)
import Prelude (($),(/=),(.),(<$>),(<*>),(>>=),(=<<),Maybe(..),Bool(..),Char,Double,FilePath,Float,Int,Integer,String,fmap,undefined,mempty,maybe,pure,Monad,Applicative,Functor)

import qualified Prelude as P



-- * Parameter newtypes


-- ** All
newtype All = All { All -> Bool
unAll :: Bool } deriving (All -> All -> Bool
(All -> All -> Bool) -> (All -> All -> Bool) -> Eq All
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: All -> All -> Bool
== :: All -> All -> Bool
$c/= :: All -> All -> Bool
/= :: All -> All -> Bool
P.Eq, Int -> All -> ShowS
[All] -> ShowS
All -> [Char]
(Int -> All -> ShowS)
-> (All -> [Char]) -> ([All] -> ShowS) -> Show All
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> All -> ShowS
showsPrec :: Int -> All -> ShowS
$cshow :: All -> [Char]
show :: All -> [Char]
$cshowList :: [All] -> ShowS
showList :: [All] -> ShowS
P.Show)

-- ** AllText
newtype AllText = AllText { AllText -> Text
unAllText :: Text } deriving (AllText -> AllText -> Bool
(AllText -> AllText -> Bool)
-> (AllText -> AllText -> Bool) -> Eq AllText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AllText -> AllText -> Bool
== :: AllText -> AllText -> Bool
$c/= :: AllText -> AllText -> Bool
/= :: AllText -> AllText -> Bool
P.Eq, Int -> AllText -> ShowS
[AllText] -> ShowS
AllText -> [Char]
(Int -> AllText -> ShowS)
-> (AllText -> [Char]) -> ([AllText] -> ShowS) -> Show AllText
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AllText -> ShowS
showsPrec :: Int -> AllText -> ShowS
$cshow :: AllText -> [Char]
show :: AllText -> [Char]
$cshowList :: [AllText] -> ShowS
showList :: [AllText] -> ShowS
P.Show)

-- ** Archive
newtype Archive = Archive { Archive -> Text
unArchive :: Text } deriving (Archive -> Archive -> Bool
(Archive -> Archive -> Bool)
-> (Archive -> Archive -> Bool) -> Eq Archive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Archive -> Archive -> Bool
== :: Archive -> Archive -> Bool
$c/= :: Archive -> Archive -> Bool
/= :: Archive -> Archive -> Bool
P.Eq, Int -> Archive -> ShowS
[Archive] -> ShowS
Archive -> [Char]
(Int -> Archive -> ShowS)
-> (Archive -> [Char]) -> ([Archive] -> ShowS) -> Show Archive
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Archive -> ShowS
showsPrec :: Int -> Archive -> ShowS
$cshow :: Archive -> [Char]
show :: Archive -> [Char]
$cshowList :: [Archive] -> ShowS
showList :: [Archive] -> ShowS
P.Show)

-- ** Archived
newtype Archived = Archived { Archived -> Bool
unArchived :: Bool } deriving (Archived -> Archived -> Bool
(Archived -> Archived -> Bool)
-> (Archived -> Archived -> Bool) -> Eq Archived
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Archived -> Archived -> Bool
== :: Archived -> Archived -> Bool
$c/= :: Archived -> Archived -> Bool
/= :: Archived -> Archived -> Bool
P.Eq, Int -> Archived -> ShowS
[Archived] -> ShowS
Archived -> [Char]
(Int -> Archived -> ShowS)
-> (Archived -> [Char]) -> ([Archived] -> ShowS) -> Show Archived
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Archived -> ShowS
showsPrec :: Int -> Archived -> ShowS
$cshow :: Archived -> [Char]
show :: Archived -> [Char]
$cshowList :: [Archived] -> ShowS
showList :: [Archived] -> ShowS
P.Show)

-- ** Assigned
newtype Assigned = Assigned { Assigned -> Bool
unAssigned :: Bool } deriving (Assigned -> Assigned -> Bool
(Assigned -> Assigned -> Bool)
-> (Assigned -> Assigned -> Bool) -> Eq Assigned
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Assigned -> Assigned -> Bool
== :: Assigned -> Assigned -> Bool
$c/= :: Assigned -> Assigned -> Bool
/= :: Assigned -> Assigned -> Bool
P.Eq, Int -> Assigned -> ShowS
[Assigned] -> ShowS
Assigned -> [Char]
(Int -> Assigned -> ShowS)
-> (Assigned -> [Char]) -> ([Assigned] -> ShowS) -> Show Assigned
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Assigned -> ShowS
showsPrec :: Int -> Assigned -> ShowS
$cshow :: Assigned -> [Char]
show :: Assigned -> [Char]
$cshowList :: [Assigned] -> ShowS
showList :: [Assigned] -> ShowS
P.Show)

-- ** AssignedBy
newtype AssignedBy = AssignedBy { AssignedBy -> Text
unAssignedBy :: Text } deriving (AssignedBy -> AssignedBy -> Bool
(AssignedBy -> AssignedBy -> Bool)
-> (AssignedBy -> AssignedBy -> Bool) -> Eq AssignedBy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AssignedBy -> AssignedBy -> Bool
== :: AssignedBy -> AssignedBy -> Bool
$c/= :: AssignedBy -> AssignedBy -> Bool
/= :: AssignedBy -> AssignedBy -> Bool
P.Eq, Int -> AssignedBy -> ShowS
[AssignedBy] -> ShowS
AssignedBy -> [Char]
(Int -> AssignedBy -> ShowS)
-> (AssignedBy -> [Char])
-> ([AssignedBy] -> ShowS)
-> Show AssignedBy
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AssignedBy -> ShowS
showsPrec :: Int -> AssignedBy -> ShowS
$cshow :: AssignedBy -> [Char]
show :: AssignedBy -> [Char]
$cshowList :: [AssignedBy] -> ShowS
showList :: [AssignedBy] -> ShowS
P.Show)

-- ** Attachment2
newtype Attachment2 = Attachment2 { Attachment2 -> [Char]
unAttachment2 :: FilePath } deriving (Attachment2 -> Attachment2 -> Bool
(Attachment2 -> Attachment2 -> Bool)
-> (Attachment2 -> Attachment2 -> Bool) -> Eq Attachment2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Attachment2 -> Attachment2 -> Bool
== :: Attachment2 -> Attachment2 -> Bool
$c/= :: Attachment2 -> Attachment2 -> Bool
/= :: Attachment2 -> Attachment2 -> Bool
P.Eq, Int -> Attachment2 -> ShowS
[Attachment2] -> ShowS
Attachment2 -> [Char]
(Int -> Attachment2 -> ShowS)
-> (Attachment2 -> [Char])
-> ([Attachment2] -> ShowS)
-> Show Attachment2
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Attachment2 -> ShowS
showsPrec :: Int -> Attachment2 -> ShowS
$cshow :: Attachment2 -> [Char]
show :: Attachment2 -> [Char]
$cshowList :: [Attachment2] -> ShowS
showList :: [Attachment2] -> ShowS
P.Show)

-- ** AttachmentId
newtype AttachmentId = AttachmentId { AttachmentId -> Integer
unAttachmentId :: Integer } deriving (AttachmentId -> AttachmentId -> Bool
(AttachmentId -> AttachmentId -> Bool)
-> (AttachmentId -> AttachmentId -> Bool) -> Eq AttachmentId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AttachmentId -> AttachmentId -> Bool
== :: AttachmentId -> AttachmentId -> Bool
$c/= :: AttachmentId -> AttachmentId -> Bool
/= :: AttachmentId -> AttachmentId -> Bool
P.Eq, Int -> AttachmentId -> ShowS
[AttachmentId] -> ShowS
AttachmentId -> [Char]
(Int -> AttachmentId -> ShowS)
-> (AttachmentId -> [Char])
-> ([AttachmentId] -> ShowS)
-> Show AttachmentId
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AttachmentId -> ShowS
showsPrec :: Int -> AttachmentId -> ShowS
$cshow :: AttachmentId -> [Char]
show :: AttachmentId -> [Char]
$cshowList :: [AttachmentId] -> ShowS
showList :: [AttachmentId] -> ShowS
P.Show)

-- ** Base
newtype Base = Base { Base -> Text
unBase :: Text } deriving (Base -> Base -> Bool
(Base -> Base -> Bool) -> (Base -> Base -> Bool) -> Eq Base
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Base -> Base -> Bool
== :: Base -> Base -> Bool
$c/= :: Base -> Base -> Bool
/= :: Base -> Base -> Bool
P.Eq, Int -> Base -> ShowS
[Base] -> ShowS
Base -> [Char]
(Int -> Base -> ShowS)
-> (Base -> [Char]) -> ([Base] -> ShowS) -> Show Base
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Base -> ShowS
showsPrec :: Int -> Base -> ShowS
$cshow :: Base -> [Char]
show :: Base -> [Char]
$cshowList :: [Base] -> ShowS
showList :: [Base] -> ShowS
P.Show)

-- ** Basehead
newtype Basehead = Basehead { Basehead -> Text
unBasehead :: Text } deriving (Basehead -> Basehead -> Bool
(Basehead -> Basehead -> Bool)
-> (Basehead -> Basehead -> Bool) -> Eq Basehead
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Basehead -> Basehead -> Bool
== :: Basehead -> Basehead -> Bool
$c/= :: Basehead -> Basehead -> Bool
/= :: Basehead -> Basehead -> Bool
P.Eq, Int -> Basehead -> ShowS
[Basehead] -> ShowS
Basehead -> [Char]
(Int -> Basehead -> ShowS)
-> (Basehead -> [Char]) -> ([Basehead] -> ShowS) -> Show Basehead
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Basehead -> ShowS
showsPrec :: Int -> Basehead -> ShowS
$cshow :: Basehead -> [Char]
show :: Basehead -> [Char]
$cshowList :: [Basehead] -> ShowS
showList :: [Basehead] -> ShowS
P.Show)

-- ** Before
newtype Before = Before { Before -> DateTime
unBefore :: DateTime } deriving (Before -> Before -> Bool
(Before -> Before -> Bool)
-> (Before -> Before -> Bool) -> Eq Before
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Before -> Before -> Bool
== :: Before -> Before -> Bool
$c/= :: Before -> Before -> Bool
/= :: Before -> Before -> Bool
P.Eq, Int -> Before -> ShowS
[Before] -> ShowS
Before -> [Char]
(Int -> Before -> ShowS)
-> (Before -> [Char]) -> ([Before] -> ShowS) -> Show Before
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Before -> ShowS
showsPrec :: Int -> Before -> ShowS
$cshow :: Before -> [Char]
show :: Before -> [Char]
$cshowList :: [Before] -> ShowS
showList :: [Before] -> ShowS
P.Show)

-- ** Body
newtype Body = Body { Body -> Text
unBody :: Text } deriving (Body -> Body -> Bool
(Body -> Body -> Bool) -> (Body -> Body -> Bool) -> Eq Body
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Body -> Body -> Bool
== :: Body -> Body -> Bool
$c/= :: Body -> Body -> Bool
/= :: Body -> Body -> Bool
P.Eq, Int -> Body -> ShowS
[Body] -> ShowS
Body -> [Char]
(Int -> Body -> ShowS)
-> (Body -> [Char]) -> ([Body] -> ShowS) -> Show Body
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Body -> ShowS
showsPrec :: Int -> Body -> ShowS
$cshow :: Body -> [Char]
show :: Body -> [Char]
$cshowList :: [Body] -> ShowS
showList :: [Body] -> ShowS
P.Show, [Body] -> Value
[Body] -> Encoding
Body -> Value
Body -> Encoding
(Body -> Value)
-> (Body -> Encoding)
-> ([Body] -> Value)
-> ([Body] -> Encoding)
-> ToJSON Body
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: Body -> Value
toJSON :: Body -> Value
$ctoEncoding :: Body -> Encoding
toEncoding :: Body -> Encoding
$ctoJSONList :: [Body] -> Value
toJSONList :: [Body] -> Value
$ctoEncodingList :: [Body] -> Encoding
toEncodingList :: [Body] -> Encoding
A.ToJSON)

-- ** Branch2
newtype Branch2 = Branch2 { Branch2 -> Text
unBranch2 :: Text } deriving (Branch2 -> Branch2 -> Bool
(Branch2 -> Branch2 -> Bool)
-> (Branch2 -> Branch2 -> Bool) -> Eq Branch2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Branch2 -> Branch2 -> Bool
== :: Branch2 -> Branch2 -> Bool
$c/= :: Branch2 -> Branch2 -> Bool
/= :: Branch2 -> Branch2 -> Bool
P.Eq, Int -> Branch2 -> ShowS
[Branch2] -> ShowS
Branch2 -> [Char]
(Int -> Branch2 -> ShowS)
-> (Branch2 -> [Char]) -> ([Branch2] -> ShowS) -> Show Branch2
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Branch2 -> ShowS
showsPrec :: Int -> Branch2 -> ShowS
$cshow :: Branch2 -> [Char]
show :: Branch2 -> [Char]
$cshowList :: [Branch2] -> ShowS
showList :: [Branch2] -> ShowS
P.Show)

-- ** Collaborator
newtype Collaborator = Collaborator { Collaborator -> Text
unCollaborator :: Text } deriving (Collaborator -> Collaborator -> Bool
(Collaborator -> Collaborator -> Bool)
-> (Collaborator -> Collaborator -> Bool) -> Eq Collaborator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Collaborator -> Collaborator -> Bool
== :: Collaborator -> Collaborator -> Bool
$c/= :: Collaborator -> Collaborator -> Bool
/= :: Collaborator -> Collaborator -> Bool
P.Eq, Int -> Collaborator -> ShowS
[Collaborator] -> ShowS
Collaborator -> [Char]
(Int -> Collaborator -> ShowS)
-> (Collaborator -> [Char])
-> ([Collaborator] -> ShowS)
-> Show Collaborator
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Collaborator -> ShowS
showsPrec :: Int -> Collaborator -> ShowS
$cshow :: Collaborator -> [Char]
show :: Collaborator -> [Char]
$cshowList :: [Collaborator] -> ShowS
showList :: [Collaborator] -> ShowS
P.Show)

-- ** Created
newtype Created = Created { Created -> Bool
unCreated :: Bool } deriving (Created -> Created -> Bool
(Created -> Created -> Bool)
-> (Created -> Created -> Bool) -> Eq Created
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Created -> Created -> Bool
== :: Created -> Created -> Bool
$c/= :: Created -> Created -> Bool
/= :: Created -> Created -> Bool
P.Eq, Int -> Created -> ShowS
[Created] -> ShowS
Created -> [Char]
(Int -> Created -> ShowS)
-> (Created -> [Char]) -> ([Created] -> ShowS) -> Show Created
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Created -> ShowS
showsPrec :: Int -> Created -> ShowS
$cshow :: Created -> [Char]
show :: Created -> [Char]
$cshowList :: [Created] -> ShowS
showList :: [Created] -> ShowS
P.Show)

-- ** CreatedBy
newtype CreatedBy = CreatedBy { CreatedBy -> Text
unCreatedBy :: Text } deriving (CreatedBy -> CreatedBy -> Bool
(CreatedBy -> CreatedBy -> Bool)
-> (CreatedBy -> CreatedBy -> Bool) -> Eq CreatedBy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreatedBy -> CreatedBy -> Bool
== :: CreatedBy -> CreatedBy -> Bool
$c/= :: CreatedBy -> CreatedBy -> Bool
/= :: CreatedBy -> CreatedBy -> Bool
P.Eq, Int -> CreatedBy -> ShowS
[CreatedBy] -> ShowS
CreatedBy -> [Char]
(Int -> CreatedBy -> ShowS)
-> (CreatedBy -> [Char])
-> ([CreatedBy] -> ShowS)
-> Show CreatedBy
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreatedBy -> ShowS
showsPrec :: Int -> CreatedBy -> ShowS
$cshow :: CreatedBy -> [Char]
show :: CreatedBy -> [Char]
$cshowList :: [CreatedBy] -> ShowS
showList :: [CreatedBy] -> ShowS
P.Show)

-- ** DiffType
newtype DiffType = DiffType { DiffType -> E'DiffType
unDiffType :: E'DiffType } deriving (DiffType -> DiffType -> Bool
(DiffType -> DiffType -> Bool)
-> (DiffType -> DiffType -> Bool) -> Eq DiffType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DiffType -> DiffType -> Bool
== :: DiffType -> DiffType -> Bool
$c/= :: DiffType -> DiffType -> Bool
/= :: DiffType -> DiffType -> Bool
P.Eq, Int -> DiffType -> ShowS
[DiffType] -> ShowS
DiffType -> [Char]
(Int -> DiffType -> ShowS)
-> (DiffType -> [Char]) -> ([DiffType] -> ShowS) -> Show DiffType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DiffType -> ShowS
showsPrec :: Int -> DiffType -> ShowS
$cshow :: DiffType -> [Char]
show :: DiffType -> [Char]
$cshowList :: [DiffType] -> ShowS
showList :: [DiffType] -> ShowS
P.Show)

-- ** Draft
newtype Draft = Draft { Draft -> Bool
unDraft :: Bool } deriving (Draft -> Draft -> Bool
(Draft -> Draft -> Bool) -> (Draft -> Draft -> Bool) -> Eq Draft
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Draft -> Draft -> Bool
== :: Draft -> Draft -> Bool
$c/= :: Draft -> Draft -> Bool
/= :: Draft -> Draft -> Bool
P.Eq, Int -> Draft -> ShowS
[Draft] -> ShowS
Draft -> [Char]
(Int -> Draft -> ShowS)
-> (Draft -> [Char]) -> ([Draft] -> ShowS) -> Show Draft
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Draft -> ShowS
showsPrec :: Int -> Draft -> ShowS
$cshow :: Draft -> [Char]
show :: Draft -> [Char]
$cshowList :: [Draft] -> ShowS
showList :: [Draft] -> ShowS
P.Show)

-- ** Exclusive
newtype Exclusive = Exclusive { Exclusive -> Bool
unExclusive :: Bool } deriving (Exclusive -> Exclusive -> Bool
(Exclusive -> Exclusive -> Bool)
-> (Exclusive -> Exclusive -> Bool) -> Eq Exclusive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Exclusive -> Exclusive -> Bool
== :: Exclusive -> Exclusive -> Bool
$c/= :: Exclusive -> Exclusive -> Bool
/= :: Exclusive -> Exclusive -> Bool
P.Eq, Int -> Exclusive -> ShowS
[Exclusive] -> ShowS
Exclusive -> [Char]
(Int -> Exclusive -> ShowS)
-> (Exclusive -> [Char])
-> ([Exclusive] -> ShowS)
-> Show Exclusive
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Exclusive -> ShowS
showsPrec :: Int -> Exclusive -> ShowS
$cshow :: Exclusive -> [Char]
show :: Exclusive -> [Char]
$cshowList :: [Exclusive] -> ShowS
showList :: [Exclusive] -> ShowS
P.Show)

-- ** Filepath
newtype Filepath = Filepath { Filepath -> Text
unFilepath :: Text } deriving (Filepath -> Filepath -> Bool
(Filepath -> Filepath -> Bool)
-> (Filepath -> Filepath -> Bool) -> Eq Filepath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Filepath -> Filepath -> Bool
== :: Filepath -> Filepath -> Bool
$c/= :: Filepath -> Filepath -> Bool
/= :: Filepath -> Filepath -> Bool
P.Eq, Int -> Filepath -> ShowS
[Filepath] -> ShowS
Filepath -> [Char]
(Int -> Filepath -> ShowS)
-> (Filepath -> [Char]) -> ([Filepath] -> ShowS) -> Show Filepath
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Filepath -> ShowS
showsPrec :: Int -> Filepath -> ShowS
$cshow :: Filepath -> [Char]
show :: Filepath -> [Char]
$cshowList :: [Filepath] -> ShowS
showList :: [Filepath] -> ShowS
P.Show)

-- ** Files
newtype Files = Files { Files -> Bool
unFiles :: Bool } deriving (Files -> Files -> Bool
(Files -> Files -> Bool) -> (Files -> Files -> Bool) -> Eq Files
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Files -> Files -> Bool
== :: Files -> Files -> Bool
$c/= :: Files -> Files -> Bool
/= :: Files -> Files -> Bool
P.Eq, Int -> Files -> ShowS
[Files] -> ShowS
Files -> [Char]
(Int -> Files -> ShowS)
-> (Files -> [Char]) -> ([Files] -> ShowS) -> Show Files
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Files -> ShowS
showsPrec :: Int -> Files -> ShowS
$cshow :: Files -> [Char]
show :: Files -> [Char]
$cshowList :: [Files] -> ShowS
showList :: [Files] -> ShowS
P.Show)

-- ** Fingerprint
newtype Fingerprint = Fingerprint { Fingerprint -> Text
unFingerprint :: Text } deriving (Fingerprint -> Fingerprint -> Bool
(Fingerprint -> Fingerprint -> Bool)
-> (Fingerprint -> Fingerprint -> Bool) -> Eq Fingerprint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Fingerprint -> Fingerprint -> Bool
== :: Fingerprint -> Fingerprint -> Bool
$c/= :: Fingerprint -> Fingerprint -> Bool
/= :: Fingerprint -> Fingerprint -> Bool
P.Eq, Int -> Fingerprint -> ShowS
[Fingerprint] -> ShowS
Fingerprint -> [Char]
(Int -> Fingerprint -> ShowS)
-> (Fingerprint -> [Char])
-> ([Fingerprint] -> ShowS)
-> Show Fingerprint
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Fingerprint -> ShowS
showsPrec :: Int -> Fingerprint -> ShowS
$cshow :: Fingerprint -> [Char]
show :: Fingerprint -> [Char]
$cshowList :: [Fingerprint] -> ShowS
showList :: [Fingerprint] -> ShowS
P.Show)

-- ** Head
newtype Head = Head { Head -> Text
unHead :: Text } deriving (Head -> Head -> Bool
(Head -> Head -> Bool) -> (Head -> Head -> Bool) -> Eq Head
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Head -> Head -> Bool
== :: Head -> Head -> Bool
$c/= :: Head -> Head -> Bool
/= :: Head -> Head -> Bool
P.Eq, Int -> Head -> ShowS
[Head] -> ShowS
Head -> [Char]
(Int -> Head -> ShowS)
-> (Head -> [Char]) -> ([Head] -> ShowS) -> Show Head
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Head -> ShowS
showsPrec :: Int -> Head -> ShowS
$cshow :: Head -> [Char]
show :: Head -> [Char]
$cshowList :: [Head] -> ShowS
showList :: [Head] -> ShowS
P.Show)

-- ** Id
newtype Id = Id { Id -> Integer
unId :: Integer } deriving (Id -> Id -> Bool
(Id -> Id -> Bool) -> (Id -> Id -> Bool) -> Eq Id
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Id -> Id -> Bool
== :: Id -> Id -> Bool
$c/= :: Id -> Id -> Bool
/= :: Id -> Id -> Bool
P.Eq, Int -> Id -> ShowS
[Id] -> ShowS
Id -> [Char]
(Int -> Id -> ShowS)
-> (Id -> [Char]) -> ([Id] -> ShowS) -> Show Id
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Id -> ShowS
showsPrec :: Int -> Id -> ShowS
$cshow :: Id -> [Char]
show :: Id -> [Char]
$cshowList :: [Id] -> ShowS
showList :: [Id] -> ShowS
P.Show)

-- ** IdInt
newtype IdInt = IdInt { IdInt -> Int
unIdInt :: Int } deriving (IdInt -> IdInt -> Bool
(IdInt -> IdInt -> Bool) -> (IdInt -> IdInt -> Bool) -> Eq IdInt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IdInt -> IdInt -> Bool
== :: IdInt -> IdInt -> Bool
$c/= :: IdInt -> IdInt -> Bool
/= :: IdInt -> IdInt -> Bool
P.Eq, Int -> IdInt -> ShowS
[IdInt] -> ShowS
IdInt -> [Char]
(Int -> IdInt -> ShowS)
-> (IdInt -> [Char]) -> ([IdInt] -> ShowS) -> Show IdInt
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IdInt -> ShowS
showsPrec :: Int -> IdInt -> ShowS
$cshow :: IdInt -> [Char]
show :: IdInt -> [Char]
$cshowList :: [IdInt] -> ShowS
showList :: [IdInt] -> ShowS
P.Show)

-- ** IdText
newtype IdText = IdText { IdText -> Text
unIdText :: Text } deriving (IdText -> IdText -> Bool
(IdText -> IdText -> Bool)
-> (IdText -> IdText -> Bool) -> Eq IdText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IdText -> IdText -> Bool
== :: IdText -> IdText -> Bool
$c/= :: IdText -> IdText -> Bool
/= :: IdText -> IdText -> Bool
P.Eq, Int -> IdText -> ShowS
[IdText] -> ShowS
IdText -> [Char]
(Int -> IdText -> ShowS)
-> (IdText -> [Char]) -> ([IdText] -> ShowS) -> Show IdText
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IdText -> ShowS
showsPrec :: Int -> IdText -> ShowS
$cshow :: IdText -> [Char]
show :: IdText -> [Char]
$cshowList :: [IdText] -> ShowS
showList :: [IdText] -> ShowS
P.Show)

-- ** IncludeDesc
newtype IncludeDesc = IncludeDesc { IncludeDesc -> Bool
unIncludeDesc :: Bool } deriving (IncludeDesc -> IncludeDesc -> Bool
(IncludeDesc -> IncludeDesc -> Bool)
-> (IncludeDesc -> IncludeDesc -> Bool) -> Eq IncludeDesc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IncludeDesc -> IncludeDesc -> Bool
== :: IncludeDesc -> IncludeDesc -> Bool
$c/= :: IncludeDesc -> IncludeDesc -> Bool
/= :: IncludeDesc -> IncludeDesc -> Bool
P.Eq, Int -> IncludeDesc -> ShowS
[IncludeDesc] -> ShowS
IncludeDesc -> [Char]
(Int -> IncludeDesc -> ShowS)
-> (IncludeDesc -> [Char])
-> ([IncludeDesc] -> ShowS)
-> Show IncludeDesc
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IncludeDesc -> ShowS
showsPrec :: Int -> IncludeDesc -> ShowS
$cshow :: IncludeDesc -> [Char]
show :: IncludeDesc -> [Char]
$cshowList :: [IncludeDesc] -> ShowS
showList :: [IncludeDesc] -> ShowS
P.Show)

-- ** Index
newtype Index = Index { Index -> Integer
unIndex :: Integer } deriving (Index -> Index -> Bool
(Index -> Index -> Bool) -> (Index -> Index -> Bool) -> Eq Index
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Index -> Index -> Bool
== :: Index -> Index -> Bool
$c/= :: Index -> Index -> Bool
/= :: Index -> Index -> Bool
P.Eq, Int -> Index -> ShowS
[Index] -> ShowS
Index -> [Char]
(Int -> Index -> ShowS)
-> (Index -> [Char]) -> ([Index] -> ShowS) -> Show Index
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Index -> ShowS
showsPrec :: Int -> Index -> ShowS
$cshow :: Index -> [Char]
show :: Index -> [Char]
$cshowList :: [Index] -> ShowS
showList :: [Index] -> ShowS
P.Show)

-- ** IndexInt
newtype IndexInt = IndexInt { IndexInt -> Int
unIndexInt :: Int } deriving (IndexInt -> IndexInt -> Bool
(IndexInt -> IndexInt -> Bool)
-> (IndexInt -> IndexInt -> Bool) -> Eq IndexInt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndexInt -> IndexInt -> Bool
== :: IndexInt -> IndexInt -> Bool
$c/= :: IndexInt -> IndexInt -> Bool
/= :: IndexInt -> IndexInt -> Bool
P.Eq, Int -> IndexInt -> ShowS
[IndexInt] -> ShowS
IndexInt -> [Char]
(Int -> IndexInt -> ShowS)
-> (IndexInt -> [Char]) -> ([IndexInt] -> ShowS) -> Show IndexInt
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IndexInt -> ShowS
showsPrec :: Int -> IndexInt -> ShowS
$cshow :: IndexInt -> [Char]
show :: IndexInt -> [Char]
$cshowList :: [IndexInt] -> ShowS
showList :: [IndexInt] -> ShowS
P.Show)

-- ** IndexText
newtype IndexText = IndexText { IndexText -> Text
unIndexText :: Text } deriving (IndexText -> IndexText -> Bool
(IndexText -> IndexText -> Bool)
-> (IndexText -> IndexText -> Bool) -> Eq IndexText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IndexText -> IndexText -> Bool
== :: IndexText -> IndexText -> Bool
$c/= :: IndexText -> IndexText -> Bool
/= :: IndexText -> IndexText -> Bool
P.Eq, Int -> IndexText -> ShowS
[IndexText] -> ShowS
IndexText -> [Char]
(Int -> IndexText -> ShowS)
-> (IndexText -> [Char])
-> ([IndexText] -> ShowS)
-> Show IndexText
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IndexText -> ShowS
showsPrec :: Int -> IndexText -> ShowS
$cshow :: IndexText -> [Char]
show :: IndexText -> [Char]
$cshowList :: [IndexText] -> ShowS
showList :: [IndexText] -> ShowS
P.Show)

-- ** IsPrivate
newtype IsPrivate = IsPrivate { IsPrivate -> Bool
unIsPrivate :: Bool } deriving (IsPrivate -> IsPrivate -> Bool
(IsPrivate -> IsPrivate -> Bool)
-> (IsPrivate -> IsPrivate -> Bool) -> Eq IsPrivate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IsPrivate -> IsPrivate -> Bool
== :: IsPrivate -> IsPrivate -> Bool
$c/= :: IsPrivate -> IsPrivate -> Bool
/= :: IsPrivate -> IsPrivate -> Bool
P.Eq, Int -> IsPrivate -> ShowS
[IsPrivate] -> ShowS
IsPrivate -> [Char]
(Int -> IsPrivate -> ShowS)
-> (IsPrivate -> [Char])
-> ([IsPrivate] -> ShowS)
-> Show IsPrivate
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IsPrivate -> ShowS
showsPrec :: Int -> IsPrivate -> ShowS
$cshow :: IsPrivate -> [Char]
show :: IsPrivate -> [Char]
$cshowList :: [IsPrivate] -> ShowS
showList :: [IsPrivate] -> ShowS
P.Show)

-- ** KeyId
newtype KeyId = KeyId { KeyId -> Int
unKeyId :: Int } deriving (KeyId -> KeyId -> Bool
(KeyId -> KeyId -> Bool) -> (KeyId -> KeyId -> Bool) -> Eq KeyId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyId -> KeyId -> Bool
== :: KeyId -> KeyId -> Bool
$c/= :: KeyId -> KeyId -> Bool
/= :: KeyId -> KeyId -> Bool
P.Eq, Int -> KeyId -> ShowS
[KeyId] -> ShowS
KeyId -> [Char]
(Int -> KeyId -> ShowS)
-> (KeyId -> [Char]) -> ([KeyId] -> ShowS) -> Show KeyId
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyId -> ShowS
showsPrec :: Int -> KeyId -> ShowS
$cshow :: KeyId -> [Char]
show :: KeyId -> [Char]
$cshowList :: [KeyId] -> ShowS
showList :: [KeyId] -> ShowS
P.Show)

-- ** Labels
newtype Labels = Labels { Labels -> Text
unLabels :: Text } deriving (Labels -> Labels -> Bool
(Labels -> Labels -> Bool)
-> (Labels -> Labels -> Bool) -> Eq Labels
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Labels -> Labels -> Bool
== :: Labels -> Labels -> Bool
$c/= :: Labels -> Labels -> Bool
/= :: Labels -> Labels -> Bool
P.Eq, Int -> Labels -> ShowS
[Labels] -> ShowS
Labels -> [Char]
(Int -> Labels -> ShowS)
-> (Labels -> [Char]) -> ([Labels] -> ShowS) -> Show Labels
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Labels -> ShowS
showsPrec :: Int -> Labels -> ShowS
$cshow :: Labels -> [Char]
show :: Labels -> [Char]
$cshowList :: [Labels] -> ShowS
showList :: [Labels] -> ShowS
P.Show)

-- ** LabelsInteger
newtype LabelsInteger = LabelsInteger { LabelsInteger -> [Integer]
unLabelsInteger :: [Integer] } deriving (LabelsInteger -> LabelsInteger -> Bool
(LabelsInteger -> LabelsInteger -> Bool)
-> (LabelsInteger -> LabelsInteger -> Bool) -> Eq LabelsInteger
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LabelsInteger -> LabelsInteger -> Bool
== :: LabelsInteger -> LabelsInteger -> Bool
$c/= :: LabelsInteger -> LabelsInteger -> Bool
/= :: LabelsInteger -> LabelsInteger -> Bool
P.Eq, Int -> LabelsInteger -> ShowS
[LabelsInteger] -> ShowS
LabelsInteger -> [Char]
(Int -> LabelsInteger -> ShowS)
-> (LabelsInteger -> [Char])
-> ([LabelsInteger] -> ShowS)
-> Show LabelsInteger
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LabelsInteger -> ShowS
showsPrec :: Int -> LabelsInteger -> ShowS
$cshow :: LabelsInteger -> [Char]
show :: LabelsInteger -> [Char]
$cshowList :: [LabelsInteger] -> ShowS
showList :: [LabelsInteger] -> ShowS
P.Show)

-- ** LastReadAt
newtype LastReadAt = LastReadAt { LastReadAt -> DateTime
unLastReadAt :: DateTime } deriving (LastReadAt -> LastReadAt -> Bool
(LastReadAt -> LastReadAt -> Bool)
-> (LastReadAt -> LastReadAt -> Bool) -> Eq LastReadAt
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LastReadAt -> LastReadAt -> Bool
== :: LastReadAt -> LastReadAt -> Bool
$c/= :: LastReadAt -> LastReadAt -> Bool
/= :: LastReadAt -> LastReadAt -> Bool
P.Eq, Int -> LastReadAt -> ShowS
[LastReadAt] -> ShowS
LastReadAt -> [Char]
(Int -> LastReadAt -> ShowS)
-> (LastReadAt -> [Char])
-> ([LastReadAt] -> ShowS)
-> Show LastReadAt
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LastReadAt -> ShowS
showsPrec :: Int -> LastReadAt -> ShowS
$cshow :: LastReadAt -> [Char]
show :: LastReadAt -> [Char]
$cshowList :: [LastReadAt] -> ShowS
showList :: [LastReadAt] -> ShowS
P.Show)

-- ** Limit
newtype Limit = Limit { Limit -> Int
unLimit :: Int } deriving (Limit -> Limit -> Bool
(Limit -> Limit -> Bool) -> (Limit -> Limit -> Bool) -> Eq Limit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Limit -> Limit -> Bool
== :: Limit -> Limit -> Bool
$c/= :: Limit -> Limit -> Bool
/= :: Limit -> Limit -> Bool
P.Eq, Int -> Limit -> ShowS
[Limit] -> ShowS
Limit -> [Char]
(Int -> Limit -> ShowS)
-> (Limit -> [Char]) -> ([Limit] -> ShowS) -> Show Limit
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Limit -> ShowS
showsPrec :: Int -> Limit -> ShowS
$cshow :: Limit -> [Char]
show :: Limit -> [Char]
$cshowList :: [Limit] -> ShowS
showList :: [Limit] -> ShowS
P.Show)

-- ** LoginName
newtype LoginName = LoginName { LoginName -> Text
unLoginName :: Text } deriving (LoginName -> LoginName -> Bool
(LoginName -> LoginName -> Bool)
-> (LoginName -> LoginName -> Bool) -> Eq LoginName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LoginName -> LoginName -> Bool
== :: LoginName -> LoginName -> Bool
$c/= :: LoginName -> LoginName -> Bool
/= :: LoginName -> LoginName -> Bool
P.Eq, Int -> LoginName -> ShowS
[LoginName] -> ShowS
LoginName -> [Char]
(Int -> LoginName -> ShowS)
-> (LoginName -> [Char])
-> ([LoginName] -> ShowS)
-> Show LoginName
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LoginName -> ShowS
showsPrec :: Int -> LoginName -> ShowS
$cshow :: LoginName -> [Char]
show :: LoginName -> [Char]
$cshowList :: [LoginName] -> ShowS
showList :: [LoginName] -> ShowS
P.Show)

-- ** Mentioned
newtype Mentioned = Mentioned { Mentioned -> Bool
unMentioned :: Bool } deriving (Mentioned -> Mentioned -> Bool
(Mentioned -> Mentioned -> Bool)
-> (Mentioned -> Mentioned -> Bool) -> Eq Mentioned
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mentioned -> Mentioned -> Bool
== :: Mentioned -> Mentioned -> Bool
$c/= :: Mentioned -> Mentioned -> Bool
/= :: Mentioned -> Mentioned -> Bool
P.Eq, Int -> Mentioned -> ShowS
[Mentioned] -> ShowS
Mentioned -> [Char]
(Int -> Mentioned -> ShowS)
-> (Mentioned -> [Char])
-> ([Mentioned] -> ShowS)
-> Show Mentioned
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mentioned -> ShowS
showsPrec :: Int -> Mentioned -> ShowS
$cshow :: Mentioned -> [Char]
show :: Mentioned -> [Char]
$cshowList :: [Mentioned] -> ShowS
showList :: [Mentioned] -> ShowS
P.Show)

-- ** MentionedBy
newtype MentionedBy = MentionedBy { MentionedBy -> Text
unMentionedBy :: Text } deriving (MentionedBy -> MentionedBy -> Bool
(MentionedBy -> MentionedBy -> Bool)
-> (MentionedBy -> MentionedBy -> Bool) -> Eq MentionedBy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MentionedBy -> MentionedBy -> Bool
== :: MentionedBy -> MentionedBy -> Bool
$c/= :: MentionedBy -> MentionedBy -> Bool
/= :: MentionedBy -> MentionedBy -> Bool
P.Eq, Int -> MentionedBy -> ShowS
[MentionedBy] -> ShowS
MentionedBy -> [Char]
(Int -> MentionedBy -> ShowS)
-> (MentionedBy -> [Char])
-> ([MentionedBy] -> ShowS)
-> Show MentionedBy
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MentionedBy -> ShowS
showsPrec :: Int -> MentionedBy -> ShowS
$cshow :: MentionedBy -> [Char]
show :: MentionedBy -> [Char]
$cshowList :: [MentionedBy] -> ShowS
showList :: [MentionedBy] -> ShowS
P.Show)

-- ** Milestone2
newtype Milestone2 = Milestone2 { Milestone2 -> Integer
unMilestone2 :: Integer } deriving (Milestone2 -> Milestone2 -> Bool
(Milestone2 -> Milestone2 -> Bool)
-> (Milestone2 -> Milestone2 -> Bool) -> Eq Milestone2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Milestone2 -> Milestone2 -> Bool
== :: Milestone2 -> Milestone2 -> Bool
$c/= :: Milestone2 -> Milestone2 -> Bool
/= :: Milestone2 -> Milestone2 -> Bool
P.Eq, Int -> Milestone2 -> ShowS
[Milestone2] -> ShowS
Milestone2 -> [Char]
(Int -> Milestone2 -> ShowS)
-> (Milestone2 -> [Char])
-> ([Milestone2] -> ShowS)
-> Show Milestone2
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Milestone2 -> ShowS
showsPrec :: Int -> Milestone2 -> ShowS
$cshow :: Milestone2 -> [Char]
show :: Milestone2 -> [Char]
$cshowList :: [Milestone2] -> ShowS
showList :: [Milestone2] -> ShowS
P.Show)

-- ** Milestones
newtype Milestones = Milestones { Milestones -> Text
unMilestones :: Text } deriving (Milestones -> Milestones -> Bool
(Milestones -> Milestones -> Bool)
-> (Milestones -> Milestones -> Bool) -> Eq Milestones
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Milestones -> Milestones -> Bool
== :: Milestones -> Milestones -> Bool
$c/= :: Milestones -> Milestones -> Bool
/= :: Milestones -> Milestones -> Bool
P.Eq, Int -> Milestones -> ShowS
[Milestones] -> ShowS
Milestones -> [Char]
(Int -> Milestones -> ShowS)
-> (Milestones -> [Char])
-> ([Milestones] -> ShowS)
-> Show Milestones
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Milestones -> ShowS
showsPrec :: Int -> Milestones -> ShowS
$cshow :: Milestones -> [Char]
show :: Milestones -> [Char]
$cshowList :: [Milestones] -> ShowS
showList :: [Milestones] -> ShowS
P.Show)

-- ** Mode
newtype Mode = Mode { Mode -> Text
unMode :: Text } deriving (Mode -> Mode -> Bool
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
/= :: Mode -> Mode -> Bool
P.Eq, Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> [Char]
(Int -> Mode -> ShowS)
-> (Mode -> [Char]) -> ([Mode] -> ShowS) -> Show Mode
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mode -> ShowS
showsPrec :: Int -> Mode -> ShowS
$cshow :: Mode -> [Char]
show :: Mode -> [Char]
$cshowList :: [Mode] -> ShowS
showList :: [Mode] -> ShowS
P.Show)

-- ** Name
newtype Name = Name { Name -> Text
unName :: Text } deriving (Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
/= :: Name -> Name -> Bool
P.Eq, Int -> Name -> ShowS
[Name] -> ShowS
Name -> [Char]
(Int -> Name -> ShowS)
-> (Name -> [Char]) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Name -> ShowS
showsPrec :: Int -> Name -> ShowS
$cshow :: Name -> [Char]
show :: Name -> [Char]
$cshowList :: [Name] -> ShowS
showList :: [Name] -> ShowS
P.Show)

-- ** Not
newtype Not = Not { Not -> Text
unNot :: Text } deriving (Not -> Not -> Bool
(Not -> Not -> Bool) -> (Not -> Not -> Bool) -> Eq Not
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Not -> Not -> Bool
== :: Not -> Not -> Bool
$c/= :: Not -> Not -> Bool
/= :: Not -> Not -> Bool
P.Eq, Int -> Not -> ShowS
[Not] -> ShowS
Not -> [Char]
(Int -> Not -> ShowS)
-> (Not -> [Char]) -> ([Not] -> ShowS) -> Show Not
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Not -> ShowS
showsPrec :: Int -> Not -> ShowS
$cshow :: Not -> [Char]
show :: Not -> [Char]
$cshowList :: [Not] -> ShowS
showList :: [Not] -> ShowS
P.Show)

-- ** Note2
newtype Note2 = Note2 { Note2 -> Text
unNote2 :: Text } deriving (Note2 -> Note2 -> Bool
(Note2 -> Note2 -> Bool) -> (Note2 -> Note2 -> Bool) -> Eq Note2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Note2 -> Note2 -> Bool
== :: Note2 -> Note2 -> Bool
$c/= :: Note2 -> Note2 -> Bool
/= :: Note2 -> Note2 -> Bool
P.Eq, Int -> Note2 -> ShowS
[Note2] -> ShowS
Note2 -> [Char]
(Int -> Note2 -> ShowS)
-> (Note2 -> [Char]) -> ([Note2] -> ShowS) -> Show Note2
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Note2 -> ShowS
showsPrec :: Int -> Note2 -> ShowS
$cshow :: Note2 -> [Char]
show :: Note2 -> [Char]
$cshowList :: [Note2] -> ShowS
showList :: [Note2] -> ShowS
P.Show)

-- ** OnlyPerformedBy
newtype OnlyPerformedBy = OnlyPerformedBy { OnlyPerformedBy -> Bool
unOnlyPerformedBy :: Bool } deriving (OnlyPerformedBy -> OnlyPerformedBy -> Bool
(OnlyPerformedBy -> OnlyPerformedBy -> Bool)
-> (OnlyPerformedBy -> OnlyPerformedBy -> Bool)
-> Eq OnlyPerformedBy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OnlyPerformedBy -> OnlyPerformedBy -> Bool
== :: OnlyPerformedBy -> OnlyPerformedBy -> Bool
$c/= :: OnlyPerformedBy -> OnlyPerformedBy -> Bool
/= :: OnlyPerformedBy -> OnlyPerformedBy -> Bool
P.Eq, Int -> OnlyPerformedBy -> ShowS
[OnlyPerformedBy] -> ShowS
OnlyPerformedBy -> [Char]
(Int -> OnlyPerformedBy -> ShowS)
-> (OnlyPerformedBy -> [Char])
-> ([OnlyPerformedBy] -> ShowS)
-> Show OnlyPerformedBy
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OnlyPerformedBy -> ShowS
showsPrec :: Int -> OnlyPerformedBy -> ShowS
$cshow :: OnlyPerformedBy -> [Char]
show :: OnlyPerformedBy -> [Char]
$cshowList :: [OnlyPerformedBy] -> ShowS
showList :: [OnlyPerformedBy] -> ShowS
P.Show)

-- ** Order
newtype Order = Order { Order -> Text
unOrder :: Text } deriving (Order -> Order -> Bool
(Order -> Order -> Bool) -> (Order -> Order -> Bool) -> Eq Order
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Order -> Order -> Bool
== :: Order -> Order -> Bool
$c/= :: Order -> Order -> Bool
/= :: Order -> Order -> Bool
P.Eq, Int -> Order -> ShowS
[Order] -> ShowS
Order -> [Char]
(Int -> Order -> ShowS)
-> (Order -> [Char]) -> ([Order] -> ShowS) -> Show Order
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Order -> ShowS
showsPrec :: Int -> Order -> ShowS
$cshow :: Order -> [Char]
show :: Order -> [Char]
$cshowList :: [Order] -> ShowS
showList :: [Order] -> ShowS
P.Show)

-- ** Org
newtype Org = Org { Org -> Text
unOrg :: Text } deriving (Org -> Org -> Bool
(Org -> Org -> Bool) -> (Org -> Org -> Bool) -> Eq Org
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Org -> Org -> Bool
== :: Org -> Org -> Bool
$c/= :: Org -> Org -> Bool
/= :: Org -> Org -> Bool
P.Eq, Int -> Org -> ShowS
[Org] -> ShowS
Org -> [Char]
(Int -> Org -> ShowS)
-> (Org -> [Char]) -> ([Org] -> ShowS) -> Show Org
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Org -> ShowS
showsPrec :: Int -> Org -> ShowS
$cshow :: Org -> [Char]
show :: Org -> [Char]
$cshowList :: [Org] -> ShowS
showList :: [Org] -> ShowS
P.Show)

-- ** Owner
newtype Owner = Owner { Owner -> Text
unOwner :: Text } deriving (Owner -> Owner -> Bool
(Owner -> Owner -> Bool) -> (Owner -> Owner -> Bool) -> Eq Owner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Owner -> Owner -> Bool
== :: Owner -> Owner -> Bool
$c/= :: Owner -> Owner -> Bool
/= :: Owner -> Owner -> Bool
P.Eq, Int -> Owner -> ShowS
[Owner] -> ShowS
Owner -> [Char]
(Int -> Owner -> ShowS)
-> (Owner -> [Char]) -> ([Owner] -> ShowS) -> Show Owner
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Owner -> ShowS
showsPrec :: Int -> Owner -> ShowS
$cshow :: Owner -> [Char]
show :: Owner -> [Char]
$cshowList :: [Owner] -> ShowS
showList :: [Owner] -> ShowS
P.Show)

-- ** Page
newtype Page = Page { Page -> Int
unPage :: Int } deriving (Page -> Page -> Bool
(Page -> Page -> Bool) -> (Page -> Page -> Bool) -> Eq Page
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Page -> Page -> Bool
== :: Page -> Page -> Bool
$c/= :: Page -> Page -> Bool
/= :: Page -> Page -> Bool
P.Eq, Int -> Page -> ShowS
[Page] -> ShowS
Page -> [Char]
(Int -> Page -> ShowS)
-> (Page -> [Char]) -> ([Page] -> ShowS) -> Show Page
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Page -> ShowS
showsPrec :: Int -> Page -> ShowS
$cshow :: Page -> [Char]
show :: Page -> [Char]
$cshowList :: [Page] -> ShowS
showList :: [Page] -> ShowS
P.Show)

-- ** PageName
newtype PageName = PageName { PageName -> Text
unPageName :: Text } deriving (PageName -> PageName -> Bool
(PageName -> PageName -> Bool)
-> (PageName -> PageName -> Bool) -> Eq PageName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PageName -> PageName -> Bool
== :: PageName -> PageName -> Bool
$c/= :: PageName -> PageName -> Bool
/= :: PageName -> PageName -> Bool
P.Eq, Int -> PageName -> ShowS
[PageName] -> ShowS
PageName -> [Char]
(Int -> PageName -> ShowS)
-> (PageName -> [Char]) -> ([PageName] -> ShowS) -> Show PageName
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PageName -> ShowS
showsPrec :: Int -> PageName -> ShowS
$cshow :: PageName -> [Char]
show :: PageName -> [Char]
$cshowList :: [PageName] -> ShowS
showList :: [PageName] -> ShowS
P.Show)

-- ** ParamBinary
newtype ParamBinary = ParamBinary { ParamBinary -> Bool
unParamBinary :: Bool } deriving (ParamBinary -> ParamBinary -> Bool
(ParamBinary -> ParamBinary -> Bool)
-> (ParamBinary -> ParamBinary -> Bool) -> Eq ParamBinary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParamBinary -> ParamBinary -> Bool
== :: ParamBinary -> ParamBinary -> Bool
$c/= :: ParamBinary -> ParamBinary -> Bool
/= :: ParamBinary -> ParamBinary -> Bool
P.Eq, Int -> ParamBinary -> ShowS
[ParamBinary] -> ShowS
ParamBinary -> [Char]
(Int -> ParamBinary -> ShowS)
-> (ParamBinary -> [Char])
-> ([ParamBinary] -> ShowS)
-> Show ParamBinary
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParamBinary -> ShowS
showsPrec :: Int -> ParamBinary -> ShowS
$cshow :: ParamBinary -> [Char]
show :: ParamBinary -> [Char]
$cshowList :: [ParamBinary] -> ShowS
showList :: [ParamBinary] -> ShowS
P.Show)

-- ** ParamDate
newtype ParamDate = ParamDate { ParamDate -> Date
unParamDate :: Date } deriving (ParamDate -> ParamDate -> Bool
(ParamDate -> ParamDate -> Bool)
-> (ParamDate -> ParamDate -> Bool) -> Eq ParamDate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParamDate -> ParamDate -> Bool
== :: ParamDate -> ParamDate -> Bool
$c/= :: ParamDate -> ParamDate -> Bool
/= :: ParamDate -> ParamDate -> Bool
P.Eq, Int -> ParamDate -> ShowS
[ParamDate] -> ShowS
ParamDate -> [Char]
(Int -> ParamDate -> ShowS)
-> (ParamDate -> [Char])
-> ([ParamDate] -> ShowS)
-> Show ParamDate
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParamDate -> ShowS
showsPrec :: Int -> ParamDate -> ShowS
$cshow :: ParamDate -> [Char]
show :: ParamDate -> [Char]
$cshowList :: [ParamDate] -> ShowS
showList :: [ParamDate] -> ShowS
P.Show)

-- ** ParamType
newtype ParamType = ParamType { ParamType -> E'Type2
unParamType :: E'Type2 } deriving (ParamType -> ParamType -> Bool
(ParamType -> ParamType -> Bool)
-> (ParamType -> ParamType -> Bool) -> Eq ParamType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParamType -> ParamType -> Bool
== :: ParamType -> ParamType -> Bool
$c/= :: ParamType -> ParamType -> Bool
/= :: ParamType -> ParamType -> Bool
P.Eq, Int -> ParamType -> ShowS
[ParamType] -> ShowS
ParamType -> [Char]
(Int -> ParamType -> ShowS)
-> (ParamType -> [Char])
-> ([ParamType] -> ShowS)
-> Show ParamType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParamType -> ShowS
showsPrec :: Int -> ParamType -> ShowS
$cshow :: ParamType -> [Char]
show :: ParamType -> [Char]
$cshowList :: [ParamType] -> ShowS
showList :: [ParamType] -> ShowS
P.Show)

-- ** ParamType2
newtype ParamType2 = ParamType2 { ParamType2 -> E'Type3
unParamType2 :: E'Type3 } deriving (ParamType2 -> ParamType2 -> Bool
(ParamType2 -> ParamType2 -> Bool)
-> (ParamType2 -> ParamType2 -> Bool) -> Eq ParamType2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParamType2 -> ParamType2 -> Bool
== :: ParamType2 -> ParamType2 -> Bool
$c/= :: ParamType2 -> ParamType2 -> Bool
/= :: ParamType2 -> ParamType2 -> Bool
P.Eq, Int -> ParamType2 -> ShowS
[ParamType2] -> ShowS
ParamType2 -> [Char]
(Int -> ParamType2 -> ShowS)
-> (ParamType2 -> [Char])
-> ([ParamType2] -> ShowS)
-> Show ParamType2
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParamType2 -> ShowS
showsPrec :: Int -> ParamType2 -> ShowS
$cshow :: ParamType2 -> [Char]
show :: ParamType2 -> [Char]
$cshowList :: [ParamType2] -> ShowS
showList :: [ParamType2] -> ShowS
P.Show)

-- ** ParamTypeText
newtype ParamTypeText = ParamTypeText { ParamTypeText -> Text
unParamTypeText :: Text } deriving (ParamTypeText -> ParamTypeText -> Bool
(ParamTypeText -> ParamTypeText -> Bool)
-> (ParamTypeText -> ParamTypeText -> Bool) -> Eq ParamTypeText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParamTypeText -> ParamTypeText -> Bool
== :: ParamTypeText -> ParamTypeText -> Bool
$c/= :: ParamTypeText -> ParamTypeText -> Bool
/= :: ParamTypeText -> ParamTypeText -> Bool
P.Eq, Int -> ParamTypeText -> ShowS
[ParamTypeText] -> ShowS
ParamTypeText -> [Char]
(Int -> ParamTypeText -> ShowS)
-> (ParamTypeText -> [Char])
-> ([ParamTypeText] -> ShowS)
-> Show ParamTypeText
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParamTypeText -> ShowS
showsPrec :: Int -> ParamTypeText -> ShowS
$cshow :: ParamTypeText -> [Char]
show :: ParamTypeText -> [Char]
$cshowList :: [ParamTypeText] -> ShowS
showList :: [ParamTypeText] -> ShowS
P.Show)

-- ** Path
newtype Path = Path { Path -> Text
unPath :: Text } deriving (Path -> Path -> Bool
(Path -> Path -> Bool) -> (Path -> Path -> Bool) -> Eq Path
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Path -> Path -> Bool
== :: Path -> Path -> Bool
$c/= :: Path -> Path -> Bool
/= :: Path -> Path -> Bool
P.Eq, Int -> Path -> ShowS
[Path] -> ShowS
Path -> [Char]
(Int -> Path -> ShowS)
-> (Path -> [Char]) -> ([Path] -> ShowS) -> Show Path
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Path -> ShowS
showsPrec :: Int -> Path -> ShowS
$cshow :: Path -> [Char]
show :: Path -> [Char]
$cshowList :: [Path] -> ShowS
showList :: [Path] -> ShowS
P.Show)

-- ** Pattern
newtype Pattern = Pattern { Pattern -> Text
unPattern :: Text } deriving (Pattern -> Pattern -> Bool
(Pattern -> Pattern -> Bool)
-> (Pattern -> Pattern -> Bool) -> Eq Pattern
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pattern -> Pattern -> Bool
== :: Pattern -> Pattern -> Bool
$c/= :: Pattern -> Pattern -> Bool
/= :: Pattern -> Pattern -> Bool
P.Eq, Int -> Pattern -> ShowS
[Pattern] -> ShowS
Pattern -> [Char]
(Int -> Pattern -> ShowS)
-> (Pattern -> [Char]) -> ([Pattern] -> ShowS) -> Show Pattern
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pattern -> ShowS
showsPrec :: Int -> Pattern -> ShowS
$cshow :: Pattern -> [Char]
show :: Pattern -> [Char]
$cshowList :: [Pattern] -> ShowS
showList :: [Pattern] -> ShowS
P.Show)

-- ** PerPage
newtype PerPage = PerPage { PerPage -> Int
unPerPage :: Int } deriving (PerPage -> PerPage -> Bool
(PerPage -> PerPage -> Bool)
-> (PerPage -> PerPage -> Bool) -> Eq PerPage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PerPage -> PerPage -> Bool
== :: PerPage -> PerPage -> Bool
$c/= :: PerPage -> PerPage -> Bool
/= :: PerPage -> PerPage -> Bool
P.Eq, Int -> PerPage -> ShowS
[PerPage] -> ShowS
PerPage -> [Char]
(Int -> PerPage -> ShowS)
-> (PerPage -> [Char]) -> ([PerPage] -> ShowS) -> Show PerPage
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PerPage -> ShowS
showsPrec :: Int -> PerPage -> ShowS
$cshow :: PerPage -> [Char]
show :: PerPage -> [Char]
$cshowList :: [PerPage] -> ShowS
showList :: [PerPage] -> ShowS
P.Show)

-- ** Position
newtype Position = Position { Position -> Integer
unPosition :: Integer } deriving (Position -> Position -> Bool
(Position -> Position -> Bool)
-> (Position -> Position -> Bool) -> Eq Position
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
/= :: Position -> Position -> Bool
P.Eq, Int -> Position -> ShowS
[Position] -> ShowS
Position -> [Char]
(Int -> Position -> ShowS)
-> (Position -> [Char]) -> ([Position] -> ShowS) -> Show Position
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Position -> ShowS
showsPrec :: Int -> Position -> ShowS
$cshow :: Position -> [Char]
show :: Position -> [Char]
$cshowList :: [Position] -> ShowS
showList :: [Position] -> ShowS
P.Show)

-- ** Poster
newtype Poster = Poster { Poster -> Text
unPoster :: Text } deriving (Poster -> Poster -> Bool
(Poster -> Poster -> Bool)
-> (Poster -> Poster -> Bool) -> Eq Poster
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Poster -> Poster -> Bool
== :: Poster -> Poster -> Bool
$c/= :: Poster -> Poster -> Bool
/= :: Poster -> Poster -> Bool
P.Eq, Int -> Poster -> ShowS
[Poster] -> ShowS
Poster -> [Char]
(Int -> Poster -> ShowS)
-> (Poster -> [Char]) -> ([Poster] -> ShowS) -> Show Poster
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Poster -> ShowS
showsPrec :: Int -> Poster -> ShowS
$cshow :: Poster -> [Char]
show :: Poster -> [Char]
$cshowList :: [Poster] -> ShowS
showList :: [Poster] -> ShowS
P.Show)

-- ** PreRelease
newtype PreRelease = PreRelease { PreRelease -> Bool
unPreRelease :: Bool } deriving (PreRelease -> PreRelease -> Bool
(PreRelease -> PreRelease -> Bool)
-> (PreRelease -> PreRelease -> Bool) -> Eq PreRelease
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PreRelease -> PreRelease -> Bool
== :: PreRelease -> PreRelease -> Bool
$c/= :: PreRelease -> PreRelease -> Bool
/= :: PreRelease -> PreRelease -> Bool
P.Eq, Int -> PreRelease -> ShowS
[PreRelease] -> ShowS
PreRelease -> [Char]
(Int -> PreRelease -> ShowS)
-> (PreRelease -> [Char])
-> ([PreRelease] -> ShowS)
-> Show PreRelease
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PreRelease -> ShowS
showsPrec :: Int -> PreRelease -> ShowS
$cshow :: PreRelease -> [Char]
show :: PreRelease -> [Char]
$cshowList :: [PreRelease] -> ShowS
showList :: [PreRelease] -> ShowS
P.Show)

-- ** PriorityOwnerId
newtype PriorityOwnerId = PriorityOwnerId { PriorityOwnerId -> Integer
unPriorityOwnerId :: Integer } deriving (PriorityOwnerId -> PriorityOwnerId -> Bool
(PriorityOwnerId -> PriorityOwnerId -> Bool)
-> (PriorityOwnerId -> PriorityOwnerId -> Bool)
-> Eq PriorityOwnerId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PriorityOwnerId -> PriorityOwnerId -> Bool
== :: PriorityOwnerId -> PriorityOwnerId -> Bool
$c/= :: PriorityOwnerId -> PriorityOwnerId -> Bool
/= :: PriorityOwnerId -> PriorityOwnerId -> Bool
P.Eq, Int -> PriorityOwnerId -> ShowS
[PriorityOwnerId] -> ShowS
PriorityOwnerId -> [Char]
(Int -> PriorityOwnerId -> ShowS)
-> (PriorityOwnerId -> [Char])
-> ([PriorityOwnerId] -> ShowS)
-> Show PriorityOwnerId
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PriorityOwnerId -> ShowS
showsPrec :: Int -> PriorityOwnerId -> ShowS
$cshow :: PriorityOwnerId -> [Char]
show :: PriorityOwnerId -> [Char]
$cshowList :: [PriorityOwnerId] -> ShowS
showList :: [PriorityOwnerId] -> ShowS
P.Show)

-- ** PriorityRepoId
newtype PriorityRepoId = PriorityRepoId { PriorityRepoId -> Integer
unPriorityRepoId :: Integer } deriving (PriorityRepoId -> PriorityRepoId -> Bool
(PriorityRepoId -> PriorityRepoId -> Bool)
-> (PriorityRepoId -> PriorityRepoId -> Bool) -> Eq PriorityRepoId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PriorityRepoId -> PriorityRepoId -> Bool
== :: PriorityRepoId -> PriorityRepoId -> Bool
$c/= :: PriorityRepoId -> PriorityRepoId -> Bool
/= :: PriorityRepoId -> PriorityRepoId -> Bool
P.Eq, Int -> PriorityRepoId -> ShowS
[PriorityRepoId] -> ShowS
PriorityRepoId -> [Char]
(Int -> PriorityRepoId -> ShowS)
-> (PriorityRepoId -> [Char])
-> ([PriorityRepoId] -> ShowS)
-> Show PriorityRepoId
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PriorityRepoId -> ShowS
showsPrec :: Int -> PriorityRepoId -> ShowS
$cshow :: PriorityRepoId -> [Char]
show :: PriorityRepoId -> [Char]
$cshowList :: [PriorityRepoId] -> ShowS
showList :: [PriorityRepoId] -> ShowS
P.Show)

-- ** Private
newtype Private = Private { Private -> Bool
unPrivate :: Bool } deriving (Private -> Private -> Bool
(Private -> Private -> Bool)
-> (Private -> Private -> Bool) -> Eq Private
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Private -> Private -> Bool
== :: Private -> Private -> Bool
$c/= :: Private -> Private -> Bool
/= :: Private -> Private -> Bool
P.Eq, Int -> Private -> ShowS
[Private] -> ShowS
Private -> [Char]
(Int -> Private -> ShowS)
-> (Private -> [Char]) -> ([Private] -> ShowS) -> Show Private
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Private -> ShowS
showsPrec :: Int -> Private -> ShowS
$cshow :: Private -> [Char]
show :: Private -> [Char]
$cshowList :: [Private] -> ShowS
showList :: [Private] -> ShowS
P.Show)

-- ** Purge
newtype Purge = Purge { Purge -> Bool
unPurge :: Bool } deriving (Purge -> Purge -> Bool
(Purge -> Purge -> Bool) -> (Purge -> Purge -> Bool) -> Eq Purge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Purge -> Purge -> Bool
== :: Purge -> Purge -> Bool
$c/= :: Purge -> Purge -> Bool
/= :: Purge -> Purge -> Bool
P.Eq, Int -> Purge -> ShowS
[Purge] -> ShowS
Purge -> [Char]
(Int -> Purge -> ShowS)
-> (Purge -> [Char]) -> ([Purge] -> ShowS) -> Show Purge
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Purge -> ShowS
showsPrec :: Int -> Purge -> ShowS
$cshow :: Purge -> [Char]
show :: Purge -> [Char]
$cshowList :: [Purge] -> ShowS
showList :: [Purge] -> ShowS
P.Show)

-- ** Q
newtype Q = Q { Q -> Text
unQ :: Text } deriving (Q -> Q -> Bool
(Q -> Q -> Bool) -> (Q -> Q -> Bool) -> Eq Q
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Q -> Q -> Bool
== :: Q -> Q -> Bool
$c/= :: Q -> Q -> Bool
/= :: Q -> Q -> Bool
P.Eq, Int -> Q -> ShowS
[Q] -> ShowS
Q -> [Char]
(Int -> Q -> ShowS) -> (Q -> [Char]) -> ([Q] -> ShowS) -> Show Q
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Q -> ShowS
showsPrec :: Int -> Q -> ShowS
$cshow :: Q -> [Char]
show :: Q -> [Char]
$cshowList :: [Q] -> ShowS
showList :: [Q] -> ShowS
P.Show)

-- ** Recursive
newtype Recursive = Recursive { Recursive -> Bool
unRecursive :: Bool } deriving (Recursive -> Recursive -> Bool
(Recursive -> Recursive -> Bool)
-> (Recursive -> Recursive -> Bool) -> Eq Recursive
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Recursive -> Recursive -> Bool
== :: Recursive -> Recursive -> Bool
$c/= :: Recursive -> Recursive -> Bool
/= :: Recursive -> Recursive -> Bool
P.Eq, Int -> Recursive -> ShowS
[Recursive] -> ShowS
Recursive -> [Char]
(Int -> Recursive -> ShowS)
-> (Recursive -> [Char])
-> ([Recursive] -> ShowS)
-> Show Recursive
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Recursive -> ShowS
showsPrec :: Int -> Recursive -> ShowS
$cshow :: Recursive -> [Char]
show :: Recursive -> [Char]
$cshowList :: [Recursive] -> ShowS
showList :: [Recursive] -> ShowS
P.Show)

-- ** Ref
newtype Ref = Ref { Ref -> Text
unRef :: Text } deriving (Ref -> Ref -> Bool
(Ref -> Ref -> Bool) -> (Ref -> Ref -> Bool) -> Eq Ref
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ref -> Ref -> Bool
== :: Ref -> Ref -> Bool
$c/= :: Ref -> Ref -> Bool
/= :: Ref -> Ref -> Bool
P.Eq, Int -> Ref -> ShowS
[Ref] -> ShowS
Ref -> [Char]
(Int -> Ref -> ShowS)
-> (Ref -> [Char]) -> ([Ref] -> ShowS) -> Show Ref
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ref -> ShowS
showsPrec :: Int -> Ref -> ShowS
$cshow :: Ref -> [Char]
show :: Ref -> [Char]
$cshowList :: [Ref] -> ShowS
showList :: [Ref] -> ShowS
P.Show)

-- ** Repo
newtype Repo = Repo { Repo -> Text
unRepo :: Text } deriving (Repo -> Repo -> Bool
(Repo -> Repo -> Bool) -> (Repo -> Repo -> Bool) -> Eq Repo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Repo -> Repo -> Bool
== :: Repo -> Repo -> Bool
$c/= :: Repo -> Repo -> Bool
/= :: Repo -> Repo -> Bool
P.Eq, Int -> Repo -> ShowS
[Repo] -> ShowS
Repo -> [Char]
(Int -> Repo -> ShowS)
-> (Repo -> [Char]) -> ([Repo] -> ShowS) -> Show Repo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Repo -> ShowS
showsPrec :: Int -> Repo -> ShowS
$cshow :: Repo -> [Char]
show :: Repo -> [Char]
$cshowList :: [Repo] -> ShowS
showList :: [Repo] -> ShowS
P.Show)

-- ** ReviewRequested
newtype ReviewRequested = ReviewRequested { ReviewRequested -> Bool
unReviewRequested :: Bool } deriving (ReviewRequested -> ReviewRequested -> Bool
(ReviewRequested -> ReviewRequested -> Bool)
-> (ReviewRequested -> ReviewRequested -> Bool)
-> Eq ReviewRequested
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReviewRequested -> ReviewRequested -> Bool
== :: ReviewRequested -> ReviewRequested -> Bool
$c/= :: ReviewRequested -> ReviewRequested -> Bool
/= :: ReviewRequested -> ReviewRequested -> Bool
P.Eq, Int -> ReviewRequested -> ShowS
[ReviewRequested] -> ShowS
ReviewRequested -> [Char]
(Int -> ReviewRequested -> ShowS)
-> (ReviewRequested -> [Char])
-> ([ReviewRequested] -> ShowS)
-> Show ReviewRequested
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReviewRequested -> ShowS
showsPrec :: Int -> ReviewRequested -> ShowS
$cshow :: ReviewRequested -> [Char]
show :: ReviewRequested -> [Char]
$cshowList :: [ReviewRequested] -> ShowS
showList :: [ReviewRequested] -> ShowS
P.Show)

-- ** Reviewed
newtype Reviewed = Reviewed { Reviewed -> Bool
unReviewed :: Bool } deriving (Reviewed -> Reviewed -> Bool
(Reviewed -> Reviewed -> Bool)
-> (Reviewed -> Reviewed -> Bool) -> Eq Reviewed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Reviewed -> Reviewed -> Bool
== :: Reviewed -> Reviewed -> Bool
$c/= :: Reviewed -> Reviewed -> Bool
/= :: Reviewed -> Reviewed -> Bool
P.Eq, Int -> Reviewed -> ShowS
[Reviewed] -> ShowS
Reviewed -> [Char]
(Int -> Reviewed -> ShowS)
-> (Reviewed -> [Char]) -> ([Reviewed] -> ShowS) -> Show Reviewed
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Reviewed -> ShowS
showsPrec :: Int -> Reviewed -> ShowS
$cshow :: Reviewed -> [Char]
show :: Reviewed -> [Char]
$cshowList :: [Reviewed] -> ShowS
showList :: [Reviewed] -> ShowS
P.Show)

-- ** Secretname
newtype Secretname = Secretname { Secretname -> Text
unSecretname :: Text } deriving (Secretname -> Secretname -> Bool
(Secretname -> Secretname -> Bool)
-> (Secretname -> Secretname -> Bool) -> Eq Secretname
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Secretname -> Secretname -> Bool
== :: Secretname -> Secretname -> Bool
$c/= :: Secretname -> Secretname -> Bool
/= :: Secretname -> Secretname -> Bool
P.Eq, Int -> Secretname -> ShowS
[Secretname] -> ShowS
Secretname -> [Char]
(Int -> Secretname -> ShowS)
-> (Secretname -> [Char])
-> ([Secretname] -> ShowS)
-> Show Secretname
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Secretname -> ShowS
showsPrec :: Int -> Secretname -> ShowS
$cshow :: Secretname -> [Char]
show :: Secretname -> [Char]
$cshowList :: [Secretname] -> ShowS
showList :: [Secretname] -> ShowS
P.Show)

-- ** Sha
newtype Sha = Sha { Sha -> Text
unSha :: Text } deriving (Sha -> Sha -> Bool
(Sha -> Sha -> Bool) -> (Sha -> Sha -> Bool) -> Eq Sha
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sha -> Sha -> Bool
== :: Sha -> Sha -> Bool
$c/= :: Sha -> Sha -> Bool
/= :: Sha -> Sha -> Bool
P.Eq, Int -> Sha -> ShowS
[Sha] -> ShowS
Sha -> [Char]
(Int -> Sha -> ShowS)
-> (Sha -> [Char]) -> ([Sha] -> ShowS) -> Show Sha
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sha -> ShowS
showsPrec :: Int -> Sha -> ShowS
$cshow :: Sha -> [Char]
show :: Sha -> [Char]
$cshowList :: [Sha] -> ShowS
showList :: [Sha] -> ShowS
P.Show)

-- ** Since
newtype Since = Since { Since -> DateTime
unSince :: DateTime } deriving (Since -> Since -> Bool
(Since -> Since -> Bool) -> (Since -> Since -> Bool) -> Eq Since
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Since -> Since -> Bool
== :: Since -> Since -> Bool
$c/= :: Since -> Since -> Bool
/= :: Since -> Since -> Bool
P.Eq, Int -> Since -> ShowS
[Since] -> ShowS
Since -> [Char]
(Int -> Since -> ShowS)
-> (Since -> [Char]) -> ([Since] -> ShowS) -> Show Since
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Since -> ShowS
showsPrec :: Int -> Since -> ShowS
$cshow :: Since -> [Char]
show :: Since -> [Char]
$cshowList :: [Since] -> ShowS
showList :: [Since] -> ShowS
P.Show)

-- ** SkipTo
newtype SkipTo = SkipTo { SkipTo -> Text
unSkipTo :: Text } deriving (SkipTo -> SkipTo -> Bool
(SkipTo -> SkipTo -> Bool)
-> (SkipTo -> SkipTo -> Bool) -> Eq SkipTo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SkipTo -> SkipTo -> Bool
== :: SkipTo -> SkipTo -> Bool
$c/= :: SkipTo -> SkipTo -> Bool
/= :: SkipTo -> SkipTo -> Bool
P.Eq, Int -> SkipTo -> ShowS
[SkipTo] -> ShowS
SkipTo -> [Char]
(Int -> SkipTo -> ShowS)
-> (SkipTo -> [Char]) -> ([SkipTo] -> ShowS) -> Show SkipTo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SkipTo -> ShowS
showsPrec :: Int -> SkipTo -> ShowS
$cshow :: SkipTo -> [Char]
show :: SkipTo -> [Char]
$cshowList :: [SkipTo] -> ShowS
showList :: [SkipTo] -> ShowS
P.Show)

-- ** Sort
newtype Sort = Sort { Sort -> Text
unSort :: Text } deriving (Sort -> Sort -> Bool
(Sort -> Sort -> Bool) -> (Sort -> Sort -> Bool) -> Eq Sort
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sort -> Sort -> Bool
== :: Sort -> Sort -> Bool
$c/= :: Sort -> Sort -> Bool
/= :: Sort -> Sort -> Bool
P.Eq, Int -> Sort -> ShowS
[Sort] -> ShowS
Sort -> [Char]
(Int -> Sort -> ShowS)
-> (Sort -> [Char]) -> ([Sort] -> ShowS) -> Show Sort
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sort -> ShowS
showsPrec :: Int -> Sort -> ShowS
$cshow :: Sort -> [Char]
show :: Sort -> [Char]
$cshowList :: [Sort] -> ShowS
showList :: [Sort] -> ShowS
P.Show)

-- ** Sort2
newtype Sort2 = Sort2 { Sort2 -> E'Sort
unSort2 :: E'Sort } deriving (Sort2 -> Sort2 -> Bool
(Sort2 -> Sort2 -> Bool) -> (Sort2 -> Sort2 -> Bool) -> Eq Sort2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sort2 -> Sort2 -> Bool
== :: Sort2 -> Sort2 -> Bool
$c/= :: Sort2 -> Sort2 -> Bool
/= :: Sort2 -> Sort2 -> Bool
P.Eq, Int -> Sort2 -> ShowS
[Sort2] -> ShowS
Sort2 -> [Char]
(Int -> Sort2 -> ShowS)
-> (Sort2 -> [Char]) -> ([Sort2] -> ShowS) -> Show Sort2
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sort2 -> ShowS
showsPrec :: Int -> Sort2 -> ShowS
$cshow :: Sort2 -> [Char]
show :: Sort2 -> [Char]
$cshowList :: [Sort2] -> ShowS
showList :: [Sort2] -> ShowS
P.Show)

-- ** Sort3
newtype Sort3 = Sort3 { Sort3 -> E'Sort2
unSort3 :: E'Sort2 } deriving (Sort3 -> Sort3 -> Bool
(Sort3 -> Sort3 -> Bool) -> (Sort3 -> Sort3 -> Bool) -> Eq Sort3
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sort3 -> Sort3 -> Bool
== :: Sort3 -> Sort3 -> Bool
$c/= :: Sort3 -> Sort3 -> Bool
/= :: Sort3 -> Sort3 -> Bool
P.Eq, Int -> Sort3 -> ShowS
[Sort3] -> ShowS
Sort3 -> [Char]
(Int -> Sort3 -> ShowS)
-> (Sort3 -> [Char]) -> ([Sort3] -> ShowS) -> Show Sort3
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sort3 -> ShowS
showsPrec :: Int -> Sort3 -> ShowS
$cshow :: Sort3 -> [Char]
show :: Sort3 -> [Char]
$cshowList :: [Sort3] -> ShowS
showList :: [Sort3] -> ShowS
P.Show)

-- ** SourceId
newtype SourceId = SourceId { SourceId -> Integer
unSourceId :: Integer } deriving (SourceId -> SourceId -> Bool
(SourceId -> SourceId -> Bool)
-> (SourceId -> SourceId -> Bool) -> Eq SourceId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SourceId -> SourceId -> Bool
== :: SourceId -> SourceId -> Bool
$c/= :: SourceId -> SourceId -> Bool
/= :: SourceId -> SourceId -> Bool
P.Eq, Int -> SourceId -> ShowS
[SourceId] -> ShowS
SourceId -> [Char]
(Int -> SourceId -> ShowS)
-> (SourceId -> [Char]) -> ([SourceId] -> ShowS) -> Show SourceId
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SourceId -> ShowS
showsPrec :: Int -> SourceId -> ShowS
$cshow :: SourceId -> [Char]
show :: SourceId -> [Char]
$cshowList :: [SourceId] -> ShowS
showList :: [SourceId] -> ShowS
P.Show)

-- ** StarredBy
newtype StarredBy = StarredBy { StarredBy -> Integer
unStarredBy :: Integer } deriving (StarredBy -> StarredBy -> Bool
(StarredBy -> StarredBy -> Bool)
-> (StarredBy -> StarredBy -> Bool) -> Eq StarredBy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StarredBy -> StarredBy -> Bool
== :: StarredBy -> StarredBy -> Bool
$c/= :: StarredBy -> StarredBy -> Bool
/= :: StarredBy -> StarredBy -> Bool
P.Eq, Int -> StarredBy -> ShowS
[StarredBy] -> ShowS
StarredBy -> [Char]
(Int -> StarredBy -> ShowS)
-> (StarredBy -> [Char])
-> ([StarredBy] -> ShowS)
-> Show StarredBy
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StarredBy -> ShowS
showsPrec :: Int -> StarredBy -> ShowS
$cshow :: StarredBy -> [Char]
show :: StarredBy -> [Char]
$cshowList :: [StarredBy] -> ShowS
showList :: [StarredBy] -> ShowS
P.Show)

-- ** Stat
newtype Stat = Stat { Stat -> Bool
unStat :: Bool } deriving (Stat -> Stat -> Bool
(Stat -> Stat -> Bool) -> (Stat -> Stat -> Bool) -> Eq Stat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Stat -> Stat -> Bool
== :: Stat -> Stat -> Bool
$c/= :: Stat -> Stat -> Bool
/= :: Stat -> Stat -> Bool
P.Eq, Int -> Stat -> ShowS
[Stat] -> ShowS
Stat -> [Char]
(Int -> Stat -> ShowS)
-> (Stat -> [Char]) -> ([Stat] -> ShowS) -> Show Stat
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Stat -> ShowS
showsPrec :: Int -> Stat -> ShowS
$cshow :: Stat -> [Char]
show :: Stat -> [Char]
$cshowList :: [Stat] -> ShowS
showList :: [Stat] -> ShowS
P.Show)

-- ** State
newtype State = State { State -> E'State2
unState :: E'State2 } deriving (State -> State -> Bool
(State -> State -> Bool) -> (State -> State -> Bool) -> Eq State
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: State -> State -> Bool
== :: State -> State -> Bool
$c/= :: State -> State -> Bool
/= :: State -> State -> Bool
P.Eq, Int -> State -> ShowS
[State] -> ShowS
State -> [Char]
(Int -> State -> ShowS)
-> (State -> [Char]) -> ([State] -> ShowS) -> Show State
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> State -> ShowS
showsPrec :: Int -> State -> ShowS
$cshow :: State -> [Char]
show :: State -> [Char]
$cshowList :: [State] -> ShowS
showList :: [State] -> ShowS
P.Show)

-- ** State2
newtype State2 = State2 { State2 -> E'State3
unState2 :: E'State3 } deriving (State2 -> State2 -> Bool
(State2 -> State2 -> Bool)
-> (State2 -> State2 -> Bool) -> Eq State2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: State2 -> State2 -> Bool
== :: State2 -> State2 -> Bool
$c/= :: State2 -> State2 -> Bool
/= :: State2 -> State2 -> Bool
P.Eq, Int -> State2 -> ShowS
[State2] -> ShowS
State2 -> [Char]
(Int -> State2 -> ShowS)
-> (State2 -> [Char]) -> ([State2] -> ShowS) -> Show State2
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> State2 -> ShowS
showsPrec :: Int -> State2 -> ShowS
$cshow :: State2 -> [Char]
show :: State2 -> [Char]
$cshowList :: [State2] -> ShowS
showList :: [State2] -> ShowS
P.Show)

-- ** State3
newtype State3 = State3 { State3 -> E'State4
unState3 :: E'State4 } deriving (State3 -> State3 -> Bool
(State3 -> State3 -> Bool)
-> (State3 -> State3 -> Bool) -> Eq State3
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: State3 -> State3 -> Bool
== :: State3 -> State3 -> Bool
$c/= :: State3 -> State3 -> Bool
/= :: State3 -> State3 -> Bool
P.Eq, Int -> State3 -> ShowS
[State3] -> ShowS
State3 -> [Char]
(Int -> State3 -> ShowS)
-> (State3 -> [Char]) -> ([State3] -> ShowS) -> Show State3
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> State3 -> ShowS
showsPrec :: Int -> State3 -> ShowS
$cshow :: State3 -> [Char]
show :: State3 -> [Char]
$cshowList :: [State3] -> ShowS
showList :: [State3] -> ShowS
P.Show)

-- ** StateText
newtype StateText = StateText { StateText -> Text
unStateText :: Text } deriving (StateText -> StateText -> Bool
(StateText -> StateText -> Bool)
-> (StateText -> StateText -> Bool) -> Eq StateText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StateText -> StateText -> Bool
== :: StateText -> StateText -> Bool
$c/= :: StateText -> StateText -> Bool
/= :: StateText -> StateText -> Bool
P.Eq, Int -> StateText -> ShowS
[StateText] -> ShowS
StateText -> [Char]
(Int -> StateText -> ShowS)
-> (StateText -> [Char])
-> ([StateText] -> ShowS)
-> Show StateText
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StateText -> ShowS
showsPrec :: Int -> StateText -> ShowS
$cshow :: StateText -> [Char]
show :: StateText -> [Char]
$cshowList :: [StateText] -> ShowS
showList :: [StateText] -> ShowS
P.Show)

-- ** StatusTypes
newtype StatusTypes = StatusTypes { StatusTypes -> [Text]
unStatusTypes :: [Text] } deriving (StatusTypes -> StatusTypes -> Bool
(StatusTypes -> StatusTypes -> Bool)
-> (StatusTypes -> StatusTypes -> Bool) -> Eq StatusTypes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StatusTypes -> StatusTypes -> Bool
== :: StatusTypes -> StatusTypes -> Bool
$c/= :: StatusTypes -> StatusTypes -> Bool
/= :: StatusTypes -> StatusTypes -> Bool
P.Eq, Int -> StatusTypes -> ShowS
[StatusTypes] -> ShowS
StatusTypes -> [Char]
(Int -> StatusTypes -> ShowS)
-> (StatusTypes -> [Char])
-> ([StatusTypes] -> ShowS)
-> Show StatusTypes
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StatusTypes -> ShowS
showsPrec :: Int -> StatusTypes -> ShowS
$cshow :: StatusTypes -> [Char]
show :: StatusTypes -> [Char]
$cshowList :: [StatusTypes] -> ShowS
showList :: [StatusTypes] -> ShowS
P.Show)

-- ** Style
newtype Style = Style { Style -> E'Style
unStyle :: E'Style } deriving (Style -> Style -> Bool
(Style -> Style -> Bool) -> (Style -> Style -> Bool) -> Eq Style
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Style -> Style -> Bool
== :: Style -> Style -> Bool
$c/= :: Style -> Style -> Bool
/= :: Style -> Style -> Bool
P.Eq, Int -> Style -> ShowS
[Style] -> ShowS
Style -> [Char]
(Int -> Style -> ShowS)
-> (Style -> [Char]) -> ([Style] -> ShowS) -> Show Style
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Style -> ShowS
showsPrec :: Int -> Style -> ShowS
$cshow :: Style -> [Char]
show :: Style -> [Char]
$cshowList :: [Style] -> ShowS
showList :: [Style] -> ShowS
P.Show)

-- ** SubjectType
newtype SubjectType = SubjectType { SubjectType -> [E'SubjectType]
unSubjectType :: [E'SubjectType] } deriving (SubjectType -> SubjectType -> Bool
(SubjectType -> SubjectType -> Bool)
-> (SubjectType -> SubjectType -> Bool) -> Eq SubjectType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubjectType -> SubjectType -> Bool
== :: SubjectType -> SubjectType -> Bool
$c/= :: SubjectType -> SubjectType -> Bool
/= :: SubjectType -> SubjectType -> Bool
P.Eq, Int -> SubjectType -> ShowS
[SubjectType] -> ShowS
SubjectType -> [Char]
(Int -> SubjectType -> ShowS)
-> (SubjectType -> [Char])
-> ([SubjectType] -> ShowS)
-> Show SubjectType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubjectType -> ShowS
showsPrec :: Int -> SubjectType -> ShowS
$cshow :: SubjectType -> [Char]
show :: SubjectType -> [Char]
$cshowList :: [SubjectType] -> ShowS
showList :: [SubjectType] -> ShowS
P.Show)

-- ** Tag2
newtype Tag2 = Tag2 { Tag2 -> Text
unTag2 :: Text } deriving (Tag2 -> Tag2 -> Bool
(Tag2 -> Tag2 -> Bool) -> (Tag2 -> Tag2 -> Bool) -> Eq Tag2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tag2 -> Tag2 -> Bool
== :: Tag2 -> Tag2 -> Bool
$c/= :: Tag2 -> Tag2 -> Bool
/= :: Tag2 -> Tag2 -> Bool
P.Eq, Int -> Tag2 -> ShowS
[Tag2] -> ShowS
Tag2 -> [Char]
(Int -> Tag2 -> ShowS)
-> (Tag2 -> [Char]) -> ([Tag2] -> ShowS) -> Show Tag2
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tag2 -> ShowS
showsPrec :: Int -> Tag2 -> ShowS
$cshow :: Tag2 -> [Char]
show :: Tag2 -> [Char]
$cshowList :: [Tag2] -> ShowS
showList :: [Tag2] -> ShowS
P.Show)

-- ** Target
newtype Target = Target { Target -> Text
unTarget :: Text } deriving (Target -> Target -> Bool
(Target -> Target -> Bool)
-> (Target -> Target -> Bool) -> Eq Target
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Target -> Target -> Bool
== :: Target -> Target -> Bool
$c/= :: Target -> Target -> Bool
/= :: Target -> Target -> Bool
P.Eq, Int -> Target -> ShowS
[Target] -> ShowS
Target -> [Char]
(Int -> Target -> ShowS)
-> (Target -> [Char]) -> ([Target] -> ShowS) -> Show Target
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Target -> ShowS
showsPrec :: Int -> Target -> ShowS
$cshow :: Target -> [Char]
show :: Target -> [Char]
$cshowList :: [Target] -> ShowS
showList :: [Target] -> ShowS
P.Show)

-- ** Task
newtype Task = Task { Task -> Text
unTask :: Text } deriving (Task -> Task -> Bool
(Task -> Task -> Bool) -> (Task -> Task -> Bool) -> Eq Task
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Task -> Task -> Bool
== :: Task -> Task -> Bool
$c/= :: Task -> Task -> Bool
/= :: Task -> Task -> Bool
P.Eq, Int -> Task -> ShowS
[Task] -> ShowS
Task -> [Char]
(Int -> Task -> ShowS)
-> (Task -> [Char]) -> ([Task] -> ShowS) -> Show Task
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Task -> ShowS
showsPrec :: Int -> Task -> ShowS
$cshow :: Task -> [Char]
show :: Task -> [Char]
$cshowList :: [Task] -> ShowS
showList :: [Task] -> ShowS
P.Show)

-- ** Team2
newtype Team2 = Team2 { Team2 -> Text
unTeam2 :: Text } deriving (Team2 -> Team2 -> Bool
(Team2 -> Team2 -> Bool) -> (Team2 -> Team2 -> Bool) -> Eq Team2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Team2 -> Team2 -> Bool
== :: Team2 -> Team2 -> Bool
$c/= :: Team2 -> Team2 -> Bool
/= :: Team2 -> Team2 -> Bool
P.Eq, Int -> Team2 -> ShowS
[Team2] -> ShowS
Team2 -> [Char]
(Int -> Team2 -> ShowS)
-> (Team2 -> [Char]) -> ([Team2] -> ShowS) -> Show Team2
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Team2 -> ShowS
showsPrec :: Int -> Team2 -> ShowS
$cshow :: Team2 -> [Char]
show :: Team2 -> [Char]
$cshowList :: [Team2] -> ShowS
showList :: [Team2] -> ShowS
P.Show)

-- ** TeamId
newtype TeamId = TeamId { TeamId -> Integer
unTeamId :: Integer } deriving (TeamId -> TeamId -> Bool
(TeamId -> TeamId -> Bool)
-> (TeamId -> TeamId -> Bool) -> Eq TeamId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TeamId -> TeamId -> Bool
== :: TeamId -> TeamId -> Bool
$c/= :: TeamId -> TeamId -> Bool
/= :: TeamId -> TeamId -> Bool
P.Eq, Int -> TeamId -> ShowS
[TeamId] -> ShowS
TeamId -> [Char]
(Int -> TeamId -> ShowS)
-> (TeamId -> [Char]) -> ([TeamId] -> ShowS) -> Show TeamId
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TeamId -> ShowS
showsPrec :: Int -> TeamId -> ShowS
$cshow :: TeamId -> [Char]
show :: TeamId -> [Char]
$cshowList :: [TeamId] -> ShowS
showList :: [TeamId] -> ShowS
P.Show)

-- ** Template
newtype Template = Template { Template -> Bool
unTemplate :: Bool } deriving (Template -> Template -> Bool
(Template -> Template -> Bool)
-> (Template -> Template -> Bool) -> Eq Template
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Template -> Template -> Bool
== :: Template -> Template -> Bool
$c/= :: Template -> Template -> Bool
/= :: Template -> Template -> Bool
P.Eq, Int -> Template -> ShowS
[Template] -> ShowS
Template -> [Char]
(Int -> Template -> ShowS)
-> (Template -> [Char]) -> ([Template] -> ShowS) -> Show Template
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Template -> ShowS
showsPrec :: Int -> Template -> ShowS
$cshow :: Template -> [Char]
show :: Template -> [Char]
$cshowList :: [Template] -> ShowS
showList :: [Template] -> ShowS
P.Show)

-- ** TemplateOwner
newtype TemplateOwner = TemplateOwner { TemplateOwner -> Text
unTemplateOwner :: Text } deriving (TemplateOwner -> TemplateOwner -> Bool
(TemplateOwner -> TemplateOwner -> Bool)
-> (TemplateOwner -> TemplateOwner -> Bool) -> Eq TemplateOwner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TemplateOwner -> TemplateOwner -> Bool
== :: TemplateOwner -> TemplateOwner -> Bool
$c/= :: TemplateOwner -> TemplateOwner -> Bool
/= :: TemplateOwner -> TemplateOwner -> Bool
P.Eq, Int -> TemplateOwner -> ShowS
[TemplateOwner] -> ShowS
TemplateOwner -> [Char]
(Int -> TemplateOwner -> ShowS)
-> (TemplateOwner -> [Char])
-> ([TemplateOwner] -> ShowS)
-> Show TemplateOwner
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TemplateOwner -> ShowS
showsPrec :: Int -> TemplateOwner -> ShowS
$cshow :: TemplateOwner -> [Char]
show :: TemplateOwner -> [Char]
$cshowList :: [TemplateOwner] -> ShowS
showList :: [TemplateOwner] -> ShowS
P.Show)

-- ** TemplateRepo
newtype TemplateRepo = TemplateRepo { TemplateRepo -> Text
unTemplateRepo :: Text } deriving (TemplateRepo -> TemplateRepo -> Bool
(TemplateRepo -> TemplateRepo -> Bool)
-> (TemplateRepo -> TemplateRepo -> Bool) -> Eq TemplateRepo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TemplateRepo -> TemplateRepo -> Bool
== :: TemplateRepo -> TemplateRepo -> Bool
$c/= :: TemplateRepo -> TemplateRepo -> Bool
/= :: TemplateRepo -> TemplateRepo -> Bool
P.Eq, Int -> TemplateRepo -> ShowS
[TemplateRepo] -> ShowS
TemplateRepo -> [Char]
(Int -> TemplateRepo -> ShowS)
-> (TemplateRepo -> [Char])
-> ([TemplateRepo] -> ShowS)
-> Show TemplateRepo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TemplateRepo -> ShowS
showsPrec :: Int -> TemplateRepo -> ShowS
$cshow :: TemplateRepo -> [Char]
show :: TemplateRepo -> [Char]
$cshowList :: [TemplateRepo] -> ShowS
showList :: [TemplateRepo] -> ShowS
P.Show)

-- ** ToStatus
newtype ToStatus = ToStatus { ToStatus -> Text
unToStatus :: Text } deriving (ToStatus -> ToStatus -> Bool
(ToStatus -> ToStatus -> Bool)
-> (ToStatus -> ToStatus -> Bool) -> Eq ToStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ToStatus -> ToStatus -> Bool
== :: ToStatus -> ToStatus -> Bool
$c/= :: ToStatus -> ToStatus -> Bool
/= :: ToStatus -> ToStatus -> Bool
P.Eq, Int -> ToStatus -> ShowS
[ToStatus] -> ShowS
ToStatus -> [Char]
(Int -> ToStatus -> ShowS)
-> (ToStatus -> [Char]) -> ([ToStatus] -> ShowS) -> Show ToStatus
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ToStatus -> ShowS
showsPrec :: Int -> ToStatus -> ShowS
$cshow :: ToStatus -> [Char]
show :: ToStatus -> [Char]
$cshowList :: [ToStatus] -> ShowS
showList :: [ToStatus] -> ShowS
P.Show)

-- ** Token
newtype Token = Token { Token -> Text
unToken :: Text } deriving (Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
/= :: Token -> Token -> Bool
P.Eq, Int -> Token -> ShowS
[Token] -> ShowS
Token -> [Char]
(Int -> Token -> ShowS)
-> (Token -> [Char]) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Token -> ShowS
showsPrec :: Int -> Token -> ShowS
$cshow :: Token -> [Char]
show :: Token -> [Char]
$cshowList :: [Token] -> ShowS
showList :: [Token] -> ShowS
P.Show)

-- ** Topic
newtype Topic = Topic { Topic -> Bool
unTopic :: Bool } deriving (Topic -> Topic -> Bool
(Topic -> Topic -> Bool) -> (Topic -> Topic -> Bool) -> Eq Topic
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Topic -> Topic -> Bool
== :: Topic -> Topic -> Bool
$c/= :: Topic -> Topic -> Bool
/= :: Topic -> Topic -> Bool
P.Eq, Int -> Topic -> ShowS
[Topic] -> ShowS
Topic -> [Char]
(Int -> Topic -> ShowS)
-> (Topic -> [Char]) -> ([Topic] -> ShowS) -> Show Topic
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Topic -> ShowS
showsPrec :: Int -> Topic -> ShowS
$cshow :: Topic -> [Char]
show :: Topic -> [Char]
$cshowList :: [Topic] -> ShowS
showList :: [Topic] -> ShowS
P.Show)

-- ** TopicText
newtype TopicText = TopicText { TopicText -> Text
unTopicText :: Text } deriving (TopicText -> TopicText -> Bool
(TopicText -> TopicText -> Bool)
-> (TopicText -> TopicText -> Bool) -> Eq TopicText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TopicText -> TopicText -> Bool
== :: TopicText -> TopicText -> Bool
$c/= :: TopicText -> TopicText -> Bool
/= :: TopicText -> TopicText -> Bool
P.Eq, Int -> TopicText -> ShowS
[TopicText] -> ShowS
TopicText -> [Char]
(Int -> TopicText -> ShowS)
-> (TopicText -> [Char])
-> ([TopicText] -> ShowS)
-> Show TopicText
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TopicText -> ShowS
showsPrec :: Int -> TopicText -> ShowS
$cshow :: TopicText -> [Char]
show :: TopicText -> [Char]
$cshowList :: [TopicText] -> ShowS
showList :: [TopicText] -> ShowS
P.Show)

-- ** Uid
newtype Uid = Uid { Uid -> Integer
unUid :: Integer } deriving (Uid -> Uid -> Bool
(Uid -> Uid -> Bool) -> (Uid -> Uid -> Bool) -> Eq Uid
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Uid -> Uid -> Bool
== :: Uid -> Uid -> Bool
$c/= :: Uid -> Uid -> Bool
/= :: Uid -> Uid -> Bool
P.Eq, Int -> Uid -> ShowS
[Uid] -> ShowS
Uid -> [Char]
(Int -> Uid -> ShowS)
-> (Uid -> [Char]) -> ([Uid] -> ShowS) -> Show Uid
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Uid -> ShowS
showsPrec :: Int -> Uid -> ShowS
$cshow :: Uid -> [Char]
show :: Uid -> [Char]
$cshowList :: [Uid] -> ShowS
showList :: [Uid] -> ShowS
P.Show)

-- ** User2
newtype User2 = User2 { User2 -> Text
unUser2 :: Text } deriving (User2 -> User2 -> Bool
(User2 -> User2 -> Bool) -> (User2 -> User2 -> Bool) -> Eq User2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: User2 -> User2 -> Bool
== :: User2 -> User2 -> Bool
$c/= :: User2 -> User2 -> Bool
/= :: User2 -> User2 -> Bool
P.Eq, Int -> User2 -> ShowS
[User2] -> ShowS
User2 -> [Char]
(Int -> User2 -> ShowS)
-> (User2 -> [Char]) -> ([User2] -> ShowS) -> Show User2
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> User2 -> ShowS
showsPrec :: Int -> User2 -> ShowS
$cshow :: User2 -> [Char]
show :: User2 -> [Char]
$cshowList :: [User2] -> ShowS
showList :: [User2] -> ShowS
P.Show)

-- ** UserId
newtype UserId = UserId { UserId -> Int
unUserId :: Int } deriving (UserId -> UserId -> Bool
(UserId -> UserId -> Bool)
-> (UserId -> UserId -> Bool) -> Eq UserId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserId -> UserId -> Bool
== :: UserId -> UserId -> Bool
$c/= :: UserId -> UserId -> Bool
/= :: UserId -> UserId -> Bool
P.Eq, Int -> UserId -> ShowS
[UserId] -> ShowS
UserId -> [Char]
(Int -> UserId -> ShowS)
-> (UserId -> [Char]) -> ([UserId] -> ShowS) -> Show UserId
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserId -> ShowS
showsPrec :: Int -> UserId -> ShowS
$cshow :: UserId -> [Char]
show :: UserId -> [Char]
$cshowList :: [UserId] -> ShowS
showList :: [UserId] -> ShowS
P.Show)

-- ** Username
newtype Username = Username { Username -> Text
unUsername :: Text } deriving (Username -> Username -> Bool
(Username -> Username -> Bool)
-> (Username -> Username -> Bool) -> Eq Username
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Username -> Username -> Bool
== :: Username -> Username -> Bool
$c/= :: Username -> Username -> Bool
/= :: Username -> Username -> Bool
P.Eq, Int -> Username -> ShowS
[Username] -> ShowS
Username -> [Char]
(Int -> Username -> ShowS)
-> (Username -> [Char]) -> ([Username] -> ShowS) -> Show Username
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Username -> ShowS
showsPrec :: Int -> Username -> ShowS
$cshow :: Username -> [Char]
show :: Username -> [Char]
$cshowList :: [Username] -> ShowS
showList :: [Username] -> ShowS
P.Show)

-- ** Variablename
newtype Variablename = Variablename { Variablename -> Text
unVariablename :: Text } deriving (Variablename -> Variablename -> Bool
(Variablename -> Variablename -> Bool)
-> (Variablename -> Variablename -> Bool) -> Eq Variablename
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Variablename -> Variablename -> Bool
== :: Variablename -> Variablename -> Bool
$c/= :: Variablename -> Variablename -> Bool
/= :: Variablename -> Variablename -> Bool
P.Eq, Int -> Variablename -> ShowS
[Variablename] -> ShowS
Variablename -> [Char]
(Int -> Variablename -> ShowS)
-> (Variablename -> [Char])
-> ([Variablename] -> ShowS)
-> Show Variablename
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Variablename -> ShowS
showsPrec :: Int -> Variablename -> ShowS
$cshow :: Variablename -> [Char]
show :: Variablename -> [Char]
$cshowList :: [Variablename] -> ShowS
showList :: [Variablename] -> ShowS
P.Show)

-- ** Verification
newtype Verification = Verification { Verification -> Bool
unVerification :: Bool } deriving (Verification -> Verification -> Bool
(Verification -> Verification -> Bool)
-> (Verification -> Verification -> Bool) -> Eq Verification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Verification -> Verification -> Bool
== :: Verification -> Verification -> Bool
$c/= :: Verification -> Verification -> Bool
/= :: Verification -> Verification -> Bool
P.Eq, Int -> Verification -> ShowS
[Verification] -> ShowS
Verification -> [Char]
(Int -> Verification -> ShowS)
-> (Verification -> [Char])
-> ([Verification] -> ShowS)
-> Show Verification
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Verification -> ShowS
showsPrec :: Int -> Verification -> ShowS
$cshow :: Verification -> [Char]
show :: Verification -> [Char]
$cshowList :: [Verification] -> ShowS
showList :: [Verification] -> ShowS
P.Show)

-- ** Version
newtype Version = Version { Version -> Text
unVersion :: Text } deriving (Version -> Version -> Bool
(Version -> Version -> Bool)
-> (Version -> Version -> Bool) -> Eq Version
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Version -> Version -> Bool
== :: Version -> Version -> Bool
$c/= :: Version -> Version -> Bool
/= :: Version -> Version -> Bool
P.Eq, Int -> Version -> ShowS
[Version] -> ShowS
Version -> [Char]
(Int -> Version -> ShowS)
-> (Version -> [Char]) -> ([Version] -> ShowS) -> Show Version
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Version -> ShowS
showsPrec :: Int -> Version -> ShowS
$cshow :: Version -> [Char]
show :: Version -> [Char]
$cshowList :: [Version] -> ShowS
showList :: [Version] -> ShowS
P.Show)

-- ** Whitespace
newtype Whitespace = Whitespace { Whitespace -> E'Whitespace
unWhitespace :: E'Whitespace } deriving (Whitespace -> Whitespace -> Bool
(Whitespace -> Whitespace -> Bool)
-> (Whitespace -> Whitespace -> Bool) -> Eq Whitespace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Whitespace -> Whitespace -> Bool
== :: Whitespace -> Whitespace -> Bool
$c/= :: Whitespace -> Whitespace -> Bool
/= :: Whitespace -> Whitespace -> Bool
P.Eq, Int -> Whitespace -> ShowS
[Whitespace] -> ShowS
Whitespace -> [Char]
(Int -> Whitespace -> ShowS)
-> (Whitespace -> [Char])
-> ([Whitespace] -> ShowS)
-> Show Whitespace
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Whitespace -> ShowS
showsPrec :: Int -> Whitespace -> ShowS
$cshow :: Whitespace -> [Char]
show :: Whitespace -> [Char]
$cshowList :: [Whitespace] -> ShowS
showList :: [Whitespace] -> ShowS
P.Show)

-- * Models


-- ** APIError
-- | APIError
-- APIError is an api error with a message
data APIError = APIError
  { APIError -> Maybe Text
aPIErrorMessage :: !(Maybe Text) -- ^ "message"
  , APIError -> Maybe Text
aPIErrorUrl :: !(Maybe Text) -- ^ "url"
  } deriving (Int -> APIError -> ShowS
[APIError] -> ShowS
APIError -> [Char]
(Int -> APIError -> ShowS)
-> (APIError -> [Char]) -> ([APIError] -> ShowS) -> Show APIError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> APIError -> ShowS
showsPrec :: Int -> APIError -> ShowS
$cshow :: APIError -> [Char]
show :: APIError -> [Char]
$cshowList :: [APIError] -> ShowS
showList :: [APIError] -> ShowS
P.Show, APIError -> APIError -> Bool
(APIError -> APIError -> Bool)
-> (APIError -> APIError -> Bool) -> Eq APIError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: APIError -> APIError -> Bool
== :: APIError -> APIError -> Bool
$c/= :: APIError -> APIError -> Bool
/= :: APIError -> APIError -> Bool
P.Eq, P.Typeable)

-- | FromJSON APIError
instance A.FromJSON APIError where
  parseJSON :: Value -> Parser APIError
parseJSON = [Char] -> (Object -> Parser APIError) -> Value -> Parser APIError
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"APIError" ((Object -> Parser APIError) -> Value -> Parser APIError)
-> (Object -> Parser APIError) -> Value -> Parser APIError
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Text -> APIError
APIError
      (Maybe Text -> Maybe Text -> APIError)
-> Parser (Maybe Text) -> Parser (Maybe Text -> APIError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"message")
      Parser (Maybe Text -> APIError)
-> Parser (Maybe Text) -> Parser APIError
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")

-- | ToJSON APIError
instance A.ToJSON APIError where
  toJSON :: APIError -> Value
toJSON APIError {Maybe Text
$sel:aPIErrorMessage:APIError :: APIError -> Maybe Text
$sel:aPIErrorUrl:APIError :: APIError -> Maybe Text
aPIErrorMessage :: Maybe Text
aPIErrorUrl :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"message" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
aPIErrorMessage
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
aPIErrorUrl
      ]


-- | Construct a value of type 'APIError' (by applying it's required fields, if any)
mkAPIError
  :: APIError
mkAPIError :: APIError
mkAPIError =
  APIError
  { $sel:aPIErrorMessage:APIError :: Maybe Text
aPIErrorMessage = Maybe Text
forall a. Maybe a
Nothing
  , $sel:aPIErrorUrl:APIError :: Maybe Text
aPIErrorUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** AccessToken
-- | AccessToken
-- AccessToken represents an API access token.
-- 
data AccessToken = AccessToken
  { AccessToken -> Maybe Integer
accessTokenId :: !(Maybe Integer) -- ^ "id"
  , AccessToken -> Maybe Text
accessTokenName :: !(Maybe Text) -- ^ "name"
  , AccessToken -> Maybe [Text]
accessTokenScopes :: !(Maybe [Text]) -- ^ "scopes"
  , AccessToken -> Maybe Text
accessTokenSha1 :: !(Maybe Text) -- ^ "sha1"
  , AccessToken -> Maybe Text
accessTokenTokenLastEight :: !(Maybe Text) -- ^ "token_last_eight"
  } deriving (Int -> AccessToken -> ShowS
[AccessToken] -> ShowS
AccessToken -> [Char]
(Int -> AccessToken -> ShowS)
-> (AccessToken -> [Char])
-> ([AccessToken] -> ShowS)
-> Show AccessToken
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AccessToken -> ShowS
showsPrec :: Int -> AccessToken -> ShowS
$cshow :: AccessToken -> [Char]
show :: AccessToken -> [Char]
$cshowList :: [AccessToken] -> ShowS
showList :: [AccessToken] -> ShowS
P.Show, AccessToken -> AccessToken -> Bool
(AccessToken -> AccessToken -> Bool)
-> (AccessToken -> AccessToken -> Bool) -> Eq AccessToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccessToken -> AccessToken -> Bool
== :: AccessToken -> AccessToken -> Bool
$c/= :: AccessToken -> AccessToken -> Bool
/= :: AccessToken -> AccessToken -> Bool
P.Eq, P.Typeable)

-- | FromJSON AccessToken
instance A.FromJSON AccessToken where
  parseJSON :: Value -> Parser AccessToken
parseJSON = [Char]
-> (Object -> Parser AccessToken) -> Value -> Parser AccessToken
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"AccessToken" ((Object -> Parser AccessToken) -> Value -> Parser AccessToken)
-> (Object -> Parser AccessToken) -> Value -> Parser AccessToken
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Integer
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> AccessToken
AccessToken
      (Maybe Integer
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe Text
 -> Maybe Text
 -> AccessToken)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe [Text] -> Maybe Text -> Maybe Text -> AccessToken)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Text
   -> Maybe [Text] -> Maybe Text -> Maybe Text -> AccessToken)
-> Parser (Maybe Text)
-> Parser (Maybe [Text] -> Maybe Text -> Maybe Text -> AccessToken)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser (Maybe [Text] -> Maybe Text -> Maybe Text -> AccessToken)
-> Parser (Maybe [Text])
-> Parser (Maybe Text -> Maybe Text -> AccessToken)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"scopes")
      Parser (Maybe Text -> Maybe Text -> AccessToken)
-> Parser (Maybe Text) -> Parser (Maybe Text -> AccessToken)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sha1")
      Parser (Maybe Text -> AccessToken)
-> Parser (Maybe Text) -> Parser AccessToken
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"token_last_eight")

-- | ToJSON AccessToken
instance A.ToJSON AccessToken where
  toJSON :: AccessToken -> Value
toJSON AccessToken {Maybe Integer
Maybe [Text]
Maybe Text
$sel:accessTokenId:AccessToken :: AccessToken -> Maybe Integer
$sel:accessTokenName:AccessToken :: AccessToken -> Maybe Text
$sel:accessTokenScopes:AccessToken :: AccessToken -> Maybe [Text]
$sel:accessTokenSha1:AccessToken :: AccessToken -> Maybe Text
$sel:accessTokenTokenLastEight:AccessToken :: AccessToken -> Maybe Text
accessTokenId :: Maybe Integer
accessTokenName :: Maybe Text
accessTokenScopes :: Maybe [Text]
accessTokenSha1 :: Maybe Text
accessTokenTokenLastEight :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
accessTokenId
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
accessTokenName
      , Key
"scopes" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
accessTokenScopes
      , Key
"sha1" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
accessTokenSha1
      , Key
"token_last_eight" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
accessTokenTokenLastEight
      ]


-- | Construct a value of type 'AccessToken' (by applying it's required fields, if any)
mkAccessToken
  :: AccessToken
mkAccessToken :: AccessToken
mkAccessToken =
  AccessToken
  { $sel:accessTokenId:AccessToken :: Maybe Integer
accessTokenId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:accessTokenName:AccessToken :: Maybe Text
accessTokenName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:accessTokenScopes:AccessToken :: Maybe [Text]
accessTokenScopes = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:accessTokenSha1:AccessToken :: Maybe Text
accessTokenSha1 = Maybe Text
forall a. Maybe a
Nothing
  , $sel:accessTokenTokenLastEight:AccessToken :: Maybe Text
accessTokenTokenLastEight = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ActionTask
-- | ActionTask
-- ActionTask represents a ActionTask
data ActionTask = ActionTask
  { ActionTask -> Maybe DateTime
actionTaskCreatedAt :: !(Maybe DateTime) -- ^ "created_at"
  , ActionTask -> Maybe Text
actionTaskDisplayTitle :: !(Maybe Text) -- ^ "display_title"
  , ActionTask -> Maybe Text
actionTaskEvent :: !(Maybe Text) -- ^ "event"
  , ActionTask -> Maybe Text
actionTaskHeadBranch :: !(Maybe Text) -- ^ "head_branch"
  , ActionTask -> Maybe Text
actionTaskHeadSha :: !(Maybe Text) -- ^ "head_sha"
  , ActionTask -> Maybe Integer
actionTaskId :: !(Maybe Integer) -- ^ "id"
  , ActionTask -> Maybe Text
actionTaskName :: !(Maybe Text) -- ^ "name"
  , ActionTask -> Maybe Integer
actionTaskRunNumber :: !(Maybe Integer) -- ^ "run_number"
  , ActionTask -> Maybe DateTime
actionTaskRunStartedAt :: !(Maybe DateTime) -- ^ "run_started_at"
  , ActionTask -> Maybe Text
actionTaskStatus :: !(Maybe Text) -- ^ "status"
  , ActionTask -> Maybe DateTime
actionTaskUpdatedAt :: !(Maybe DateTime) -- ^ "updated_at"
  , ActionTask -> Maybe Text
actionTaskUrl :: !(Maybe Text) -- ^ "url"
  , ActionTask -> Maybe Text
actionTaskWorkflowId :: !(Maybe Text) -- ^ "workflow_id"
  } deriving (Int -> ActionTask -> ShowS
[ActionTask] -> ShowS
ActionTask -> [Char]
(Int -> ActionTask -> ShowS)
-> (ActionTask -> [Char])
-> ([ActionTask] -> ShowS)
-> Show ActionTask
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionTask -> ShowS
showsPrec :: Int -> ActionTask -> ShowS
$cshow :: ActionTask -> [Char]
show :: ActionTask -> [Char]
$cshowList :: [ActionTask] -> ShowS
showList :: [ActionTask] -> ShowS
P.Show, ActionTask -> ActionTask -> Bool
(ActionTask -> ActionTask -> Bool)
-> (ActionTask -> ActionTask -> Bool) -> Eq ActionTask
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActionTask -> ActionTask -> Bool
== :: ActionTask -> ActionTask -> Bool
$c/= :: ActionTask -> ActionTask -> Bool
/= :: ActionTask -> ActionTask -> Bool
P.Eq, P.Typeable)

-- | FromJSON ActionTask
instance A.FromJSON ActionTask where
  parseJSON :: Value -> Parser ActionTask
parseJSON = [Char]
-> (Object -> Parser ActionTask) -> Value -> Parser ActionTask
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"ActionTask" ((Object -> Parser ActionTask) -> Value -> Parser ActionTask)
-> (Object -> Parser ActionTask) -> Value -> Parser ActionTask
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe DateTime
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe Integer
-> Maybe DateTime
-> Maybe Text
-> Maybe DateTime
-> Maybe Text
-> Maybe Text
-> ActionTask
ActionTask
      (Maybe DateTime
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Integer
 -> Maybe DateTime
 -> Maybe Text
 -> Maybe DateTime
 -> Maybe Text
 -> Maybe Text
 -> ActionTask)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> ActionTask)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_at")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> ActionTask)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> ActionTask)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"display_title")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> ActionTask)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> ActionTask)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"event")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> ActionTask)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> ActionTask)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"head_branch")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> ActionTask)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> ActionTask)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"head_sha")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> ActionTask)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> ActionTask)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> ActionTask)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> ActionTask)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser
  (Maybe Integer
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> ActionTask)
-> Parser (Maybe Integer)
-> Parser
     (Maybe DateTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> ActionTask)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"run_number")
      Parser
  (Maybe DateTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> ActionTask)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Text
      -> Maybe DateTime -> Maybe Text -> Maybe Text -> ActionTask)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"run_started_at")
      Parser
  (Maybe Text
   -> Maybe DateTime -> Maybe Text -> Maybe Text -> ActionTask)
-> Parser (Maybe Text)
-> Parser
     (Maybe DateTime -> Maybe Text -> Maybe Text -> ActionTask)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"status")
      Parser (Maybe DateTime -> Maybe Text -> Maybe Text -> ActionTask)
-> Parser (Maybe DateTime)
-> Parser (Maybe Text -> Maybe Text -> ActionTask)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated_at")
      Parser (Maybe Text -> Maybe Text -> ActionTask)
-> Parser (Maybe Text) -> Parser (Maybe Text -> ActionTask)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")
      Parser (Maybe Text -> ActionTask)
-> Parser (Maybe Text) -> Parser ActionTask
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"workflow_id")

-- | ToJSON ActionTask
instance A.ToJSON ActionTask where
  toJSON :: ActionTask -> Value
toJSON ActionTask {Maybe Integer
Maybe Text
Maybe DateTime
$sel:actionTaskCreatedAt:ActionTask :: ActionTask -> Maybe DateTime
$sel:actionTaskDisplayTitle:ActionTask :: ActionTask -> Maybe Text
$sel:actionTaskEvent:ActionTask :: ActionTask -> Maybe Text
$sel:actionTaskHeadBranch:ActionTask :: ActionTask -> Maybe Text
$sel:actionTaskHeadSha:ActionTask :: ActionTask -> Maybe Text
$sel:actionTaskId:ActionTask :: ActionTask -> Maybe Integer
$sel:actionTaskName:ActionTask :: ActionTask -> Maybe Text
$sel:actionTaskRunNumber:ActionTask :: ActionTask -> Maybe Integer
$sel:actionTaskRunStartedAt:ActionTask :: ActionTask -> Maybe DateTime
$sel:actionTaskStatus:ActionTask :: ActionTask -> Maybe Text
$sel:actionTaskUpdatedAt:ActionTask :: ActionTask -> Maybe DateTime
$sel:actionTaskUrl:ActionTask :: ActionTask -> Maybe Text
$sel:actionTaskWorkflowId:ActionTask :: ActionTask -> Maybe Text
actionTaskCreatedAt :: Maybe DateTime
actionTaskDisplayTitle :: Maybe Text
actionTaskEvent :: Maybe Text
actionTaskHeadBranch :: Maybe Text
actionTaskHeadSha :: Maybe Text
actionTaskId :: Maybe Integer
actionTaskName :: Maybe Text
actionTaskRunNumber :: Maybe Integer
actionTaskRunStartedAt :: Maybe DateTime
actionTaskStatus :: Maybe Text
actionTaskUpdatedAt :: Maybe DateTime
actionTaskUrl :: Maybe Text
actionTaskWorkflowId :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
actionTaskCreatedAt
      , Key
"display_title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
actionTaskDisplayTitle
      , Key
"event" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
actionTaskEvent
      , Key
"head_branch" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
actionTaskHeadBranch
      , Key
"head_sha" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
actionTaskHeadSha
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
actionTaskId
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
actionTaskName
      , Key
"run_number" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
actionTaskRunNumber
      , Key
"run_started_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
actionTaskRunStartedAt
      , Key
"status" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
actionTaskStatus
      , Key
"updated_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
actionTaskUpdatedAt
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
actionTaskUrl
      , Key
"workflow_id" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
actionTaskWorkflowId
      ]


-- | Construct a value of type 'ActionTask' (by applying it's required fields, if any)
mkActionTask
  :: ActionTask
mkActionTask :: ActionTask
mkActionTask =
  ActionTask
  { $sel:actionTaskCreatedAt:ActionTask :: Maybe DateTime
actionTaskCreatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:actionTaskDisplayTitle:ActionTask :: Maybe Text
actionTaskDisplayTitle = Maybe Text
forall a. Maybe a
Nothing
  , $sel:actionTaskEvent:ActionTask :: Maybe Text
actionTaskEvent = Maybe Text
forall a. Maybe a
Nothing
  , $sel:actionTaskHeadBranch:ActionTask :: Maybe Text
actionTaskHeadBranch = Maybe Text
forall a. Maybe a
Nothing
  , $sel:actionTaskHeadSha:ActionTask :: Maybe Text
actionTaskHeadSha = Maybe Text
forall a. Maybe a
Nothing
  , $sel:actionTaskId:ActionTask :: Maybe Integer
actionTaskId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:actionTaskName:ActionTask :: Maybe Text
actionTaskName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:actionTaskRunNumber:ActionTask :: Maybe Integer
actionTaskRunNumber = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:actionTaskRunStartedAt:ActionTask :: Maybe DateTime
actionTaskRunStartedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:actionTaskStatus:ActionTask :: Maybe Text
actionTaskStatus = Maybe Text
forall a. Maybe a
Nothing
  , $sel:actionTaskUpdatedAt:ActionTask :: Maybe DateTime
actionTaskUpdatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:actionTaskUrl:ActionTask :: Maybe Text
actionTaskUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:actionTaskWorkflowId:ActionTask :: Maybe Text
actionTaskWorkflowId = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ActionTaskResponse
-- | ActionTaskResponse
-- ActionTaskResponse returns a ActionTask
data ActionTaskResponse = ActionTaskResponse
  { ActionTaskResponse -> Maybe Integer
actionTaskResponseTotalCount :: !(Maybe Integer) -- ^ "total_count"
  , ActionTaskResponse -> Maybe [ActionTask]
actionTaskResponseWorkflowRuns :: !(Maybe [ActionTask]) -- ^ "workflow_runs"
  } deriving (Int -> ActionTaskResponse -> ShowS
[ActionTaskResponse] -> ShowS
ActionTaskResponse -> [Char]
(Int -> ActionTaskResponse -> ShowS)
-> (ActionTaskResponse -> [Char])
-> ([ActionTaskResponse] -> ShowS)
-> Show ActionTaskResponse
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionTaskResponse -> ShowS
showsPrec :: Int -> ActionTaskResponse -> ShowS
$cshow :: ActionTaskResponse -> [Char]
show :: ActionTaskResponse -> [Char]
$cshowList :: [ActionTaskResponse] -> ShowS
showList :: [ActionTaskResponse] -> ShowS
P.Show, ActionTaskResponse -> ActionTaskResponse -> Bool
(ActionTaskResponse -> ActionTaskResponse -> Bool)
-> (ActionTaskResponse -> ActionTaskResponse -> Bool)
-> Eq ActionTaskResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActionTaskResponse -> ActionTaskResponse -> Bool
== :: ActionTaskResponse -> ActionTaskResponse -> Bool
$c/= :: ActionTaskResponse -> ActionTaskResponse -> Bool
/= :: ActionTaskResponse -> ActionTaskResponse -> Bool
P.Eq, P.Typeable)

-- | FromJSON ActionTaskResponse
instance A.FromJSON ActionTaskResponse where
  parseJSON :: Value -> Parser ActionTaskResponse
parseJSON = [Char]
-> (Object -> Parser ActionTaskResponse)
-> Value
-> Parser ActionTaskResponse
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"ActionTaskResponse" ((Object -> Parser ActionTaskResponse)
 -> Value -> Parser ActionTaskResponse)
-> (Object -> Parser ActionTaskResponse)
-> Value
-> Parser ActionTaskResponse
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Integer -> Maybe [ActionTask] -> ActionTaskResponse
ActionTaskResponse
      (Maybe Integer -> Maybe [ActionTask] -> ActionTaskResponse)
-> Parser (Maybe Integer)
-> Parser (Maybe [ActionTask] -> ActionTaskResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"total_count")
      Parser (Maybe [ActionTask] -> ActionTaskResponse)
-> Parser (Maybe [ActionTask]) -> Parser ActionTaskResponse
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [ActionTask])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"workflow_runs")

-- | ToJSON ActionTaskResponse
instance A.ToJSON ActionTaskResponse where
  toJSON :: ActionTaskResponse -> Value
toJSON ActionTaskResponse {Maybe Integer
Maybe [ActionTask]
$sel:actionTaskResponseTotalCount:ActionTaskResponse :: ActionTaskResponse -> Maybe Integer
$sel:actionTaskResponseWorkflowRuns:ActionTaskResponse :: ActionTaskResponse -> Maybe [ActionTask]
actionTaskResponseTotalCount :: Maybe Integer
actionTaskResponseWorkflowRuns :: Maybe [ActionTask]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"total_count" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
actionTaskResponseTotalCount
      , Key
"workflow_runs" Key -> Maybe [ActionTask] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [ActionTask]
actionTaskResponseWorkflowRuns
      ]


-- | Construct a value of type 'ActionTaskResponse' (by applying it's required fields, if any)
mkActionTaskResponse
  :: ActionTaskResponse
mkActionTaskResponse :: ActionTaskResponse
mkActionTaskResponse =
  ActionTaskResponse
  { $sel:actionTaskResponseTotalCount:ActionTaskResponse :: Maybe Integer
actionTaskResponseTotalCount = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:actionTaskResponseWorkflowRuns:ActionTaskResponse :: Maybe [ActionTask]
actionTaskResponseWorkflowRuns = Maybe [ActionTask]
forall a. Maybe a
Nothing
  }

-- ** ActionVariable
-- | ActionVariable
-- ActionVariable return value of the query API
data ActionVariable = ActionVariable
  { ActionVariable -> Maybe Text
actionVariableData :: !(Maybe Text) -- ^ "data" - the value of the variable
  , ActionVariable -> Maybe Text
actionVariableName :: !(Maybe Text) -- ^ "name" - the name of the variable
  , ActionVariable -> Maybe Integer
actionVariableOwnerId :: !(Maybe Integer) -- ^ "owner_id" - the owner to which the variable belongs
  , ActionVariable -> Maybe Integer
actionVariableRepoId :: !(Maybe Integer) -- ^ "repo_id" - the repository to which the variable belongs
  } deriving (Int -> ActionVariable -> ShowS
[ActionVariable] -> ShowS
ActionVariable -> [Char]
(Int -> ActionVariable -> ShowS)
-> (ActionVariable -> [Char])
-> ([ActionVariable] -> ShowS)
-> Show ActionVariable
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionVariable -> ShowS
showsPrec :: Int -> ActionVariable -> ShowS
$cshow :: ActionVariable -> [Char]
show :: ActionVariable -> [Char]
$cshowList :: [ActionVariable] -> ShowS
showList :: [ActionVariable] -> ShowS
P.Show, ActionVariable -> ActionVariable -> Bool
(ActionVariable -> ActionVariable -> Bool)
-> (ActionVariable -> ActionVariable -> Bool) -> Eq ActionVariable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActionVariable -> ActionVariable -> Bool
== :: ActionVariable -> ActionVariable -> Bool
$c/= :: ActionVariable -> ActionVariable -> Bool
/= :: ActionVariable -> ActionVariable -> Bool
P.Eq, P.Typeable)

-- | FromJSON ActionVariable
instance A.FromJSON ActionVariable where
  parseJSON :: Value -> Parser ActionVariable
parseJSON = [Char]
-> (Object -> Parser ActionVariable)
-> Value
-> Parser ActionVariable
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"ActionVariable" ((Object -> Parser ActionVariable)
 -> Value -> Parser ActionVariable)
-> (Object -> Parser ActionVariable)
-> Value
-> Parser ActionVariable
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text -> Maybe Integer -> Maybe Integer -> ActionVariable
ActionVariable
      (Maybe Text
 -> Maybe Text -> Maybe Integer -> Maybe Integer -> ActionVariable)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Integer -> Maybe Integer -> ActionVariable)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"data")
      Parser
  (Maybe Text -> Maybe Integer -> Maybe Integer -> ActionVariable)
-> Parser (Maybe Text)
-> Parser (Maybe Integer -> Maybe Integer -> ActionVariable)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser (Maybe Integer -> Maybe Integer -> ActionVariable)
-> Parser (Maybe Integer)
-> Parser (Maybe Integer -> ActionVariable)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"owner_id")
      Parser (Maybe Integer -> ActionVariable)
-> Parser (Maybe Integer) -> Parser ActionVariable
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"repo_id")

-- | ToJSON ActionVariable
instance A.ToJSON ActionVariable where
  toJSON :: ActionVariable -> Value
toJSON ActionVariable {Maybe Integer
Maybe Text
$sel:actionVariableData:ActionVariable :: ActionVariable -> Maybe Text
$sel:actionVariableName:ActionVariable :: ActionVariable -> Maybe Text
$sel:actionVariableOwnerId:ActionVariable :: ActionVariable -> Maybe Integer
$sel:actionVariableRepoId:ActionVariable :: ActionVariable -> Maybe Integer
actionVariableData :: Maybe Text
actionVariableName :: Maybe Text
actionVariableOwnerId :: Maybe Integer
actionVariableRepoId :: Maybe Integer
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"data" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
actionVariableData
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
actionVariableName
      , Key
"owner_id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
actionVariableOwnerId
      , Key
"repo_id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
actionVariableRepoId
      ]


-- | Construct a value of type 'ActionVariable' (by applying it's required fields, if any)
mkActionVariable
  :: ActionVariable
mkActionVariable :: ActionVariable
mkActionVariable =
  ActionVariable
  { $sel:actionVariableData:ActionVariable :: Maybe Text
actionVariableData = Maybe Text
forall a. Maybe a
Nothing
  , $sel:actionVariableName:ActionVariable :: Maybe Text
actionVariableName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:actionVariableOwnerId:ActionVariable :: Maybe Integer
actionVariableOwnerId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:actionVariableRepoId:ActionVariable :: Maybe Integer
actionVariableRepoId = Maybe Integer
forall a. Maybe a
Nothing
  }

-- ** Activity
-- | Activity
data Activity = Activity
  { Activity -> Maybe User
activityActUser :: !(Maybe User) -- ^ "act_user"
  , Activity -> Maybe Integer
activityActUserId :: !(Maybe Integer) -- ^ "act_user_id"
  , Activity -> Maybe Comment
activityComment :: !(Maybe Comment) -- ^ "comment"
  , Activity -> Maybe Integer
activityCommentId :: !(Maybe Integer) -- ^ "comment_id"
  , Activity -> Maybe Text
activityContent :: !(Maybe Text) -- ^ "content"
  , Activity -> Maybe DateTime
activityCreated :: !(Maybe DateTime) -- ^ "created"
  , Activity -> Maybe Integer
activityId :: !(Maybe Integer) -- ^ "id"
  , Activity -> Maybe Bool
activityIsPrivate :: !(Maybe Bool) -- ^ "is_private"
  , Activity -> Maybe E'OpType
activityOpType :: !(Maybe E'OpType) -- ^ "op_type" - the type of action
  , Activity -> Maybe Text
activityRefName :: !(Maybe Text) -- ^ "ref_name"
  , Activity -> Maybe Repository
activityRepo :: !(Maybe Repository) -- ^ "repo"
  , Activity -> Maybe Integer
activityRepoId :: !(Maybe Integer) -- ^ "repo_id"
  , Activity -> Maybe Integer
activityUserId :: !(Maybe Integer) -- ^ "user_id"
  } deriving (Int -> Activity -> ShowS
[Activity] -> ShowS
Activity -> [Char]
(Int -> Activity -> ShowS)
-> (Activity -> [Char]) -> ([Activity] -> ShowS) -> Show Activity
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Activity -> ShowS
showsPrec :: Int -> Activity -> ShowS
$cshow :: Activity -> [Char]
show :: Activity -> [Char]
$cshowList :: [Activity] -> ShowS
showList :: [Activity] -> ShowS
P.Show, Activity -> Activity -> Bool
(Activity -> Activity -> Bool)
-> (Activity -> Activity -> Bool) -> Eq Activity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Activity -> Activity -> Bool
== :: Activity -> Activity -> Bool
$c/= :: Activity -> Activity -> Bool
/= :: Activity -> Activity -> Bool
P.Eq, P.Typeable)

-- | FromJSON Activity
instance A.FromJSON Activity where
  parseJSON :: Value -> Parser Activity
parseJSON = [Char] -> (Object -> Parser Activity) -> Value -> Parser Activity
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Activity" ((Object -> Parser Activity) -> Value -> Parser Activity)
-> (Object -> Parser Activity) -> Value -> Parser Activity
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe User
-> Maybe Integer
-> Maybe Comment
-> Maybe Integer
-> Maybe Text
-> Maybe DateTime
-> Maybe Integer
-> Maybe Bool
-> Maybe E'OpType
-> Maybe Text
-> Maybe Repository
-> Maybe Integer
-> Maybe Integer
-> Activity
Activity
      (Maybe User
 -> Maybe Integer
 -> Maybe Comment
 -> Maybe Integer
 -> Maybe Text
 -> Maybe DateTime
 -> Maybe Integer
 -> Maybe Bool
 -> Maybe E'OpType
 -> Maybe Text
 -> Maybe Repository
 -> Maybe Integer
 -> Maybe Integer
 -> Activity)
-> Parser (Maybe User)
-> Parser
     (Maybe Integer
      -> Maybe Comment
      -> Maybe Integer
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe E'OpType
      -> Maybe Text
      -> Maybe Repository
      -> Maybe Integer
      -> Maybe Integer
      -> Activity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"act_user")
      Parser
  (Maybe Integer
   -> Maybe Comment
   -> Maybe Integer
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe E'OpType
   -> Maybe Text
   -> Maybe Repository
   -> Maybe Integer
   -> Maybe Integer
   -> Activity)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Comment
      -> Maybe Integer
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe E'OpType
      -> Maybe Text
      -> Maybe Repository
      -> Maybe Integer
      -> Maybe Integer
      -> Activity)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"act_user_id")
      Parser
  (Maybe Comment
   -> Maybe Integer
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe E'OpType
   -> Maybe Text
   -> Maybe Repository
   -> Maybe Integer
   -> Maybe Integer
   -> Activity)
-> Parser (Maybe Comment)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe E'OpType
      -> Maybe Text
      -> Maybe Repository
      -> Maybe Integer
      -> Maybe Integer
      -> Activity)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Comment)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"comment")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe E'OpType
   -> Maybe Text
   -> Maybe Repository
   -> Maybe Integer
   -> Maybe Integer
   -> Activity)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe E'OpType
      -> Maybe Text
      -> Maybe Repository
      -> Maybe Integer
      -> Maybe Integer
      -> Activity)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"comment_id")
      Parser
  (Maybe Text
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe E'OpType
   -> Maybe Text
   -> Maybe Repository
   -> Maybe Integer
   -> Maybe Integer
   -> Activity)
-> Parser (Maybe Text)
-> Parser
     (Maybe DateTime
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe E'OpType
      -> Maybe Text
      -> Maybe Repository
      -> Maybe Integer
      -> Maybe Integer
      -> Activity)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"content")
      Parser
  (Maybe DateTime
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe E'OpType
   -> Maybe Text
   -> Maybe Repository
   -> Maybe Integer
   -> Maybe Integer
   -> Activity)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Integer
      -> Maybe Bool
      -> Maybe E'OpType
      -> Maybe Text
      -> Maybe Repository
      -> Maybe Integer
      -> Maybe Integer
      -> Activity)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe Integer
   -> Maybe Bool
   -> Maybe E'OpType
   -> Maybe Text
   -> Maybe Repository
   -> Maybe Integer
   -> Maybe Integer
   -> Activity)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Bool
      -> Maybe E'OpType
      -> Maybe Text
      -> Maybe Repository
      -> Maybe Integer
      -> Maybe Integer
      -> Activity)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Bool
   -> Maybe E'OpType
   -> Maybe Text
   -> Maybe Repository
   -> Maybe Integer
   -> Maybe Integer
   -> Activity)
-> Parser (Maybe Bool)
-> Parser
     (Maybe E'OpType
      -> Maybe Text
      -> Maybe Repository
      -> Maybe Integer
      -> Maybe Integer
      -> Activity)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_private")
      Parser
  (Maybe E'OpType
   -> Maybe Text
   -> Maybe Repository
   -> Maybe Integer
   -> Maybe Integer
   -> Activity)
-> Parser (Maybe E'OpType)
-> Parser
     (Maybe Text
      -> Maybe Repository -> Maybe Integer -> Maybe Integer -> Activity)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe E'OpType)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"op_type")
      Parser
  (Maybe Text
   -> Maybe Repository -> Maybe Integer -> Maybe Integer -> Activity)
-> Parser (Maybe Text)
-> Parser
     (Maybe Repository -> Maybe Integer -> Maybe Integer -> Activity)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ref_name")
      Parser
  (Maybe Repository -> Maybe Integer -> Maybe Integer -> Activity)
-> Parser (Maybe Repository)
-> Parser (Maybe Integer -> Maybe Integer -> Activity)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Repository)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"repo")
      Parser (Maybe Integer -> Maybe Integer -> Activity)
-> Parser (Maybe Integer) -> Parser (Maybe Integer -> Activity)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"repo_id")
      Parser (Maybe Integer -> Activity)
-> Parser (Maybe Integer) -> Parser Activity
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user_id")

-- | ToJSON Activity
instance A.ToJSON Activity where
  toJSON :: Activity -> Value
toJSON Activity {Maybe Bool
Maybe Integer
Maybe Text
Maybe DateTime
Maybe E'OpType
Maybe User
Maybe Repository
Maybe Comment
$sel:activityActUser:Activity :: Activity -> Maybe User
$sel:activityActUserId:Activity :: Activity -> Maybe Integer
$sel:activityComment:Activity :: Activity -> Maybe Comment
$sel:activityCommentId:Activity :: Activity -> Maybe Integer
$sel:activityContent:Activity :: Activity -> Maybe Text
$sel:activityCreated:Activity :: Activity -> Maybe DateTime
$sel:activityId:Activity :: Activity -> Maybe Integer
$sel:activityIsPrivate:Activity :: Activity -> Maybe Bool
$sel:activityOpType:Activity :: Activity -> Maybe E'OpType
$sel:activityRefName:Activity :: Activity -> Maybe Text
$sel:activityRepo:Activity :: Activity -> Maybe Repository
$sel:activityRepoId:Activity :: Activity -> Maybe Integer
$sel:activityUserId:Activity :: Activity -> Maybe Integer
activityActUser :: Maybe User
activityActUserId :: Maybe Integer
activityComment :: Maybe Comment
activityCommentId :: Maybe Integer
activityContent :: Maybe Text
activityCreated :: Maybe DateTime
activityId :: Maybe Integer
activityIsPrivate :: Maybe Bool
activityOpType :: Maybe E'OpType
activityRefName :: Maybe Text
activityRepo :: Maybe Repository
activityRepoId :: Maybe Integer
activityUserId :: Maybe Integer
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"act_user" Key -> Maybe User -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe User
activityActUser
      , Key
"act_user_id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
activityActUserId
      , Key
"comment" Key -> Maybe Comment -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Comment
activityComment
      , Key
"comment_id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
activityCommentId
      , Key
"content" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
activityContent
      , Key
"created" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
activityCreated
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
activityId
      , Key
"is_private" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
activityIsPrivate
      , Key
"op_type" Key -> Maybe E'OpType -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe E'OpType
activityOpType
      , Key
"ref_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
activityRefName
      , Key
"repo" Key -> Maybe Repository -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Repository
activityRepo
      , Key
"repo_id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
activityRepoId
      , Key
"user_id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
activityUserId
      ]


-- | Construct a value of type 'Activity' (by applying it's required fields, if any)
mkActivity
  :: Activity
mkActivity :: Activity
mkActivity =
  Activity
  { $sel:activityActUser:Activity :: Maybe User
activityActUser = Maybe User
forall a. Maybe a
Nothing
  , $sel:activityActUserId:Activity :: Maybe Integer
activityActUserId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:activityComment:Activity :: Maybe Comment
activityComment = Maybe Comment
forall a. Maybe a
Nothing
  , $sel:activityCommentId:Activity :: Maybe Integer
activityCommentId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:activityContent:Activity :: Maybe Text
activityContent = Maybe Text
forall a. Maybe a
Nothing
  , $sel:activityCreated:Activity :: Maybe DateTime
activityCreated = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:activityId:Activity :: Maybe Integer
activityId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:activityIsPrivate:Activity :: Maybe Bool
activityIsPrivate = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:activityOpType:Activity :: Maybe E'OpType
activityOpType = Maybe E'OpType
forall a. Maybe a
Nothing
  , $sel:activityRefName:Activity :: Maybe Text
activityRefName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:activityRepo:Activity :: Maybe Repository
activityRepo = Maybe Repository
forall a. Maybe a
Nothing
  , $sel:activityRepoId:Activity :: Maybe Integer
activityRepoId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:activityUserId:Activity :: Maybe Integer
activityUserId = Maybe Integer
forall a. Maybe a
Nothing
  }

-- ** ActivityPub
-- | ActivityPub
-- ActivityPub type
data ActivityPub = ActivityPub
  { ActivityPub -> Maybe Text
activityPubContext :: !(Maybe Text) -- ^ "@context"
  } deriving (Int -> ActivityPub -> ShowS
[ActivityPub] -> ShowS
ActivityPub -> [Char]
(Int -> ActivityPub -> ShowS)
-> (ActivityPub -> [Char])
-> ([ActivityPub] -> ShowS)
-> Show ActivityPub
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActivityPub -> ShowS
showsPrec :: Int -> ActivityPub -> ShowS
$cshow :: ActivityPub -> [Char]
show :: ActivityPub -> [Char]
$cshowList :: [ActivityPub] -> ShowS
showList :: [ActivityPub] -> ShowS
P.Show, ActivityPub -> ActivityPub -> Bool
(ActivityPub -> ActivityPub -> Bool)
-> (ActivityPub -> ActivityPub -> Bool) -> Eq ActivityPub
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActivityPub -> ActivityPub -> Bool
== :: ActivityPub -> ActivityPub -> Bool
$c/= :: ActivityPub -> ActivityPub -> Bool
/= :: ActivityPub -> ActivityPub -> Bool
P.Eq, P.Typeable)

-- | FromJSON ActivityPub
instance A.FromJSON ActivityPub where
  parseJSON :: Value -> Parser ActivityPub
parseJSON = [Char]
-> (Object -> Parser ActivityPub) -> Value -> Parser ActivityPub
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"ActivityPub" ((Object -> Parser ActivityPub) -> Value -> Parser ActivityPub)
-> (Object -> Parser ActivityPub) -> Value -> Parser ActivityPub
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> ActivityPub
ActivityPub
      (Maybe Text -> ActivityPub)
-> Parser (Maybe Text) -> Parser ActivityPub
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"@context")

-- | ToJSON ActivityPub
instance A.ToJSON ActivityPub where
  toJSON :: ActivityPub -> Value
toJSON ActivityPub {Maybe Text
$sel:activityPubContext:ActivityPub :: ActivityPub -> Maybe Text
activityPubContext :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"@context" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
activityPubContext
      ]


-- | Construct a value of type 'ActivityPub' (by applying it's required fields, if any)
mkActivityPub
  :: ActivityPub
mkActivityPub :: ActivityPub
mkActivityPub =
  ActivityPub
  { $sel:activityPubContext:ActivityPub :: Maybe Text
activityPubContext = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** AddCollaboratorOption
-- | AddCollaboratorOption
-- AddCollaboratorOption options when adding a user as a collaborator of a repository
data AddCollaboratorOption = AddCollaboratorOption
  { AddCollaboratorOption -> Maybe E'Permission
addCollaboratorOptionPermission :: !(Maybe E'Permission) -- ^ "permission"
  } deriving (Int -> AddCollaboratorOption -> ShowS
[AddCollaboratorOption] -> ShowS
AddCollaboratorOption -> [Char]
(Int -> AddCollaboratorOption -> ShowS)
-> (AddCollaboratorOption -> [Char])
-> ([AddCollaboratorOption] -> ShowS)
-> Show AddCollaboratorOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddCollaboratorOption -> ShowS
showsPrec :: Int -> AddCollaboratorOption -> ShowS
$cshow :: AddCollaboratorOption -> [Char]
show :: AddCollaboratorOption -> [Char]
$cshowList :: [AddCollaboratorOption] -> ShowS
showList :: [AddCollaboratorOption] -> ShowS
P.Show, AddCollaboratorOption -> AddCollaboratorOption -> Bool
(AddCollaboratorOption -> AddCollaboratorOption -> Bool)
-> (AddCollaboratorOption -> AddCollaboratorOption -> Bool)
-> Eq AddCollaboratorOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddCollaboratorOption -> AddCollaboratorOption -> Bool
== :: AddCollaboratorOption -> AddCollaboratorOption -> Bool
$c/= :: AddCollaboratorOption -> AddCollaboratorOption -> Bool
/= :: AddCollaboratorOption -> AddCollaboratorOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON AddCollaboratorOption
instance A.FromJSON AddCollaboratorOption where
  parseJSON :: Value -> Parser AddCollaboratorOption
parseJSON = [Char]
-> (Object -> Parser AddCollaboratorOption)
-> Value
-> Parser AddCollaboratorOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"AddCollaboratorOption" ((Object -> Parser AddCollaboratorOption)
 -> Value -> Parser AddCollaboratorOption)
-> (Object -> Parser AddCollaboratorOption)
-> Value
-> Parser AddCollaboratorOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe E'Permission -> AddCollaboratorOption
AddCollaboratorOption
      (Maybe E'Permission -> AddCollaboratorOption)
-> Parser (Maybe E'Permission) -> Parser AddCollaboratorOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe E'Permission)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"permission")

-- | ToJSON AddCollaboratorOption
instance A.ToJSON AddCollaboratorOption where
  toJSON :: AddCollaboratorOption -> Value
toJSON AddCollaboratorOption {Maybe E'Permission
$sel:addCollaboratorOptionPermission:AddCollaboratorOption :: AddCollaboratorOption -> Maybe E'Permission
addCollaboratorOptionPermission :: Maybe E'Permission
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"permission" Key -> Maybe E'Permission -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe E'Permission
addCollaboratorOptionPermission
      ]


-- | Construct a value of type 'AddCollaboratorOption' (by applying it's required fields, if any)
mkAddCollaboratorOption
  :: AddCollaboratorOption
mkAddCollaboratorOption :: AddCollaboratorOption
mkAddCollaboratorOption =
  AddCollaboratorOption
  { $sel:addCollaboratorOptionPermission:AddCollaboratorOption :: Maybe E'Permission
addCollaboratorOptionPermission = Maybe E'Permission
forall a. Maybe a
Nothing
  }

-- ** AddTimeOption
-- | AddTimeOption
-- AddTimeOption options for adding time to an issue
data AddTimeOption = AddTimeOption
  { AddTimeOption -> Maybe DateTime
addTimeOptionCreated :: !(Maybe DateTime) -- ^ "created"
  , AddTimeOption -> Integer
addTimeOptionTime :: !(Integer) -- ^ /Required/ "time" - time in seconds
  , AddTimeOption -> Maybe Text
addTimeOptionUserName :: !(Maybe Text) -- ^ "user_name" - User who spent the time (optional)
  } deriving (Int -> AddTimeOption -> ShowS
[AddTimeOption] -> ShowS
AddTimeOption -> [Char]
(Int -> AddTimeOption -> ShowS)
-> (AddTimeOption -> [Char])
-> ([AddTimeOption] -> ShowS)
-> Show AddTimeOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AddTimeOption -> ShowS
showsPrec :: Int -> AddTimeOption -> ShowS
$cshow :: AddTimeOption -> [Char]
show :: AddTimeOption -> [Char]
$cshowList :: [AddTimeOption] -> ShowS
showList :: [AddTimeOption] -> ShowS
P.Show, AddTimeOption -> AddTimeOption -> Bool
(AddTimeOption -> AddTimeOption -> Bool)
-> (AddTimeOption -> AddTimeOption -> Bool) -> Eq AddTimeOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AddTimeOption -> AddTimeOption -> Bool
== :: AddTimeOption -> AddTimeOption -> Bool
$c/= :: AddTimeOption -> AddTimeOption -> Bool
/= :: AddTimeOption -> AddTimeOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON AddTimeOption
instance A.FromJSON AddTimeOption where
  parseJSON :: Value -> Parser AddTimeOption
parseJSON = [Char]
-> (Object -> Parser AddTimeOption)
-> Value
-> Parser AddTimeOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"AddTimeOption" ((Object -> Parser AddTimeOption) -> Value -> Parser AddTimeOption)
-> (Object -> Parser AddTimeOption)
-> Value
-> Parser AddTimeOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe DateTime -> Integer -> Maybe Text -> AddTimeOption
AddTimeOption
      (Maybe DateTime -> Integer -> Maybe Text -> AddTimeOption)
-> Parser (Maybe DateTime)
-> Parser (Integer -> Maybe Text -> AddTimeOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser (Integer -> Maybe Text -> AddTimeOption)
-> Parser Integer -> Parser (Maybe Text -> AddTimeOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"time")
      Parser (Maybe Text -> AddTimeOption)
-> Parser (Maybe Text) -> Parser AddTimeOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user_name")

-- | ToJSON AddTimeOption
instance A.ToJSON AddTimeOption where
  toJSON :: AddTimeOption -> Value
toJSON AddTimeOption {Integer
Maybe Text
Maybe DateTime
$sel:addTimeOptionCreated:AddTimeOption :: AddTimeOption -> Maybe DateTime
$sel:addTimeOptionTime:AddTimeOption :: AddTimeOption -> Integer
$sel:addTimeOptionUserName:AddTimeOption :: AddTimeOption -> Maybe Text
addTimeOptionCreated :: Maybe DateTime
addTimeOptionTime :: Integer
addTimeOptionUserName :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
addTimeOptionCreated
      , Key
"time" Key -> Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Integer
addTimeOptionTime
      , Key
"user_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
addTimeOptionUserName
      ]


-- | Construct a value of type 'AddTimeOption' (by applying it's required fields, if any)
mkAddTimeOption
  :: Integer -- ^ 'addTimeOptionTime': time in seconds
  -> AddTimeOption
mkAddTimeOption :: Integer -> AddTimeOption
mkAddTimeOption Integer
addTimeOptionTime =
  AddTimeOption
  { $sel:addTimeOptionCreated:AddTimeOption :: Maybe DateTime
addTimeOptionCreated = Maybe DateTime
forall a. Maybe a
Nothing
  , Integer
$sel:addTimeOptionTime:AddTimeOption :: Integer
addTimeOptionTime :: Integer
addTimeOptionTime
  , $sel:addTimeOptionUserName:AddTimeOption :: Maybe Text
addTimeOptionUserName = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** AnnotatedTag
-- | AnnotatedTag
-- AnnotatedTag represents an annotated tag
data AnnotatedTag = AnnotatedTag
  { AnnotatedTag -> Maybe Text
annotatedTagMessage :: !(Maybe Text) -- ^ "message"
  , AnnotatedTag -> Maybe AnnotatedTagObject
annotatedTagObject :: !(Maybe AnnotatedTagObject) -- ^ "object"
  , AnnotatedTag -> Maybe Text
annotatedTagSha :: !(Maybe Text) -- ^ "sha"
  , AnnotatedTag -> Maybe Text
annotatedTagTag :: !(Maybe Text) -- ^ "tag"
  , AnnotatedTag -> Maybe CommitUser
annotatedTagTagger :: !(Maybe CommitUser) -- ^ "tagger"
  , AnnotatedTag -> Maybe Text
annotatedTagUrl :: !(Maybe Text) -- ^ "url"
  , AnnotatedTag -> Maybe PayloadCommitVerification
annotatedTagVerification :: !(Maybe PayloadCommitVerification) -- ^ "verification"
  } deriving (Int -> AnnotatedTag -> ShowS
[AnnotatedTag] -> ShowS
AnnotatedTag -> [Char]
(Int -> AnnotatedTag -> ShowS)
-> (AnnotatedTag -> [Char])
-> ([AnnotatedTag] -> ShowS)
-> Show AnnotatedTag
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AnnotatedTag -> ShowS
showsPrec :: Int -> AnnotatedTag -> ShowS
$cshow :: AnnotatedTag -> [Char]
show :: AnnotatedTag -> [Char]
$cshowList :: [AnnotatedTag] -> ShowS
showList :: [AnnotatedTag] -> ShowS
P.Show, AnnotatedTag -> AnnotatedTag -> Bool
(AnnotatedTag -> AnnotatedTag -> Bool)
-> (AnnotatedTag -> AnnotatedTag -> Bool) -> Eq AnnotatedTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AnnotatedTag -> AnnotatedTag -> Bool
== :: AnnotatedTag -> AnnotatedTag -> Bool
$c/= :: AnnotatedTag -> AnnotatedTag -> Bool
/= :: AnnotatedTag -> AnnotatedTag -> Bool
P.Eq, P.Typeable)

-- | FromJSON AnnotatedTag
instance A.FromJSON AnnotatedTag where
  parseJSON :: Value -> Parser AnnotatedTag
parseJSON = [Char]
-> (Object -> Parser AnnotatedTag) -> Value -> Parser AnnotatedTag
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"AnnotatedTag" ((Object -> Parser AnnotatedTag) -> Value -> Parser AnnotatedTag)
-> (Object -> Parser AnnotatedTag) -> Value -> Parser AnnotatedTag
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe AnnotatedTagObject
-> Maybe Text
-> Maybe Text
-> Maybe CommitUser
-> Maybe Text
-> Maybe PayloadCommitVerification
-> AnnotatedTag
AnnotatedTag
      (Maybe Text
 -> Maybe AnnotatedTagObject
 -> Maybe Text
 -> Maybe Text
 -> Maybe CommitUser
 -> Maybe Text
 -> Maybe PayloadCommitVerification
 -> AnnotatedTag)
-> Parser (Maybe Text)
-> Parser
     (Maybe AnnotatedTagObject
      -> Maybe Text
      -> Maybe Text
      -> Maybe CommitUser
      -> Maybe Text
      -> Maybe PayloadCommitVerification
      -> AnnotatedTag)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"message")
      Parser
  (Maybe AnnotatedTagObject
   -> Maybe Text
   -> Maybe Text
   -> Maybe CommitUser
   -> Maybe Text
   -> Maybe PayloadCommitVerification
   -> AnnotatedTag)
-> Parser (Maybe AnnotatedTagObject)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe CommitUser
      -> Maybe Text
      -> Maybe PayloadCommitVerification
      -> AnnotatedTag)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe AnnotatedTagObject)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"object")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe CommitUser
   -> Maybe Text
   -> Maybe PayloadCommitVerification
   -> AnnotatedTag)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe CommitUser
      -> Maybe Text
      -> Maybe PayloadCommitVerification
      -> AnnotatedTag)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sha")
      Parser
  (Maybe Text
   -> Maybe CommitUser
   -> Maybe Text
   -> Maybe PayloadCommitVerification
   -> AnnotatedTag)
-> Parser (Maybe Text)
-> Parser
     (Maybe CommitUser
      -> Maybe Text -> Maybe PayloadCommitVerification -> AnnotatedTag)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tag")
      Parser
  (Maybe CommitUser
   -> Maybe Text -> Maybe PayloadCommitVerification -> AnnotatedTag)
-> Parser (Maybe CommitUser)
-> Parser
     (Maybe Text -> Maybe PayloadCommitVerification -> AnnotatedTag)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe CommitUser)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tagger")
      Parser
  (Maybe Text -> Maybe PayloadCommitVerification -> AnnotatedTag)
-> Parser (Maybe Text)
-> Parser (Maybe PayloadCommitVerification -> AnnotatedTag)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")
      Parser (Maybe PayloadCommitVerification -> AnnotatedTag)
-> Parser (Maybe PayloadCommitVerification) -> Parser AnnotatedTag
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe PayloadCommitVerification)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"verification")

-- | ToJSON AnnotatedTag
instance A.ToJSON AnnotatedTag where
  toJSON :: AnnotatedTag -> Value
toJSON AnnotatedTag {Maybe Text
Maybe PayloadCommitVerification
Maybe CommitUser
Maybe AnnotatedTagObject
$sel:annotatedTagMessage:AnnotatedTag :: AnnotatedTag -> Maybe Text
$sel:annotatedTagObject:AnnotatedTag :: AnnotatedTag -> Maybe AnnotatedTagObject
$sel:annotatedTagSha:AnnotatedTag :: AnnotatedTag -> Maybe Text
$sel:annotatedTagTag:AnnotatedTag :: AnnotatedTag -> Maybe Text
$sel:annotatedTagTagger:AnnotatedTag :: AnnotatedTag -> Maybe CommitUser
$sel:annotatedTagUrl:AnnotatedTag :: AnnotatedTag -> Maybe Text
$sel:annotatedTagVerification:AnnotatedTag :: AnnotatedTag -> Maybe PayloadCommitVerification
annotatedTagMessage :: Maybe Text
annotatedTagObject :: Maybe AnnotatedTagObject
annotatedTagSha :: Maybe Text
annotatedTagTag :: Maybe Text
annotatedTagTagger :: Maybe CommitUser
annotatedTagUrl :: Maybe Text
annotatedTagVerification :: Maybe PayloadCommitVerification
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"message" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
annotatedTagMessage
      , Key
"object" Key -> Maybe AnnotatedTagObject -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe AnnotatedTagObject
annotatedTagObject
      , Key
"sha" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
annotatedTagSha
      , Key
"tag" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
annotatedTagTag
      , Key
"tagger" Key -> Maybe CommitUser -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe CommitUser
annotatedTagTagger
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
annotatedTagUrl
      , Key
"verification" Key -> Maybe PayloadCommitVerification -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe PayloadCommitVerification
annotatedTagVerification
      ]


-- | Construct a value of type 'AnnotatedTag' (by applying it's required fields, if any)
mkAnnotatedTag
  :: AnnotatedTag
mkAnnotatedTag :: AnnotatedTag
mkAnnotatedTag =
  AnnotatedTag
  { $sel:annotatedTagMessage:AnnotatedTag :: Maybe Text
annotatedTagMessage = Maybe Text
forall a. Maybe a
Nothing
  , $sel:annotatedTagObject:AnnotatedTag :: Maybe AnnotatedTagObject
annotatedTagObject = Maybe AnnotatedTagObject
forall a. Maybe a
Nothing
  , $sel:annotatedTagSha:AnnotatedTag :: Maybe Text
annotatedTagSha = Maybe Text
forall a. Maybe a
Nothing
  , $sel:annotatedTagTag:AnnotatedTag :: Maybe Text
annotatedTagTag = Maybe Text
forall a. Maybe a
Nothing
  , $sel:annotatedTagTagger:AnnotatedTag :: Maybe CommitUser
annotatedTagTagger = Maybe CommitUser
forall a. Maybe a
Nothing
  , $sel:annotatedTagUrl:AnnotatedTag :: Maybe Text
annotatedTagUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:annotatedTagVerification:AnnotatedTag :: Maybe PayloadCommitVerification
annotatedTagVerification = Maybe PayloadCommitVerification
forall a. Maybe a
Nothing
  }

-- ** AnnotatedTagObject
-- | AnnotatedTagObject
-- AnnotatedTagObject contains meta information of the tag object
data AnnotatedTagObject = AnnotatedTagObject
  { AnnotatedTagObject -> Maybe Text
annotatedTagObjectSha :: !(Maybe Text) -- ^ "sha"
  , AnnotatedTagObject -> Maybe Text
annotatedTagObjectType :: !(Maybe Text) -- ^ "type"
  , AnnotatedTagObject -> Maybe Text
annotatedTagObjectUrl :: !(Maybe Text) -- ^ "url"
  } deriving (Int -> AnnotatedTagObject -> ShowS
[AnnotatedTagObject] -> ShowS
AnnotatedTagObject -> [Char]
(Int -> AnnotatedTagObject -> ShowS)
-> (AnnotatedTagObject -> [Char])
-> ([AnnotatedTagObject] -> ShowS)
-> Show AnnotatedTagObject
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AnnotatedTagObject -> ShowS
showsPrec :: Int -> AnnotatedTagObject -> ShowS
$cshow :: AnnotatedTagObject -> [Char]
show :: AnnotatedTagObject -> [Char]
$cshowList :: [AnnotatedTagObject] -> ShowS
showList :: [AnnotatedTagObject] -> ShowS
P.Show, AnnotatedTagObject -> AnnotatedTagObject -> Bool
(AnnotatedTagObject -> AnnotatedTagObject -> Bool)
-> (AnnotatedTagObject -> AnnotatedTagObject -> Bool)
-> Eq AnnotatedTagObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AnnotatedTagObject -> AnnotatedTagObject -> Bool
== :: AnnotatedTagObject -> AnnotatedTagObject -> Bool
$c/= :: AnnotatedTagObject -> AnnotatedTagObject -> Bool
/= :: AnnotatedTagObject -> AnnotatedTagObject -> Bool
P.Eq, P.Typeable)

-- | FromJSON AnnotatedTagObject
instance A.FromJSON AnnotatedTagObject where
  parseJSON :: Value -> Parser AnnotatedTagObject
parseJSON = [Char]
-> (Object -> Parser AnnotatedTagObject)
-> Value
-> Parser AnnotatedTagObject
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"AnnotatedTagObject" ((Object -> Parser AnnotatedTagObject)
 -> Value -> Parser AnnotatedTagObject)
-> (Object -> Parser AnnotatedTagObject)
-> Value
-> Parser AnnotatedTagObject
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Text -> Maybe Text -> AnnotatedTagObject
AnnotatedTagObject
      (Maybe Text -> Maybe Text -> Maybe Text -> AnnotatedTagObject)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> AnnotatedTagObject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sha")
      Parser (Maybe Text -> Maybe Text -> AnnotatedTagObject)
-> Parser (Maybe Text) -> Parser (Maybe Text -> AnnotatedTagObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"type")
      Parser (Maybe Text -> AnnotatedTagObject)
-> Parser (Maybe Text) -> Parser AnnotatedTagObject
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")

-- | ToJSON AnnotatedTagObject
instance A.ToJSON AnnotatedTagObject where
  toJSON :: AnnotatedTagObject -> Value
toJSON AnnotatedTagObject {Maybe Text
$sel:annotatedTagObjectSha:AnnotatedTagObject :: AnnotatedTagObject -> Maybe Text
$sel:annotatedTagObjectType:AnnotatedTagObject :: AnnotatedTagObject -> Maybe Text
$sel:annotatedTagObjectUrl:AnnotatedTagObject :: AnnotatedTagObject -> Maybe Text
annotatedTagObjectSha :: Maybe Text
annotatedTagObjectType :: Maybe Text
annotatedTagObjectUrl :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"sha" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
annotatedTagObjectSha
      , Key
"type" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
annotatedTagObjectType
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
annotatedTagObjectUrl
      ]


-- | Construct a value of type 'AnnotatedTagObject' (by applying it's required fields, if any)
mkAnnotatedTagObject
  :: AnnotatedTagObject
mkAnnotatedTagObject :: AnnotatedTagObject
mkAnnotatedTagObject =
  AnnotatedTagObject
  { $sel:annotatedTagObjectSha:AnnotatedTagObject :: Maybe Text
annotatedTagObjectSha = Maybe Text
forall a. Maybe a
Nothing
  , $sel:annotatedTagObjectType:AnnotatedTagObject :: Maybe Text
annotatedTagObjectType = Maybe Text
forall a. Maybe a
Nothing
  , $sel:annotatedTagObjectUrl:AnnotatedTagObject :: Maybe Text
annotatedTagObjectUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** Attachment
-- | Attachment
-- Attachment a generic attachment
data Attachment = Attachment
  { Attachment -> Maybe Text
attachmentBrowserDownloadUrl :: !(Maybe Text) -- ^ "browser_download_url"
  , Attachment -> Maybe DateTime
attachmentCreatedAt :: !(Maybe DateTime) -- ^ "created_at"
  , Attachment -> Maybe Integer
attachmentDownloadCount :: !(Maybe Integer) -- ^ "download_count"
  , Attachment -> Maybe Integer
attachmentId :: !(Maybe Integer) -- ^ "id"
  , Attachment -> Maybe Text
attachmentName :: !(Maybe Text) -- ^ "name"
  , Attachment -> Maybe Integer
attachmentSize :: !(Maybe Integer) -- ^ "size"
  , Attachment -> Maybe Text
attachmentUuid :: !(Maybe Text) -- ^ "uuid"
  } deriving (Int -> Attachment -> ShowS
[Attachment] -> ShowS
Attachment -> [Char]
(Int -> Attachment -> ShowS)
-> (Attachment -> [Char])
-> ([Attachment] -> ShowS)
-> Show Attachment
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Attachment -> ShowS
showsPrec :: Int -> Attachment -> ShowS
$cshow :: Attachment -> [Char]
show :: Attachment -> [Char]
$cshowList :: [Attachment] -> ShowS
showList :: [Attachment] -> ShowS
P.Show, Attachment -> Attachment -> Bool
(Attachment -> Attachment -> Bool)
-> (Attachment -> Attachment -> Bool) -> Eq Attachment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Attachment -> Attachment -> Bool
== :: Attachment -> Attachment -> Bool
$c/= :: Attachment -> Attachment -> Bool
/= :: Attachment -> Attachment -> Bool
P.Eq, P.Typeable)

-- | FromJSON Attachment
instance A.FromJSON Attachment where
  parseJSON :: Value -> Parser Attachment
parseJSON = [Char]
-> (Object -> Parser Attachment) -> Value -> Parser Attachment
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Attachment" ((Object -> Parser Attachment) -> Value -> Parser Attachment)
-> (Object -> Parser Attachment) -> Value -> Parser Attachment
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe DateTime
-> Maybe Integer
-> Maybe Integer
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Attachment
Attachment
      (Maybe Text
 -> Maybe DateTime
 -> Maybe Integer
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Text
 -> Attachment)
-> Parser (Maybe Text)
-> Parser
     (Maybe DateTime
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Attachment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"browser_download_url")
      Parser
  (Maybe DateTime
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Attachment)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Attachment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_at")
      Parser
  (Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Attachment)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Integer
      -> Maybe Text -> Maybe Integer -> Maybe Text -> Attachment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"download_count")
      Parser
  (Maybe Integer
   -> Maybe Text -> Maybe Integer -> Maybe Text -> Attachment)
-> Parser (Maybe Integer)
-> Parser (Maybe Text -> Maybe Integer -> Maybe Text -> Attachment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser (Maybe Text -> Maybe Integer -> Maybe Text -> Attachment)
-> Parser (Maybe Text)
-> Parser (Maybe Integer -> Maybe Text -> Attachment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser (Maybe Integer -> Maybe Text -> Attachment)
-> Parser (Maybe Integer) -> Parser (Maybe Text -> Attachment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"size")
      Parser (Maybe Text -> Attachment)
-> Parser (Maybe Text) -> Parser Attachment
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"uuid")

-- | ToJSON Attachment
instance A.ToJSON Attachment where
  toJSON :: Attachment -> Value
toJSON Attachment {Maybe Integer
Maybe Text
Maybe DateTime
$sel:attachmentBrowserDownloadUrl:Attachment :: Attachment -> Maybe Text
$sel:attachmentCreatedAt:Attachment :: Attachment -> Maybe DateTime
$sel:attachmentDownloadCount:Attachment :: Attachment -> Maybe Integer
$sel:attachmentId:Attachment :: Attachment -> Maybe Integer
$sel:attachmentName:Attachment :: Attachment -> Maybe Text
$sel:attachmentSize:Attachment :: Attachment -> Maybe Integer
$sel:attachmentUuid:Attachment :: Attachment -> Maybe Text
attachmentBrowserDownloadUrl :: Maybe Text
attachmentCreatedAt :: Maybe DateTime
attachmentDownloadCount :: Maybe Integer
attachmentId :: Maybe Integer
attachmentName :: Maybe Text
attachmentSize :: Maybe Integer
attachmentUuid :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"browser_download_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
attachmentBrowserDownloadUrl
      , Key
"created_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
attachmentCreatedAt
      , Key
"download_count" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
attachmentDownloadCount
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
attachmentId
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
attachmentName
      , Key
"size" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
attachmentSize
      , Key
"uuid" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
attachmentUuid
      ]


-- | Construct a value of type 'Attachment' (by applying it's required fields, if any)
mkAttachment
  :: Attachment
mkAttachment :: Attachment
mkAttachment =
  Attachment
  { $sel:attachmentBrowserDownloadUrl:Attachment :: Maybe Text
attachmentBrowserDownloadUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:attachmentCreatedAt:Attachment :: Maybe DateTime
attachmentCreatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:attachmentDownloadCount:Attachment :: Maybe Integer
attachmentDownloadCount = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:attachmentId:Attachment :: Maybe Integer
attachmentId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:attachmentName:Attachment :: Maybe Text
attachmentName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:attachmentSize:Attachment :: Maybe Integer
attachmentSize = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:attachmentUuid:Attachment :: Maybe Text
attachmentUuid = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** Badge
-- | Badge
-- Badge represents a user badge
data Badge = Badge
  { Badge -> Maybe Text
badgeDescription :: !(Maybe Text) -- ^ "description"
  , Badge -> Maybe Integer
badgeId :: !(Maybe Integer) -- ^ "id"
  , Badge -> Maybe Text
badgeImageUrl :: !(Maybe Text) -- ^ "image_url"
  , Badge -> Maybe Text
badgeSlug :: !(Maybe Text) -- ^ "slug"
  } deriving (Int -> Badge -> ShowS
[Badge] -> ShowS
Badge -> [Char]
(Int -> Badge -> ShowS)
-> (Badge -> [Char]) -> ([Badge] -> ShowS) -> Show Badge
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Badge -> ShowS
showsPrec :: Int -> Badge -> ShowS
$cshow :: Badge -> [Char]
show :: Badge -> [Char]
$cshowList :: [Badge] -> ShowS
showList :: [Badge] -> ShowS
P.Show, Badge -> Badge -> Bool
(Badge -> Badge -> Bool) -> (Badge -> Badge -> Bool) -> Eq Badge
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Badge -> Badge -> Bool
== :: Badge -> Badge -> Bool
$c/= :: Badge -> Badge -> Bool
/= :: Badge -> Badge -> Bool
P.Eq, P.Typeable)

-- | FromJSON Badge
instance A.FromJSON Badge where
  parseJSON :: Value -> Parser Badge
parseJSON = [Char] -> (Object -> Parser Badge) -> Value -> Parser Badge
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Badge" ((Object -> Parser Badge) -> Value -> Parser Badge)
-> (Object -> Parser Badge) -> Value -> Parser Badge
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Integer -> Maybe Text -> Maybe Text -> Badge
Badge
      (Maybe Text -> Maybe Integer -> Maybe Text -> Maybe Text -> Badge)
-> Parser (Maybe Text)
-> Parser (Maybe Integer -> Maybe Text -> Maybe Text -> Badge)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser (Maybe Integer -> Maybe Text -> Maybe Text -> Badge)
-> Parser (Maybe Integer)
-> Parser (Maybe Text -> Maybe Text -> Badge)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser (Maybe Text -> Maybe Text -> Badge)
-> Parser (Maybe Text) -> Parser (Maybe Text -> Badge)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"image_url")
      Parser (Maybe Text -> Badge) -> Parser (Maybe Text) -> Parser Badge
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"slug")

-- | ToJSON Badge
instance A.ToJSON Badge where
  toJSON :: Badge -> Value
toJSON Badge {Maybe Integer
Maybe Text
$sel:badgeDescription:Badge :: Badge -> Maybe Text
$sel:badgeId:Badge :: Badge -> Maybe Integer
$sel:badgeImageUrl:Badge :: Badge -> Maybe Text
$sel:badgeSlug:Badge :: Badge -> Maybe Text
badgeDescription :: Maybe Text
badgeId :: Maybe Integer
badgeImageUrl :: Maybe Text
badgeSlug :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
badgeDescription
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
badgeId
      , Key
"image_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
badgeImageUrl
      , Key
"slug" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
badgeSlug
      ]


-- | Construct a value of type 'Badge' (by applying it's required fields, if any)
mkBadge
  :: Badge
mkBadge :: Badge
mkBadge =
  Badge
  { $sel:badgeDescription:Badge :: Maybe Text
badgeDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:badgeId:Badge :: Maybe Integer
badgeId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:badgeImageUrl:Badge :: Maybe Text
badgeImageUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:badgeSlug:Badge :: Maybe Text
badgeSlug = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** Branch
-- | Branch
-- Branch represents a repository branch
data Branch = Branch
  { Branch -> Maybe PayloadCommit
branchCommit :: !(Maybe PayloadCommit) -- ^ "commit"
  , Branch -> Maybe Text
branchEffectiveBranchProtectionName :: !(Maybe Text) -- ^ "effective_branch_protection_name"
  , Branch -> Maybe Bool
branchEnableStatusCheck :: !(Maybe Bool) -- ^ "enable_status_check"
  , Branch -> Maybe Text
branchName :: !(Maybe Text) -- ^ "name"
  , Branch -> Maybe Bool
branchProtected :: !(Maybe Bool) -- ^ "protected"
  , Branch -> Maybe Integer
branchRequiredApprovals :: !(Maybe Integer) -- ^ "required_approvals"
  , Branch -> Maybe [Text]
branchStatusCheckContexts :: !(Maybe [Text]) -- ^ "status_check_contexts"
  , Branch -> Maybe Bool
branchUserCanMerge :: !(Maybe Bool) -- ^ "user_can_merge"
  , Branch -> Maybe Bool
branchUserCanPush :: !(Maybe Bool) -- ^ "user_can_push"
  } deriving (Int -> Branch -> ShowS
[Branch] -> ShowS
Branch -> [Char]
(Int -> Branch -> ShowS)
-> (Branch -> [Char]) -> ([Branch] -> ShowS) -> Show Branch
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Branch -> ShowS
showsPrec :: Int -> Branch -> ShowS
$cshow :: Branch -> [Char]
show :: Branch -> [Char]
$cshowList :: [Branch] -> ShowS
showList :: [Branch] -> ShowS
P.Show, Branch -> Branch -> Bool
(Branch -> Branch -> Bool)
-> (Branch -> Branch -> Bool) -> Eq Branch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Branch -> Branch -> Bool
== :: Branch -> Branch -> Bool
$c/= :: Branch -> Branch -> Bool
/= :: Branch -> Branch -> Bool
P.Eq, P.Typeable)

-- | FromJSON Branch
instance A.FromJSON Branch where
  parseJSON :: Value -> Parser Branch
parseJSON = [Char] -> (Object -> Parser Branch) -> Value -> Parser Branch
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Branch" ((Object -> Parser Branch) -> Value -> Parser Branch)
-> (Object -> Parser Branch) -> Value -> Parser Branch
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe PayloadCommit
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> Maybe Integer
-> Maybe [Text]
-> Maybe Bool
-> Maybe Bool
-> Branch
Branch
      (Maybe PayloadCommit
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Integer
 -> Maybe [Text]
 -> Maybe Bool
 -> Maybe Bool
 -> Branch)
-> Parser (Maybe PayloadCommit)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Bool
      -> Branch)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe PayloadCommit)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"commit")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Bool
   -> Branch)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Bool
      -> Branch)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"effective_branch_protection_name")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Bool
   -> Branch)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Bool
      -> Branch)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enable_status_check")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Bool
   -> Branch)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Bool
      -> Branch)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser
  (Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Bool
   -> Branch)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Integer
      -> Maybe [Text] -> Maybe Bool -> Maybe Bool -> Branch)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"protected")
      Parser
  (Maybe Integer
   -> Maybe [Text] -> Maybe Bool -> Maybe Bool -> Branch)
-> Parser (Maybe Integer)
-> Parser (Maybe [Text] -> Maybe Bool -> Maybe Bool -> Branch)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"required_approvals")
      Parser (Maybe [Text] -> Maybe Bool -> Maybe Bool -> Branch)
-> Parser (Maybe [Text])
-> Parser (Maybe Bool -> Maybe Bool -> Branch)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"status_check_contexts")
      Parser (Maybe Bool -> Maybe Bool -> Branch)
-> Parser (Maybe Bool) -> Parser (Maybe Bool -> Branch)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user_can_merge")
      Parser (Maybe Bool -> Branch)
-> Parser (Maybe Bool) -> Parser Branch
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user_can_push")

-- | ToJSON Branch
instance A.ToJSON Branch where
  toJSON :: Branch -> Value
toJSON Branch {Maybe Bool
Maybe Integer
Maybe [Text]
Maybe Text
Maybe PayloadCommit
$sel:branchCommit:Branch :: Branch -> Maybe PayloadCommit
$sel:branchEffectiveBranchProtectionName:Branch :: Branch -> Maybe Text
$sel:branchEnableStatusCheck:Branch :: Branch -> Maybe Bool
$sel:branchName:Branch :: Branch -> Maybe Text
$sel:branchProtected:Branch :: Branch -> Maybe Bool
$sel:branchRequiredApprovals:Branch :: Branch -> Maybe Integer
$sel:branchStatusCheckContexts:Branch :: Branch -> Maybe [Text]
$sel:branchUserCanMerge:Branch :: Branch -> Maybe Bool
$sel:branchUserCanPush:Branch :: Branch -> Maybe Bool
branchCommit :: Maybe PayloadCommit
branchEffectiveBranchProtectionName :: Maybe Text
branchEnableStatusCheck :: Maybe Bool
branchName :: Maybe Text
branchProtected :: Maybe Bool
branchRequiredApprovals :: Maybe Integer
branchStatusCheckContexts :: Maybe [Text]
branchUserCanMerge :: Maybe Bool
branchUserCanPush :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"commit" Key -> Maybe PayloadCommit -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe PayloadCommit
branchCommit
      , Key
"effective_branch_protection_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
branchEffectiveBranchProtectionName
      , Key
"enable_status_check" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
branchEnableStatusCheck
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
branchName
      , Key
"protected" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
branchProtected
      , Key
"required_approvals" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
branchRequiredApprovals
      , Key
"status_check_contexts" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
branchStatusCheckContexts
      , Key
"user_can_merge" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
branchUserCanMerge
      , Key
"user_can_push" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
branchUserCanPush
      ]


-- | Construct a value of type 'Branch' (by applying it's required fields, if any)
mkBranch
  :: Branch
mkBranch :: Branch
mkBranch =
  Branch
  { $sel:branchCommit:Branch :: Maybe PayloadCommit
branchCommit = Maybe PayloadCommit
forall a. Maybe a
Nothing
  , $sel:branchEffectiveBranchProtectionName:Branch :: Maybe Text
branchEffectiveBranchProtectionName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:branchEnableStatusCheck:Branch :: Maybe Bool
branchEnableStatusCheck = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:branchName:Branch :: Maybe Text
branchName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:branchProtected:Branch :: Maybe Bool
branchProtected = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:branchRequiredApprovals:Branch :: Maybe Integer
branchRequiredApprovals = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:branchStatusCheckContexts:Branch :: Maybe [Text]
branchStatusCheckContexts = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:branchUserCanMerge:Branch :: Maybe Bool
branchUserCanMerge = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:branchUserCanPush:Branch :: Maybe Bool
branchUserCanPush = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** BranchProtection
-- | BranchProtection
-- BranchProtection represents a branch protection for a repository
data BranchProtection = BranchProtection
  { BranchProtection -> Maybe [Text]
branchProtectionApprovalsWhitelistTeams :: !(Maybe [Text]) -- ^ "approvals_whitelist_teams"
  , BranchProtection -> Maybe [Text]
branchProtectionApprovalsWhitelistUsername :: !(Maybe [Text]) -- ^ "approvals_whitelist_username"
  , BranchProtection -> Maybe Bool
branchProtectionBlockAdminMergeOverride :: !(Maybe Bool) -- ^ "block_admin_merge_override"
  , BranchProtection -> Maybe Bool
branchProtectionBlockOnOfficialReviewRequests :: !(Maybe Bool) -- ^ "block_on_official_review_requests"
  , BranchProtection -> Maybe Bool
branchProtectionBlockOnOutdatedBranch :: !(Maybe Bool) -- ^ "block_on_outdated_branch"
  , BranchProtection -> Maybe Bool
branchProtectionBlockOnRejectedReviews :: !(Maybe Bool) -- ^ "block_on_rejected_reviews"
  , BranchProtection -> Maybe Text
branchProtectionBranchName :: !(Maybe Text) -- ^ "branch_name" - Deprecated: true
  , BranchProtection -> Maybe DateTime
branchProtectionCreatedAt :: !(Maybe DateTime) -- ^ "created_at"
  , BranchProtection -> Maybe Bool
branchProtectionDismissStaleApprovals :: !(Maybe Bool) -- ^ "dismiss_stale_approvals"
  , BranchProtection -> Maybe Bool
branchProtectionEnableApprovalsWhitelist :: !(Maybe Bool) -- ^ "enable_approvals_whitelist"
  , BranchProtection -> Maybe Bool
branchProtectionEnableForcePush :: !(Maybe Bool) -- ^ "enable_force_push"
  , BranchProtection -> Maybe Bool
branchProtectionEnableForcePushAllowlist :: !(Maybe Bool) -- ^ "enable_force_push_allowlist"
  , BranchProtection -> Maybe Bool
branchProtectionEnableMergeWhitelist :: !(Maybe Bool) -- ^ "enable_merge_whitelist"
  , BranchProtection -> Maybe Bool
branchProtectionEnablePush :: !(Maybe Bool) -- ^ "enable_push"
  , BranchProtection -> Maybe Bool
branchProtectionEnablePushWhitelist :: !(Maybe Bool) -- ^ "enable_push_whitelist"
  , BranchProtection -> Maybe Bool
branchProtectionEnableStatusCheck :: !(Maybe Bool) -- ^ "enable_status_check"
  , BranchProtection -> Maybe Bool
branchProtectionForcePushAllowlistDeployKeys :: !(Maybe Bool) -- ^ "force_push_allowlist_deploy_keys"
  , BranchProtection -> Maybe [Text]
branchProtectionForcePushAllowlistTeams :: !(Maybe [Text]) -- ^ "force_push_allowlist_teams"
  , BranchProtection -> Maybe [Text]
branchProtectionForcePushAllowlistUsernames :: !(Maybe [Text]) -- ^ "force_push_allowlist_usernames"
  , BranchProtection -> Maybe Bool
branchProtectionIgnoreStaleApprovals :: !(Maybe Bool) -- ^ "ignore_stale_approvals"
  , BranchProtection -> Maybe [Text]
branchProtectionMergeWhitelistTeams :: !(Maybe [Text]) -- ^ "merge_whitelist_teams"
  , BranchProtection -> Maybe [Text]
branchProtectionMergeWhitelistUsernames :: !(Maybe [Text]) -- ^ "merge_whitelist_usernames"
  , BranchProtection -> Maybe Integer
branchProtectionPriority :: !(Maybe Integer) -- ^ "priority"
  , BranchProtection -> Maybe Text
branchProtectionProtectedFilePatterns :: !(Maybe Text) -- ^ "protected_file_patterns"
  , BranchProtection -> Maybe Bool
branchProtectionPushWhitelistDeployKeys :: !(Maybe Bool) -- ^ "push_whitelist_deploy_keys"
  , BranchProtection -> Maybe [Text]
branchProtectionPushWhitelistTeams :: !(Maybe [Text]) -- ^ "push_whitelist_teams"
  , BranchProtection -> Maybe [Text]
branchProtectionPushWhitelistUsernames :: !(Maybe [Text]) -- ^ "push_whitelist_usernames"
  , BranchProtection -> Maybe Bool
branchProtectionRequireSignedCommits :: !(Maybe Bool) -- ^ "require_signed_commits"
  , BranchProtection -> Maybe Integer
branchProtectionRequiredApprovals :: !(Maybe Integer) -- ^ "required_approvals"
  , BranchProtection -> Maybe Text
branchProtectionRuleName :: !(Maybe Text) -- ^ "rule_name"
  , BranchProtection -> Maybe [Text]
branchProtectionStatusCheckContexts :: !(Maybe [Text]) -- ^ "status_check_contexts"
  , BranchProtection -> Maybe Text
branchProtectionUnprotectedFilePatterns :: !(Maybe Text) -- ^ "unprotected_file_patterns"
  , BranchProtection -> Maybe DateTime
branchProtectionUpdatedAt :: !(Maybe DateTime) -- ^ "updated_at"
  } deriving (Int -> BranchProtection -> ShowS
[BranchProtection] -> ShowS
BranchProtection -> [Char]
(Int -> BranchProtection -> ShowS)
-> (BranchProtection -> [Char])
-> ([BranchProtection] -> ShowS)
-> Show BranchProtection
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BranchProtection -> ShowS
showsPrec :: Int -> BranchProtection -> ShowS
$cshow :: BranchProtection -> [Char]
show :: BranchProtection -> [Char]
$cshowList :: [BranchProtection] -> ShowS
showList :: [BranchProtection] -> ShowS
P.Show, BranchProtection -> BranchProtection -> Bool
(BranchProtection -> BranchProtection -> Bool)
-> (BranchProtection -> BranchProtection -> Bool)
-> Eq BranchProtection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BranchProtection -> BranchProtection -> Bool
== :: BranchProtection -> BranchProtection -> Bool
$c/= :: BranchProtection -> BranchProtection -> Bool
/= :: BranchProtection -> BranchProtection -> Bool
P.Eq, P.Typeable)

-- | FromJSON BranchProtection
instance A.FromJSON BranchProtection where
  parseJSON :: Value -> Parser BranchProtection
parseJSON = [Char]
-> (Object -> Parser BranchProtection)
-> Value
-> Parser BranchProtection
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"BranchProtection" ((Object -> Parser BranchProtection)
 -> Value -> Parser BranchProtection)
-> (Object -> Parser BranchProtection)
-> Value
-> Parser BranchProtection
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Text]
-> Maybe [Text]
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe DateTime
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe [Text]
-> Maybe [Text]
-> Maybe Bool
-> Maybe [Text]
-> Maybe [Text]
-> Maybe Integer
-> Maybe Text
-> Maybe Bool
-> Maybe [Text]
-> Maybe [Text]
-> Maybe Bool
-> Maybe Integer
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe DateTime
-> BranchProtection
BranchProtection
      (Maybe [Text]
 -> Maybe [Text]
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Text
 -> Maybe DateTime
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe [Text]
 -> Maybe [Text]
 -> Maybe Bool
 -> Maybe [Text]
 -> Maybe [Text]
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Bool
 -> Maybe [Text]
 -> Maybe [Text]
 -> Maybe Bool
 -> Maybe Integer
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe Text
 -> Maybe DateTime
 -> BranchProtection)
-> Parser (Maybe [Text])
-> Parser
     (Maybe [Text]
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"approvals_whitelist_teams")
      Parser
  (Maybe [Text]
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"approvals_whitelist_username")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"block_admin_merge_override")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"block_on_official_review_requests")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"block_on_outdated_branch")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe DateTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"block_on_rejected_reviews")
      Parser
  (Maybe Text
   -> Maybe DateTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe Text)
-> Parser
     (Maybe DateTime
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"branch_name")
      Parser
  (Maybe DateTime
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_at")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"dismiss_stale_approvals")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enable_approvals_whitelist")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enable_force_push")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enable_force_push_allowlist")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enable_merge_whitelist")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enable_push")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enable_push_whitelist")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enable_status_check")
      Parser
  (Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe Bool)
-> Parser
     (Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"force_push_allowlist_deploy_keys")
      Parser
  (Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe [Text])
-> Parser
     (Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"force_push_allowlist_teams")
      Parser
  (Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"force_push_allowlist_usernames")
      Parser
  (Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe Bool)
-> Parser
     (Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ignore_stale_approvals")
      Parser
  (Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe [Text])
-> Parser
     (Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"merge_whitelist_teams")
      Parser
  (Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"merge_whitelist_usernames")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"priority")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"protected_file_patterns")
      Parser
  (Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe Bool)
-> Parser
     (Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"push_whitelist_deploy_keys")
      Parser
  (Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe [Text])
-> Parser
     (Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"push_whitelist_teams")
      Parser
  (Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"push_whitelist_usernames")
      Parser
  (Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"require_signed_commits")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"required_approvals")
      Parser
  (Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> BranchProtection)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text] -> Maybe Text -> Maybe DateTime -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"rule_name")
      Parser
  (Maybe [Text] -> Maybe Text -> Maybe DateTime -> BranchProtection)
-> Parser (Maybe [Text])
-> Parser (Maybe Text -> Maybe DateTime -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"status_check_contexts")
      Parser (Maybe Text -> Maybe DateTime -> BranchProtection)
-> Parser (Maybe Text)
-> Parser (Maybe DateTime -> BranchProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"unprotected_file_patterns")
      Parser (Maybe DateTime -> BranchProtection)
-> Parser (Maybe DateTime) -> Parser BranchProtection
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated_at")

-- | ToJSON BranchProtection
instance A.ToJSON BranchProtection where
  toJSON :: BranchProtection -> Value
toJSON BranchProtection {Maybe Bool
Maybe Integer
Maybe [Text]
Maybe Text
Maybe DateTime
$sel:branchProtectionApprovalsWhitelistTeams:BranchProtection :: BranchProtection -> Maybe [Text]
$sel:branchProtectionApprovalsWhitelistUsername:BranchProtection :: BranchProtection -> Maybe [Text]
$sel:branchProtectionBlockAdminMergeOverride:BranchProtection :: BranchProtection -> Maybe Bool
$sel:branchProtectionBlockOnOfficialReviewRequests:BranchProtection :: BranchProtection -> Maybe Bool
$sel:branchProtectionBlockOnOutdatedBranch:BranchProtection :: BranchProtection -> Maybe Bool
$sel:branchProtectionBlockOnRejectedReviews:BranchProtection :: BranchProtection -> Maybe Bool
$sel:branchProtectionBranchName:BranchProtection :: BranchProtection -> Maybe Text
$sel:branchProtectionCreatedAt:BranchProtection :: BranchProtection -> Maybe DateTime
$sel:branchProtectionDismissStaleApprovals:BranchProtection :: BranchProtection -> Maybe Bool
$sel:branchProtectionEnableApprovalsWhitelist:BranchProtection :: BranchProtection -> Maybe Bool
$sel:branchProtectionEnableForcePush:BranchProtection :: BranchProtection -> Maybe Bool
$sel:branchProtectionEnableForcePushAllowlist:BranchProtection :: BranchProtection -> Maybe Bool
$sel:branchProtectionEnableMergeWhitelist:BranchProtection :: BranchProtection -> Maybe Bool
$sel:branchProtectionEnablePush:BranchProtection :: BranchProtection -> Maybe Bool
$sel:branchProtectionEnablePushWhitelist:BranchProtection :: BranchProtection -> Maybe Bool
$sel:branchProtectionEnableStatusCheck:BranchProtection :: BranchProtection -> Maybe Bool
$sel:branchProtectionForcePushAllowlistDeployKeys:BranchProtection :: BranchProtection -> Maybe Bool
$sel:branchProtectionForcePushAllowlistTeams:BranchProtection :: BranchProtection -> Maybe [Text]
$sel:branchProtectionForcePushAllowlistUsernames:BranchProtection :: BranchProtection -> Maybe [Text]
$sel:branchProtectionIgnoreStaleApprovals:BranchProtection :: BranchProtection -> Maybe Bool
$sel:branchProtectionMergeWhitelistTeams:BranchProtection :: BranchProtection -> Maybe [Text]
$sel:branchProtectionMergeWhitelistUsernames:BranchProtection :: BranchProtection -> Maybe [Text]
$sel:branchProtectionPriority:BranchProtection :: BranchProtection -> Maybe Integer
$sel:branchProtectionProtectedFilePatterns:BranchProtection :: BranchProtection -> Maybe Text
$sel:branchProtectionPushWhitelistDeployKeys:BranchProtection :: BranchProtection -> Maybe Bool
$sel:branchProtectionPushWhitelistTeams:BranchProtection :: BranchProtection -> Maybe [Text]
$sel:branchProtectionPushWhitelistUsernames:BranchProtection :: BranchProtection -> Maybe [Text]
$sel:branchProtectionRequireSignedCommits:BranchProtection :: BranchProtection -> Maybe Bool
$sel:branchProtectionRequiredApprovals:BranchProtection :: BranchProtection -> Maybe Integer
$sel:branchProtectionRuleName:BranchProtection :: BranchProtection -> Maybe Text
$sel:branchProtectionStatusCheckContexts:BranchProtection :: BranchProtection -> Maybe [Text]
$sel:branchProtectionUnprotectedFilePatterns:BranchProtection :: BranchProtection -> Maybe Text
$sel:branchProtectionUpdatedAt:BranchProtection :: BranchProtection -> Maybe DateTime
branchProtectionApprovalsWhitelistTeams :: Maybe [Text]
branchProtectionApprovalsWhitelistUsername :: Maybe [Text]
branchProtectionBlockAdminMergeOverride :: Maybe Bool
branchProtectionBlockOnOfficialReviewRequests :: Maybe Bool
branchProtectionBlockOnOutdatedBranch :: Maybe Bool
branchProtectionBlockOnRejectedReviews :: Maybe Bool
branchProtectionBranchName :: Maybe Text
branchProtectionCreatedAt :: Maybe DateTime
branchProtectionDismissStaleApprovals :: Maybe Bool
branchProtectionEnableApprovalsWhitelist :: Maybe Bool
branchProtectionEnableForcePush :: Maybe Bool
branchProtectionEnableForcePushAllowlist :: Maybe Bool
branchProtectionEnableMergeWhitelist :: Maybe Bool
branchProtectionEnablePush :: Maybe Bool
branchProtectionEnablePushWhitelist :: Maybe Bool
branchProtectionEnableStatusCheck :: Maybe Bool
branchProtectionForcePushAllowlistDeployKeys :: Maybe Bool
branchProtectionForcePushAllowlistTeams :: Maybe [Text]
branchProtectionForcePushAllowlistUsernames :: Maybe [Text]
branchProtectionIgnoreStaleApprovals :: Maybe Bool
branchProtectionMergeWhitelistTeams :: Maybe [Text]
branchProtectionMergeWhitelistUsernames :: Maybe [Text]
branchProtectionPriority :: Maybe Integer
branchProtectionProtectedFilePatterns :: Maybe Text
branchProtectionPushWhitelistDeployKeys :: Maybe Bool
branchProtectionPushWhitelistTeams :: Maybe [Text]
branchProtectionPushWhitelistUsernames :: Maybe [Text]
branchProtectionRequireSignedCommits :: Maybe Bool
branchProtectionRequiredApprovals :: Maybe Integer
branchProtectionRuleName :: Maybe Text
branchProtectionStatusCheckContexts :: Maybe [Text]
branchProtectionUnprotectedFilePatterns :: Maybe Text
branchProtectionUpdatedAt :: Maybe DateTime
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"approvals_whitelist_teams" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
branchProtectionApprovalsWhitelistTeams
      , Key
"approvals_whitelist_username" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
branchProtectionApprovalsWhitelistUsername
      , Key
"block_admin_merge_override" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
branchProtectionBlockAdminMergeOverride
      , Key
"block_on_official_review_requests" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
branchProtectionBlockOnOfficialReviewRequests
      , Key
"block_on_outdated_branch" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
branchProtectionBlockOnOutdatedBranch
      , Key
"block_on_rejected_reviews" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
branchProtectionBlockOnRejectedReviews
      , Key
"branch_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
branchProtectionBranchName
      , Key
"created_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
branchProtectionCreatedAt
      , Key
"dismiss_stale_approvals" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
branchProtectionDismissStaleApprovals
      , Key
"enable_approvals_whitelist" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
branchProtectionEnableApprovalsWhitelist
      , Key
"enable_force_push" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
branchProtectionEnableForcePush
      , Key
"enable_force_push_allowlist" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
branchProtectionEnableForcePushAllowlist
      , Key
"enable_merge_whitelist" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
branchProtectionEnableMergeWhitelist
      , Key
"enable_push" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
branchProtectionEnablePush
      , Key
"enable_push_whitelist" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
branchProtectionEnablePushWhitelist
      , Key
"enable_status_check" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
branchProtectionEnableStatusCheck
      , Key
"force_push_allowlist_deploy_keys" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
branchProtectionForcePushAllowlistDeployKeys
      , Key
"force_push_allowlist_teams" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
branchProtectionForcePushAllowlistTeams
      , Key
"force_push_allowlist_usernames" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
branchProtectionForcePushAllowlistUsernames
      , Key
"ignore_stale_approvals" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
branchProtectionIgnoreStaleApprovals
      , Key
"merge_whitelist_teams" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
branchProtectionMergeWhitelistTeams
      , Key
"merge_whitelist_usernames" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
branchProtectionMergeWhitelistUsernames
      , Key
"priority" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
branchProtectionPriority
      , Key
"protected_file_patterns" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
branchProtectionProtectedFilePatterns
      , Key
"push_whitelist_deploy_keys" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
branchProtectionPushWhitelistDeployKeys
      , Key
"push_whitelist_teams" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
branchProtectionPushWhitelistTeams
      , Key
"push_whitelist_usernames" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
branchProtectionPushWhitelistUsernames
      , Key
"require_signed_commits" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
branchProtectionRequireSignedCommits
      , Key
"required_approvals" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
branchProtectionRequiredApprovals
      , Key
"rule_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
branchProtectionRuleName
      , Key
"status_check_contexts" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
branchProtectionStatusCheckContexts
      , Key
"unprotected_file_patterns" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
branchProtectionUnprotectedFilePatterns
      , Key
"updated_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
branchProtectionUpdatedAt
      ]


-- | Construct a value of type 'BranchProtection' (by applying it's required fields, if any)
mkBranchProtection
  :: BranchProtection
mkBranchProtection :: BranchProtection
mkBranchProtection =
  BranchProtection
  { $sel:branchProtectionApprovalsWhitelistTeams:BranchProtection :: Maybe [Text]
branchProtectionApprovalsWhitelistTeams = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:branchProtectionApprovalsWhitelistUsername:BranchProtection :: Maybe [Text]
branchProtectionApprovalsWhitelistUsername = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:branchProtectionBlockAdminMergeOverride:BranchProtection :: Maybe Bool
branchProtectionBlockAdminMergeOverride = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:branchProtectionBlockOnOfficialReviewRequests:BranchProtection :: Maybe Bool
branchProtectionBlockOnOfficialReviewRequests = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:branchProtectionBlockOnOutdatedBranch:BranchProtection :: Maybe Bool
branchProtectionBlockOnOutdatedBranch = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:branchProtectionBlockOnRejectedReviews:BranchProtection :: Maybe Bool
branchProtectionBlockOnRejectedReviews = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:branchProtectionBranchName:BranchProtection :: Maybe Text
branchProtectionBranchName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:branchProtectionCreatedAt:BranchProtection :: Maybe DateTime
branchProtectionCreatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:branchProtectionDismissStaleApprovals:BranchProtection :: Maybe Bool
branchProtectionDismissStaleApprovals = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:branchProtectionEnableApprovalsWhitelist:BranchProtection :: Maybe Bool
branchProtectionEnableApprovalsWhitelist = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:branchProtectionEnableForcePush:BranchProtection :: Maybe Bool
branchProtectionEnableForcePush = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:branchProtectionEnableForcePushAllowlist:BranchProtection :: Maybe Bool
branchProtectionEnableForcePushAllowlist = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:branchProtectionEnableMergeWhitelist:BranchProtection :: Maybe Bool
branchProtectionEnableMergeWhitelist = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:branchProtectionEnablePush:BranchProtection :: Maybe Bool
branchProtectionEnablePush = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:branchProtectionEnablePushWhitelist:BranchProtection :: Maybe Bool
branchProtectionEnablePushWhitelist = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:branchProtectionEnableStatusCheck:BranchProtection :: Maybe Bool
branchProtectionEnableStatusCheck = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:branchProtectionForcePushAllowlistDeployKeys:BranchProtection :: Maybe Bool
branchProtectionForcePushAllowlistDeployKeys = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:branchProtectionForcePushAllowlistTeams:BranchProtection :: Maybe [Text]
branchProtectionForcePushAllowlistTeams = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:branchProtectionForcePushAllowlistUsernames:BranchProtection :: Maybe [Text]
branchProtectionForcePushAllowlistUsernames = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:branchProtectionIgnoreStaleApprovals:BranchProtection :: Maybe Bool
branchProtectionIgnoreStaleApprovals = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:branchProtectionMergeWhitelistTeams:BranchProtection :: Maybe [Text]
branchProtectionMergeWhitelistTeams = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:branchProtectionMergeWhitelistUsernames:BranchProtection :: Maybe [Text]
branchProtectionMergeWhitelistUsernames = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:branchProtectionPriority:BranchProtection :: Maybe Integer
branchProtectionPriority = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:branchProtectionProtectedFilePatterns:BranchProtection :: Maybe Text
branchProtectionProtectedFilePatterns = Maybe Text
forall a. Maybe a
Nothing
  , $sel:branchProtectionPushWhitelistDeployKeys:BranchProtection :: Maybe Bool
branchProtectionPushWhitelistDeployKeys = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:branchProtectionPushWhitelistTeams:BranchProtection :: Maybe [Text]
branchProtectionPushWhitelistTeams = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:branchProtectionPushWhitelistUsernames:BranchProtection :: Maybe [Text]
branchProtectionPushWhitelistUsernames = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:branchProtectionRequireSignedCommits:BranchProtection :: Maybe Bool
branchProtectionRequireSignedCommits = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:branchProtectionRequiredApprovals:BranchProtection :: Maybe Integer
branchProtectionRequiredApprovals = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:branchProtectionRuleName:BranchProtection :: Maybe Text
branchProtectionRuleName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:branchProtectionStatusCheckContexts:BranchProtection :: Maybe [Text]
branchProtectionStatusCheckContexts = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:branchProtectionUnprotectedFilePatterns:BranchProtection :: Maybe Text
branchProtectionUnprotectedFilePatterns = Maybe Text
forall a. Maybe a
Nothing
  , $sel:branchProtectionUpdatedAt:BranchProtection :: Maybe DateTime
branchProtectionUpdatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  }

-- ** ChangeFileOperation
-- | ChangeFileOperation
-- ChangeFileOperation for creating, updating or deleting a file
data ChangeFileOperation = ChangeFileOperation
  { ChangeFileOperation -> Maybe Text
changeFileOperationContent :: !(Maybe Text) -- ^ "content" - new or updated file content, must be base64 encoded
  , ChangeFileOperation -> Maybe Text
changeFileOperationFromPath :: !(Maybe Text) -- ^ "from_path" - old path of the file to move
  , ChangeFileOperation -> E'Operation
changeFileOperationOperation :: !(E'Operation) -- ^ /Required/ "operation" - indicates what to do with the file
  , ChangeFileOperation -> Text
changeFileOperationPath :: !(Text) -- ^ /Required/ "path" - path to the existing or new file
  , ChangeFileOperation -> Maybe Text
changeFileOperationSha :: !(Maybe Text) -- ^ "sha" - sha is the SHA for the file that already exists, required for update or delete
  } deriving (Int -> ChangeFileOperation -> ShowS
[ChangeFileOperation] -> ShowS
ChangeFileOperation -> [Char]
(Int -> ChangeFileOperation -> ShowS)
-> (ChangeFileOperation -> [Char])
-> ([ChangeFileOperation] -> ShowS)
-> Show ChangeFileOperation
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChangeFileOperation -> ShowS
showsPrec :: Int -> ChangeFileOperation -> ShowS
$cshow :: ChangeFileOperation -> [Char]
show :: ChangeFileOperation -> [Char]
$cshowList :: [ChangeFileOperation] -> ShowS
showList :: [ChangeFileOperation] -> ShowS
P.Show, ChangeFileOperation -> ChangeFileOperation -> Bool
(ChangeFileOperation -> ChangeFileOperation -> Bool)
-> (ChangeFileOperation -> ChangeFileOperation -> Bool)
-> Eq ChangeFileOperation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChangeFileOperation -> ChangeFileOperation -> Bool
== :: ChangeFileOperation -> ChangeFileOperation -> Bool
$c/= :: ChangeFileOperation -> ChangeFileOperation -> Bool
/= :: ChangeFileOperation -> ChangeFileOperation -> Bool
P.Eq, P.Typeable)

-- | FromJSON ChangeFileOperation
instance A.FromJSON ChangeFileOperation where
  parseJSON :: Value -> Parser ChangeFileOperation
parseJSON = [Char]
-> (Object -> Parser ChangeFileOperation)
-> Value
-> Parser ChangeFileOperation
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"ChangeFileOperation" ((Object -> Parser ChangeFileOperation)
 -> Value -> Parser ChangeFileOperation)
-> (Object -> Parser ChangeFileOperation)
-> Value
-> Parser ChangeFileOperation
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> E'Operation
-> Text
-> Maybe Text
-> ChangeFileOperation
ChangeFileOperation
      (Maybe Text
 -> Maybe Text
 -> E'Operation
 -> Text
 -> Maybe Text
 -> ChangeFileOperation)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> E'Operation -> Text -> Maybe Text -> ChangeFileOperation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"content")
      Parser
  (Maybe Text
   -> E'Operation -> Text -> Maybe Text -> ChangeFileOperation)
-> Parser (Maybe Text)
-> Parser
     (E'Operation -> Text -> Maybe Text -> ChangeFileOperation)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"from_path")
      Parser (E'Operation -> Text -> Maybe Text -> ChangeFileOperation)
-> Parser E'Operation
-> Parser (Text -> Maybe Text -> ChangeFileOperation)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser E'Operation
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"operation")
      Parser (Text -> Maybe Text -> ChangeFileOperation)
-> Parser Text -> Parser (Maybe Text -> ChangeFileOperation)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"path")
      Parser (Maybe Text -> ChangeFileOperation)
-> Parser (Maybe Text) -> Parser ChangeFileOperation
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sha")

-- | ToJSON ChangeFileOperation
instance A.ToJSON ChangeFileOperation where
  toJSON :: ChangeFileOperation -> Value
toJSON ChangeFileOperation {Maybe Text
Text
E'Operation
$sel:changeFileOperationContent:ChangeFileOperation :: ChangeFileOperation -> Maybe Text
$sel:changeFileOperationFromPath:ChangeFileOperation :: ChangeFileOperation -> Maybe Text
$sel:changeFileOperationOperation:ChangeFileOperation :: ChangeFileOperation -> E'Operation
$sel:changeFileOperationPath:ChangeFileOperation :: ChangeFileOperation -> Text
$sel:changeFileOperationSha:ChangeFileOperation :: ChangeFileOperation -> Maybe Text
changeFileOperationContent :: Maybe Text
changeFileOperationFromPath :: Maybe Text
changeFileOperationOperation :: E'Operation
changeFileOperationPath :: Text
changeFileOperationSha :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"content" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
changeFileOperationContent
      , Key
"from_path" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
changeFileOperationFromPath
      , Key
"operation" Key -> E'Operation -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= E'Operation
changeFileOperationOperation
      , Key
"path" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
changeFileOperationPath
      , Key
"sha" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
changeFileOperationSha
      ]


-- | Construct a value of type 'ChangeFileOperation' (by applying it's required fields, if any)
mkChangeFileOperation
  :: E'Operation -- ^ 'changeFileOperationOperation': indicates what to do with the file
  -> Text -- ^ 'changeFileOperationPath': path to the existing or new file
  -> ChangeFileOperation
mkChangeFileOperation :: E'Operation -> Text -> ChangeFileOperation
mkChangeFileOperation E'Operation
changeFileOperationOperation Text
changeFileOperationPath =
  ChangeFileOperation
  { $sel:changeFileOperationContent:ChangeFileOperation :: Maybe Text
changeFileOperationContent = Maybe Text
forall a. Maybe a
Nothing
  , $sel:changeFileOperationFromPath:ChangeFileOperation :: Maybe Text
changeFileOperationFromPath = Maybe Text
forall a. Maybe a
Nothing
  , E'Operation
$sel:changeFileOperationOperation:ChangeFileOperation :: E'Operation
changeFileOperationOperation :: E'Operation
changeFileOperationOperation
  , Text
$sel:changeFileOperationPath:ChangeFileOperation :: Text
changeFileOperationPath :: Text
changeFileOperationPath
  , $sel:changeFileOperationSha:ChangeFileOperation :: Maybe Text
changeFileOperationSha = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ChangeFilesOptions
-- | ChangeFilesOptions
-- ChangeFilesOptions options for creating, updating or deleting multiple files Note: `author` and `committer` are optional (if only one is given, it will be used for the other, otherwise the authenticated user will be used)
data ChangeFilesOptions = ChangeFilesOptions
  { ChangeFilesOptions -> Maybe Identity
changeFilesOptionsAuthor :: !(Maybe Identity) -- ^ "author"
  , ChangeFilesOptions -> Maybe Text
changeFilesOptionsBranch :: !(Maybe Text) -- ^ "branch" - branch (optional) to base this file from. if not given, the default branch is used
  , ChangeFilesOptions -> Maybe Identity
changeFilesOptionsCommitter :: !(Maybe Identity) -- ^ "committer"
  , ChangeFilesOptions -> Maybe CommitDateOptions
changeFilesOptionsDates :: !(Maybe CommitDateOptions) -- ^ "dates"
  , ChangeFilesOptions -> [ChangeFileOperation]
changeFilesOptionsFiles :: !([ChangeFileOperation]) -- ^ /Required/ "files" - list of file operations
  , ChangeFilesOptions -> Maybe Text
changeFilesOptionsMessage :: !(Maybe Text) -- ^ "message" - message (optional) for the commit of this file. if not supplied, a default message will be used
  , ChangeFilesOptions -> Maybe Text
changeFilesOptionsNewBranch :: !(Maybe Text) -- ^ "new_branch" - new_branch (optional) will make a new branch from &#x60;branch&#x60; before creating the file
  , ChangeFilesOptions -> Maybe Bool
changeFilesOptionsSignoff :: !(Maybe Bool) -- ^ "signoff" - Add a Signed-off-by trailer by the committer at the end of the commit log message.
  } deriving (Int -> ChangeFilesOptions -> ShowS
[ChangeFilesOptions] -> ShowS
ChangeFilesOptions -> [Char]
(Int -> ChangeFilesOptions -> ShowS)
-> (ChangeFilesOptions -> [Char])
-> ([ChangeFilesOptions] -> ShowS)
-> Show ChangeFilesOptions
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChangeFilesOptions -> ShowS
showsPrec :: Int -> ChangeFilesOptions -> ShowS
$cshow :: ChangeFilesOptions -> [Char]
show :: ChangeFilesOptions -> [Char]
$cshowList :: [ChangeFilesOptions] -> ShowS
showList :: [ChangeFilesOptions] -> ShowS
P.Show, ChangeFilesOptions -> ChangeFilesOptions -> Bool
(ChangeFilesOptions -> ChangeFilesOptions -> Bool)
-> (ChangeFilesOptions -> ChangeFilesOptions -> Bool)
-> Eq ChangeFilesOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChangeFilesOptions -> ChangeFilesOptions -> Bool
== :: ChangeFilesOptions -> ChangeFilesOptions -> Bool
$c/= :: ChangeFilesOptions -> ChangeFilesOptions -> Bool
/= :: ChangeFilesOptions -> ChangeFilesOptions -> Bool
P.Eq, P.Typeable)

-- | FromJSON ChangeFilesOptions
instance A.FromJSON ChangeFilesOptions where
  parseJSON :: Value -> Parser ChangeFilesOptions
parseJSON = [Char]
-> (Object -> Parser ChangeFilesOptions)
-> Value
-> Parser ChangeFilesOptions
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"ChangeFilesOptions" ((Object -> Parser ChangeFilesOptions)
 -> Value -> Parser ChangeFilesOptions)
-> (Object -> Parser ChangeFilesOptions)
-> Value
-> Parser ChangeFilesOptions
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Identity
-> Maybe Text
-> Maybe Identity
-> Maybe CommitDateOptions
-> [ChangeFileOperation]
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> ChangeFilesOptions
ChangeFilesOptions
      (Maybe Identity
 -> Maybe Text
 -> Maybe Identity
 -> Maybe CommitDateOptions
 -> [ChangeFileOperation]
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> ChangeFilesOptions)
-> Parser (Maybe Identity)
-> Parser
     (Maybe Text
      -> Maybe Identity
      -> Maybe CommitDateOptions
      -> [ChangeFileOperation]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> ChangeFilesOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Identity)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"author")
      Parser
  (Maybe Text
   -> Maybe Identity
   -> Maybe CommitDateOptions
   -> [ChangeFileOperation]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> ChangeFilesOptions)
-> Parser (Maybe Text)
-> Parser
     (Maybe Identity
      -> Maybe CommitDateOptions
      -> [ChangeFileOperation]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> ChangeFilesOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"branch")
      Parser
  (Maybe Identity
   -> Maybe CommitDateOptions
   -> [ChangeFileOperation]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> ChangeFilesOptions)
-> Parser (Maybe Identity)
-> Parser
     (Maybe CommitDateOptions
      -> [ChangeFileOperation]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> ChangeFilesOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Identity)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"committer")
      Parser
  (Maybe CommitDateOptions
   -> [ChangeFileOperation]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> ChangeFilesOptions)
-> Parser (Maybe CommitDateOptions)
-> Parser
     ([ChangeFileOperation]
      -> Maybe Text -> Maybe Text -> Maybe Bool -> ChangeFilesOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe CommitDateOptions)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"dates")
      Parser
  ([ChangeFileOperation]
   -> Maybe Text -> Maybe Text -> Maybe Bool -> ChangeFilesOptions)
-> Parser [ChangeFileOperation]
-> Parser
     (Maybe Text -> Maybe Text -> Maybe Bool -> ChangeFilesOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser [ChangeFileOperation]
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"files")
      Parser
  (Maybe Text -> Maybe Text -> Maybe Bool -> ChangeFilesOptions)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Bool -> ChangeFilesOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"message")
      Parser (Maybe Text -> Maybe Bool -> ChangeFilesOptions)
-> Parser (Maybe Text) -> Parser (Maybe Bool -> ChangeFilesOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"new_branch")
      Parser (Maybe Bool -> ChangeFilesOptions)
-> Parser (Maybe Bool) -> Parser ChangeFilesOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"signoff")

-- | ToJSON ChangeFilesOptions
instance A.ToJSON ChangeFilesOptions where
  toJSON :: ChangeFilesOptions -> Value
toJSON ChangeFilesOptions {[ChangeFileOperation]
Maybe Bool
Maybe Text
Maybe Identity
Maybe CommitDateOptions
$sel:changeFilesOptionsAuthor:ChangeFilesOptions :: ChangeFilesOptions -> Maybe Identity
$sel:changeFilesOptionsBranch:ChangeFilesOptions :: ChangeFilesOptions -> Maybe Text
$sel:changeFilesOptionsCommitter:ChangeFilesOptions :: ChangeFilesOptions -> Maybe Identity
$sel:changeFilesOptionsDates:ChangeFilesOptions :: ChangeFilesOptions -> Maybe CommitDateOptions
$sel:changeFilesOptionsFiles:ChangeFilesOptions :: ChangeFilesOptions -> [ChangeFileOperation]
$sel:changeFilesOptionsMessage:ChangeFilesOptions :: ChangeFilesOptions -> Maybe Text
$sel:changeFilesOptionsNewBranch:ChangeFilesOptions :: ChangeFilesOptions -> Maybe Text
$sel:changeFilesOptionsSignoff:ChangeFilesOptions :: ChangeFilesOptions -> Maybe Bool
changeFilesOptionsAuthor :: Maybe Identity
changeFilesOptionsBranch :: Maybe Text
changeFilesOptionsCommitter :: Maybe Identity
changeFilesOptionsDates :: Maybe CommitDateOptions
changeFilesOptionsFiles :: [ChangeFileOperation]
changeFilesOptionsMessage :: Maybe Text
changeFilesOptionsNewBranch :: Maybe Text
changeFilesOptionsSignoff :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"author" Key -> Maybe Identity -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Identity
changeFilesOptionsAuthor
      , Key
"branch" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
changeFilesOptionsBranch
      , Key
"committer" Key -> Maybe Identity -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Identity
changeFilesOptionsCommitter
      , Key
"dates" Key -> Maybe CommitDateOptions -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe CommitDateOptions
changeFilesOptionsDates
      , Key
"files" Key -> [ChangeFileOperation] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= [ChangeFileOperation]
changeFilesOptionsFiles
      , Key
"message" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
changeFilesOptionsMessage
      , Key
"new_branch" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
changeFilesOptionsNewBranch
      , Key
"signoff" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
changeFilesOptionsSignoff
      ]


-- | Construct a value of type 'ChangeFilesOptions' (by applying it's required fields, if any)
mkChangeFilesOptions
  :: [ChangeFileOperation] -- ^ 'changeFilesOptionsFiles': list of file operations
  -> ChangeFilesOptions
mkChangeFilesOptions :: [ChangeFileOperation] -> ChangeFilesOptions
mkChangeFilesOptions [ChangeFileOperation]
changeFilesOptionsFiles =
  ChangeFilesOptions
  { $sel:changeFilesOptionsAuthor:ChangeFilesOptions :: Maybe Identity
changeFilesOptionsAuthor = Maybe Identity
forall a. Maybe a
Nothing
  , $sel:changeFilesOptionsBranch:ChangeFilesOptions :: Maybe Text
changeFilesOptionsBranch = Maybe Text
forall a. Maybe a
Nothing
  , $sel:changeFilesOptionsCommitter:ChangeFilesOptions :: Maybe Identity
changeFilesOptionsCommitter = Maybe Identity
forall a. Maybe a
Nothing
  , $sel:changeFilesOptionsDates:ChangeFilesOptions :: Maybe CommitDateOptions
changeFilesOptionsDates = Maybe CommitDateOptions
forall a. Maybe a
Nothing
  , [ChangeFileOperation]
$sel:changeFilesOptionsFiles:ChangeFilesOptions :: [ChangeFileOperation]
changeFilesOptionsFiles :: [ChangeFileOperation]
changeFilesOptionsFiles
  , $sel:changeFilesOptionsMessage:ChangeFilesOptions :: Maybe Text
changeFilesOptionsMessage = Maybe Text
forall a. Maybe a
Nothing
  , $sel:changeFilesOptionsNewBranch:ChangeFilesOptions :: Maybe Text
changeFilesOptionsNewBranch = Maybe Text
forall a. Maybe a
Nothing
  , $sel:changeFilesOptionsSignoff:ChangeFilesOptions :: Maybe Bool
changeFilesOptionsSignoff = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** ChangedFile
-- | ChangedFile
-- ChangedFile store information about files affected by the pull request
data ChangedFile = ChangedFile
  { ChangedFile -> Maybe Integer
changedFileAdditions :: !(Maybe Integer) -- ^ "additions"
  , ChangedFile -> Maybe Integer
changedFileChanges :: !(Maybe Integer) -- ^ "changes"
  , ChangedFile -> Maybe Text
changedFileContentsUrl :: !(Maybe Text) -- ^ "contents_url"
  , ChangedFile -> Maybe Integer
changedFileDeletions :: !(Maybe Integer) -- ^ "deletions"
  , ChangedFile -> Maybe Text
changedFileFilename :: !(Maybe Text) -- ^ "filename"
  , ChangedFile -> Maybe Text
changedFileHtmlUrl :: !(Maybe Text) -- ^ "html_url"
  , ChangedFile -> Maybe Text
changedFilePreviousFilename :: !(Maybe Text) -- ^ "previous_filename"
  , ChangedFile -> Maybe Text
changedFileRawUrl :: !(Maybe Text) -- ^ "raw_url"
  , ChangedFile -> Maybe Text
changedFileStatus :: !(Maybe Text) -- ^ "status"
  } deriving (Int -> ChangedFile -> ShowS
[ChangedFile] -> ShowS
ChangedFile -> [Char]
(Int -> ChangedFile -> ShowS)
-> (ChangedFile -> [Char])
-> ([ChangedFile] -> ShowS)
-> Show ChangedFile
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChangedFile -> ShowS
showsPrec :: Int -> ChangedFile -> ShowS
$cshow :: ChangedFile -> [Char]
show :: ChangedFile -> [Char]
$cshowList :: [ChangedFile] -> ShowS
showList :: [ChangedFile] -> ShowS
P.Show, ChangedFile -> ChangedFile -> Bool
(ChangedFile -> ChangedFile -> Bool)
-> (ChangedFile -> ChangedFile -> Bool) -> Eq ChangedFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChangedFile -> ChangedFile -> Bool
== :: ChangedFile -> ChangedFile -> Bool
$c/= :: ChangedFile -> ChangedFile -> Bool
/= :: ChangedFile -> ChangedFile -> Bool
P.Eq, P.Typeable)

-- | FromJSON ChangedFile
instance A.FromJSON ChangedFile where
  parseJSON :: Value -> Parser ChangedFile
parseJSON = [Char]
-> (Object -> Parser ChangedFile) -> Value -> Parser ChangedFile
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"ChangedFile" ((Object -> Parser ChangedFile) -> Value -> Parser ChangedFile)
-> (Object -> Parser ChangedFile) -> Value -> Parser ChangedFile
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Integer
-> Maybe Integer
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> ChangedFile
ChangedFile
      (Maybe Integer
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> ChangedFile)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ChangedFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"additions")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ChangedFile)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ChangedFile)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"changes")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ChangedFile)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ChangedFile)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"contents_url")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ChangedFile)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ChangedFile)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"deletions")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ChangedFile)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe Text -> Maybe Text -> ChangedFile)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"filename")
      Parser
  (Maybe Text
   -> Maybe Text -> Maybe Text -> Maybe Text -> ChangedFile)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> Maybe Text -> ChangedFile)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"html_url")
      Parser (Maybe Text -> Maybe Text -> Maybe Text -> ChangedFile)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> ChangedFile)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"previous_filename")
      Parser (Maybe Text -> Maybe Text -> ChangedFile)
-> Parser (Maybe Text) -> Parser (Maybe Text -> ChangedFile)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"raw_url")
      Parser (Maybe Text -> ChangedFile)
-> Parser (Maybe Text) -> Parser ChangedFile
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"status")

-- | ToJSON ChangedFile
instance A.ToJSON ChangedFile where
  toJSON :: ChangedFile -> Value
toJSON ChangedFile {Maybe Integer
Maybe Text
$sel:changedFileAdditions:ChangedFile :: ChangedFile -> Maybe Integer
$sel:changedFileChanges:ChangedFile :: ChangedFile -> Maybe Integer
$sel:changedFileContentsUrl:ChangedFile :: ChangedFile -> Maybe Text
$sel:changedFileDeletions:ChangedFile :: ChangedFile -> Maybe Integer
$sel:changedFileFilename:ChangedFile :: ChangedFile -> Maybe Text
$sel:changedFileHtmlUrl:ChangedFile :: ChangedFile -> Maybe Text
$sel:changedFilePreviousFilename:ChangedFile :: ChangedFile -> Maybe Text
$sel:changedFileRawUrl:ChangedFile :: ChangedFile -> Maybe Text
$sel:changedFileStatus:ChangedFile :: ChangedFile -> Maybe Text
changedFileAdditions :: Maybe Integer
changedFileChanges :: Maybe Integer
changedFileContentsUrl :: Maybe Text
changedFileDeletions :: Maybe Integer
changedFileFilename :: Maybe Text
changedFileHtmlUrl :: Maybe Text
changedFilePreviousFilename :: Maybe Text
changedFileRawUrl :: Maybe Text
changedFileStatus :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"additions" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
changedFileAdditions
      , Key
"changes" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
changedFileChanges
      , Key
"contents_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
changedFileContentsUrl
      , Key
"deletions" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
changedFileDeletions
      , Key
"filename" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
changedFileFilename
      , Key
"html_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
changedFileHtmlUrl
      , Key
"previous_filename" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
changedFilePreviousFilename
      , Key
"raw_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
changedFileRawUrl
      , Key
"status" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
changedFileStatus
      ]


-- | Construct a value of type 'ChangedFile' (by applying it's required fields, if any)
mkChangedFile
  :: ChangedFile
mkChangedFile :: ChangedFile
mkChangedFile =
  ChangedFile
  { $sel:changedFileAdditions:ChangedFile :: Maybe Integer
changedFileAdditions = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:changedFileChanges:ChangedFile :: Maybe Integer
changedFileChanges = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:changedFileContentsUrl:ChangedFile :: Maybe Text
changedFileContentsUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:changedFileDeletions:ChangedFile :: Maybe Integer
changedFileDeletions = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:changedFileFilename:ChangedFile :: Maybe Text
changedFileFilename = Maybe Text
forall a. Maybe a
Nothing
  , $sel:changedFileHtmlUrl:ChangedFile :: Maybe Text
changedFileHtmlUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:changedFilePreviousFilename:ChangedFile :: Maybe Text
changedFilePreviousFilename = Maybe Text
forall a. Maybe a
Nothing
  , $sel:changedFileRawUrl:ChangedFile :: Maybe Text
changedFileRawUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:changedFileStatus:ChangedFile :: Maybe Text
changedFileStatus = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** CombinedStatus
-- | CombinedStatus
-- CombinedStatus holds the combined state of several statuses for a single commit
data CombinedStatus = CombinedStatus
  { CombinedStatus -> Maybe Text
combinedStatusCommitUrl :: !(Maybe Text) -- ^ "commit_url"
  , CombinedStatus -> Maybe Repository
combinedStatusRepository :: !(Maybe Repository) -- ^ "repository"
  , CombinedStatus -> Maybe Text
combinedStatusSha :: !(Maybe Text) -- ^ "sha"
  , CombinedStatus -> Maybe Text
combinedStatusState :: !(Maybe Text) -- ^ "state" - CommitStatusState holds the state of a CommitStatus It can be \&quot;pending\&quot;, \&quot;success\&quot;, \&quot;error\&quot; and \&quot;failure\&quot;
  , CombinedStatus -> Maybe [CommitStatus]
combinedStatusStatuses :: !(Maybe [CommitStatus]) -- ^ "statuses"
  , CombinedStatus -> Maybe Integer
combinedStatusTotalCount :: !(Maybe Integer) -- ^ "total_count"
  , CombinedStatus -> Maybe Text
combinedStatusUrl :: !(Maybe Text) -- ^ "url"
  } deriving (Int -> CombinedStatus -> ShowS
[CombinedStatus] -> ShowS
CombinedStatus -> [Char]
(Int -> CombinedStatus -> ShowS)
-> (CombinedStatus -> [Char])
-> ([CombinedStatus] -> ShowS)
-> Show CombinedStatus
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CombinedStatus -> ShowS
showsPrec :: Int -> CombinedStatus -> ShowS
$cshow :: CombinedStatus -> [Char]
show :: CombinedStatus -> [Char]
$cshowList :: [CombinedStatus] -> ShowS
showList :: [CombinedStatus] -> ShowS
P.Show, CombinedStatus -> CombinedStatus -> Bool
(CombinedStatus -> CombinedStatus -> Bool)
-> (CombinedStatus -> CombinedStatus -> Bool) -> Eq CombinedStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CombinedStatus -> CombinedStatus -> Bool
== :: CombinedStatus -> CombinedStatus -> Bool
$c/= :: CombinedStatus -> CombinedStatus -> Bool
/= :: CombinedStatus -> CombinedStatus -> Bool
P.Eq, P.Typeable)

-- | FromJSON CombinedStatus
instance A.FromJSON CombinedStatus where
  parseJSON :: Value -> Parser CombinedStatus
parseJSON = [Char]
-> (Object -> Parser CombinedStatus)
-> Value
-> Parser CombinedStatus
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CombinedStatus" ((Object -> Parser CombinedStatus)
 -> Value -> Parser CombinedStatus)
-> (Object -> Parser CombinedStatus)
-> Value
-> Parser CombinedStatus
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Repository
-> Maybe Text
-> Maybe Text
-> Maybe [CommitStatus]
-> Maybe Integer
-> Maybe Text
-> CombinedStatus
CombinedStatus
      (Maybe Text
 -> Maybe Repository
 -> Maybe Text
 -> Maybe Text
 -> Maybe [CommitStatus]
 -> Maybe Integer
 -> Maybe Text
 -> CombinedStatus)
-> Parser (Maybe Text)
-> Parser
     (Maybe Repository
      -> Maybe Text
      -> Maybe Text
      -> Maybe [CommitStatus]
      -> Maybe Integer
      -> Maybe Text
      -> CombinedStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"commit_url")
      Parser
  (Maybe Repository
   -> Maybe Text
   -> Maybe Text
   -> Maybe [CommitStatus]
   -> Maybe Integer
   -> Maybe Text
   -> CombinedStatus)
-> Parser (Maybe Repository)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe [CommitStatus]
      -> Maybe Integer
      -> Maybe Text
      -> CombinedStatus)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Repository)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"repository")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe [CommitStatus]
   -> Maybe Integer
   -> Maybe Text
   -> CombinedStatus)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe [CommitStatus]
      -> Maybe Integer
      -> Maybe Text
      -> CombinedStatus)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sha")
      Parser
  (Maybe Text
   -> Maybe [CommitStatus]
   -> Maybe Integer
   -> Maybe Text
   -> CombinedStatus)
-> Parser (Maybe Text)
-> Parser
     (Maybe [CommitStatus]
      -> Maybe Integer -> Maybe Text -> CombinedStatus)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"state")
      Parser
  (Maybe [CommitStatus]
   -> Maybe Integer -> Maybe Text -> CombinedStatus)
-> Parser (Maybe [CommitStatus])
-> Parser (Maybe Integer -> Maybe Text -> CombinedStatus)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [CommitStatus])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"statuses")
      Parser (Maybe Integer -> Maybe Text -> CombinedStatus)
-> Parser (Maybe Integer) -> Parser (Maybe Text -> CombinedStatus)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"total_count")
      Parser (Maybe Text -> CombinedStatus)
-> Parser (Maybe Text) -> Parser CombinedStatus
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")

-- | ToJSON CombinedStatus
instance A.ToJSON CombinedStatus where
  toJSON :: CombinedStatus -> Value
toJSON CombinedStatus {Maybe Integer
Maybe [CommitStatus]
Maybe Text
Maybe Repository
$sel:combinedStatusCommitUrl:CombinedStatus :: CombinedStatus -> Maybe Text
$sel:combinedStatusRepository:CombinedStatus :: CombinedStatus -> Maybe Repository
$sel:combinedStatusSha:CombinedStatus :: CombinedStatus -> Maybe Text
$sel:combinedStatusState:CombinedStatus :: CombinedStatus -> Maybe Text
$sel:combinedStatusStatuses:CombinedStatus :: CombinedStatus -> Maybe [CommitStatus]
$sel:combinedStatusTotalCount:CombinedStatus :: CombinedStatus -> Maybe Integer
$sel:combinedStatusUrl:CombinedStatus :: CombinedStatus -> Maybe Text
combinedStatusCommitUrl :: Maybe Text
combinedStatusRepository :: Maybe Repository
combinedStatusSha :: Maybe Text
combinedStatusState :: Maybe Text
combinedStatusStatuses :: Maybe [CommitStatus]
combinedStatusTotalCount :: Maybe Integer
combinedStatusUrl :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"commit_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
combinedStatusCommitUrl
      , Key
"repository" Key -> Maybe Repository -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Repository
combinedStatusRepository
      , Key
"sha" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
combinedStatusSha
      , Key
"state" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
combinedStatusState
      , Key
"statuses" Key -> Maybe [CommitStatus] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [CommitStatus]
combinedStatusStatuses
      , Key
"total_count" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
combinedStatusTotalCount
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
combinedStatusUrl
      ]


-- | Construct a value of type 'CombinedStatus' (by applying it's required fields, if any)
mkCombinedStatus
  :: CombinedStatus
mkCombinedStatus :: CombinedStatus
mkCombinedStatus =
  CombinedStatus
  { $sel:combinedStatusCommitUrl:CombinedStatus :: Maybe Text
combinedStatusCommitUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:combinedStatusRepository:CombinedStatus :: Maybe Repository
combinedStatusRepository = Maybe Repository
forall a. Maybe a
Nothing
  , $sel:combinedStatusSha:CombinedStatus :: Maybe Text
combinedStatusSha = Maybe Text
forall a. Maybe a
Nothing
  , $sel:combinedStatusState:CombinedStatus :: Maybe Text
combinedStatusState = Maybe Text
forall a. Maybe a
Nothing
  , $sel:combinedStatusStatuses:CombinedStatus :: Maybe [CommitStatus]
combinedStatusStatuses = Maybe [CommitStatus]
forall a. Maybe a
Nothing
  , $sel:combinedStatusTotalCount:CombinedStatus :: Maybe Integer
combinedStatusTotalCount = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:combinedStatusUrl:CombinedStatus :: Maybe Text
combinedStatusUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** Comment
-- | Comment
-- Comment represents a comment on a commit or issue
data Comment = Comment
  { Comment -> Maybe [Attachment]
commentAssets :: !(Maybe [Attachment]) -- ^ "assets"
  , Comment -> Maybe Text
commentBody :: !(Maybe Text) -- ^ "body"
  , Comment -> Maybe DateTime
commentCreatedAt :: !(Maybe DateTime) -- ^ "created_at"
  , Comment -> Maybe Text
commentHtmlUrl :: !(Maybe Text) -- ^ "html_url"
  , Comment -> Maybe Integer
commentId :: !(Maybe Integer) -- ^ "id"
  , Comment -> Maybe Text
commentIssueUrl :: !(Maybe Text) -- ^ "issue_url"
  , Comment -> Maybe Text
commentOriginalAuthor :: !(Maybe Text) -- ^ "original_author"
  , Comment -> Maybe Integer
commentOriginalAuthorId :: !(Maybe Integer) -- ^ "original_author_id"
  , Comment -> Maybe Text
commentPullRequestUrl :: !(Maybe Text) -- ^ "pull_request_url"
  , Comment -> Maybe DateTime
commentUpdatedAt :: !(Maybe DateTime) -- ^ "updated_at"
  , Comment -> Maybe User
commentUser :: !(Maybe User) -- ^ "user"
  } deriving (Int -> Comment -> ShowS
[Comment] -> ShowS
Comment -> [Char]
(Int -> Comment -> ShowS)
-> (Comment -> [Char]) -> ([Comment] -> ShowS) -> Show Comment
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Comment -> ShowS
showsPrec :: Int -> Comment -> ShowS
$cshow :: Comment -> [Char]
show :: Comment -> [Char]
$cshowList :: [Comment] -> ShowS
showList :: [Comment] -> ShowS
P.Show, Comment -> Comment -> Bool
(Comment -> Comment -> Bool)
-> (Comment -> Comment -> Bool) -> Eq Comment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Comment -> Comment -> Bool
== :: Comment -> Comment -> Bool
$c/= :: Comment -> Comment -> Bool
/= :: Comment -> Comment -> Bool
P.Eq, P.Typeable)

-- | FromJSON Comment
instance A.FromJSON Comment where
  parseJSON :: Value -> Parser Comment
parseJSON = [Char] -> (Object -> Parser Comment) -> Value -> Parser Comment
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Comment" ((Object -> Parser Comment) -> Value -> Parser Comment)
-> (Object -> Parser Comment) -> Value -> Parser Comment
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Attachment]
-> Maybe Text
-> Maybe DateTime
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe DateTime
-> Maybe User
-> Comment
Comment
      (Maybe [Attachment]
 -> Maybe Text
 -> Maybe DateTime
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Text
 -> Maybe DateTime
 -> Maybe User
 -> Comment)
-> Parser (Maybe [Attachment])
-> Parser
     (Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> Comment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [Attachment])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"assets")
      Parser
  (Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> Comment)
-> Parser (Maybe Text)
-> Parser
     (Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> Comment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"body")
      Parser
  (Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> Comment)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> Comment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_at")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> Comment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> Comment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"html_url")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> Comment)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> Comment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> Comment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> Comment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"issue_url")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> Comment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Text -> Maybe DateTime -> Maybe User -> Comment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"original_author")
      Parser
  (Maybe Integer
   -> Maybe Text -> Maybe DateTime -> Maybe User -> Comment)
-> Parser (Maybe Integer)
-> Parser (Maybe Text -> Maybe DateTime -> Maybe User -> Comment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"original_author_id")
      Parser (Maybe Text -> Maybe DateTime -> Maybe User -> Comment)
-> Parser (Maybe Text)
-> Parser (Maybe DateTime -> Maybe User -> Comment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pull_request_url")
      Parser (Maybe DateTime -> Maybe User -> Comment)
-> Parser (Maybe DateTime) -> Parser (Maybe User -> Comment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated_at")
      Parser (Maybe User -> Comment)
-> Parser (Maybe User) -> Parser Comment
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user")

-- | ToJSON Comment
instance A.ToJSON Comment where
  toJSON :: Comment -> Value
toJSON Comment {Maybe Integer
Maybe [Attachment]
Maybe Text
Maybe DateTime
Maybe User
$sel:commentAssets:Comment :: Comment -> Maybe [Attachment]
$sel:commentBody:Comment :: Comment -> Maybe Text
$sel:commentCreatedAt:Comment :: Comment -> Maybe DateTime
$sel:commentHtmlUrl:Comment :: Comment -> Maybe Text
$sel:commentId:Comment :: Comment -> Maybe Integer
$sel:commentIssueUrl:Comment :: Comment -> Maybe Text
$sel:commentOriginalAuthor:Comment :: Comment -> Maybe Text
$sel:commentOriginalAuthorId:Comment :: Comment -> Maybe Integer
$sel:commentPullRequestUrl:Comment :: Comment -> Maybe Text
$sel:commentUpdatedAt:Comment :: Comment -> Maybe DateTime
$sel:commentUser:Comment :: Comment -> Maybe User
commentAssets :: Maybe [Attachment]
commentBody :: Maybe Text
commentCreatedAt :: Maybe DateTime
commentHtmlUrl :: Maybe Text
commentId :: Maybe Integer
commentIssueUrl :: Maybe Text
commentOriginalAuthor :: Maybe Text
commentOriginalAuthorId :: Maybe Integer
commentPullRequestUrl :: Maybe Text
commentUpdatedAt :: Maybe DateTime
commentUser :: Maybe User
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"assets" Key -> Maybe [Attachment] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Attachment]
commentAssets
      , Key
"body" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
commentBody
      , Key
"created_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
commentCreatedAt
      , Key
"html_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
commentHtmlUrl
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
commentId
      , Key
"issue_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
commentIssueUrl
      , Key
"original_author" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
commentOriginalAuthor
      , Key
"original_author_id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
commentOriginalAuthorId
      , Key
"pull_request_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
commentPullRequestUrl
      , Key
"updated_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
commentUpdatedAt
      , Key
"user" Key -> Maybe User -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe User
commentUser
      ]


-- | Construct a value of type 'Comment' (by applying it's required fields, if any)
mkComment
  :: Comment
mkComment :: Comment
mkComment =
  Comment
  { $sel:commentAssets:Comment :: Maybe [Attachment]
commentAssets = Maybe [Attachment]
forall a. Maybe a
Nothing
  , $sel:commentBody:Comment :: Maybe Text
commentBody = Maybe Text
forall a. Maybe a
Nothing
  , $sel:commentCreatedAt:Comment :: Maybe DateTime
commentCreatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:commentHtmlUrl:Comment :: Maybe Text
commentHtmlUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:commentId:Comment :: Maybe Integer
commentId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:commentIssueUrl:Comment :: Maybe Text
commentIssueUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:commentOriginalAuthor:Comment :: Maybe Text
commentOriginalAuthor = Maybe Text
forall a. Maybe a
Nothing
  , $sel:commentOriginalAuthorId:Comment :: Maybe Integer
commentOriginalAuthorId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:commentPullRequestUrl:Comment :: Maybe Text
commentPullRequestUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:commentUpdatedAt:Comment :: Maybe DateTime
commentUpdatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:commentUser:Comment :: Maybe User
commentUser = Maybe User
forall a. Maybe a
Nothing
  }

-- ** Commit
-- | Commit
-- Commit contains information generated from a Git commit.
-- 
data Commit = Commit
  { Commit -> Maybe User
commitAuthor :: !(Maybe User) -- ^ "author"
  , Commit -> Maybe RepoCommit
commitCommit :: !(Maybe RepoCommit) -- ^ "commit"
  , Commit -> Maybe User
commitCommitter :: !(Maybe User) -- ^ "committer"
  , Commit -> Maybe DateTime
commitCreated :: !(Maybe DateTime) -- ^ "created"
  , Commit -> Maybe [CommitAffectedFiles]
commitFiles :: !(Maybe [CommitAffectedFiles]) -- ^ "files"
  , Commit -> Maybe Text
commitHtmlUrl :: !(Maybe Text) -- ^ "html_url"
  , Commit -> Maybe [CommitMeta]
commitParents :: !(Maybe [CommitMeta]) -- ^ "parents"
  , Commit -> Maybe Text
commitSha :: !(Maybe Text) -- ^ "sha"
  , Commit -> Maybe CommitStats
commitStats :: !(Maybe CommitStats) -- ^ "stats"
  , Commit -> Maybe Text
commitUrl :: !(Maybe Text) -- ^ "url"
  } deriving (Int -> Commit -> ShowS
[Commit] -> ShowS
Commit -> [Char]
(Int -> Commit -> ShowS)
-> (Commit -> [Char]) -> ([Commit] -> ShowS) -> Show Commit
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Commit -> ShowS
showsPrec :: Int -> Commit -> ShowS
$cshow :: Commit -> [Char]
show :: Commit -> [Char]
$cshowList :: [Commit] -> ShowS
showList :: [Commit] -> ShowS
P.Show, Commit -> Commit -> Bool
(Commit -> Commit -> Bool)
-> (Commit -> Commit -> Bool) -> Eq Commit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Commit -> Commit -> Bool
== :: Commit -> Commit -> Bool
$c/= :: Commit -> Commit -> Bool
/= :: Commit -> Commit -> Bool
P.Eq, P.Typeable)

-- | FromJSON Commit
instance A.FromJSON Commit where
  parseJSON :: Value -> Parser Commit
parseJSON = [Char] -> (Object -> Parser Commit) -> Value -> Parser Commit
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Commit" ((Object -> Parser Commit) -> Value -> Parser Commit)
-> (Object -> Parser Commit) -> Value -> Parser Commit
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe User
-> Maybe RepoCommit
-> Maybe User
-> Maybe DateTime
-> Maybe [CommitAffectedFiles]
-> Maybe Text
-> Maybe [CommitMeta]
-> Maybe Text
-> Maybe CommitStats
-> Maybe Text
-> Commit
Commit
      (Maybe User
 -> Maybe RepoCommit
 -> Maybe User
 -> Maybe DateTime
 -> Maybe [CommitAffectedFiles]
 -> Maybe Text
 -> Maybe [CommitMeta]
 -> Maybe Text
 -> Maybe CommitStats
 -> Maybe Text
 -> Commit)
-> Parser (Maybe User)
-> Parser
     (Maybe RepoCommit
      -> Maybe User
      -> Maybe DateTime
      -> Maybe [CommitAffectedFiles]
      -> Maybe Text
      -> Maybe [CommitMeta]
      -> Maybe Text
      -> Maybe CommitStats
      -> Maybe Text
      -> Commit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"author")
      Parser
  (Maybe RepoCommit
   -> Maybe User
   -> Maybe DateTime
   -> Maybe [CommitAffectedFiles]
   -> Maybe Text
   -> Maybe [CommitMeta]
   -> Maybe Text
   -> Maybe CommitStats
   -> Maybe Text
   -> Commit)
-> Parser (Maybe RepoCommit)
-> Parser
     (Maybe User
      -> Maybe DateTime
      -> Maybe [CommitAffectedFiles]
      -> Maybe Text
      -> Maybe [CommitMeta]
      -> Maybe Text
      -> Maybe CommitStats
      -> Maybe Text
      -> Commit)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe RepoCommit)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"commit")
      Parser
  (Maybe User
   -> Maybe DateTime
   -> Maybe [CommitAffectedFiles]
   -> Maybe Text
   -> Maybe [CommitMeta]
   -> Maybe Text
   -> Maybe CommitStats
   -> Maybe Text
   -> Commit)
-> Parser (Maybe User)
-> Parser
     (Maybe DateTime
      -> Maybe [CommitAffectedFiles]
      -> Maybe Text
      -> Maybe [CommitMeta]
      -> Maybe Text
      -> Maybe CommitStats
      -> Maybe Text
      -> Commit)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"committer")
      Parser
  (Maybe DateTime
   -> Maybe [CommitAffectedFiles]
   -> Maybe Text
   -> Maybe [CommitMeta]
   -> Maybe Text
   -> Maybe CommitStats
   -> Maybe Text
   -> Commit)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe [CommitAffectedFiles]
      -> Maybe Text
      -> Maybe [CommitMeta]
      -> Maybe Text
      -> Maybe CommitStats
      -> Maybe Text
      -> Commit)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe [CommitAffectedFiles]
   -> Maybe Text
   -> Maybe [CommitMeta]
   -> Maybe Text
   -> Maybe CommitStats
   -> Maybe Text
   -> Commit)
-> Parser (Maybe [CommitAffectedFiles])
-> Parser
     (Maybe Text
      -> Maybe [CommitMeta]
      -> Maybe Text
      -> Maybe CommitStats
      -> Maybe Text
      -> Commit)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [CommitAffectedFiles])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"files")
      Parser
  (Maybe Text
   -> Maybe [CommitMeta]
   -> Maybe Text
   -> Maybe CommitStats
   -> Maybe Text
   -> Commit)
-> Parser (Maybe Text)
-> Parser
     (Maybe [CommitMeta]
      -> Maybe Text -> Maybe CommitStats -> Maybe Text -> Commit)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"html_url")
      Parser
  (Maybe [CommitMeta]
   -> Maybe Text -> Maybe CommitStats -> Maybe Text -> Commit)
-> Parser (Maybe [CommitMeta])
-> Parser (Maybe Text -> Maybe CommitStats -> Maybe Text -> Commit)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [CommitMeta])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"parents")
      Parser (Maybe Text -> Maybe CommitStats -> Maybe Text -> Commit)
-> Parser (Maybe Text)
-> Parser (Maybe CommitStats -> Maybe Text -> Commit)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sha")
      Parser (Maybe CommitStats -> Maybe Text -> Commit)
-> Parser (Maybe CommitStats) -> Parser (Maybe Text -> Commit)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe CommitStats)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"stats")
      Parser (Maybe Text -> Commit)
-> Parser (Maybe Text) -> Parser Commit
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")

-- | ToJSON Commit
instance A.ToJSON Commit where
  toJSON :: Commit -> Value
toJSON Commit {Maybe [CommitMeta]
Maybe [CommitAffectedFiles]
Maybe Text
Maybe DateTime
Maybe User
Maybe RepoCommit
Maybe CommitStats
$sel:commitAuthor:Commit :: Commit -> Maybe User
$sel:commitCommit:Commit :: Commit -> Maybe RepoCommit
$sel:commitCommitter:Commit :: Commit -> Maybe User
$sel:commitCreated:Commit :: Commit -> Maybe DateTime
$sel:commitFiles:Commit :: Commit -> Maybe [CommitAffectedFiles]
$sel:commitHtmlUrl:Commit :: Commit -> Maybe Text
$sel:commitParents:Commit :: Commit -> Maybe [CommitMeta]
$sel:commitSha:Commit :: Commit -> Maybe Text
$sel:commitStats:Commit :: Commit -> Maybe CommitStats
$sel:commitUrl:Commit :: Commit -> Maybe Text
commitAuthor :: Maybe User
commitCommit :: Maybe RepoCommit
commitCommitter :: Maybe User
commitCreated :: Maybe DateTime
commitFiles :: Maybe [CommitAffectedFiles]
commitHtmlUrl :: Maybe Text
commitParents :: Maybe [CommitMeta]
commitSha :: Maybe Text
commitStats :: Maybe CommitStats
commitUrl :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"author" Key -> Maybe User -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe User
commitAuthor
      , Key
"commit" Key -> Maybe RepoCommit -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe RepoCommit
commitCommit
      , Key
"committer" Key -> Maybe User -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe User
commitCommitter
      , Key
"created" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
commitCreated
      , Key
"files" Key -> Maybe [CommitAffectedFiles] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [CommitAffectedFiles]
commitFiles
      , Key
"html_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
commitHtmlUrl
      , Key
"parents" Key -> Maybe [CommitMeta] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [CommitMeta]
commitParents
      , Key
"sha" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
commitSha
      , Key
"stats" Key -> Maybe CommitStats -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe CommitStats
commitStats
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
commitUrl
      ]


-- | Construct a value of type 'Commit' (by applying it's required fields, if any)
mkCommit
  :: Commit
mkCommit :: Commit
mkCommit =
  Commit
  { $sel:commitAuthor:Commit :: Maybe User
commitAuthor = Maybe User
forall a. Maybe a
Nothing
  , $sel:commitCommit:Commit :: Maybe RepoCommit
commitCommit = Maybe RepoCommit
forall a. Maybe a
Nothing
  , $sel:commitCommitter:Commit :: Maybe User
commitCommitter = Maybe User
forall a. Maybe a
Nothing
  , $sel:commitCreated:Commit :: Maybe DateTime
commitCreated = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:commitFiles:Commit :: Maybe [CommitAffectedFiles]
commitFiles = Maybe [CommitAffectedFiles]
forall a. Maybe a
Nothing
  , $sel:commitHtmlUrl:Commit :: Maybe Text
commitHtmlUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:commitParents:Commit :: Maybe [CommitMeta]
commitParents = Maybe [CommitMeta]
forall a. Maybe a
Nothing
  , $sel:commitSha:Commit :: Maybe Text
commitSha = Maybe Text
forall a. Maybe a
Nothing
  , $sel:commitStats:Commit :: Maybe CommitStats
commitStats = Maybe CommitStats
forall a. Maybe a
Nothing
  , $sel:commitUrl:Commit :: Maybe Text
commitUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** CommitAffectedFiles
-- | CommitAffectedFiles
-- CommitAffectedFiles store information about files affected by the commit
data CommitAffectedFiles = CommitAffectedFiles
  { CommitAffectedFiles -> Maybe Text
commitAffectedFilesFilename :: !(Maybe Text) -- ^ "filename"
  , CommitAffectedFiles -> Maybe Text
commitAffectedFilesStatus :: !(Maybe Text) -- ^ "status"
  } deriving (Int -> CommitAffectedFiles -> ShowS
[CommitAffectedFiles] -> ShowS
CommitAffectedFiles -> [Char]
(Int -> CommitAffectedFiles -> ShowS)
-> (CommitAffectedFiles -> [Char])
-> ([CommitAffectedFiles] -> ShowS)
-> Show CommitAffectedFiles
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommitAffectedFiles -> ShowS
showsPrec :: Int -> CommitAffectedFiles -> ShowS
$cshow :: CommitAffectedFiles -> [Char]
show :: CommitAffectedFiles -> [Char]
$cshowList :: [CommitAffectedFiles] -> ShowS
showList :: [CommitAffectedFiles] -> ShowS
P.Show, CommitAffectedFiles -> CommitAffectedFiles -> Bool
(CommitAffectedFiles -> CommitAffectedFiles -> Bool)
-> (CommitAffectedFiles -> CommitAffectedFiles -> Bool)
-> Eq CommitAffectedFiles
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommitAffectedFiles -> CommitAffectedFiles -> Bool
== :: CommitAffectedFiles -> CommitAffectedFiles -> Bool
$c/= :: CommitAffectedFiles -> CommitAffectedFiles -> Bool
/= :: CommitAffectedFiles -> CommitAffectedFiles -> Bool
P.Eq, P.Typeable)

-- | FromJSON CommitAffectedFiles
instance A.FromJSON CommitAffectedFiles where
  parseJSON :: Value -> Parser CommitAffectedFiles
parseJSON = [Char]
-> (Object -> Parser CommitAffectedFiles)
-> Value
-> Parser CommitAffectedFiles
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CommitAffectedFiles" ((Object -> Parser CommitAffectedFiles)
 -> Value -> Parser CommitAffectedFiles)
-> (Object -> Parser CommitAffectedFiles)
-> Value
-> Parser CommitAffectedFiles
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Text -> CommitAffectedFiles
CommitAffectedFiles
      (Maybe Text -> Maybe Text -> CommitAffectedFiles)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> CommitAffectedFiles)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"filename")
      Parser (Maybe Text -> CommitAffectedFiles)
-> Parser (Maybe Text) -> Parser CommitAffectedFiles
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"status")

-- | ToJSON CommitAffectedFiles
instance A.ToJSON CommitAffectedFiles where
  toJSON :: CommitAffectedFiles -> Value
toJSON CommitAffectedFiles {Maybe Text
$sel:commitAffectedFilesFilename:CommitAffectedFiles :: CommitAffectedFiles -> Maybe Text
$sel:commitAffectedFilesStatus:CommitAffectedFiles :: CommitAffectedFiles -> Maybe Text
commitAffectedFilesFilename :: Maybe Text
commitAffectedFilesStatus :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"filename" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
commitAffectedFilesFilename
      , Key
"status" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
commitAffectedFilesStatus
      ]


-- | Construct a value of type 'CommitAffectedFiles' (by applying it's required fields, if any)
mkCommitAffectedFiles
  :: CommitAffectedFiles
mkCommitAffectedFiles :: CommitAffectedFiles
mkCommitAffectedFiles =
  CommitAffectedFiles
  { $sel:commitAffectedFilesFilename:CommitAffectedFiles :: Maybe Text
commitAffectedFilesFilename = Maybe Text
forall a. Maybe a
Nothing
  , $sel:commitAffectedFilesStatus:CommitAffectedFiles :: Maybe Text
commitAffectedFilesStatus = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** CommitDateOptions
-- | CommitDateOptions
-- CommitDateOptions store dates for GIT_AUTHOR_DATE and GIT_COMMITTER_DATE
data CommitDateOptions = CommitDateOptions
  { CommitDateOptions -> Maybe DateTime
commitDateOptionsAuthor :: !(Maybe DateTime) -- ^ "author"
  , CommitDateOptions -> Maybe DateTime
commitDateOptionsCommitter :: !(Maybe DateTime) -- ^ "committer"
  } deriving (Int -> CommitDateOptions -> ShowS
[CommitDateOptions] -> ShowS
CommitDateOptions -> [Char]
(Int -> CommitDateOptions -> ShowS)
-> (CommitDateOptions -> [Char])
-> ([CommitDateOptions] -> ShowS)
-> Show CommitDateOptions
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommitDateOptions -> ShowS
showsPrec :: Int -> CommitDateOptions -> ShowS
$cshow :: CommitDateOptions -> [Char]
show :: CommitDateOptions -> [Char]
$cshowList :: [CommitDateOptions] -> ShowS
showList :: [CommitDateOptions] -> ShowS
P.Show, CommitDateOptions -> CommitDateOptions -> Bool
(CommitDateOptions -> CommitDateOptions -> Bool)
-> (CommitDateOptions -> CommitDateOptions -> Bool)
-> Eq CommitDateOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommitDateOptions -> CommitDateOptions -> Bool
== :: CommitDateOptions -> CommitDateOptions -> Bool
$c/= :: CommitDateOptions -> CommitDateOptions -> Bool
/= :: CommitDateOptions -> CommitDateOptions -> Bool
P.Eq, P.Typeable)

-- | FromJSON CommitDateOptions
instance A.FromJSON CommitDateOptions where
  parseJSON :: Value -> Parser CommitDateOptions
parseJSON = [Char]
-> (Object -> Parser CommitDateOptions)
-> Value
-> Parser CommitDateOptions
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CommitDateOptions" ((Object -> Parser CommitDateOptions)
 -> Value -> Parser CommitDateOptions)
-> (Object -> Parser CommitDateOptions)
-> Value
-> Parser CommitDateOptions
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe DateTime -> Maybe DateTime -> CommitDateOptions
CommitDateOptions
      (Maybe DateTime -> Maybe DateTime -> CommitDateOptions)
-> Parser (Maybe DateTime)
-> Parser (Maybe DateTime -> CommitDateOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"author")
      Parser (Maybe DateTime -> CommitDateOptions)
-> Parser (Maybe DateTime) -> Parser CommitDateOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"committer")

-- | ToJSON CommitDateOptions
instance A.ToJSON CommitDateOptions where
  toJSON :: CommitDateOptions -> Value
toJSON CommitDateOptions {Maybe DateTime
$sel:commitDateOptionsAuthor:CommitDateOptions :: CommitDateOptions -> Maybe DateTime
$sel:commitDateOptionsCommitter:CommitDateOptions :: CommitDateOptions -> Maybe DateTime
commitDateOptionsAuthor :: Maybe DateTime
commitDateOptionsCommitter :: Maybe DateTime
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"author" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
commitDateOptionsAuthor
      , Key
"committer" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
commitDateOptionsCommitter
      ]


-- | Construct a value of type 'CommitDateOptions' (by applying it's required fields, if any)
mkCommitDateOptions
  :: CommitDateOptions
mkCommitDateOptions :: CommitDateOptions
mkCommitDateOptions =
  CommitDateOptions
  { $sel:commitDateOptionsAuthor:CommitDateOptions :: Maybe DateTime
commitDateOptionsAuthor = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:commitDateOptionsCommitter:CommitDateOptions :: Maybe DateTime
commitDateOptionsCommitter = Maybe DateTime
forall a. Maybe a
Nothing
  }

-- ** CommitMeta
-- | CommitMeta
-- CommitMeta contains meta information of a commit in terms of API.
-- 
data CommitMeta = CommitMeta
  { CommitMeta -> Maybe DateTime
commitMetaCreated :: !(Maybe DateTime) -- ^ "created"
  , CommitMeta -> Maybe Text
commitMetaSha :: !(Maybe Text) -- ^ "sha"
  , CommitMeta -> Maybe Text
commitMetaUrl :: !(Maybe Text) -- ^ "url"
  } deriving (Int -> CommitMeta -> ShowS
[CommitMeta] -> ShowS
CommitMeta -> [Char]
(Int -> CommitMeta -> ShowS)
-> (CommitMeta -> [Char])
-> ([CommitMeta] -> ShowS)
-> Show CommitMeta
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommitMeta -> ShowS
showsPrec :: Int -> CommitMeta -> ShowS
$cshow :: CommitMeta -> [Char]
show :: CommitMeta -> [Char]
$cshowList :: [CommitMeta] -> ShowS
showList :: [CommitMeta] -> ShowS
P.Show, CommitMeta -> CommitMeta -> Bool
(CommitMeta -> CommitMeta -> Bool)
-> (CommitMeta -> CommitMeta -> Bool) -> Eq CommitMeta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommitMeta -> CommitMeta -> Bool
== :: CommitMeta -> CommitMeta -> Bool
$c/= :: CommitMeta -> CommitMeta -> Bool
/= :: CommitMeta -> CommitMeta -> Bool
P.Eq, P.Typeable)

-- | FromJSON CommitMeta
instance A.FromJSON CommitMeta where
  parseJSON :: Value -> Parser CommitMeta
parseJSON = [Char]
-> (Object -> Parser CommitMeta) -> Value -> Parser CommitMeta
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CommitMeta" ((Object -> Parser CommitMeta) -> Value -> Parser CommitMeta)
-> (Object -> Parser CommitMeta) -> Value -> Parser CommitMeta
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe DateTime -> Maybe Text -> Maybe Text -> CommitMeta
CommitMeta
      (Maybe DateTime -> Maybe Text -> Maybe Text -> CommitMeta)
-> Parser (Maybe DateTime)
-> Parser (Maybe Text -> Maybe Text -> CommitMeta)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser (Maybe Text -> Maybe Text -> CommitMeta)
-> Parser (Maybe Text) -> Parser (Maybe Text -> CommitMeta)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sha")
      Parser (Maybe Text -> CommitMeta)
-> Parser (Maybe Text) -> Parser CommitMeta
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")

-- | ToJSON CommitMeta
instance A.ToJSON CommitMeta where
  toJSON :: CommitMeta -> Value
toJSON CommitMeta {Maybe Text
Maybe DateTime
$sel:commitMetaCreated:CommitMeta :: CommitMeta -> Maybe DateTime
$sel:commitMetaSha:CommitMeta :: CommitMeta -> Maybe Text
$sel:commitMetaUrl:CommitMeta :: CommitMeta -> Maybe Text
commitMetaCreated :: Maybe DateTime
commitMetaSha :: Maybe Text
commitMetaUrl :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
commitMetaCreated
      , Key
"sha" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
commitMetaSha
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
commitMetaUrl
      ]


-- | Construct a value of type 'CommitMeta' (by applying it's required fields, if any)
mkCommitMeta
  :: CommitMeta
mkCommitMeta :: CommitMeta
mkCommitMeta =
  CommitMeta
  { $sel:commitMetaCreated:CommitMeta :: Maybe DateTime
commitMetaCreated = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:commitMetaSha:CommitMeta :: Maybe Text
commitMetaSha = Maybe Text
forall a. Maybe a
Nothing
  , $sel:commitMetaUrl:CommitMeta :: Maybe Text
commitMetaUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** CommitStats
-- | CommitStats
-- CommitStats is statistics for a RepoCommit
data CommitStats = CommitStats
  { CommitStats -> Maybe Integer
commitStatsAdditions :: !(Maybe Integer) -- ^ "additions"
  , CommitStats -> Maybe Integer
commitStatsDeletions :: !(Maybe Integer) -- ^ "deletions"
  , CommitStats -> Maybe Integer
commitStatsTotal :: !(Maybe Integer) -- ^ "total"
  } deriving (Int -> CommitStats -> ShowS
[CommitStats] -> ShowS
CommitStats -> [Char]
(Int -> CommitStats -> ShowS)
-> (CommitStats -> [Char])
-> ([CommitStats] -> ShowS)
-> Show CommitStats
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommitStats -> ShowS
showsPrec :: Int -> CommitStats -> ShowS
$cshow :: CommitStats -> [Char]
show :: CommitStats -> [Char]
$cshowList :: [CommitStats] -> ShowS
showList :: [CommitStats] -> ShowS
P.Show, CommitStats -> CommitStats -> Bool
(CommitStats -> CommitStats -> Bool)
-> (CommitStats -> CommitStats -> Bool) -> Eq CommitStats
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommitStats -> CommitStats -> Bool
== :: CommitStats -> CommitStats -> Bool
$c/= :: CommitStats -> CommitStats -> Bool
/= :: CommitStats -> CommitStats -> Bool
P.Eq, P.Typeable)

-- | FromJSON CommitStats
instance A.FromJSON CommitStats where
  parseJSON :: Value -> Parser CommitStats
parseJSON = [Char]
-> (Object -> Parser CommitStats) -> Value -> Parser CommitStats
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CommitStats" ((Object -> Parser CommitStats) -> Value -> Parser CommitStats)
-> (Object -> Parser CommitStats) -> Value -> Parser CommitStats
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Integer -> Maybe Integer -> Maybe Integer -> CommitStats
CommitStats
      (Maybe Integer -> Maybe Integer -> Maybe Integer -> CommitStats)
-> Parser (Maybe Integer)
-> Parser (Maybe Integer -> Maybe Integer -> CommitStats)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"additions")
      Parser (Maybe Integer -> Maybe Integer -> CommitStats)
-> Parser (Maybe Integer) -> Parser (Maybe Integer -> CommitStats)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"deletions")
      Parser (Maybe Integer -> CommitStats)
-> Parser (Maybe Integer) -> Parser CommitStats
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"total")

-- | ToJSON CommitStats
instance A.ToJSON CommitStats where
  toJSON :: CommitStats -> Value
toJSON CommitStats {Maybe Integer
$sel:commitStatsAdditions:CommitStats :: CommitStats -> Maybe Integer
$sel:commitStatsDeletions:CommitStats :: CommitStats -> Maybe Integer
$sel:commitStatsTotal:CommitStats :: CommitStats -> Maybe Integer
commitStatsAdditions :: Maybe Integer
commitStatsDeletions :: Maybe Integer
commitStatsTotal :: Maybe Integer
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"additions" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
commitStatsAdditions
      , Key
"deletions" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
commitStatsDeletions
      , Key
"total" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
commitStatsTotal
      ]


-- | Construct a value of type 'CommitStats' (by applying it's required fields, if any)
mkCommitStats
  :: CommitStats
mkCommitStats :: CommitStats
mkCommitStats =
  CommitStats
  { $sel:commitStatsAdditions:CommitStats :: Maybe Integer
commitStatsAdditions = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:commitStatsDeletions:CommitStats :: Maybe Integer
commitStatsDeletions = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:commitStatsTotal:CommitStats :: Maybe Integer
commitStatsTotal = Maybe Integer
forall a. Maybe a
Nothing
  }

-- ** CommitStatus
-- | CommitStatus
-- CommitStatus holds a single status of a single Commit
data CommitStatus = CommitStatus
  { CommitStatus -> Maybe Text
commitStatusContext :: !(Maybe Text) -- ^ "context"
  , CommitStatus -> Maybe DateTime
commitStatusCreatedAt :: !(Maybe DateTime) -- ^ "created_at"
  , CommitStatus -> Maybe User
commitStatusCreator :: !(Maybe User) -- ^ "creator"
  , CommitStatus -> Maybe Text
commitStatusDescription :: !(Maybe Text) -- ^ "description"
  , CommitStatus -> Maybe Integer
commitStatusId :: !(Maybe Integer) -- ^ "id"
  , CommitStatus -> Maybe Text
commitStatusStatus :: !(Maybe Text) -- ^ "status" - CommitStatusState holds the state of a CommitStatus It can be \&quot;pending\&quot;, \&quot;success\&quot;, \&quot;error\&quot; and \&quot;failure\&quot;
  , CommitStatus -> Maybe Text
commitStatusTargetUrl :: !(Maybe Text) -- ^ "target_url"
  , CommitStatus -> Maybe DateTime
commitStatusUpdatedAt :: !(Maybe DateTime) -- ^ "updated_at"
  , CommitStatus -> Maybe Text
commitStatusUrl :: !(Maybe Text) -- ^ "url"
  } deriving (Int -> CommitStatus -> ShowS
[CommitStatus] -> ShowS
CommitStatus -> [Char]
(Int -> CommitStatus -> ShowS)
-> (CommitStatus -> [Char])
-> ([CommitStatus] -> ShowS)
-> Show CommitStatus
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommitStatus -> ShowS
showsPrec :: Int -> CommitStatus -> ShowS
$cshow :: CommitStatus -> [Char]
show :: CommitStatus -> [Char]
$cshowList :: [CommitStatus] -> ShowS
showList :: [CommitStatus] -> ShowS
P.Show, CommitStatus -> CommitStatus -> Bool
(CommitStatus -> CommitStatus -> Bool)
-> (CommitStatus -> CommitStatus -> Bool) -> Eq CommitStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommitStatus -> CommitStatus -> Bool
== :: CommitStatus -> CommitStatus -> Bool
$c/= :: CommitStatus -> CommitStatus -> Bool
/= :: CommitStatus -> CommitStatus -> Bool
P.Eq, P.Typeable)

-- | FromJSON CommitStatus
instance A.FromJSON CommitStatus where
  parseJSON :: Value -> Parser CommitStatus
parseJSON = [Char]
-> (Object -> Parser CommitStatus) -> Value -> Parser CommitStatus
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CommitStatus" ((Object -> Parser CommitStatus) -> Value -> Parser CommitStatus)
-> (Object -> Parser CommitStatus) -> Value -> Parser CommitStatus
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe DateTime
-> Maybe User
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe DateTime
-> Maybe Text
-> CommitStatus
CommitStatus
      (Maybe Text
 -> Maybe DateTime
 -> Maybe User
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Text
 -> Maybe DateTime
 -> Maybe Text
 -> CommitStatus)
-> Parser (Maybe Text)
-> Parser
     (Maybe DateTime
      -> Maybe User
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> CommitStatus)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"context")
      Parser
  (Maybe DateTime
   -> Maybe User
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> CommitStatus)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe User
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> CommitStatus)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_at")
      Parser
  (Maybe User
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> CommitStatus)
-> Parser (Maybe User)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> CommitStatus)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"creator")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> CommitStatus)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> CommitStatus)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> CommitStatus)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe DateTime -> Maybe Text -> CommitStatus)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Text
   -> Maybe Text -> Maybe DateTime -> Maybe Text -> CommitStatus)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe DateTime -> Maybe Text -> CommitStatus)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"status")
      Parser (Maybe Text -> Maybe DateTime -> Maybe Text -> CommitStatus)
-> Parser (Maybe Text)
-> Parser (Maybe DateTime -> Maybe Text -> CommitStatus)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"target_url")
      Parser (Maybe DateTime -> Maybe Text -> CommitStatus)
-> Parser (Maybe DateTime) -> Parser (Maybe Text -> CommitStatus)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated_at")
      Parser (Maybe Text -> CommitStatus)
-> Parser (Maybe Text) -> Parser CommitStatus
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")

-- | ToJSON CommitStatus
instance A.ToJSON CommitStatus where
  toJSON :: CommitStatus -> Value
toJSON CommitStatus {Maybe Integer
Maybe Text
Maybe DateTime
Maybe User
$sel:commitStatusContext:CommitStatus :: CommitStatus -> Maybe Text
$sel:commitStatusCreatedAt:CommitStatus :: CommitStatus -> Maybe DateTime
$sel:commitStatusCreator:CommitStatus :: CommitStatus -> Maybe User
$sel:commitStatusDescription:CommitStatus :: CommitStatus -> Maybe Text
$sel:commitStatusId:CommitStatus :: CommitStatus -> Maybe Integer
$sel:commitStatusStatus:CommitStatus :: CommitStatus -> Maybe Text
$sel:commitStatusTargetUrl:CommitStatus :: CommitStatus -> Maybe Text
$sel:commitStatusUpdatedAt:CommitStatus :: CommitStatus -> Maybe DateTime
$sel:commitStatusUrl:CommitStatus :: CommitStatus -> Maybe Text
commitStatusContext :: Maybe Text
commitStatusCreatedAt :: Maybe DateTime
commitStatusCreator :: Maybe User
commitStatusDescription :: Maybe Text
commitStatusId :: Maybe Integer
commitStatusStatus :: Maybe Text
commitStatusTargetUrl :: Maybe Text
commitStatusUpdatedAt :: Maybe DateTime
commitStatusUrl :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"context" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
commitStatusContext
      , Key
"created_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
commitStatusCreatedAt
      , Key
"creator" Key -> Maybe User -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe User
commitStatusCreator
      , Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
commitStatusDescription
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
commitStatusId
      , Key
"status" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
commitStatusStatus
      , Key
"target_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
commitStatusTargetUrl
      , Key
"updated_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
commitStatusUpdatedAt
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
commitStatusUrl
      ]


-- | Construct a value of type 'CommitStatus' (by applying it's required fields, if any)
mkCommitStatus
  :: CommitStatus
mkCommitStatus :: CommitStatus
mkCommitStatus =
  CommitStatus
  { $sel:commitStatusContext:CommitStatus :: Maybe Text
commitStatusContext = Maybe Text
forall a. Maybe a
Nothing
  , $sel:commitStatusCreatedAt:CommitStatus :: Maybe DateTime
commitStatusCreatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:commitStatusCreator:CommitStatus :: Maybe User
commitStatusCreator = Maybe User
forall a. Maybe a
Nothing
  , $sel:commitStatusDescription:CommitStatus :: Maybe Text
commitStatusDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:commitStatusId:CommitStatus :: Maybe Integer
commitStatusId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:commitStatusStatus:CommitStatus :: Maybe Text
commitStatusStatus = Maybe Text
forall a. Maybe a
Nothing
  , $sel:commitStatusTargetUrl:CommitStatus :: Maybe Text
commitStatusTargetUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:commitStatusUpdatedAt:CommitStatus :: Maybe DateTime
commitStatusUpdatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:commitStatusUrl:CommitStatus :: Maybe Text
commitStatusUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** CommitUser
-- | CommitUser
-- CommitUser contains information of a user in the context of a commit.
-- 
data CommitUser = CommitUser
  { CommitUser -> Maybe Text
commitUserDate :: !(Maybe Text) -- ^ "date"
  , CommitUser -> Maybe Text
commitUserEmail :: !(Maybe Text) -- ^ "email"
  , CommitUser -> Maybe Text
commitUserName :: !(Maybe Text) -- ^ "name"
  } deriving (Int -> CommitUser -> ShowS
[CommitUser] -> ShowS
CommitUser -> [Char]
(Int -> CommitUser -> ShowS)
-> (CommitUser -> [Char])
-> ([CommitUser] -> ShowS)
-> Show CommitUser
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommitUser -> ShowS
showsPrec :: Int -> CommitUser -> ShowS
$cshow :: CommitUser -> [Char]
show :: CommitUser -> [Char]
$cshowList :: [CommitUser] -> ShowS
showList :: [CommitUser] -> ShowS
P.Show, CommitUser -> CommitUser -> Bool
(CommitUser -> CommitUser -> Bool)
-> (CommitUser -> CommitUser -> Bool) -> Eq CommitUser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommitUser -> CommitUser -> Bool
== :: CommitUser -> CommitUser -> Bool
$c/= :: CommitUser -> CommitUser -> Bool
/= :: CommitUser -> CommitUser -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON CommitUser
instance A.ToJSON CommitUser where
  toJSON :: CommitUser -> Value
toJSON CommitUser {Maybe Text
$sel:commitUserDate:CommitUser :: CommitUser -> Maybe Text
$sel:commitUserEmail:CommitUser :: CommitUser -> Maybe Text
$sel:commitUserName:CommitUser :: CommitUser -> Maybe Text
commitUserDate :: Maybe Text
commitUserEmail :: Maybe Text
commitUserName :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"date" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
commitUserDate
      , Key
"email" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
commitUserEmail
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
commitUserName
      ]


-- | Construct a value of type 'CommitUser' (by applying it's required fields, if any)
mkCommitUser
  :: CommitUser
mkCommitUser :: CommitUser
mkCommitUser =
  CommitUser
  { $sel:commitUserDate:CommitUser :: Maybe Text
commitUserDate = Maybe Text
forall a. Maybe a
Nothing
  , $sel:commitUserEmail:CommitUser :: Maybe Text
commitUserEmail = Maybe Text
forall a. Maybe a
Nothing
  , $sel:commitUserName:CommitUser :: Maybe Text
commitUserName = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** Compare
-- | Compare
-- Compare represents a comparison between two commits.
-- 
data Compare = Compare
  { Compare -> Maybe [Commit]
compareCommits :: !(Maybe [Commit]) -- ^ "commits"
  , Compare -> Maybe Integer
compareTotalCommits :: !(Maybe Integer) -- ^ "total_commits"
  } deriving (Int -> Compare -> ShowS
[Compare] -> ShowS
Compare -> [Char]
(Int -> Compare -> ShowS)
-> (Compare -> [Char]) -> ([Compare] -> ShowS) -> Show Compare
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Compare -> ShowS
showsPrec :: Int -> Compare -> ShowS
$cshow :: Compare -> [Char]
show :: Compare -> [Char]
$cshowList :: [Compare] -> ShowS
showList :: [Compare] -> ShowS
P.Show, Compare -> Compare -> Bool
(Compare -> Compare -> Bool)
-> (Compare -> Compare -> Bool) -> Eq Compare
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Compare -> Compare -> Bool
== :: Compare -> Compare -> Bool
$c/= :: Compare -> Compare -> Bool
/= :: Compare -> Compare -> Bool
P.Eq, P.Typeable)

-- | FromJSON Compare
instance A.FromJSON Compare where
  parseJSON :: Value -> Parser Compare
parseJSON = [Char] -> (Object -> Parser Compare) -> Value -> Parser Compare
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Compare" ((Object -> Parser Compare) -> Value -> Parser Compare)
-> (Object -> Parser Compare) -> Value -> Parser Compare
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Commit] -> Maybe Integer -> Compare
Compare
      (Maybe [Commit] -> Maybe Integer -> Compare)
-> Parser (Maybe [Commit]) -> Parser (Maybe Integer -> Compare)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [Commit])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"commits")
      Parser (Maybe Integer -> Compare)
-> Parser (Maybe Integer) -> Parser Compare
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"total_commits")

-- | ToJSON Compare
instance A.ToJSON Compare where
  toJSON :: Compare -> Value
toJSON Compare {Maybe Integer
Maybe [Commit]
$sel:compareCommits:Compare :: Compare -> Maybe [Commit]
$sel:compareTotalCommits:Compare :: Compare -> Maybe Integer
compareCommits :: Maybe [Commit]
compareTotalCommits :: Maybe Integer
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"commits" Key -> Maybe [Commit] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Commit]
compareCommits
      , Key
"total_commits" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
compareTotalCommits
      ]


-- | Construct a value of type 'Compare' (by applying it's required fields, if any)
mkCompare
  :: Compare
mkCompare :: Compare
mkCompare =
  Compare
  { $sel:compareCommits:Compare :: Maybe [Commit]
compareCommits = Maybe [Commit]
forall a. Maybe a
Nothing
  , $sel:compareTotalCommits:Compare :: Maybe Integer
compareTotalCommits = Maybe Integer
forall a. Maybe a
Nothing
  }

-- ** ContentsResponse
-- | ContentsResponse
-- ContentsResponse contains information about a repo's entry's (dir, file, symlink, submodule) metadata and content
data ContentsResponse = ContentsResponse
  { ContentsResponse -> Maybe FileLinksResponse
contentsResponseLinks :: !(Maybe FileLinksResponse) -- ^ "_links"
  , ContentsResponse -> Maybe Text
contentsResponseContent :: !(Maybe Text) -- ^ "content" - &#x60;content&#x60; is populated when &#x60;type&#x60; is &#x60;file&#x60;, otherwise null
  , ContentsResponse -> Maybe Text
contentsResponseDownloadUrl :: !(Maybe Text) -- ^ "download_url"
  , ContentsResponse -> Maybe Text
contentsResponseEncoding :: !(Maybe Text) -- ^ "encoding" - &#x60;encoding&#x60; is populated when &#x60;type&#x60; is &#x60;file&#x60;, otherwise null
  , ContentsResponse -> Maybe Text
contentsResponseGitUrl :: !(Maybe Text) -- ^ "git_url"
  , ContentsResponse -> Maybe Text
contentsResponseHtmlUrl :: !(Maybe Text) -- ^ "html_url"
  , ContentsResponse -> Maybe Text
contentsResponseLastCommitSha :: !(Maybe Text) -- ^ "last_commit_sha"
  , ContentsResponse -> Maybe Text
contentsResponseName :: !(Maybe Text) -- ^ "name"
  , ContentsResponse -> Maybe Text
contentsResponsePath :: !(Maybe Text) -- ^ "path"
  , ContentsResponse -> Maybe Text
contentsResponseSha :: !(Maybe Text) -- ^ "sha"
  , ContentsResponse -> Maybe Integer
contentsResponseSize :: !(Maybe Integer) -- ^ "size"
  , ContentsResponse -> Maybe Text
contentsResponseSubmoduleGitUrl :: !(Maybe Text) -- ^ "submodule_git_url" - &#x60;submodule_git_url&#x60; is populated when &#x60;type&#x60; is &#x60;submodule&#x60;, otherwise null
  , ContentsResponse -> Maybe Text
contentsResponseTarget :: !(Maybe Text) -- ^ "target" - &#x60;target&#x60; is populated when &#x60;type&#x60; is &#x60;symlink&#x60;, otherwise null
  , ContentsResponse -> Maybe Text
contentsResponseType :: !(Maybe Text) -- ^ "type" - &#x60;type&#x60; will be &#x60;file&#x60;, &#x60;dir&#x60;, &#x60;symlink&#x60;, or &#x60;submodule&#x60;
  , ContentsResponse -> Maybe Text
contentsResponseUrl :: !(Maybe Text) -- ^ "url"
  } deriving (Int -> ContentsResponse -> ShowS
[ContentsResponse] -> ShowS
ContentsResponse -> [Char]
(Int -> ContentsResponse -> ShowS)
-> (ContentsResponse -> [Char])
-> ([ContentsResponse] -> ShowS)
-> Show ContentsResponse
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContentsResponse -> ShowS
showsPrec :: Int -> ContentsResponse -> ShowS
$cshow :: ContentsResponse -> [Char]
show :: ContentsResponse -> [Char]
$cshowList :: [ContentsResponse] -> ShowS
showList :: [ContentsResponse] -> ShowS
P.Show, ContentsResponse -> ContentsResponse -> Bool
(ContentsResponse -> ContentsResponse -> Bool)
-> (ContentsResponse -> ContentsResponse -> Bool)
-> Eq ContentsResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContentsResponse -> ContentsResponse -> Bool
== :: ContentsResponse -> ContentsResponse -> Bool
$c/= :: ContentsResponse -> ContentsResponse -> Bool
/= :: ContentsResponse -> ContentsResponse -> Bool
P.Eq, P.Typeable)

-- | FromJSON ContentsResponse
instance A.FromJSON ContentsResponse where
  parseJSON :: Value -> Parser ContentsResponse
parseJSON = [Char]
-> (Object -> Parser ContentsResponse)
-> Value
-> Parser ContentsResponse
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"ContentsResponse" ((Object -> Parser ContentsResponse)
 -> Value -> Parser ContentsResponse)
-> (Object -> Parser ContentsResponse)
-> Value
-> Parser ContentsResponse
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe FileLinksResponse
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> ContentsResponse
ContentsResponse
      (Maybe FileLinksResponse
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> ContentsResponse)
-> Parser (Maybe FileLinksResponse)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ContentsResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe FileLinksResponse)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"_links")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ContentsResponse)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ContentsResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"content")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ContentsResponse)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ContentsResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"download_url")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ContentsResponse)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ContentsResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"encoding")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ContentsResponse)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ContentsResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"git_url")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ContentsResponse)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ContentsResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"html_url")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ContentsResponse)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ContentsResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"last_commit_sha")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ContentsResponse)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ContentsResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ContentsResponse)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ContentsResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"path")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ContentsResponse)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> ContentsResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sha")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> ContentsResponse)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe Text -> Maybe Text -> ContentsResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"size")
      Parser
  (Maybe Text
   -> Maybe Text -> Maybe Text -> Maybe Text -> ContentsResponse)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Text -> Maybe Text -> ContentsResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"submodule_git_url")
      Parser (Maybe Text -> Maybe Text -> Maybe Text -> ContentsResponse)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> ContentsResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"target")
      Parser (Maybe Text -> Maybe Text -> ContentsResponse)
-> Parser (Maybe Text) -> Parser (Maybe Text -> ContentsResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"type")
      Parser (Maybe Text -> ContentsResponse)
-> Parser (Maybe Text) -> Parser ContentsResponse
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")

-- | ToJSON ContentsResponse
instance A.ToJSON ContentsResponse where
  toJSON :: ContentsResponse -> Value
toJSON ContentsResponse {Maybe Integer
Maybe Text
Maybe FileLinksResponse
$sel:contentsResponseLinks:ContentsResponse :: ContentsResponse -> Maybe FileLinksResponse
$sel:contentsResponseContent:ContentsResponse :: ContentsResponse -> Maybe Text
$sel:contentsResponseDownloadUrl:ContentsResponse :: ContentsResponse -> Maybe Text
$sel:contentsResponseEncoding:ContentsResponse :: ContentsResponse -> Maybe Text
$sel:contentsResponseGitUrl:ContentsResponse :: ContentsResponse -> Maybe Text
$sel:contentsResponseHtmlUrl:ContentsResponse :: ContentsResponse -> Maybe Text
$sel:contentsResponseLastCommitSha:ContentsResponse :: ContentsResponse -> Maybe Text
$sel:contentsResponseName:ContentsResponse :: ContentsResponse -> Maybe Text
$sel:contentsResponsePath:ContentsResponse :: ContentsResponse -> Maybe Text
$sel:contentsResponseSha:ContentsResponse :: ContentsResponse -> Maybe Text
$sel:contentsResponseSize:ContentsResponse :: ContentsResponse -> Maybe Integer
$sel:contentsResponseSubmoduleGitUrl:ContentsResponse :: ContentsResponse -> Maybe Text
$sel:contentsResponseTarget:ContentsResponse :: ContentsResponse -> Maybe Text
$sel:contentsResponseType:ContentsResponse :: ContentsResponse -> Maybe Text
$sel:contentsResponseUrl:ContentsResponse :: ContentsResponse -> Maybe Text
contentsResponseLinks :: Maybe FileLinksResponse
contentsResponseContent :: Maybe Text
contentsResponseDownloadUrl :: Maybe Text
contentsResponseEncoding :: Maybe Text
contentsResponseGitUrl :: Maybe Text
contentsResponseHtmlUrl :: Maybe Text
contentsResponseLastCommitSha :: Maybe Text
contentsResponseName :: Maybe Text
contentsResponsePath :: Maybe Text
contentsResponseSha :: Maybe Text
contentsResponseSize :: Maybe Integer
contentsResponseSubmoduleGitUrl :: Maybe Text
contentsResponseTarget :: Maybe Text
contentsResponseType :: Maybe Text
contentsResponseUrl :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"_links" Key -> Maybe FileLinksResponse -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe FileLinksResponse
contentsResponseLinks
      , Key
"content" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
contentsResponseContent
      , Key
"download_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
contentsResponseDownloadUrl
      , Key
"encoding" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
contentsResponseEncoding
      , Key
"git_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
contentsResponseGitUrl
      , Key
"html_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
contentsResponseHtmlUrl
      , Key
"last_commit_sha" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
contentsResponseLastCommitSha
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
contentsResponseName
      , Key
"path" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
contentsResponsePath
      , Key
"sha" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
contentsResponseSha
      , Key
"size" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
contentsResponseSize
      , Key
"submodule_git_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
contentsResponseSubmoduleGitUrl
      , Key
"target" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
contentsResponseTarget
      , Key
"type" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
contentsResponseType
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
contentsResponseUrl
      ]


-- | Construct a value of type 'ContentsResponse' (by applying it's required fields, if any)
mkContentsResponse
  :: ContentsResponse
mkContentsResponse :: ContentsResponse
mkContentsResponse =
  ContentsResponse
  { $sel:contentsResponseLinks:ContentsResponse :: Maybe FileLinksResponse
contentsResponseLinks = Maybe FileLinksResponse
forall a. Maybe a
Nothing
  , $sel:contentsResponseContent:ContentsResponse :: Maybe Text
contentsResponseContent = Maybe Text
forall a. Maybe a
Nothing
  , $sel:contentsResponseDownloadUrl:ContentsResponse :: Maybe Text
contentsResponseDownloadUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:contentsResponseEncoding:ContentsResponse :: Maybe Text
contentsResponseEncoding = Maybe Text
forall a. Maybe a
Nothing
  , $sel:contentsResponseGitUrl:ContentsResponse :: Maybe Text
contentsResponseGitUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:contentsResponseHtmlUrl:ContentsResponse :: Maybe Text
contentsResponseHtmlUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:contentsResponseLastCommitSha:ContentsResponse :: Maybe Text
contentsResponseLastCommitSha = Maybe Text
forall a. Maybe a
Nothing
  , $sel:contentsResponseName:ContentsResponse :: Maybe Text
contentsResponseName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:contentsResponsePath:ContentsResponse :: Maybe Text
contentsResponsePath = Maybe Text
forall a. Maybe a
Nothing
  , $sel:contentsResponseSha:ContentsResponse :: Maybe Text
contentsResponseSha = Maybe Text
forall a. Maybe a
Nothing
  , $sel:contentsResponseSize:ContentsResponse :: Maybe Integer
contentsResponseSize = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:contentsResponseSubmoduleGitUrl:ContentsResponse :: Maybe Text
contentsResponseSubmoduleGitUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:contentsResponseTarget:ContentsResponse :: Maybe Text
contentsResponseTarget = Maybe Text
forall a. Maybe a
Nothing
  , $sel:contentsResponseType:ContentsResponse :: Maybe Text
contentsResponseType = Maybe Text
forall a. Maybe a
Nothing
  , $sel:contentsResponseUrl:ContentsResponse :: Maybe Text
contentsResponseUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** CreateAccessTokenOption
-- | CreateAccessTokenOption
-- CreateAccessTokenOption options when create access token
data CreateAccessTokenOption = CreateAccessTokenOption
  { CreateAccessTokenOption -> Text
createAccessTokenOptionName :: !(Text) -- ^ /Required/ "name"
  , CreateAccessTokenOption -> Maybe [Text]
createAccessTokenOptionScopes :: !(Maybe [Text]) -- ^ "scopes"
  } deriving (Int -> CreateAccessTokenOption -> ShowS
[CreateAccessTokenOption] -> ShowS
CreateAccessTokenOption -> [Char]
(Int -> CreateAccessTokenOption -> ShowS)
-> (CreateAccessTokenOption -> [Char])
-> ([CreateAccessTokenOption] -> ShowS)
-> Show CreateAccessTokenOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateAccessTokenOption -> ShowS
showsPrec :: Int -> CreateAccessTokenOption -> ShowS
$cshow :: CreateAccessTokenOption -> [Char]
show :: CreateAccessTokenOption -> [Char]
$cshowList :: [CreateAccessTokenOption] -> ShowS
showList :: [CreateAccessTokenOption] -> ShowS
P.Show, CreateAccessTokenOption -> CreateAccessTokenOption -> Bool
(CreateAccessTokenOption -> CreateAccessTokenOption -> Bool)
-> (CreateAccessTokenOption -> CreateAccessTokenOption -> Bool)
-> Eq CreateAccessTokenOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateAccessTokenOption -> CreateAccessTokenOption -> Bool
== :: CreateAccessTokenOption -> CreateAccessTokenOption -> Bool
$c/= :: CreateAccessTokenOption -> CreateAccessTokenOption -> Bool
/= :: CreateAccessTokenOption -> CreateAccessTokenOption -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON CreateAccessTokenOption
instance A.ToJSON CreateAccessTokenOption where
  toJSON :: CreateAccessTokenOption -> Value
toJSON CreateAccessTokenOption {Maybe [Text]
Text
$sel:createAccessTokenOptionName:CreateAccessTokenOption :: CreateAccessTokenOption -> Text
$sel:createAccessTokenOptionScopes:CreateAccessTokenOption :: CreateAccessTokenOption -> Maybe [Text]
createAccessTokenOptionName :: Text
createAccessTokenOptionScopes :: Maybe [Text]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"name" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
createAccessTokenOptionName
      , Key
"scopes" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
createAccessTokenOptionScopes
      ]


-- | Construct a value of type 'CreateAccessTokenOption' (by applying it's required fields, if any)
mkCreateAccessTokenOption
  :: Text -- ^ 'createAccessTokenOptionName' 
  -> CreateAccessTokenOption
mkCreateAccessTokenOption :: Text -> CreateAccessTokenOption
mkCreateAccessTokenOption Text
createAccessTokenOptionName =
  CreateAccessTokenOption
  { Text
$sel:createAccessTokenOptionName:CreateAccessTokenOption :: Text
createAccessTokenOptionName :: Text
createAccessTokenOptionName
  , $sel:createAccessTokenOptionScopes:CreateAccessTokenOption :: Maybe [Text]
createAccessTokenOptionScopes = Maybe [Text]
forall a. Maybe a
Nothing
  }

-- ** CreateBranchProtectionOption
-- | CreateBranchProtectionOption
-- CreateBranchProtectionOption options for creating a branch protection
data CreateBranchProtectionOption = CreateBranchProtectionOption
  { CreateBranchProtectionOption -> Maybe [Text]
createBranchProtectionOptionApprovalsWhitelistTeams :: !(Maybe [Text]) -- ^ "approvals_whitelist_teams"
  , CreateBranchProtectionOption -> Maybe [Text]
createBranchProtectionOptionApprovalsWhitelistUsername :: !(Maybe [Text]) -- ^ "approvals_whitelist_username"
  , CreateBranchProtectionOption -> Maybe Bool
createBranchProtectionOptionBlockAdminMergeOverride :: !(Maybe Bool) -- ^ "block_admin_merge_override"
  , CreateBranchProtectionOption -> Maybe Bool
createBranchProtectionOptionBlockOnOfficialReviewRequests :: !(Maybe Bool) -- ^ "block_on_official_review_requests"
  , CreateBranchProtectionOption -> Maybe Bool
createBranchProtectionOptionBlockOnOutdatedBranch :: !(Maybe Bool) -- ^ "block_on_outdated_branch"
  , CreateBranchProtectionOption -> Maybe Bool
createBranchProtectionOptionBlockOnRejectedReviews :: !(Maybe Bool) -- ^ "block_on_rejected_reviews"
  , CreateBranchProtectionOption -> Maybe Text
createBranchProtectionOptionBranchName :: !(Maybe Text) -- ^ "branch_name" - Deprecated: true
  , CreateBranchProtectionOption -> Maybe Bool
createBranchProtectionOptionDismissStaleApprovals :: !(Maybe Bool) -- ^ "dismiss_stale_approvals"
  , CreateBranchProtectionOption -> Maybe Bool
createBranchProtectionOptionEnableApprovalsWhitelist :: !(Maybe Bool) -- ^ "enable_approvals_whitelist"
  , CreateBranchProtectionOption -> Maybe Bool
createBranchProtectionOptionEnableForcePush :: !(Maybe Bool) -- ^ "enable_force_push"
  , CreateBranchProtectionOption -> Maybe Bool
createBranchProtectionOptionEnableForcePushAllowlist :: !(Maybe Bool) -- ^ "enable_force_push_allowlist"
  , CreateBranchProtectionOption -> Maybe Bool
createBranchProtectionOptionEnableMergeWhitelist :: !(Maybe Bool) -- ^ "enable_merge_whitelist"
  , CreateBranchProtectionOption -> Maybe Bool
createBranchProtectionOptionEnablePush :: !(Maybe Bool) -- ^ "enable_push"
  , CreateBranchProtectionOption -> Maybe Bool
createBranchProtectionOptionEnablePushWhitelist :: !(Maybe Bool) -- ^ "enable_push_whitelist"
  , CreateBranchProtectionOption -> Maybe Bool
createBranchProtectionOptionEnableStatusCheck :: !(Maybe Bool) -- ^ "enable_status_check"
  , CreateBranchProtectionOption -> Maybe Bool
createBranchProtectionOptionForcePushAllowlistDeployKeys :: !(Maybe Bool) -- ^ "force_push_allowlist_deploy_keys"
  , CreateBranchProtectionOption -> Maybe [Text]
createBranchProtectionOptionForcePushAllowlistTeams :: !(Maybe [Text]) -- ^ "force_push_allowlist_teams"
  , CreateBranchProtectionOption -> Maybe [Text]
createBranchProtectionOptionForcePushAllowlistUsernames :: !(Maybe [Text]) -- ^ "force_push_allowlist_usernames"
  , CreateBranchProtectionOption -> Maybe Bool
createBranchProtectionOptionIgnoreStaleApprovals :: !(Maybe Bool) -- ^ "ignore_stale_approvals"
  , CreateBranchProtectionOption -> Maybe [Text]
createBranchProtectionOptionMergeWhitelistTeams :: !(Maybe [Text]) -- ^ "merge_whitelist_teams"
  , CreateBranchProtectionOption -> Maybe [Text]
createBranchProtectionOptionMergeWhitelistUsernames :: !(Maybe [Text]) -- ^ "merge_whitelist_usernames"
  , CreateBranchProtectionOption -> Maybe Integer
createBranchProtectionOptionPriority :: !(Maybe Integer) -- ^ "priority"
  , CreateBranchProtectionOption -> Maybe Text
createBranchProtectionOptionProtectedFilePatterns :: !(Maybe Text) -- ^ "protected_file_patterns"
  , CreateBranchProtectionOption -> Maybe Bool
createBranchProtectionOptionPushWhitelistDeployKeys :: !(Maybe Bool) -- ^ "push_whitelist_deploy_keys"
  , CreateBranchProtectionOption -> Maybe [Text]
createBranchProtectionOptionPushWhitelistTeams :: !(Maybe [Text]) -- ^ "push_whitelist_teams"
  , CreateBranchProtectionOption -> Maybe [Text]
createBranchProtectionOptionPushWhitelistUsernames :: !(Maybe [Text]) -- ^ "push_whitelist_usernames"
  , CreateBranchProtectionOption -> Maybe Bool
createBranchProtectionOptionRequireSignedCommits :: !(Maybe Bool) -- ^ "require_signed_commits"
  , CreateBranchProtectionOption -> Maybe Integer
createBranchProtectionOptionRequiredApprovals :: !(Maybe Integer) -- ^ "required_approvals"
  , CreateBranchProtectionOption -> Maybe Text
createBranchProtectionOptionRuleName :: !(Maybe Text) -- ^ "rule_name"
  , CreateBranchProtectionOption -> Maybe [Text]
createBranchProtectionOptionStatusCheckContexts :: !(Maybe [Text]) -- ^ "status_check_contexts"
  , CreateBranchProtectionOption -> Maybe Text
createBranchProtectionOptionUnprotectedFilePatterns :: !(Maybe Text) -- ^ "unprotected_file_patterns"
  } deriving (Int -> CreateBranchProtectionOption -> ShowS
[CreateBranchProtectionOption] -> ShowS
CreateBranchProtectionOption -> [Char]
(Int -> CreateBranchProtectionOption -> ShowS)
-> (CreateBranchProtectionOption -> [Char])
-> ([CreateBranchProtectionOption] -> ShowS)
-> Show CreateBranchProtectionOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateBranchProtectionOption -> ShowS
showsPrec :: Int -> CreateBranchProtectionOption -> ShowS
$cshow :: CreateBranchProtectionOption -> [Char]
show :: CreateBranchProtectionOption -> [Char]
$cshowList :: [CreateBranchProtectionOption] -> ShowS
showList :: [CreateBranchProtectionOption] -> ShowS
P.Show, CreateBranchProtectionOption
-> CreateBranchProtectionOption -> Bool
(CreateBranchProtectionOption
 -> CreateBranchProtectionOption -> Bool)
-> (CreateBranchProtectionOption
    -> CreateBranchProtectionOption -> Bool)
-> Eq CreateBranchProtectionOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateBranchProtectionOption
-> CreateBranchProtectionOption -> Bool
== :: CreateBranchProtectionOption
-> CreateBranchProtectionOption -> Bool
$c/= :: CreateBranchProtectionOption
-> CreateBranchProtectionOption -> Bool
/= :: CreateBranchProtectionOption
-> CreateBranchProtectionOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreateBranchProtectionOption
instance A.FromJSON CreateBranchProtectionOption where
  parseJSON :: Value -> Parser CreateBranchProtectionOption
parseJSON = [Char]
-> (Object -> Parser CreateBranchProtectionOption)
-> Value
-> Parser CreateBranchProtectionOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CreateBranchProtectionOption" ((Object -> Parser CreateBranchProtectionOption)
 -> Value -> Parser CreateBranchProtectionOption)
-> (Object -> Parser CreateBranchProtectionOption)
-> Value
-> Parser CreateBranchProtectionOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Text]
-> Maybe [Text]
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe [Text]
-> Maybe [Text]
-> Maybe Bool
-> Maybe [Text]
-> Maybe [Text]
-> Maybe Integer
-> Maybe Text
-> Maybe Bool
-> Maybe [Text]
-> Maybe [Text]
-> Maybe Bool
-> Maybe Integer
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> CreateBranchProtectionOption
CreateBranchProtectionOption
      (Maybe [Text]
 -> Maybe [Text]
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe [Text]
 -> Maybe [Text]
 -> Maybe Bool
 -> Maybe [Text]
 -> Maybe [Text]
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Bool
 -> Maybe [Text]
 -> Maybe [Text]
 -> Maybe Bool
 -> Maybe Integer
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe Text
 -> CreateBranchProtectionOption)
-> Parser (Maybe [Text])
-> Parser
     (Maybe [Text]
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"approvals_whitelist_teams")
      Parser
  (Maybe [Text]
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"approvals_whitelist_username")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"block_admin_merge_override")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"block_on_official_review_requests")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"block_on_outdated_branch")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"block_on_rejected_reviews")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"branch_name")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"dismiss_stale_approvals")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enable_approvals_whitelist")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enable_force_push")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enable_force_push_allowlist")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enable_merge_whitelist")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enable_push")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enable_push_whitelist")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enable_status_check")
      Parser
  (Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"force_push_allowlist_deploy_keys")
      Parser
  (Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe [Text])
-> Parser
     (Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"force_push_allowlist_teams")
      Parser
  (Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"force_push_allowlist_usernames")
      Parser
  (Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ignore_stale_approvals")
      Parser
  (Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe [Text])
-> Parser
     (Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"merge_whitelist_teams")
      Parser
  (Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"merge_whitelist_usernames")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"priority")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"protected_file_patterns")
      Parser
  (Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"push_whitelist_deploy_keys")
      Parser
  (Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe [Text])
-> Parser
     (Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"push_whitelist_teams")
      Parser
  (Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"push_whitelist_usernames")
      Parser
  (Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"require_signed_commits")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> CreateBranchProtectionOption)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe [Text] -> Maybe Text -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"required_approvals")
      Parser
  (Maybe Text
   -> Maybe [Text] -> Maybe Text -> CreateBranchProtectionOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text] -> Maybe Text -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"rule_name")
      Parser (Maybe [Text] -> Maybe Text -> CreateBranchProtectionOption)
-> Parser (Maybe [Text])
-> Parser (Maybe Text -> CreateBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"status_check_contexts")
      Parser (Maybe Text -> CreateBranchProtectionOption)
-> Parser (Maybe Text) -> Parser CreateBranchProtectionOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"unprotected_file_patterns")

-- | ToJSON CreateBranchProtectionOption
instance A.ToJSON CreateBranchProtectionOption where
  toJSON :: CreateBranchProtectionOption -> Value
toJSON CreateBranchProtectionOption {Maybe Bool
Maybe Integer
Maybe [Text]
Maybe Text
$sel:createBranchProtectionOptionApprovalsWhitelistTeams:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe [Text]
$sel:createBranchProtectionOptionApprovalsWhitelistUsername:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe [Text]
$sel:createBranchProtectionOptionBlockAdminMergeOverride:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe Bool
$sel:createBranchProtectionOptionBlockOnOfficialReviewRequests:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe Bool
$sel:createBranchProtectionOptionBlockOnOutdatedBranch:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe Bool
$sel:createBranchProtectionOptionBlockOnRejectedReviews:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe Bool
$sel:createBranchProtectionOptionBranchName:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe Text
$sel:createBranchProtectionOptionDismissStaleApprovals:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe Bool
$sel:createBranchProtectionOptionEnableApprovalsWhitelist:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe Bool
$sel:createBranchProtectionOptionEnableForcePush:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe Bool
$sel:createBranchProtectionOptionEnableForcePushAllowlist:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe Bool
$sel:createBranchProtectionOptionEnableMergeWhitelist:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe Bool
$sel:createBranchProtectionOptionEnablePush:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe Bool
$sel:createBranchProtectionOptionEnablePushWhitelist:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe Bool
$sel:createBranchProtectionOptionEnableStatusCheck:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe Bool
$sel:createBranchProtectionOptionForcePushAllowlistDeployKeys:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe Bool
$sel:createBranchProtectionOptionForcePushAllowlistTeams:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe [Text]
$sel:createBranchProtectionOptionForcePushAllowlistUsernames:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe [Text]
$sel:createBranchProtectionOptionIgnoreStaleApprovals:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe Bool
$sel:createBranchProtectionOptionMergeWhitelistTeams:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe [Text]
$sel:createBranchProtectionOptionMergeWhitelistUsernames:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe [Text]
$sel:createBranchProtectionOptionPriority:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe Integer
$sel:createBranchProtectionOptionProtectedFilePatterns:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe Text
$sel:createBranchProtectionOptionPushWhitelistDeployKeys:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe Bool
$sel:createBranchProtectionOptionPushWhitelistTeams:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe [Text]
$sel:createBranchProtectionOptionPushWhitelistUsernames:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe [Text]
$sel:createBranchProtectionOptionRequireSignedCommits:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe Bool
$sel:createBranchProtectionOptionRequiredApprovals:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe Integer
$sel:createBranchProtectionOptionRuleName:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe Text
$sel:createBranchProtectionOptionStatusCheckContexts:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe [Text]
$sel:createBranchProtectionOptionUnprotectedFilePatterns:CreateBranchProtectionOption :: CreateBranchProtectionOption -> Maybe Text
createBranchProtectionOptionApprovalsWhitelistTeams :: Maybe [Text]
createBranchProtectionOptionApprovalsWhitelistUsername :: Maybe [Text]
createBranchProtectionOptionBlockAdminMergeOverride :: Maybe Bool
createBranchProtectionOptionBlockOnOfficialReviewRequests :: Maybe Bool
createBranchProtectionOptionBlockOnOutdatedBranch :: Maybe Bool
createBranchProtectionOptionBlockOnRejectedReviews :: Maybe Bool
createBranchProtectionOptionBranchName :: Maybe Text
createBranchProtectionOptionDismissStaleApprovals :: Maybe Bool
createBranchProtectionOptionEnableApprovalsWhitelist :: Maybe Bool
createBranchProtectionOptionEnableForcePush :: Maybe Bool
createBranchProtectionOptionEnableForcePushAllowlist :: Maybe Bool
createBranchProtectionOptionEnableMergeWhitelist :: Maybe Bool
createBranchProtectionOptionEnablePush :: Maybe Bool
createBranchProtectionOptionEnablePushWhitelist :: Maybe Bool
createBranchProtectionOptionEnableStatusCheck :: Maybe Bool
createBranchProtectionOptionForcePushAllowlistDeployKeys :: Maybe Bool
createBranchProtectionOptionForcePushAllowlistTeams :: Maybe [Text]
createBranchProtectionOptionForcePushAllowlistUsernames :: Maybe [Text]
createBranchProtectionOptionIgnoreStaleApprovals :: Maybe Bool
createBranchProtectionOptionMergeWhitelistTeams :: Maybe [Text]
createBranchProtectionOptionMergeWhitelistUsernames :: Maybe [Text]
createBranchProtectionOptionPriority :: Maybe Integer
createBranchProtectionOptionProtectedFilePatterns :: Maybe Text
createBranchProtectionOptionPushWhitelistDeployKeys :: Maybe Bool
createBranchProtectionOptionPushWhitelistTeams :: Maybe [Text]
createBranchProtectionOptionPushWhitelistUsernames :: Maybe [Text]
createBranchProtectionOptionRequireSignedCommits :: Maybe Bool
createBranchProtectionOptionRequiredApprovals :: Maybe Integer
createBranchProtectionOptionRuleName :: Maybe Text
createBranchProtectionOptionStatusCheckContexts :: Maybe [Text]
createBranchProtectionOptionUnprotectedFilePatterns :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"approvals_whitelist_teams" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
createBranchProtectionOptionApprovalsWhitelistTeams
      , Key
"approvals_whitelist_username" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
createBranchProtectionOptionApprovalsWhitelistUsername
      , Key
"block_admin_merge_override" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createBranchProtectionOptionBlockAdminMergeOverride
      , Key
"block_on_official_review_requests" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createBranchProtectionOptionBlockOnOfficialReviewRequests
      , Key
"block_on_outdated_branch" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createBranchProtectionOptionBlockOnOutdatedBranch
      , Key
"block_on_rejected_reviews" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createBranchProtectionOptionBlockOnRejectedReviews
      , Key
"branch_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createBranchProtectionOptionBranchName
      , Key
"dismiss_stale_approvals" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createBranchProtectionOptionDismissStaleApprovals
      , Key
"enable_approvals_whitelist" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createBranchProtectionOptionEnableApprovalsWhitelist
      , Key
"enable_force_push" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createBranchProtectionOptionEnableForcePush
      , Key
"enable_force_push_allowlist" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createBranchProtectionOptionEnableForcePushAllowlist
      , Key
"enable_merge_whitelist" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createBranchProtectionOptionEnableMergeWhitelist
      , Key
"enable_push" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createBranchProtectionOptionEnablePush
      , Key
"enable_push_whitelist" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createBranchProtectionOptionEnablePushWhitelist
      , Key
"enable_status_check" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createBranchProtectionOptionEnableStatusCheck
      , Key
"force_push_allowlist_deploy_keys" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createBranchProtectionOptionForcePushAllowlistDeployKeys
      , Key
"force_push_allowlist_teams" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
createBranchProtectionOptionForcePushAllowlistTeams
      , Key
"force_push_allowlist_usernames" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
createBranchProtectionOptionForcePushAllowlistUsernames
      , Key
"ignore_stale_approvals" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createBranchProtectionOptionIgnoreStaleApprovals
      , Key
"merge_whitelist_teams" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
createBranchProtectionOptionMergeWhitelistTeams
      , Key
"merge_whitelist_usernames" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
createBranchProtectionOptionMergeWhitelistUsernames
      , Key
"priority" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
createBranchProtectionOptionPriority
      , Key
"protected_file_patterns" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createBranchProtectionOptionProtectedFilePatterns
      , Key
"push_whitelist_deploy_keys" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createBranchProtectionOptionPushWhitelistDeployKeys
      , Key
"push_whitelist_teams" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
createBranchProtectionOptionPushWhitelistTeams
      , Key
"push_whitelist_usernames" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
createBranchProtectionOptionPushWhitelistUsernames
      , Key
"require_signed_commits" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createBranchProtectionOptionRequireSignedCommits
      , Key
"required_approvals" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
createBranchProtectionOptionRequiredApprovals
      , Key
"rule_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createBranchProtectionOptionRuleName
      , Key
"status_check_contexts" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
createBranchProtectionOptionStatusCheckContexts
      , Key
"unprotected_file_patterns" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createBranchProtectionOptionUnprotectedFilePatterns
      ]


-- | Construct a value of type 'CreateBranchProtectionOption' (by applying it's required fields, if any)
mkCreateBranchProtectionOption
  :: CreateBranchProtectionOption
mkCreateBranchProtectionOption :: CreateBranchProtectionOption
mkCreateBranchProtectionOption =
  CreateBranchProtectionOption
  { $sel:createBranchProtectionOptionApprovalsWhitelistTeams:CreateBranchProtectionOption :: Maybe [Text]
createBranchProtectionOptionApprovalsWhitelistTeams = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionApprovalsWhitelistUsername:CreateBranchProtectionOption :: Maybe [Text]
createBranchProtectionOptionApprovalsWhitelistUsername = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionBlockAdminMergeOverride:CreateBranchProtectionOption :: Maybe Bool
createBranchProtectionOptionBlockAdminMergeOverride = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionBlockOnOfficialReviewRequests:CreateBranchProtectionOption :: Maybe Bool
createBranchProtectionOptionBlockOnOfficialReviewRequests = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionBlockOnOutdatedBranch:CreateBranchProtectionOption :: Maybe Bool
createBranchProtectionOptionBlockOnOutdatedBranch = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionBlockOnRejectedReviews:CreateBranchProtectionOption :: Maybe Bool
createBranchProtectionOptionBlockOnRejectedReviews = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionBranchName:CreateBranchProtectionOption :: Maybe Text
createBranchProtectionOptionBranchName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionDismissStaleApprovals:CreateBranchProtectionOption :: Maybe Bool
createBranchProtectionOptionDismissStaleApprovals = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionEnableApprovalsWhitelist:CreateBranchProtectionOption :: Maybe Bool
createBranchProtectionOptionEnableApprovalsWhitelist = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionEnableForcePush:CreateBranchProtectionOption :: Maybe Bool
createBranchProtectionOptionEnableForcePush = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionEnableForcePushAllowlist:CreateBranchProtectionOption :: Maybe Bool
createBranchProtectionOptionEnableForcePushAllowlist = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionEnableMergeWhitelist:CreateBranchProtectionOption :: Maybe Bool
createBranchProtectionOptionEnableMergeWhitelist = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionEnablePush:CreateBranchProtectionOption :: Maybe Bool
createBranchProtectionOptionEnablePush = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionEnablePushWhitelist:CreateBranchProtectionOption :: Maybe Bool
createBranchProtectionOptionEnablePushWhitelist = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionEnableStatusCheck:CreateBranchProtectionOption :: Maybe Bool
createBranchProtectionOptionEnableStatusCheck = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionForcePushAllowlistDeployKeys:CreateBranchProtectionOption :: Maybe Bool
createBranchProtectionOptionForcePushAllowlistDeployKeys = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionForcePushAllowlistTeams:CreateBranchProtectionOption :: Maybe [Text]
createBranchProtectionOptionForcePushAllowlistTeams = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionForcePushAllowlistUsernames:CreateBranchProtectionOption :: Maybe [Text]
createBranchProtectionOptionForcePushAllowlistUsernames = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionIgnoreStaleApprovals:CreateBranchProtectionOption :: Maybe Bool
createBranchProtectionOptionIgnoreStaleApprovals = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionMergeWhitelistTeams:CreateBranchProtectionOption :: Maybe [Text]
createBranchProtectionOptionMergeWhitelistTeams = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionMergeWhitelistUsernames:CreateBranchProtectionOption :: Maybe [Text]
createBranchProtectionOptionMergeWhitelistUsernames = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionPriority:CreateBranchProtectionOption :: Maybe Integer
createBranchProtectionOptionPriority = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionProtectedFilePatterns:CreateBranchProtectionOption :: Maybe Text
createBranchProtectionOptionProtectedFilePatterns = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionPushWhitelistDeployKeys:CreateBranchProtectionOption :: Maybe Bool
createBranchProtectionOptionPushWhitelistDeployKeys = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionPushWhitelistTeams:CreateBranchProtectionOption :: Maybe [Text]
createBranchProtectionOptionPushWhitelistTeams = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionPushWhitelistUsernames:CreateBranchProtectionOption :: Maybe [Text]
createBranchProtectionOptionPushWhitelistUsernames = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionRequireSignedCommits:CreateBranchProtectionOption :: Maybe Bool
createBranchProtectionOptionRequireSignedCommits = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionRequiredApprovals:CreateBranchProtectionOption :: Maybe Integer
createBranchProtectionOptionRequiredApprovals = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionRuleName:CreateBranchProtectionOption :: Maybe Text
createBranchProtectionOptionRuleName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionStatusCheckContexts:CreateBranchProtectionOption :: Maybe [Text]
createBranchProtectionOptionStatusCheckContexts = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:createBranchProtectionOptionUnprotectedFilePatterns:CreateBranchProtectionOption :: Maybe Text
createBranchProtectionOptionUnprotectedFilePatterns = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** CreateBranchRepoOption
-- | CreateBranchRepoOption
-- CreateBranchRepoOption options when creating a branch in a repository
data CreateBranchRepoOption = CreateBranchRepoOption
  { CreateBranchRepoOption -> Text
createBranchRepoOptionNewBranchName :: !(Text) -- ^ /Required/ "new_branch_name" - Name of the branch to create
  , CreateBranchRepoOption -> Maybe Text
createBranchRepoOptionOldBranchName :: !(Maybe Text) -- ^ "old_branch_name" - Deprecated: true Name of the old branch to create from
  , CreateBranchRepoOption -> Maybe Text
createBranchRepoOptionOldRefName :: !(Maybe Text) -- ^ "old_ref_name" - Name of the old branch/tag/commit to create from
  } deriving (Int -> CreateBranchRepoOption -> ShowS
[CreateBranchRepoOption] -> ShowS
CreateBranchRepoOption -> [Char]
(Int -> CreateBranchRepoOption -> ShowS)
-> (CreateBranchRepoOption -> [Char])
-> ([CreateBranchRepoOption] -> ShowS)
-> Show CreateBranchRepoOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateBranchRepoOption -> ShowS
showsPrec :: Int -> CreateBranchRepoOption -> ShowS
$cshow :: CreateBranchRepoOption -> [Char]
show :: CreateBranchRepoOption -> [Char]
$cshowList :: [CreateBranchRepoOption] -> ShowS
showList :: [CreateBranchRepoOption] -> ShowS
P.Show, CreateBranchRepoOption -> CreateBranchRepoOption -> Bool
(CreateBranchRepoOption -> CreateBranchRepoOption -> Bool)
-> (CreateBranchRepoOption -> CreateBranchRepoOption -> Bool)
-> Eq CreateBranchRepoOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateBranchRepoOption -> CreateBranchRepoOption -> Bool
== :: CreateBranchRepoOption -> CreateBranchRepoOption -> Bool
$c/= :: CreateBranchRepoOption -> CreateBranchRepoOption -> Bool
/= :: CreateBranchRepoOption -> CreateBranchRepoOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreateBranchRepoOption
instance A.FromJSON CreateBranchRepoOption where
  parseJSON :: Value -> Parser CreateBranchRepoOption
parseJSON = [Char]
-> (Object -> Parser CreateBranchRepoOption)
-> Value
-> Parser CreateBranchRepoOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CreateBranchRepoOption" ((Object -> Parser CreateBranchRepoOption)
 -> Value -> Parser CreateBranchRepoOption)
-> (Object -> Parser CreateBranchRepoOption)
-> Value
-> Parser CreateBranchRepoOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Maybe Text -> Maybe Text -> CreateBranchRepoOption
CreateBranchRepoOption
      (Text -> Maybe Text -> Maybe Text -> CreateBranchRepoOption)
-> Parser Text
-> Parser (Maybe Text -> Maybe Text -> CreateBranchRepoOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"new_branch_name")
      Parser (Maybe Text -> Maybe Text -> CreateBranchRepoOption)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> CreateBranchRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"old_branch_name")
      Parser (Maybe Text -> CreateBranchRepoOption)
-> Parser (Maybe Text) -> Parser CreateBranchRepoOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"old_ref_name")

-- | ToJSON CreateBranchRepoOption
instance A.ToJSON CreateBranchRepoOption where
  toJSON :: CreateBranchRepoOption -> Value
toJSON CreateBranchRepoOption {Maybe Text
Text
$sel:createBranchRepoOptionNewBranchName:CreateBranchRepoOption :: CreateBranchRepoOption -> Text
$sel:createBranchRepoOptionOldBranchName:CreateBranchRepoOption :: CreateBranchRepoOption -> Maybe Text
$sel:createBranchRepoOptionOldRefName:CreateBranchRepoOption :: CreateBranchRepoOption -> Maybe Text
createBranchRepoOptionNewBranchName :: Text
createBranchRepoOptionOldBranchName :: Maybe Text
createBranchRepoOptionOldRefName :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"new_branch_name" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
createBranchRepoOptionNewBranchName
      , Key
"old_branch_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createBranchRepoOptionOldBranchName
      , Key
"old_ref_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createBranchRepoOptionOldRefName
      ]


-- | Construct a value of type 'CreateBranchRepoOption' (by applying it's required fields, if any)
mkCreateBranchRepoOption
  :: Text -- ^ 'createBranchRepoOptionNewBranchName': Name of the branch to create
  -> CreateBranchRepoOption
mkCreateBranchRepoOption :: Text -> CreateBranchRepoOption
mkCreateBranchRepoOption Text
createBranchRepoOptionNewBranchName =
  CreateBranchRepoOption
  { Text
$sel:createBranchRepoOptionNewBranchName:CreateBranchRepoOption :: Text
createBranchRepoOptionNewBranchName :: Text
createBranchRepoOptionNewBranchName
  , $sel:createBranchRepoOptionOldBranchName:CreateBranchRepoOption :: Maybe Text
createBranchRepoOptionOldBranchName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createBranchRepoOptionOldRefName:CreateBranchRepoOption :: Maybe Text
createBranchRepoOptionOldRefName = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** CreateEmailOption
-- | CreateEmailOption
-- CreateEmailOption options when creating email addresses
data CreateEmailOption = CreateEmailOption
  { CreateEmailOption -> Maybe [Text]
createEmailOptionEmails :: !(Maybe [Text]) -- ^ "emails" - email addresses to add
  } deriving (Int -> CreateEmailOption -> ShowS
[CreateEmailOption] -> ShowS
CreateEmailOption -> [Char]
(Int -> CreateEmailOption -> ShowS)
-> (CreateEmailOption -> [Char])
-> ([CreateEmailOption] -> ShowS)
-> Show CreateEmailOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateEmailOption -> ShowS
showsPrec :: Int -> CreateEmailOption -> ShowS
$cshow :: CreateEmailOption -> [Char]
show :: CreateEmailOption -> [Char]
$cshowList :: [CreateEmailOption] -> ShowS
showList :: [CreateEmailOption] -> ShowS
P.Show, CreateEmailOption -> CreateEmailOption -> Bool
(CreateEmailOption -> CreateEmailOption -> Bool)
-> (CreateEmailOption -> CreateEmailOption -> Bool)
-> Eq CreateEmailOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateEmailOption -> CreateEmailOption -> Bool
== :: CreateEmailOption -> CreateEmailOption -> Bool
$c/= :: CreateEmailOption -> CreateEmailOption -> Bool
/= :: CreateEmailOption -> CreateEmailOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreateEmailOption
instance A.FromJSON CreateEmailOption where
  parseJSON :: Value -> Parser CreateEmailOption
parseJSON = [Char]
-> (Object -> Parser CreateEmailOption)
-> Value
-> Parser CreateEmailOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CreateEmailOption" ((Object -> Parser CreateEmailOption)
 -> Value -> Parser CreateEmailOption)
-> (Object -> Parser CreateEmailOption)
-> Value
-> Parser CreateEmailOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Text] -> CreateEmailOption
CreateEmailOption
      (Maybe [Text] -> CreateEmailOption)
-> Parser (Maybe [Text]) -> Parser CreateEmailOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"emails")

-- | ToJSON CreateEmailOption
instance A.ToJSON CreateEmailOption where
  toJSON :: CreateEmailOption -> Value
toJSON CreateEmailOption {Maybe [Text]
$sel:createEmailOptionEmails:CreateEmailOption :: CreateEmailOption -> Maybe [Text]
createEmailOptionEmails :: Maybe [Text]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"emails" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
createEmailOptionEmails
      ]


-- | Construct a value of type 'CreateEmailOption' (by applying it's required fields, if any)
mkCreateEmailOption
  :: CreateEmailOption
mkCreateEmailOption :: CreateEmailOption
mkCreateEmailOption =
  CreateEmailOption
  { $sel:createEmailOptionEmails:CreateEmailOption :: Maybe [Text]
createEmailOptionEmails = Maybe [Text]
forall a. Maybe a
Nothing
  }

-- ** CreateFileOptions
-- | CreateFileOptions
-- CreateFileOptions options for creating files Note: `author` and `committer` are optional (if only one is given, it will be used for the other, otherwise the authenticated user will be used)
data CreateFileOptions = CreateFileOptions
  { CreateFileOptions -> Maybe Identity
createFileOptionsAuthor :: !(Maybe Identity) -- ^ "author"
  , CreateFileOptions -> Maybe Text
createFileOptionsBranch :: !(Maybe Text) -- ^ "branch" - branch (optional) to base this file from. if not given, the default branch is used
  , CreateFileOptions -> Maybe Identity
createFileOptionsCommitter :: !(Maybe Identity) -- ^ "committer"
  , CreateFileOptions -> Text
createFileOptionsContent :: !(Text) -- ^ /Required/ "content" - content must be base64 encoded
  , CreateFileOptions -> Maybe CommitDateOptions
createFileOptionsDates :: !(Maybe CommitDateOptions) -- ^ "dates"
  , CreateFileOptions -> Maybe Text
createFileOptionsMessage :: !(Maybe Text) -- ^ "message" - message (optional) for the commit of this file. if not supplied, a default message will be used
  , CreateFileOptions -> Maybe Text
createFileOptionsNewBranch :: !(Maybe Text) -- ^ "new_branch" - new_branch (optional) will make a new branch from &#x60;branch&#x60; before creating the file
  , CreateFileOptions -> Maybe Bool
createFileOptionsSignoff :: !(Maybe Bool) -- ^ "signoff" - Add a Signed-off-by trailer by the committer at the end of the commit log message.
  } deriving (Int -> CreateFileOptions -> ShowS
[CreateFileOptions] -> ShowS
CreateFileOptions -> [Char]
(Int -> CreateFileOptions -> ShowS)
-> (CreateFileOptions -> [Char])
-> ([CreateFileOptions] -> ShowS)
-> Show CreateFileOptions
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateFileOptions -> ShowS
showsPrec :: Int -> CreateFileOptions -> ShowS
$cshow :: CreateFileOptions -> [Char]
show :: CreateFileOptions -> [Char]
$cshowList :: [CreateFileOptions] -> ShowS
showList :: [CreateFileOptions] -> ShowS
P.Show, CreateFileOptions -> CreateFileOptions -> Bool
(CreateFileOptions -> CreateFileOptions -> Bool)
-> (CreateFileOptions -> CreateFileOptions -> Bool)
-> Eq CreateFileOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateFileOptions -> CreateFileOptions -> Bool
== :: CreateFileOptions -> CreateFileOptions -> Bool
$c/= :: CreateFileOptions -> CreateFileOptions -> Bool
/= :: CreateFileOptions -> CreateFileOptions -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreateFileOptions
instance A.FromJSON CreateFileOptions where
  parseJSON :: Value -> Parser CreateFileOptions
parseJSON = [Char]
-> (Object -> Parser CreateFileOptions)
-> Value
-> Parser CreateFileOptions
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CreateFileOptions" ((Object -> Parser CreateFileOptions)
 -> Value -> Parser CreateFileOptions)
-> (Object -> Parser CreateFileOptions)
-> Value
-> Parser CreateFileOptions
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Identity
-> Maybe Text
-> Maybe Identity
-> Text
-> Maybe CommitDateOptions
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> CreateFileOptions
CreateFileOptions
      (Maybe Identity
 -> Maybe Text
 -> Maybe Identity
 -> Text
 -> Maybe CommitDateOptions
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> CreateFileOptions)
-> Parser (Maybe Identity)
-> Parser
     (Maybe Text
      -> Maybe Identity
      -> Text
      -> Maybe CommitDateOptions
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> CreateFileOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Identity)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"author")
      Parser
  (Maybe Text
   -> Maybe Identity
   -> Text
   -> Maybe CommitDateOptions
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> CreateFileOptions)
-> Parser (Maybe Text)
-> Parser
     (Maybe Identity
      -> Text
      -> Maybe CommitDateOptions
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> CreateFileOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"branch")
      Parser
  (Maybe Identity
   -> Text
   -> Maybe CommitDateOptions
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> CreateFileOptions)
-> Parser (Maybe Identity)
-> Parser
     (Text
      -> Maybe CommitDateOptions
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> CreateFileOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Identity)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"committer")
      Parser
  (Text
   -> Maybe CommitDateOptions
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> CreateFileOptions)
-> Parser Text
-> Parser
     (Maybe CommitDateOptions
      -> Maybe Text -> Maybe Text -> Maybe Bool -> CreateFileOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"content")
      Parser
  (Maybe CommitDateOptions
   -> Maybe Text -> Maybe Text -> Maybe Bool -> CreateFileOptions)
-> Parser (Maybe CommitDateOptions)
-> Parser
     (Maybe Text -> Maybe Text -> Maybe Bool -> CreateFileOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe CommitDateOptions)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"dates")
      Parser
  (Maybe Text -> Maybe Text -> Maybe Bool -> CreateFileOptions)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Bool -> CreateFileOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"message")
      Parser (Maybe Text -> Maybe Bool -> CreateFileOptions)
-> Parser (Maybe Text) -> Parser (Maybe Bool -> CreateFileOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"new_branch")
      Parser (Maybe Bool -> CreateFileOptions)
-> Parser (Maybe Bool) -> Parser CreateFileOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"signoff")

-- | ToJSON CreateFileOptions
instance A.ToJSON CreateFileOptions where
  toJSON :: CreateFileOptions -> Value
toJSON CreateFileOptions {Maybe Bool
Maybe Text
Maybe Identity
Maybe CommitDateOptions
Text
$sel:createFileOptionsAuthor:CreateFileOptions :: CreateFileOptions -> Maybe Identity
$sel:createFileOptionsBranch:CreateFileOptions :: CreateFileOptions -> Maybe Text
$sel:createFileOptionsCommitter:CreateFileOptions :: CreateFileOptions -> Maybe Identity
$sel:createFileOptionsContent:CreateFileOptions :: CreateFileOptions -> Text
$sel:createFileOptionsDates:CreateFileOptions :: CreateFileOptions -> Maybe CommitDateOptions
$sel:createFileOptionsMessage:CreateFileOptions :: CreateFileOptions -> Maybe Text
$sel:createFileOptionsNewBranch:CreateFileOptions :: CreateFileOptions -> Maybe Text
$sel:createFileOptionsSignoff:CreateFileOptions :: CreateFileOptions -> Maybe Bool
createFileOptionsAuthor :: Maybe Identity
createFileOptionsBranch :: Maybe Text
createFileOptionsCommitter :: Maybe Identity
createFileOptionsContent :: Text
createFileOptionsDates :: Maybe CommitDateOptions
createFileOptionsMessage :: Maybe Text
createFileOptionsNewBranch :: Maybe Text
createFileOptionsSignoff :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"author" Key -> Maybe Identity -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Identity
createFileOptionsAuthor
      , Key
"branch" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createFileOptionsBranch
      , Key
"committer" Key -> Maybe Identity -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Identity
createFileOptionsCommitter
      , Key
"content" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
createFileOptionsContent
      , Key
"dates" Key -> Maybe CommitDateOptions -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe CommitDateOptions
createFileOptionsDates
      , Key
"message" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createFileOptionsMessage
      , Key
"new_branch" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createFileOptionsNewBranch
      , Key
"signoff" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createFileOptionsSignoff
      ]


-- | Construct a value of type 'CreateFileOptions' (by applying it's required fields, if any)
mkCreateFileOptions
  :: Text -- ^ 'createFileOptionsContent': content must be base64 encoded
  -> CreateFileOptions
mkCreateFileOptions :: Text -> CreateFileOptions
mkCreateFileOptions Text
createFileOptionsContent =
  CreateFileOptions
  { $sel:createFileOptionsAuthor:CreateFileOptions :: Maybe Identity
createFileOptionsAuthor = Maybe Identity
forall a. Maybe a
Nothing
  , $sel:createFileOptionsBranch:CreateFileOptions :: Maybe Text
createFileOptionsBranch = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createFileOptionsCommitter:CreateFileOptions :: Maybe Identity
createFileOptionsCommitter = Maybe Identity
forall a. Maybe a
Nothing
  , Text
$sel:createFileOptionsContent:CreateFileOptions :: Text
createFileOptionsContent :: Text
createFileOptionsContent
  , $sel:createFileOptionsDates:CreateFileOptions :: Maybe CommitDateOptions
createFileOptionsDates = Maybe CommitDateOptions
forall a. Maybe a
Nothing
  , $sel:createFileOptionsMessage:CreateFileOptions :: Maybe Text
createFileOptionsMessage = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createFileOptionsNewBranch:CreateFileOptions :: Maybe Text
createFileOptionsNewBranch = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createFileOptionsSignoff:CreateFileOptions :: Maybe Bool
createFileOptionsSignoff = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** CreateForkOption
-- | CreateForkOption
-- CreateForkOption options for creating a fork
data CreateForkOption = CreateForkOption
  { CreateForkOption -> Maybe Text
createForkOptionName :: !(Maybe Text) -- ^ "name" - name of the forked repository
  , CreateForkOption -> Maybe Text
createForkOptionOrganization :: !(Maybe Text) -- ^ "organization" - organization name, if forking into an organization
  } deriving (Int -> CreateForkOption -> ShowS
[CreateForkOption] -> ShowS
CreateForkOption -> [Char]
(Int -> CreateForkOption -> ShowS)
-> (CreateForkOption -> [Char])
-> ([CreateForkOption] -> ShowS)
-> Show CreateForkOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateForkOption -> ShowS
showsPrec :: Int -> CreateForkOption -> ShowS
$cshow :: CreateForkOption -> [Char]
show :: CreateForkOption -> [Char]
$cshowList :: [CreateForkOption] -> ShowS
showList :: [CreateForkOption] -> ShowS
P.Show, CreateForkOption -> CreateForkOption -> Bool
(CreateForkOption -> CreateForkOption -> Bool)
-> (CreateForkOption -> CreateForkOption -> Bool)
-> Eq CreateForkOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateForkOption -> CreateForkOption -> Bool
== :: CreateForkOption -> CreateForkOption -> Bool
$c/= :: CreateForkOption -> CreateForkOption -> Bool
/= :: CreateForkOption -> CreateForkOption -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON CreateForkOption
instance A.ToJSON CreateForkOption where
  toJSON :: CreateForkOption -> Value
toJSON CreateForkOption {Maybe Text
$sel:createForkOptionName:CreateForkOption :: CreateForkOption -> Maybe Text
$sel:createForkOptionOrganization:CreateForkOption :: CreateForkOption -> Maybe Text
createForkOptionName :: Maybe Text
createForkOptionOrganization :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createForkOptionName
      , Key
"organization" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createForkOptionOrganization
      ]


-- | Construct a value of type 'CreateForkOption' (by applying it's required fields, if any)
mkCreateForkOption
  :: CreateForkOption
mkCreateForkOption :: CreateForkOption
mkCreateForkOption =
  CreateForkOption
  { $sel:createForkOptionName:CreateForkOption :: Maybe Text
createForkOptionName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createForkOptionOrganization:CreateForkOption :: Maybe Text
createForkOptionOrganization = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** CreateGPGKeyOption
-- | CreateGPGKeyOption
-- CreateGPGKeyOption options create user GPG key
data CreateGPGKeyOption = CreateGPGKeyOption
  { CreateGPGKeyOption -> Text
createGPGKeyOptionArmoredPublicKey :: !(Text) -- ^ /Required/ "armored_public_key" - An armored GPG key to add
  , CreateGPGKeyOption -> Maybe Text
createGPGKeyOptionArmoredSignature :: !(Maybe Text) -- ^ "armored_signature"
  } deriving (Int -> CreateGPGKeyOption -> ShowS
[CreateGPGKeyOption] -> ShowS
CreateGPGKeyOption -> [Char]
(Int -> CreateGPGKeyOption -> ShowS)
-> (CreateGPGKeyOption -> [Char])
-> ([CreateGPGKeyOption] -> ShowS)
-> Show CreateGPGKeyOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateGPGKeyOption -> ShowS
showsPrec :: Int -> CreateGPGKeyOption -> ShowS
$cshow :: CreateGPGKeyOption -> [Char]
show :: CreateGPGKeyOption -> [Char]
$cshowList :: [CreateGPGKeyOption] -> ShowS
showList :: [CreateGPGKeyOption] -> ShowS
P.Show, CreateGPGKeyOption -> CreateGPGKeyOption -> Bool
(CreateGPGKeyOption -> CreateGPGKeyOption -> Bool)
-> (CreateGPGKeyOption -> CreateGPGKeyOption -> Bool)
-> Eq CreateGPGKeyOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateGPGKeyOption -> CreateGPGKeyOption -> Bool
== :: CreateGPGKeyOption -> CreateGPGKeyOption -> Bool
$c/= :: CreateGPGKeyOption -> CreateGPGKeyOption -> Bool
/= :: CreateGPGKeyOption -> CreateGPGKeyOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreateGPGKeyOption
instance A.FromJSON CreateGPGKeyOption where
  parseJSON :: Value -> Parser CreateGPGKeyOption
parseJSON = [Char]
-> (Object -> Parser CreateGPGKeyOption)
-> Value
-> Parser CreateGPGKeyOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CreateGPGKeyOption" ((Object -> Parser CreateGPGKeyOption)
 -> Value -> Parser CreateGPGKeyOption)
-> (Object -> Parser CreateGPGKeyOption)
-> Value
-> Parser CreateGPGKeyOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Maybe Text -> CreateGPGKeyOption
CreateGPGKeyOption
      (Text -> Maybe Text -> CreateGPGKeyOption)
-> Parser Text -> Parser (Maybe Text -> CreateGPGKeyOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"armored_public_key")
      Parser (Maybe Text -> CreateGPGKeyOption)
-> Parser (Maybe Text) -> Parser CreateGPGKeyOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"armored_signature")

-- | ToJSON CreateGPGKeyOption
instance A.ToJSON CreateGPGKeyOption where
  toJSON :: CreateGPGKeyOption -> Value
toJSON CreateGPGKeyOption {Maybe Text
Text
$sel:createGPGKeyOptionArmoredPublicKey:CreateGPGKeyOption :: CreateGPGKeyOption -> Text
$sel:createGPGKeyOptionArmoredSignature:CreateGPGKeyOption :: CreateGPGKeyOption -> Maybe Text
createGPGKeyOptionArmoredPublicKey :: Text
createGPGKeyOptionArmoredSignature :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"armored_public_key" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
createGPGKeyOptionArmoredPublicKey
      , Key
"armored_signature" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createGPGKeyOptionArmoredSignature
      ]


-- | Construct a value of type 'CreateGPGKeyOption' (by applying it's required fields, if any)
mkCreateGPGKeyOption
  :: Text -- ^ 'createGPGKeyOptionArmoredPublicKey': An armored GPG key to add
  -> CreateGPGKeyOption
mkCreateGPGKeyOption :: Text -> CreateGPGKeyOption
mkCreateGPGKeyOption Text
createGPGKeyOptionArmoredPublicKey =
  CreateGPGKeyOption
  { Text
$sel:createGPGKeyOptionArmoredPublicKey:CreateGPGKeyOption :: Text
createGPGKeyOptionArmoredPublicKey :: Text
createGPGKeyOptionArmoredPublicKey
  , $sel:createGPGKeyOptionArmoredSignature:CreateGPGKeyOption :: Maybe Text
createGPGKeyOptionArmoredSignature = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** CreateHookOption
-- | CreateHookOption
-- CreateHookOption options when create a hook
data CreateHookOption = CreateHookOption
  { CreateHookOption -> Maybe Bool
createHookOptionActive :: !(Maybe Bool) -- ^ "active"
  , CreateHookOption -> Maybe Text
createHookOptionAuthorizationHeader :: !(Maybe Text) -- ^ "authorization_header"
  , CreateHookOption -> Maybe Text
createHookOptionBranchFilter :: !(Maybe Text) -- ^ "branch_filter"
  , CreateHookOption -> Map [Char] Text
createHookOptionConfig :: !((Map.Map String Text)) -- ^ /Required/ "config" - CreateHookOptionConfig has all config options in it required are \&quot;content_type\&quot; and \&quot;url\&quot; Required
  , CreateHookOption -> Maybe [Text]
createHookOptionEvents :: !(Maybe [Text]) -- ^ "events"
  , CreateHookOption -> E'Type
createHookOptionType :: !(E'Type) -- ^ /Required/ "type"
  } deriving (Int -> CreateHookOption -> ShowS
[CreateHookOption] -> ShowS
CreateHookOption -> [Char]
(Int -> CreateHookOption -> ShowS)
-> (CreateHookOption -> [Char])
-> ([CreateHookOption] -> ShowS)
-> Show CreateHookOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateHookOption -> ShowS
showsPrec :: Int -> CreateHookOption -> ShowS
$cshow :: CreateHookOption -> [Char]
show :: CreateHookOption -> [Char]
$cshowList :: [CreateHookOption] -> ShowS
showList :: [CreateHookOption] -> ShowS
P.Show, CreateHookOption -> CreateHookOption -> Bool
(CreateHookOption -> CreateHookOption -> Bool)
-> (CreateHookOption -> CreateHookOption -> Bool)
-> Eq CreateHookOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateHookOption -> CreateHookOption -> Bool
== :: CreateHookOption -> CreateHookOption -> Bool
$c/= :: CreateHookOption -> CreateHookOption -> Bool
/= :: CreateHookOption -> CreateHookOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreateHookOption
instance A.FromJSON CreateHookOption where
  parseJSON :: Value -> Parser CreateHookOption
parseJSON = [Char]
-> (Object -> Parser CreateHookOption)
-> Value
-> Parser CreateHookOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CreateHookOption" ((Object -> Parser CreateHookOption)
 -> Value -> Parser CreateHookOption)
-> (Object -> Parser CreateHookOption)
-> Value
-> Parser CreateHookOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool
-> Maybe Text
-> Maybe Text
-> Map [Char] Text
-> Maybe [Text]
-> E'Type
-> CreateHookOption
CreateHookOption
      (Maybe Bool
 -> Maybe Text
 -> Maybe Text
 -> Map [Char] Text
 -> Maybe [Text]
 -> E'Type
 -> CreateHookOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Map [Char] Text
      -> Maybe [Text]
      -> E'Type
      -> CreateHookOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"active")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Map [Char] Text
   -> Maybe [Text]
   -> E'Type
   -> CreateHookOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Map [Char] Text -> Maybe [Text] -> E'Type -> CreateHookOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"authorization_header")
      Parser
  (Maybe Text
   -> Map [Char] Text -> Maybe [Text] -> E'Type -> CreateHookOption)
-> Parser (Maybe Text)
-> Parser
     (Map [Char] Text -> Maybe [Text] -> E'Type -> CreateHookOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"branch_filter")
      Parser
  (Map [Char] Text -> Maybe [Text] -> E'Type -> CreateHookOption)
-> Parser (Map [Char] Text)
-> Parser (Maybe [Text] -> E'Type -> CreateHookOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Map [Char] Text)
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"config")
      Parser (Maybe [Text] -> E'Type -> CreateHookOption)
-> Parser (Maybe [Text]) -> Parser (E'Type -> CreateHookOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"events")
      Parser (E'Type -> CreateHookOption)
-> Parser E'Type -> Parser CreateHookOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser E'Type
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"type")

-- | ToJSON CreateHookOption
instance A.ToJSON CreateHookOption where
  toJSON :: CreateHookOption -> Value
toJSON CreateHookOption {Maybe Bool
Maybe [Text]
Maybe Text
Map [Char] Text
E'Type
$sel:createHookOptionActive:CreateHookOption :: CreateHookOption -> Maybe Bool
$sel:createHookOptionAuthorizationHeader:CreateHookOption :: CreateHookOption -> Maybe Text
$sel:createHookOptionBranchFilter:CreateHookOption :: CreateHookOption -> Maybe Text
$sel:createHookOptionConfig:CreateHookOption :: CreateHookOption -> Map [Char] Text
$sel:createHookOptionEvents:CreateHookOption :: CreateHookOption -> Maybe [Text]
$sel:createHookOptionType:CreateHookOption :: CreateHookOption -> E'Type
createHookOptionActive :: Maybe Bool
createHookOptionAuthorizationHeader :: Maybe Text
createHookOptionBranchFilter :: Maybe Text
createHookOptionConfig :: Map [Char] Text
createHookOptionEvents :: Maybe [Text]
createHookOptionType :: E'Type
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"active" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createHookOptionActive
      , Key
"authorization_header" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createHookOptionAuthorizationHeader
      , Key
"branch_filter" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createHookOptionBranchFilter
      , Key
"config" Key -> Map [Char] Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Map [Char] Text
createHookOptionConfig
      , Key
"events" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
createHookOptionEvents
      , Key
"type" Key -> E'Type -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= E'Type
createHookOptionType
      ]


-- | Construct a value of type 'CreateHookOption' (by applying it's required fields, if any)
mkCreateHookOption
  :: (Map.Map String Text) -- ^ 'createHookOptionConfig': CreateHookOptionConfig has all config options in it required are \"content_type\" and \"url\" Required
  -> E'Type -- ^ 'createHookOptionType' 
  -> CreateHookOption
mkCreateHookOption :: Map [Char] Text -> E'Type -> CreateHookOption
mkCreateHookOption Map [Char] Text
createHookOptionConfig E'Type
createHookOptionType =
  CreateHookOption
  { $sel:createHookOptionActive:CreateHookOption :: Maybe Bool
createHookOptionActive = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createHookOptionAuthorizationHeader:CreateHookOption :: Maybe Text
createHookOptionAuthorizationHeader = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createHookOptionBranchFilter:CreateHookOption :: Maybe Text
createHookOptionBranchFilter = Maybe Text
forall a. Maybe a
Nothing
  , Map [Char] Text
$sel:createHookOptionConfig:CreateHookOption :: Map [Char] Text
createHookOptionConfig :: Map [Char] Text
createHookOptionConfig
  , $sel:createHookOptionEvents:CreateHookOption :: Maybe [Text]
createHookOptionEvents = Maybe [Text]
forall a. Maybe a
Nothing
  , E'Type
$sel:createHookOptionType:CreateHookOption :: E'Type
createHookOptionType :: E'Type
createHookOptionType
  }

-- ** CreateIssueCommentOption
-- | CreateIssueCommentOption
-- CreateIssueCommentOption options for creating a comment on an issue
data CreateIssueCommentOption = CreateIssueCommentOption
  { CreateIssueCommentOption -> Text
createIssueCommentOptionBody :: !(Text) -- ^ /Required/ "body"
  } deriving (Int -> CreateIssueCommentOption -> ShowS
[CreateIssueCommentOption] -> ShowS
CreateIssueCommentOption -> [Char]
(Int -> CreateIssueCommentOption -> ShowS)
-> (CreateIssueCommentOption -> [Char])
-> ([CreateIssueCommentOption] -> ShowS)
-> Show CreateIssueCommentOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateIssueCommentOption -> ShowS
showsPrec :: Int -> CreateIssueCommentOption -> ShowS
$cshow :: CreateIssueCommentOption -> [Char]
show :: CreateIssueCommentOption -> [Char]
$cshowList :: [CreateIssueCommentOption] -> ShowS
showList :: [CreateIssueCommentOption] -> ShowS
P.Show, CreateIssueCommentOption -> CreateIssueCommentOption -> Bool
(CreateIssueCommentOption -> CreateIssueCommentOption -> Bool)
-> (CreateIssueCommentOption -> CreateIssueCommentOption -> Bool)
-> Eq CreateIssueCommentOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateIssueCommentOption -> CreateIssueCommentOption -> Bool
== :: CreateIssueCommentOption -> CreateIssueCommentOption -> Bool
$c/= :: CreateIssueCommentOption -> CreateIssueCommentOption -> Bool
/= :: CreateIssueCommentOption -> CreateIssueCommentOption -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON CreateIssueCommentOption
instance A.ToJSON CreateIssueCommentOption where
  toJSON :: CreateIssueCommentOption -> Value
toJSON CreateIssueCommentOption {Text
$sel:createIssueCommentOptionBody:CreateIssueCommentOption :: CreateIssueCommentOption -> Text
createIssueCommentOptionBody :: Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"body" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
createIssueCommentOptionBody
      ]


-- | Construct a value of type 'CreateIssueCommentOption' (by applying it's required fields, if any)
mkCreateIssueCommentOption
  :: Text -- ^ 'createIssueCommentOptionBody' 
  -> CreateIssueCommentOption
mkCreateIssueCommentOption :: Text -> CreateIssueCommentOption
mkCreateIssueCommentOption Text
createIssueCommentOptionBody =
  CreateIssueCommentOption
  { Text
$sel:createIssueCommentOptionBody:CreateIssueCommentOption :: Text
createIssueCommentOptionBody :: Text
createIssueCommentOptionBody
  }

-- ** CreateIssueOption
-- | CreateIssueOption
-- CreateIssueOption options to create one issue
data CreateIssueOption = CreateIssueOption
  { CreateIssueOption -> Maybe Text
createIssueOptionAssignee :: !(Maybe Text) -- ^ "assignee" - deprecated
  , CreateIssueOption -> Maybe [Text]
createIssueOptionAssignees :: !(Maybe [Text]) -- ^ "assignees"
  , CreateIssueOption -> Maybe Text
createIssueOptionBody :: !(Maybe Text) -- ^ "body"
  , CreateIssueOption -> Maybe Bool
createIssueOptionClosed :: !(Maybe Bool) -- ^ "closed"
  , CreateIssueOption -> Maybe DateTime
createIssueOptionDueDate :: !(Maybe DateTime) -- ^ "due_date"
  , CreateIssueOption -> Maybe [Integer]
createIssueOptionLabels :: !(Maybe [Integer]) -- ^ "labels" - list of label ids
  , CreateIssueOption -> Maybe Integer
createIssueOptionMilestone :: !(Maybe Integer) -- ^ "milestone" - milestone id
  , CreateIssueOption -> Maybe Text
createIssueOptionRef :: !(Maybe Text) -- ^ "ref"
  , CreateIssueOption -> Text
createIssueOptionTitle :: !(Text) -- ^ /Required/ "title"
  } deriving (Int -> CreateIssueOption -> ShowS
[CreateIssueOption] -> ShowS
CreateIssueOption -> [Char]
(Int -> CreateIssueOption -> ShowS)
-> (CreateIssueOption -> [Char])
-> ([CreateIssueOption] -> ShowS)
-> Show CreateIssueOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateIssueOption -> ShowS
showsPrec :: Int -> CreateIssueOption -> ShowS
$cshow :: CreateIssueOption -> [Char]
show :: CreateIssueOption -> [Char]
$cshowList :: [CreateIssueOption] -> ShowS
showList :: [CreateIssueOption] -> ShowS
P.Show, CreateIssueOption -> CreateIssueOption -> Bool
(CreateIssueOption -> CreateIssueOption -> Bool)
-> (CreateIssueOption -> CreateIssueOption -> Bool)
-> Eq CreateIssueOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateIssueOption -> CreateIssueOption -> Bool
== :: CreateIssueOption -> CreateIssueOption -> Bool
$c/= :: CreateIssueOption -> CreateIssueOption -> Bool
/= :: CreateIssueOption -> CreateIssueOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreateIssueOption
instance A.FromJSON CreateIssueOption where
  parseJSON :: Value -> Parser CreateIssueOption
parseJSON = [Char]
-> (Object -> Parser CreateIssueOption)
-> Value
-> Parser CreateIssueOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CreateIssueOption" ((Object -> Parser CreateIssueOption)
 -> Value -> Parser CreateIssueOption)
-> (Object -> Parser CreateIssueOption)
-> Value
-> Parser CreateIssueOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Bool
-> Maybe DateTime
-> Maybe [Integer]
-> Maybe Integer
-> Maybe Text
-> Text
-> CreateIssueOption
CreateIssueOption
      (Maybe Text
 -> Maybe [Text]
 -> Maybe Text
 -> Maybe Bool
 -> Maybe DateTime
 -> Maybe [Integer]
 -> Maybe Integer
 -> Maybe Text
 -> Text
 -> CreateIssueOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe [Integer]
      -> Maybe Integer
      -> Maybe Text
      -> Text
      -> CreateIssueOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"assignee")
      Parser
  (Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe [Integer]
   -> Maybe Integer
   -> Maybe Text
   -> Text
   -> CreateIssueOption)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe [Integer]
      -> Maybe Integer
      -> Maybe Text
      -> Text
      -> CreateIssueOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"assignees")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe [Integer]
   -> Maybe Integer
   -> Maybe Text
   -> Text
   -> CreateIssueOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe DateTime
      -> Maybe [Integer]
      -> Maybe Integer
      -> Maybe Text
      -> Text
      -> CreateIssueOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"body")
      Parser
  (Maybe Bool
   -> Maybe DateTime
   -> Maybe [Integer]
   -> Maybe Integer
   -> Maybe Text
   -> Text
   -> CreateIssueOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe DateTime
      -> Maybe [Integer]
      -> Maybe Integer
      -> Maybe Text
      -> Text
      -> CreateIssueOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"closed")
      Parser
  (Maybe DateTime
   -> Maybe [Integer]
   -> Maybe Integer
   -> Maybe Text
   -> Text
   -> CreateIssueOption)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe [Integer]
      -> Maybe Integer -> Maybe Text -> Text -> CreateIssueOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"due_date")
      Parser
  (Maybe [Integer]
   -> Maybe Integer -> Maybe Text -> Text -> CreateIssueOption)
-> Parser (Maybe [Integer])
-> Parser
     (Maybe Integer -> Maybe Text -> Text -> CreateIssueOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Integer])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"labels")
      Parser (Maybe Integer -> Maybe Text -> Text -> CreateIssueOption)
-> Parser (Maybe Integer)
-> Parser (Maybe Text -> Text -> CreateIssueOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"milestone")
      Parser (Maybe Text -> Text -> CreateIssueOption)
-> Parser (Maybe Text) -> Parser (Text -> CreateIssueOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ref")
      Parser (Text -> CreateIssueOption)
-> Parser Text -> Parser CreateIssueOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"title")

-- | ToJSON CreateIssueOption
instance A.ToJSON CreateIssueOption where
  toJSON :: CreateIssueOption -> Value
toJSON CreateIssueOption {Maybe Bool
Maybe Integer
Maybe [Integer]
Maybe [Text]
Maybe Text
Maybe DateTime
Text
$sel:createIssueOptionAssignee:CreateIssueOption :: CreateIssueOption -> Maybe Text
$sel:createIssueOptionAssignees:CreateIssueOption :: CreateIssueOption -> Maybe [Text]
$sel:createIssueOptionBody:CreateIssueOption :: CreateIssueOption -> Maybe Text
$sel:createIssueOptionClosed:CreateIssueOption :: CreateIssueOption -> Maybe Bool
$sel:createIssueOptionDueDate:CreateIssueOption :: CreateIssueOption -> Maybe DateTime
$sel:createIssueOptionLabels:CreateIssueOption :: CreateIssueOption -> Maybe [Integer]
$sel:createIssueOptionMilestone:CreateIssueOption :: CreateIssueOption -> Maybe Integer
$sel:createIssueOptionRef:CreateIssueOption :: CreateIssueOption -> Maybe Text
$sel:createIssueOptionTitle:CreateIssueOption :: CreateIssueOption -> Text
createIssueOptionAssignee :: Maybe Text
createIssueOptionAssignees :: Maybe [Text]
createIssueOptionBody :: Maybe Text
createIssueOptionClosed :: Maybe Bool
createIssueOptionDueDate :: Maybe DateTime
createIssueOptionLabels :: Maybe [Integer]
createIssueOptionMilestone :: Maybe Integer
createIssueOptionRef :: Maybe Text
createIssueOptionTitle :: Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"assignee" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createIssueOptionAssignee
      , Key
"assignees" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
createIssueOptionAssignees
      , Key
"body" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createIssueOptionBody
      , Key
"closed" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createIssueOptionClosed
      , Key
"due_date" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
createIssueOptionDueDate
      , Key
"labels" Key -> Maybe [Integer] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Integer]
createIssueOptionLabels
      , Key
"milestone" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
createIssueOptionMilestone
      , Key
"ref" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createIssueOptionRef
      , Key
"title" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
createIssueOptionTitle
      ]


-- | Construct a value of type 'CreateIssueOption' (by applying it's required fields, if any)
mkCreateIssueOption
  :: Text -- ^ 'createIssueOptionTitle' 
  -> CreateIssueOption
mkCreateIssueOption :: Text -> CreateIssueOption
mkCreateIssueOption Text
createIssueOptionTitle =
  CreateIssueOption
  { $sel:createIssueOptionAssignee:CreateIssueOption :: Maybe Text
createIssueOptionAssignee = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createIssueOptionAssignees:CreateIssueOption :: Maybe [Text]
createIssueOptionAssignees = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:createIssueOptionBody:CreateIssueOption :: Maybe Text
createIssueOptionBody = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createIssueOptionClosed:CreateIssueOption :: Maybe Bool
createIssueOptionClosed = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createIssueOptionDueDate:CreateIssueOption :: Maybe DateTime
createIssueOptionDueDate = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:createIssueOptionLabels:CreateIssueOption :: Maybe [Integer]
createIssueOptionLabels = Maybe [Integer]
forall a. Maybe a
Nothing
  , $sel:createIssueOptionMilestone:CreateIssueOption :: Maybe Integer
createIssueOptionMilestone = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:createIssueOptionRef:CreateIssueOption :: Maybe Text
createIssueOptionRef = Maybe Text
forall a. Maybe a
Nothing
  , Text
$sel:createIssueOptionTitle:CreateIssueOption :: Text
createIssueOptionTitle :: Text
createIssueOptionTitle
  }

-- ** CreateKeyOption
-- | CreateKeyOption
-- CreateKeyOption options when creating a key
data CreateKeyOption = CreateKeyOption
  { CreateKeyOption -> Text
createKeyOptionKey :: !(Text) -- ^ /Required/ "key" - An armored SSH key to add
  , CreateKeyOption -> Maybe Bool
createKeyOptionReadOnly :: !(Maybe Bool) -- ^ "read_only" - Describe if the key has only read access or read/write
  , CreateKeyOption -> Text
createKeyOptionTitle :: !(Text) -- ^ /Required/ "title" - Title of the key to add
  } deriving (Int -> CreateKeyOption -> ShowS
[CreateKeyOption] -> ShowS
CreateKeyOption -> [Char]
(Int -> CreateKeyOption -> ShowS)
-> (CreateKeyOption -> [Char])
-> ([CreateKeyOption] -> ShowS)
-> Show CreateKeyOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateKeyOption -> ShowS
showsPrec :: Int -> CreateKeyOption -> ShowS
$cshow :: CreateKeyOption -> [Char]
show :: CreateKeyOption -> [Char]
$cshowList :: [CreateKeyOption] -> ShowS
showList :: [CreateKeyOption] -> ShowS
P.Show, CreateKeyOption -> CreateKeyOption -> Bool
(CreateKeyOption -> CreateKeyOption -> Bool)
-> (CreateKeyOption -> CreateKeyOption -> Bool)
-> Eq CreateKeyOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateKeyOption -> CreateKeyOption -> Bool
== :: CreateKeyOption -> CreateKeyOption -> Bool
$c/= :: CreateKeyOption -> CreateKeyOption -> Bool
/= :: CreateKeyOption -> CreateKeyOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreateKeyOption
instance A.FromJSON CreateKeyOption where
  parseJSON :: Value -> Parser CreateKeyOption
parseJSON = [Char]
-> (Object -> Parser CreateKeyOption)
-> Value
-> Parser CreateKeyOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CreateKeyOption" ((Object -> Parser CreateKeyOption)
 -> Value -> Parser CreateKeyOption)
-> (Object -> Parser CreateKeyOption)
-> Value
-> Parser CreateKeyOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Maybe Bool -> Text -> CreateKeyOption
CreateKeyOption
      (Text -> Maybe Bool -> Text -> CreateKeyOption)
-> Parser Text -> Parser (Maybe Bool -> Text -> CreateKeyOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"key")
      Parser (Maybe Bool -> Text -> CreateKeyOption)
-> Parser (Maybe Bool) -> Parser (Text -> CreateKeyOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"read_only")
      Parser (Text -> CreateKeyOption)
-> Parser Text -> Parser CreateKeyOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"title")

-- | ToJSON CreateKeyOption
instance A.ToJSON CreateKeyOption where
  toJSON :: CreateKeyOption -> Value
toJSON CreateKeyOption {Maybe Bool
Text
$sel:createKeyOptionKey:CreateKeyOption :: CreateKeyOption -> Text
$sel:createKeyOptionReadOnly:CreateKeyOption :: CreateKeyOption -> Maybe Bool
$sel:createKeyOptionTitle:CreateKeyOption :: CreateKeyOption -> Text
createKeyOptionKey :: Text
createKeyOptionReadOnly :: Maybe Bool
createKeyOptionTitle :: Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"key" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
createKeyOptionKey
      , Key
"read_only" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createKeyOptionReadOnly
      , Key
"title" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
createKeyOptionTitle
      ]


-- | Construct a value of type 'CreateKeyOption' (by applying it's required fields, if any)
mkCreateKeyOption
  :: Text -- ^ 'createKeyOptionKey': An armored SSH key to add
  -> Text -- ^ 'createKeyOptionTitle': Title of the key to add
  -> CreateKeyOption
mkCreateKeyOption :: Text -> Text -> CreateKeyOption
mkCreateKeyOption Text
createKeyOptionKey Text
createKeyOptionTitle =
  CreateKeyOption
  { Text
$sel:createKeyOptionKey:CreateKeyOption :: Text
createKeyOptionKey :: Text
createKeyOptionKey
  , $sel:createKeyOptionReadOnly:CreateKeyOption :: Maybe Bool
createKeyOptionReadOnly = Maybe Bool
forall a. Maybe a
Nothing
  , Text
$sel:createKeyOptionTitle:CreateKeyOption :: Text
createKeyOptionTitle :: Text
createKeyOptionTitle
  }

-- ** CreateLabelOption
-- | CreateLabelOption
-- CreateLabelOption options for creating a label
data CreateLabelOption = CreateLabelOption
  { CreateLabelOption -> Text
createLabelOptionColor :: !(Text) -- ^ /Required/ "color"
  , CreateLabelOption -> Maybe Text
createLabelOptionDescription :: !(Maybe Text) -- ^ "description"
  , CreateLabelOption -> Maybe Bool
createLabelOptionExclusive :: !(Maybe Bool) -- ^ "exclusive"
  , CreateLabelOption -> Maybe Bool
createLabelOptionIsArchived :: !(Maybe Bool) -- ^ "is_archived"
  , CreateLabelOption -> Text
createLabelOptionName :: !(Text) -- ^ /Required/ "name"
  } deriving (Int -> CreateLabelOption -> ShowS
[CreateLabelOption] -> ShowS
CreateLabelOption -> [Char]
(Int -> CreateLabelOption -> ShowS)
-> (CreateLabelOption -> [Char])
-> ([CreateLabelOption] -> ShowS)
-> Show CreateLabelOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateLabelOption -> ShowS
showsPrec :: Int -> CreateLabelOption -> ShowS
$cshow :: CreateLabelOption -> [Char]
show :: CreateLabelOption -> [Char]
$cshowList :: [CreateLabelOption] -> ShowS
showList :: [CreateLabelOption] -> ShowS
P.Show, CreateLabelOption -> CreateLabelOption -> Bool
(CreateLabelOption -> CreateLabelOption -> Bool)
-> (CreateLabelOption -> CreateLabelOption -> Bool)
-> Eq CreateLabelOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateLabelOption -> CreateLabelOption -> Bool
== :: CreateLabelOption -> CreateLabelOption -> Bool
$c/= :: CreateLabelOption -> CreateLabelOption -> Bool
/= :: CreateLabelOption -> CreateLabelOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreateLabelOption
instance A.FromJSON CreateLabelOption where
  parseJSON :: Value -> Parser CreateLabelOption
parseJSON = [Char]
-> (Object -> Parser CreateLabelOption)
-> Value
-> Parser CreateLabelOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CreateLabelOption" ((Object -> Parser CreateLabelOption)
 -> Value -> Parser CreateLabelOption)
-> (Object -> Parser CreateLabelOption)
-> Value
-> Parser CreateLabelOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Text
-> CreateLabelOption
CreateLabelOption
      (Text
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Bool
 -> Text
 -> CreateLabelOption)
-> Parser Text
-> Parser
     (Maybe Text
      -> Maybe Bool -> Maybe Bool -> Text -> CreateLabelOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"color")
      Parser
  (Maybe Text
   -> Maybe Bool -> Maybe Bool -> Text -> CreateLabelOption)
-> Parser (Maybe Text)
-> Parser (Maybe Bool -> Maybe Bool -> Text -> CreateLabelOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser (Maybe Bool -> Maybe Bool -> Text -> CreateLabelOption)
-> Parser (Maybe Bool)
-> Parser (Maybe Bool -> Text -> CreateLabelOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"exclusive")
      Parser (Maybe Bool -> Text -> CreateLabelOption)
-> Parser (Maybe Bool) -> Parser (Text -> CreateLabelOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_archived")
      Parser (Text -> CreateLabelOption)
-> Parser Text -> Parser CreateLabelOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"name")

-- | ToJSON CreateLabelOption
instance A.ToJSON CreateLabelOption where
  toJSON :: CreateLabelOption -> Value
toJSON CreateLabelOption {Maybe Bool
Maybe Text
Text
$sel:createLabelOptionColor:CreateLabelOption :: CreateLabelOption -> Text
$sel:createLabelOptionDescription:CreateLabelOption :: CreateLabelOption -> Maybe Text
$sel:createLabelOptionExclusive:CreateLabelOption :: CreateLabelOption -> Maybe Bool
$sel:createLabelOptionIsArchived:CreateLabelOption :: CreateLabelOption -> Maybe Bool
$sel:createLabelOptionName:CreateLabelOption :: CreateLabelOption -> Text
createLabelOptionColor :: Text
createLabelOptionDescription :: Maybe Text
createLabelOptionExclusive :: Maybe Bool
createLabelOptionIsArchived :: Maybe Bool
createLabelOptionName :: Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"color" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
createLabelOptionColor
      , Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createLabelOptionDescription
      , Key
"exclusive" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createLabelOptionExclusive
      , Key
"is_archived" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createLabelOptionIsArchived
      , Key
"name" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
createLabelOptionName
      ]


-- | Construct a value of type 'CreateLabelOption' (by applying it's required fields, if any)
mkCreateLabelOption
  :: Text -- ^ 'createLabelOptionColor' 
  -> Text -- ^ 'createLabelOptionName' 
  -> CreateLabelOption
mkCreateLabelOption :: Text -> Text -> CreateLabelOption
mkCreateLabelOption Text
createLabelOptionColor Text
createLabelOptionName =
  CreateLabelOption
  { Text
$sel:createLabelOptionColor:CreateLabelOption :: Text
createLabelOptionColor :: Text
createLabelOptionColor
  , $sel:createLabelOptionDescription:CreateLabelOption :: Maybe Text
createLabelOptionDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createLabelOptionExclusive:CreateLabelOption :: Maybe Bool
createLabelOptionExclusive = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createLabelOptionIsArchived:CreateLabelOption :: Maybe Bool
createLabelOptionIsArchived = Maybe Bool
forall a. Maybe a
Nothing
  , Text
$sel:createLabelOptionName:CreateLabelOption :: Text
createLabelOptionName :: Text
createLabelOptionName
  }

-- ** CreateMilestoneOption
-- | CreateMilestoneOption
-- CreateMilestoneOption options for creating a milestone
data CreateMilestoneOption = CreateMilestoneOption
  { CreateMilestoneOption -> Maybe Text
createMilestoneOptionDescription :: !(Maybe Text) -- ^ "description"
  , CreateMilestoneOption -> Maybe DateTime
createMilestoneOptionDueOn :: !(Maybe DateTime) -- ^ "due_on"
  , CreateMilestoneOption -> Maybe E'State
createMilestoneOptionState :: !(Maybe E'State) -- ^ "state"
  , CreateMilestoneOption -> Maybe Text
createMilestoneOptionTitle :: !(Maybe Text) -- ^ "title"
  } deriving (Int -> CreateMilestoneOption -> ShowS
[CreateMilestoneOption] -> ShowS
CreateMilestoneOption -> [Char]
(Int -> CreateMilestoneOption -> ShowS)
-> (CreateMilestoneOption -> [Char])
-> ([CreateMilestoneOption] -> ShowS)
-> Show CreateMilestoneOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateMilestoneOption -> ShowS
showsPrec :: Int -> CreateMilestoneOption -> ShowS
$cshow :: CreateMilestoneOption -> [Char]
show :: CreateMilestoneOption -> [Char]
$cshowList :: [CreateMilestoneOption] -> ShowS
showList :: [CreateMilestoneOption] -> ShowS
P.Show, CreateMilestoneOption -> CreateMilestoneOption -> Bool
(CreateMilestoneOption -> CreateMilestoneOption -> Bool)
-> (CreateMilestoneOption -> CreateMilestoneOption -> Bool)
-> Eq CreateMilestoneOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateMilestoneOption -> CreateMilestoneOption -> Bool
== :: CreateMilestoneOption -> CreateMilestoneOption -> Bool
$c/= :: CreateMilestoneOption -> CreateMilestoneOption -> Bool
/= :: CreateMilestoneOption -> CreateMilestoneOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreateMilestoneOption
instance A.FromJSON CreateMilestoneOption where
  parseJSON :: Value -> Parser CreateMilestoneOption
parseJSON = [Char]
-> (Object -> Parser CreateMilestoneOption)
-> Value
-> Parser CreateMilestoneOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CreateMilestoneOption" ((Object -> Parser CreateMilestoneOption)
 -> Value -> Parser CreateMilestoneOption)
-> (Object -> Parser CreateMilestoneOption)
-> Value
-> Parser CreateMilestoneOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe DateTime
-> Maybe E'State
-> Maybe Text
-> CreateMilestoneOption
CreateMilestoneOption
      (Maybe Text
 -> Maybe DateTime
 -> Maybe E'State
 -> Maybe Text
 -> CreateMilestoneOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe DateTime
      -> Maybe E'State -> Maybe Text -> CreateMilestoneOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe DateTime
   -> Maybe E'State -> Maybe Text -> CreateMilestoneOption)
-> Parser (Maybe DateTime)
-> Parser (Maybe E'State -> Maybe Text -> CreateMilestoneOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"due_on")
      Parser (Maybe E'State -> Maybe Text -> CreateMilestoneOption)
-> Parser (Maybe E'State)
-> Parser (Maybe Text -> CreateMilestoneOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe E'State)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"state")
      Parser (Maybe Text -> CreateMilestoneOption)
-> Parser (Maybe Text) -> Parser CreateMilestoneOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title")

-- | ToJSON CreateMilestoneOption
instance A.ToJSON CreateMilestoneOption where
  toJSON :: CreateMilestoneOption -> Value
toJSON CreateMilestoneOption {Maybe Text
Maybe DateTime
Maybe E'State
$sel:createMilestoneOptionDescription:CreateMilestoneOption :: CreateMilestoneOption -> Maybe Text
$sel:createMilestoneOptionDueOn:CreateMilestoneOption :: CreateMilestoneOption -> Maybe DateTime
$sel:createMilestoneOptionState:CreateMilestoneOption :: CreateMilestoneOption -> Maybe E'State
$sel:createMilestoneOptionTitle:CreateMilestoneOption :: CreateMilestoneOption -> Maybe Text
createMilestoneOptionDescription :: Maybe Text
createMilestoneOptionDueOn :: Maybe DateTime
createMilestoneOptionState :: Maybe E'State
createMilestoneOptionTitle :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createMilestoneOptionDescription
      , Key
"due_on" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
createMilestoneOptionDueOn
      , Key
"state" Key -> Maybe E'State -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe E'State
createMilestoneOptionState
      , Key
"title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createMilestoneOptionTitle
      ]


-- | Construct a value of type 'CreateMilestoneOption' (by applying it's required fields, if any)
mkCreateMilestoneOption
  :: CreateMilestoneOption
mkCreateMilestoneOption :: CreateMilestoneOption
mkCreateMilestoneOption =
  CreateMilestoneOption
  { $sel:createMilestoneOptionDescription:CreateMilestoneOption :: Maybe Text
createMilestoneOptionDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createMilestoneOptionDueOn:CreateMilestoneOption :: Maybe DateTime
createMilestoneOptionDueOn = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:createMilestoneOptionState:CreateMilestoneOption :: Maybe E'State
createMilestoneOptionState = Maybe E'State
forall a. Maybe a
Nothing
  , $sel:createMilestoneOptionTitle:CreateMilestoneOption :: Maybe Text
createMilestoneOptionTitle = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** CreateOAuth2ApplicationOptions
-- | CreateOAuth2ApplicationOptions
-- CreateOAuth2ApplicationOptions holds options to create an oauth2 application
data CreateOAuth2ApplicationOptions = CreateOAuth2ApplicationOptions
  { CreateOAuth2ApplicationOptions -> Maybe Bool
createOAuth2ApplicationOptionsConfidentialClient :: !(Maybe Bool) -- ^ "confidential_client"
  , CreateOAuth2ApplicationOptions -> Maybe Text
createOAuth2ApplicationOptionsName :: !(Maybe Text) -- ^ "name"
  , CreateOAuth2ApplicationOptions -> Maybe [Text]
createOAuth2ApplicationOptionsRedirectUris :: !(Maybe [Text]) -- ^ "redirect_uris"
  , CreateOAuth2ApplicationOptions -> Maybe Bool
createOAuth2ApplicationOptionsSkipSecondaryAuthorization :: !(Maybe Bool) -- ^ "skip_secondary_authorization"
  } deriving (Int -> CreateOAuth2ApplicationOptions -> ShowS
[CreateOAuth2ApplicationOptions] -> ShowS
CreateOAuth2ApplicationOptions -> [Char]
(Int -> CreateOAuth2ApplicationOptions -> ShowS)
-> (CreateOAuth2ApplicationOptions -> [Char])
-> ([CreateOAuth2ApplicationOptions] -> ShowS)
-> Show CreateOAuth2ApplicationOptions
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateOAuth2ApplicationOptions -> ShowS
showsPrec :: Int -> CreateOAuth2ApplicationOptions -> ShowS
$cshow :: CreateOAuth2ApplicationOptions -> [Char]
show :: CreateOAuth2ApplicationOptions -> [Char]
$cshowList :: [CreateOAuth2ApplicationOptions] -> ShowS
showList :: [CreateOAuth2ApplicationOptions] -> ShowS
P.Show, CreateOAuth2ApplicationOptions
-> CreateOAuth2ApplicationOptions -> Bool
(CreateOAuth2ApplicationOptions
 -> CreateOAuth2ApplicationOptions -> Bool)
-> (CreateOAuth2ApplicationOptions
    -> CreateOAuth2ApplicationOptions -> Bool)
-> Eq CreateOAuth2ApplicationOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateOAuth2ApplicationOptions
-> CreateOAuth2ApplicationOptions -> Bool
== :: CreateOAuth2ApplicationOptions
-> CreateOAuth2ApplicationOptions -> Bool
$c/= :: CreateOAuth2ApplicationOptions
-> CreateOAuth2ApplicationOptions -> Bool
/= :: CreateOAuth2ApplicationOptions
-> CreateOAuth2ApplicationOptions -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreateOAuth2ApplicationOptions
instance A.FromJSON CreateOAuth2ApplicationOptions where
  parseJSON :: Value -> Parser CreateOAuth2ApplicationOptions
parseJSON = [Char]
-> (Object -> Parser CreateOAuth2ApplicationOptions)
-> Value
-> Parser CreateOAuth2ApplicationOptions
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CreateOAuth2ApplicationOptions" ((Object -> Parser CreateOAuth2ApplicationOptions)
 -> Value -> Parser CreateOAuth2ApplicationOptions)
-> (Object -> Parser CreateOAuth2ApplicationOptions)
-> Value
-> Parser CreateOAuth2ApplicationOptions
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool
-> Maybe Text
-> Maybe [Text]
-> Maybe Bool
-> CreateOAuth2ApplicationOptions
CreateOAuth2ApplicationOptions
      (Maybe Bool
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe Bool
 -> CreateOAuth2ApplicationOptions)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe [Text] -> Maybe Bool -> CreateOAuth2ApplicationOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"confidential_client")
      Parser
  (Maybe Text
   -> Maybe [Text] -> Maybe Bool -> CreateOAuth2ApplicationOptions)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text] -> Maybe Bool -> CreateOAuth2ApplicationOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser
  (Maybe [Text] -> Maybe Bool -> CreateOAuth2ApplicationOptions)
-> Parser (Maybe [Text])
-> Parser (Maybe Bool -> CreateOAuth2ApplicationOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"redirect_uris")
      Parser (Maybe Bool -> CreateOAuth2ApplicationOptions)
-> Parser (Maybe Bool) -> Parser CreateOAuth2ApplicationOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"skip_secondary_authorization")

-- | ToJSON CreateOAuth2ApplicationOptions
instance A.ToJSON CreateOAuth2ApplicationOptions where
  toJSON :: CreateOAuth2ApplicationOptions -> Value
toJSON CreateOAuth2ApplicationOptions {Maybe Bool
Maybe [Text]
Maybe Text
$sel:createOAuth2ApplicationOptionsConfidentialClient:CreateOAuth2ApplicationOptions :: CreateOAuth2ApplicationOptions -> Maybe Bool
$sel:createOAuth2ApplicationOptionsName:CreateOAuth2ApplicationOptions :: CreateOAuth2ApplicationOptions -> Maybe Text
$sel:createOAuth2ApplicationOptionsRedirectUris:CreateOAuth2ApplicationOptions :: CreateOAuth2ApplicationOptions -> Maybe [Text]
$sel:createOAuth2ApplicationOptionsSkipSecondaryAuthorization:CreateOAuth2ApplicationOptions :: CreateOAuth2ApplicationOptions -> Maybe Bool
createOAuth2ApplicationOptionsConfidentialClient :: Maybe Bool
createOAuth2ApplicationOptionsName :: Maybe Text
createOAuth2ApplicationOptionsRedirectUris :: Maybe [Text]
createOAuth2ApplicationOptionsSkipSecondaryAuthorization :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"confidential_client" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createOAuth2ApplicationOptionsConfidentialClient
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createOAuth2ApplicationOptionsName
      , Key
"redirect_uris" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
createOAuth2ApplicationOptionsRedirectUris
      , Key
"skip_secondary_authorization" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createOAuth2ApplicationOptionsSkipSecondaryAuthorization
      ]


-- | Construct a value of type 'CreateOAuth2ApplicationOptions' (by applying it's required fields, if any)
mkCreateOAuth2ApplicationOptions
  :: CreateOAuth2ApplicationOptions
mkCreateOAuth2ApplicationOptions :: CreateOAuth2ApplicationOptions
mkCreateOAuth2ApplicationOptions =
  CreateOAuth2ApplicationOptions
  { $sel:createOAuth2ApplicationOptionsConfidentialClient:CreateOAuth2ApplicationOptions :: Maybe Bool
createOAuth2ApplicationOptionsConfidentialClient = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createOAuth2ApplicationOptionsName:CreateOAuth2ApplicationOptions :: Maybe Text
createOAuth2ApplicationOptionsName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createOAuth2ApplicationOptionsRedirectUris:CreateOAuth2ApplicationOptions :: Maybe [Text]
createOAuth2ApplicationOptionsRedirectUris = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:createOAuth2ApplicationOptionsSkipSecondaryAuthorization:CreateOAuth2ApplicationOptions :: Maybe Bool
createOAuth2ApplicationOptionsSkipSecondaryAuthorization = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** CreateOrUpdateSecretOption
-- | CreateOrUpdateSecretOption
-- CreateOrUpdateSecretOption options when creating or updating secret
data CreateOrUpdateSecretOption = CreateOrUpdateSecretOption
  { CreateOrUpdateSecretOption -> Text
createOrUpdateSecretOptionData :: !(Text) -- ^ /Required/ "data" - Data of the secret to update
  } deriving (Int -> CreateOrUpdateSecretOption -> ShowS
[CreateOrUpdateSecretOption] -> ShowS
CreateOrUpdateSecretOption -> [Char]
(Int -> CreateOrUpdateSecretOption -> ShowS)
-> (CreateOrUpdateSecretOption -> [Char])
-> ([CreateOrUpdateSecretOption] -> ShowS)
-> Show CreateOrUpdateSecretOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateOrUpdateSecretOption -> ShowS
showsPrec :: Int -> CreateOrUpdateSecretOption -> ShowS
$cshow :: CreateOrUpdateSecretOption -> [Char]
show :: CreateOrUpdateSecretOption -> [Char]
$cshowList :: [CreateOrUpdateSecretOption] -> ShowS
showList :: [CreateOrUpdateSecretOption] -> ShowS
P.Show, CreateOrUpdateSecretOption -> CreateOrUpdateSecretOption -> Bool
(CreateOrUpdateSecretOption -> CreateOrUpdateSecretOption -> Bool)
-> (CreateOrUpdateSecretOption
    -> CreateOrUpdateSecretOption -> Bool)
-> Eq CreateOrUpdateSecretOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateOrUpdateSecretOption -> CreateOrUpdateSecretOption -> Bool
== :: CreateOrUpdateSecretOption -> CreateOrUpdateSecretOption -> Bool
$c/= :: CreateOrUpdateSecretOption -> CreateOrUpdateSecretOption -> Bool
/= :: CreateOrUpdateSecretOption -> CreateOrUpdateSecretOption -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON CreateOrUpdateSecretOption
instance A.ToJSON CreateOrUpdateSecretOption where
  toJSON :: CreateOrUpdateSecretOption -> Value
toJSON CreateOrUpdateSecretOption {Text
$sel:createOrUpdateSecretOptionData:CreateOrUpdateSecretOption :: CreateOrUpdateSecretOption -> Text
createOrUpdateSecretOptionData :: Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"data" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
createOrUpdateSecretOptionData
      ]


-- | Construct a value of type 'CreateOrUpdateSecretOption' (by applying it's required fields, if any)
mkCreateOrUpdateSecretOption
  :: Text -- ^ 'createOrUpdateSecretOptionData': Data of the secret to update
  -> CreateOrUpdateSecretOption
mkCreateOrUpdateSecretOption :: Text -> CreateOrUpdateSecretOption
mkCreateOrUpdateSecretOption Text
createOrUpdateSecretOptionData =
  CreateOrUpdateSecretOption
  { Text
$sel:createOrUpdateSecretOptionData:CreateOrUpdateSecretOption :: Text
createOrUpdateSecretOptionData :: Text
createOrUpdateSecretOptionData
  }

-- ** CreateOrgOption
-- | CreateOrgOption
-- CreateOrgOption options for creating an organization
data CreateOrgOption = CreateOrgOption
  { CreateOrgOption -> Maybe Text
createOrgOptionDescription :: !(Maybe Text) -- ^ "description"
  , CreateOrgOption -> Maybe Text
createOrgOptionEmail :: !(Maybe Text) -- ^ "email"
  , CreateOrgOption -> Maybe Text
createOrgOptionFullName :: !(Maybe Text) -- ^ "full_name"
  , CreateOrgOption -> Maybe Text
createOrgOptionLocation :: !(Maybe Text) -- ^ "location"
  , CreateOrgOption -> Maybe Bool
createOrgOptionRepoAdminChangeTeamAccess :: !(Maybe Bool) -- ^ "repo_admin_change_team_access"
  , CreateOrgOption -> Text
createOrgOptionUsername :: !(Text) -- ^ /Required/ "username"
  , CreateOrgOption -> Maybe E'Visibility
createOrgOptionVisibility :: !(Maybe E'Visibility) -- ^ "visibility" - possible values are &#x60;public&#x60; (default), &#x60;limited&#x60; or &#x60;private&#x60;
  , CreateOrgOption -> Maybe Text
createOrgOptionWebsite :: !(Maybe Text) -- ^ "website"
  } deriving (Int -> CreateOrgOption -> ShowS
[CreateOrgOption] -> ShowS
CreateOrgOption -> [Char]
(Int -> CreateOrgOption -> ShowS)
-> (CreateOrgOption -> [Char])
-> ([CreateOrgOption] -> ShowS)
-> Show CreateOrgOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateOrgOption -> ShowS
showsPrec :: Int -> CreateOrgOption -> ShowS
$cshow :: CreateOrgOption -> [Char]
show :: CreateOrgOption -> [Char]
$cshowList :: [CreateOrgOption] -> ShowS
showList :: [CreateOrgOption] -> ShowS
P.Show, CreateOrgOption -> CreateOrgOption -> Bool
(CreateOrgOption -> CreateOrgOption -> Bool)
-> (CreateOrgOption -> CreateOrgOption -> Bool)
-> Eq CreateOrgOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateOrgOption -> CreateOrgOption -> Bool
== :: CreateOrgOption -> CreateOrgOption -> Bool
$c/= :: CreateOrgOption -> CreateOrgOption -> Bool
/= :: CreateOrgOption -> CreateOrgOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreateOrgOption
instance A.FromJSON CreateOrgOption where
  parseJSON :: Value -> Parser CreateOrgOption
parseJSON = [Char]
-> (Object -> Parser CreateOrgOption)
-> Value
-> Parser CreateOrgOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CreateOrgOption" ((Object -> Parser CreateOrgOption)
 -> Value -> Parser CreateOrgOption)
-> (Object -> Parser CreateOrgOption)
-> Value
-> Parser CreateOrgOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Text
-> Maybe E'Visibility
-> Maybe Text
-> CreateOrgOption
CreateOrgOption
      (Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Text
 -> Maybe E'Visibility
 -> Maybe Text
 -> CreateOrgOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Text
      -> Maybe E'Visibility
      -> Maybe Text
      -> CreateOrgOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Text
   -> Maybe E'Visibility
   -> Maybe Text
   -> CreateOrgOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Text
      -> Maybe E'Visibility
      -> Maybe Text
      -> CreateOrgOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"email")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Text
   -> Maybe E'Visibility
   -> Maybe Text
   -> CreateOrgOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Text
      -> Maybe E'Visibility
      -> Maybe Text
      -> CreateOrgOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"full_name")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Text
   -> Maybe E'Visibility
   -> Maybe Text
   -> CreateOrgOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Text -> Maybe E'Visibility -> Maybe Text -> CreateOrgOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"location")
      Parser
  (Maybe Bool
   -> Text -> Maybe E'Visibility -> Maybe Text -> CreateOrgOption)
-> Parser (Maybe Bool)
-> Parser
     (Text -> Maybe E'Visibility -> Maybe Text -> CreateOrgOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"repo_admin_change_team_access")
      Parser
  (Text -> Maybe E'Visibility -> Maybe Text -> CreateOrgOption)
-> Parser Text
-> Parser (Maybe E'Visibility -> Maybe Text -> CreateOrgOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"username")
      Parser (Maybe E'Visibility -> Maybe Text -> CreateOrgOption)
-> Parser (Maybe E'Visibility)
-> Parser (Maybe Text -> CreateOrgOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe E'Visibility)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"visibility")
      Parser (Maybe Text -> CreateOrgOption)
-> Parser (Maybe Text) -> Parser CreateOrgOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"website")

-- | ToJSON CreateOrgOption
instance A.ToJSON CreateOrgOption where
  toJSON :: CreateOrgOption -> Value
toJSON CreateOrgOption {Maybe Bool
Maybe Text
Maybe E'Visibility
Text
$sel:createOrgOptionDescription:CreateOrgOption :: CreateOrgOption -> Maybe Text
$sel:createOrgOptionEmail:CreateOrgOption :: CreateOrgOption -> Maybe Text
$sel:createOrgOptionFullName:CreateOrgOption :: CreateOrgOption -> Maybe Text
$sel:createOrgOptionLocation:CreateOrgOption :: CreateOrgOption -> Maybe Text
$sel:createOrgOptionRepoAdminChangeTeamAccess:CreateOrgOption :: CreateOrgOption -> Maybe Bool
$sel:createOrgOptionUsername:CreateOrgOption :: CreateOrgOption -> Text
$sel:createOrgOptionVisibility:CreateOrgOption :: CreateOrgOption -> Maybe E'Visibility
$sel:createOrgOptionWebsite:CreateOrgOption :: CreateOrgOption -> Maybe Text
createOrgOptionDescription :: Maybe Text
createOrgOptionEmail :: Maybe Text
createOrgOptionFullName :: Maybe Text
createOrgOptionLocation :: Maybe Text
createOrgOptionRepoAdminChangeTeamAccess :: Maybe Bool
createOrgOptionUsername :: Text
createOrgOptionVisibility :: Maybe E'Visibility
createOrgOptionWebsite :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createOrgOptionDescription
      , Key
"email" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createOrgOptionEmail
      , Key
"full_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createOrgOptionFullName
      , Key
"location" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createOrgOptionLocation
      , Key
"repo_admin_change_team_access" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createOrgOptionRepoAdminChangeTeamAccess
      , Key
"username" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
createOrgOptionUsername
      , Key
"visibility" Key -> Maybe E'Visibility -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe E'Visibility
createOrgOptionVisibility
      , Key
"website" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createOrgOptionWebsite
      ]


-- | Construct a value of type 'CreateOrgOption' (by applying it's required fields, if any)
mkCreateOrgOption
  :: Text -- ^ 'createOrgOptionUsername' 
  -> CreateOrgOption
mkCreateOrgOption :: Text -> CreateOrgOption
mkCreateOrgOption Text
createOrgOptionUsername =
  CreateOrgOption
  { $sel:createOrgOptionDescription:CreateOrgOption :: Maybe Text
createOrgOptionDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createOrgOptionEmail:CreateOrgOption :: Maybe Text
createOrgOptionEmail = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createOrgOptionFullName:CreateOrgOption :: Maybe Text
createOrgOptionFullName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createOrgOptionLocation:CreateOrgOption :: Maybe Text
createOrgOptionLocation = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createOrgOptionRepoAdminChangeTeamAccess:CreateOrgOption :: Maybe Bool
createOrgOptionRepoAdminChangeTeamAccess = Maybe Bool
forall a. Maybe a
Nothing
  , Text
$sel:createOrgOptionUsername:CreateOrgOption :: Text
createOrgOptionUsername :: Text
createOrgOptionUsername
  , $sel:createOrgOptionVisibility:CreateOrgOption :: Maybe E'Visibility
createOrgOptionVisibility = Maybe E'Visibility
forall a. Maybe a
Nothing
  , $sel:createOrgOptionWebsite:CreateOrgOption :: Maybe Text
createOrgOptionWebsite = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** CreatePullRequestOption
-- | CreatePullRequestOption
-- CreatePullRequestOption options when creating a pull request
data CreatePullRequestOption = CreatePullRequestOption
  { CreatePullRequestOption -> Maybe Text
createPullRequestOptionAssignee :: !(Maybe Text) -- ^ "assignee"
  , CreatePullRequestOption -> Maybe [Text]
createPullRequestOptionAssignees :: !(Maybe [Text]) -- ^ "assignees"
  , CreatePullRequestOption -> Maybe Text
createPullRequestOptionBase :: !(Maybe Text) -- ^ "base"
  , CreatePullRequestOption -> Maybe Text
createPullRequestOptionBody :: !(Maybe Text) -- ^ "body"
  , CreatePullRequestOption -> Maybe DateTime
createPullRequestOptionDueDate :: !(Maybe DateTime) -- ^ "due_date"
  , CreatePullRequestOption -> Maybe Text
createPullRequestOptionHead :: !(Maybe Text) -- ^ "head"
  , CreatePullRequestOption -> Maybe [Integer]
createPullRequestOptionLabels :: !(Maybe [Integer]) -- ^ "labels"
  , CreatePullRequestOption -> Maybe Integer
createPullRequestOptionMilestone :: !(Maybe Integer) -- ^ "milestone"
  , CreatePullRequestOption -> Maybe [Text]
createPullRequestOptionReviewers :: !(Maybe [Text]) -- ^ "reviewers"
  , CreatePullRequestOption -> Maybe [Text]
createPullRequestOptionTeamReviewers :: !(Maybe [Text]) -- ^ "team_reviewers"
  , CreatePullRequestOption -> Maybe Text
createPullRequestOptionTitle :: !(Maybe Text) -- ^ "title"
  } deriving (Int -> CreatePullRequestOption -> ShowS
[CreatePullRequestOption] -> ShowS
CreatePullRequestOption -> [Char]
(Int -> CreatePullRequestOption -> ShowS)
-> (CreatePullRequestOption -> [Char])
-> ([CreatePullRequestOption] -> ShowS)
-> Show CreatePullRequestOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreatePullRequestOption -> ShowS
showsPrec :: Int -> CreatePullRequestOption -> ShowS
$cshow :: CreatePullRequestOption -> [Char]
show :: CreatePullRequestOption -> [Char]
$cshowList :: [CreatePullRequestOption] -> ShowS
showList :: [CreatePullRequestOption] -> ShowS
P.Show, CreatePullRequestOption -> CreatePullRequestOption -> Bool
(CreatePullRequestOption -> CreatePullRequestOption -> Bool)
-> (CreatePullRequestOption -> CreatePullRequestOption -> Bool)
-> Eq CreatePullRequestOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreatePullRequestOption -> CreatePullRequestOption -> Bool
== :: CreatePullRequestOption -> CreatePullRequestOption -> Bool
$c/= :: CreatePullRequestOption -> CreatePullRequestOption -> Bool
/= :: CreatePullRequestOption -> CreatePullRequestOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreatePullRequestOption
instance A.FromJSON CreatePullRequestOption where
  parseJSON :: Value -> Parser CreatePullRequestOption
parseJSON = [Char]
-> (Object -> Parser CreatePullRequestOption)
-> Value
-> Parser CreatePullRequestOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CreatePullRequestOption" ((Object -> Parser CreatePullRequestOption)
 -> Value -> Parser CreatePullRequestOption)
-> (Object -> Parser CreatePullRequestOption)
-> Value
-> Parser CreatePullRequestOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe DateTime
-> Maybe Text
-> Maybe [Integer]
-> Maybe Integer
-> Maybe [Text]
-> Maybe [Text]
-> Maybe Text
-> CreatePullRequestOption
CreatePullRequestOption
      (Maybe Text
 -> Maybe [Text]
 -> Maybe Text
 -> Maybe Text
 -> Maybe DateTime
 -> Maybe Text
 -> Maybe [Integer]
 -> Maybe Integer
 -> Maybe [Text]
 -> Maybe [Text]
 -> Maybe Text
 -> CreatePullRequestOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe [Integer]
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Text
      -> CreatePullRequestOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"assignee")
      Parser
  (Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe [Integer]
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Text
   -> CreatePullRequestOption)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe [Integer]
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Text
      -> CreatePullRequestOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"assignees")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe [Integer]
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Text
   -> CreatePullRequestOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe [Integer]
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Text
      -> CreatePullRequestOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"base")
      Parser
  (Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe [Integer]
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Text
   -> CreatePullRequestOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe DateTime
      -> Maybe Text
      -> Maybe [Integer]
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Text
      -> CreatePullRequestOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"body")
      Parser
  (Maybe DateTime
   -> Maybe Text
   -> Maybe [Integer]
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Text
   -> CreatePullRequestOption)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Text
      -> Maybe [Integer]
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Text
      -> CreatePullRequestOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"due_date")
      Parser
  (Maybe Text
   -> Maybe [Integer]
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Text
   -> CreatePullRequestOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Integer]
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Text
      -> CreatePullRequestOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"head")
      Parser
  (Maybe [Integer]
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Text
   -> CreatePullRequestOption)
-> Parser (Maybe [Integer])
-> Parser
     (Maybe Integer
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Text
      -> CreatePullRequestOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Integer])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"labels")
      Parser
  (Maybe Integer
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Text
   -> CreatePullRequestOption)
-> Parser (Maybe Integer)
-> Parser
     (Maybe [Text]
      -> Maybe [Text] -> Maybe Text -> CreatePullRequestOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"milestone")
      Parser
  (Maybe [Text]
   -> Maybe [Text] -> Maybe Text -> CreatePullRequestOption)
-> Parser (Maybe [Text])
-> Parser (Maybe [Text] -> Maybe Text -> CreatePullRequestOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"reviewers")
      Parser (Maybe [Text] -> Maybe Text -> CreatePullRequestOption)
-> Parser (Maybe [Text])
-> Parser (Maybe Text -> CreatePullRequestOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"team_reviewers")
      Parser (Maybe Text -> CreatePullRequestOption)
-> Parser (Maybe Text) -> Parser CreatePullRequestOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title")

-- | ToJSON CreatePullRequestOption
instance A.ToJSON CreatePullRequestOption where
  toJSON :: CreatePullRequestOption -> Value
toJSON CreatePullRequestOption {Maybe Integer
Maybe [Integer]
Maybe [Text]
Maybe Text
Maybe DateTime
$sel:createPullRequestOptionAssignee:CreatePullRequestOption :: CreatePullRequestOption -> Maybe Text
$sel:createPullRequestOptionAssignees:CreatePullRequestOption :: CreatePullRequestOption -> Maybe [Text]
$sel:createPullRequestOptionBase:CreatePullRequestOption :: CreatePullRequestOption -> Maybe Text
$sel:createPullRequestOptionBody:CreatePullRequestOption :: CreatePullRequestOption -> Maybe Text
$sel:createPullRequestOptionDueDate:CreatePullRequestOption :: CreatePullRequestOption -> Maybe DateTime
$sel:createPullRequestOptionHead:CreatePullRequestOption :: CreatePullRequestOption -> Maybe Text
$sel:createPullRequestOptionLabels:CreatePullRequestOption :: CreatePullRequestOption -> Maybe [Integer]
$sel:createPullRequestOptionMilestone:CreatePullRequestOption :: CreatePullRequestOption -> Maybe Integer
$sel:createPullRequestOptionReviewers:CreatePullRequestOption :: CreatePullRequestOption -> Maybe [Text]
$sel:createPullRequestOptionTeamReviewers:CreatePullRequestOption :: CreatePullRequestOption -> Maybe [Text]
$sel:createPullRequestOptionTitle:CreatePullRequestOption :: CreatePullRequestOption -> Maybe Text
createPullRequestOptionAssignee :: Maybe Text
createPullRequestOptionAssignees :: Maybe [Text]
createPullRequestOptionBase :: Maybe Text
createPullRequestOptionBody :: Maybe Text
createPullRequestOptionDueDate :: Maybe DateTime
createPullRequestOptionHead :: Maybe Text
createPullRequestOptionLabels :: Maybe [Integer]
createPullRequestOptionMilestone :: Maybe Integer
createPullRequestOptionReviewers :: Maybe [Text]
createPullRequestOptionTeamReviewers :: Maybe [Text]
createPullRequestOptionTitle :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"assignee" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createPullRequestOptionAssignee
      , Key
"assignees" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
createPullRequestOptionAssignees
      , Key
"base" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createPullRequestOptionBase
      , Key
"body" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createPullRequestOptionBody
      , Key
"due_date" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
createPullRequestOptionDueDate
      , Key
"head" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createPullRequestOptionHead
      , Key
"labels" Key -> Maybe [Integer] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Integer]
createPullRequestOptionLabels
      , Key
"milestone" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
createPullRequestOptionMilestone
      , Key
"reviewers" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
createPullRequestOptionReviewers
      , Key
"team_reviewers" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
createPullRequestOptionTeamReviewers
      , Key
"title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createPullRequestOptionTitle
      ]


-- | Construct a value of type 'CreatePullRequestOption' (by applying it's required fields, if any)
mkCreatePullRequestOption
  :: CreatePullRequestOption
mkCreatePullRequestOption :: CreatePullRequestOption
mkCreatePullRequestOption =
  CreatePullRequestOption
  { $sel:createPullRequestOptionAssignee:CreatePullRequestOption :: Maybe Text
createPullRequestOptionAssignee = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createPullRequestOptionAssignees:CreatePullRequestOption :: Maybe [Text]
createPullRequestOptionAssignees = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:createPullRequestOptionBase:CreatePullRequestOption :: Maybe Text
createPullRequestOptionBase = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createPullRequestOptionBody:CreatePullRequestOption :: Maybe Text
createPullRequestOptionBody = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createPullRequestOptionDueDate:CreatePullRequestOption :: Maybe DateTime
createPullRequestOptionDueDate = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:createPullRequestOptionHead:CreatePullRequestOption :: Maybe Text
createPullRequestOptionHead = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createPullRequestOptionLabels:CreatePullRequestOption :: Maybe [Integer]
createPullRequestOptionLabels = Maybe [Integer]
forall a. Maybe a
Nothing
  , $sel:createPullRequestOptionMilestone:CreatePullRequestOption :: Maybe Integer
createPullRequestOptionMilestone = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:createPullRequestOptionReviewers:CreatePullRequestOption :: Maybe [Text]
createPullRequestOptionReviewers = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:createPullRequestOptionTeamReviewers:CreatePullRequestOption :: Maybe [Text]
createPullRequestOptionTeamReviewers = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:createPullRequestOptionTitle:CreatePullRequestOption :: Maybe Text
createPullRequestOptionTitle = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** CreatePullReviewComment
-- | CreatePullReviewComment
-- CreatePullReviewComment represent a review comment for creation api
data CreatePullReviewComment = CreatePullReviewComment
  { CreatePullReviewComment -> Maybe Text
createPullReviewCommentBody :: !(Maybe Text) -- ^ "body"
  , CreatePullReviewComment -> Maybe Integer
createPullReviewCommentNewPosition :: !(Maybe Integer) -- ^ "new_position" - if comment to new file line or 0
  , CreatePullReviewComment -> Maybe Integer
createPullReviewCommentOldPosition :: !(Maybe Integer) -- ^ "old_position" - if comment to old file line or 0
  , CreatePullReviewComment -> Maybe Text
createPullReviewCommentPath :: !(Maybe Text) -- ^ "path" - the tree path
  } deriving (Int -> CreatePullReviewComment -> ShowS
[CreatePullReviewComment] -> ShowS
CreatePullReviewComment -> [Char]
(Int -> CreatePullReviewComment -> ShowS)
-> (CreatePullReviewComment -> [Char])
-> ([CreatePullReviewComment] -> ShowS)
-> Show CreatePullReviewComment
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreatePullReviewComment -> ShowS
showsPrec :: Int -> CreatePullReviewComment -> ShowS
$cshow :: CreatePullReviewComment -> [Char]
show :: CreatePullReviewComment -> [Char]
$cshowList :: [CreatePullReviewComment] -> ShowS
showList :: [CreatePullReviewComment] -> ShowS
P.Show, CreatePullReviewComment -> CreatePullReviewComment -> Bool
(CreatePullReviewComment -> CreatePullReviewComment -> Bool)
-> (CreatePullReviewComment -> CreatePullReviewComment -> Bool)
-> Eq CreatePullReviewComment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreatePullReviewComment -> CreatePullReviewComment -> Bool
== :: CreatePullReviewComment -> CreatePullReviewComment -> Bool
$c/= :: CreatePullReviewComment -> CreatePullReviewComment -> Bool
/= :: CreatePullReviewComment -> CreatePullReviewComment -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreatePullReviewComment
instance A.FromJSON CreatePullReviewComment where
  parseJSON :: Value -> Parser CreatePullReviewComment
parseJSON = [Char]
-> (Object -> Parser CreatePullReviewComment)
-> Value
-> Parser CreatePullReviewComment
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CreatePullReviewComment" ((Object -> Parser CreatePullReviewComment)
 -> Value -> Parser CreatePullReviewComment)
-> (Object -> Parser CreatePullReviewComment)
-> Value
-> Parser CreatePullReviewComment
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Integer
-> Maybe Integer
-> Maybe Text
-> CreatePullReviewComment
CreatePullReviewComment
      (Maybe Text
 -> Maybe Integer
 -> Maybe Integer
 -> Maybe Text
 -> CreatePullReviewComment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Integer -> Maybe Text -> CreatePullReviewComment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"body")
      Parser
  (Maybe Integer
   -> Maybe Integer -> Maybe Text -> CreatePullReviewComment)
-> Parser (Maybe Integer)
-> Parser (Maybe Integer -> Maybe Text -> CreatePullReviewComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"new_position")
      Parser (Maybe Integer -> Maybe Text -> CreatePullReviewComment)
-> Parser (Maybe Integer)
-> Parser (Maybe Text -> CreatePullReviewComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"old_position")
      Parser (Maybe Text -> CreatePullReviewComment)
-> Parser (Maybe Text) -> Parser CreatePullReviewComment
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"path")

-- | ToJSON CreatePullReviewComment
instance A.ToJSON CreatePullReviewComment where
  toJSON :: CreatePullReviewComment -> Value
toJSON CreatePullReviewComment {Maybe Integer
Maybe Text
$sel:createPullReviewCommentBody:CreatePullReviewComment :: CreatePullReviewComment -> Maybe Text
$sel:createPullReviewCommentNewPosition:CreatePullReviewComment :: CreatePullReviewComment -> Maybe Integer
$sel:createPullReviewCommentOldPosition:CreatePullReviewComment :: CreatePullReviewComment -> Maybe Integer
$sel:createPullReviewCommentPath:CreatePullReviewComment :: CreatePullReviewComment -> Maybe Text
createPullReviewCommentBody :: Maybe Text
createPullReviewCommentNewPosition :: Maybe Integer
createPullReviewCommentOldPosition :: Maybe Integer
createPullReviewCommentPath :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"body" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createPullReviewCommentBody
      , Key
"new_position" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
createPullReviewCommentNewPosition
      , Key
"old_position" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
createPullReviewCommentOldPosition
      , Key
"path" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createPullReviewCommentPath
      ]


-- | Construct a value of type 'CreatePullReviewComment' (by applying it's required fields, if any)
mkCreatePullReviewComment
  :: CreatePullReviewComment
mkCreatePullReviewComment :: CreatePullReviewComment
mkCreatePullReviewComment =
  CreatePullReviewComment
  { $sel:createPullReviewCommentBody:CreatePullReviewComment :: Maybe Text
createPullReviewCommentBody = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createPullReviewCommentNewPosition:CreatePullReviewComment :: Maybe Integer
createPullReviewCommentNewPosition = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:createPullReviewCommentOldPosition:CreatePullReviewComment :: Maybe Integer
createPullReviewCommentOldPosition = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:createPullReviewCommentPath:CreatePullReviewComment :: Maybe Text
createPullReviewCommentPath = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** CreatePullReviewOptions
-- | CreatePullReviewOptions
-- CreatePullReviewOptions are options to create a pull review
data CreatePullReviewOptions = CreatePullReviewOptions
  { CreatePullReviewOptions -> Maybe Text
createPullReviewOptionsBody :: !(Maybe Text) -- ^ "body"
  , CreatePullReviewOptions -> Maybe [CreatePullReviewComment]
createPullReviewOptionsComments :: !(Maybe [CreatePullReviewComment]) -- ^ "comments"
  , CreatePullReviewOptions -> Maybe Text
createPullReviewOptionsCommitId :: !(Maybe Text) -- ^ "commit_id"
  , CreatePullReviewOptions -> Maybe Text
createPullReviewOptionsEvent :: !(Maybe Text) -- ^ "event" - ReviewStateType review state type
  } deriving (Int -> CreatePullReviewOptions -> ShowS
[CreatePullReviewOptions] -> ShowS
CreatePullReviewOptions -> [Char]
(Int -> CreatePullReviewOptions -> ShowS)
-> (CreatePullReviewOptions -> [Char])
-> ([CreatePullReviewOptions] -> ShowS)
-> Show CreatePullReviewOptions
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreatePullReviewOptions -> ShowS
showsPrec :: Int -> CreatePullReviewOptions -> ShowS
$cshow :: CreatePullReviewOptions -> [Char]
show :: CreatePullReviewOptions -> [Char]
$cshowList :: [CreatePullReviewOptions] -> ShowS
showList :: [CreatePullReviewOptions] -> ShowS
P.Show, CreatePullReviewOptions -> CreatePullReviewOptions -> Bool
(CreatePullReviewOptions -> CreatePullReviewOptions -> Bool)
-> (CreatePullReviewOptions -> CreatePullReviewOptions -> Bool)
-> Eq CreatePullReviewOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreatePullReviewOptions -> CreatePullReviewOptions -> Bool
== :: CreatePullReviewOptions -> CreatePullReviewOptions -> Bool
$c/= :: CreatePullReviewOptions -> CreatePullReviewOptions -> Bool
/= :: CreatePullReviewOptions -> CreatePullReviewOptions -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreatePullReviewOptions
instance A.FromJSON CreatePullReviewOptions where
  parseJSON :: Value -> Parser CreatePullReviewOptions
parseJSON = [Char]
-> (Object -> Parser CreatePullReviewOptions)
-> Value
-> Parser CreatePullReviewOptions
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CreatePullReviewOptions" ((Object -> Parser CreatePullReviewOptions)
 -> Value -> Parser CreatePullReviewOptions)
-> (Object -> Parser CreatePullReviewOptions)
-> Value
-> Parser CreatePullReviewOptions
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe [CreatePullReviewComment]
-> Maybe Text
-> Maybe Text
-> CreatePullReviewOptions
CreatePullReviewOptions
      (Maybe Text
 -> Maybe [CreatePullReviewComment]
 -> Maybe Text
 -> Maybe Text
 -> CreatePullReviewOptions)
-> Parser (Maybe Text)
-> Parser
     (Maybe [CreatePullReviewComment]
      -> Maybe Text -> Maybe Text -> CreatePullReviewOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"body")
      Parser
  (Maybe [CreatePullReviewComment]
   -> Maybe Text -> Maybe Text -> CreatePullReviewOptions)
-> Parser (Maybe [CreatePullReviewComment])
-> Parser (Maybe Text -> Maybe Text -> CreatePullReviewOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [CreatePullReviewComment])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"comments")
      Parser (Maybe Text -> Maybe Text -> CreatePullReviewOptions)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> CreatePullReviewOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"commit_id")
      Parser (Maybe Text -> CreatePullReviewOptions)
-> Parser (Maybe Text) -> Parser CreatePullReviewOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"event")

-- | ToJSON CreatePullReviewOptions
instance A.ToJSON CreatePullReviewOptions where
  toJSON :: CreatePullReviewOptions -> Value
toJSON CreatePullReviewOptions {Maybe [CreatePullReviewComment]
Maybe Text
$sel:createPullReviewOptionsBody:CreatePullReviewOptions :: CreatePullReviewOptions -> Maybe Text
$sel:createPullReviewOptionsComments:CreatePullReviewOptions :: CreatePullReviewOptions -> Maybe [CreatePullReviewComment]
$sel:createPullReviewOptionsCommitId:CreatePullReviewOptions :: CreatePullReviewOptions -> Maybe Text
$sel:createPullReviewOptionsEvent:CreatePullReviewOptions :: CreatePullReviewOptions -> Maybe Text
createPullReviewOptionsBody :: Maybe Text
createPullReviewOptionsComments :: Maybe [CreatePullReviewComment]
createPullReviewOptionsCommitId :: Maybe Text
createPullReviewOptionsEvent :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"body" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createPullReviewOptionsBody
      , Key
"comments" Key -> Maybe [CreatePullReviewComment] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [CreatePullReviewComment]
createPullReviewOptionsComments
      , Key
"commit_id" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createPullReviewOptionsCommitId
      , Key
"event" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createPullReviewOptionsEvent
      ]


-- | Construct a value of type 'CreatePullReviewOptions' (by applying it's required fields, if any)
mkCreatePullReviewOptions
  :: CreatePullReviewOptions
mkCreatePullReviewOptions :: CreatePullReviewOptions
mkCreatePullReviewOptions =
  CreatePullReviewOptions
  { $sel:createPullReviewOptionsBody:CreatePullReviewOptions :: Maybe Text
createPullReviewOptionsBody = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createPullReviewOptionsComments:CreatePullReviewOptions :: Maybe [CreatePullReviewComment]
createPullReviewOptionsComments = Maybe [CreatePullReviewComment]
forall a. Maybe a
Nothing
  , $sel:createPullReviewOptionsCommitId:CreatePullReviewOptions :: Maybe Text
createPullReviewOptionsCommitId = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createPullReviewOptionsEvent:CreatePullReviewOptions :: Maybe Text
createPullReviewOptionsEvent = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** CreatePushMirrorOption
-- | CreatePushMirrorOption
-- CreatePushMirrorOption represents need information to create a push mirror of a repository.
-- 
data CreatePushMirrorOption = CreatePushMirrorOption
  { CreatePushMirrorOption -> Maybe Text
createPushMirrorOptionInterval :: !(Maybe Text) -- ^ "interval"
  , CreatePushMirrorOption -> Maybe Text
createPushMirrorOptionRemoteAddress :: !(Maybe Text) -- ^ "remote_address"
  , CreatePushMirrorOption -> Maybe Text
createPushMirrorOptionRemotePassword :: !(Maybe Text) -- ^ "remote_password"
  , CreatePushMirrorOption -> Maybe Text
createPushMirrorOptionRemoteUsername :: !(Maybe Text) -- ^ "remote_username"
  , CreatePushMirrorOption -> Maybe Bool
createPushMirrorOptionSyncOnCommit :: !(Maybe Bool) -- ^ "sync_on_commit"
  } deriving (Int -> CreatePushMirrorOption -> ShowS
[CreatePushMirrorOption] -> ShowS
CreatePushMirrorOption -> [Char]
(Int -> CreatePushMirrorOption -> ShowS)
-> (CreatePushMirrorOption -> [Char])
-> ([CreatePushMirrorOption] -> ShowS)
-> Show CreatePushMirrorOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreatePushMirrorOption -> ShowS
showsPrec :: Int -> CreatePushMirrorOption -> ShowS
$cshow :: CreatePushMirrorOption -> [Char]
show :: CreatePushMirrorOption -> [Char]
$cshowList :: [CreatePushMirrorOption] -> ShowS
showList :: [CreatePushMirrorOption] -> ShowS
P.Show, CreatePushMirrorOption -> CreatePushMirrorOption -> Bool
(CreatePushMirrorOption -> CreatePushMirrorOption -> Bool)
-> (CreatePushMirrorOption -> CreatePushMirrorOption -> Bool)
-> Eq CreatePushMirrorOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreatePushMirrorOption -> CreatePushMirrorOption -> Bool
== :: CreatePushMirrorOption -> CreatePushMirrorOption -> Bool
$c/= :: CreatePushMirrorOption -> CreatePushMirrorOption -> Bool
/= :: CreatePushMirrorOption -> CreatePushMirrorOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreatePushMirrorOption
instance A.FromJSON CreatePushMirrorOption where
  parseJSON :: Value -> Parser CreatePushMirrorOption
parseJSON = [Char]
-> (Object -> Parser CreatePushMirrorOption)
-> Value
-> Parser CreatePushMirrorOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CreatePushMirrorOption" ((Object -> Parser CreatePushMirrorOption)
 -> Value -> Parser CreatePushMirrorOption)
-> (Object -> Parser CreatePushMirrorOption)
-> Value
-> Parser CreatePushMirrorOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> CreatePushMirrorOption
CreatePushMirrorOption
      (Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> CreatePushMirrorOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> CreatePushMirrorOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"interval")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> CreatePushMirrorOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Text -> Maybe Bool -> CreatePushMirrorOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"remote_address")
      Parser
  (Maybe Text -> Maybe Text -> Maybe Bool -> CreatePushMirrorOption)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Bool -> CreatePushMirrorOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"remote_password")
      Parser (Maybe Text -> Maybe Bool -> CreatePushMirrorOption)
-> Parser (Maybe Text)
-> Parser (Maybe Bool -> CreatePushMirrorOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"remote_username")
      Parser (Maybe Bool -> CreatePushMirrorOption)
-> Parser (Maybe Bool) -> Parser CreatePushMirrorOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sync_on_commit")

-- | ToJSON CreatePushMirrorOption
instance A.ToJSON CreatePushMirrorOption where
  toJSON :: CreatePushMirrorOption -> Value
toJSON CreatePushMirrorOption {Maybe Bool
Maybe Text
$sel:createPushMirrorOptionInterval:CreatePushMirrorOption :: CreatePushMirrorOption -> Maybe Text
$sel:createPushMirrorOptionRemoteAddress:CreatePushMirrorOption :: CreatePushMirrorOption -> Maybe Text
$sel:createPushMirrorOptionRemotePassword:CreatePushMirrorOption :: CreatePushMirrorOption -> Maybe Text
$sel:createPushMirrorOptionRemoteUsername:CreatePushMirrorOption :: CreatePushMirrorOption -> Maybe Text
$sel:createPushMirrorOptionSyncOnCommit:CreatePushMirrorOption :: CreatePushMirrorOption -> Maybe Bool
createPushMirrorOptionInterval :: Maybe Text
createPushMirrorOptionRemoteAddress :: Maybe Text
createPushMirrorOptionRemotePassword :: Maybe Text
createPushMirrorOptionRemoteUsername :: Maybe Text
createPushMirrorOptionSyncOnCommit :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"interval" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createPushMirrorOptionInterval
      , Key
"remote_address" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createPushMirrorOptionRemoteAddress
      , Key
"remote_password" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createPushMirrorOptionRemotePassword
      , Key
"remote_username" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createPushMirrorOptionRemoteUsername
      , Key
"sync_on_commit" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createPushMirrorOptionSyncOnCommit
      ]


-- | Construct a value of type 'CreatePushMirrorOption' (by applying it's required fields, if any)
mkCreatePushMirrorOption
  :: CreatePushMirrorOption
mkCreatePushMirrorOption :: CreatePushMirrorOption
mkCreatePushMirrorOption =
  CreatePushMirrorOption
  { $sel:createPushMirrorOptionInterval:CreatePushMirrorOption :: Maybe Text
createPushMirrorOptionInterval = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createPushMirrorOptionRemoteAddress:CreatePushMirrorOption :: Maybe Text
createPushMirrorOptionRemoteAddress = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createPushMirrorOptionRemotePassword:CreatePushMirrorOption :: Maybe Text
createPushMirrorOptionRemotePassword = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createPushMirrorOptionRemoteUsername:CreatePushMirrorOption :: Maybe Text
createPushMirrorOptionRemoteUsername = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createPushMirrorOptionSyncOnCommit:CreatePushMirrorOption :: Maybe Bool
createPushMirrorOptionSyncOnCommit = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** CreateReleaseOption
-- | CreateReleaseOption
-- CreateReleaseOption options when creating a release
data CreateReleaseOption = CreateReleaseOption
  { CreateReleaseOption -> Maybe Text
createReleaseOptionBody :: !(Maybe Text) -- ^ "body"
  , CreateReleaseOption -> Maybe Bool
createReleaseOptionDraft :: !(Maybe Bool) -- ^ "draft"
  , CreateReleaseOption -> Maybe Text
createReleaseOptionName :: !(Maybe Text) -- ^ "name"
  , CreateReleaseOption -> Maybe Bool
createReleaseOptionPrerelease :: !(Maybe Bool) -- ^ "prerelease"
  , CreateReleaseOption -> Text
createReleaseOptionTagName :: !(Text) -- ^ /Required/ "tag_name"
  , CreateReleaseOption -> Maybe Text
createReleaseOptionTargetCommitish :: !(Maybe Text) -- ^ "target_commitish"
  } deriving (Int -> CreateReleaseOption -> ShowS
[CreateReleaseOption] -> ShowS
CreateReleaseOption -> [Char]
(Int -> CreateReleaseOption -> ShowS)
-> (CreateReleaseOption -> [Char])
-> ([CreateReleaseOption] -> ShowS)
-> Show CreateReleaseOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateReleaseOption -> ShowS
showsPrec :: Int -> CreateReleaseOption -> ShowS
$cshow :: CreateReleaseOption -> [Char]
show :: CreateReleaseOption -> [Char]
$cshowList :: [CreateReleaseOption] -> ShowS
showList :: [CreateReleaseOption] -> ShowS
P.Show, CreateReleaseOption -> CreateReleaseOption -> Bool
(CreateReleaseOption -> CreateReleaseOption -> Bool)
-> (CreateReleaseOption -> CreateReleaseOption -> Bool)
-> Eq CreateReleaseOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateReleaseOption -> CreateReleaseOption -> Bool
== :: CreateReleaseOption -> CreateReleaseOption -> Bool
$c/= :: CreateReleaseOption -> CreateReleaseOption -> Bool
/= :: CreateReleaseOption -> CreateReleaseOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreateReleaseOption
instance A.FromJSON CreateReleaseOption where
  parseJSON :: Value -> Parser CreateReleaseOption
parseJSON = [Char]
-> (Object -> Parser CreateReleaseOption)
-> Value
-> Parser CreateReleaseOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CreateReleaseOption" ((Object -> Parser CreateReleaseOption)
 -> Value -> Parser CreateReleaseOption)
-> (Object -> Parser CreateReleaseOption)
-> Value
-> Parser CreateReleaseOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> Text
-> Maybe Text
-> CreateReleaseOption
CreateReleaseOption
      (Maybe Text
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Bool
 -> Text
 -> Maybe Text
 -> CreateReleaseOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Text
      -> Maybe Text
      -> CreateReleaseOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"body")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Text
   -> Maybe Text
   -> CreateReleaseOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Bool -> Text -> Maybe Text -> CreateReleaseOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"draft")
      Parser
  (Maybe Text
   -> Maybe Bool -> Text -> Maybe Text -> CreateReleaseOption)
-> Parser (Maybe Text)
-> Parser (Maybe Bool -> Text -> Maybe Text -> CreateReleaseOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser (Maybe Bool -> Text -> Maybe Text -> CreateReleaseOption)
-> Parser (Maybe Bool)
-> Parser (Text -> Maybe Text -> CreateReleaseOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prerelease")
      Parser (Text -> Maybe Text -> CreateReleaseOption)
-> Parser Text -> Parser (Maybe Text -> CreateReleaseOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"tag_name")
      Parser (Maybe Text -> CreateReleaseOption)
-> Parser (Maybe Text) -> Parser CreateReleaseOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"target_commitish")

-- | ToJSON CreateReleaseOption
instance A.ToJSON CreateReleaseOption where
  toJSON :: CreateReleaseOption -> Value
toJSON CreateReleaseOption {Maybe Bool
Maybe Text
Text
$sel:createReleaseOptionBody:CreateReleaseOption :: CreateReleaseOption -> Maybe Text
$sel:createReleaseOptionDraft:CreateReleaseOption :: CreateReleaseOption -> Maybe Bool
$sel:createReleaseOptionName:CreateReleaseOption :: CreateReleaseOption -> Maybe Text
$sel:createReleaseOptionPrerelease:CreateReleaseOption :: CreateReleaseOption -> Maybe Bool
$sel:createReleaseOptionTagName:CreateReleaseOption :: CreateReleaseOption -> Text
$sel:createReleaseOptionTargetCommitish:CreateReleaseOption :: CreateReleaseOption -> Maybe Text
createReleaseOptionBody :: Maybe Text
createReleaseOptionDraft :: Maybe Bool
createReleaseOptionName :: Maybe Text
createReleaseOptionPrerelease :: Maybe Bool
createReleaseOptionTagName :: Text
createReleaseOptionTargetCommitish :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"body" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createReleaseOptionBody
      , Key
"draft" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createReleaseOptionDraft
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createReleaseOptionName
      , Key
"prerelease" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createReleaseOptionPrerelease
      , Key
"tag_name" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
createReleaseOptionTagName
      , Key
"target_commitish" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createReleaseOptionTargetCommitish
      ]


-- | Construct a value of type 'CreateReleaseOption' (by applying it's required fields, if any)
mkCreateReleaseOption
  :: Text -- ^ 'createReleaseOptionTagName' 
  -> CreateReleaseOption
mkCreateReleaseOption :: Text -> CreateReleaseOption
mkCreateReleaseOption Text
createReleaseOptionTagName =
  CreateReleaseOption
  { $sel:createReleaseOptionBody:CreateReleaseOption :: Maybe Text
createReleaseOptionBody = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createReleaseOptionDraft:CreateReleaseOption :: Maybe Bool
createReleaseOptionDraft = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createReleaseOptionName:CreateReleaseOption :: Maybe Text
createReleaseOptionName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createReleaseOptionPrerelease:CreateReleaseOption :: Maybe Bool
createReleaseOptionPrerelease = Maybe Bool
forall a. Maybe a
Nothing
  , Text
$sel:createReleaseOptionTagName:CreateReleaseOption :: Text
createReleaseOptionTagName :: Text
createReleaseOptionTagName
  , $sel:createReleaseOptionTargetCommitish:CreateReleaseOption :: Maybe Text
createReleaseOptionTargetCommitish = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** CreateRepoOption
-- | CreateRepoOption
-- CreateRepoOption options when creating repository
data CreateRepoOption = CreateRepoOption
  { CreateRepoOption -> Maybe Bool
createRepoOptionAutoInit :: !(Maybe Bool) -- ^ "auto_init" - Whether the repository should be auto-initialized?
  , CreateRepoOption -> Maybe Text
createRepoOptionDefaultBranch :: !(Maybe Text) -- ^ "default_branch" - DefaultBranch of the repository (used when initializes and in template)
  , CreateRepoOption -> Maybe Text
createRepoOptionDescription :: !(Maybe Text) -- ^ "description" - Description of the repository to create
  , CreateRepoOption -> Maybe Text
createRepoOptionGitignores :: !(Maybe Text) -- ^ "gitignores" - Gitignores to use
  , CreateRepoOption -> Maybe Text
createRepoOptionIssueLabels :: !(Maybe Text) -- ^ "issue_labels" - Label-Set to use
  , CreateRepoOption -> Maybe Text
createRepoOptionLicense :: !(Maybe Text) -- ^ "license" - License to use
  , CreateRepoOption -> Text
createRepoOptionName :: !(Text) -- ^ /Required/ "name" - Name of the repository to create
  , CreateRepoOption -> Maybe E'ObjectFormatName
createRepoOptionObjectFormatName :: !(Maybe E'ObjectFormatName) -- ^ "object_format_name" - ObjectFormatName of the underlying git repository
  , CreateRepoOption -> Maybe Bool
createRepoOptionPrivate :: !(Maybe Bool) -- ^ "private" - Whether the repository is private
  , CreateRepoOption -> Maybe Text
createRepoOptionReadme :: !(Maybe Text) -- ^ "readme" - Readme of the repository to create
  , CreateRepoOption -> Maybe Bool
createRepoOptionTemplate :: !(Maybe Bool) -- ^ "template" - Whether the repository is template
  , CreateRepoOption -> Maybe E'TrustModel
createRepoOptionTrustModel :: !(Maybe E'TrustModel) -- ^ "trust_model" - TrustModel of the repository
  } deriving (Int -> CreateRepoOption -> ShowS
[CreateRepoOption] -> ShowS
CreateRepoOption -> [Char]
(Int -> CreateRepoOption -> ShowS)
-> (CreateRepoOption -> [Char])
-> ([CreateRepoOption] -> ShowS)
-> Show CreateRepoOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateRepoOption -> ShowS
showsPrec :: Int -> CreateRepoOption -> ShowS
$cshow :: CreateRepoOption -> [Char]
show :: CreateRepoOption -> [Char]
$cshowList :: [CreateRepoOption] -> ShowS
showList :: [CreateRepoOption] -> ShowS
P.Show, CreateRepoOption -> CreateRepoOption -> Bool
(CreateRepoOption -> CreateRepoOption -> Bool)
-> (CreateRepoOption -> CreateRepoOption -> Bool)
-> Eq CreateRepoOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateRepoOption -> CreateRepoOption -> Bool
== :: CreateRepoOption -> CreateRepoOption -> Bool
$c/= :: CreateRepoOption -> CreateRepoOption -> Bool
/= :: CreateRepoOption -> CreateRepoOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreateRepoOption
instance A.FromJSON CreateRepoOption where
  parseJSON :: Value -> Parser CreateRepoOption
parseJSON = [Char]
-> (Object -> Parser CreateRepoOption)
-> Value
-> Parser CreateRepoOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CreateRepoOption" ((Object -> Parser CreateRepoOption)
 -> Value -> Parser CreateRepoOption)
-> (Object -> Parser CreateRepoOption)
-> Value
-> Parser CreateRepoOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Text
-> Maybe E'ObjectFormatName
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> Maybe E'TrustModel
-> CreateRepoOption
CreateRepoOption
      (Maybe Bool
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Text
 -> Maybe E'ObjectFormatName
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Bool
 -> Maybe E'TrustModel
 -> CreateRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe E'ObjectFormatName
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe E'TrustModel
      -> CreateRepoOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"auto_init")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe E'ObjectFormatName
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe E'TrustModel
   -> CreateRepoOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe E'ObjectFormatName
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe E'TrustModel
      -> CreateRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"default_branch")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe E'ObjectFormatName
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe E'TrustModel
   -> CreateRepoOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe E'ObjectFormatName
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe E'TrustModel
      -> CreateRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe E'ObjectFormatName
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe E'TrustModel
   -> CreateRepoOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe E'ObjectFormatName
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe E'TrustModel
      -> CreateRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"gitignores")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe E'ObjectFormatName
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe E'TrustModel
   -> CreateRepoOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Text
      -> Maybe E'ObjectFormatName
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe E'TrustModel
      -> CreateRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"issue_labels")
      Parser
  (Maybe Text
   -> Text
   -> Maybe E'ObjectFormatName
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe E'TrustModel
   -> CreateRepoOption)
-> Parser (Maybe Text)
-> Parser
     (Text
      -> Maybe E'ObjectFormatName
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe E'TrustModel
      -> CreateRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"license")
      Parser
  (Text
   -> Maybe E'ObjectFormatName
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe E'TrustModel
   -> CreateRepoOption)
-> Parser Text
-> Parser
     (Maybe E'ObjectFormatName
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe E'TrustModel
      -> CreateRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"name")
      Parser
  (Maybe E'ObjectFormatName
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe E'TrustModel
   -> CreateRepoOption)
-> Parser (Maybe E'ObjectFormatName)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe E'TrustModel
      -> CreateRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe E'ObjectFormatName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"object_format_name")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe E'TrustModel
   -> CreateRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Bool -> Maybe E'TrustModel -> CreateRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"private")
      Parser
  (Maybe Text
   -> Maybe Bool -> Maybe E'TrustModel -> CreateRepoOption)
-> Parser (Maybe Text)
-> Parser (Maybe Bool -> Maybe E'TrustModel -> CreateRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"readme")
      Parser (Maybe Bool -> Maybe E'TrustModel -> CreateRepoOption)
-> Parser (Maybe Bool)
-> Parser (Maybe E'TrustModel -> CreateRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"template")
      Parser (Maybe E'TrustModel -> CreateRepoOption)
-> Parser (Maybe E'TrustModel) -> Parser CreateRepoOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe E'TrustModel)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"trust_model")

-- | ToJSON CreateRepoOption
instance A.ToJSON CreateRepoOption where
  toJSON :: CreateRepoOption -> Value
toJSON CreateRepoOption {Maybe Bool
Maybe Text
Maybe E'TrustModel
Maybe E'ObjectFormatName
Text
$sel:createRepoOptionAutoInit:CreateRepoOption :: CreateRepoOption -> Maybe Bool
$sel:createRepoOptionDefaultBranch:CreateRepoOption :: CreateRepoOption -> Maybe Text
$sel:createRepoOptionDescription:CreateRepoOption :: CreateRepoOption -> Maybe Text
$sel:createRepoOptionGitignores:CreateRepoOption :: CreateRepoOption -> Maybe Text
$sel:createRepoOptionIssueLabels:CreateRepoOption :: CreateRepoOption -> Maybe Text
$sel:createRepoOptionLicense:CreateRepoOption :: CreateRepoOption -> Maybe Text
$sel:createRepoOptionName:CreateRepoOption :: CreateRepoOption -> Text
$sel:createRepoOptionObjectFormatName:CreateRepoOption :: CreateRepoOption -> Maybe E'ObjectFormatName
$sel:createRepoOptionPrivate:CreateRepoOption :: CreateRepoOption -> Maybe Bool
$sel:createRepoOptionReadme:CreateRepoOption :: CreateRepoOption -> Maybe Text
$sel:createRepoOptionTemplate:CreateRepoOption :: CreateRepoOption -> Maybe Bool
$sel:createRepoOptionTrustModel:CreateRepoOption :: CreateRepoOption -> Maybe E'TrustModel
createRepoOptionAutoInit :: Maybe Bool
createRepoOptionDefaultBranch :: Maybe Text
createRepoOptionDescription :: Maybe Text
createRepoOptionGitignores :: Maybe Text
createRepoOptionIssueLabels :: Maybe Text
createRepoOptionLicense :: Maybe Text
createRepoOptionName :: Text
createRepoOptionObjectFormatName :: Maybe E'ObjectFormatName
createRepoOptionPrivate :: Maybe Bool
createRepoOptionReadme :: Maybe Text
createRepoOptionTemplate :: Maybe Bool
createRepoOptionTrustModel :: Maybe E'TrustModel
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"auto_init" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createRepoOptionAutoInit
      , Key
"default_branch" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createRepoOptionDefaultBranch
      , Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createRepoOptionDescription
      , Key
"gitignores" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createRepoOptionGitignores
      , Key
"issue_labels" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createRepoOptionIssueLabels
      , Key
"license" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createRepoOptionLicense
      , Key
"name" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
createRepoOptionName
      , Key
"object_format_name" Key -> Maybe E'ObjectFormatName -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe E'ObjectFormatName
createRepoOptionObjectFormatName
      , Key
"private" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createRepoOptionPrivate
      , Key
"readme" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createRepoOptionReadme
      , Key
"template" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createRepoOptionTemplate
      , Key
"trust_model" Key -> Maybe E'TrustModel -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe E'TrustModel
createRepoOptionTrustModel
      ]


-- | Construct a value of type 'CreateRepoOption' (by applying it's required fields, if any)
mkCreateRepoOption
  :: Text -- ^ 'createRepoOptionName': Name of the repository to create
  -> CreateRepoOption
mkCreateRepoOption :: Text -> CreateRepoOption
mkCreateRepoOption Text
createRepoOptionName =
  CreateRepoOption
  { $sel:createRepoOptionAutoInit:CreateRepoOption :: Maybe Bool
createRepoOptionAutoInit = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createRepoOptionDefaultBranch:CreateRepoOption :: Maybe Text
createRepoOptionDefaultBranch = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createRepoOptionDescription:CreateRepoOption :: Maybe Text
createRepoOptionDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createRepoOptionGitignores:CreateRepoOption :: Maybe Text
createRepoOptionGitignores = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createRepoOptionIssueLabels:CreateRepoOption :: Maybe Text
createRepoOptionIssueLabels = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createRepoOptionLicense:CreateRepoOption :: Maybe Text
createRepoOptionLicense = Maybe Text
forall a. Maybe a
Nothing
  , Text
$sel:createRepoOptionName:CreateRepoOption :: Text
createRepoOptionName :: Text
createRepoOptionName
  , $sel:createRepoOptionObjectFormatName:CreateRepoOption :: Maybe E'ObjectFormatName
createRepoOptionObjectFormatName = Maybe E'ObjectFormatName
forall a. Maybe a
Nothing
  , $sel:createRepoOptionPrivate:CreateRepoOption :: Maybe Bool
createRepoOptionPrivate = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createRepoOptionReadme:CreateRepoOption :: Maybe Text
createRepoOptionReadme = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createRepoOptionTemplate:CreateRepoOption :: Maybe Bool
createRepoOptionTemplate = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createRepoOptionTrustModel:CreateRepoOption :: Maybe E'TrustModel
createRepoOptionTrustModel = Maybe E'TrustModel
forall a. Maybe a
Nothing
  }

-- ** CreateStatusOption
-- | CreateStatusOption
-- CreateStatusOption holds the information needed to create a new CommitStatus for a Commit
data CreateStatusOption = CreateStatusOption
  { CreateStatusOption -> Maybe Text
createStatusOptionContext :: !(Maybe Text) -- ^ "context"
  , CreateStatusOption -> Maybe Text
createStatusOptionDescription :: !(Maybe Text) -- ^ "description"
  , CreateStatusOption -> Maybe Text
createStatusOptionState :: !(Maybe Text) -- ^ "state" - CommitStatusState holds the state of a CommitStatus It can be \&quot;pending\&quot;, \&quot;success\&quot;, \&quot;error\&quot; and \&quot;failure\&quot;
  , CreateStatusOption -> Maybe Text
createStatusOptionTargetUrl :: !(Maybe Text) -- ^ "target_url"
  } deriving (Int -> CreateStatusOption -> ShowS
[CreateStatusOption] -> ShowS
CreateStatusOption -> [Char]
(Int -> CreateStatusOption -> ShowS)
-> (CreateStatusOption -> [Char])
-> ([CreateStatusOption] -> ShowS)
-> Show CreateStatusOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateStatusOption -> ShowS
showsPrec :: Int -> CreateStatusOption -> ShowS
$cshow :: CreateStatusOption -> [Char]
show :: CreateStatusOption -> [Char]
$cshowList :: [CreateStatusOption] -> ShowS
showList :: [CreateStatusOption] -> ShowS
P.Show, CreateStatusOption -> CreateStatusOption -> Bool
(CreateStatusOption -> CreateStatusOption -> Bool)
-> (CreateStatusOption -> CreateStatusOption -> Bool)
-> Eq CreateStatusOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateStatusOption -> CreateStatusOption -> Bool
== :: CreateStatusOption -> CreateStatusOption -> Bool
$c/= :: CreateStatusOption -> CreateStatusOption -> Bool
/= :: CreateStatusOption -> CreateStatusOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreateStatusOption
instance A.FromJSON CreateStatusOption where
  parseJSON :: Value -> Parser CreateStatusOption
parseJSON = [Char]
-> (Object -> Parser CreateStatusOption)
-> Value
-> Parser CreateStatusOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CreateStatusOption" ((Object -> Parser CreateStatusOption)
 -> Value -> Parser CreateStatusOption)
-> (Object -> Parser CreateStatusOption)
-> Value
-> Parser CreateStatusOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text -> Maybe Text -> Maybe Text -> CreateStatusOption
CreateStatusOption
      (Maybe Text
 -> Maybe Text -> Maybe Text -> Maybe Text -> CreateStatusOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Text -> Maybe Text -> CreateStatusOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"context")
      Parser
  (Maybe Text -> Maybe Text -> Maybe Text -> CreateStatusOption)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> CreateStatusOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser (Maybe Text -> Maybe Text -> CreateStatusOption)
-> Parser (Maybe Text) -> Parser (Maybe Text -> CreateStatusOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"state")
      Parser (Maybe Text -> CreateStatusOption)
-> Parser (Maybe Text) -> Parser CreateStatusOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"target_url")

-- | ToJSON CreateStatusOption
instance A.ToJSON CreateStatusOption where
  toJSON :: CreateStatusOption -> Value
toJSON CreateStatusOption {Maybe Text
$sel:createStatusOptionContext:CreateStatusOption :: CreateStatusOption -> Maybe Text
$sel:createStatusOptionDescription:CreateStatusOption :: CreateStatusOption -> Maybe Text
$sel:createStatusOptionState:CreateStatusOption :: CreateStatusOption -> Maybe Text
$sel:createStatusOptionTargetUrl:CreateStatusOption :: CreateStatusOption -> Maybe Text
createStatusOptionContext :: Maybe Text
createStatusOptionDescription :: Maybe Text
createStatusOptionState :: Maybe Text
createStatusOptionTargetUrl :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"context" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createStatusOptionContext
      , Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createStatusOptionDescription
      , Key
"state" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createStatusOptionState
      , Key
"target_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createStatusOptionTargetUrl
      ]


-- | Construct a value of type 'CreateStatusOption' (by applying it's required fields, if any)
mkCreateStatusOption
  :: CreateStatusOption
mkCreateStatusOption :: CreateStatusOption
mkCreateStatusOption =
  CreateStatusOption
  { $sel:createStatusOptionContext:CreateStatusOption :: Maybe Text
createStatusOptionContext = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createStatusOptionDescription:CreateStatusOption :: Maybe Text
createStatusOptionDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createStatusOptionState:CreateStatusOption :: Maybe Text
createStatusOptionState = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createStatusOptionTargetUrl:CreateStatusOption :: Maybe Text
createStatusOptionTargetUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** CreateTagOption
-- | CreateTagOption
-- CreateTagOption options when creating a tag
data CreateTagOption = CreateTagOption
  { CreateTagOption -> Maybe Text
createTagOptionMessage :: !(Maybe Text) -- ^ "message"
  , CreateTagOption -> Text
createTagOptionTagName :: !(Text) -- ^ /Required/ "tag_name"
  , CreateTagOption -> Maybe Text
createTagOptionTarget :: !(Maybe Text) -- ^ "target"
  } deriving (Int -> CreateTagOption -> ShowS
[CreateTagOption] -> ShowS
CreateTagOption -> [Char]
(Int -> CreateTagOption -> ShowS)
-> (CreateTagOption -> [Char])
-> ([CreateTagOption] -> ShowS)
-> Show CreateTagOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateTagOption -> ShowS
showsPrec :: Int -> CreateTagOption -> ShowS
$cshow :: CreateTagOption -> [Char]
show :: CreateTagOption -> [Char]
$cshowList :: [CreateTagOption] -> ShowS
showList :: [CreateTagOption] -> ShowS
P.Show, CreateTagOption -> CreateTagOption -> Bool
(CreateTagOption -> CreateTagOption -> Bool)
-> (CreateTagOption -> CreateTagOption -> Bool)
-> Eq CreateTagOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateTagOption -> CreateTagOption -> Bool
== :: CreateTagOption -> CreateTagOption -> Bool
$c/= :: CreateTagOption -> CreateTagOption -> Bool
/= :: CreateTagOption -> CreateTagOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreateTagOption
instance A.FromJSON CreateTagOption where
  parseJSON :: Value -> Parser CreateTagOption
parseJSON = [Char]
-> (Object -> Parser CreateTagOption)
-> Value
-> Parser CreateTagOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CreateTagOption" ((Object -> Parser CreateTagOption)
 -> Value -> Parser CreateTagOption)
-> (Object -> Parser CreateTagOption)
-> Value
-> Parser CreateTagOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Text -> Maybe Text -> CreateTagOption
CreateTagOption
      (Maybe Text -> Text -> Maybe Text -> CreateTagOption)
-> Parser (Maybe Text)
-> Parser (Text -> Maybe Text -> CreateTagOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"message")
      Parser (Text -> Maybe Text -> CreateTagOption)
-> Parser Text -> Parser (Maybe Text -> CreateTagOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"tag_name")
      Parser (Maybe Text -> CreateTagOption)
-> Parser (Maybe Text) -> Parser CreateTagOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"target")

-- | ToJSON CreateTagOption
instance A.ToJSON CreateTagOption where
  toJSON :: CreateTagOption -> Value
toJSON CreateTagOption {Maybe Text
Text
$sel:createTagOptionMessage:CreateTagOption :: CreateTagOption -> Maybe Text
$sel:createTagOptionTagName:CreateTagOption :: CreateTagOption -> Text
$sel:createTagOptionTarget:CreateTagOption :: CreateTagOption -> Maybe Text
createTagOptionMessage :: Maybe Text
createTagOptionTagName :: Text
createTagOptionTarget :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"message" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createTagOptionMessage
      , Key
"tag_name" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
createTagOptionTagName
      , Key
"target" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createTagOptionTarget
      ]


-- | Construct a value of type 'CreateTagOption' (by applying it's required fields, if any)
mkCreateTagOption
  :: Text -- ^ 'createTagOptionTagName' 
  -> CreateTagOption
mkCreateTagOption :: Text -> CreateTagOption
mkCreateTagOption Text
createTagOptionTagName =
  CreateTagOption
  { $sel:createTagOptionMessage:CreateTagOption :: Maybe Text
createTagOptionMessage = Maybe Text
forall a. Maybe a
Nothing
  , Text
$sel:createTagOptionTagName:CreateTagOption :: Text
createTagOptionTagName :: Text
createTagOptionTagName
  , $sel:createTagOptionTarget:CreateTagOption :: Maybe Text
createTagOptionTarget = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** CreateTagProtectionOption
-- | CreateTagProtectionOption
-- CreateTagProtectionOption options for creating a tag protection
data CreateTagProtectionOption = CreateTagProtectionOption
  { CreateTagProtectionOption -> Maybe Text
createTagProtectionOptionNamePattern :: !(Maybe Text) -- ^ "name_pattern"
  , CreateTagProtectionOption -> Maybe [Text]
createTagProtectionOptionWhitelistTeams :: !(Maybe [Text]) -- ^ "whitelist_teams"
  , CreateTagProtectionOption -> Maybe [Text]
createTagProtectionOptionWhitelistUsernames :: !(Maybe [Text]) -- ^ "whitelist_usernames"
  } deriving (Int -> CreateTagProtectionOption -> ShowS
[CreateTagProtectionOption] -> ShowS
CreateTagProtectionOption -> [Char]
(Int -> CreateTagProtectionOption -> ShowS)
-> (CreateTagProtectionOption -> [Char])
-> ([CreateTagProtectionOption] -> ShowS)
-> Show CreateTagProtectionOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateTagProtectionOption -> ShowS
showsPrec :: Int -> CreateTagProtectionOption -> ShowS
$cshow :: CreateTagProtectionOption -> [Char]
show :: CreateTagProtectionOption -> [Char]
$cshowList :: [CreateTagProtectionOption] -> ShowS
showList :: [CreateTagProtectionOption] -> ShowS
P.Show, CreateTagProtectionOption -> CreateTagProtectionOption -> Bool
(CreateTagProtectionOption -> CreateTagProtectionOption -> Bool)
-> (CreateTagProtectionOption -> CreateTagProtectionOption -> Bool)
-> Eq CreateTagProtectionOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateTagProtectionOption -> CreateTagProtectionOption -> Bool
== :: CreateTagProtectionOption -> CreateTagProtectionOption -> Bool
$c/= :: CreateTagProtectionOption -> CreateTagProtectionOption -> Bool
/= :: CreateTagProtectionOption -> CreateTagProtectionOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreateTagProtectionOption
instance A.FromJSON CreateTagProtectionOption where
  parseJSON :: Value -> Parser CreateTagProtectionOption
parseJSON = [Char]
-> (Object -> Parser CreateTagProtectionOption)
-> Value
-> Parser CreateTagProtectionOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CreateTagProtectionOption" ((Object -> Parser CreateTagProtectionOption)
 -> Value -> Parser CreateTagProtectionOption)
-> (Object -> Parser CreateTagProtectionOption)
-> Value
-> Parser CreateTagProtectionOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe [Text] -> Maybe [Text] -> CreateTagProtectionOption
CreateTagProtectionOption
      (Maybe Text
 -> Maybe [Text] -> Maybe [Text] -> CreateTagProtectionOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text] -> Maybe [Text] -> CreateTagProtectionOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name_pattern")
      Parser (Maybe [Text] -> Maybe [Text] -> CreateTagProtectionOption)
-> Parser (Maybe [Text])
-> Parser (Maybe [Text] -> CreateTagProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"whitelist_teams")
      Parser (Maybe [Text] -> CreateTagProtectionOption)
-> Parser (Maybe [Text]) -> Parser CreateTagProtectionOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"whitelist_usernames")

-- | ToJSON CreateTagProtectionOption
instance A.ToJSON CreateTagProtectionOption where
  toJSON :: CreateTagProtectionOption -> Value
toJSON CreateTagProtectionOption {Maybe [Text]
Maybe Text
$sel:createTagProtectionOptionNamePattern:CreateTagProtectionOption :: CreateTagProtectionOption -> Maybe Text
$sel:createTagProtectionOptionWhitelistTeams:CreateTagProtectionOption :: CreateTagProtectionOption -> Maybe [Text]
$sel:createTagProtectionOptionWhitelistUsernames:CreateTagProtectionOption :: CreateTagProtectionOption -> Maybe [Text]
createTagProtectionOptionNamePattern :: Maybe Text
createTagProtectionOptionWhitelistTeams :: Maybe [Text]
createTagProtectionOptionWhitelistUsernames :: Maybe [Text]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"name_pattern" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createTagProtectionOptionNamePattern
      , Key
"whitelist_teams" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
createTagProtectionOptionWhitelistTeams
      , Key
"whitelist_usernames" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
createTagProtectionOptionWhitelistUsernames
      ]


-- | Construct a value of type 'CreateTagProtectionOption' (by applying it's required fields, if any)
mkCreateTagProtectionOption
  :: CreateTagProtectionOption
mkCreateTagProtectionOption :: CreateTagProtectionOption
mkCreateTagProtectionOption =
  CreateTagProtectionOption
  { $sel:createTagProtectionOptionNamePattern:CreateTagProtectionOption :: Maybe Text
createTagProtectionOptionNamePattern = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createTagProtectionOptionWhitelistTeams:CreateTagProtectionOption :: Maybe [Text]
createTagProtectionOptionWhitelistTeams = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:createTagProtectionOptionWhitelistUsernames:CreateTagProtectionOption :: Maybe [Text]
createTagProtectionOptionWhitelistUsernames = Maybe [Text]
forall a. Maybe a
Nothing
  }

-- ** CreateTeamOption
-- | CreateTeamOption
-- CreateTeamOption options for creating a team
data CreateTeamOption = CreateTeamOption
  { CreateTeamOption -> Maybe Bool
createTeamOptionCanCreateOrgRepo :: !(Maybe Bool) -- ^ "can_create_org_repo"
  , CreateTeamOption -> Maybe Text
createTeamOptionDescription :: !(Maybe Text) -- ^ "description"
  , CreateTeamOption -> Maybe Bool
createTeamOptionIncludesAllRepositories :: !(Maybe Bool) -- ^ "includes_all_repositories"
  , CreateTeamOption -> Text
createTeamOptionName :: !(Text) -- ^ /Required/ "name"
  , CreateTeamOption -> Maybe E'Permission
createTeamOptionPermission :: !(Maybe E'Permission) -- ^ "permission"
  , CreateTeamOption -> Maybe [Text]
createTeamOptionUnits :: !(Maybe [Text]) -- ^ "units"
  , CreateTeamOption -> Maybe (Map [Char] Text)
createTeamOptionUnitsMap :: !(Maybe (Map.Map String Text)) -- ^ "units_map"
  } deriving (Int -> CreateTeamOption -> ShowS
[CreateTeamOption] -> ShowS
CreateTeamOption -> [Char]
(Int -> CreateTeamOption -> ShowS)
-> (CreateTeamOption -> [Char])
-> ([CreateTeamOption] -> ShowS)
-> Show CreateTeamOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateTeamOption -> ShowS
showsPrec :: Int -> CreateTeamOption -> ShowS
$cshow :: CreateTeamOption -> [Char]
show :: CreateTeamOption -> [Char]
$cshowList :: [CreateTeamOption] -> ShowS
showList :: [CreateTeamOption] -> ShowS
P.Show, CreateTeamOption -> CreateTeamOption -> Bool
(CreateTeamOption -> CreateTeamOption -> Bool)
-> (CreateTeamOption -> CreateTeamOption -> Bool)
-> Eq CreateTeamOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateTeamOption -> CreateTeamOption -> Bool
== :: CreateTeamOption -> CreateTeamOption -> Bool
$c/= :: CreateTeamOption -> CreateTeamOption -> Bool
/= :: CreateTeamOption -> CreateTeamOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreateTeamOption
instance A.FromJSON CreateTeamOption where
  parseJSON :: Value -> Parser CreateTeamOption
parseJSON = [Char]
-> (Object -> Parser CreateTeamOption)
-> Value
-> Parser CreateTeamOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CreateTeamOption" ((Object -> Parser CreateTeamOption)
 -> Value -> Parser CreateTeamOption)
-> (Object -> Parser CreateTeamOption)
-> Value
-> Parser CreateTeamOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool
-> Maybe Text
-> Maybe Bool
-> Text
-> Maybe E'Permission
-> Maybe [Text]
-> Maybe (Map [Char] Text)
-> CreateTeamOption
CreateTeamOption
      (Maybe Bool
 -> Maybe Text
 -> Maybe Bool
 -> Text
 -> Maybe E'Permission
 -> Maybe [Text]
 -> Maybe (Map [Char] Text)
 -> CreateTeamOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Text
      -> Maybe E'Permission
      -> Maybe [Text]
      -> Maybe (Map [Char] Text)
      -> CreateTeamOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"can_create_org_repo")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Text
   -> Maybe E'Permission
   -> Maybe [Text]
   -> Maybe (Map [Char] Text)
   -> CreateTeamOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Text
      -> Maybe E'Permission
      -> Maybe [Text]
      -> Maybe (Map [Char] Text)
      -> CreateTeamOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe Bool
   -> Text
   -> Maybe E'Permission
   -> Maybe [Text]
   -> Maybe (Map [Char] Text)
   -> CreateTeamOption)
-> Parser (Maybe Bool)
-> Parser
     (Text
      -> Maybe E'Permission
      -> Maybe [Text]
      -> Maybe (Map [Char] Text)
      -> CreateTeamOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"includes_all_repositories")
      Parser
  (Text
   -> Maybe E'Permission
   -> Maybe [Text]
   -> Maybe (Map [Char] Text)
   -> CreateTeamOption)
-> Parser Text
-> Parser
     (Maybe E'Permission
      -> Maybe [Text] -> Maybe (Map [Char] Text) -> CreateTeamOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"name")
      Parser
  (Maybe E'Permission
   -> Maybe [Text] -> Maybe (Map [Char] Text) -> CreateTeamOption)
-> Parser (Maybe E'Permission)
-> Parser
     (Maybe [Text] -> Maybe (Map [Char] Text) -> CreateTeamOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe E'Permission)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"permission")
      Parser
  (Maybe [Text] -> Maybe (Map [Char] Text) -> CreateTeamOption)
-> Parser (Maybe [Text])
-> Parser (Maybe (Map [Char] Text) -> CreateTeamOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"units")
      Parser (Maybe (Map [Char] Text) -> CreateTeamOption)
-> Parser (Maybe (Map [Char] Text)) -> Parser CreateTeamOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe (Map [Char] Text))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"units_map")

-- | ToJSON CreateTeamOption
instance A.ToJSON CreateTeamOption where
  toJSON :: CreateTeamOption -> Value
toJSON CreateTeamOption {Maybe Bool
Maybe [Text]
Maybe (Map [Char] Text)
Maybe Text
Maybe E'Permission
Text
$sel:createTeamOptionCanCreateOrgRepo:CreateTeamOption :: CreateTeamOption -> Maybe Bool
$sel:createTeamOptionDescription:CreateTeamOption :: CreateTeamOption -> Maybe Text
$sel:createTeamOptionIncludesAllRepositories:CreateTeamOption :: CreateTeamOption -> Maybe Bool
$sel:createTeamOptionName:CreateTeamOption :: CreateTeamOption -> Text
$sel:createTeamOptionPermission:CreateTeamOption :: CreateTeamOption -> Maybe E'Permission
$sel:createTeamOptionUnits:CreateTeamOption :: CreateTeamOption -> Maybe [Text]
$sel:createTeamOptionUnitsMap:CreateTeamOption :: CreateTeamOption -> Maybe (Map [Char] Text)
createTeamOptionCanCreateOrgRepo :: Maybe Bool
createTeamOptionDescription :: Maybe Text
createTeamOptionIncludesAllRepositories :: Maybe Bool
createTeamOptionName :: Text
createTeamOptionPermission :: Maybe E'Permission
createTeamOptionUnits :: Maybe [Text]
createTeamOptionUnitsMap :: Maybe (Map [Char] Text)
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"can_create_org_repo" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createTeamOptionCanCreateOrgRepo
      , Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createTeamOptionDescription
      , Key
"includes_all_repositories" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createTeamOptionIncludesAllRepositories
      , Key
"name" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
createTeamOptionName
      , Key
"permission" Key -> Maybe E'Permission -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe E'Permission
createTeamOptionPermission
      , Key
"units" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
createTeamOptionUnits
      , Key
"units_map" Key -> Maybe (Map [Char] Text) -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe (Map [Char] Text)
createTeamOptionUnitsMap
      ]


-- | Construct a value of type 'CreateTeamOption' (by applying it's required fields, if any)
mkCreateTeamOption
  :: Text -- ^ 'createTeamOptionName' 
  -> CreateTeamOption
mkCreateTeamOption :: Text -> CreateTeamOption
mkCreateTeamOption Text
createTeamOptionName =
  CreateTeamOption
  { $sel:createTeamOptionCanCreateOrgRepo:CreateTeamOption :: Maybe Bool
createTeamOptionCanCreateOrgRepo = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createTeamOptionDescription:CreateTeamOption :: Maybe Text
createTeamOptionDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createTeamOptionIncludesAllRepositories:CreateTeamOption :: Maybe Bool
createTeamOptionIncludesAllRepositories = Maybe Bool
forall a. Maybe a
Nothing
  , Text
$sel:createTeamOptionName:CreateTeamOption :: Text
createTeamOptionName :: Text
createTeamOptionName
  , $sel:createTeamOptionPermission:CreateTeamOption :: Maybe E'Permission
createTeamOptionPermission = Maybe E'Permission
forall a. Maybe a
Nothing
  , $sel:createTeamOptionUnits:CreateTeamOption :: Maybe [Text]
createTeamOptionUnits = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:createTeamOptionUnitsMap:CreateTeamOption :: Maybe (Map [Char] Text)
createTeamOptionUnitsMap = Maybe (Map [Char] Text)
forall a. Maybe a
Nothing
  }

-- ** CreateUserOption
-- | CreateUserOption
-- CreateUserOption create user options
data CreateUserOption = CreateUserOption
  { CreateUserOption -> Maybe DateTime
createUserOptionCreatedAt :: !(Maybe DateTime) -- ^ "created_at" - For explicitly setting the user creation timestamp. Useful when users are migrated from other systems. When omitted, the user&#39;s creation timestamp will be set to \&quot;now\&quot;.
  , CreateUserOption -> Text
createUserOptionEmail :: !(Text) -- ^ /Required/ "email"
  , CreateUserOption -> Maybe Text
createUserOptionFullName :: !(Maybe Text) -- ^ "full_name"
  , CreateUserOption -> Maybe Text
createUserOptionLoginName :: !(Maybe Text) -- ^ "login_name"
  , CreateUserOption -> Maybe Bool
createUserOptionMustChangePassword :: !(Maybe Bool) -- ^ "must_change_password"
  , CreateUserOption -> Maybe Text
createUserOptionPassword :: !(Maybe Text) -- ^ "password"
  , CreateUserOption -> Maybe Bool
createUserOptionRestricted :: !(Maybe Bool) -- ^ "restricted"
  , CreateUserOption -> Maybe Bool
createUserOptionSendNotify :: !(Maybe Bool) -- ^ "send_notify"
  , CreateUserOption -> Maybe Integer
createUserOptionSourceId :: !(Maybe Integer) -- ^ "source_id"
  , CreateUserOption -> Text
createUserOptionUsername :: !(Text) -- ^ /Required/ "username"
  , CreateUserOption -> Maybe Text
createUserOptionVisibility :: !(Maybe Text) -- ^ "visibility"
  } deriving (Int -> CreateUserOption -> ShowS
[CreateUserOption] -> ShowS
CreateUserOption -> [Char]
(Int -> CreateUserOption -> ShowS)
-> (CreateUserOption -> [Char])
-> ([CreateUserOption] -> ShowS)
-> Show CreateUserOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateUserOption -> ShowS
showsPrec :: Int -> CreateUserOption -> ShowS
$cshow :: CreateUserOption -> [Char]
show :: CreateUserOption -> [Char]
$cshowList :: [CreateUserOption] -> ShowS
showList :: [CreateUserOption] -> ShowS
P.Show, CreateUserOption -> CreateUserOption -> Bool
(CreateUserOption -> CreateUserOption -> Bool)
-> (CreateUserOption -> CreateUserOption -> Bool)
-> Eq CreateUserOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateUserOption -> CreateUserOption -> Bool
== :: CreateUserOption -> CreateUserOption -> Bool
$c/= :: CreateUserOption -> CreateUserOption -> Bool
/= :: CreateUserOption -> CreateUserOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreateUserOption
instance A.FromJSON CreateUserOption where
  parseJSON :: Value -> Parser CreateUserOption
parseJSON = [Char]
-> (Object -> Parser CreateUserOption)
-> Value
-> Parser CreateUserOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CreateUserOption" ((Object -> Parser CreateUserOption)
 -> Value -> Parser CreateUserOption)
-> (Object -> Parser CreateUserOption)
-> Value
-> Parser CreateUserOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe DateTime
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Integer
-> Text
-> Maybe Text
-> CreateUserOption
CreateUserOption
      (Maybe DateTime
 -> Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Integer
 -> Text
 -> Maybe Text
 -> CreateUserOption)
-> Parser (Maybe DateTime)
-> Parser
     (Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Text
      -> Maybe Text
      -> CreateUserOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_at")
      Parser
  (Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Text
   -> Maybe Text
   -> CreateUserOption)
-> Parser Text
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Text
      -> Maybe Text
      -> CreateUserOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"email")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Text
   -> Maybe Text
   -> CreateUserOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Text
      -> Maybe Text
      -> CreateUserOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"full_name")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Text
   -> Maybe Text
   -> CreateUserOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Text
      -> Maybe Text
      -> CreateUserOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"login_name")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Text
   -> Maybe Text
   -> CreateUserOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Text
      -> Maybe Text
      -> CreateUserOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"must_change_password")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Text
   -> Maybe Text
   -> CreateUserOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Text
      -> Maybe Text
      -> CreateUserOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"password")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Text
   -> Maybe Text
   -> CreateUserOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Integer -> Text -> Maybe Text -> CreateUserOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"restricted")
      Parser
  (Maybe Bool
   -> Maybe Integer -> Text -> Maybe Text -> CreateUserOption)
-> Parser (Maybe Bool)
-> Parser (Maybe Integer -> Text -> Maybe Text -> CreateUserOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"send_notify")
      Parser (Maybe Integer -> Text -> Maybe Text -> CreateUserOption)
-> Parser (Maybe Integer)
-> Parser (Text -> Maybe Text -> CreateUserOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source_id")
      Parser (Text -> Maybe Text -> CreateUserOption)
-> Parser Text -> Parser (Maybe Text -> CreateUserOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"username")
      Parser (Maybe Text -> CreateUserOption)
-> Parser (Maybe Text) -> Parser CreateUserOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"visibility")

-- | ToJSON CreateUserOption
instance A.ToJSON CreateUserOption where
  toJSON :: CreateUserOption -> Value
toJSON CreateUserOption {Maybe Bool
Maybe Integer
Maybe Text
Maybe DateTime
Text
$sel:createUserOptionCreatedAt:CreateUserOption :: CreateUserOption -> Maybe DateTime
$sel:createUserOptionEmail:CreateUserOption :: CreateUserOption -> Text
$sel:createUserOptionFullName:CreateUserOption :: CreateUserOption -> Maybe Text
$sel:createUserOptionLoginName:CreateUserOption :: CreateUserOption -> Maybe Text
$sel:createUserOptionMustChangePassword:CreateUserOption :: CreateUserOption -> Maybe Bool
$sel:createUserOptionPassword:CreateUserOption :: CreateUserOption -> Maybe Text
$sel:createUserOptionRestricted:CreateUserOption :: CreateUserOption -> Maybe Bool
$sel:createUserOptionSendNotify:CreateUserOption :: CreateUserOption -> Maybe Bool
$sel:createUserOptionSourceId:CreateUserOption :: CreateUserOption -> Maybe Integer
$sel:createUserOptionUsername:CreateUserOption :: CreateUserOption -> Text
$sel:createUserOptionVisibility:CreateUserOption :: CreateUserOption -> Maybe Text
createUserOptionCreatedAt :: Maybe DateTime
createUserOptionEmail :: Text
createUserOptionFullName :: Maybe Text
createUserOptionLoginName :: Maybe Text
createUserOptionMustChangePassword :: Maybe Bool
createUserOptionPassword :: Maybe Text
createUserOptionRestricted :: Maybe Bool
createUserOptionSendNotify :: Maybe Bool
createUserOptionSourceId :: Maybe Integer
createUserOptionUsername :: Text
createUserOptionVisibility :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
createUserOptionCreatedAt
      , Key
"email" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
createUserOptionEmail
      , Key
"full_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createUserOptionFullName
      , Key
"login_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createUserOptionLoginName
      , Key
"must_change_password" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createUserOptionMustChangePassword
      , Key
"password" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createUserOptionPassword
      , Key
"restricted" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createUserOptionRestricted
      , Key
"send_notify" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
createUserOptionSendNotify
      , Key
"source_id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
createUserOptionSourceId
      , Key
"username" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
createUserOptionUsername
      , Key
"visibility" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createUserOptionVisibility
      ]


-- | Construct a value of type 'CreateUserOption' (by applying it's required fields, if any)
mkCreateUserOption
  :: Text -- ^ 'createUserOptionEmail' 
  -> Text -- ^ 'createUserOptionUsername' 
  -> CreateUserOption
mkCreateUserOption :: Text -> Text -> CreateUserOption
mkCreateUserOption Text
createUserOptionEmail Text
createUserOptionUsername =
  CreateUserOption
  { $sel:createUserOptionCreatedAt:CreateUserOption :: Maybe DateTime
createUserOptionCreatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , Text
$sel:createUserOptionEmail:CreateUserOption :: Text
createUserOptionEmail :: Text
createUserOptionEmail
  , $sel:createUserOptionFullName:CreateUserOption :: Maybe Text
createUserOptionFullName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createUserOptionLoginName:CreateUserOption :: Maybe Text
createUserOptionLoginName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createUserOptionMustChangePassword:CreateUserOption :: Maybe Bool
createUserOptionMustChangePassword = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createUserOptionPassword:CreateUserOption :: Maybe Text
createUserOptionPassword = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createUserOptionRestricted:CreateUserOption :: Maybe Bool
createUserOptionRestricted = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createUserOptionSendNotify:CreateUserOption :: Maybe Bool
createUserOptionSendNotify = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:createUserOptionSourceId:CreateUserOption :: Maybe Integer
createUserOptionSourceId = Maybe Integer
forall a. Maybe a
Nothing
  , Text
$sel:createUserOptionUsername:CreateUserOption :: Text
createUserOptionUsername :: Text
createUserOptionUsername
  , $sel:createUserOptionVisibility:CreateUserOption :: Maybe Text
createUserOptionVisibility = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** CreateVariableOption
-- | CreateVariableOption
-- CreateVariableOption the option when creating variable
data CreateVariableOption = CreateVariableOption
  { CreateVariableOption -> Text
createVariableOptionValue :: !(Text) -- ^ /Required/ "value" - Value of the variable to create
  } deriving (Int -> CreateVariableOption -> ShowS
[CreateVariableOption] -> ShowS
CreateVariableOption -> [Char]
(Int -> CreateVariableOption -> ShowS)
-> (CreateVariableOption -> [Char])
-> ([CreateVariableOption] -> ShowS)
-> Show CreateVariableOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateVariableOption -> ShowS
showsPrec :: Int -> CreateVariableOption -> ShowS
$cshow :: CreateVariableOption -> [Char]
show :: CreateVariableOption -> [Char]
$cshowList :: [CreateVariableOption] -> ShowS
showList :: [CreateVariableOption] -> ShowS
P.Show, CreateVariableOption -> CreateVariableOption -> Bool
(CreateVariableOption -> CreateVariableOption -> Bool)
-> (CreateVariableOption -> CreateVariableOption -> Bool)
-> Eq CreateVariableOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateVariableOption -> CreateVariableOption -> Bool
== :: CreateVariableOption -> CreateVariableOption -> Bool
$c/= :: CreateVariableOption -> CreateVariableOption -> Bool
/= :: CreateVariableOption -> CreateVariableOption -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON CreateVariableOption
instance A.ToJSON CreateVariableOption where
  toJSON :: CreateVariableOption -> Value
toJSON CreateVariableOption {Text
$sel:createVariableOptionValue:CreateVariableOption :: CreateVariableOption -> Text
createVariableOptionValue :: Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"value" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
createVariableOptionValue
      ]


-- | Construct a value of type 'CreateVariableOption' (by applying it's required fields, if any)
mkCreateVariableOption
  :: Text -- ^ 'createVariableOptionValue': Value of the variable to create
  -> CreateVariableOption
mkCreateVariableOption :: Text -> CreateVariableOption
mkCreateVariableOption Text
createVariableOptionValue =
  CreateVariableOption
  { Text
$sel:createVariableOptionValue:CreateVariableOption :: Text
createVariableOptionValue :: Text
createVariableOptionValue
  }

-- ** CreateWikiPageOptions
-- | CreateWikiPageOptions
-- CreateWikiPageOptions form for creating wiki
data CreateWikiPageOptions = CreateWikiPageOptions
  { CreateWikiPageOptions -> Maybe Text
createWikiPageOptionsContentBase64 :: !(Maybe Text) -- ^ "content_base64" - content must be base64 encoded
  , CreateWikiPageOptions -> Maybe Text
createWikiPageOptionsMessage :: !(Maybe Text) -- ^ "message" - optional commit message summarizing the change
  , CreateWikiPageOptions -> Maybe Text
createWikiPageOptionsTitle :: !(Maybe Text) -- ^ "title" - page title. leave empty to keep unchanged
  } deriving (Int -> CreateWikiPageOptions -> ShowS
[CreateWikiPageOptions] -> ShowS
CreateWikiPageOptions -> [Char]
(Int -> CreateWikiPageOptions -> ShowS)
-> (CreateWikiPageOptions -> [Char])
-> ([CreateWikiPageOptions] -> ShowS)
-> Show CreateWikiPageOptions
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CreateWikiPageOptions -> ShowS
showsPrec :: Int -> CreateWikiPageOptions -> ShowS
$cshow :: CreateWikiPageOptions -> [Char]
show :: CreateWikiPageOptions -> [Char]
$cshowList :: [CreateWikiPageOptions] -> ShowS
showList :: [CreateWikiPageOptions] -> ShowS
P.Show, CreateWikiPageOptions -> CreateWikiPageOptions -> Bool
(CreateWikiPageOptions -> CreateWikiPageOptions -> Bool)
-> (CreateWikiPageOptions -> CreateWikiPageOptions -> Bool)
-> Eq CreateWikiPageOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CreateWikiPageOptions -> CreateWikiPageOptions -> Bool
== :: CreateWikiPageOptions -> CreateWikiPageOptions -> Bool
$c/= :: CreateWikiPageOptions -> CreateWikiPageOptions -> Bool
/= :: CreateWikiPageOptions -> CreateWikiPageOptions -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreateWikiPageOptions
instance A.FromJSON CreateWikiPageOptions where
  parseJSON :: Value -> Parser CreateWikiPageOptions
parseJSON = [Char]
-> (Object -> Parser CreateWikiPageOptions)
-> Value
-> Parser CreateWikiPageOptions
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CreateWikiPageOptions" ((Object -> Parser CreateWikiPageOptions)
 -> Value -> Parser CreateWikiPageOptions)
-> (Object -> Parser CreateWikiPageOptions)
-> Value
-> Parser CreateWikiPageOptions
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Text -> Maybe Text -> CreateWikiPageOptions
CreateWikiPageOptions
      (Maybe Text -> Maybe Text -> Maybe Text -> CreateWikiPageOptions)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> CreateWikiPageOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"content_base64")
      Parser (Maybe Text -> Maybe Text -> CreateWikiPageOptions)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> CreateWikiPageOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"message")
      Parser (Maybe Text -> CreateWikiPageOptions)
-> Parser (Maybe Text) -> Parser CreateWikiPageOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title")

-- | ToJSON CreateWikiPageOptions
instance A.ToJSON CreateWikiPageOptions where
  toJSON :: CreateWikiPageOptions -> Value
toJSON CreateWikiPageOptions {Maybe Text
$sel:createWikiPageOptionsContentBase64:CreateWikiPageOptions :: CreateWikiPageOptions -> Maybe Text
$sel:createWikiPageOptionsMessage:CreateWikiPageOptions :: CreateWikiPageOptions -> Maybe Text
$sel:createWikiPageOptionsTitle:CreateWikiPageOptions :: CreateWikiPageOptions -> Maybe Text
createWikiPageOptionsContentBase64 :: Maybe Text
createWikiPageOptionsMessage :: Maybe Text
createWikiPageOptionsTitle :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"content_base64" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createWikiPageOptionsContentBase64
      , Key
"message" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createWikiPageOptionsMessage
      , Key
"title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
createWikiPageOptionsTitle
      ]


-- | Construct a value of type 'CreateWikiPageOptions' (by applying it's required fields, if any)
mkCreateWikiPageOptions
  :: CreateWikiPageOptions
mkCreateWikiPageOptions :: CreateWikiPageOptions
mkCreateWikiPageOptions =
  CreateWikiPageOptions
  { $sel:createWikiPageOptionsContentBase64:CreateWikiPageOptions :: Maybe Text
createWikiPageOptionsContentBase64 = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createWikiPageOptionsMessage:CreateWikiPageOptions :: Maybe Text
createWikiPageOptionsMessage = Maybe Text
forall a. Maybe a
Nothing
  , $sel:createWikiPageOptionsTitle:CreateWikiPageOptions :: Maybe Text
createWikiPageOptionsTitle = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** Cron
-- | Cron
-- Cron represents a Cron task
data Cron = Cron
  { Cron -> Maybe Integer
cronExecTimes :: !(Maybe Integer) -- ^ "exec_times"
  , Cron -> Maybe Text
cronName :: !(Maybe Text) -- ^ "name"
  , Cron -> Maybe DateTime
cronNext :: !(Maybe DateTime) -- ^ "next"
  , Cron -> Maybe DateTime
cronPrev :: !(Maybe DateTime) -- ^ "prev"
  , Cron -> Maybe Text
cronSchedule :: !(Maybe Text) -- ^ "schedule"
  } deriving (Int -> Cron -> ShowS
[Cron] -> ShowS
Cron -> [Char]
(Int -> Cron -> ShowS)
-> (Cron -> [Char]) -> ([Cron] -> ShowS) -> Show Cron
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Cron -> ShowS
showsPrec :: Int -> Cron -> ShowS
$cshow :: Cron -> [Char]
show :: Cron -> [Char]
$cshowList :: [Cron] -> ShowS
showList :: [Cron] -> ShowS
P.Show, Cron -> Cron -> Bool
(Cron -> Cron -> Bool) -> (Cron -> Cron -> Bool) -> Eq Cron
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Cron -> Cron -> Bool
== :: Cron -> Cron -> Bool
$c/= :: Cron -> Cron -> Bool
/= :: Cron -> Cron -> Bool
P.Eq, P.Typeable)

-- | FromJSON Cron
instance A.FromJSON Cron where
  parseJSON :: Value -> Parser Cron
parseJSON = [Char] -> (Object -> Parser Cron) -> Value -> Parser Cron
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Cron" ((Object -> Parser Cron) -> Value -> Parser Cron)
-> (Object -> Parser Cron) -> Value -> Parser Cron
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Integer
-> Maybe Text
-> Maybe DateTime
-> Maybe DateTime
-> Maybe Text
-> Cron
Cron
      (Maybe Integer
 -> Maybe Text
 -> Maybe DateTime
 -> Maybe DateTime
 -> Maybe Text
 -> Cron)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe DateTime -> Maybe DateTime -> Maybe Text -> Cron)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"exec_times")
      Parser
  (Maybe Text
   -> Maybe DateTime -> Maybe DateTime -> Maybe Text -> Cron)
-> Parser (Maybe Text)
-> Parser (Maybe DateTime -> Maybe DateTime -> Maybe Text -> Cron)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser (Maybe DateTime -> Maybe DateTime -> Maybe Text -> Cron)
-> Parser (Maybe DateTime)
-> Parser (Maybe DateTime -> Maybe Text -> Cron)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"next")
      Parser (Maybe DateTime -> Maybe Text -> Cron)
-> Parser (Maybe DateTime) -> Parser (Maybe Text -> Cron)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prev")
      Parser (Maybe Text -> Cron) -> Parser (Maybe Text) -> Parser Cron
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"schedule")

-- | ToJSON Cron
instance A.ToJSON Cron where
  toJSON :: Cron -> Value
toJSON Cron {Maybe Integer
Maybe Text
Maybe DateTime
$sel:cronExecTimes:Cron :: Cron -> Maybe Integer
$sel:cronName:Cron :: Cron -> Maybe Text
$sel:cronNext:Cron :: Cron -> Maybe DateTime
$sel:cronPrev:Cron :: Cron -> Maybe DateTime
$sel:cronSchedule:Cron :: Cron -> Maybe Text
cronExecTimes :: Maybe Integer
cronName :: Maybe Text
cronNext :: Maybe DateTime
cronPrev :: Maybe DateTime
cronSchedule :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"exec_times" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
cronExecTimes
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
cronName
      , Key
"next" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
cronNext
      , Key
"prev" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
cronPrev
      , Key
"schedule" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
cronSchedule
      ]


-- | Construct a value of type 'Cron' (by applying it's required fields, if any)
mkCron
  :: Cron
mkCron :: Cron
mkCron =
  Cron
  { $sel:cronExecTimes:Cron :: Maybe Integer
cronExecTimes = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:cronName:Cron :: Maybe Text
cronName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:cronNext:Cron :: Maybe DateTime
cronNext = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:cronPrev:Cron :: Maybe DateTime
cronPrev = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:cronSchedule:Cron :: Maybe Text
cronSchedule = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** DeleteEmailOption
-- | DeleteEmailOption
-- DeleteEmailOption options when deleting email addresses
data DeleteEmailOption = DeleteEmailOption
  { DeleteEmailOption -> Maybe [Text]
deleteEmailOptionEmails :: !(Maybe [Text]) -- ^ "emails" - email addresses to delete
  } deriving (Int -> DeleteEmailOption -> ShowS
[DeleteEmailOption] -> ShowS
DeleteEmailOption -> [Char]
(Int -> DeleteEmailOption -> ShowS)
-> (DeleteEmailOption -> [Char])
-> ([DeleteEmailOption] -> ShowS)
-> Show DeleteEmailOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeleteEmailOption -> ShowS
showsPrec :: Int -> DeleteEmailOption -> ShowS
$cshow :: DeleteEmailOption -> [Char]
show :: DeleteEmailOption -> [Char]
$cshowList :: [DeleteEmailOption] -> ShowS
showList :: [DeleteEmailOption] -> ShowS
P.Show, DeleteEmailOption -> DeleteEmailOption -> Bool
(DeleteEmailOption -> DeleteEmailOption -> Bool)
-> (DeleteEmailOption -> DeleteEmailOption -> Bool)
-> Eq DeleteEmailOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeleteEmailOption -> DeleteEmailOption -> Bool
== :: DeleteEmailOption -> DeleteEmailOption -> Bool
$c/= :: DeleteEmailOption -> DeleteEmailOption -> Bool
/= :: DeleteEmailOption -> DeleteEmailOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON DeleteEmailOption
instance A.FromJSON DeleteEmailOption where
  parseJSON :: Value -> Parser DeleteEmailOption
parseJSON = [Char]
-> (Object -> Parser DeleteEmailOption)
-> Value
-> Parser DeleteEmailOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"DeleteEmailOption" ((Object -> Parser DeleteEmailOption)
 -> Value -> Parser DeleteEmailOption)
-> (Object -> Parser DeleteEmailOption)
-> Value
-> Parser DeleteEmailOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Text] -> DeleteEmailOption
DeleteEmailOption
      (Maybe [Text] -> DeleteEmailOption)
-> Parser (Maybe [Text]) -> Parser DeleteEmailOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"emails")

-- | ToJSON DeleteEmailOption
instance A.ToJSON DeleteEmailOption where
  toJSON :: DeleteEmailOption -> Value
toJSON DeleteEmailOption {Maybe [Text]
$sel:deleteEmailOptionEmails:DeleteEmailOption :: DeleteEmailOption -> Maybe [Text]
deleteEmailOptionEmails :: Maybe [Text]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"emails" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
deleteEmailOptionEmails
      ]


-- | Construct a value of type 'DeleteEmailOption' (by applying it's required fields, if any)
mkDeleteEmailOption
  :: DeleteEmailOption
mkDeleteEmailOption :: DeleteEmailOption
mkDeleteEmailOption =
  DeleteEmailOption
  { $sel:deleteEmailOptionEmails:DeleteEmailOption :: Maybe [Text]
deleteEmailOptionEmails = Maybe [Text]
forall a. Maybe a
Nothing
  }

-- ** DeleteFileOptions
-- | DeleteFileOptions
-- DeleteFileOptions options for deleting files (used for other File structs below) Note: `author` and `committer` are optional (if only one is given, it will be used for the other, otherwise the authenticated user will be used)
data DeleteFileOptions = DeleteFileOptions
  { DeleteFileOptions -> Maybe Identity
deleteFileOptionsAuthor :: !(Maybe Identity) -- ^ "author"
  , DeleteFileOptions -> Maybe Text
deleteFileOptionsBranch :: !(Maybe Text) -- ^ "branch" - branch (optional) to base this file from. if not given, the default branch is used
  , DeleteFileOptions -> Maybe Identity
deleteFileOptionsCommitter :: !(Maybe Identity) -- ^ "committer"
  , DeleteFileOptions -> Maybe CommitDateOptions
deleteFileOptionsDates :: !(Maybe CommitDateOptions) -- ^ "dates"
  , DeleteFileOptions -> Maybe Text
deleteFileOptionsMessage :: !(Maybe Text) -- ^ "message" - message (optional) for the commit of this file. if not supplied, a default message will be used
  , DeleteFileOptions -> Maybe Text
deleteFileOptionsNewBranch :: !(Maybe Text) -- ^ "new_branch" - new_branch (optional) will make a new branch from &#x60;branch&#x60; before creating the file
  , DeleteFileOptions -> Text
deleteFileOptionsSha :: !(Text) -- ^ /Required/ "sha" - sha is the SHA for the file that already exists
  , DeleteFileOptions -> Maybe Bool
deleteFileOptionsSignoff :: !(Maybe Bool) -- ^ "signoff" - Add a Signed-off-by trailer by the committer at the end of the commit log message.
  } deriving (Int -> DeleteFileOptions -> ShowS
[DeleteFileOptions] -> ShowS
DeleteFileOptions -> [Char]
(Int -> DeleteFileOptions -> ShowS)
-> (DeleteFileOptions -> [Char])
-> ([DeleteFileOptions] -> ShowS)
-> Show DeleteFileOptions
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeleteFileOptions -> ShowS
showsPrec :: Int -> DeleteFileOptions -> ShowS
$cshow :: DeleteFileOptions -> [Char]
show :: DeleteFileOptions -> [Char]
$cshowList :: [DeleteFileOptions] -> ShowS
showList :: [DeleteFileOptions] -> ShowS
P.Show, DeleteFileOptions -> DeleteFileOptions -> Bool
(DeleteFileOptions -> DeleteFileOptions -> Bool)
-> (DeleteFileOptions -> DeleteFileOptions -> Bool)
-> Eq DeleteFileOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeleteFileOptions -> DeleteFileOptions -> Bool
== :: DeleteFileOptions -> DeleteFileOptions -> Bool
$c/= :: DeleteFileOptions -> DeleteFileOptions -> Bool
/= :: DeleteFileOptions -> DeleteFileOptions -> Bool
P.Eq, P.Typeable)

-- | FromJSON DeleteFileOptions
instance A.FromJSON DeleteFileOptions where
  parseJSON :: Value -> Parser DeleteFileOptions
parseJSON = [Char]
-> (Object -> Parser DeleteFileOptions)
-> Value
-> Parser DeleteFileOptions
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"DeleteFileOptions" ((Object -> Parser DeleteFileOptions)
 -> Value -> Parser DeleteFileOptions)
-> (Object -> Parser DeleteFileOptions)
-> Value
-> Parser DeleteFileOptions
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Identity
-> Maybe Text
-> Maybe Identity
-> Maybe CommitDateOptions
-> Maybe Text
-> Maybe Text
-> Text
-> Maybe Bool
-> DeleteFileOptions
DeleteFileOptions
      (Maybe Identity
 -> Maybe Text
 -> Maybe Identity
 -> Maybe CommitDateOptions
 -> Maybe Text
 -> Maybe Text
 -> Text
 -> Maybe Bool
 -> DeleteFileOptions)
-> Parser (Maybe Identity)
-> Parser
     (Maybe Text
      -> Maybe Identity
      -> Maybe CommitDateOptions
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Bool
      -> DeleteFileOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Identity)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"author")
      Parser
  (Maybe Text
   -> Maybe Identity
   -> Maybe CommitDateOptions
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Bool
   -> DeleteFileOptions)
-> Parser (Maybe Text)
-> Parser
     (Maybe Identity
      -> Maybe CommitDateOptions
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Bool
      -> DeleteFileOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"branch")
      Parser
  (Maybe Identity
   -> Maybe CommitDateOptions
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Bool
   -> DeleteFileOptions)
-> Parser (Maybe Identity)
-> Parser
     (Maybe CommitDateOptions
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Bool
      -> DeleteFileOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Identity)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"committer")
      Parser
  (Maybe CommitDateOptions
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Bool
   -> DeleteFileOptions)
-> Parser (Maybe CommitDateOptions)
-> Parser
     (Maybe Text
      -> Maybe Text -> Text -> Maybe Bool -> DeleteFileOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe CommitDateOptions)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"dates")
      Parser
  (Maybe Text
   -> Maybe Text -> Text -> Maybe Bool -> DeleteFileOptions)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Text -> Maybe Bool -> DeleteFileOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"message")
      Parser (Maybe Text -> Text -> Maybe Bool -> DeleteFileOptions)
-> Parser (Maybe Text)
-> Parser (Text -> Maybe Bool -> DeleteFileOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"new_branch")
      Parser (Text -> Maybe Bool -> DeleteFileOptions)
-> Parser Text -> Parser (Maybe Bool -> DeleteFileOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"sha")
      Parser (Maybe Bool -> DeleteFileOptions)
-> Parser (Maybe Bool) -> Parser DeleteFileOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"signoff")

-- | ToJSON DeleteFileOptions
instance A.ToJSON DeleteFileOptions where
  toJSON :: DeleteFileOptions -> Value
toJSON DeleteFileOptions {Maybe Bool
Maybe Text
Maybe Identity
Maybe CommitDateOptions
Text
$sel:deleteFileOptionsAuthor:DeleteFileOptions :: DeleteFileOptions -> Maybe Identity
$sel:deleteFileOptionsBranch:DeleteFileOptions :: DeleteFileOptions -> Maybe Text
$sel:deleteFileOptionsCommitter:DeleteFileOptions :: DeleteFileOptions -> Maybe Identity
$sel:deleteFileOptionsDates:DeleteFileOptions :: DeleteFileOptions -> Maybe CommitDateOptions
$sel:deleteFileOptionsMessage:DeleteFileOptions :: DeleteFileOptions -> Maybe Text
$sel:deleteFileOptionsNewBranch:DeleteFileOptions :: DeleteFileOptions -> Maybe Text
$sel:deleteFileOptionsSha:DeleteFileOptions :: DeleteFileOptions -> Text
$sel:deleteFileOptionsSignoff:DeleteFileOptions :: DeleteFileOptions -> Maybe Bool
deleteFileOptionsAuthor :: Maybe Identity
deleteFileOptionsBranch :: Maybe Text
deleteFileOptionsCommitter :: Maybe Identity
deleteFileOptionsDates :: Maybe CommitDateOptions
deleteFileOptionsMessage :: Maybe Text
deleteFileOptionsNewBranch :: Maybe Text
deleteFileOptionsSha :: Text
deleteFileOptionsSignoff :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"author" Key -> Maybe Identity -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Identity
deleteFileOptionsAuthor
      , Key
"branch" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
deleteFileOptionsBranch
      , Key
"committer" Key -> Maybe Identity -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Identity
deleteFileOptionsCommitter
      , Key
"dates" Key -> Maybe CommitDateOptions -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe CommitDateOptions
deleteFileOptionsDates
      , Key
"message" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
deleteFileOptionsMessage
      , Key
"new_branch" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
deleteFileOptionsNewBranch
      , Key
"sha" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
deleteFileOptionsSha
      , Key
"signoff" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
deleteFileOptionsSignoff
      ]


-- | Construct a value of type 'DeleteFileOptions' (by applying it's required fields, if any)
mkDeleteFileOptions
  :: Text -- ^ 'deleteFileOptionsSha': sha is the SHA for the file that already exists
  -> DeleteFileOptions
mkDeleteFileOptions :: Text -> DeleteFileOptions
mkDeleteFileOptions Text
deleteFileOptionsSha =
  DeleteFileOptions
  { $sel:deleteFileOptionsAuthor:DeleteFileOptions :: Maybe Identity
deleteFileOptionsAuthor = Maybe Identity
forall a. Maybe a
Nothing
  , $sel:deleteFileOptionsBranch:DeleteFileOptions :: Maybe Text
deleteFileOptionsBranch = Maybe Text
forall a. Maybe a
Nothing
  , $sel:deleteFileOptionsCommitter:DeleteFileOptions :: Maybe Identity
deleteFileOptionsCommitter = Maybe Identity
forall a. Maybe a
Nothing
  , $sel:deleteFileOptionsDates:DeleteFileOptions :: Maybe CommitDateOptions
deleteFileOptionsDates = Maybe CommitDateOptions
forall a. Maybe a
Nothing
  , $sel:deleteFileOptionsMessage:DeleteFileOptions :: Maybe Text
deleteFileOptionsMessage = Maybe Text
forall a. Maybe a
Nothing
  , $sel:deleteFileOptionsNewBranch:DeleteFileOptions :: Maybe Text
deleteFileOptionsNewBranch = Maybe Text
forall a. Maybe a
Nothing
  , Text
$sel:deleteFileOptionsSha:DeleteFileOptions :: Text
deleteFileOptionsSha :: Text
deleteFileOptionsSha
  , $sel:deleteFileOptionsSignoff:DeleteFileOptions :: Maybe Bool
deleteFileOptionsSignoff = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** DeployKey
-- | DeployKey
-- DeployKey a deploy key
data DeployKey = DeployKey
  { DeployKey -> Maybe DateTime
deployKeyCreatedAt :: !(Maybe DateTime) -- ^ "created_at"
  , DeployKey -> Maybe Text
deployKeyFingerprint :: !(Maybe Text) -- ^ "fingerprint"
  , DeployKey -> Maybe Integer
deployKeyId :: !(Maybe Integer) -- ^ "id"
  , DeployKey -> Maybe Text
deployKeyKey :: !(Maybe Text) -- ^ "key"
  , DeployKey -> Maybe Integer
deployKeyKeyId :: !(Maybe Integer) -- ^ "key_id"
  , DeployKey -> Maybe Bool
deployKeyReadOnly :: !(Maybe Bool) -- ^ "read_only"
  , DeployKey -> Maybe Repository
deployKeyRepository :: !(Maybe Repository) -- ^ "repository"
  , DeployKey -> Maybe Text
deployKeyTitle :: !(Maybe Text) -- ^ "title"
  , DeployKey -> Maybe Text
deployKeyUrl :: !(Maybe Text) -- ^ "url"
  } deriving (Int -> DeployKey -> ShowS
[DeployKey] -> ShowS
DeployKey -> [Char]
(Int -> DeployKey -> ShowS)
-> (DeployKey -> [Char])
-> ([DeployKey] -> ShowS)
-> Show DeployKey
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeployKey -> ShowS
showsPrec :: Int -> DeployKey -> ShowS
$cshow :: DeployKey -> [Char]
show :: DeployKey -> [Char]
$cshowList :: [DeployKey] -> ShowS
showList :: [DeployKey] -> ShowS
P.Show, DeployKey -> DeployKey -> Bool
(DeployKey -> DeployKey -> Bool)
-> (DeployKey -> DeployKey -> Bool) -> Eq DeployKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeployKey -> DeployKey -> Bool
== :: DeployKey -> DeployKey -> Bool
$c/= :: DeployKey -> DeployKey -> Bool
/= :: DeployKey -> DeployKey -> Bool
P.Eq, P.Typeable)

-- | FromJSON DeployKey
instance A.FromJSON DeployKey where
  parseJSON :: Value -> Parser DeployKey
parseJSON = [Char] -> (Object -> Parser DeployKey) -> Value -> Parser DeployKey
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"DeployKey" ((Object -> Parser DeployKey) -> Value -> Parser DeployKey)
-> (Object -> Parser DeployKey) -> Value -> Parser DeployKey
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe DateTime
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe Integer
-> Maybe Bool
-> Maybe Repository
-> Maybe Text
-> Maybe Text
-> DeployKey
DeployKey
      (Maybe DateTime
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Bool
 -> Maybe Repository
 -> Maybe Text
 -> Maybe Text
 -> DeployKey)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Repository
      -> Maybe Text
      -> Maybe Text
      -> DeployKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_at")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Repository
   -> Maybe Text
   -> Maybe Text
   -> DeployKey)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Repository
      -> Maybe Text
      -> Maybe Text
      -> DeployKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"fingerprint")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Repository
   -> Maybe Text
   -> Maybe Text
   -> DeployKey)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Repository
      -> Maybe Text
      -> Maybe Text
      -> DeployKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Repository
   -> Maybe Text
   -> Maybe Text
   -> DeployKey)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Bool
      -> Maybe Repository
      -> Maybe Text
      -> Maybe Text
      -> DeployKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"key")
      Parser
  (Maybe Integer
   -> Maybe Bool
   -> Maybe Repository
   -> Maybe Text
   -> Maybe Text
   -> DeployKey)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Bool
      -> Maybe Repository -> Maybe Text -> Maybe Text -> DeployKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"key_id")
      Parser
  (Maybe Bool
   -> Maybe Repository -> Maybe Text -> Maybe Text -> DeployKey)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Repository -> Maybe Text -> Maybe Text -> DeployKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"read_only")
      Parser (Maybe Repository -> Maybe Text -> Maybe Text -> DeployKey)
-> Parser (Maybe Repository)
-> Parser (Maybe Text -> Maybe Text -> DeployKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Repository)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"repository")
      Parser (Maybe Text -> Maybe Text -> DeployKey)
-> Parser (Maybe Text) -> Parser (Maybe Text -> DeployKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title")
      Parser (Maybe Text -> DeployKey)
-> Parser (Maybe Text) -> Parser DeployKey
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")

-- | ToJSON DeployKey
instance A.ToJSON DeployKey where
  toJSON :: DeployKey -> Value
toJSON DeployKey {Maybe Bool
Maybe Integer
Maybe Text
Maybe DateTime
Maybe Repository
$sel:deployKeyCreatedAt:DeployKey :: DeployKey -> Maybe DateTime
$sel:deployKeyFingerprint:DeployKey :: DeployKey -> Maybe Text
$sel:deployKeyId:DeployKey :: DeployKey -> Maybe Integer
$sel:deployKeyKey:DeployKey :: DeployKey -> Maybe Text
$sel:deployKeyKeyId:DeployKey :: DeployKey -> Maybe Integer
$sel:deployKeyReadOnly:DeployKey :: DeployKey -> Maybe Bool
$sel:deployKeyRepository:DeployKey :: DeployKey -> Maybe Repository
$sel:deployKeyTitle:DeployKey :: DeployKey -> Maybe Text
$sel:deployKeyUrl:DeployKey :: DeployKey -> Maybe Text
deployKeyCreatedAt :: Maybe DateTime
deployKeyFingerprint :: Maybe Text
deployKeyId :: Maybe Integer
deployKeyKey :: Maybe Text
deployKeyKeyId :: Maybe Integer
deployKeyReadOnly :: Maybe Bool
deployKeyRepository :: Maybe Repository
deployKeyTitle :: Maybe Text
deployKeyUrl :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
deployKeyCreatedAt
      , Key
"fingerprint" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
deployKeyFingerprint
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
deployKeyId
      , Key
"key" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
deployKeyKey
      , Key
"key_id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
deployKeyKeyId
      , Key
"read_only" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
deployKeyReadOnly
      , Key
"repository" Key -> Maybe Repository -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Repository
deployKeyRepository
      , Key
"title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
deployKeyTitle
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
deployKeyUrl
      ]


-- | Construct a value of type 'DeployKey' (by applying it's required fields, if any)
mkDeployKey
  :: DeployKey
mkDeployKey :: DeployKey
mkDeployKey =
  DeployKey
  { $sel:deployKeyCreatedAt:DeployKey :: Maybe DateTime
deployKeyCreatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:deployKeyFingerprint:DeployKey :: Maybe Text
deployKeyFingerprint = Maybe Text
forall a. Maybe a
Nothing
  , $sel:deployKeyId:DeployKey :: Maybe Integer
deployKeyId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:deployKeyKey:DeployKey :: Maybe Text
deployKeyKey = Maybe Text
forall a. Maybe a
Nothing
  , $sel:deployKeyKeyId:DeployKey :: Maybe Integer
deployKeyKeyId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:deployKeyReadOnly:DeployKey :: Maybe Bool
deployKeyReadOnly = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:deployKeyRepository:DeployKey :: Maybe Repository
deployKeyRepository = Maybe Repository
forall a. Maybe a
Nothing
  , $sel:deployKeyTitle:DeployKey :: Maybe Text
deployKeyTitle = Maybe Text
forall a. Maybe a
Nothing
  , $sel:deployKeyUrl:DeployKey :: Maybe Text
deployKeyUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** DismissPullReviewOptions
-- | DismissPullReviewOptions
-- DismissPullReviewOptions are options to dismiss a pull review
data DismissPullReviewOptions = DismissPullReviewOptions
  { DismissPullReviewOptions -> Maybe Text
dismissPullReviewOptionsMessage :: !(Maybe Text) -- ^ "message"
  , DismissPullReviewOptions -> Maybe Bool
dismissPullReviewOptionsPriors :: !(Maybe Bool) -- ^ "priors"
  } deriving (Int -> DismissPullReviewOptions -> ShowS
[DismissPullReviewOptions] -> ShowS
DismissPullReviewOptions -> [Char]
(Int -> DismissPullReviewOptions -> ShowS)
-> (DismissPullReviewOptions -> [Char])
-> ([DismissPullReviewOptions] -> ShowS)
-> Show DismissPullReviewOptions
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DismissPullReviewOptions -> ShowS
showsPrec :: Int -> DismissPullReviewOptions -> ShowS
$cshow :: DismissPullReviewOptions -> [Char]
show :: DismissPullReviewOptions -> [Char]
$cshowList :: [DismissPullReviewOptions] -> ShowS
showList :: [DismissPullReviewOptions] -> ShowS
P.Show, DismissPullReviewOptions -> DismissPullReviewOptions -> Bool
(DismissPullReviewOptions -> DismissPullReviewOptions -> Bool)
-> (DismissPullReviewOptions -> DismissPullReviewOptions -> Bool)
-> Eq DismissPullReviewOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DismissPullReviewOptions -> DismissPullReviewOptions -> Bool
== :: DismissPullReviewOptions -> DismissPullReviewOptions -> Bool
$c/= :: DismissPullReviewOptions -> DismissPullReviewOptions -> Bool
/= :: DismissPullReviewOptions -> DismissPullReviewOptions -> Bool
P.Eq, P.Typeable)

-- | FromJSON DismissPullReviewOptions
instance A.FromJSON DismissPullReviewOptions where
  parseJSON :: Value -> Parser DismissPullReviewOptions
parseJSON = [Char]
-> (Object -> Parser DismissPullReviewOptions)
-> Value
-> Parser DismissPullReviewOptions
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"DismissPullReviewOptions" ((Object -> Parser DismissPullReviewOptions)
 -> Value -> Parser DismissPullReviewOptions)
-> (Object -> Parser DismissPullReviewOptions)
-> Value
-> Parser DismissPullReviewOptions
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Bool -> DismissPullReviewOptions
DismissPullReviewOptions
      (Maybe Text -> Maybe Bool -> DismissPullReviewOptions)
-> Parser (Maybe Text)
-> Parser (Maybe Bool -> DismissPullReviewOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"message")
      Parser (Maybe Bool -> DismissPullReviewOptions)
-> Parser (Maybe Bool) -> Parser DismissPullReviewOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"priors")

-- | ToJSON DismissPullReviewOptions
instance A.ToJSON DismissPullReviewOptions where
  toJSON :: DismissPullReviewOptions -> Value
toJSON DismissPullReviewOptions {Maybe Bool
Maybe Text
$sel:dismissPullReviewOptionsMessage:DismissPullReviewOptions :: DismissPullReviewOptions -> Maybe Text
$sel:dismissPullReviewOptionsPriors:DismissPullReviewOptions :: DismissPullReviewOptions -> Maybe Bool
dismissPullReviewOptionsMessage :: Maybe Text
dismissPullReviewOptionsPriors :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"message" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
dismissPullReviewOptionsMessage
      , Key
"priors" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
dismissPullReviewOptionsPriors
      ]


-- | Construct a value of type 'DismissPullReviewOptions' (by applying it's required fields, if any)
mkDismissPullReviewOptions
  :: DismissPullReviewOptions
mkDismissPullReviewOptions :: DismissPullReviewOptions
mkDismissPullReviewOptions =
  DismissPullReviewOptions
  { $sel:dismissPullReviewOptionsMessage:DismissPullReviewOptions :: Maybe Text
dismissPullReviewOptionsMessage = Maybe Text
forall a. Maybe a
Nothing
  , $sel:dismissPullReviewOptionsPriors:DismissPullReviewOptions :: Maybe Bool
dismissPullReviewOptionsPriors = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** EditAttachmentOptions
-- | EditAttachmentOptions
-- EditAttachmentOptions options for editing attachments
data EditAttachmentOptions = EditAttachmentOptions
  { EditAttachmentOptions -> Maybe Text
editAttachmentOptionsName :: !(Maybe Text) -- ^ "name"
  } deriving (Int -> EditAttachmentOptions -> ShowS
[EditAttachmentOptions] -> ShowS
EditAttachmentOptions -> [Char]
(Int -> EditAttachmentOptions -> ShowS)
-> (EditAttachmentOptions -> [Char])
-> ([EditAttachmentOptions] -> ShowS)
-> Show EditAttachmentOptions
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EditAttachmentOptions -> ShowS
showsPrec :: Int -> EditAttachmentOptions -> ShowS
$cshow :: EditAttachmentOptions -> [Char]
show :: EditAttachmentOptions -> [Char]
$cshowList :: [EditAttachmentOptions] -> ShowS
showList :: [EditAttachmentOptions] -> ShowS
P.Show, EditAttachmentOptions -> EditAttachmentOptions -> Bool
(EditAttachmentOptions -> EditAttachmentOptions -> Bool)
-> (EditAttachmentOptions -> EditAttachmentOptions -> Bool)
-> Eq EditAttachmentOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EditAttachmentOptions -> EditAttachmentOptions -> Bool
== :: EditAttachmentOptions -> EditAttachmentOptions -> Bool
$c/= :: EditAttachmentOptions -> EditAttachmentOptions -> Bool
/= :: EditAttachmentOptions -> EditAttachmentOptions -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON EditAttachmentOptions
instance A.ToJSON EditAttachmentOptions where
  toJSON :: EditAttachmentOptions -> Value
toJSON EditAttachmentOptions {Maybe Text
$sel:editAttachmentOptionsName:EditAttachmentOptions :: EditAttachmentOptions -> Maybe Text
editAttachmentOptionsName :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editAttachmentOptionsName
      ]


-- | Construct a value of type 'EditAttachmentOptions' (by applying it's required fields, if any)
mkEditAttachmentOptions
  :: EditAttachmentOptions
mkEditAttachmentOptions :: EditAttachmentOptions
mkEditAttachmentOptions =
  EditAttachmentOptions
  { $sel:editAttachmentOptionsName:EditAttachmentOptions :: Maybe Text
editAttachmentOptionsName = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** EditBranchProtectionOption
-- | EditBranchProtectionOption
-- EditBranchProtectionOption options for editing a branch protection
data EditBranchProtectionOption = EditBranchProtectionOption
  { EditBranchProtectionOption -> Maybe [Text]
editBranchProtectionOptionApprovalsWhitelistTeams :: !(Maybe [Text]) -- ^ "approvals_whitelist_teams"
  , EditBranchProtectionOption -> Maybe [Text]
editBranchProtectionOptionApprovalsWhitelistUsername :: !(Maybe [Text]) -- ^ "approvals_whitelist_username"
  , EditBranchProtectionOption -> Maybe Bool
editBranchProtectionOptionBlockAdminMergeOverride :: !(Maybe Bool) -- ^ "block_admin_merge_override"
  , EditBranchProtectionOption -> Maybe Bool
editBranchProtectionOptionBlockOnOfficialReviewRequests :: !(Maybe Bool) -- ^ "block_on_official_review_requests"
  , EditBranchProtectionOption -> Maybe Bool
editBranchProtectionOptionBlockOnOutdatedBranch :: !(Maybe Bool) -- ^ "block_on_outdated_branch"
  , EditBranchProtectionOption -> Maybe Bool
editBranchProtectionOptionBlockOnRejectedReviews :: !(Maybe Bool) -- ^ "block_on_rejected_reviews"
  , EditBranchProtectionOption -> Maybe Bool
editBranchProtectionOptionDismissStaleApprovals :: !(Maybe Bool) -- ^ "dismiss_stale_approvals"
  , EditBranchProtectionOption -> Maybe Bool
editBranchProtectionOptionEnableApprovalsWhitelist :: !(Maybe Bool) -- ^ "enable_approvals_whitelist"
  , EditBranchProtectionOption -> Maybe Bool
editBranchProtectionOptionEnableForcePush :: !(Maybe Bool) -- ^ "enable_force_push"
  , EditBranchProtectionOption -> Maybe Bool
editBranchProtectionOptionEnableForcePushAllowlist :: !(Maybe Bool) -- ^ "enable_force_push_allowlist"
  , EditBranchProtectionOption -> Maybe Bool
editBranchProtectionOptionEnableMergeWhitelist :: !(Maybe Bool) -- ^ "enable_merge_whitelist"
  , EditBranchProtectionOption -> Maybe Bool
editBranchProtectionOptionEnablePush :: !(Maybe Bool) -- ^ "enable_push"
  , EditBranchProtectionOption -> Maybe Bool
editBranchProtectionOptionEnablePushWhitelist :: !(Maybe Bool) -- ^ "enable_push_whitelist"
  , EditBranchProtectionOption -> Maybe Bool
editBranchProtectionOptionEnableStatusCheck :: !(Maybe Bool) -- ^ "enable_status_check"
  , EditBranchProtectionOption -> Maybe Bool
editBranchProtectionOptionForcePushAllowlistDeployKeys :: !(Maybe Bool) -- ^ "force_push_allowlist_deploy_keys"
  , EditBranchProtectionOption -> Maybe [Text]
editBranchProtectionOptionForcePushAllowlistTeams :: !(Maybe [Text]) -- ^ "force_push_allowlist_teams"
  , EditBranchProtectionOption -> Maybe [Text]
editBranchProtectionOptionForcePushAllowlistUsernames :: !(Maybe [Text]) -- ^ "force_push_allowlist_usernames"
  , EditBranchProtectionOption -> Maybe Bool
editBranchProtectionOptionIgnoreStaleApprovals :: !(Maybe Bool) -- ^ "ignore_stale_approvals"
  , EditBranchProtectionOption -> Maybe [Text]
editBranchProtectionOptionMergeWhitelistTeams :: !(Maybe [Text]) -- ^ "merge_whitelist_teams"
  , EditBranchProtectionOption -> Maybe [Text]
editBranchProtectionOptionMergeWhitelistUsernames :: !(Maybe [Text]) -- ^ "merge_whitelist_usernames"
  , EditBranchProtectionOption -> Maybe Integer
editBranchProtectionOptionPriority :: !(Maybe Integer) -- ^ "priority"
  , EditBranchProtectionOption -> Maybe Text
editBranchProtectionOptionProtectedFilePatterns :: !(Maybe Text) -- ^ "protected_file_patterns"
  , EditBranchProtectionOption -> Maybe Bool
editBranchProtectionOptionPushWhitelistDeployKeys :: !(Maybe Bool) -- ^ "push_whitelist_deploy_keys"
  , EditBranchProtectionOption -> Maybe [Text]
editBranchProtectionOptionPushWhitelistTeams :: !(Maybe [Text]) -- ^ "push_whitelist_teams"
  , EditBranchProtectionOption -> Maybe [Text]
editBranchProtectionOptionPushWhitelistUsernames :: !(Maybe [Text]) -- ^ "push_whitelist_usernames"
  , EditBranchProtectionOption -> Maybe Bool
editBranchProtectionOptionRequireSignedCommits :: !(Maybe Bool) -- ^ "require_signed_commits"
  , EditBranchProtectionOption -> Maybe Integer
editBranchProtectionOptionRequiredApprovals :: !(Maybe Integer) -- ^ "required_approvals"
  , EditBranchProtectionOption -> Maybe [Text]
editBranchProtectionOptionStatusCheckContexts :: !(Maybe [Text]) -- ^ "status_check_contexts"
  , EditBranchProtectionOption -> Maybe Text
editBranchProtectionOptionUnprotectedFilePatterns :: !(Maybe Text) -- ^ "unprotected_file_patterns"
  } deriving (Int -> EditBranchProtectionOption -> ShowS
[EditBranchProtectionOption] -> ShowS
EditBranchProtectionOption -> [Char]
(Int -> EditBranchProtectionOption -> ShowS)
-> (EditBranchProtectionOption -> [Char])
-> ([EditBranchProtectionOption] -> ShowS)
-> Show EditBranchProtectionOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EditBranchProtectionOption -> ShowS
showsPrec :: Int -> EditBranchProtectionOption -> ShowS
$cshow :: EditBranchProtectionOption -> [Char]
show :: EditBranchProtectionOption -> [Char]
$cshowList :: [EditBranchProtectionOption] -> ShowS
showList :: [EditBranchProtectionOption] -> ShowS
P.Show, EditBranchProtectionOption -> EditBranchProtectionOption -> Bool
(EditBranchProtectionOption -> EditBranchProtectionOption -> Bool)
-> (EditBranchProtectionOption
    -> EditBranchProtectionOption -> Bool)
-> Eq EditBranchProtectionOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EditBranchProtectionOption -> EditBranchProtectionOption -> Bool
== :: EditBranchProtectionOption -> EditBranchProtectionOption -> Bool
$c/= :: EditBranchProtectionOption -> EditBranchProtectionOption -> Bool
/= :: EditBranchProtectionOption -> EditBranchProtectionOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON EditBranchProtectionOption
instance A.FromJSON EditBranchProtectionOption where
  parseJSON :: Value -> Parser EditBranchProtectionOption
parseJSON = [Char]
-> (Object -> Parser EditBranchProtectionOption)
-> Value
-> Parser EditBranchProtectionOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"EditBranchProtectionOption" ((Object -> Parser EditBranchProtectionOption)
 -> Value -> Parser EditBranchProtectionOption)
-> (Object -> Parser EditBranchProtectionOption)
-> Value
-> Parser EditBranchProtectionOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Text]
-> Maybe [Text]
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe [Text]
-> Maybe [Text]
-> Maybe Bool
-> Maybe [Text]
-> Maybe [Text]
-> Maybe Integer
-> Maybe Text
-> Maybe Bool
-> Maybe [Text]
-> Maybe [Text]
-> Maybe Bool
-> Maybe Integer
-> Maybe [Text]
-> Maybe Text
-> EditBranchProtectionOption
EditBranchProtectionOption
      (Maybe [Text]
 -> Maybe [Text]
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe [Text]
 -> Maybe [Text]
 -> Maybe Bool
 -> Maybe [Text]
 -> Maybe [Text]
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Bool
 -> Maybe [Text]
 -> Maybe [Text]
 -> Maybe Bool
 -> Maybe Integer
 -> Maybe [Text]
 -> Maybe Text
 -> EditBranchProtectionOption)
-> Parser (Maybe [Text])
-> Parser
     (Maybe [Text]
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Text
      -> EditBranchProtectionOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"approvals_whitelist_teams")
      Parser
  (Maybe [Text]
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Text
   -> EditBranchProtectionOption)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Text
      -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"approvals_whitelist_username")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Text
   -> EditBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Text
      -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"block_admin_merge_override")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Text
   -> EditBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Text
      -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"block_on_official_review_requests")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Text
   -> EditBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Text
      -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"block_on_outdated_branch")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Text
   -> EditBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Text
      -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"block_on_rejected_reviews")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Text
   -> EditBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Text
      -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"dismiss_stale_approvals")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Text
   -> EditBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Text
      -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enable_approvals_whitelist")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Text
   -> EditBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Text
      -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enable_force_push")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Text
   -> EditBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Text
      -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enable_force_push_allowlist")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Text
   -> EditBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Text
      -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enable_merge_whitelist")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Text
   -> EditBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Text
      -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enable_push")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Text
   -> EditBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Text
      -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enable_push_whitelist")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Text
   -> EditBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Text
      -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enable_status_check")
      Parser
  (Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Text
   -> EditBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Text
      -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"force_push_allowlist_deploy_keys")
      Parser
  (Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Text
   -> EditBranchProtectionOption)
-> Parser (Maybe [Text])
-> Parser
     (Maybe [Text]
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Text
      -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"force_push_allowlist_teams")
      Parser
  (Maybe [Text]
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Text
   -> EditBranchProtectionOption)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Text
      -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"force_push_allowlist_usernames")
      Parser
  (Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Text
   -> EditBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe [Text]
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Text
      -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ignore_stale_approvals")
      Parser
  (Maybe [Text]
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Text
   -> EditBranchProtectionOption)
-> Parser (Maybe [Text])
-> Parser
     (Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Text
      -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"merge_whitelist_teams")
      Parser
  (Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Text
   -> EditBranchProtectionOption)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Text
      -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"merge_whitelist_usernames")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Text
   -> EditBranchProtectionOption)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Text
      -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"priority")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Text
   -> EditBranchProtectionOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Text
      -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"protected_file_patterns")
      Parser
  (Maybe Bool
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Text
   -> EditBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe [Text]
      -> Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Text
      -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"push_whitelist_deploy_keys")
      Parser
  (Maybe [Text]
   -> Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Text
   -> EditBranchProtectionOption)
-> Parser (Maybe [Text])
-> Parser
     (Maybe [Text]
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Text
      -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"push_whitelist_teams")
      Parser
  (Maybe [Text]
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Text
   -> EditBranchProtectionOption)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Bool
      -> Maybe Integer
      -> Maybe [Text]
      -> Maybe Text
      -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"push_whitelist_usernames")
      Parser
  (Maybe Bool
   -> Maybe Integer
   -> Maybe [Text]
   -> Maybe Text
   -> EditBranchProtectionOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Integer
      -> Maybe [Text] -> Maybe Text -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"require_signed_commits")
      Parser
  (Maybe Integer
   -> Maybe [Text] -> Maybe Text -> EditBranchProtectionOption)
-> Parser (Maybe Integer)
-> Parser
     (Maybe [Text] -> Maybe Text -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"required_approvals")
      Parser (Maybe [Text] -> Maybe Text -> EditBranchProtectionOption)
-> Parser (Maybe [Text])
-> Parser (Maybe Text -> EditBranchProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"status_check_contexts")
      Parser (Maybe Text -> EditBranchProtectionOption)
-> Parser (Maybe Text) -> Parser EditBranchProtectionOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"unprotected_file_patterns")

-- | ToJSON EditBranchProtectionOption
instance A.ToJSON EditBranchProtectionOption where
  toJSON :: EditBranchProtectionOption -> Value
toJSON EditBranchProtectionOption {Maybe Bool
Maybe Integer
Maybe [Text]
Maybe Text
$sel:editBranchProtectionOptionApprovalsWhitelistTeams:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe [Text]
$sel:editBranchProtectionOptionApprovalsWhitelistUsername:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe [Text]
$sel:editBranchProtectionOptionBlockAdminMergeOverride:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe Bool
$sel:editBranchProtectionOptionBlockOnOfficialReviewRequests:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe Bool
$sel:editBranchProtectionOptionBlockOnOutdatedBranch:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe Bool
$sel:editBranchProtectionOptionBlockOnRejectedReviews:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe Bool
$sel:editBranchProtectionOptionDismissStaleApprovals:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe Bool
$sel:editBranchProtectionOptionEnableApprovalsWhitelist:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe Bool
$sel:editBranchProtectionOptionEnableForcePush:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe Bool
$sel:editBranchProtectionOptionEnableForcePushAllowlist:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe Bool
$sel:editBranchProtectionOptionEnableMergeWhitelist:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe Bool
$sel:editBranchProtectionOptionEnablePush:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe Bool
$sel:editBranchProtectionOptionEnablePushWhitelist:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe Bool
$sel:editBranchProtectionOptionEnableStatusCheck:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe Bool
$sel:editBranchProtectionOptionForcePushAllowlistDeployKeys:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe Bool
$sel:editBranchProtectionOptionForcePushAllowlistTeams:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe [Text]
$sel:editBranchProtectionOptionForcePushAllowlistUsernames:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe [Text]
$sel:editBranchProtectionOptionIgnoreStaleApprovals:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe Bool
$sel:editBranchProtectionOptionMergeWhitelistTeams:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe [Text]
$sel:editBranchProtectionOptionMergeWhitelistUsernames:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe [Text]
$sel:editBranchProtectionOptionPriority:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe Integer
$sel:editBranchProtectionOptionProtectedFilePatterns:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe Text
$sel:editBranchProtectionOptionPushWhitelistDeployKeys:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe Bool
$sel:editBranchProtectionOptionPushWhitelistTeams:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe [Text]
$sel:editBranchProtectionOptionPushWhitelistUsernames:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe [Text]
$sel:editBranchProtectionOptionRequireSignedCommits:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe Bool
$sel:editBranchProtectionOptionRequiredApprovals:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe Integer
$sel:editBranchProtectionOptionStatusCheckContexts:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe [Text]
$sel:editBranchProtectionOptionUnprotectedFilePatterns:EditBranchProtectionOption :: EditBranchProtectionOption -> Maybe Text
editBranchProtectionOptionApprovalsWhitelistTeams :: Maybe [Text]
editBranchProtectionOptionApprovalsWhitelistUsername :: Maybe [Text]
editBranchProtectionOptionBlockAdminMergeOverride :: Maybe Bool
editBranchProtectionOptionBlockOnOfficialReviewRequests :: Maybe Bool
editBranchProtectionOptionBlockOnOutdatedBranch :: Maybe Bool
editBranchProtectionOptionBlockOnRejectedReviews :: Maybe Bool
editBranchProtectionOptionDismissStaleApprovals :: Maybe Bool
editBranchProtectionOptionEnableApprovalsWhitelist :: Maybe Bool
editBranchProtectionOptionEnableForcePush :: Maybe Bool
editBranchProtectionOptionEnableForcePushAllowlist :: Maybe Bool
editBranchProtectionOptionEnableMergeWhitelist :: Maybe Bool
editBranchProtectionOptionEnablePush :: Maybe Bool
editBranchProtectionOptionEnablePushWhitelist :: Maybe Bool
editBranchProtectionOptionEnableStatusCheck :: Maybe Bool
editBranchProtectionOptionForcePushAllowlistDeployKeys :: Maybe Bool
editBranchProtectionOptionForcePushAllowlistTeams :: Maybe [Text]
editBranchProtectionOptionForcePushAllowlistUsernames :: Maybe [Text]
editBranchProtectionOptionIgnoreStaleApprovals :: Maybe Bool
editBranchProtectionOptionMergeWhitelistTeams :: Maybe [Text]
editBranchProtectionOptionMergeWhitelistUsernames :: Maybe [Text]
editBranchProtectionOptionPriority :: Maybe Integer
editBranchProtectionOptionProtectedFilePatterns :: Maybe Text
editBranchProtectionOptionPushWhitelistDeployKeys :: Maybe Bool
editBranchProtectionOptionPushWhitelistTeams :: Maybe [Text]
editBranchProtectionOptionPushWhitelistUsernames :: Maybe [Text]
editBranchProtectionOptionRequireSignedCommits :: Maybe Bool
editBranchProtectionOptionRequiredApprovals :: Maybe Integer
editBranchProtectionOptionStatusCheckContexts :: Maybe [Text]
editBranchProtectionOptionUnprotectedFilePatterns :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"approvals_whitelist_teams" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
editBranchProtectionOptionApprovalsWhitelistTeams
      , Key
"approvals_whitelist_username" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
editBranchProtectionOptionApprovalsWhitelistUsername
      , Key
"block_admin_merge_override" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editBranchProtectionOptionBlockAdminMergeOverride
      , Key
"block_on_official_review_requests" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editBranchProtectionOptionBlockOnOfficialReviewRequests
      , Key
"block_on_outdated_branch" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editBranchProtectionOptionBlockOnOutdatedBranch
      , Key
"block_on_rejected_reviews" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editBranchProtectionOptionBlockOnRejectedReviews
      , Key
"dismiss_stale_approvals" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editBranchProtectionOptionDismissStaleApprovals
      , Key
"enable_approvals_whitelist" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editBranchProtectionOptionEnableApprovalsWhitelist
      , Key
"enable_force_push" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editBranchProtectionOptionEnableForcePush
      , Key
"enable_force_push_allowlist" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editBranchProtectionOptionEnableForcePushAllowlist
      , Key
"enable_merge_whitelist" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editBranchProtectionOptionEnableMergeWhitelist
      , Key
"enable_push" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editBranchProtectionOptionEnablePush
      , Key
"enable_push_whitelist" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editBranchProtectionOptionEnablePushWhitelist
      , Key
"enable_status_check" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editBranchProtectionOptionEnableStatusCheck
      , Key
"force_push_allowlist_deploy_keys" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editBranchProtectionOptionForcePushAllowlistDeployKeys
      , Key
"force_push_allowlist_teams" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
editBranchProtectionOptionForcePushAllowlistTeams
      , Key
"force_push_allowlist_usernames" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
editBranchProtectionOptionForcePushAllowlistUsernames
      , Key
"ignore_stale_approvals" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editBranchProtectionOptionIgnoreStaleApprovals
      , Key
"merge_whitelist_teams" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
editBranchProtectionOptionMergeWhitelistTeams
      , Key
"merge_whitelist_usernames" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
editBranchProtectionOptionMergeWhitelistUsernames
      , Key
"priority" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
editBranchProtectionOptionPriority
      , Key
"protected_file_patterns" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editBranchProtectionOptionProtectedFilePatterns
      , Key
"push_whitelist_deploy_keys" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editBranchProtectionOptionPushWhitelistDeployKeys
      , Key
"push_whitelist_teams" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
editBranchProtectionOptionPushWhitelistTeams
      , Key
"push_whitelist_usernames" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
editBranchProtectionOptionPushWhitelistUsernames
      , Key
"require_signed_commits" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editBranchProtectionOptionRequireSignedCommits
      , Key
"required_approvals" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
editBranchProtectionOptionRequiredApprovals
      , Key
"status_check_contexts" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
editBranchProtectionOptionStatusCheckContexts
      , Key
"unprotected_file_patterns" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editBranchProtectionOptionUnprotectedFilePatterns
      ]


-- | Construct a value of type 'EditBranchProtectionOption' (by applying it's required fields, if any)
mkEditBranchProtectionOption
  :: EditBranchProtectionOption
mkEditBranchProtectionOption :: EditBranchProtectionOption
mkEditBranchProtectionOption =
  EditBranchProtectionOption
  { $sel:editBranchProtectionOptionApprovalsWhitelistTeams:EditBranchProtectionOption :: Maybe [Text]
editBranchProtectionOptionApprovalsWhitelistTeams = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionApprovalsWhitelistUsername:EditBranchProtectionOption :: Maybe [Text]
editBranchProtectionOptionApprovalsWhitelistUsername = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionBlockAdminMergeOverride:EditBranchProtectionOption :: Maybe Bool
editBranchProtectionOptionBlockAdminMergeOverride = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionBlockOnOfficialReviewRequests:EditBranchProtectionOption :: Maybe Bool
editBranchProtectionOptionBlockOnOfficialReviewRequests = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionBlockOnOutdatedBranch:EditBranchProtectionOption :: Maybe Bool
editBranchProtectionOptionBlockOnOutdatedBranch = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionBlockOnRejectedReviews:EditBranchProtectionOption :: Maybe Bool
editBranchProtectionOptionBlockOnRejectedReviews = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionDismissStaleApprovals:EditBranchProtectionOption :: Maybe Bool
editBranchProtectionOptionDismissStaleApprovals = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionEnableApprovalsWhitelist:EditBranchProtectionOption :: Maybe Bool
editBranchProtectionOptionEnableApprovalsWhitelist = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionEnableForcePush:EditBranchProtectionOption :: Maybe Bool
editBranchProtectionOptionEnableForcePush = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionEnableForcePushAllowlist:EditBranchProtectionOption :: Maybe Bool
editBranchProtectionOptionEnableForcePushAllowlist = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionEnableMergeWhitelist:EditBranchProtectionOption :: Maybe Bool
editBranchProtectionOptionEnableMergeWhitelist = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionEnablePush:EditBranchProtectionOption :: Maybe Bool
editBranchProtectionOptionEnablePush = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionEnablePushWhitelist:EditBranchProtectionOption :: Maybe Bool
editBranchProtectionOptionEnablePushWhitelist = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionEnableStatusCheck:EditBranchProtectionOption :: Maybe Bool
editBranchProtectionOptionEnableStatusCheck = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionForcePushAllowlistDeployKeys:EditBranchProtectionOption :: Maybe Bool
editBranchProtectionOptionForcePushAllowlistDeployKeys = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionForcePushAllowlistTeams:EditBranchProtectionOption :: Maybe [Text]
editBranchProtectionOptionForcePushAllowlistTeams = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionForcePushAllowlistUsernames:EditBranchProtectionOption :: Maybe [Text]
editBranchProtectionOptionForcePushAllowlistUsernames = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionIgnoreStaleApprovals:EditBranchProtectionOption :: Maybe Bool
editBranchProtectionOptionIgnoreStaleApprovals = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionMergeWhitelistTeams:EditBranchProtectionOption :: Maybe [Text]
editBranchProtectionOptionMergeWhitelistTeams = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionMergeWhitelistUsernames:EditBranchProtectionOption :: Maybe [Text]
editBranchProtectionOptionMergeWhitelistUsernames = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionPriority:EditBranchProtectionOption :: Maybe Integer
editBranchProtectionOptionPriority = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionProtectedFilePatterns:EditBranchProtectionOption :: Maybe Text
editBranchProtectionOptionProtectedFilePatterns = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionPushWhitelistDeployKeys:EditBranchProtectionOption :: Maybe Bool
editBranchProtectionOptionPushWhitelistDeployKeys = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionPushWhitelistTeams:EditBranchProtectionOption :: Maybe [Text]
editBranchProtectionOptionPushWhitelistTeams = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionPushWhitelistUsernames:EditBranchProtectionOption :: Maybe [Text]
editBranchProtectionOptionPushWhitelistUsernames = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionRequireSignedCommits:EditBranchProtectionOption :: Maybe Bool
editBranchProtectionOptionRequireSignedCommits = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionRequiredApprovals:EditBranchProtectionOption :: Maybe Integer
editBranchProtectionOptionRequiredApprovals = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionStatusCheckContexts:EditBranchProtectionOption :: Maybe [Text]
editBranchProtectionOptionStatusCheckContexts = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:editBranchProtectionOptionUnprotectedFilePatterns:EditBranchProtectionOption :: Maybe Text
editBranchProtectionOptionUnprotectedFilePatterns = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** EditDeadlineOption
-- | EditDeadlineOption
-- EditDeadlineOption options for creating a deadline
data EditDeadlineOption = EditDeadlineOption
  { EditDeadlineOption -> DateTime
editDeadlineOptionDueDate :: !(DateTime) -- ^ /Required/ "due_date"
  } deriving (Int -> EditDeadlineOption -> ShowS
[EditDeadlineOption] -> ShowS
EditDeadlineOption -> [Char]
(Int -> EditDeadlineOption -> ShowS)
-> (EditDeadlineOption -> [Char])
-> ([EditDeadlineOption] -> ShowS)
-> Show EditDeadlineOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EditDeadlineOption -> ShowS
showsPrec :: Int -> EditDeadlineOption -> ShowS
$cshow :: EditDeadlineOption -> [Char]
show :: EditDeadlineOption -> [Char]
$cshowList :: [EditDeadlineOption] -> ShowS
showList :: [EditDeadlineOption] -> ShowS
P.Show, EditDeadlineOption -> EditDeadlineOption -> Bool
(EditDeadlineOption -> EditDeadlineOption -> Bool)
-> (EditDeadlineOption -> EditDeadlineOption -> Bool)
-> Eq EditDeadlineOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EditDeadlineOption -> EditDeadlineOption -> Bool
== :: EditDeadlineOption -> EditDeadlineOption -> Bool
$c/= :: EditDeadlineOption -> EditDeadlineOption -> Bool
/= :: EditDeadlineOption -> EditDeadlineOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON EditDeadlineOption
instance A.FromJSON EditDeadlineOption where
  parseJSON :: Value -> Parser EditDeadlineOption
parseJSON = [Char]
-> (Object -> Parser EditDeadlineOption)
-> Value
-> Parser EditDeadlineOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"EditDeadlineOption" ((Object -> Parser EditDeadlineOption)
 -> Value -> Parser EditDeadlineOption)
-> (Object -> Parser EditDeadlineOption)
-> Value
-> Parser EditDeadlineOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    DateTime -> EditDeadlineOption
EditDeadlineOption
      (DateTime -> EditDeadlineOption)
-> Parser DateTime -> Parser EditDeadlineOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser DateTime
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"due_date")

-- | ToJSON EditDeadlineOption
instance A.ToJSON EditDeadlineOption where
  toJSON :: EditDeadlineOption -> Value
toJSON EditDeadlineOption {DateTime
$sel:editDeadlineOptionDueDate:EditDeadlineOption :: EditDeadlineOption -> DateTime
editDeadlineOptionDueDate :: DateTime
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"due_date" Key -> DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= DateTime
editDeadlineOptionDueDate
      ]


-- | Construct a value of type 'EditDeadlineOption' (by applying it's required fields, if any)
mkEditDeadlineOption
  :: DateTime -- ^ 'editDeadlineOptionDueDate' 
  -> EditDeadlineOption
mkEditDeadlineOption :: DateTime -> EditDeadlineOption
mkEditDeadlineOption DateTime
editDeadlineOptionDueDate =
  EditDeadlineOption
  { DateTime
$sel:editDeadlineOptionDueDate:EditDeadlineOption :: DateTime
editDeadlineOptionDueDate :: DateTime
editDeadlineOptionDueDate
  }

-- ** EditGitHookOption
-- | EditGitHookOption
-- EditGitHookOption options when modifying one Git hook
data EditGitHookOption = EditGitHookOption
  { EditGitHookOption -> Maybe Text
editGitHookOptionContent :: !(Maybe Text) -- ^ "content"
  } deriving (Int -> EditGitHookOption -> ShowS
[EditGitHookOption] -> ShowS
EditGitHookOption -> [Char]
(Int -> EditGitHookOption -> ShowS)
-> (EditGitHookOption -> [Char])
-> ([EditGitHookOption] -> ShowS)
-> Show EditGitHookOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EditGitHookOption -> ShowS
showsPrec :: Int -> EditGitHookOption -> ShowS
$cshow :: EditGitHookOption -> [Char]
show :: EditGitHookOption -> [Char]
$cshowList :: [EditGitHookOption] -> ShowS
showList :: [EditGitHookOption] -> ShowS
P.Show, EditGitHookOption -> EditGitHookOption -> Bool
(EditGitHookOption -> EditGitHookOption -> Bool)
-> (EditGitHookOption -> EditGitHookOption -> Bool)
-> Eq EditGitHookOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EditGitHookOption -> EditGitHookOption -> Bool
== :: EditGitHookOption -> EditGitHookOption -> Bool
$c/= :: EditGitHookOption -> EditGitHookOption -> Bool
/= :: EditGitHookOption -> EditGitHookOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON EditGitHookOption
instance A.FromJSON EditGitHookOption where
  parseJSON :: Value -> Parser EditGitHookOption
parseJSON = [Char]
-> (Object -> Parser EditGitHookOption)
-> Value
-> Parser EditGitHookOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"EditGitHookOption" ((Object -> Parser EditGitHookOption)
 -> Value -> Parser EditGitHookOption)
-> (Object -> Parser EditGitHookOption)
-> Value
-> Parser EditGitHookOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> EditGitHookOption
EditGitHookOption
      (Maybe Text -> EditGitHookOption)
-> Parser (Maybe Text) -> Parser EditGitHookOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"content")

-- | ToJSON EditGitHookOption
instance A.ToJSON EditGitHookOption where
  toJSON :: EditGitHookOption -> Value
toJSON EditGitHookOption {Maybe Text
$sel:editGitHookOptionContent:EditGitHookOption :: EditGitHookOption -> Maybe Text
editGitHookOptionContent :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"content" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editGitHookOptionContent
      ]


-- | Construct a value of type 'EditGitHookOption' (by applying it's required fields, if any)
mkEditGitHookOption
  :: EditGitHookOption
mkEditGitHookOption :: EditGitHookOption
mkEditGitHookOption =
  EditGitHookOption
  { $sel:editGitHookOptionContent:EditGitHookOption :: Maybe Text
editGitHookOptionContent = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** EditHookOption
-- | EditHookOption
-- EditHookOption options when modify one hook
data EditHookOption = EditHookOption
  { EditHookOption -> Maybe Bool
editHookOptionActive :: !(Maybe Bool) -- ^ "active"
  , EditHookOption -> Maybe Text
editHookOptionAuthorizationHeader :: !(Maybe Text) -- ^ "authorization_header"
  , EditHookOption -> Maybe Text
editHookOptionBranchFilter :: !(Maybe Text) -- ^ "branch_filter"
  , EditHookOption -> Maybe (Map [Char] Text)
editHookOptionConfig :: !(Maybe (Map.Map String Text)) -- ^ "config"
  , EditHookOption -> Maybe [Text]
editHookOptionEvents :: !(Maybe [Text]) -- ^ "events"
  } deriving (Int -> EditHookOption -> ShowS
[EditHookOption] -> ShowS
EditHookOption -> [Char]
(Int -> EditHookOption -> ShowS)
-> (EditHookOption -> [Char])
-> ([EditHookOption] -> ShowS)
-> Show EditHookOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EditHookOption -> ShowS
showsPrec :: Int -> EditHookOption -> ShowS
$cshow :: EditHookOption -> [Char]
show :: EditHookOption -> [Char]
$cshowList :: [EditHookOption] -> ShowS
showList :: [EditHookOption] -> ShowS
P.Show, EditHookOption -> EditHookOption -> Bool
(EditHookOption -> EditHookOption -> Bool)
-> (EditHookOption -> EditHookOption -> Bool) -> Eq EditHookOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EditHookOption -> EditHookOption -> Bool
== :: EditHookOption -> EditHookOption -> Bool
$c/= :: EditHookOption -> EditHookOption -> Bool
/= :: EditHookOption -> EditHookOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON EditHookOption
instance A.FromJSON EditHookOption where
  parseJSON :: Value -> Parser EditHookOption
parseJSON = [Char]
-> (Object -> Parser EditHookOption)
-> Value
-> Parser EditHookOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"EditHookOption" ((Object -> Parser EditHookOption)
 -> Value -> Parser EditHookOption)
-> (Object -> Parser EditHookOption)
-> Value
-> Parser EditHookOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe (Map [Char] Text)
-> Maybe [Text]
-> EditHookOption
EditHookOption
      (Maybe Bool
 -> Maybe Text
 -> Maybe Text
 -> Maybe (Map [Char] Text)
 -> Maybe [Text]
 -> EditHookOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe (Map [Char] Text)
      -> Maybe [Text]
      -> EditHookOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"active")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe (Map [Char] Text)
   -> Maybe [Text]
   -> EditHookOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe (Map [Char] Text) -> Maybe [Text] -> EditHookOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"authorization_header")
      Parser
  (Maybe Text
   -> Maybe (Map [Char] Text) -> Maybe [Text] -> EditHookOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe (Map [Char] Text) -> Maybe [Text] -> EditHookOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"branch_filter")
      Parser (Maybe (Map [Char] Text) -> Maybe [Text] -> EditHookOption)
-> Parser (Maybe (Map [Char] Text))
-> Parser (Maybe [Text] -> EditHookOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe (Map [Char] Text))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"config")
      Parser (Maybe [Text] -> EditHookOption)
-> Parser (Maybe [Text]) -> Parser EditHookOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"events")

-- | ToJSON EditHookOption
instance A.ToJSON EditHookOption where
  toJSON :: EditHookOption -> Value
toJSON EditHookOption {Maybe Bool
Maybe [Text]
Maybe (Map [Char] Text)
Maybe Text
$sel:editHookOptionActive:EditHookOption :: EditHookOption -> Maybe Bool
$sel:editHookOptionAuthorizationHeader:EditHookOption :: EditHookOption -> Maybe Text
$sel:editHookOptionBranchFilter:EditHookOption :: EditHookOption -> Maybe Text
$sel:editHookOptionConfig:EditHookOption :: EditHookOption -> Maybe (Map [Char] Text)
$sel:editHookOptionEvents:EditHookOption :: EditHookOption -> Maybe [Text]
editHookOptionActive :: Maybe Bool
editHookOptionAuthorizationHeader :: Maybe Text
editHookOptionBranchFilter :: Maybe Text
editHookOptionConfig :: Maybe (Map [Char] Text)
editHookOptionEvents :: Maybe [Text]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"active" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editHookOptionActive
      , Key
"authorization_header" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editHookOptionAuthorizationHeader
      , Key
"branch_filter" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editHookOptionBranchFilter
      , Key
"config" Key -> Maybe (Map [Char] Text) -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe (Map [Char] Text)
editHookOptionConfig
      , Key
"events" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
editHookOptionEvents
      ]


-- | Construct a value of type 'EditHookOption' (by applying it's required fields, if any)
mkEditHookOption
  :: EditHookOption
mkEditHookOption :: EditHookOption
mkEditHookOption =
  EditHookOption
  { $sel:editHookOptionActive:EditHookOption :: Maybe Bool
editHookOptionActive = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editHookOptionAuthorizationHeader:EditHookOption :: Maybe Text
editHookOptionAuthorizationHeader = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editHookOptionBranchFilter:EditHookOption :: Maybe Text
editHookOptionBranchFilter = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editHookOptionConfig:EditHookOption :: Maybe (Map [Char] Text)
editHookOptionConfig = Maybe (Map [Char] Text)
forall a. Maybe a
Nothing
  , $sel:editHookOptionEvents:EditHookOption :: Maybe [Text]
editHookOptionEvents = Maybe [Text]
forall a. Maybe a
Nothing
  }

-- ** EditIssueCommentOption
-- | EditIssueCommentOption
-- EditIssueCommentOption options for editing a comment
data EditIssueCommentOption = EditIssueCommentOption
  { EditIssueCommentOption -> Text
editIssueCommentOptionBody :: !(Text) -- ^ /Required/ "body"
  } deriving (Int -> EditIssueCommentOption -> ShowS
[EditIssueCommentOption] -> ShowS
EditIssueCommentOption -> [Char]
(Int -> EditIssueCommentOption -> ShowS)
-> (EditIssueCommentOption -> [Char])
-> ([EditIssueCommentOption] -> ShowS)
-> Show EditIssueCommentOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EditIssueCommentOption -> ShowS
showsPrec :: Int -> EditIssueCommentOption -> ShowS
$cshow :: EditIssueCommentOption -> [Char]
show :: EditIssueCommentOption -> [Char]
$cshowList :: [EditIssueCommentOption] -> ShowS
showList :: [EditIssueCommentOption] -> ShowS
P.Show, EditIssueCommentOption -> EditIssueCommentOption -> Bool
(EditIssueCommentOption -> EditIssueCommentOption -> Bool)
-> (EditIssueCommentOption -> EditIssueCommentOption -> Bool)
-> Eq EditIssueCommentOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EditIssueCommentOption -> EditIssueCommentOption -> Bool
== :: EditIssueCommentOption -> EditIssueCommentOption -> Bool
$c/= :: EditIssueCommentOption -> EditIssueCommentOption -> Bool
/= :: EditIssueCommentOption -> EditIssueCommentOption -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON EditIssueCommentOption
instance A.ToJSON EditIssueCommentOption where
  toJSON :: EditIssueCommentOption -> Value
toJSON EditIssueCommentOption {Text
$sel:editIssueCommentOptionBody:EditIssueCommentOption :: EditIssueCommentOption -> Text
editIssueCommentOptionBody :: Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"body" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
editIssueCommentOptionBody
      ]


-- | Construct a value of type 'EditIssueCommentOption' (by applying it's required fields, if any)
mkEditIssueCommentOption
  :: Text -- ^ 'editIssueCommentOptionBody' 
  -> EditIssueCommentOption
mkEditIssueCommentOption :: Text -> EditIssueCommentOption
mkEditIssueCommentOption Text
editIssueCommentOptionBody =
  EditIssueCommentOption
  { Text
$sel:editIssueCommentOptionBody:EditIssueCommentOption :: Text
editIssueCommentOptionBody :: Text
editIssueCommentOptionBody
  }

-- ** EditIssueOption
-- | EditIssueOption
-- EditIssueOption options for editing an issue
data EditIssueOption = EditIssueOption
  { EditIssueOption -> Maybe Text
editIssueOptionAssignee :: !(Maybe Text) -- ^ "assignee" - deprecated
  , EditIssueOption -> Maybe [Text]
editIssueOptionAssignees :: !(Maybe [Text]) -- ^ "assignees"
  , EditIssueOption -> Maybe Text
editIssueOptionBody :: !(Maybe Text) -- ^ "body"
  , EditIssueOption -> Maybe DateTime
editIssueOptionDueDate :: !(Maybe DateTime) -- ^ "due_date"
  , EditIssueOption -> Maybe Integer
editIssueOptionMilestone :: !(Maybe Integer) -- ^ "milestone"
  , EditIssueOption -> Maybe Text
editIssueOptionRef :: !(Maybe Text) -- ^ "ref"
  , EditIssueOption -> Maybe Text
editIssueOptionState :: !(Maybe Text) -- ^ "state"
  , EditIssueOption -> Maybe Text
editIssueOptionTitle :: !(Maybe Text) -- ^ "title"
  , EditIssueOption -> Maybe Bool
editIssueOptionUnsetDueDate :: !(Maybe Bool) -- ^ "unset_due_date"
  } deriving (Int -> EditIssueOption -> ShowS
[EditIssueOption] -> ShowS
EditIssueOption -> [Char]
(Int -> EditIssueOption -> ShowS)
-> (EditIssueOption -> [Char])
-> ([EditIssueOption] -> ShowS)
-> Show EditIssueOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EditIssueOption -> ShowS
showsPrec :: Int -> EditIssueOption -> ShowS
$cshow :: EditIssueOption -> [Char]
show :: EditIssueOption -> [Char]
$cshowList :: [EditIssueOption] -> ShowS
showList :: [EditIssueOption] -> ShowS
P.Show, EditIssueOption -> EditIssueOption -> Bool
(EditIssueOption -> EditIssueOption -> Bool)
-> (EditIssueOption -> EditIssueOption -> Bool)
-> Eq EditIssueOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EditIssueOption -> EditIssueOption -> Bool
== :: EditIssueOption -> EditIssueOption -> Bool
$c/= :: EditIssueOption -> EditIssueOption -> Bool
/= :: EditIssueOption -> EditIssueOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON EditIssueOption
instance A.FromJSON EditIssueOption where
  parseJSON :: Value -> Parser EditIssueOption
parseJSON = [Char]
-> (Object -> Parser EditIssueOption)
-> Value
-> Parser EditIssueOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"EditIssueOption" ((Object -> Parser EditIssueOption)
 -> Value -> Parser EditIssueOption)
-> (Object -> Parser EditIssueOption)
-> Value
-> Parser EditIssueOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe DateTime
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> EditIssueOption
EditIssueOption
      (Maybe Text
 -> Maybe [Text]
 -> Maybe Text
 -> Maybe DateTime
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> EditIssueOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text]
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> EditIssueOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"assignee")
      Parser
  (Maybe [Text]
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> EditIssueOption)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Text
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> EditIssueOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"assignees")
      Parser
  (Maybe Text
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> EditIssueOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe DateTime
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> EditIssueOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"body")
      Parser
  (Maybe DateTime
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> EditIssueOption)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> EditIssueOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"due_date")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> EditIssueOption)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe Text -> Maybe Bool -> EditIssueOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"milestone")
      Parser
  (Maybe Text
   -> Maybe Text -> Maybe Text -> Maybe Bool -> EditIssueOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Text -> Maybe Bool -> EditIssueOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ref")
      Parser (Maybe Text -> Maybe Text -> Maybe Bool -> EditIssueOption)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Bool -> EditIssueOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"state")
      Parser (Maybe Text -> Maybe Bool -> EditIssueOption)
-> Parser (Maybe Text) -> Parser (Maybe Bool -> EditIssueOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title")
      Parser (Maybe Bool -> EditIssueOption)
-> Parser (Maybe Bool) -> Parser EditIssueOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"unset_due_date")

-- | ToJSON EditIssueOption
instance A.ToJSON EditIssueOption where
  toJSON :: EditIssueOption -> Value
toJSON EditIssueOption {Maybe Bool
Maybe Integer
Maybe [Text]
Maybe Text
Maybe DateTime
$sel:editIssueOptionAssignee:EditIssueOption :: EditIssueOption -> Maybe Text
$sel:editIssueOptionAssignees:EditIssueOption :: EditIssueOption -> Maybe [Text]
$sel:editIssueOptionBody:EditIssueOption :: EditIssueOption -> Maybe Text
$sel:editIssueOptionDueDate:EditIssueOption :: EditIssueOption -> Maybe DateTime
$sel:editIssueOptionMilestone:EditIssueOption :: EditIssueOption -> Maybe Integer
$sel:editIssueOptionRef:EditIssueOption :: EditIssueOption -> Maybe Text
$sel:editIssueOptionState:EditIssueOption :: EditIssueOption -> Maybe Text
$sel:editIssueOptionTitle:EditIssueOption :: EditIssueOption -> Maybe Text
$sel:editIssueOptionUnsetDueDate:EditIssueOption :: EditIssueOption -> Maybe Bool
editIssueOptionAssignee :: Maybe Text
editIssueOptionAssignees :: Maybe [Text]
editIssueOptionBody :: Maybe Text
editIssueOptionDueDate :: Maybe DateTime
editIssueOptionMilestone :: Maybe Integer
editIssueOptionRef :: Maybe Text
editIssueOptionState :: Maybe Text
editIssueOptionTitle :: Maybe Text
editIssueOptionUnsetDueDate :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"assignee" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editIssueOptionAssignee
      , Key
"assignees" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
editIssueOptionAssignees
      , Key
"body" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editIssueOptionBody
      , Key
"due_date" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
editIssueOptionDueDate
      , Key
"milestone" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
editIssueOptionMilestone
      , Key
"ref" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editIssueOptionRef
      , Key
"state" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editIssueOptionState
      , Key
"title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editIssueOptionTitle
      , Key
"unset_due_date" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editIssueOptionUnsetDueDate
      ]


-- | Construct a value of type 'EditIssueOption' (by applying it's required fields, if any)
mkEditIssueOption
  :: EditIssueOption
mkEditIssueOption :: EditIssueOption
mkEditIssueOption =
  EditIssueOption
  { $sel:editIssueOptionAssignee:EditIssueOption :: Maybe Text
editIssueOptionAssignee = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editIssueOptionAssignees:EditIssueOption :: Maybe [Text]
editIssueOptionAssignees = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:editIssueOptionBody:EditIssueOption :: Maybe Text
editIssueOptionBody = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editIssueOptionDueDate:EditIssueOption :: Maybe DateTime
editIssueOptionDueDate = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:editIssueOptionMilestone:EditIssueOption :: Maybe Integer
editIssueOptionMilestone = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:editIssueOptionRef:EditIssueOption :: Maybe Text
editIssueOptionRef = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editIssueOptionState:EditIssueOption :: Maybe Text
editIssueOptionState = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editIssueOptionTitle:EditIssueOption :: Maybe Text
editIssueOptionTitle = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editIssueOptionUnsetDueDate:EditIssueOption :: Maybe Bool
editIssueOptionUnsetDueDate = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** EditLabelOption
-- | EditLabelOption
-- EditLabelOption options for editing a label
data EditLabelOption = EditLabelOption
  { EditLabelOption -> Maybe Text
editLabelOptionColor :: !(Maybe Text) -- ^ "color"
  , EditLabelOption -> Maybe Text
editLabelOptionDescription :: !(Maybe Text) -- ^ "description"
  , EditLabelOption -> Maybe Bool
editLabelOptionExclusive :: !(Maybe Bool) -- ^ "exclusive"
  , EditLabelOption -> Maybe Bool
editLabelOptionIsArchived :: !(Maybe Bool) -- ^ "is_archived"
  , EditLabelOption -> Maybe Text
editLabelOptionName :: !(Maybe Text) -- ^ "name"
  } deriving (Int -> EditLabelOption -> ShowS
[EditLabelOption] -> ShowS
EditLabelOption -> [Char]
(Int -> EditLabelOption -> ShowS)
-> (EditLabelOption -> [Char])
-> ([EditLabelOption] -> ShowS)
-> Show EditLabelOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EditLabelOption -> ShowS
showsPrec :: Int -> EditLabelOption -> ShowS
$cshow :: EditLabelOption -> [Char]
show :: EditLabelOption -> [Char]
$cshowList :: [EditLabelOption] -> ShowS
showList :: [EditLabelOption] -> ShowS
P.Show, EditLabelOption -> EditLabelOption -> Bool
(EditLabelOption -> EditLabelOption -> Bool)
-> (EditLabelOption -> EditLabelOption -> Bool)
-> Eq EditLabelOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EditLabelOption -> EditLabelOption -> Bool
== :: EditLabelOption -> EditLabelOption -> Bool
$c/= :: EditLabelOption -> EditLabelOption -> Bool
/= :: EditLabelOption -> EditLabelOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON EditLabelOption
instance A.FromJSON EditLabelOption where
  parseJSON :: Value -> Parser EditLabelOption
parseJSON = [Char]
-> (Object -> Parser EditLabelOption)
-> Value
-> Parser EditLabelOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"EditLabelOption" ((Object -> Parser EditLabelOption)
 -> Value -> Parser EditLabelOption)
-> (Object -> Parser EditLabelOption)
-> Value
-> Parser EditLabelOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> EditLabelOption
EditLabelOption
      (Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Text
 -> EditLabelOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool -> Maybe Bool -> Maybe Text -> EditLabelOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"color")
      Parser
  (Maybe Text
   -> Maybe Bool -> Maybe Bool -> Maybe Text -> EditLabelOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool -> Maybe Bool -> Maybe Text -> EditLabelOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser (Maybe Bool -> Maybe Bool -> Maybe Text -> EditLabelOption)
-> Parser (Maybe Bool)
-> Parser (Maybe Bool -> Maybe Text -> EditLabelOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"exclusive")
      Parser (Maybe Bool -> Maybe Text -> EditLabelOption)
-> Parser (Maybe Bool) -> Parser (Maybe Text -> EditLabelOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_archived")
      Parser (Maybe Text -> EditLabelOption)
-> Parser (Maybe Text) -> Parser EditLabelOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")

-- | ToJSON EditLabelOption
instance A.ToJSON EditLabelOption where
  toJSON :: EditLabelOption -> Value
toJSON EditLabelOption {Maybe Bool
Maybe Text
$sel:editLabelOptionColor:EditLabelOption :: EditLabelOption -> Maybe Text
$sel:editLabelOptionDescription:EditLabelOption :: EditLabelOption -> Maybe Text
$sel:editLabelOptionExclusive:EditLabelOption :: EditLabelOption -> Maybe Bool
$sel:editLabelOptionIsArchived:EditLabelOption :: EditLabelOption -> Maybe Bool
$sel:editLabelOptionName:EditLabelOption :: EditLabelOption -> Maybe Text
editLabelOptionColor :: Maybe Text
editLabelOptionDescription :: Maybe Text
editLabelOptionExclusive :: Maybe Bool
editLabelOptionIsArchived :: Maybe Bool
editLabelOptionName :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"color" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editLabelOptionColor
      , Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editLabelOptionDescription
      , Key
"exclusive" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editLabelOptionExclusive
      , Key
"is_archived" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editLabelOptionIsArchived
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editLabelOptionName
      ]


-- | Construct a value of type 'EditLabelOption' (by applying it's required fields, if any)
mkEditLabelOption
  :: EditLabelOption
mkEditLabelOption :: EditLabelOption
mkEditLabelOption =
  EditLabelOption
  { $sel:editLabelOptionColor:EditLabelOption :: Maybe Text
editLabelOptionColor = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editLabelOptionDescription:EditLabelOption :: Maybe Text
editLabelOptionDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editLabelOptionExclusive:EditLabelOption :: Maybe Bool
editLabelOptionExclusive = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editLabelOptionIsArchived:EditLabelOption :: Maybe Bool
editLabelOptionIsArchived = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editLabelOptionName:EditLabelOption :: Maybe Text
editLabelOptionName = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** EditMilestoneOption
-- | EditMilestoneOption
-- EditMilestoneOption options for editing a milestone
data EditMilestoneOption = EditMilestoneOption
  { EditMilestoneOption -> Maybe Text
editMilestoneOptionDescription :: !(Maybe Text) -- ^ "description"
  , EditMilestoneOption -> Maybe DateTime
editMilestoneOptionDueOn :: !(Maybe DateTime) -- ^ "due_on"
  , EditMilestoneOption -> Maybe Text
editMilestoneOptionState :: !(Maybe Text) -- ^ "state"
  , EditMilestoneOption -> Maybe Text
editMilestoneOptionTitle :: !(Maybe Text) -- ^ "title"
  } deriving (Int -> EditMilestoneOption -> ShowS
[EditMilestoneOption] -> ShowS
EditMilestoneOption -> [Char]
(Int -> EditMilestoneOption -> ShowS)
-> (EditMilestoneOption -> [Char])
-> ([EditMilestoneOption] -> ShowS)
-> Show EditMilestoneOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EditMilestoneOption -> ShowS
showsPrec :: Int -> EditMilestoneOption -> ShowS
$cshow :: EditMilestoneOption -> [Char]
show :: EditMilestoneOption -> [Char]
$cshowList :: [EditMilestoneOption] -> ShowS
showList :: [EditMilestoneOption] -> ShowS
P.Show, EditMilestoneOption -> EditMilestoneOption -> Bool
(EditMilestoneOption -> EditMilestoneOption -> Bool)
-> (EditMilestoneOption -> EditMilestoneOption -> Bool)
-> Eq EditMilestoneOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EditMilestoneOption -> EditMilestoneOption -> Bool
== :: EditMilestoneOption -> EditMilestoneOption -> Bool
$c/= :: EditMilestoneOption -> EditMilestoneOption -> Bool
/= :: EditMilestoneOption -> EditMilestoneOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON EditMilestoneOption
instance A.FromJSON EditMilestoneOption where
  parseJSON :: Value -> Parser EditMilestoneOption
parseJSON = [Char]
-> (Object -> Parser EditMilestoneOption)
-> Value
-> Parser EditMilestoneOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"EditMilestoneOption" ((Object -> Parser EditMilestoneOption)
 -> Value -> Parser EditMilestoneOption)
-> (Object -> Parser EditMilestoneOption)
-> Value
-> Parser EditMilestoneOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe DateTime
-> Maybe Text
-> Maybe Text
-> EditMilestoneOption
EditMilestoneOption
      (Maybe Text
 -> Maybe DateTime
 -> Maybe Text
 -> Maybe Text
 -> EditMilestoneOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe DateTime -> Maybe Text -> Maybe Text -> EditMilestoneOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe DateTime -> Maybe Text -> Maybe Text -> EditMilestoneOption)
-> Parser (Maybe DateTime)
-> Parser (Maybe Text -> Maybe Text -> EditMilestoneOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"due_on")
      Parser (Maybe Text -> Maybe Text -> EditMilestoneOption)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> EditMilestoneOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"state")
      Parser (Maybe Text -> EditMilestoneOption)
-> Parser (Maybe Text) -> Parser EditMilestoneOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title")

-- | ToJSON EditMilestoneOption
instance A.ToJSON EditMilestoneOption where
  toJSON :: EditMilestoneOption -> Value
toJSON EditMilestoneOption {Maybe Text
Maybe DateTime
$sel:editMilestoneOptionDescription:EditMilestoneOption :: EditMilestoneOption -> Maybe Text
$sel:editMilestoneOptionDueOn:EditMilestoneOption :: EditMilestoneOption -> Maybe DateTime
$sel:editMilestoneOptionState:EditMilestoneOption :: EditMilestoneOption -> Maybe Text
$sel:editMilestoneOptionTitle:EditMilestoneOption :: EditMilestoneOption -> Maybe Text
editMilestoneOptionDescription :: Maybe Text
editMilestoneOptionDueOn :: Maybe DateTime
editMilestoneOptionState :: Maybe Text
editMilestoneOptionTitle :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editMilestoneOptionDescription
      , Key
"due_on" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
editMilestoneOptionDueOn
      , Key
"state" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editMilestoneOptionState
      , Key
"title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editMilestoneOptionTitle
      ]


-- | Construct a value of type 'EditMilestoneOption' (by applying it's required fields, if any)
mkEditMilestoneOption
  :: EditMilestoneOption
mkEditMilestoneOption :: EditMilestoneOption
mkEditMilestoneOption =
  EditMilestoneOption
  { $sel:editMilestoneOptionDescription:EditMilestoneOption :: Maybe Text
editMilestoneOptionDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editMilestoneOptionDueOn:EditMilestoneOption :: Maybe DateTime
editMilestoneOptionDueOn = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:editMilestoneOptionState:EditMilestoneOption :: Maybe Text
editMilestoneOptionState = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editMilestoneOptionTitle:EditMilestoneOption :: Maybe Text
editMilestoneOptionTitle = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** EditOrgOption
-- | EditOrgOption
-- EditOrgOption options for editing an organization
data EditOrgOption = EditOrgOption
  { EditOrgOption -> Maybe Text
editOrgOptionDescription :: !(Maybe Text) -- ^ "description"
  , EditOrgOption -> Maybe Text
editOrgOptionEmail :: !(Maybe Text) -- ^ "email"
  , EditOrgOption -> Maybe Text
editOrgOptionFullName :: !(Maybe Text) -- ^ "full_name"
  , EditOrgOption -> Maybe Text
editOrgOptionLocation :: !(Maybe Text) -- ^ "location"
  , EditOrgOption -> Maybe Bool
editOrgOptionRepoAdminChangeTeamAccess :: !(Maybe Bool) -- ^ "repo_admin_change_team_access"
  , EditOrgOption -> Maybe E'Visibility
editOrgOptionVisibility :: !(Maybe E'Visibility) -- ^ "visibility" - possible values are &#x60;public&#x60;, &#x60;limited&#x60; or &#x60;private&#x60;
  , EditOrgOption -> Maybe Text
editOrgOptionWebsite :: !(Maybe Text) -- ^ "website"
  } deriving (Int -> EditOrgOption -> ShowS
[EditOrgOption] -> ShowS
EditOrgOption -> [Char]
(Int -> EditOrgOption -> ShowS)
-> (EditOrgOption -> [Char])
-> ([EditOrgOption] -> ShowS)
-> Show EditOrgOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EditOrgOption -> ShowS
showsPrec :: Int -> EditOrgOption -> ShowS
$cshow :: EditOrgOption -> [Char]
show :: EditOrgOption -> [Char]
$cshowList :: [EditOrgOption] -> ShowS
showList :: [EditOrgOption] -> ShowS
P.Show, EditOrgOption -> EditOrgOption -> Bool
(EditOrgOption -> EditOrgOption -> Bool)
-> (EditOrgOption -> EditOrgOption -> Bool) -> Eq EditOrgOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EditOrgOption -> EditOrgOption -> Bool
== :: EditOrgOption -> EditOrgOption -> Bool
$c/= :: EditOrgOption -> EditOrgOption -> Bool
/= :: EditOrgOption -> EditOrgOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON EditOrgOption
instance A.FromJSON EditOrgOption where
  parseJSON :: Value -> Parser EditOrgOption
parseJSON = [Char]
-> (Object -> Parser EditOrgOption)
-> Value
-> Parser EditOrgOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"EditOrgOption" ((Object -> Parser EditOrgOption) -> Value -> Parser EditOrgOption)
-> (Object -> Parser EditOrgOption)
-> Value
-> Parser EditOrgOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe E'Visibility
-> Maybe Text
-> EditOrgOption
EditOrgOption
      (Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Maybe E'Visibility
 -> Maybe Text
 -> EditOrgOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe E'Visibility
      -> Maybe Text
      -> EditOrgOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe E'Visibility
   -> Maybe Text
   -> EditOrgOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe E'Visibility
      -> Maybe Text
      -> EditOrgOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"email")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe E'Visibility
   -> Maybe Text
   -> EditOrgOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool -> Maybe E'Visibility -> Maybe Text -> EditOrgOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"full_name")
      Parser
  (Maybe Text
   -> Maybe Bool -> Maybe E'Visibility -> Maybe Text -> EditOrgOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool -> Maybe E'Visibility -> Maybe Text -> EditOrgOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"location")
      Parser
  (Maybe Bool -> Maybe E'Visibility -> Maybe Text -> EditOrgOption)
-> Parser (Maybe Bool)
-> Parser (Maybe E'Visibility -> Maybe Text -> EditOrgOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"repo_admin_change_team_access")
      Parser (Maybe E'Visibility -> Maybe Text -> EditOrgOption)
-> Parser (Maybe E'Visibility)
-> Parser (Maybe Text -> EditOrgOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe E'Visibility)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"visibility")
      Parser (Maybe Text -> EditOrgOption)
-> Parser (Maybe Text) -> Parser EditOrgOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"website")

-- | ToJSON EditOrgOption
instance A.ToJSON EditOrgOption where
  toJSON :: EditOrgOption -> Value
toJSON EditOrgOption {Maybe Bool
Maybe Text
Maybe E'Visibility
$sel:editOrgOptionDescription:EditOrgOption :: EditOrgOption -> Maybe Text
$sel:editOrgOptionEmail:EditOrgOption :: EditOrgOption -> Maybe Text
$sel:editOrgOptionFullName:EditOrgOption :: EditOrgOption -> Maybe Text
$sel:editOrgOptionLocation:EditOrgOption :: EditOrgOption -> Maybe Text
$sel:editOrgOptionRepoAdminChangeTeamAccess:EditOrgOption :: EditOrgOption -> Maybe Bool
$sel:editOrgOptionVisibility:EditOrgOption :: EditOrgOption -> Maybe E'Visibility
$sel:editOrgOptionWebsite:EditOrgOption :: EditOrgOption -> Maybe Text
editOrgOptionDescription :: Maybe Text
editOrgOptionEmail :: Maybe Text
editOrgOptionFullName :: Maybe Text
editOrgOptionLocation :: Maybe Text
editOrgOptionRepoAdminChangeTeamAccess :: Maybe Bool
editOrgOptionVisibility :: Maybe E'Visibility
editOrgOptionWebsite :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editOrgOptionDescription
      , Key
"email" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editOrgOptionEmail
      , Key
"full_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editOrgOptionFullName
      , Key
"location" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editOrgOptionLocation
      , Key
"repo_admin_change_team_access" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editOrgOptionRepoAdminChangeTeamAccess
      , Key
"visibility" Key -> Maybe E'Visibility -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe E'Visibility
editOrgOptionVisibility
      , Key
"website" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editOrgOptionWebsite
      ]


-- | Construct a value of type 'EditOrgOption' (by applying it's required fields, if any)
mkEditOrgOption
  :: EditOrgOption
mkEditOrgOption :: EditOrgOption
mkEditOrgOption =
  EditOrgOption
  { $sel:editOrgOptionDescription:EditOrgOption :: Maybe Text
editOrgOptionDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editOrgOptionEmail:EditOrgOption :: Maybe Text
editOrgOptionEmail = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editOrgOptionFullName:EditOrgOption :: Maybe Text
editOrgOptionFullName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editOrgOptionLocation:EditOrgOption :: Maybe Text
editOrgOptionLocation = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editOrgOptionRepoAdminChangeTeamAccess:EditOrgOption :: Maybe Bool
editOrgOptionRepoAdminChangeTeamAccess = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editOrgOptionVisibility:EditOrgOption :: Maybe E'Visibility
editOrgOptionVisibility = Maybe E'Visibility
forall a. Maybe a
Nothing
  , $sel:editOrgOptionWebsite:EditOrgOption :: Maybe Text
editOrgOptionWebsite = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** EditPullRequestOption
-- | EditPullRequestOption
-- EditPullRequestOption options when modify pull request
data EditPullRequestOption = EditPullRequestOption
  { EditPullRequestOption -> Maybe Bool
editPullRequestOptionAllowMaintainerEdit :: !(Maybe Bool) -- ^ "allow_maintainer_edit"
  , EditPullRequestOption -> Maybe Text
editPullRequestOptionAssignee :: !(Maybe Text) -- ^ "assignee"
  , EditPullRequestOption -> Maybe [Text]
editPullRequestOptionAssignees :: !(Maybe [Text]) -- ^ "assignees"
  , EditPullRequestOption -> Maybe Text
editPullRequestOptionBase :: !(Maybe Text) -- ^ "base"
  , EditPullRequestOption -> Maybe Text
editPullRequestOptionBody :: !(Maybe Text) -- ^ "body"
  , EditPullRequestOption -> Maybe DateTime
editPullRequestOptionDueDate :: !(Maybe DateTime) -- ^ "due_date"
  , EditPullRequestOption -> Maybe [Integer]
editPullRequestOptionLabels :: !(Maybe [Integer]) -- ^ "labels"
  , EditPullRequestOption -> Maybe Integer
editPullRequestOptionMilestone :: !(Maybe Integer) -- ^ "milestone"
  , EditPullRequestOption -> Maybe Text
editPullRequestOptionState :: !(Maybe Text) -- ^ "state"
  , EditPullRequestOption -> Maybe Text
editPullRequestOptionTitle :: !(Maybe Text) -- ^ "title"
  , EditPullRequestOption -> Maybe Bool
editPullRequestOptionUnsetDueDate :: !(Maybe Bool) -- ^ "unset_due_date"
  } deriving (Int -> EditPullRequestOption -> ShowS
[EditPullRequestOption] -> ShowS
EditPullRequestOption -> [Char]
(Int -> EditPullRequestOption -> ShowS)
-> (EditPullRequestOption -> [Char])
-> ([EditPullRequestOption] -> ShowS)
-> Show EditPullRequestOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EditPullRequestOption -> ShowS
showsPrec :: Int -> EditPullRequestOption -> ShowS
$cshow :: EditPullRequestOption -> [Char]
show :: EditPullRequestOption -> [Char]
$cshowList :: [EditPullRequestOption] -> ShowS
showList :: [EditPullRequestOption] -> ShowS
P.Show, EditPullRequestOption -> EditPullRequestOption -> Bool
(EditPullRequestOption -> EditPullRequestOption -> Bool)
-> (EditPullRequestOption -> EditPullRequestOption -> Bool)
-> Eq EditPullRequestOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EditPullRequestOption -> EditPullRequestOption -> Bool
== :: EditPullRequestOption -> EditPullRequestOption -> Bool
$c/= :: EditPullRequestOption -> EditPullRequestOption -> Bool
/= :: EditPullRequestOption -> EditPullRequestOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON EditPullRequestOption
instance A.FromJSON EditPullRequestOption where
  parseJSON :: Value -> Parser EditPullRequestOption
parseJSON = [Char]
-> (Object -> Parser EditPullRequestOption)
-> Value
-> Parser EditPullRequestOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"EditPullRequestOption" ((Object -> Parser EditPullRequestOption)
 -> Value -> Parser EditPullRequestOption)
-> (Object -> Parser EditPullRequestOption)
-> Value
-> Parser EditPullRequestOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe DateTime
-> Maybe [Integer]
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> EditPullRequestOption
EditPullRequestOption
      (Maybe Bool
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe Text
 -> Maybe Text
 -> Maybe DateTime
 -> Maybe [Integer]
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> EditPullRequestOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe [Integer]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> EditPullRequestOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allow_maintainer_edit")
      Parser
  (Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe [Integer]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> EditPullRequestOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe [Integer]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> EditPullRequestOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"assignee")
      Parser
  (Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe [Integer]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> EditPullRequestOption)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe [Integer]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> EditPullRequestOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"assignees")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe [Integer]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> EditPullRequestOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe DateTime
      -> Maybe [Integer]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> EditPullRequestOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"base")
      Parser
  (Maybe Text
   -> Maybe DateTime
   -> Maybe [Integer]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> EditPullRequestOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe DateTime
      -> Maybe [Integer]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> EditPullRequestOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"body")
      Parser
  (Maybe DateTime
   -> Maybe [Integer]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> EditPullRequestOption)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe [Integer]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> EditPullRequestOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"due_date")
      Parser
  (Maybe [Integer]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> EditPullRequestOption)
-> Parser (Maybe [Integer])
-> Parser
     (Maybe Integer
      -> Maybe Text -> Maybe Text -> Maybe Bool -> EditPullRequestOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Integer])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"labels")
      Parser
  (Maybe Integer
   -> Maybe Text -> Maybe Text -> Maybe Bool -> EditPullRequestOption)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text -> Maybe Text -> Maybe Bool -> EditPullRequestOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"milestone")
      Parser
  (Maybe Text -> Maybe Text -> Maybe Bool -> EditPullRequestOption)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Bool -> EditPullRequestOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"state")
      Parser (Maybe Text -> Maybe Bool -> EditPullRequestOption)
-> Parser (Maybe Text)
-> Parser (Maybe Bool -> EditPullRequestOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title")
      Parser (Maybe Bool -> EditPullRequestOption)
-> Parser (Maybe Bool) -> Parser EditPullRequestOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"unset_due_date")

-- | ToJSON EditPullRequestOption
instance A.ToJSON EditPullRequestOption where
  toJSON :: EditPullRequestOption -> Value
toJSON EditPullRequestOption {Maybe Bool
Maybe Integer
Maybe [Integer]
Maybe [Text]
Maybe Text
Maybe DateTime
$sel:editPullRequestOptionAllowMaintainerEdit:EditPullRequestOption :: EditPullRequestOption -> Maybe Bool
$sel:editPullRequestOptionAssignee:EditPullRequestOption :: EditPullRequestOption -> Maybe Text
$sel:editPullRequestOptionAssignees:EditPullRequestOption :: EditPullRequestOption -> Maybe [Text]
$sel:editPullRequestOptionBase:EditPullRequestOption :: EditPullRequestOption -> Maybe Text
$sel:editPullRequestOptionBody:EditPullRequestOption :: EditPullRequestOption -> Maybe Text
$sel:editPullRequestOptionDueDate:EditPullRequestOption :: EditPullRequestOption -> Maybe DateTime
$sel:editPullRequestOptionLabels:EditPullRequestOption :: EditPullRequestOption -> Maybe [Integer]
$sel:editPullRequestOptionMilestone:EditPullRequestOption :: EditPullRequestOption -> Maybe Integer
$sel:editPullRequestOptionState:EditPullRequestOption :: EditPullRequestOption -> Maybe Text
$sel:editPullRequestOptionTitle:EditPullRequestOption :: EditPullRequestOption -> Maybe Text
$sel:editPullRequestOptionUnsetDueDate:EditPullRequestOption :: EditPullRequestOption -> Maybe Bool
editPullRequestOptionAllowMaintainerEdit :: Maybe Bool
editPullRequestOptionAssignee :: Maybe Text
editPullRequestOptionAssignees :: Maybe [Text]
editPullRequestOptionBase :: Maybe Text
editPullRequestOptionBody :: Maybe Text
editPullRequestOptionDueDate :: Maybe DateTime
editPullRequestOptionLabels :: Maybe [Integer]
editPullRequestOptionMilestone :: Maybe Integer
editPullRequestOptionState :: Maybe Text
editPullRequestOptionTitle :: Maybe Text
editPullRequestOptionUnsetDueDate :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"allow_maintainer_edit" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editPullRequestOptionAllowMaintainerEdit
      , Key
"assignee" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editPullRequestOptionAssignee
      , Key
"assignees" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
editPullRequestOptionAssignees
      , Key
"base" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editPullRequestOptionBase
      , Key
"body" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editPullRequestOptionBody
      , Key
"due_date" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
editPullRequestOptionDueDate
      , Key
"labels" Key -> Maybe [Integer] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Integer]
editPullRequestOptionLabels
      , Key
"milestone" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
editPullRequestOptionMilestone
      , Key
"state" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editPullRequestOptionState
      , Key
"title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editPullRequestOptionTitle
      , Key
"unset_due_date" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editPullRequestOptionUnsetDueDate
      ]


-- | Construct a value of type 'EditPullRequestOption' (by applying it's required fields, if any)
mkEditPullRequestOption
  :: EditPullRequestOption
mkEditPullRequestOption :: EditPullRequestOption
mkEditPullRequestOption =
  EditPullRequestOption
  { $sel:editPullRequestOptionAllowMaintainerEdit:EditPullRequestOption :: Maybe Bool
editPullRequestOptionAllowMaintainerEdit = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editPullRequestOptionAssignee:EditPullRequestOption :: Maybe Text
editPullRequestOptionAssignee = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editPullRequestOptionAssignees:EditPullRequestOption :: Maybe [Text]
editPullRequestOptionAssignees = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:editPullRequestOptionBase:EditPullRequestOption :: Maybe Text
editPullRequestOptionBase = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editPullRequestOptionBody:EditPullRequestOption :: Maybe Text
editPullRequestOptionBody = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editPullRequestOptionDueDate:EditPullRequestOption :: Maybe DateTime
editPullRequestOptionDueDate = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:editPullRequestOptionLabels:EditPullRequestOption :: Maybe [Integer]
editPullRequestOptionLabels = Maybe [Integer]
forall a. Maybe a
Nothing
  , $sel:editPullRequestOptionMilestone:EditPullRequestOption :: Maybe Integer
editPullRequestOptionMilestone = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:editPullRequestOptionState:EditPullRequestOption :: Maybe Text
editPullRequestOptionState = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editPullRequestOptionTitle:EditPullRequestOption :: Maybe Text
editPullRequestOptionTitle = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editPullRequestOptionUnsetDueDate:EditPullRequestOption :: Maybe Bool
editPullRequestOptionUnsetDueDate = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** EditReactionOption
-- | EditReactionOption
-- EditReactionOption contain the reaction type
data EditReactionOption = EditReactionOption
  { EditReactionOption -> Maybe Text
editReactionOptionContent :: !(Maybe Text) -- ^ "content"
  } deriving (Int -> EditReactionOption -> ShowS
[EditReactionOption] -> ShowS
EditReactionOption -> [Char]
(Int -> EditReactionOption -> ShowS)
-> (EditReactionOption -> [Char])
-> ([EditReactionOption] -> ShowS)
-> Show EditReactionOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EditReactionOption -> ShowS
showsPrec :: Int -> EditReactionOption -> ShowS
$cshow :: EditReactionOption -> [Char]
show :: EditReactionOption -> [Char]
$cshowList :: [EditReactionOption] -> ShowS
showList :: [EditReactionOption] -> ShowS
P.Show, EditReactionOption -> EditReactionOption -> Bool
(EditReactionOption -> EditReactionOption -> Bool)
-> (EditReactionOption -> EditReactionOption -> Bool)
-> Eq EditReactionOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EditReactionOption -> EditReactionOption -> Bool
== :: EditReactionOption -> EditReactionOption -> Bool
$c/= :: EditReactionOption -> EditReactionOption -> Bool
/= :: EditReactionOption -> EditReactionOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON EditReactionOption
instance A.FromJSON EditReactionOption where
  parseJSON :: Value -> Parser EditReactionOption
parseJSON = [Char]
-> (Object -> Parser EditReactionOption)
-> Value
-> Parser EditReactionOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"EditReactionOption" ((Object -> Parser EditReactionOption)
 -> Value -> Parser EditReactionOption)
-> (Object -> Parser EditReactionOption)
-> Value
-> Parser EditReactionOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> EditReactionOption
EditReactionOption
      (Maybe Text -> EditReactionOption)
-> Parser (Maybe Text) -> Parser EditReactionOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"content")

-- | ToJSON EditReactionOption
instance A.ToJSON EditReactionOption where
  toJSON :: EditReactionOption -> Value
toJSON EditReactionOption {Maybe Text
$sel:editReactionOptionContent:EditReactionOption :: EditReactionOption -> Maybe Text
editReactionOptionContent :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"content" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editReactionOptionContent
      ]


-- | Construct a value of type 'EditReactionOption' (by applying it's required fields, if any)
mkEditReactionOption
  :: EditReactionOption
mkEditReactionOption :: EditReactionOption
mkEditReactionOption =
  EditReactionOption
  { $sel:editReactionOptionContent:EditReactionOption :: Maybe Text
editReactionOptionContent = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** EditReleaseOption
-- | EditReleaseOption
-- EditReleaseOption options when editing a release
data EditReleaseOption = EditReleaseOption
  { EditReleaseOption -> Maybe Text
editReleaseOptionBody :: !(Maybe Text) -- ^ "body"
  , EditReleaseOption -> Maybe Bool
editReleaseOptionDraft :: !(Maybe Bool) -- ^ "draft"
  , EditReleaseOption -> Maybe Text
editReleaseOptionName :: !(Maybe Text) -- ^ "name"
  , EditReleaseOption -> Maybe Bool
editReleaseOptionPrerelease :: !(Maybe Bool) -- ^ "prerelease"
  , EditReleaseOption -> Maybe Text
editReleaseOptionTagName :: !(Maybe Text) -- ^ "tag_name"
  , EditReleaseOption -> Maybe Text
editReleaseOptionTargetCommitish :: !(Maybe Text) -- ^ "target_commitish"
  } deriving (Int -> EditReleaseOption -> ShowS
[EditReleaseOption] -> ShowS
EditReleaseOption -> [Char]
(Int -> EditReleaseOption -> ShowS)
-> (EditReleaseOption -> [Char])
-> ([EditReleaseOption] -> ShowS)
-> Show EditReleaseOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EditReleaseOption -> ShowS
showsPrec :: Int -> EditReleaseOption -> ShowS
$cshow :: EditReleaseOption -> [Char]
show :: EditReleaseOption -> [Char]
$cshowList :: [EditReleaseOption] -> ShowS
showList :: [EditReleaseOption] -> ShowS
P.Show, EditReleaseOption -> EditReleaseOption -> Bool
(EditReleaseOption -> EditReleaseOption -> Bool)
-> (EditReleaseOption -> EditReleaseOption -> Bool)
-> Eq EditReleaseOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EditReleaseOption -> EditReleaseOption -> Bool
== :: EditReleaseOption -> EditReleaseOption -> Bool
$c/= :: EditReleaseOption -> EditReleaseOption -> Bool
/= :: EditReleaseOption -> EditReleaseOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON EditReleaseOption
instance A.FromJSON EditReleaseOption where
  parseJSON :: Value -> Parser EditReleaseOption
parseJSON = [Char]
-> (Object -> Parser EditReleaseOption)
-> Value
-> Parser EditReleaseOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"EditReleaseOption" ((Object -> Parser EditReleaseOption)
 -> Value -> Parser EditReleaseOption)
-> (Object -> Parser EditReleaseOption)
-> Value
-> Parser EditReleaseOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> EditReleaseOption
EditReleaseOption
      (Maybe Text
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Text
 -> EditReleaseOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> EditReleaseOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"body")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> EditReleaseOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Bool -> Maybe Text -> Maybe Text -> EditReleaseOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"draft")
      Parser
  (Maybe Text
   -> Maybe Bool -> Maybe Text -> Maybe Text -> EditReleaseOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool -> Maybe Text -> Maybe Text -> EditReleaseOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser
  (Maybe Bool -> Maybe Text -> Maybe Text -> EditReleaseOption)
-> Parser (Maybe Bool)
-> Parser (Maybe Text -> Maybe Text -> EditReleaseOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prerelease")
      Parser (Maybe Text -> Maybe Text -> EditReleaseOption)
-> Parser (Maybe Text) -> Parser (Maybe Text -> EditReleaseOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tag_name")
      Parser (Maybe Text -> EditReleaseOption)
-> Parser (Maybe Text) -> Parser EditReleaseOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"target_commitish")

-- | ToJSON EditReleaseOption
instance A.ToJSON EditReleaseOption where
  toJSON :: EditReleaseOption -> Value
toJSON EditReleaseOption {Maybe Bool
Maybe Text
$sel:editReleaseOptionBody:EditReleaseOption :: EditReleaseOption -> Maybe Text
$sel:editReleaseOptionDraft:EditReleaseOption :: EditReleaseOption -> Maybe Bool
$sel:editReleaseOptionName:EditReleaseOption :: EditReleaseOption -> Maybe Text
$sel:editReleaseOptionPrerelease:EditReleaseOption :: EditReleaseOption -> Maybe Bool
$sel:editReleaseOptionTagName:EditReleaseOption :: EditReleaseOption -> Maybe Text
$sel:editReleaseOptionTargetCommitish:EditReleaseOption :: EditReleaseOption -> Maybe Text
editReleaseOptionBody :: Maybe Text
editReleaseOptionDraft :: Maybe Bool
editReleaseOptionName :: Maybe Text
editReleaseOptionPrerelease :: Maybe Bool
editReleaseOptionTagName :: Maybe Text
editReleaseOptionTargetCommitish :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"body" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editReleaseOptionBody
      , Key
"draft" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editReleaseOptionDraft
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editReleaseOptionName
      , Key
"prerelease" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editReleaseOptionPrerelease
      , Key
"tag_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editReleaseOptionTagName
      , Key
"target_commitish" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editReleaseOptionTargetCommitish
      ]


-- | Construct a value of type 'EditReleaseOption' (by applying it's required fields, if any)
mkEditReleaseOption
  :: EditReleaseOption
mkEditReleaseOption :: EditReleaseOption
mkEditReleaseOption =
  EditReleaseOption
  { $sel:editReleaseOptionBody:EditReleaseOption :: Maybe Text
editReleaseOptionBody = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editReleaseOptionDraft:EditReleaseOption :: Maybe Bool
editReleaseOptionDraft = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editReleaseOptionName:EditReleaseOption :: Maybe Text
editReleaseOptionName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editReleaseOptionPrerelease:EditReleaseOption :: Maybe Bool
editReleaseOptionPrerelease = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editReleaseOptionTagName:EditReleaseOption :: Maybe Text
editReleaseOptionTagName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editReleaseOptionTargetCommitish:EditReleaseOption :: Maybe Text
editReleaseOptionTargetCommitish = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** EditRepoOption
-- | EditRepoOption
-- EditRepoOption options when editing a repository's properties
data EditRepoOption = EditRepoOption
  { EditRepoOption -> Maybe Bool
editRepoOptionAllowFastForwardOnlyMerge :: !(Maybe Bool) -- ^ "allow_fast_forward_only_merge" - either &#x60;true&#x60; to allow fast-forward-only merging pull requests, or &#x60;false&#x60; to prevent fast-forward-only merging.
  , EditRepoOption -> Maybe Bool
editRepoOptionAllowManualMerge :: !(Maybe Bool) -- ^ "allow_manual_merge" - either &#x60;true&#x60; to allow mark pr as merged manually, or &#x60;false&#x60; to prevent it.
  , EditRepoOption -> Maybe Bool
editRepoOptionAllowMergeCommits :: !(Maybe Bool) -- ^ "allow_merge_commits" - either &#x60;true&#x60; to allow merging pull requests with a merge commit, or &#x60;false&#x60; to prevent merging pull requests with merge commits.
  , EditRepoOption -> Maybe Bool
editRepoOptionAllowRebase :: !(Maybe Bool) -- ^ "allow_rebase" - either &#x60;true&#x60; to allow rebase-merging pull requests, or &#x60;false&#x60; to prevent rebase-merging.
  , EditRepoOption -> Maybe Bool
editRepoOptionAllowRebaseExplicit :: !(Maybe Bool) -- ^ "allow_rebase_explicit" - either &#x60;true&#x60; to allow rebase with explicit merge commits (--no-ff), or &#x60;false&#x60; to prevent rebase with explicit merge commits.
  , EditRepoOption -> Maybe Bool
editRepoOptionAllowRebaseUpdate :: !(Maybe Bool) -- ^ "allow_rebase_update" - either &#x60;true&#x60; to allow updating pull request branch by rebase, or &#x60;false&#x60; to prevent it.
  , EditRepoOption -> Maybe Bool
editRepoOptionAllowSquashMerge :: !(Maybe Bool) -- ^ "allow_squash_merge" - either &#x60;true&#x60; to allow squash-merging pull requests, or &#x60;false&#x60; to prevent squash-merging.
  , EditRepoOption -> Maybe Bool
editRepoOptionArchived :: !(Maybe Bool) -- ^ "archived" - set to &#x60;true&#x60; to archive this repository.
  , EditRepoOption -> Maybe Bool
editRepoOptionAutodetectManualMerge :: !(Maybe Bool) -- ^ "autodetect_manual_merge" - either &#x60;true&#x60; to enable AutodetectManualMerge, or &#x60;false&#x60; to prevent it. Note: In some special cases, misjudgments can occur.
  , EditRepoOption -> Maybe Bool
editRepoOptionDefaultAllowMaintainerEdit :: !(Maybe Bool) -- ^ "default_allow_maintainer_edit" - set to &#x60;true&#x60; to allow edits from maintainers by default
  , EditRepoOption -> Maybe Text
editRepoOptionDefaultBranch :: !(Maybe Text) -- ^ "default_branch" - sets the default branch for this repository.
  , EditRepoOption -> Maybe Bool
editRepoOptionDefaultDeleteBranchAfterMerge :: !(Maybe Bool) -- ^ "default_delete_branch_after_merge" - set to &#x60;true&#x60; to delete pr branch after merge by default
  , EditRepoOption -> Maybe Text
editRepoOptionDefaultMergeStyle :: !(Maybe Text) -- ^ "default_merge_style" - set to a merge style to be used by this repository: \&quot;merge\&quot;, \&quot;rebase\&quot;, \&quot;rebase-merge\&quot;, \&quot;squash\&quot;, or \&quot;fast-forward-only\&quot;.
  , EditRepoOption -> Maybe Text
editRepoOptionDescription :: !(Maybe Text) -- ^ "description" - a short description of the repository.
  , EditRepoOption -> Maybe Bool
editRepoOptionEnablePrune :: !(Maybe Bool) -- ^ "enable_prune" - enable prune - remove obsolete remote-tracking references when mirroring
  , EditRepoOption -> Maybe ExternalTracker
editRepoOptionExternalTracker :: !(Maybe ExternalTracker) -- ^ "external_tracker"
  , EditRepoOption -> Maybe ExternalWiki
editRepoOptionExternalWiki :: !(Maybe ExternalWiki) -- ^ "external_wiki"
  , EditRepoOption -> Maybe Bool
editRepoOptionHasActions :: !(Maybe Bool) -- ^ "has_actions" - either &#x60;true&#x60; to enable actions unit, or &#x60;false&#x60; to disable them.
  , EditRepoOption -> Maybe Bool
editRepoOptionHasIssues :: !(Maybe Bool) -- ^ "has_issues" - either &#x60;true&#x60; to enable issues for this repository or &#x60;false&#x60; to disable them.
  , EditRepoOption -> Maybe Bool
editRepoOptionHasPackages :: !(Maybe Bool) -- ^ "has_packages" - either &#x60;true&#x60; to enable packages unit, or &#x60;false&#x60; to disable them.
  , EditRepoOption -> Maybe Bool
editRepoOptionHasProjects :: !(Maybe Bool) -- ^ "has_projects" - either &#x60;true&#x60; to enable project unit, or &#x60;false&#x60; to disable them.
  , EditRepoOption -> Maybe Bool
editRepoOptionHasPullRequests :: !(Maybe Bool) -- ^ "has_pull_requests" - either &#x60;true&#x60; to allow pull requests, or &#x60;false&#x60; to prevent pull request.
  , EditRepoOption -> Maybe Bool
editRepoOptionHasReleases :: !(Maybe Bool) -- ^ "has_releases" - either &#x60;true&#x60; to enable releases unit, or &#x60;false&#x60; to disable them.
  , EditRepoOption -> Maybe Bool
editRepoOptionHasWiki :: !(Maybe Bool) -- ^ "has_wiki" - either &#x60;true&#x60; to enable the wiki for this repository or &#x60;false&#x60; to disable it.
  , EditRepoOption -> Maybe Bool
editRepoOptionIgnoreWhitespaceConflicts :: !(Maybe Bool) -- ^ "ignore_whitespace_conflicts" - either &#x60;true&#x60; to ignore whitespace for conflicts, or &#x60;false&#x60; to not ignore whitespace.
  , EditRepoOption -> Maybe InternalTracker
editRepoOptionInternalTracker :: !(Maybe InternalTracker) -- ^ "internal_tracker"
  , EditRepoOption -> Maybe Text
editRepoOptionMirrorInterval :: !(Maybe Text) -- ^ "mirror_interval" - set to a string like &#x60;8h30m0s&#x60; to set the mirror interval time
  , EditRepoOption -> Maybe Text
editRepoOptionName :: !(Maybe Text) -- ^ "name" - name of the repository
  , EditRepoOption -> Maybe Bool
editRepoOptionPrivate :: !(Maybe Bool) -- ^ "private" - either &#x60;true&#x60; to make the repository private or &#x60;false&#x60; to make it public. Note: you will get a 422 error if the organization restricts changing repository visibility to organization owners and a non-owner tries to change the value of private.
  , EditRepoOption -> Maybe Text
editRepoOptionProjectsMode :: !(Maybe Text) -- ^ "projects_mode" - &#x60;repo&#x60; to only allow repo-level projects, &#x60;owner&#x60; to only allow owner projects, &#x60;all&#x60; to allow both.
  , EditRepoOption -> Maybe Bool
editRepoOptionTemplate :: !(Maybe Bool) -- ^ "template" - either &#x60;true&#x60; to make this repository a template or &#x60;false&#x60; to make it a normal repository
  , EditRepoOption -> Maybe Text
editRepoOptionWebsite :: !(Maybe Text) -- ^ "website" - a URL with more information about the repository.
  } deriving (Int -> EditRepoOption -> ShowS
[EditRepoOption] -> ShowS
EditRepoOption -> [Char]
(Int -> EditRepoOption -> ShowS)
-> (EditRepoOption -> [Char])
-> ([EditRepoOption] -> ShowS)
-> Show EditRepoOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EditRepoOption -> ShowS
showsPrec :: Int -> EditRepoOption -> ShowS
$cshow :: EditRepoOption -> [Char]
show :: EditRepoOption -> [Char]
$cshowList :: [EditRepoOption] -> ShowS
showList :: [EditRepoOption] -> ShowS
P.Show, EditRepoOption -> EditRepoOption -> Bool
(EditRepoOption -> EditRepoOption -> Bool)
-> (EditRepoOption -> EditRepoOption -> Bool) -> Eq EditRepoOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EditRepoOption -> EditRepoOption -> Bool
== :: EditRepoOption -> EditRepoOption -> Bool
$c/= :: EditRepoOption -> EditRepoOption -> Bool
/= :: EditRepoOption -> EditRepoOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON EditRepoOption
instance A.FromJSON EditRepoOption where
  parseJSON :: Value -> Parser EditRepoOption
parseJSON = [Char]
-> (Object -> Parser EditRepoOption)
-> Value
-> Parser EditRepoOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"EditRepoOption" ((Object -> Parser EditRepoOption)
 -> Value -> Parser EditRepoOption)
-> (Object -> Parser EditRepoOption)
-> Value
-> Parser EditRepoOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe ExternalTracker
-> Maybe ExternalWiki
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe InternalTracker
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> EditRepoOption
EditRepoOption
      (Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Maybe ExternalTracker
 -> Maybe ExternalWiki
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe InternalTracker
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Text
 -> EditRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allow_fast_forward_only_merge")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allow_manual_merge")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allow_merge_commits")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allow_rebase")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allow_rebase_explicit")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allow_rebase_update")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allow_squash_merge")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"archived")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"autodetect_manual_merge")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"default_allow_maintainer_edit")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"default_branch")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"default_delete_branch_after_merge")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"default_merge_style")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enable_prune")
      Parser
  (Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe ExternalTracker)
-> Parser
     (Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe ExternalTracker)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"external_tracker")
      Parser
  (Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe ExternalWiki)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe ExternalWiki)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"external_wiki")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"has_actions")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"has_issues")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"has_packages")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"has_projects")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"has_pull_requests")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"has_releases")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"has_wiki")
      Parser
  (Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ignore_whitespace_conflicts")
      Parser
  (Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe InternalTracker)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe InternalTracker)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"internal_tracker")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mirror_interval")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> EditRepoOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Text -> Maybe Bool -> Maybe Text -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser
  (Maybe Bool
   -> Maybe Text -> Maybe Bool -> Maybe Text -> EditRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text -> Maybe Bool -> Maybe Text -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"private")
      Parser (Maybe Text -> Maybe Bool -> Maybe Text -> EditRepoOption)
-> Parser (Maybe Text)
-> Parser (Maybe Bool -> Maybe Text -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"projects_mode")
      Parser (Maybe Bool -> Maybe Text -> EditRepoOption)
-> Parser (Maybe Bool) -> Parser (Maybe Text -> EditRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"template")
      Parser (Maybe Text -> EditRepoOption)
-> Parser (Maybe Text) -> Parser EditRepoOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"website")

-- | ToJSON EditRepoOption
instance A.ToJSON EditRepoOption where
  toJSON :: EditRepoOption -> Value
toJSON EditRepoOption {Maybe Bool
Maybe Text
Maybe InternalTracker
Maybe ExternalWiki
Maybe ExternalTracker
$sel:editRepoOptionAllowFastForwardOnlyMerge:EditRepoOption :: EditRepoOption -> Maybe Bool
$sel:editRepoOptionAllowManualMerge:EditRepoOption :: EditRepoOption -> Maybe Bool
$sel:editRepoOptionAllowMergeCommits:EditRepoOption :: EditRepoOption -> Maybe Bool
$sel:editRepoOptionAllowRebase:EditRepoOption :: EditRepoOption -> Maybe Bool
$sel:editRepoOptionAllowRebaseExplicit:EditRepoOption :: EditRepoOption -> Maybe Bool
$sel:editRepoOptionAllowRebaseUpdate:EditRepoOption :: EditRepoOption -> Maybe Bool
$sel:editRepoOptionAllowSquashMerge:EditRepoOption :: EditRepoOption -> Maybe Bool
$sel:editRepoOptionArchived:EditRepoOption :: EditRepoOption -> Maybe Bool
$sel:editRepoOptionAutodetectManualMerge:EditRepoOption :: EditRepoOption -> Maybe Bool
$sel:editRepoOptionDefaultAllowMaintainerEdit:EditRepoOption :: EditRepoOption -> Maybe Bool
$sel:editRepoOptionDefaultBranch:EditRepoOption :: EditRepoOption -> Maybe Text
$sel:editRepoOptionDefaultDeleteBranchAfterMerge:EditRepoOption :: EditRepoOption -> Maybe Bool
$sel:editRepoOptionDefaultMergeStyle:EditRepoOption :: EditRepoOption -> Maybe Text
$sel:editRepoOptionDescription:EditRepoOption :: EditRepoOption -> Maybe Text
$sel:editRepoOptionEnablePrune:EditRepoOption :: EditRepoOption -> Maybe Bool
$sel:editRepoOptionExternalTracker:EditRepoOption :: EditRepoOption -> Maybe ExternalTracker
$sel:editRepoOptionExternalWiki:EditRepoOption :: EditRepoOption -> Maybe ExternalWiki
$sel:editRepoOptionHasActions:EditRepoOption :: EditRepoOption -> Maybe Bool
$sel:editRepoOptionHasIssues:EditRepoOption :: EditRepoOption -> Maybe Bool
$sel:editRepoOptionHasPackages:EditRepoOption :: EditRepoOption -> Maybe Bool
$sel:editRepoOptionHasProjects:EditRepoOption :: EditRepoOption -> Maybe Bool
$sel:editRepoOptionHasPullRequests:EditRepoOption :: EditRepoOption -> Maybe Bool
$sel:editRepoOptionHasReleases:EditRepoOption :: EditRepoOption -> Maybe Bool
$sel:editRepoOptionHasWiki:EditRepoOption :: EditRepoOption -> Maybe Bool
$sel:editRepoOptionIgnoreWhitespaceConflicts:EditRepoOption :: EditRepoOption -> Maybe Bool
$sel:editRepoOptionInternalTracker:EditRepoOption :: EditRepoOption -> Maybe InternalTracker
$sel:editRepoOptionMirrorInterval:EditRepoOption :: EditRepoOption -> Maybe Text
$sel:editRepoOptionName:EditRepoOption :: EditRepoOption -> Maybe Text
$sel:editRepoOptionPrivate:EditRepoOption :: EditRepoOption -> Maybe Bool
$sel:editRepoOptionProjectsMode:EditRepoOption :: EditRepoOption -> Maybe Text
$sel:editRepoOptionTemplate:EditRepoOption :: EditRepoOption -> Maybe Bool
$sel:editRepoOptionWebsite:EditRepoOption :: EditRepoOption -> Maybe Text
editRepoOptionAllowFastForwardOnlyMerge :: Maybe Bool
editRepoOptionAllowManualMerge :: Maybe Bool
editRepoOptionAllowMergeCommits :: Maybe Bool
editRepoOptionAllowRebase :: Maybe Bool
editRepoOptionAllowRebaseExplicit :: Maybe Bool
editRepoOptionAllowRebaseUpdate :: Maybe Bool
editRepoOptionAllowSquashMerge :: Maybe Bool
editRepoOptionArchived :: Maybe Bool
editRepoOptionAutodetectManualMerge :: Maybe Bool
editRepoOptionDefaultAllowMaintainerEdit :: Maybe Bool
editRepoOptionDefaultBranch :: Maybe Text
editRepoOptionDefaultDeleteBranchAfterMerge :: Maybe Bool
editRepoOptionDefaultMergeStyle :: Maybe Text
editRepoOptionDescription :: Maybe Text
editRepoOptionEnablePrune :: Maybe Bool
editRepoOptionExternalTracker :: Maybe ExternalTracker
editRepoOptionExternalWiki :: Maybe ExternalWiki
editRepoOptionHasActions :: Maybe Bool
editRepoOptionHasIssues :: Maybe Bool
editRepoOptionHasPackages :: Maybe Bool
editRepoOptionHasProjects :: Maybe Bool
editRepoOptionHasPullRequests :: Maybe Bool
editRepoOptionHasReleases :: Maybe Bool
editRepoOptionHasWiki :: Maybe Bool
editRepoOptionIgnoreWhitespaceConflicts :: Maybe Bool
editRepoOptionInternalTracker :: Maybe InternalTracker
editRepoOptionMirrorInterval :: Maybe Text
editRepoOptionName :: Maybe Text
editRepoOptionPrivate :: Maybe Bool
editRepoOptionProjectsMode :: Maybe Text
editRepoOptionTemplate :: Maybe Bool
editRepoOptionWebsite :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"allow_fast_forward_only_merge" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editRepoOptionAllowFastForwardOnlyMerge
      , Key
"allow_manual_merge" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editRepoOptionAllowManualMerge
      , Key
"allow_merge_commits" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editRepoOptionAllowMergeCommits
      , Key
"allow_rebase" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editRepoOptionAllowRebase
      , Key
"allow_rebase_explicit" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editRepoOptionAllowRebaseExplicit
      , Key
"allow_rebase_update" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editRepoOptionAllowRebaseUpdate
      , Key
"allow_squash_merge" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editRepoOptionAllowSquashMerge
      , Key
"archived" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editRepoOptionArchived
      , Key
"autodetect_manual_merge" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editRepoOptionAutodetectManualMerge
      , Key
"default_allow_maintainer_edit" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editRepoOptionDefaultAllowMaintainerEdit
      , Key
"default_branch" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editRepoOptionDefaultBranch
      , Key
"default_delete_branch_after_merge" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editRepoOptionDefaultDeleteBranchAfterMerge
      , Key
"default_merge_style" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editRepoOptionDefaultMergeStyle
      , Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editRepoOptionDescription
      , Key
"enable_prune" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editRepoOptionEnablePrune
      , Key
"external_tracker" Key -> Maybe ExternalTracker -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe ExternalTracker
editRepoOptionExternalTracker
      , Key
"external_wiki" Key -> Maybe ExternalWiki -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe ExternalWiki
editRepoOptionExternalWiki
      , Key
"has_actions" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editRepoOptionHasActions
      , Key
"has_issues" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editRepoOptionHasIssues
      , Key
"has_packages" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editRepoOptionHasPackages
      , Key
"has_projects" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editRepoOptionHasProjects
      , Key
"has_pull_requests" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editRepoOptionHasPullRequests
      , Key
"has_releases" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editRepoOptionHasReleases
      , Key
"has_wiki" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editRepoOptionHasWiki
      , Key
"ignore_whitespace_conflicts" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editRepoOptionIgnoreWhitespaceConflicts
      , Key
"internal_tracker" Key -> Maybe InternalTracker -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe InternalTracker
editRepoOptionInternalTracker
      , Key
"mirror_interval" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editRepoOptionMirrorInterval
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editRepoOptionName
      , Key
"private" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editRepoOptionPrivate
      , Key
"projects_mode" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editRepoOptionProjectsMode
      , Key
"template" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editRepoOptionTemplate
      , Key
"website" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editRepoOptionWebsite
      ]


-- | Construct a value of type 'EditRepoOption' (by applying it's required fields, if any)
mkEditRepoOption
  :: EditRepoOption
mkEditRepoOption :: EditRepoOption
mkEditRepoOption =
  EditRepoOption
  { $sel:editRepoOptionAllowFastForwardOnlyMerge:EditRepoOption :: Maybe Bool
editRepoOptionAllowFastForwardOnlyMerge = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editRepoOptionAllowManualMerge:EditRepoOption :: Maybe Bool
editRepoOptionAllowManualMerge = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editRepoOptionAllowMergeCommits:EditRepoOption :: Maybe Bool
editRepoOptionAllowMergeCommits = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editRepoOptionAllowRebase:EditRepoOption :: Maybe Bool
editRepoOptionAllowRebase = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editRepoOptionAllowRebaseExplicit:EditRepoOption :: Maybe Bool
editRepoOptionAllowRebaseExplicit = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editRepoOptionAllowRebaseUpdate:EditRepoOption :: Maybe Bool
editRepoOptionAllowRebaseUpdate = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editRepoOptionAllowSquashMerge:EditRepoOption :: Maybe Bool
editRepoOptionAllowSquashMerge = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editRepoOptionArchived:EditRepoOption :: Maybe Bool
editRepoOptionArchived = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editRepoOptionAutodetectManualMerge:EditRepoOption :: Maybe Bool
editRepoOptionAutodetectManualMerge = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editRepoOptionDefaultAllowMaintainerEdit:EditRepoOption :: Maybe Bool
editRepoOptionDefaultAllowMaintainerEdit = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editRepoOptionDefaultBranch:EditRepoOption :: Maybe Text
editRepoOptionDefaultBranch = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editRepoOptionDefaultDeleteBranchAfterMerge:EditRepoOption :: Maybe Bool
editRepoOptionDefaultDeleteBranchAfterMerge = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editRepoOptionDefaultMergeStyle:EditRepoOption :: Maybe Text
editRepoOptionDefaultMergeStyle = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editRepoOptionDescription:EditRepoOption :: Maybe Text
editRepoOptionDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editRepoOptionEnablePrune:EditRepoOption :: Maybe Bool
editRepoOptionEnablePrune = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editRepoOptionExternalTracker:EditRepoOption :: Maybe ExternalTracker
editRepoOptionExternalTracker = Maybe ExternalTracker
forall a. Maybe a
Nothing
  , $sel:editRepoOptionExternalWiki:EditRepoOption :: Maybe ExternalWiki
editRepoOptionExternalWiki = Maybe ExternalWiki
forall a. Maybe a
Nothing
  , $sel:editRepoOptionHasActions:EditRepoOption :: Maybe Bool
editRepoOptionHasActions = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editRepoOptionHasIssues:EditRepoOption :: Maybe Bool
editRepoOptionHasIssues = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editRepoOptionHasPackages:EditRepoOption :: Maybe Bool
editRepoOptionHasPackages = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editRepoOptionHasProjects:EditRepoOption :: Maybe Bool
editRepoOptionHasProjects = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editRepoOptionHasPullRequests:EditRepoOption :: Maybe Bool
editRepoOptionHasPullRequests = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editRepoOptionHasReleases:EditRepoOption :: Maybe Bool
editRepoOptionHasReleases = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editRepoOptionHasWiki:EditRepoOption :: Maybe Bool
editRepoOptionHasWiki = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editRepoOptionIgnoreWhitespaceConflicts:EditRepoOption :: Maybe Bool
editRepoOptionIgnoreWhitespaceConflicts = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editRepoOptionInternalTracker:EditRepoOption :: Maybe InternalTracker
editRepoOptionInternalTracker = Maybe InternalTracker
forall a. Maybe a
Nothing
  , $sel:editRepoOptionMirrorInterval:EditRepoOption :: Maybe Text
editRepoOptionMirrorInterval = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editRepoOptionName:EditRepoOption :: Maybe Text
editRepoOptionName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editRepoOptionPrivate:EditRepoOption :: Maybe Bool
editRepoOptionPrivate = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editRepoOptionProjectsMode:EditRepoOption :: Maybe Text
editRepoOptionProjectsMode = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editRepoOptionTemplate:EditRepoOption :: Maybe Bool
editRepoOptionTemplate = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editRepoOptionWebsite:EditRepoOption :: Maybe Text
editRepoOptionWebsite = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** EditTagProtectionOption
-- | EditTagProtectionOption
-- EditTagProtectionOption options for editing a tag protection
data EditTagProtectionOption = EditTagProtectionOption
  { EditTagProtectionOption -> Maybe Text
editTagProtectionOptionNamePattern :: !(Maybe Text) -- ^ "name_pattern"
  , EditTagProtectionOption -> Maybe [Text]
editTagProtectionOptionWhitelistTeams :: !(Maybe [Text]) -- ^ "whitelist_teams"
  , EditTagProtectionOption -> Maybe [Text]
editTagProtectionOptionWhitelistUsernames :: !(Maybe [Text]) -- ^ "whitelist_usernames"
  } deriving (Int -> EditTagProtectionOption -> ShowS
[EditTagProtectionOption] -> ShowS
EditTagProtectionOption -> [Char]
(Int -> EditTagProtectionOption -> ShowS)
-> (EditTagProtectionOption -> [Char])
-> ([EditTagProtectionOption] -> ShowS)
-> Show EditTagProtectionOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EditTagProtectionOption -> ShowS
showsPrec :: Int -> EditTagProtectionOption -> ShowS
$cshow :: EditTagProtectionOption -> [Char]
show :: EditTagProtectionOption -> [Char]
$cshowList :: [EditTagProtectionOption] -> ShowS
showList :: [EditTagProtectionOption] -> ShowS
P.Show, EditTagProtectionOption -> EditTagProtectionOption -> Bool
(EditTagProtectionOption -> EditTagProtectionOption -> Bool)
-> (EditTagProtectionOption -> EditTagProtectionOption -> Bool)
-> Eq EditTagProtectionOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EditTagProtectionOption -> EditTagProtectionOption -> Bool
== :: EditTagProtectionOption -> EditTagProtectionOption -> Bool
$c/= :: EditTagProtectionOption -> EditTagProtectionOption -> Bool
/= :: EditTagProtectionOption -> EditTagProtectionOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON EditTagProtectionOption
instance A.FromJSON EditTagProtectionOption where
  parseJSON :: Value -> Parser EditTagProtectionOption
parseJSON = [Char]
-> (Object -> Parser EditTagProtectionOption)
-> Value
-> Parser EditTagProtectionOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"EditTagProtectionOption" ((Object -> Parser EditTagProtectionOption)
 -> Value -> Parser EditTagProtectionOption)
-> (Object -> Parser EditTagProtectionOption)
-> Value
-> Parser EditTagProtectionOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe [Text] -> Maybe [Text] -> EditTagProtectionOption
EditTagProtectionOption
      (Maybe Text
 -> Maybe [Text] -> Maybe [Text] -> EditTagProtectionOption)
-> Parser (Maybe Text)
-> Parser (Maybe [Text] -> Maybe [Text] -> EditTagProtectionOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name_pattern")
      Parser (Maybe [Text] -> Maybe [Text] -> EditTagProtectionOption)
-> Parser (Maybe [Text])
-> Parser (Maybe [Text] -> EditTagProtectionOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"whitelist_teams")
      Parser (Maybe [Text] -> EditTagProtectionOption)
-> Parser (Maybe [Text]) -> Parser EditTagProtectionOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"whitelist_usernames")

-- | ToJSON EditTagProtectionOption
instance A.ToJSON EditTagProtectionOption where
  toJSON :: EditTagProtectionOption -> Value
toJSON EditTagProtectionOption {Maybe [Text]
Maybe Text
$sel:editTagProtectionOptionNamePattern:EditTagProtectionOption :: EditTagProtectionOption -> Maybe Text
$sel:editTagProtectionOptionWhitelistTeams:EditTagProtectionOption :: EditTagProtectionOption -> Maybe [Text]
$sel:editTagProtectionOptionWhitelistUsernames:EditTagProtectionOption :: EditTagProtectionOption -> Maybe [Text]
editTagProtectionOptionNamePattern :: Maybe Text
editTagProtectionOptionWhitelistTeams :: Maybe [Text]
editTagProtectionOptionWhitelistUsernames :: Maybe [Text]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"name_pattern" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editTagProtectionOptionNamePattern
      , Key
"whitelist_teams" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
editTagProtectionOptionWhitelistTeams
      , Key
"whitelist_usernames" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
editTagProtectionOptionWhitelistUsernames
      ]


-- | Construct a value of type 'EditTagProtectionOption' (by applying it's required fields, if any)
mkEditTagProtectionOption
  :: EditTagProtectionOption
mkEditTagProtectionOption :: EditTagProtectionOption
mkEditTagProtectionOption =
  EditTagProtectionOption
  { $sel:editTagProtectionOptionNamePattern:EditTagProtectionOption :: Maybe Text
editTagProtectionOptionNamePattern = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editTagProtectionOptionWhitelistTeams:EditTagProtectionOption :: Maybe [Text]
editTagProtectionOptionWhitelistTeams = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:editTagProtectionOptionWhitelistUsernames:EditTagProtectionOption :: Maybe [Text]
editTagProtectionOptionWhitelistUsernames = Maybe [Text]
forall a. Maybe a
Nothing
  }

-- ** EditTeamOption
-- | EditTeamOption
-- EditTeamOption options for editing a team
data EditTeamOption = EditTeamOption
  { EditTeamOption -> Maybe Bool
editTeamOptionCanCreateOrgRepo :: !(Maybe Bool) -- ^ "can_create_org_repo"
  , EditTeamOption -> Maybe Text
editTeamOptionDescription :: !(Maybe Text) -- ^ "description"
  , EditTeamOption -> Maybe Bool
editTeamOptionIncludesAllRepositories :: !(Maybe Bool) -- ^ "includes_all_repositories"
  , EditTeamOption -> Text
editTeamOptionName :: !(Text) -- ^ /Required/ "name"
  , EditTeamOption -> Maybe E'Permission
editTeamOptionPermission :: !(Maybe E'Permission) -- ^ "permission"
  , EditTeamOption -> Maybe [Text]
editTeamOptionUnits :: !(Maybe [Text]) -- ^ "units"
  , EditTeamOption -> Maybe (Map [Char] Text)
editTeamOptionUnitsMap :: !(Maybe (Map.Map String Text)) -- ^ "units_map"
  } deriving (Int -> EditTeamOption -> ShowS
[EditTeamOption] -> ShowS
EditTeamOption -> [Char]
(Int -> EditTeamOption -> ShowS)
-> (EditTeamOption -> [Char])
-> ([EditTeamOption] -> ShowS)
-> Show EditTeamOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EditTeamOption -> ShowS
showsPrec :: Int -> EditTeamOption -> ShowS
$cshow :: EditTeamOption -> [Char]
show :: EditTeamOption -> [Char]
$cshowList :: [EditTeamOption] -> ShowS
showList :: [EditTeamOption] -> ShowS
P.Show, EditTeamOption -> EditTeamOption -> Bool
(EditTeamOption -> EditTeamOption -> Bool)
-> (EditTeamOption -> EditTeamOption -> Bool) -> Eq EditTeamOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EditTeamOption -> EditTeamOption -> Bool
== :: EditTeamOption -> EditTeamOption -> Bool
$c/= :: EditTeamOption -> EditTeamOption -> Bool
/= :: EditTeamOption -> EditTeamOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON EditTeamOption
instance A.FromJSON EditTeamOption where
  parseJSON :: Value -> Parser EditTeamOption
parseJSON = [Char]
-> (Object -> Parser EditTeamOption)
-> Value
-> Parser EditTeamOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"EditTeamOption" ((Object -> Parser EditTeamOption)
 -> Value -> Parser EditTeamOption)
-> (Object -> Parser EditTeamOption)
-> Value
-> Parser EditTeamOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool
-> Maybe Text
-> Maybe Bool
-> Text
-> Maybe E'Permission
-> Maybe [Text]
-> Maybe (Map [Char] Text)
-> EditTeamOption
EditTeamOption
      (Maybe Bool
 -> Maybe Text
 -> Maybe Bool
 -> Text
 -> Maybe E'Permission
 -> Maybe [Text]
 -> Maybe (Map [Char] Text)
 -> EditTeamOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Text
      -> Maybe E'Permission
      -> Maybe [Text]
      -> Maybe (Map [Char] Text)
      -> EditTeamOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"can_create_org_repo")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Text
   -> Maybe E'Permission
   -> Maybe [Text]
   -> Maybe (Map [Char] Text)
   -> EditTeamOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Text
      -> Maybe E'Permission
      -> Maybe [Text]
      -> Maybe (Map [Char] Text)
      -> EditTeamOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe Bool
   -> Text
   -> Maybe E'Permission
   -> Maybe [Text]
   -> Maybe (Map [Char] Text)
   -> EditTeamOption)
-> Parser (Maybe Bool)
-> Parser
     (Text
      -> Maybe E'Permission
      -> Maybe [Text]
      -> Maybe (Map [Char] Text)
      -> EditTeamOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"includes_all_repositories")
      Parser
  (Text
   -> Maybe E'Permission
   -> Maybe [Text]
   -> Maybe (Map [Char] Text)
   -> EditTeamOption)
-> Parser Text
-> Parser
     (Maybe E'Permission
      -> Maybe [Text] -> Maybe (Map [Char] Text) -> EditTeamOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"name")
      Parser
  (Maybe E'Permission
   -> Maybe [Text] -> Maybe (Map [Char] Text) -> EditTeamOption)
-> Parser (Maybe E'Permission)
-> Parser
     (Maybe [Text] -> Maybe (Map [Char] Text) -> EditTeamOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe E'Permission)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"permission")
      Parser (Maybe [Text] -> Maybe (Map [Char] Text) -> EditTeamOption)
-> Parser (Maybe [Text])
-> Parser (Maybe (Map [Char] Text) -> EditTeamOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"units")
      Parser (Maybe (Map [Char] Text) -> EditTeamOption)
-> Parser (Maybe (Map [Char] Text)) -> Parser EditTeamOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe (Map [Char] Text))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"units_map")

-- | ToJSON EditTeamOption
instance A.ToJSON EditTeamOption where
  toJSON :: EditTeamOption -> Value
toJSON EditTeamOption {Maybe Bool
Maybe [Text]
Maybe (Map [Char] Text)
Maybe Text
Maybe E'Permission
Text
$sel:editTeamOptionCanCreateOrgRepo:EditTeamOption :: EditTeamOption -> Maybe Bool
$sel:editTeamOptionDescription:EditTeamOption :: EditTeamOption -> Maybe Text
$sel:editTeamOptionIncludesAllRepositories:EditTeamOption :: EditTeamOption -> Maybe Bool
$sel:editTeamOptionName:EditTeamOption :: EditTeamOption -> Text
$sel:editTeamOptionPermission:EditTeamOption :: EditTeamOption -> Maybe E'Permission
$sel:editTeamOptionUnits:EditTeamOption :: EditTeamOption -> Maybe [Text]
$sel:editTeamOptionUnitsMap:EditTeamOption :: EditTeamOption -> Maybe (Map [Char] Text)
editTeamOptionCanCreateOrgRepo :: Maybe Bool
editTeamOptionDescription :: Maybe Text
editTeamOptionIncludesAllRepositories :: Maybe Bool
editTeamOptionName :: Text
editTeamOptionPermission :: Maybe E'Permission
editTeamOptionUnits :: Maybe [Text]
editTeamOptionUnitsMap :: Maybe (Map [Char] Text)
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"can_create_org_repo" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editTeamOptionCanCreateOrgRepo
      , Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editTeamOptionDescription
      , Key
"includes_all_repositories" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editTeamOptionIncludesAllRepositories
      , Key
"name" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
editTeamOptionName
      , Key
"permission" Key -> Maybe E'Permission -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe E'Permission
editTeamOptionPermission
      , Key
"units" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
editTeamOptionUnits
      , Key
"units_map" Key -> Maybe (Map [Char] Text) -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe (Map [Char] Text)
editTeamOptionUnitsMap
      ]


-- | Construct a value of type 'EditTeamOption' (by applying it's required fields, if any)
mkEditTeamOption
  :: Text -- ^ 'editTeamOptionName' 
  -> EditTeamOption
mkEditTeamOption :: Text -> EditTeamOption
mkEditTeamOption Text
editTeamOptionName =
  EditTeamOption
  { $sel:editTeamOptionCanCreateOrgRepo:EditTeamOption :: Maybe Bool
editTeamOptionCanCreateOrgRepo = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editTeamOptionDescription:EditTeamOption :: Maybe Text
editTeamOptionDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editTeamOptionIncludesAllRepositories:EditTeamOption :: Maybe Bool
editTeamOptionIncludesAllRepositories = Maybe Bool
forall a. Maybe a
Nothing
  , Text
$sel:editTeamOptionName:EditTeamOption :: Text
editTeamOptionName :: Text
editTeamOptionName
  , $sel:editTeamOptionPermission:EditTeamOption :: Maybe E'Permission
editTeamOptionPermission = Maybe E'Permission
forall a. Maybe a
Nothing
  , $sel:editTeamOptionUnits:EditTeamOption :: Maybe [Text]
editTeamOptionUnits = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:editTeamOptionUnitsMap:EditTeamOption :: Maybe (Map [Char] Text)
editTeamOptionUnitsMap = Maybe (Map [Char] Text)
forall a. Maybe a
Nothing
  }

-- ** EditUserOption
-- | EditUserOption
-- EditUserOption edit user options
data EditUserOption = EditUserOption
  { EditUserOption -> Maybe Bool
editUserOptionActive :: !(Maybe Bool) -- ^ "active"
  , EditUserOption -> Maybe Bool
editUserOptionAdmin :: !(Maybe Bool) -- ^ "admin"
  , EditUserOption -> Maybe Bool
editUserOptionAllowCreateOrganization :: !(Maybe Bool) -- ^ "allow_create_organization"
  , EditUserOption -> Maybe Bool
editUserOptionAllowGitHook :: !(Maybe Bool) -- ^ "allow_git_hook"
  , EditUserOption -> Maybe Bool
editUserOptionAllowImportLocal :: !(Maybe Bool) -- ^ "allow_import_local"
  , EditUserOption -> Maybe Text
editUserOptionDescription :: !(Maybe Text) -- ^ "description"
  , EditUserOption -> Maybe Text
editUserOptionEmail :: !(Maybe Text) -- ^ "email"
  , EditUserOption -> Maybe Text
editUserOptionFullName :: !(Maybe Text) -- ^ "full_name"
  , EditUserOption -> Maybe Text
editUserOptionLocation :: !(Maybe Text) -- ^ "location"
  , EditUserOption -> Text
editUserOptionLoginName :: !(Text) -- ^ /Required/ "login_name"
  , EditUserOption -> Maybe Integer
editUserOptionMaxRepoCreation :: !(Maybe Integer) -- ^ "max_repo_creation"
  , EditUserOption -> Maybe Bool
editUserOptionMustChangePassword :: !(Maybe Bool) -- ^ "must_change_password"
  , EditUserOption -> Maybe Text
editUserOptionPassword :: !(Maybe Text) -- ^ "password"
  , EditUserOption -> Maybe Bool
editUserOptionProhibitLogin :: !(Maybe Bool) -- ^ "prohibit_login"
  , EditUserOption -> Maybe Bool
editUserOptionRestricted :: !(Maybe Bool) -- ^ "restricted"
  , EditUserOption -> Integer
editUserOptionSourceId :: !(Integer) -- ^ /Required/ "source_id"
  , EditUserOption -> Maybe Text
editUserOptionVisibility :: !(Maybe Text) -- ^ "visibility"
  , EditUserOption -> Maybe Text
editUserOptionWebsite :: !(Maybe Text) -- ^ "website"
  } deriving (Int -> EditUserOption -> ShowS
[EditUserOption] -> ShowS
EditUserOption -> [Char]
(Int -> EditUserOption -> ShowS)
-> (EditUserOption -> [Char])
-> ([EditUserOption] -> ShowS)
-> Show EditUserOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EditUserOption -> ShowS
showsPrec :: Int -> EditUserOption -> ShowS
$cshow :: EditUserOption -> [Char]
show :: EditUserOption -> [Char]
$cshowList :: [EditUserOption] -> ShowS
showList :: [EditUserOption] -> ShowS
P.Show, EditUserOption -> EditUserOption -> Bool
(EditUserOption -> EditUserOption -> Bool)
-> (EditUserOption -> EditUserOption -> Bool) -> Eq EditUserOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EditUserOption -> EditUserOption -> Bool
== :: EditUserOption -> EditUserOption -> Bool
$c/= :: EditUserOption -> EditUserOption -> Bool
/= :: EditUserOption -> EditUserOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON EditUserOption
instance A.FromJSON EditUserOption where
  parseJSON :: Value -> Parser EditUserOption
parseJSON = [Char]
-> (Object -> Parser EditUserOption)
-> Value
-> Parser EditUserOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"EditUserOption" ((Object -> Parser EditUserOption)
 -> Value -> Parser EditUserOption)
-> (Object -> Parser EditUserOption)
-> Value
-> Parser EditUserOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Text
-> Maybe Integer
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Integer
-> Maybe Text
-> Maybe Text
-> EditUserOption
EditUserOption
      (Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Text
 -> Maybe Integer
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Bool
 -> Integer
 -> Maybe Text
 -> Maybe Text
 -> EditUserOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Integer
      -> Maybe Text
      -> Maybe Text
      -> EditUserOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"active")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Integer
   -> Maybe Text
   -> Maybe Text
   -> EditUserOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Integer
      -> Maybe Text
      -> Maybe Text
      -> EditUserOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"admin")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Integer
   -> Maybe Text
   -> Maybe Text
   -> EditUserOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Integer
      -> Maybe Text
      -> Maybe Text
      -> EditUserOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allow_create_organization")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Integer
   -> Maybe Text
   -> Maybe Text
   -> EditUserOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Integer
      -> Maybe Text
      -> Maybe Text
      -> EditUserOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allow_git_hook")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Integer
   -> Maybe Text
   -> Maybe Text
   -> EditUserOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Integer
      -> Maybe Text
      -> Maybe Text
      -> EditUserOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allow_import_local")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Integer
   -> Maybe Text
   -> Maybe Text
   -> EditUserOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Integer
      -> Maybe Text
      -> Maybe Text
      -> EditUserOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Integer
   -> Maybe Text
   -> Maybe Text
   -> EditUserOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Integer
      -> Maybe Text
      -> Maybe Text
      -> EditUserOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"email")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Integer
   -> Maybe Text
   -> Maybe Text
   -> EditUserOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Integer
      -> Maybe Text
      -> Maybe Text
      -> EditUserOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"full_name")
      Parser
  (Maybe Text
   -> Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Integer
   -> Maybe Text
   -> Maybe Text
   -> EditUserOption)
-> Parser (Maybe Text)
-> Parser
     (Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Integer
      -> Maybe Text
      -> Maybe Text
      -> EditUserOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"location")
      Parser
  (Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Integer
   -> Maybe Text
   -> Maybe Text
   -> EditUserOption)
-> Parser Text
-> Parser
     (Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Integer
      -> Maybe Text
      -> Maybe Text
      -> EditUserOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"login_name")
      Parser
  (Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Integer
   -> Maybe Text
   -> Maybe Text
   -> EditUserOption)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Integer
      -> Maybe Text
      -> Maybe Text
      -> EditUserOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max_repo_creation")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Integer
   -> Maybe Text
   -> Maybe Text
   -> EditUserOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Integer
      -> Maybe Text
      -> Maybe Text
      -> EditUserOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"must_change_password")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Integer
   -> Maybe Text
   -> Maybe Text
   -> EditUserOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Integer
      -> Maybe Text
      -> Maybe Text
      -> EditUserOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"password")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Integer
   -> Maybe Text
   -> Maybe Text
   -> EditUserOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Integer -> Maybe Text -> Maybe Text -> EditUserOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prohibit_login")
      Parser
  (Maybe Bool
   -> Integer -> Maybe Text -> Maybe Text -> EditUserOption)
-> Parser (Maybe Bool)
-> Parser (Integer -> Maybe Text -> Maybe Text -> EditUserOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"restricted")
      Parser (Integer -> Maybe Text -> Maybe Text -> EditUserOption)
-> Parser Integer
-> Parser (Maybe Text -> Maybe Text -> EditUserOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"source_id")
      Parser (Maybe Text -> Maybe Text -> EditUserOption)
-> Parser (Maybe Text) -> Parser (Maybe Text -> EditUserOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"visibility")
      Parser (Maybe Text -> EditUserOption)
-> Parser (Maybe Text) -> Parser EditUserOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"website")

-- | ToJSON EditUserOption
instance A.ToJSON EditUserOption where
  toJSON :: EditUserOption -> Value
toJSON EditUserOption {Integer
Maybe Bool
Maybe Integer
Maybe Text
Text
$sel:editUserOptionActive:EditUserOption :: EditUserOption -> Maybe Bool
$sel:editUserOptionAdmin:EditUserOption :: EditUserOption -> Maybe Bool
$sel:editUserOptionAllowCreateOrganization:EditUserOption :: EditUserOption -> Maybe Bool
$sel:editUserOptionAllowGitHook:EditUserOption :: EditUserOption -> Maybe Bool
$sel:editUserOptionAllowImportLocal:EditUserOption :: EditUserOption -> Maybe Bool
$sel:editUserOptionDescription:EditUserOption :: EditUserOption -> Maybe Text
$sel:editUserOptionEmail:EditUserOption :: EditUserOption -> Maybe Text
$sel:editUserOptionFullName:EditUserOption :: EditUserOption -> Maybe Text
$sel:editUserOptionLocation:EditUserOption :: EditUserOption -> Maybe Text
$sel:editUserOptionLoginName:EditUserOption :: EditUserOption -> Text
$sel:editUserOptionMaxRepoCreation:EditUserOption :: EditUserOption -> Maybe Integer
$sel:editUserOptionMustChangePassword:EditUserOption :: EditUserOption -> Maybe Bool
$sel:editUserOptionPassword:EditUserOption :: EditUserOption -> Maybe Text
$sel:editUserOptionProhibitLogin:EditUserOption :: EditUserOption -> Maybe Bool
$sel:editUserOptionRestricted:EditUserOption :: EditUserOption -> Maybe Bool
$sel:editUserOptionSourceId:EditUserOption :: EditUserOption -> Integer
$sel:editUserOptionVisibility:EditUserOption :: EditUserOption -> Maybe Text
$sel:editUserOptionWebsite:EditUserOption :: EditUserOption -> Maybe Text
editUserOptionActive :: Maybe Bool
editUserOptionAdmin :: Maybe Bool
editUserOptionAllowCreateOrganization :: Maybe Bool
editUserOptionAllowGitHook :: Maybe Bool
editUserOptionAllowImportLocal :: Maybe Bool
editUserOptionDescription :: Maybe Text
editUserOptionEmail :: Maybe Text
editUserOptionFullName :: Maybe Text
editUserOptionLocation :: Maybe Text
editUserOptionLoginName :: Text
editUserOptionMaxRepoCreation :: Maybe Integer
editUserOptionMustChangePassword :: Maybe Bool
editUserOptionPassword :: Maybe Text
editUserOptionProhibitLogin :: Maybe Bool
editUserOptionRestricted :: Maybe Bool
editUserOptionSourceId :: Integer
editUserOptionVisibility :: Maybe Text
editUserOptionWebsite :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"active" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editUserOptionActive
      , Key
"admin" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editUserOptionAdmin
      , Key
"allow_create_organization" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editUserOptionAllowCreateOrganization
      , Key
"allow_git_hook" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editUserOptionAllowGitHook
      , Key
"allow_import_local" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editUserOptionAllowImportLocal
      , Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editUserOptionDescription
      , Key
"email" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editUserOptionEmail
      , Key
"full_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editUserOptionFullName
      , Key
"location" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editUserOptionLocation
      , Key
"login_name" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
editUserOptionLoginName
      , Key
"max_repo_creation" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
editUserOptionMaxRepoCreation
      , Key
"must_change_password" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editUserOptionMustChangePassword
      , Key
"password" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editUserOptionPassword
      , Key
"prohibit_login" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editUserOptionProhibitLogin
      , Key
"restricted" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
editUserOptionRestricted
      , Key
"source_id" Key -> Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Integer
editUserOptionSourceId
      , Key
"visibility" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editUserOptionVisibility
      , Key
"website" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
editUserOptionWebsite
      ]


-- | Construct a value of type 'EditUserOption' (by applying it's required fields, if any)
mkEditUserOption
  :: Text -- ^ 'editUserOptionLoginName' 
  -> Integer -- ^ 'editUserOptionSourceId' 
  -> EditUserOption
mkEditUserOption :: Text -> Integer -> EditUserOption
mkEditUserOption Text
editUserOptionLoginName Integer
editUserOptionSourceId =
  EditUserOption
  { $sel:editUserOptionActive:EditUserOption :: Maybe Bool
editUserOptionActive = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editUserOptionAdmin:EditUserOption :: Maybe Bool
editUserOptionAdmin = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editUserOptionAllowCreateOrganization:EditUserOption :: Maybe Bool
editUserOptionAllowCreateOrganization = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editUserOptionAllowGitHook:EditUserOption :: Maybe Bool
editUserOptionAllowGitHook = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editUserOptionAllowImportLocal:EditUserOption :: Maybe Bool
editUserOptionAllowImportLocal = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editUserOptionDescription:EditUserOption :: Maybe Text
editUserOptionDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editUserOptionEmail:EditUserOption :: Maybe Text
editUserOptionEmail = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editUserOptionFullName:EditUserOption :: Maybe Text
editUserOptionFullName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editUserOptionLocation:EditUserOption :: Maybe Text
editUserOptionLocation = Maybe Text
forall a. Maybe a
Nothing
  , Text
$sel:editUserOptionLoginName:EditUserOption :: Text
editUserOptionLoginName :: Text
editUserOptionLoginName
  , $sel:editUserOptionMaxRepoCreation:EditUserOption :: Maybe Integer
editUserOptionMaxRepoCreation = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:editUserOptionMustChangePassword:EditUserOption :: Maybe Bool
editUserOptionMustChangePassword = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editUserOptionPassword:EditUserOption :: Maybe Text
editUserOptionPassword = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editUserOptionProhibitLogin:EditUserOption :: Maybe Bool
editUserOptionProhibitLogin = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:editUserOptionRestricted:EditUserOption :: Maybe Bool
editUserOptionRestricted = Maybe Bool
forall a. Maybe a
Nothing
  , Integer
$sel:editUserOptionSourceId:EditUserOption :: Integer
editUserOptionSourceId :: Integer
editUserOptionSourceId
  , $sel:editUserOptionVisibility:EditUserOption :: Maybe Text
editUserOptionVisibility = Maybe Text
forall a. Maybe a
Nothing
  , $sel:editUserOptionWebsite:EditUserOption :: Maybe Text
editUserOptionWebsite = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** Email
-- | Email
-- Email an email address belonging to a user
data Email = Email
  { Email -> Maybe Text
emailEmail :: !(Maybe Text) -- ^ "email"
  , Email -> Maybe Bool
emailPrimary :: !(Maybe Bool) -- ^ "primary"
  , Email -> Maybe Integer
emailUserId :: !(Maybe Integer) -- ^ "user_id"
  , Email -> Maybe Text
emailUsername :: !(Maybe Text) -- ^ "username"
  , Email -> Maybe Bool
emailVerified :: !(Maybe Bool) -- ^ "verified"
  } deriving (Int -> Email -> ShowS
[Email] -> ShowS
Email -> [Char]
(Int -> Email -> ShowS)
-> (Email -> [Char]) -> ([Email] -> ShowS) -> Show Email
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Email -> ShowS
showsPrec :: Int -> Email -> ShowS
$cshow :: Email -> [Char]
show :: Email -> [Char]
$cshowList :: [Email] -> ShowS
showList :: [Email] -> ShowS
P.Show, Email -> Email -> Bool
(Email -> Email -> Bool) -> (Email -> Email -> Bool) -> Eq Email
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Email -> Email -> Bool
== :: Email -> Email -> Bool
$c/= :: Email -> Email -> Bool
/= :: Email -> Email -> Bool
P.Eq, P.Typeable)

-- | FromJSON Email
instance A.FromJSON Email where
  parseJSON :: Value -> Parser Email
parseJSON = [Char] -> (Object -> Parser Email) -> Value -> Parser Email
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Email" ((Object -> Parser Email) -> Value -> Parser Email)
-> (Object -> Parser Email) -> Value -> Parser Email
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Bool -> Maybe Integer -> Maybe Text -> Maybe Bool -> Email
Email
      (Maybe Text
 -> Maybe Bool
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Bool
 -> Email)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool -> Maybe Integer -> Maybe Text -> Maybe Bool -> Email)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"email")
      Parser
  (Maybe Bool -> Maybe Integer -> Maybe Text -> Maybe Bool -> Email)
-> Parser (Maybe Bool)
-> Parser (Maybe Integer -> Maybe Text -> Maybe Bool -> Email)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"primary")
      Parser (Maybe Integer -> Maybe Text -> Maybe Bool -> Email)
-> Parser (Maybe Integer)
-> Parser (Maybe Text -> Maybe Bool -> Email)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user_id")
      Parser (Maybe Text -> Maybe Bool -> Email)
-> Parser (Maybe Text) -> Parser (Maybe Bool -> Email)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"username")
      Parser (Maybe Bool -> Email) -> Parser (Maybe Bool) -> Parser Email
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"verified")

-- | ToJSON Email
instance A.ToJSON Email where
  toJSON :: Email -> Value
toJSON Email {Maybe Bool
Maybe Integer
Maybe Text
$sel:emailEmail:Email :: Email -> Maybe Text
$sel:emailPrimary:Email :: Email -> Maybe Bool
$sel:emailUserId:Email :: Email -> Maybe Integer
$sel:emailUsername:Email :: Email -> Maybe Text
$sel:emailVerified:Email :: Email -> Maybe Bool
emailEmail :: Maybe Text
emailPrimary :: Maybe Bool
emailUserId :: Maybe Integer
emailUsername :: Maybe Text
emailVerified :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"email" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
emailEmail
      , Key
"primary" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
emailPrimary
      , Key
"user_id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
emailUserId
      , Key
"username" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
emailUsername
      , Key
"verified" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
emailVerified
      ]


-- | Construct a value of type 'Email' (by applying it's required fields, if any)
mkEmail
  :: Email
mkEmail :: Email
mkEmail =
  Email
  { $sel:emailEmail:Email :: Maybe Text
emailEmail = Maybe Text
forall a. Maybe a
Nothing
  , $sel:emailPrimary:Email :: Maybe Bool
emailPrimary = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:emailUserId:Email :: Maybe Integer
emailUserId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:emailUsername:Email :: Maybe Text
emailUsername = Maybe Text
forall a. Maybe a
Nothing
  , $sel:emailVerified:Email :: Maybe Bool
emailVerified = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** ExternalTracker
-- | ExternalTracker
-- ExternalTracker represents settings for external tracker
data ExternalTracker = ExternalTracker
  { ExternalTracker -> Maybe Text
externalTrackerExternalTrackerFormat :: !(Maybe Text) -- ^ "external_tracker_format" - External Issue Tracker URL Format. Use the placeholders {user}, {repo} and {index} for the username, repository name and issue index.
  , ExternalTracker -> Maybe Text
externalTrackerExternalTrackerRegexpPattern :: !(Maybe Text) -- ^ "external_tracker_regexp_pattern" - External Issue Tracker issue regular expression
  , ExternalTracker -> Maybe Text
externalTrackerExternalTrackerStyle :: !(Maybe Text) -- ^ "external_tracker_style" - External Issue Tracker Number Format, either &#x60;numeric&#x60;, &#x60;alphanumeric&#x60;, or &#x60;regexp&#x60;
  , ExternalTracker -> Maybe Text
externalTrackerExternalTrackerUrl :: !(Maybe Text) -- ^ "external_tracker_url" - URL of external issue tracker.
  } deriving (Int -> ExternalTracker -> ShowS
[ExternalTracker] -> ShowS
ExternalTracker -> [Char]
(Int -> ExternalTracker -> ShowS)
-> (ExternalTracker -> [Char])
-> ([ExternalTracker] -> ShowS)
-> Show ExternalTracker
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExternalTracker -> ShowS
showsPrec :: Int -> ExternalTracker -> ShowS
$cshow :: ExternalTracker -> [Char]
show :: ExternalTracker -> [Char]
$cshowList :: [ExternalTracker] -> ShowS
showList :: [ExternalTracker] -> ShowS
P.Show, ExternalTracker -> ExternalTracker -> Bool
(ExternalTracker -> ExternalTracker -> Bool)
-> (ExternalTracker -> ExternalTracker -> Bool)
-> Eq ExternalTracker
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExternalTracker -> ExternalTracker -> Bool
== :: ExternalTracker -> ExternalTracker -> Bool
$c/= :: ExternalTracker -> ExternalTracker -> Bool
/= :: ExternalTracker -> ExternalTracker -> Bool
P.Eq, P.Typeable)

-- | FromJSON ExternalTracker
instance A.FromJSON ExternalTracker where
  parseJSON :: Value -> Parser ExternalTracker
parseJSON = [Char]
-> (Object -> Parser ExternalTracker)
-> Value
-> Parser ExternalTracker
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"ExternalTracker" ((Object -> Parser ExternalTracker)
 -> Value -> Parser ExternalTracker)
-> (Object -> Parser ExternalTracker)
-> Value
-> Parser ExternalTracker
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text -> Maybe Text -> Maybe Text -> ExternalTracker
ExternalTracker
      (Maybe Text
 -> Maybe Text -> Maybe Text -> Maybe Text -> ExternalTracker)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Text -> Maybe Text -> ExternalTracker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"external_tracker_format")
      Parser (Maybe Text -> Maybe Text -> Maybe Text -> ExternalTracker)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> ExternalTracker)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"external_tracker_regexp_pattern")
      Parser (Maybe Text -> Maybe Text -> ExternalTracker)
-> Parser (Maybe Text) -> Parser (Maybe Text -> ExternalTracker)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"external_tracker_style")
      Parser (Maybe Text -> ExternalTracker)
-> Parser (Maybe Text) -> Parser ExternalTracker
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"external_tracker_url")

-- | ToJSON ExternalTracker
instance A.ToJSON ExternalTracker where
  toJSON :: ExternalTracker -> Value
toJSON ExternalTracker {Maybe Text
$sel:externalTrackerExternalTrackerFormat:ExternalTracker :: ExternalTracker -> Maybe Text
$sel:externalTrackerExternalTrackerRegexpPattern:ExternalTracker :: ExternalTracker -> Maybe Text
$sel:externalTrackerExternalTrackerStyle:ExternalTracker :: ExternalTracker -> Maybe Text
$sel:externalTrackerExternalTrackerUrl:ExternalTracker :: ExternalTracker -> Maybe Text
externalTrackerExternalTrackerFormat :: Maybe Text
externalTrackerExternalTrackerRegexpPattern :: Maybe Text
externalTrackerExternalTrackerStyle :: Maybe Text
externalTrackerExternalTrackerUrl :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"external_tracker_format" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
externalTrackerExternalTrackerFormat
      , Key
"external_tracker_regexp_pattern" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
externalTrackerExternalTrackerRegexpPattern
      , Key
"external_tracker_style" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
externalTrackerExternalTrackerStyle
      , Key
"external_tracker_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
externalTrackerExternalTrackerUrl
      ]


-- | Construct a value of type 'ExternalTracker' (by applying it's required fields, if any)
mkExternalTracker
  :: ExternalTracker
mkExternalTracker :: ExternalTracker
mkExternalTracker =
  ExternalTracker
  { $sel:externalTrackerExternalTrackerFormat:ExternalTracker :: Maybe Text
externalTrackerExternalTrackerFormat = Maybe Text
forall a. Maybe a
Nothing
  , $sel:externalTrackerExternalTrackerRegexpPattern:ExternalTracker :: Maybe Text
externalTrackerExternalTrackerRegexpPattern = Maybe Text
forall a. Maybe a
Nothing
  , $sel:externalTrackerExternalTrackerStyle:ExternalTracker :: Maybe Text
externalTrackerExternalTrackerStyle = Maybe Text
forall a. Maybe a
Nothing
  , $sel:externalTrackerExternalTrackerUrl:ExternalTracker :: Maybe Text
externalTrackerExternalTrackerUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ExternalWiki
-- | ExternalWiki
-- ExternalWiki represents setting for external wiki
data ExternalWiki = ExternalWiki
  { ExternalWiki -> Maybe Text
externalWikiExternalWikiUrl :: !(Maybe Text) -- ^ "external_wiki_url" - URL of external wiki.
  } deriving (Int -> ExternalWiki -> ShowS
[ExternalWiki] -> ShowS
ExternalWiki -> [Char]
(Int -> ExternalWiki -> ShowS)
-> (ExternalWiki -> [Char])
-> ([ExternalWiki] -> ShowS)
-> Show ExternalWiki
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExternalWiki -> ShowS
showsPrec :: Int -> ExternalWiki -> ShowS
$cshow :: ExternalWiki -> [Char]
show :: ExternalWiki -> [Char]
$cshowList :: [ExternalWiki] -> ShowS
showList :: [ExternalWiki] -> ShowS
P.Show, ExternalWiki -> ExternalWiki -> Bool
(ExternalWiki -> ExternalWiki -> Bool)
-> (ExternalWiki -> ExternalWiki -> Bool) -> Eq ExternalWiki
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExternalWiki -> ExternalWiki -> Bool
== :: ExternalWiki -> ExternalWiki -> Bool
$c/= :: ExternalWiki -> ExternalWiki -> Bool
/= :: ExternalWiki -> ExternalWiki -> Bool
P.Eq, P.Typeable)

-- | FromJSON ExternalWiki
instance A.FromJSON ExternalWiki where
  parseJSON :: Value -> Parser ExternalWiki
parseJSON = [Char]
-> (Object -> Parser ExternalWiki) -> Value -> Parser ExternalWiki
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"ExternalWiki" ((Object -> Parser ExternalWiki) -> Value -> Parser ExternalWiki)
-> (Object -> Parser ExternalWiki) -> Value -> Parser ExternalWiki
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> ExternalWiki
ExternalWiki
      (Maybe Text -> ExternalWiki)
-> Parser (Maybe Text) -> Parser ExternalWiki
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"external_wiki_url")

-- | ToJSON ExternalWiki
instance A.ToJSON ExternalWiki where
  toJSON :: ExternalWiki -> Value
toJSON ExternalWiki {Maybe Text
$sel:externalWikiExternalWikiUrl:ExternalWiki :: ExternalWiki -> Maybe Text
externalWikiExternalWikiUrl :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"external_wiki_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
externalWikiExternalWikiUrl
      ]


-- | Construct a value of type 'ExternalWiki' (by applying it's required fields, if any)
mkExternalWiki
  :: ExternalWiki
mkExternalWiki :: ExternalWiki
mkExternalWiki =
  ExternalWiki
  { $sel:externalWikiExternalWikiUrl:ExternalWiki :: Maybe Text
externalWikiExternalWikiUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** FileCommitResponse
-- | FileCommitResponse
-- FileCommitResponse contains information generated from a Git commit for a repo's file.
-- 
data FileCommitResponse = FileCommitResponse
  { FileCommitResponse -> Maybe CommitUser
fileCommitResponseAuthor :: !(Maybe CommitUser) -- ^ "author"
  , FileCommitResponse -> Maybe CommitUser
fileCommitResponseCommitter :: !(Maybe CommitUser) -- ^ "committer"
  , FileCommitResponse -> Maybe DateTime
fileCommitResponseCreated :: !(Maybe DateTime) -- ^ "created"
  , FileCommitResponse -> Maybe Text
fileCommitResponseHtmlUrl :: !(Maybe Text) -- ^ "html_url"
  , FileCommitResponse -> Maybe Text
fileCommitResponseMessage :: !(Maybe Text) -- ^ "message"
  , FileCommitResponse -> Maybe [CommitMeta]
fileCommitResponseParents :: !(Maybe [CommitMeta]) -- ^ "parents"
  , FileCommitResponse -> Maybe Text
fileCommitResponseSha :: !(Maybe Text) -- ^ "sha"
  , FileCommitResponse -> Maybe CommitMeta
fileCommitResponseTree :: !(Maybe CommitMeta) -- ^ "tree"
  , FileCommitResponse -> Maybe Text
fileCommitResponseUrl :: !(Maybe Text) -- ^ "url"
  } deriving (Int -> FileCommitResponse -> ShowS
[FileCommitResponse] -> ShowS
FileCommitResponse -> [Char]
(Int -> FileCommitResponse -> ShowS)
-> (FileCommitResponse -> [Char])
-> ([FileCommitResponse] -> ShowS)
-> Show FileCommitResponse
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileCommitResponse -> ShowS
showsPrec :: Int -> FileCommitResponse -> ShowS
$cshow :: FileCommitResponse -> [Char]
show :: FileCommitResponse -> [Char]
$cshowList :: [FileCommitResponse] -> ShowS
showList :: [FileCommitResponse] -> ShowS
P.Show, FileCommitResponse -> FileCommitResponse -> Bool
(FileCommitResponse -> FileCommitResponse -> Bool)
-> (FileCommitResponse -> FileCommitResponse -> Bool)
-> Eq FileCommitResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileCommitResponse -> FileCommitResponse -> Bool
== :: FileCommitResponse -> FileCommitResponse -> Bool
$c/= :: FileCommitResponse -> FileCommitResponse -> Bool
/= :: FileCommitResponse -> FileCommitResponse -> Bool
P.Eq, P.Typeable)

-- | FromJSON FileCommitResponse
instance A.FromJSON FileCommitResponse where
  parseJSON :: Value -> Parser FileCommitResponse
parseJSON = [Char]
-> (Object -> Parser FileCommitResponse)
-> Value
-> Parser FileCommitResponse
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"FileCommitResponse" ((Object -> Parser FileCommitResponse)
 -> Value -> Parser FileCommitResponse)
-> (Object -> Parser FileCommitResponse)
-> Value
-> Parser FileCommitResponse
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe CommitUser
-> Maybe CommitUser
-> Maybe DateTime
-> Maybe Text
-> Maybe Text
-> Maybe [CommitMeta]
-> Maybe Text
-> Maybe CommitMeta
-> Maybe Text
-> FileCommitResponse
FileCommitResponse
      (Maybe CommitUser
 -> Maybe CommitUser
 -> Maybe DateTime
 -> Maybe Text
 -> Maybe Text
 -> Maybe [CommitMeta]
 -> Maybe Text
 -> Maybe CommitMeta
 -> Maybe Text
 -> FileCommitResponse)
-> Parser (Maybe CommitUser)
-> Parser
     (Maybe CommitUser
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe [CommitMeta]
      -> Maybe Text
      -> Maybe CommitMeta
      -> Maybe Text
      -> FileCommitResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe CommitUser)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"author")
      Parser
  (Maybe CommitUser
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe [CommitMeta]
   -> Maybe Text
   -> Maybe CommitMeta
   -> Maybe Text
   -> FileCommitResponse)
-> Parser (Maybe CommitUser)
-> Parser
     (Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe [CommitMeta]
      -> Maybe Text
      -> Maybe CommitMeta
      -> Maybe Text
      -> FileCommitResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe CommitUser)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"committer")
      Parser
  (Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe [CommitMeta]
   -> Maybe Text
   -> Maybe CommitMeta
   -> Maybe Text
   -> FileCommitResponse)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe [CommitMeta]
      -> Maybe Text
      -> Maybe CommitMeta
      -> Maybe Text
      -> FileCommitResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe [CommitMeta]
   -> Maybe Text
   -> Maybe CommitMeta
   -> Maybe Text
   -> FileCommitResponse)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe [CommitMeta]
      -> Maybe Text
      -> Maybe CommitMeta
      -> Maybe Text
      -> FileCommitResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"html_url")
      Parser
  (Maybe Text
   -> Maybe [CommitMeta]
   -> Maybe Text
   -> Maybe CommitMeta
   -> Maybe Text
   -> FileCommitResponse)
-> Parser (Maybe Text)
-> Parser
     (Maybe [CommitMeta]
      -> Maybe Text
      -> Maybe CommitMeta
      -> Maybe Text
      -> FileCommitResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"message")
      Parser
  (Maybe [CommitMeta]
   -> Maybe Text
   -> Maybe CommitMeta
   -> Maybe Text
   -> FileCommitResponse)
-> Parser (Maybe [CommitMeta])
-> Parser
     (Maybe Text
      -> Maybe CommitMeta -> Maybe Text -> FileCommitResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [CommitMeta])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"parents")
      Parser
  (Maybe Text
   -> Maybe CommitMeta -> Maybe Text -> FileCommitResponse)
-> Parser (Maybe Text)
-> Parser (Maybe CommitMeta -> Maybe Text -> FileCommitResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sha")
      Parser (Maybe CommitMeta -> Maybe Text -> FileCommitResponse)
-> Parser (Maybe CommitMeta)
-> Parser (Maybe Text -> FileCommitResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe CommitMeta)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tree")
      Parser (Maybe Text -> FileCommitResponse)
-> Parser (Maybe Text) -> Parser FileCommitResponse
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")

-- | ToJSON FileCommitResponse
instance A.ToJSON FileCommitResponse where
  toJSON :: FileCommitResponse -> Value
toJSON FileCommitResponse {Maybe [CommitMeta]
Maybe Text
Maybe DateTime
Maybe CommitUser
Maybe CommitMeta
$sel:fileCommitResponseAuthor:FileCommitResponse :: FileCommitResponse -> Maybe CommitUser
$sel:fileCommitResponseCommitter:FileCommitResponse :: FileCommitResponse -> Maybe CommitUser
$sel:fileCommitResponseCreated:FileCommitResponse :: FileCommitResponse -> Maybe DateTime
$sel:fileCommitResponseHtmlUrl:FileCommitResponse :: FileCommitResponse -> Maybe Text
$sel:fileCommitResponseMessage:FileCommitResponse :: FileCommitResponse -> Maybe Text
$sel:fileCommitResponseParents:FileCommitResponse :: FileCommitResponse -> Maybe [CommitMeta]
$sel:fileCommitResponseSha:FileCommitResponse :: FileCommitResponse -> Maybe Text
$sel:fileCommitResponseTree:FileCommitResponse :: FileCommitResponse -> Maybe CommitMeta
$sel:fileCommitResponseUrl:FileCommitResponse :: FileCommitResponse -> Maybe Text
fileCommitResponseAuthor :: Maybe CommitUser
fileCommitResponseCommitter :: Maybe CommitUser
fileCommitResponseCreated :: Maybe DateTime
fileCommitResponseHtmlUrl :: Maybe Text
fileCommitResponseMessage :: Maybe Text
fileCommitResponseParents :: Maybe [CommitMeta]
fileCommitResponseSha :: Maybe Text
fileCommitResponseTree :: Maybe CommitMeta
fileCommitResponseUrl :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"author" Key -> Maybe CommitUser -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe CommitUser
fileCommitResponseAuthor
      , Key
"committer" Key -> Maybe CommitUser -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe CommitUser
fileCommitResponseCommitter
      , Key
"created" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
fileCommitResponseCreated
      , Key
"html_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
fileCommitResponseHtmlUrl
      , Key
"message" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
fileCommitResponseMessage
      , Key
"parents" Key -> Maybe [CommitMeta] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [CommitMeta]
fileCommitResponseParents
      , Key
"sha" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
fileCommitResponseSha
      , Key
"tree" Key -> Maybe CommitMeta -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe CommitMeta
fileCommitResponseTree
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
fileCommitResponseUrl
      ]


-- | Construct a value of type 'FileCommitResponse' (by applying it's required fields, if any)
mkFileCommitResponse
  :: FileCommitResponse
mkFileCommitResponse :: FileCommitResponse
mkFileCommitResponse =
  FileCommitResponse
  { $sel:fileCommitResponseAuthor:FileCommitResponse :: Maybe CommitUser
fileCommitResponseAuthor = Maybe CommitUser
forall a. Maybe a
Nothing
  , $sel:fileCommitResponseCommitter:FileCommitResponse :: Maybe CommitUser
fileCommitResponseCommitter = Maybe CommitUser
forall a. Maybe a
Nothing
  , $sel:fileCommitResponseCreated:FileCommitResponse :: Maybe DateTime
fileCommitResponseCreated = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:fileCommitResponseHtmlUrl:FileCommitResponse :: Maybe Text
fileCommitResponseHtmlUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:fileCommitResponseMessage:FileCommitResponse :: Maybe Text
fileCommitResponseMessage = Maybe Text
forall a. Maybe a
Nothing
  , $sel:fileCommitResponseParents:FileCommitResponse :: Maybe [CommitMeta]
fileCommitResponseParents = Maybe [CommitMeta]
forall a. Maybe a
Nothing
  , $sel:fileCommitResponseSha:FileCommitResponse :: Maybe Text
fileCommitResponseSha = Maybe Text
forall a. Maybe a
Nothing
  , $sel:fileCommitResponseTree:FileCommitResponse :: Maybe CommitMeta
fileCommitResponseTree = Maybe CommitMeta
forall a. Maybe a
Nothing
  , $sel:fileCommitResponseUrl:FileCommitResponse :: Maybe Text
fileCommitResponseUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** FileDeleteResponse
-- | FileDeleteResponse
-- FileDeleteResponse contains information about a repo's file that was deleted
data FileDeleteResponse = FileDeleteResponse
  { FileDeleteResponse -> Maybe FileCommitResponse
fileDeleteResponseCommit :: !(Maybe FileCommitResponse) -- ^ "commit"
  , FileDeleteResponse -> Maybe Value
fileDeleteResponseContent :: !(Maybe A.Value) -- ^ "content"
  , FileDeleteResponse -> Maybe PayloadCommitVerification
fileDeleteResponseVerification :: !(Maybe PayloadCommitVerification) -- ^ "verification"
  } deriving (Int -> FileDeleteResponse -> ShowS
[FileDeleteResponse] -> ShowS
FileDeleteResponse -> [Char]
(Int -> FileDeleteResponse -> ShowS)
-> (FileDeleteResponse -> [Char])
-> ([FileDeleteResponse] -> ShowS)
-> Show FileDeleteResponse
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileDeleteResponse -> ShowS
showsPrec :: Int -> FileDeleteResponse -> ShowS
$cshow :: FileDeleteResponse -> [Char]
show :: FileDeleteResponse -> [Char]
$cshowList :: [FileDeleteResponse] -> ShowS
showList :: [FileDeleteResponse] -> ShowS
P.Show, FileDeleteResponse -> FileDeleteResponse -> Bool
(FileDeleteResponse -> FileDeleteResponse -> Bool)
-> (FileDeleteResponse -> FileDeleteResponse -> Bool)
-> Eq FileDeleteResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileDeleteResponse -> FileDeleteResponse -> Bool
== :: FileDeleteResponse -> FileDeleteResponse -> Bool
$c/= :: FileDeleteResponse -> FileDeleteResponse -> Bool
/= :: FileDeleteResponse -> FileDeleteResponse -> Bool
P.Eq, P.Typeable)

-- | FromJSON FileDeleteResponse
instance A.FromJSON FileDeleteResponse where
  parseJSON :: Value -> Parser FileDeleteResponse
parseJSON = [Char]
-> (Object -> Parser FileDeleteResponse)
-> Value
-> Parser FileDeleteResponse
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"FileDeleteResponse" ((Object -> Parser FileDeleteResponse)
 -> Value -> Parser FileDeleteResponse)
-> (Object -> Parser FileDeleteResponse)
-> Value
-> Parser FileDeleteResponse
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe FileCommitResponse
-> Maybe Value
-> Maybe PayloadCommitVerification
-> FileDeleteResponse
FileDeleteResponse
      (Maybe FileCommitResponse
 -> Maybe Value
 -> Maybe PayloadCommitVerification
 -> FileDeleteResponse)
-> Parser (Maybe FileCommitResponse)
-> Parser
     (Maybe Value
      -> Maybe PayloadCommitVerification -> FileDeleteResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe FileCommitResponse)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"commit")
      Parser
  (Maybe Value
   -> Maybe PayloadCommitVerification -> FileDeleteResponse)
-> Parser (Maybe Value)
-> Parser (Maybe PayloadCommitVerification -> FileDeleteResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"content")
      Parser (Maybe PayloadCommitVerification -> FileDeleteResponse)
-> Parser (Maybe PayloadCommitVerification)
-> Parser FileDeleteResponse
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe PayloadCommitVerification)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"verification")

-- | ToJSON FileDeleteResponse
instance A.ToJSON FileDeleteResponse where
  toJSON :: FileDeleteResponse -> Value
toJSON FileDeleteResponse {Maybe Value
Maybe PayloadCommitVerification
Maybe FileCommitResponse
$sel:fileDeleteResponseCommit:FileDeleteResponse :: FileDeleteResponse -> Maybe FileCommitResponse
$sel:fileDeleteResponseContent:FileDeleteResponse :: FileDeleteResponse -> Maybe Value
$sel:fileDeleteResponseVerification:FileDeleteResponse :: FileDeleteResponse -> Maybe PayloadCommitVerification
fileDeleteResponseCommit :: Maybe FileCommitResponse
fileDeleteResponseContent :: Maybe Value
fileDeleteResponseVerification :: Maybe PayloadCommitVerification
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"commit" Key -> Maybe FileCommitResponse -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe FileCommitResponse
fileDeleteResponseCommit
      , Key
"content" Key -> Maybe Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Value
fileDeleteResponseContent
      , Key
"verification" Key -> Maybe PayloadCommitVerification -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe PayloadCommitVerification
fileDeleteResponseVerification
      ]


-- | Construct a value of type 'FileDeleteResponse' (by applying it's required fields, if any)
mkFileDeleteResponse
  :: FileDeleteResponse
mkFileDeleteResponse :: FileDeleteResponse
mkFileDeleteResponse =
  FileDeleteResponse
  { $sel:fileDeleteResponseCommit:FileDeleteResponse :: Maybe FileCommitResponse
fileDeleteResponseCommit = Maybe FileCommitResponse
forall a. Maybe a
Nothing
  , $sel:fileDeleteResponseContent:FileDeleteResponse :: Maybe Value
fileDeleteResponseContent = Maybe Value
forall a. Maybe a
Nothing
  , $sel:fileDeleteResponseVerification:FileDeleteResponse :: Maybe PayloadCommitVerification
fileDeleteResponseVerification = Maybe PayloadCommitVerification
forall a. Maybe a
Nothing
  }

-- ** FileLinksResponse
-- | FileLinksResponse
-- FileLinksResponse contains the links for a repo's file
data FileLinksResponse = FileLinksResponse
  { FileLinksResponse -> Maybe Text
fileLinksResponseGit :: !(Maybe Text) -- ^ "git"
  , FileLinksResponse -> Maybe Text
fileLinksResponseHtml :: !(Maybe Text) -- ^ "html"
  , FileLinksResponse -> Maybe Text
fileLinksResponseSelf :: !(Maybe Text) -- ^ "self"
  } deriving (Int -> FileLinksResponse -> ShowS
[FileLinksResponse] -> ShowS
FileLinksResponse -> [Char]
(Int -> FileLinksResponse -> ShowS)
-> (FileLinksResponse -> [Char])
-> ([FileLinksResponse] -> ShowS)
-> Show FileLinksResponse
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileLinksResponse -> ShowS
showsPrec :: Int -> FileLinksResponse -> ShowS
$cshow :: FileLinksResponse -> [Char]
show :: FileLinksResponse -> [Char]
$cshowList :: [FileLinksResponse] -> ShowS
showList :: [FileLinksResponse] -> ShowS
P.Show, FileLinksResponse -> FileLinksResponse -> Bool
(FileLinksResponse -> FileLinksResponse -> Bool)
-> (FileLinksResponse -> FileLinksResponse -> Bool)
-> Eq FileLinksResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileLinksResponse -> FileLinksResponse -> Bool
== :: FileLinksResponse -> FileLinksResponse -> Bool
$c/= :: FileLinksResponse -> FileLinksResponse -> Bool
/= :: FileLinksResponse -> FileLinksResponse -> Bool
P.Eq, P.Typeable)

-- | FromJSON FileLinksResponse
instance A.FromJSON FileLinksResponse where
  parseJSON :: Value -> Parser FileLinksResponse
parseJSON = [Char]
-> (Object -> Parser FileLinksResponse)
-> Value
-> Parser FileLinksResponse
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"FileLinksResponse" ((Object -> Parser FileLinksResponse)
 -> Value -> Parser FileLinksResponse)
-> (Object -> Parser FileLinksResponse)
-> Value
-> Parser FileLinksResponse
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Text -> Maybe Text -> FileLinksResponse
FileLinksResponse
      (Maybe Text -> Maybe Text -> Maybe Text -> FileLinksResponse)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> FileLinksResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"git")
      Parser (Maybe Text -> Maybe Text -> FileLinksResponse)
-> Parser (Maybe Text) -> Parser (Maybe Text -> FileLinksResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"html")
      Parser (Maybe Text -> FileLinksResponse)
-> Parser (Maybe Text) -> Parser FileLinksResponse
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"self")

-- | ToJSON FileLinksResponse
instance A.ToJSON FileLinksResponse where
  toJSON :: FileLinksResponse -> Value
toJSON FileLinksResponse {Maybe Text
$sel:fileLinksResponseGit:FileLinksResponse :: FileLinksResponse -> Maybe Text
$sel:fileLinksResponseHtml:FileLinksResponse :: FileLinksResponse -> Maybe Text
$sel:fileLinksResponseSelf:FileLinksResponse :: FileLinksResponse -> Maybe Text
fileLinksResponseGit :: Maybe Text
fileLinksResponseHtml :: Maybe Text
fileLinksResponseSelf :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"git" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
fileLinksResponseGit
      , Key
"html" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
fileLinksResponseHtml
      , Key
"self" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
fileLinksResponseSelf
      ]


-- | Construct a value of type 'FileLinksResponse' (by applying it's required fields, if any)
mkFileLinksResponse
  :: FileLinksResponse
mkFileLinksResponse :: FileLinksResponse
mkFileLinksResponse =
  FileLinksResponse
  { $sel:fileLinksResponseGit:FileLinksResponse :: Maybe Text
fileLinksResponseGit = Maybe Text
forall a. Maybe a
Nothing
  , $sel:fileLinksResponseHtml:FileLinksResponse :: Maybe Text
fileLinksResponseHtml = Maybe Text
forall a. Maybe a
Nothing
  , $sel:fileLinksResponseSelf:FileLinksResponse :: Maybe Text
fileLinksResponseSelf = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** FileResponse
-- | FileResponse
-- FileResponse contains information about a repo's file
data FileResponse = FileResponse
  { FileResponse -> Maybe FileCommitResponse
fileResponseCommit :: !(Maybe FileCommitResponse) -- ^ "commit"
  , FileResponse -> Maybe ContentsResponse
fileResponseContent :: !(Maybe ContentsResponse) -- ^ "content"
  , FileResponse -> Maybe PayloadCommitVerification
fileResponseVerification :: !(Maybe PayloadCommitVerification) -- ^ "verification"
  } deriving (Int -> FileResponse -> ShowS
[FileResponse] -> ShowS
FileResponse -> [Char]
(Int -> FileResponse -> ShowS)
-> (FileResponse -> [Char])
-> ([FileResponse] -> ShowS)
-> Show FileResponse
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FileResponse -> ShowS
showsPrec :: Int -> FileResponse -> ShowS
$cshow :: FileResponse -> [Char]
show :: FileResponse -> [Char]
$cshowList :: [FileResponse] -> ShowS
showList :: [FileResponse] -> ShowS
P.Show, FileResponse -> FileResponse -> Bool
(FileResponse -> FileResponse -> Bool)
-> (FileResponse -> FileResponse -> Bool) -> Eq FileResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileResponse -> FileResponse -> Bool
== :: FileResponse -> FileResponse -> Bool
$c/= :: FileResponse -> FileResponse -> Bool
/= :: FileResponse -> FileResponse -> Bool
P.Eq, P.Typeable)

-- | FromJSON FileResponse
instance A.FromJSON FileResponse where
  parseJSON :: Value -> Parser FileResponse
parseJSON = [Char]
-> (Object -> Parser FileResponse) -> Value -> Parser FileResponse
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"FileResponse" ((Object -> Parser FileResponse) -> Value -> Parser FileResponse)
-> (Object -> Parser FileResponse) -> Value -> Parser FileResponse
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe FileCommitResponse
-> Maybe ContentsResponse
-> Maybe PayloadCommitVerification
-> FileResponse
FileResponse
      (Maybe FileCommitResponse
 -> Maybe ContentsResponse
 -> Maybe PayloadCommitVerification
 -> FileResponse)
-> Parser (Maybe FileCommitResponse)
-> Parser
     (Maybe ContentsResponse
      -> Maybe PayloadCommitVerification -> FileResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe FileCommitResponse)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"commit")
      Parser
  (Maybe ContentsResponse
   -> Maybe PayloadCommitVerification -> FileResponse)
-> Parser (Maybe ContentsResponse)
-> Parser (Maybe PayloadCommitVerification -> FileResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe ContentsResponse)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"content")
      Parser (Maybe PayloadCommitVerification -> FileResponse)
-> Parser (Maybe PayloadCommitVerification) -> Parser FileResponse
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe PayloadCommitVerification)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"verification")

-- | ToJSON FileResponse
instance A.ToJSON FileResponse where
  toJSON :: FileResponse -> Value
toJSON FileResponse {Maybe PayloadCommitVerification
Maybe FileCommitResponse
Maybe ContentsResponse
$sel:fileResponseCommit:FileResponse :: FileResponse -> Maybe FileCommitResponse
$sel:fileResponseContent:FileResponse :: FileResponse -> Maybe ContentsResponse
$sel:fileResponseVerification:FileResponse :: FileResponse -> Maybe PayloadCommitVerification
fileResponseCommit :: Maybe FileCommitResponse
fileResponseContent :: Maybe ContentsResponse
fileResponseVerification :: Maybe PayloadCommitVerification
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"commit" Key -> Maybe FileCommitResponse -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe FileCommitResponse
fileResponseCommit
      , Key
"content" Key -> Maybe ContentsResponse -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe ContentsResponse
fileResponseContent
      , Key
"verification" Key -> Maybe PayloadCommitVerification -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe PayloadCommitVerification
fileResponseVerification
      ]


-- | Construct a value of type 'FileResponse' (by applying it's required fields, if any)
mkFileResponse
  :: FileResponse
mkFileResponse :: FileResponse
mkFileResponse =
  FileResponse
  { $sel:fileResponseCommit:FileResponse :: Maybe FileCommitResponse
fileResponseCommit = Maybe FileCommitResponse
forall a. Maybe a
Nothing
  , $sel:fileResponseContent:FileResponse :: Maybe ContentsResponse
fileResponseContent = Maybe ContentsResponse
forall a. Maybe a
Nothing
  , $sel:fileResponseVerification:FileResponse :: Maybe PayloadCommitVerification
fileResponseVerification = Maybe PayloadCommitVerification
forall a. Maybe a
Nothing
  }

-- ** FilesResponse
-- | FilesResponse
-- FilesResponse contains information about multiple files from a repo
data FilesResponse = FilesResponse
  { FilesResponse -> Maybe FileCommitResponse
filesResponseCommit :: !(Maybe FileCommitResponse) -- ^ "commit"
  , FilesResponse -> Maybe [ContentsResponse]
filesResponseFiles :: !(Maybe [ContentsResponse]) -- ^ "files"
  , FilesResponse -> Maybe PayloadCommitVerification
filesResponseVerification :: !(Maybe PayloadCommitVerification) -- ^ "verification"
  } deriving (Int -> FilesResponse -> ShowS
[FilesResponse] -> ShowS
FilesResponse -> [Char]
(Int -> FilesResponse -> ShowS)
-> (FilesResponse -> [Char])
-> ([FilesResponse] -> ShowS)
-> Show FilesResponse
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FilesResponse -> ShowS
showsPrec :: Int -> FilesResponse -> ShowS
$cshow :: FilesResponse -> [Char]
show :: FilesResponse -> [Char]
$cshowList :: [FilesResponse] -> ShowS
showList :: [FilesResponse] -> ShowS
P.Show, FilesResponse -> FilesResponse -> Bool
(FilesResponse -> FilesResponse -> Bool)
-> (FilesResponse -> FilesResponse -> Bool) -> Eq FilesResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FilesResponse -> FilesResponse -> Bool
== :: FilesResponse -> FilesResponse -> Bool
$c/= :: FilesResponse -> FilesResponse -> Bool
/= :: FilesResponse -> FilesResponse -> Bool
P.Eq, P.Typeable)

-- | FromJSON FilesResponse
instance A.FromJSON FilesResponse where
  parseJSON :: Value -> Parser FilesResponse
parseJSON = [Char]
-> (Object -> Parser FilesResponse)
-> Value
-> Parser FilesResponse
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"FilesResponse" ((Object -> Parser FilesResponse) -> Value -> Parser FilesResponse)
-> (Object -> Parser FilesResponse)
-> Value
-> Parser FilesResponse
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe FileCommitResponse
-> Maybe [ContentsResponse]
-> Maybe PayloadCommitVerification
-> FilesResponse
FilesResponse
      (Maybe FileCommitResponse
 -> Maybe [ContentsResponse]
 -> Maybe PayloadCommitVerification
 -> FilesResponse)
-> Parser (Maybe FileCommitResponse)
-> Parser
     (Maybe [ContentsResponse]
      -> Maybe PayloadCommitVerification -> FilesResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe FileCommitResponse)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"commit")
      Parser
  (Maybe [ContentsResponse]
   -> Maybe PayloadCommitVerification -> FilesResponse)
-> Parser (Maybe [ContentsResponse])
-> Parser (Maybe PayloadCommitVerification -> FilesResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [ContentsResponse])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"files")
      Parser (Maybe PayloadCommitVerification -> FilesResponse)
-> Parser (Maybe PayloadCommitVerification) -> Parser FilesResponse
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe PayloadCommitVerification)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"verification")

-- | ToJSON FilesResponse
instance A.ToJSON FilesResponse where
  toJSON :: FilesResponse -> Value
toJSON FilesResponse {Maybe [ContentsResponse]
Maybe PayloadCommitVerification
Maybe FileCommitResponse
$sel:filesResponseCommit:FilesResponse :: FilesResponse -> Maybe FileCommitResponse
$sel:filesResponseFiles:FilesResponse :: FilesResponse -> Maybe [ContentsResponse]
$sel:filesResponseVerification:FilesResponse :: FilesResponse -> Maybe PayloadCommitVerification
filesResponseCommit :: Maybe FileCommitResponse
filesResponseFiles :: Maybe [ContentsResponse]
filesResponseVerification :: Maybe PayloadCommitVerification
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"commit" Key -> Maybe FileCommitResponse -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe FileCommitResponse
filesResponseCommit
      , Key
"files" Key -> Maybe [ContentsResponse] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [ContentsResponse]
filesResponseFiles
      , Key
"verification" Key -> Maybe PayloadCommitVerification -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe PayloadCommitVerification
filesResponseVerification
      ]


-- | Construct a value of type 'FilesResponse' (by applying it's required fields, if any)
mkFilesResponse
  :: FilesResponse
mkFilesResponse :: FilesResponse
mkFilesResponse =
  FilesResponse
  { $sel:filesResponseCommit:FilesResponse :: Maybe FileCommitResponse
filesResponseCommit = Maybe FileCommitResponse
forall a. Maybe a
Nothing
  , $sel:filesResponseFiles:FilesResponse :: Maybe [ContentsResponse]
filesResponseFiles = Maybe [ContentsResponse]
forall a. Maybe a
Nothing
  , $sel:filesResponseVerification:FilesResponse :: Maybe PayloadCommitVerification
filesResponseVerification = Maybe PayloadCommitVerification
forall a. Maybe a
Nothing
  }

-- ** GPGKey
-- | GPGKey
-- GPGKey a user GPG key to sign commit and tag in repository
data GPGKey = GPGKey
  { GPGKey -> Maybe Bool
gPGKeyCanCertify :: !(Maybe Bool) -- ^ "can_certify"
  , GPGKey -> Maybe Bool
gPGKeyCanEncryptComms :: !(Maybe Bool) -- ^ "can_encrypt_comms"
  , GPGKey -> Maybe Bool
gPGKeyCanEncryptStorage :: !(Maybe Bool) -- ^ "can_encrypt_storage"
  , GPGKey -> Maybe Bool
gPGKeyCanSign :: !(Maybe Bool) -- ^ "can_sign"
  , GPGKey -> Maybe DateTime
gPGKeyCreatedAt :: !(Maybe DateTime) -- ^ "created_at"
  , GPGKey -> Maybe [GPGKeyEmail]
gPGKeyEmails :: !(Maybe [GPGKeyEmail]) -- ^ "emails"
  , GPGKey -> Maybe DateTime
gPGKeyExpiresAt :: !(Maybe DateTime) -- ^ "expires_at"
  , GPGKey -> Maybe Integer
gPGKeyId :: !(Maybe Integer) -- ^ "id"
  , GPGKey -> Maybe Text
gPGKeyKeyId :: !(Maybe Text) -- ^ "key_id"
  , GPGKey -> Maybe Text
gPGKeyPrimaryKeyId :: !(Maybe Text) -- ^ "primary_key_id"
  , GPGKey -> Maybe Text
gPGKeyPublicKey :: !(Maybe Text) -- ^ "public_key"
  , GPGKey -> Maybe [GPGKey]
gPGKeySubkeys :: !(Maybe [GPGKey]) -- ^ "subkeys"
  , GPGKey -> Maybe Bool
gPGKeyVerified :: !(Maybe Bool) -- ^ "verified"
  } deriving (Int -> GPGKey -> ShowS
[GPGKey] -> ShowS
GPGKey -> [Char]
(Int -> GPGKey -> ShowS)
-> (GPGKey -> [Char]) -> ([GPGKey] -> ShowS) -> Show GPGKey
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GPGKey -> ShowS
showsPrec :: Int -> GPGKey -> ShowS
$cshow :: GPGKey -> [Char]
show :: GPGKey -> [Char]
$cshowList :: [GPGKey] -> ShowS
showList :: [GPGKey] -> ShowS
P.Show, GPGKey -> GPGKey -> Bool
(GPGKey -> GPGKey -> Bool)
-> (GPGKey -> GPGKey -> Bool) -> Eq GPGKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GPGKey -> GPGKey -> Bool
== :: GPGKey -> GPGKey -> Bool
$c/= :: GPGKey -> GPGKey -> Bool
/= :: GPGKey -> GPGKey -> Bool
P.Eq, P.Typeable)

-- | FromJSON GPGKey
instance A.FromJSON GPGKey where
  parseJSON :: Value -> Parser GPGKey
parseJSON = [Char] -> (Object -> Parser GPGKey) -> Value -> Parser GPGKey
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"GPGKey" ((Object -> Parser GPGKey) -> Value -> Parser GPGKey)
-> (Object -> Parser GPGKey) -> Value -> Parser GPGKey
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe DateTime
-> Maybe [GPGKeyEmail]
-> Maybe DateTime
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe [GPGKey]
-> Maybe Bool
-> GPGKey
GPGKey
      (Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe DateTime
 -> Maybe [GPGKeyEmail]
 -> Maybe DateTime
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe [GPGKey]
 -> Maybe Bool
 -> GPGKey)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe [GPGKeyEmail]
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [GPGKey]
      -> Maybe Bool
      -> GPGKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"can_certify")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe [GPGKeyEmail]
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [GPGKey]
   -> Maybe Bool
   -> GPGKey)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe [GPGKeyEmail]
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [GPGKey]
      -> Maybe Bool
      -> GPGKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"can_encrypt_comms")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe [GPGKeyEmail]
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [GPGKey]
   -> Maybe Bool
   -> GPGKey)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe DateTime
      -> Maybe [GPGKeyEmail]
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [GPGKey]
      -> Maybe Bool
      -> GPGKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"can_encrypt_storage")
      Parser
  (Maybe Bool
   -> Maybe DateTime
   -> Maybe [GPGKeyEmail]
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [GPGKey]
   -> Maybe Bool
   -> GPGKey)
-> Parser (Maybe Bool)
-> Parser
     (Maybe DateTime
      -> Maybe [GPGKeyEmail]
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [GPGKey]
      -> Maybe Bool
      -> GPGKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"can_sign")
      Parser
  (Maybe DateTime
   -> Maybe [GPGKeyEmail]
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [GPGKey]
   -> Maybe Bool
   -> GPGKey)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe [GPGKeyEmail]
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [GPGKey]
      -> Maybe Bool
      -> GPGKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_at")
      Parser
  (Maybe [GPGKeyEmail]
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [GPGKey]
   -> Maybe Bool
   -> GPGKey)
-> Parser (Maybe [GPGKeyEmail])
-> Parser
     (Maybe DateTime
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [GPGKey]
      -> Maybe Bool
      -> GPGKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [GPGKeyEmail])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"emails")
      Parser
  (Maybe DateTime
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [GPGKey]
   -> Maybe Bool
   -> GPGKey)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [GPGKey]
      -> Maybe Bool
      -> GPGKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"expires_at")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [GPGKey]
   -> Maybe Bool
   -> GPGKey)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe [GPGKey]
      -> Maybe Bool
      -> GPGKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe [GPGKey]
   -> Maybe Bool
   -> GPGKey)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe [GPGKey] -> Maybe Bool -> GPGKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"key_id")
      Parser
  (Maybe Text
   -> Maybe Text -> Maybe [GPGKey] -> Maybe Bool -> GPGKey)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe [GPGKey] -> Maybe Bool -> GPGKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"primary_key_id")
      Parser (Maybe Text -> Maybe [GPGKey] -> Maybe Bool -> GPGKey)
-> Parser (Maybe Text)
-> Parser (Maybe [GPGKey] -> Maybe Bool -> GPGKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"public_key")
      Parser (Maybe [GPGKey] -> Maybe Bool -> GPGKey)
-> Parser (Maybe [GPGKey]) -> Parser (Maybe Bool -> GPGKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [GPGKey])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"subkeys")
      Parser (Maybe Bool -> GPGKey)
-> Parser (Maybe Bool) -> Parser GPGKey
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"verified")

-- | ToJSON GPGKey
instance A.ToJSON GPGKey where
  toJSON :: GPGKey -> Value
toJSON GPGKey {Maybe Bool
Maybe Integer
Maybe [GPGKeyEmail]
Maybe [GPGKey]
Maybe Text
Maybe DateTime
$sel:gPGKeyCanCertify:GPGKey :: GPGKey -> Maybe Bool
$sel:gPGKeyCanEncryptComms:GPGKey :: GPGKey -> Maybe Bool
$sel:gPGKeyCanEncryptStorage:GPGKey :: GPGKey -> Maybe Bool
$sel:gPGKeyCanSign:GPGKey :: GPGKey -> Maybe Bool
$sel:gPGKeyCreatedAt:GPGKey :: GPGKey -> Maybe DateTime
$sel:gPGKeyEmails:GPGKey :: GPGKey -> Maybe [GPGKeyEmail]
$sel:gPGKeyExpiresAt:GPGKey :: GPGKey -> Maybe DateTime
$sel:gPGKeyId:GPGKey :: GPGKey -> Maybe Integer
$sel:gPGKeyKeyId:GPGKey :: GPGKey -> Maybe Text
$sel:gPGKeyPrimaryKeyId:GPGKey :: GPGKey -> Maybe Text
$sel:gPGKeyPublicKey:GPGKey :: GPGKey -> Maybe Text
$sel:gPGKeySubkeys:GPGKey :: GPGKey -> Maybe [GPGKey]
$sel:gPGKeyVerified:GPGKey :: GPGKey -> Maybe Bool
gPGKeyCanCertify :: Maybe Bool
gPGKeyCanEncryptComms :: Maybe Bool
gPGKeyCanEncryptStorage :: Maybe Bool
gPGKeyCanSign :: Maybe Bool
gPGKeyCreatedAt :: Maybe DateTime
gPGKeyEmails :: Maybe [GPGKeyEmail]
gPGKeyExpiresAt :: Maybe DateTime
gPGKeyId :: Maybe Integer
gPGKeyKeyId :: Maybe Text
gPGKeyPrimaryKeyId :: Maybe Text
gPGKeyPublicKey :: Maybe Text
gPGKeySubkeys :: Maybe [GPGKey]
gPGKeyVerified :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"can_certify" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
gPGKeyCanCertify
      , Key
"can_encrypt_comms" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
gPGKeyCanEncryptComms
      , Key
"can_encrypt_storage" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
gPGKeyCanEncryptStorage
      , Key
"can_sign" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
gPGKeyCanSign
      , Key
"created_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
gPGKeyCreatedAt
      , Key
"emails" Key -> Maybe [GPGKeyEmail] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [GPGKeyEmail]
gPGKeyEmails
      , Key
"expires_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
gPGKeyExpiresAt
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
gPGKeyId
      , Key
"key_id" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
gPGKeyKeyId
      , Key
"primary_key_id" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
gPGKeyPrimaryKeyId
      , Key
"public_key" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
gPGKeyPublicKey
      , Key
"subkeys" Key -> Maybe [GPGKey] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [GPGKey]
gPGKeySubkeys
      , Key
"verified" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
gPGKeyVerified
      ]


-- | Construct a value of type 'GPGKey' (by applying it's required fields, if any)
mkGPGKey
  :: GPGKey
mkGPGKey :: GPGKey
mkGPGKey =
  GPGKey
  { $sel:gPGKeyCanCertify:GPGKey :: Maybe Bool
gPGKeyCanCertify = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:gPGKeyCanEncryptComms:GPGKey :: Maybe Bool
gPGKeyCanEncryptComms = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:gPGKeyCanEncryptStorage:GPGKey :: Maybe Bool
gPGKeyCanEncryptStorage = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:gPGKeyCanSign:GPGKey :: Maybe Bool
gPGKeyCanSign = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:gPGKeyCreatedAt:GPGKey :: Maybe DateTime
gPGKeyCreatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:gPGKeyEmails:GPGKey :: Maybe [GPGKeyEmail]
gPGKeyEmails = Maybe [GPGKeyEmail]
forall a. Maybe a
Nothing
  , $sel:gPGKeyExpiresAt:GPGKey :: Maybe DateTime
gPGKeyExpiresAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:gPGKeyId:GPGKey :: Maybe Integer
gPGKeyId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:gPGKeyKeyId:GPGKey :: Maybe Text
gPGKeyKeyId = Maybe Text
forall a. Maybe a
Nothing
  , $sel:gPGKeyPrimaryKeyId:GPGKey :: Maybe Text
gPGKeyPrimaryKeyId = Maybe Text
forall a. Maybe a
Nothing
  , $sel:gPGKeyPublicKey:GPGKey :: Maybe Text
gPGKeyPublicKey = Maybe Text
forall a. Maybe a
Nothing
  , $sel:gPGKeySubkeys:GPGKey :: Maybe [GPGKey]
gPGKeySubkeys = Maybe [GPGKey]
forall a. Maybe a
Nothing
  , $sel:gPGKeyVerified:GPGKey :: Maybe Bool
gPGKeyVerified = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** GPGKeyEmail
-- | GPGKeyEmail
-- GPGKeyEmail an email attached to a GPGKey
data GPGKeyEmail = GPGKeyEmail
  { GPGKeyEmail -> Maybe Text
gPGKeyEmailEmail :: !(Maybe Text) -- ^ "email"
  , GPGKeyEmail -> Maybe Bool
gPGKeyEmailVerified :: !(Maybe Bool) -- ^ "verified"
  } deriving (Int -> GPGKeyEmail -> ShowS
[GPGKeyEmail] -> ShowS
GPGKeyEmail -> [Char]
(Int -> GPGKeyEmail -> ShowS)
-> (GPGKeyEmail -> [Char])
-> ([GPGKeyEmail] -> ShowS)
-> Show GPGKeyEmail
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GPGKeyEmail -> ShowS
showsPrec :: Int -> GPGKeyEmail -> ShowS
$cshow :: GPGKeyEmail -> [Char]
show :: GPGKeyEmail -> [Char]
$cshowList :: [GPGKeyEmail] -> ShowS
showList :: [GPGKeyEmail] -> ShowS
P.Show, GPGKeyEmail -> GPGKeyEmail -> Bool
(GPGKeyEmail -> GPGKeyEmail -> Bool)
-> (GPGKeyEmail -> GPGKeyEmail -> Bool) -> Eq GPGKeyEmail
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GPGKeyEmail -> GPGKeyEmail -> Bool
== :: GPGKeyEmail -> GPGKeyEmail -> Bool
$c/= :: GPGKeyEmail -> GPGKeyEmail -> Bool
/= :: GPGKeyEmail -> GPGKeyEmail -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON GPGKeyEmail
instance A.ToJSON GPGKeyEmail where
  toJSON :: GPGKeyEmail -> Value
toJSON GPGKeyEmail {Maybe Bool
Maybe Text
$sel:gPGKeyEmailEmail:GPGKeyEmail :: GPGKeyEmail -> Maybe Text
$sel:gPGKeyEmailVerified:GPGKeyEmail :: GPGKeyEmail -> Maybe Bool
gPGKeyEmailEmail :: Maybe Text
gPGKeyEmailVerified :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"email" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
gPGKeyEmailEmail
      , Key
"verified" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
gPGKeyEmailVerified
      ]


-- | Construct a value of type 'GPGKeyEmail' (by applying it's required fields, if any)
mkGPGKeyEmail
  :: GPGKeyEmail
mkGPGKeyEmail :: GPGKeyEmail
mkGPGKeyEmail =
  GPGKeyEmail
  { $sel:gPGKeyEmailEmail:GPGKeyEmail :: Maybe Text
gPGKeyEmailEmail = Maybe Text
forall a. Maybe a
Nothing
  , $sel:gPGKeyEmailVerified:GPGKeyEmail :: Maybe Bool
gPGKeyEmailVerified = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** GeneralAPISettings
-- | GeneralAPISettings
-- GeneralAPISettings contains global api settings exposed by it
data GeneralAPISettings = GeneralAPISettings
  { GeneralAPISettings -> Maybe Integer
generalAPISettingsDefaultGitTreesPerPage :: !(Maybe Integer) -- ^ "default_git_trees_per_page"
  , GeneralAPISettings -> Maybe Integer
generalAPISettingsDefaultMaxBlobSize :: !(Maybe Integer) -- ^ "default_max_blob_size"
  , GeneralAPISettings -> Maybe Integer
generalAPISettingsDefaultPagingNum :: !(Maybe Integer) -- ^ "default_paging_num"
  , GeneralAPISettings -> Maybe Integer
generalAPISettingsMaxResponseItems :: !(Maybe Integer) -- ^ "max_response_items"
  } deriving (Int -> GeneralAPISettings -> ShowS
[GeneralAPISettings] -> ShowS
GeneralAPISettings -> [Char]
(Int -> GeneralAPISettings -> ShowS)
-> (GeneralAPISettings -> [Char])
-> ([GeneralAPISettings] -> ShowS)
-> Show GeneralAPISettings
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GeneralAPISettings -> ShowS
showsPrec :: Int -> GeneralAPISettings -> ShowS
$cshow :: GeneralAPISettings -> [Char]
show :: GeneralAPISettings -> [Char]
$cshowList :: [GeneralAPISettings] -> ShowS
showList :: [GeneralAPISettings] -> ShowS
P.Show, GeneralAPISettings -> GeneralAPISettings -> Bool
(GeneralAPISettings -> GeneralAPISettings -> Bool)
-> (GeneralAPISettings -> GeneralAPISettings -> Bool)
-> Eq GeneralAPISettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GeneralAPISettings -> GeneralAPISettings -> Bool
== :: GeneralAPISettings -> GeneralAPISettings -> Bool
$c/= :: GeneralAPISettings -> GeneralAPISettings -> Bool
/= :: GeneralAPISettings -> GeneralAPISettings -> Bool
P.Eq, P.Typeable)

-- | FromJSON GeneralAPISettings
instance A.FromJSON GeneralAPISettings where
  parseJSON :: Value -> Parser GeneralAPISettings
parseJSON = [Char]
-> (Object -> Parser GeneralAPISettings)
-> Value
-> Parser GeneralAPISettings
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"GeneralAPISettings" ((Object -> Parser GeneralAPISettings)
 -> Value -> Parser GeneralAPISettings)
-> (Object -> Parser GeneralAPISettings)
-> Value
-> Parser GeneralAPISettings
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Integer
-> Maybe Integer
-> Maybe Integer
-> Maybe Integer
-> GeneralAPISettings
GeneralAPISettings
      (Maybe Integer
 -> Maybe Integer
 -> Maybe Integer
 -> Maybe Integer
 -> GeneralAPISettings)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Integer
      -> Maybe Integer -> Maybe Integer -> GeneralAPISettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"default_git_trees_per_page")
      Parser
  (Maybe Integer
   -> Maybe Integer -> Maybe Integer -> GeneralAPISettings)
-> Parser (Maybe Integer)
-> Parser (Maybe Integer -> Maybe Integer -> GeneralAPISettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"default_max_blob_size")
      Parser (Maybe Integer -> Maybe Integer -> GeneralAPISettings)
-> Parser (Maybe Integer)
-> Parser (Maybe Integer -> GeneralAPISettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"default_paging_num")
      Parser (Maybe Integer -> GeneralAPISettings)
-> Parser (Maybe Integer) -> Parser GeneralAPISettings
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max_response_items")

-- | ToJSON GeneralAPISettings
instance A.ToJSON GeneralAPISettings where
  toJSON :: GeneralAPISettings -> Value
toJSON GeneralAPISettings {Maybe Integer
$sel:generalAPISettingsDefaultGitTreesPerPage:GeneralAPISettings :: GeneralAPISettings -> Maybe Integer
$sel:generalAPISettingsDefaultMaxBlobSize:GeneralAPISettings :: GeneralAPISettings -> Maybe Integer
$sel:generalAPISettingsDefaultPagingNum:GeneralAPISettings :: GeneralAPISettings -> Maybe Integer
$sel:generalAPISettingsMaxResponseItems:GeneralAPISettings :: GeneralAPISettings -> Maybe Integer
generalAPISettingsDefaultGitTreesPerPage :: Maybe Integer
generalAPISettingsDefaultMaxBlobSize :: Maybe Integer
generalAPISettingsDefaultPagingNum :: Maybe Integer
generalAPISettingsMaxResponseItems :: Maybe Integer
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"default_git_trees_per_page" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
generalAPISettingsDefaultGitTreesPerPage
      , Key
"default_max_blob_size" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
generalAPISettingsDefaultMaxBlobSize
      , Key
"default_paging_num" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
generalAPISettingsDefaultPagingNum
      , Key
"max_response_items" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
generalAPISettingsMaxResponseItems
      ]


-- | Construct a value of type 'GeneralAPISettings' (by applying it's required fields, if any)
mkGeneralAPISettings
  :: GeneralAPISettings
mkGeneralAPISettings :: GeneralAPISettings
mkGeneralAPISettings =
  GeneralAPISettings
  { $sel:generalAPISettingsDefaultGitTreesPerPage:GeneralAPISettings :: Maybe Integer
generalAPISettingsDefaultGitTreesPerPage = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:generalAPISettingsDefaultMaxBlobSize:GeneralAPISettings :: Maybe Integer
generalAPISettingsDefaultMaxBlobSize = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:generalAPISettingsDefaultPagingNum:GeneralAPISettings :: Maybe Integer
generalAPISettingsDefaultPagingNum = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:generalAPISettingsMaxResponseItems:GeneralAPISettings :: Maybe Integer
generalAPISettingsMaxResponseItems = Maybe Integer
forall a. Maybe a
Nothing
  }

-- ** GeneralAttachmentSettings
-- | GeneralAttachmentSettings
-- GeneralAttachmentSettings contains global Attachment settings exposed by API
data GeneralAttachmentSettings = GeneralAttachmentSettings
  { GeneralAttachmentSettings -> Maybe Text
generalAttachmentSettingsAllowedTypes :: !(Maybe Text) -- ^ "allowed_types"
  , GeneralAttachmentSettings -> Maybe Bool
generalAttachmentSettingsEnabled :: !(Maybe Bool) -- ^ "enabled"
  , GeneralAttachmentSettings -> Maybe Integer
generalAttachmentSettingsMaxFiles :: !(Maybe Integer) -- ^ "max_files"
  , GeneralAttachmentSettings -> Maybe Integer
generalAttachmentSettingsMaxSize :: !(Maybe Integer) -- ^ "max_size"
  } deriving (Int -> GeneralAttachmentSettings -> ShowS
[GeneralAttachmentSettings] -> ShowS
GeneralAttachmentSettings -> [Char]
(Int -> GeneralAttachmentSettings -> ShowS)
-> (GeneralAttachmentSettings -> [Char])
-> ([GeneralAttachmentSettings] -> ShowS)
-> Show GeneralAttachmentSettings
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GeneralAttachmentSettings -> ShowS
showsPrec :: Int -> GeneralAttachmentSettings -> ShowS
$cshow :: GeneralAttachmentSettings -> [Char]
show :: GeneralAttachmentSettings -> [Char]
$cshowList :: [GeneralAttachmentSettings] -> ShowS
showList :: [GeneralAttachmentSettings] -> ShowS
P.Show, GeneralAttachmentSettings -> GeneralAttachmentSettings -> Bool
(GeneralAttachmentSettings -> GeneralAttachmentSettings -> Bool)
-> (GeneralAttachmentSettings -> GeneralAttachmentSettings -> Bool)
-> Eq GeneralAttachmentSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GeneralAttachmentSettings -> GeneralAttachmentSettings -> Bool
== :: GeneralAttachmentSettings -> GeneralAttachmentSettings -> Bool
$c/= :: GeneralAttachmentSettings -> GeneralAttachmentSettings -> Bool
/= :: GeneralAttachmentSettings -> GeneralAttachmentSettings -> Bool
P.Eq, P.Typeable)

-- | FromJSON GeneralAttachmentSettings
instance A.FromJSON GeneralAttachmentSettings where
  parseJSON :: Value -> Parser GeneralAttachmentSettings
parseJSON = [Char]
-> (Object -> Parser GeneralAttachmentSettings)
-> Value
-> Parser GeneralAttachmentSettings
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"GeneralAttachmentSettings" ((Object -> Parser GeneralAttachmentSettings)
 -> Value -> Parser GeneralAttachmentSettings)
-> (Object -> Parser GeneralAttachmentSettings)
-> Value
-> Parser GeneralAttachmentSettings
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Bool
-> Maybe Integer
-> Maybe Integer
-> GeneralAttachmentSettings
GeneralAttachmentSettings
      (Maybe Text
 -> Maybe Bool
 -> Maybe Integer
 -> Maybe Integer
 -> GeneralAttachmentSettings)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Integer -> Maybe Integer -> GeneralAttachmentSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allowed_types")
      Parser
  (Maybe Bool
   -> Maybe Integer -> Maybe Integer -> GeneralAttachmentSettings)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Integer -> Maybe Integer -> GeneralAttachmentSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enabled")
      Parser
  (Maybe Integer -> Maybe Integer -> GeneralAttachmentSettings)
-> Parser (Maybe Integer)
-> Parser (Maybe Integer -> GeneralAttachmentSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max_files")
      Parser (Maybe Integer -> GeneralAttachmentSettings)
-> Parser (Maybe Integer) -> Parser GeneralAttachmentSettings
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max_size")

-- | ToJSON GeneralAttachmentSettings
instance A.ToJSON GeneralAttachmentSettings where
  toJSON :: GeneralAttachmentSettings -> Value
toJSON GeneralAttachmentSettings {Maybe Bool
Maybe Integer
Maybe Text
$sel:generalAttachmentSettingsAllowedTypes:GeneralAttachmentSettings :: GeneralAttachmentSettings -> Maybe Text
$sel:generalAttachmentSettingsEnabled:GeneralAttachmentSettings :: GeneralAttachmentSettings -> Maybe Bool
$sel:generalAttachmentSettingsMaxFiles:GeneralAttachmentSettings :: GeneralAttachmentSettings -> Maybe Integer
$sel:generalAttachmentSettingsMaxSize:GeneralAttachmentSettings :: GeneralAttachmentSettings -> Maybe Integer
generalAttachmentSettingsAllowedTypes :: Maybe Text
generalAttachmentSettingsEnabled :: Maybe Bool
generalAttachmentSettingsMaxFiles :: Maybe Integer
generalAttachmentSettingsMaxSize :: Maybe Integer
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"allowed_types" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
generalAttachmentSettingsAllowedTypes
      , Key
"enabled" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
generalAttachmentSettingsEnabled
      , Key
"max_files" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
generalAttachmentSettingsMaxFiles
      , Key
"max_size" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
generalAttachmentSettingsMaxSize
      ]


-- | Construct a value of type 'GeneralAttachmentSettings' (by applying it's required fields, if any)
mkGeneralAttachmentSettings
  :: GeneralAttachmentSettings
mkGeneralAttachmentSettings :: GeneralAttachmentSettings
mkGeneralAttachmentSettings =
  GeneralAttachmentSettings
  { $sel:generalAttachmentSettingsAllowedTypes:GeneralAttachmentSettings :: Maybe Text
generalAttachmentSettingsAllowedTypes = Maybe Text
forall a. Maybe a
Nothing
  , $sel:generalAttachmentSettingsEnabled:GeneralAttachmentSettings :: Maybe Bool
generalAttachmentSettingsEnabled = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:generalAttachmentSettingsMaxFiles:GeneralAttachmentSettings :: Maybe Integer
generalAttachmentSettingsMaxFiles = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:generalAttachmentSettingsMaxSize:GeneralAttachmentSettings :: Maybe Integer
generalAttachmentSettingsMaxSize = Maybe Integer
forall a. Maybe a
Nothing
  }

-- ** GeneralRepoSettings
-- | GeneralRepoSettings
-- GeneralRepoSettings contains global repository settings exposed by API
data GeneralRepoSettings = GeneralRepoSettings
  { GeneralRepoSettings -> Maybe Bool
generalRepoSettingsHttpGitDisabled :: !(Maybe Bool) -- ^ "http_git_disabled"
  , GeneralRepoSettings -> Maybe Bool
generalRepoSettingsLfsDisabled :: !(Maybe Bool) -- ^ "lfs_disabled"
  , GeneralRepoSettings -> Maybe Bool
generalRepoSettingsMigrationsDisabled :: !(Maybe Bool) -- ^ "migrations_disabled"
  , GeneralRepoSettings -> Maybe Bool
generalRepoSettingsMirrorsDisabled :: !(Maybe Bool) -- ^ "mirrors_disabled"
  , GeneralRepoSettings -> Maybe Bool
generalRepoSettingsStarsDisabled :: !(Maybe Bool) -- ^ "stars_disabled"
  , GeneralRepoSettings -> Maybe Bool
generalRepoSettingsTimeTrackingDisabled :: !(Maybe Bool) -- ^ "time_tracking_disabled"
  } deriving (Int -> GeneralRepoSettings -> ShowS
[GeneralRepoSettings] -> ShowS
GeneralRepoSettings -> [Char]
(Int -> GeneralRepoSettings -> ShowS)
-> (GeneralRepoSettings -> [Char])
-> ([GeneralRepoSettings] -> ShowS)
-> Show GeneralRepoSettings
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GeneralRepoSettings -> ShowS
showsPrec :: Int -> GeneralRepoSettings -> ShowS
$cshow :: GeneralRepoSettings -> [Char]
show :: GeneralRepoSettings -> [Char]
$cshowList :: [GeneralRepoSettings] -> ShowS
showList :: [GeneralRepoSettings] -> ShowS
P.Show, GeneralRepoSettings -> GeneralRepoSettings -> Bool
(GeneralRepoSettings -> GeneralRepoSettings -> Bool)
-> (GeneralRepoSettings -> GeneralRepoSettings -> Bool)
-> Eq GeneralRepoSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GeneralRepoSettings -> GeneralRepoSettings -> Bool
== :: GeneralRepoSettings -> GeneralRepoSettings -> Bool
$c/= :: GeneralRepoSettings -> GeneralRepoSettings -> Bool
/= :: GeneralRepoSettings -> GeneralRepoSettings -> Bool
P.Eq, P.Typeable)

-- | FromJSON GeneralRepoSettings
instance A.FromJSON GeneralRepoSettings where
  parseJSON :: Value -> Parser GeneralRepoSettings
parseJSON = [Char]
-> (Object -> Parser GeneralRepoSettings)
-> Value
-> Parser GeneralRepoSettings
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"GeneralRepoSettings" ((Object -> Parser GeneralRepoSettings)
 -> Value -> Parser GeneralRepoSettings)
-> (Object -> Parser GeneralRepoSettings)
-> Value
-> Parser GeneralRepoSettings
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> GeneralRepoSettings
GeneralRepoSettings
      (Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> GeneralRepoSettings)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> GeneralRepoSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"http_git_disabled")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> GeneralRepoSettings)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool -> Maybe Bool -> Maybe Bool -> GeneralRepoSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lfs_disabled")
      Parser
  (Maybe Bool
   -> Maybe Bool -> Maybe Bool -> Maybe Bool -> GeneralRepoSettings)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool -> Maybe Bool -> Maybe Bool -> GeneralRepoSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"migrations_disabled")
      Parser
  (Maybe Bool -> Maybe Bool -> Maybe Bool -> GeneralRepoSettings)
-> Parser (Maybe Bool)
-> Parser (Maybe Bool -> Maybe Bool -> GeneralRepoSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mirrors_disabled")
      Parser (Maybe Bool -> Maybe Bool -> GeneralRepoSettings)
-> Parser (Maybe Bool)
-> Parser (Maybe Bool -> GeneralRepoSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"stars_disabled")
      Parser (Maybe Bool -> GeneralRepoSettings)
-> Parser (Maybe Bool) -> Parser GeneralRepoSettings
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"time_tracking_disabled")

-- | ToJSON GeneralRepoSettings
instance A.ToJSON GeneralRepoSettings where
  toJSON :: GeneralRepoSettings -> Value
toJSON GeneralRepoSettings {Maybe Bool
$sel:generalRepoSettingsHttpGitDisabled:GeneralRepoSettings :: GeneralRepoSettings -> Maybe Bool
$sel:generalRepoSettingsLfsDisabled:GeneralRepoSettings :: GeneralRepoSettings -> Maybe Bool
$sel:generalRepoSettingsMigrationsDisabled:GeneralRepoSettings :: GeneralRepoSettings -> Maybe Bool
$sel:generalRepoSettingsMirrorsDisabled:GeneralRepoSettings :: GeneralRepoSettings -> Maybe Bool
$sel:generalRepoSettingsStarsDisabled:GeneralRepoSettings :: GeneralRepoSettings -> Maybe Bool
$sel:generalRepoSettingsTimeTrackingDisabled:GeneralRepoSettings :: GeneralRepoSettings -> Maybe Bool
generalRepoSettingsHttpGitDisabled :: Maybe Bool
generalRepoSettingsLfsDisabled :: Maybe Bool
generalRepoSettingsMigrationsDisabled :: Maybe Bool
generalRepoSettingsMirrorsDisabled :: Maybe Bool
generalRepoSettingsStarsDisabled :: Maybe Bool
generalRepoSettingsTimeTrackingDisabled :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"http_git_disabled" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
generalRepoSettingsHttpGitDisabled
      , Key
"lfs_disabled" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
generalRepoSettingsLfsDisabled
      , Key
"migrations_disabled" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
generalRepoSettingsMigrationsDisabled
      , Key
"mirrors_disabled" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
generalRepoSettingsMirrorsDisabled
      , Key
"stars_disabled" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
generalRepoSettingsStarsDisabled
      , Key
"time_tracking_disabled" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
generalRepoSettingsTimeTrackingDisabled
      ]


-- | Construct a value of type 'GeneralRepoSettings' (by applying it's required fields, if any)
mkGeneralRepoSettings
  :: GeneralRepoSettings
mkGeneralRepoSettings :: GeneralRepoSettings
mkGeneralRepoSettings =
  GeneralRepoSettings
  { $sel:generalRepoSettingsHttpGitDisabled:GeneralRepoSettings :: Maybe Bool
generalRepoSettingsHttpGitDisabled = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:generalRepoSettingsLfsDisabled:GeneralRepoSettings :: Maybe Bool
generalRepoSettingsLfsDisabled = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:generalRepoSettingsMigrationsDisabled:GeneralRepoSettings :: Maybe Bool
generalRepoSettingsMigrationsDisabled = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:generalRepoSettingsMirrorsDisabled:GeneralRepoSettings :: Maybe Bool
generalRepoSettingsMirrorsDisabled = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:generalRepoSettingsStarsDisabled:GeneralRepoSettings :: Maybe Bool
generalRepoSettingsStarsDisabled = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:generalRepoSettingsTimeTrackingDisabled:GeneralRepoSettings :: Maybe Bool
generalRepoSettingsTimeTrackingDisabled = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** GeneralUISettings
-- | GeneralUISettings
-- GeneralUISettings contains global ui settings exposed by API
data GeneralUISettings = GeneralUISettings
  { GeneralUISettings -> Maybe [Text]
generalUISettingsAllowedReactions :: !(Maybe [Text]) -- ^ "allowed_reactions"
  , GeneralUISettings -> Maybe [Text]
generalUISettingsCustomEmojis :: !(Maybe [Text]) -- ^ "custom_emojis"
  , GeneralUISettings -> Maybe Text
generalUISettingsDefaultTheme :: !(Maybe Text) -- ^ "default_theme"
  } deriving (Int -> GeneralUISettings -> ShowS
[GeneralUISettings] -> ShowS
GeneralUISettings -> [Char]
(Int -> GeneralUISettings -> ShowS)
-> (GeneralUISettings -> [Char])
-> ([GeneralUISettings] -> ShowS)
-> Show GeneralUISettings
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GeneralUISettings -> ShowS
showsPrec :: Int -> GeneralUISettings -> ShowS
$cshow :: GeneralUISettings -> [Char]
show :: GeneralUISettings -> [Char]
$cshowList :: [GeneralUISettings] -> ShowS
showList :: [GeneralUISettings] -> ShowS
P.Show, GeneralUISettings -> GeneralUISettings -> Bool
(GeneralUISettings -> GeneralUISettings -> Bool)
-> (GeneralUISettings -> GeneralUISettings -> Bool)
-> Eq GeneralUISettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GeneralUISettings -> GeneralUISettings -> Bool
== :: GeneralUISettings -> GeneralUISettings -> Bool
$c/= :: GeneralUISettings -> GeneralUISettings -> Bool
/= :: GeneralUISettings -> GeneralUISettings -> Bool
P.Eq, P.Typeable)

-- | FromJSON GeneralUISettings
instance A.FromJSON GeneralUISettings where
  parseJSON :: Value -> Parser GeneralUISettings
parseJSON = [Char]
-> (Object -> Parser GeneralUISettings)
-> Value
-> Parser GeneralUISettings
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"GeneralUISettings" ((Object -> Parser GeneralUISettings)
 -> Value -> Parser GeneralUISettings)
-> (Object -> Parser GeneralUISettings)
-> Value
-> Parser GeneralUISettings
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Text] -> Maybe [Text] -> Maybe Text -> GeneralUISettings
GeneralUISettings
      (Maybe [Text] -> Maybe [Text] -> Maybe Text -> GeneralUISettings)
-> Parser (Maybe [Text])
-> Parser (Maybe [Text] -> Maybe Text -> GeneralUISettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allowed_reactions")
      Parser (Maybe [Text] -> Maybe Text -> GeneralUISettings)
-> Parser (Maybe [Text])
-> Parser (Maybe Text -> GeneralUISettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"custom_emojis")
      Parser (Maybe Text -> GeneralUISettings)
-> Parser (Maybe Text) -> Parser GeneralUISettings
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"default_theme")

-- | ToJSON GeneralUISettings
instance A.ToJSON GeneralUISettings where
  toJSON :: GeneralUISettings -> Value
toJSON GeneralUISettings {Maybe [Text]
Maybe Text
$sel:generalUISettingsAllowedReactions:GeneralUISettings :: GeneralUISettings -> Maybe [Text]
$sel:generalUISettingsCustomEmojis:GeneralUISettings :: GeneralUISettings -> Maybe [Text]
$sel:generalUISettingsDefaultTheme:GeneralUISettings :: GeneralUISettings -> Maybe Text
generalUISettingsAllowedReactions :: Maybe [Text]
generalUISettingsCustomEmojis :: Maybe [Text]
generalUISettingsDefaultTheme :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"allowed_reactions" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
generalUISettingsAllowedReactions
      , Key
"custom_emojis" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
generalUISettingsCustomEmojis
      , Key
"default_theme" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
generalUISettingsDefaultTheme
      ]


-- | Construct a value of type 'GeneralUISettings' (by applying it's required fields, if any)
mkGeneralUISettings
  :: GeneralUISettings
mkGeneralUISettings :: GeneralUISettings
mkGeneralUISettings =
  GeneralUISettings
  { $sel:generalUISettingsAllowedReactions:GeneralUISettings :: Maybe [Text]
generalUISettingsAllowedReactions = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:generalUISettingsCustomEmojis:GeneralUISettings :: Maybe [Text]
generalUISettingsCustomEmojis = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:generalUISettingsDefaultTheme:GeneralUISettings :: Maybe Text
generalUISettingsDefaultTheme = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** GenerateRepoOption
-- | GenerateRepoOption
-- GenerateRepoOption options when creating repository using a template
data GenerateRepoOption = GenerateRepoOption
  { GenerateRepoOption -> Maybe Bool
generateRepoOptionAvatar :: !(Maybe Bool) -- ^ "avatar" - include avatar of the template repo
  , GenerateRepoOption -> Maybe Text
generateRepoOptionDefaultBranch :: !(Maybe Text) -- ^ "default_branch" - Default branch of the new repository
  , GenerateRepoOption -> Maybe Text
generateRepoOptionDescription :: !(Maybe Text) -- ^ "description" - Description of the repository to create
  , GenerateRepoOption -> Maybe Bool
generateRepoOptionGitContent :: !(Maybe Bool) -- ^ "git_content" - include git content of default branch in template repo
  , GenerateRepoOption -> Maybe Bool
generateRepoOptionGitHooks :: !(Maybe Bool) -- ^ "git_hooks" - include git hooks in template repo
  , GenerateRepoOption -> Maybe Bool
generateRepoOptionLabels :: !(Maybe Bool) -- ^ "labels" - include labels in template repo
  , GenerateRepoOption -> Text
generateRepoOptionName :: !(Text) -- ^ /Required/ "name" - Name of the repository to create
  , GenerateRepoOption -> Text
generateRepoOptionOwner :: !(Text) -- ^ /Required/ "owner" - The organization or person who will own the new repository
  , GenerateRepoOption -> Maybe Bool
generateRepoOptionPrivate :: !(Maybe Bool) -- ^ "private" - Whether the repository is private
  , GenerateRepoOption -> Maybe Bool
generateRepoOptionProtectedBranch :: !(Maybe Bool) -- ^ "protected_branch" - include protected branches in template repo
  , GenerateRepoOption -> Maybe Bool
generateRepoOptionTopics :: !(Maybe Bool) -- ^ "topics" - include topics in template repo
  , GenerateRepoOption -> Maybe Bool
generateRepoOptionWebhooks :: !(Maybe Bool) -- ^ "webhooks" - include webhooks in template repo
  } deriving (Int -> GenerateRepoOption -> ShowS
[GenerateRepoOption] -> ShowS
GenerateRepoOption -> [Char]
(Int -> GenerateRepoOption -> ShowS)
-> (GenerateRepoOption -> [Char])
-> ([GenerateRepoOption] -> ShowS)
-> Show GenerateRepoOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenerateRepoOption -> ShowS
showsPrec :: Int -> GenerateRepoOption -> ShowS
$cshow :: GenerateRepoOption -> [Char]
show :: GenerateRepoOption -> [Char]
$cshowList :: [GenerateRepoOption] -> ShowS
showList :: [GenerateRepoOption] -> ShowS
P.Show, GenerateRepoOption -> GenerateRepoOption -> Bool
(GenerateRepoOption -> GenerateRepoOption -> Bool)
-> (GenerateRepoOption -> GenerateRepoOption -> Bool)
-> Eq GenerateRepoOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenerateRepoOption -> GenerateRepoOption -> Bool
== :: GenerateRepoOption -> GenerateRepoOption -> Bool
$c/= :: GenerateRepoOption -> GenerateRepoOption -> Bool
/= :: GenerateRepoOption -> GenerateRepoOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON GenerateRepoOption
instance A.FromJSON GenerateRepoOption where
  parseJSON :: Value -> Parser GenerateRepoOption
parseJSON = [Char]
-> (Object -> Parser GenerateRepoOption)
-> Value
-> Parser GenerateRepoOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"GenerateRepoOption" ((Object -> Parser GenerateRepoOption)
 -> Value -> Parser GenerateRepoOption)
-> (Object -> Parser GenerateRepoOption)
-> Value
-> Parser GenerateRepoOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Text
-> Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> GenerateRepoOption
GenerateRepoOption
      (Maybe Bool
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Text
 -> Text
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> GenerateRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Text
      -> Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> GenerateRepoOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"avatar")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Text
   -> Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> GenerateRepoOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Text
      -> Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> GenerateRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"default_branch")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Text
   -> Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> GenerateRepoOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Text
      -> Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> GenerateRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Text
   -> Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> GenerateRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Text
      -> Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> GenerateRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"git_content")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Text
   -> Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> GenerateRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Text
      -> Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> GenerateRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"git_hooks")
      Parser
  (Maybe Bool
   -> Text
   -> Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> GenerateRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Text
      -> Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> GenerateRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"labels")
      Parser
  (Text
   -> Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> GenerateRepoOption)
-> Parser Text
-> Parser
     (Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> GenerateRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"name")
      Parser
  (Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> GenerateRepoOption)
-> Parser Text
-> Parser
     (Maybe Bool
      -> Maybe Bool -> Maybe Bool -> Maybe Bool -> GenerateRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"owner")
      Parser
  (Maybe Bool
   -> Maybe Bool -> Maybe Bool -> Maybe Bool -> GenerateRepoOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool -> Maybe Bool -> Maybe Bool -> GenerateRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"private")
      Parser
  (Maybe Bool -> Maybe Bool -> Maybe Bool -> GenerateRepoOption)
-> Parser (Maybe Bool)
-> Parser (Maybe Bool -> Maybe Bool -> GenerateRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"protected_branch")
      Parser (Maybe Bool -> Maybe Bool -> GenerateRepoOption)
-> Parser (Maybe Bool) -> Parser (Maybe Bool -> GenerateRepoOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"topics")
      Parser (Maybe Bool -> GenerateRepoOption)
-> Parser (Maybe Bool) -> Parser GenerateRepoOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"webhooks")

-- | ToJSON GenerateRepoOption
instance A.ToJSON GenerateRepoOption where
  toJSON :: GenerateRepoOption -> Value
toJSON GenerateRepoOption {Maybe Bool
Maybe Text
Text
$sel:generateRepoOptionAvatar:GenerateRepoOption :: GenerateRepoOption -> Maybe Bool
$sel:generateRepoOptionDefaultBranch:GenerateRepoOption :: GenerateRepoOption -> Maybe Text
$sel:generateRepoOptionDescription:GenerateRepoOption :: GenerateRepoOption -> Maybe Text
$sel:generateRepoOptionGitContent:GenerateRepoOption :: GenerateRepoOption -> Maybe Bool
$sel:generateRepoOptionGitHooks:GenerateRepoOption :: GenerateRepoOption -> Maybe Bool
$sel:generateRepoOptionLabels:GenerateRepoOption :: GenerateRepoOption -> Maybe Bool
$sel:generateRepoOptionName:GenerateRepoOption :: GenerateRepoOption -> Text
$sel:generateRepoOptionOwner:GenerateRepoOption :: GenerateRepoOption -> Text
$sel:generateRepoOptionPrivate:GenerateRepoOption :: GenerateRepoOption -> Maybe Bool
$sel:generateRepoOptionProtectedBranch:GenerateRepoOption :: GenerateRepoOption -> Maybe Bool
$sel:generateRepoOptionTopics:GenerateRepoOption :: GenerateRepoOption -> Maybe Bool
$sel:generateRepoOptionWebhooks:GenerateRepoOption :: GenerateRepoOption -> Maybe Bool
generateRepoOptionAvatar :: Maybe Bool
generateRepoOptionDefaultBranch :: Maybe Text
generateRepoOptionDescription :: Maybe Text
generateRepoOptionGitContent :: Maybe Bool
generateRepoOptionGitHooks :: Maybe Bool
generateRepoOptionLabels :: Maybe Bool
generateRepoOptionName :: Text
generateRepoOptionOwner :: Text
generateRepoOptionPrivate :: Maybe Bool
generateRepoOptionProtectedBranch :: Maybe Bool
generateRepoOptionTopics :: Maybe Bool
generateRepoOptionWebhooks :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"avatar" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
generateRepoOptionAvatar
      , Key
"default_branch" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
generateRepoOptionDefaultBranch
      , Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
generateRepoOptionDescription
      , Key
"git_content" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
generateRepoOptionGitContent
      , Key
"git_hooks" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
generateRepoOptionGitHooks
      , Key
"labels" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
generateRepoOptionLabels
      , Key
"name" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
generateRepoOptionName
      , Key
"owner" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
generateRepoOptionOwner
      , Key
"private" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
generateRepoOptionPrivate
      , Key
"protected_branch" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
generateRepoOptionProtectedBranch
      , Key
"topics" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
generateRepoOptionTopics
      , Key
"webhooks" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
generateRepoOptionWebhooks
      ]


-- | Construct a value of type 'GenerateRepoOption' (by applying it's required fields, if any)
mkGenerateRepoOption
  :: Text -- ^ 'generateRepoOptionName': Name of the repository to create
  -> Text -- ^ 'generateRepoOptionOwner': The organization or person who will own the new repository
  -> GenerateRepoOption
mkGenerateRepoOption :: Text -> Text -> GenerateRepoOption
mkGenerateRepoOption Text
generateRepoOptionName Text
generateRepoOptionOwner =
  GenerateRepoOption
  { $sel:generateRepoOptionAvatar:GenerateRepoOption :: Maybe Bool
generateRepoOptionAvatar = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:generateRepoOptionDefaultBranch:GenerateRepoOption :: Maybe Text
generateRepoOptionDefaultBranch = Maybe Text
forall a. Maybe a
Nothing
  , $sel:generateRepoOptionDescription:GenerateRepoOption :: Maybe Text
generateRepoOptionDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:generateRepoOptionGitContent:GenerateRepoOption :: Maybe Bool
generateRepoOptionGitContent = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:generateRepoOptionGitHooks:GenerateRepoOption :: Maybe Bool
generateRepoOptionGitHooks = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:generateRepoOptionLabels:GenerateRepoOption :: Maybe Bool
generateRepoOptionLabels = Maybe Bool
forall a. Maybe a
Nothing
  , Text
$sel:generateRepoOptionName:GenerateRepoOption :: Text
generateRepoOptionName :: Text
generateRepoOptionName
  , Text
$sel:generateRepoOptionOwner:GenerateRepoOption :: Text
generateRepoOptionOwner :: Text
generateRepoOptionOwner
  , $sel:generateRepoOptionPrivate:GenerateRepoOption :: Maybe Bool
generateRepoOptionPrivate = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:generateRepoOptionProtectedBranch:GenerateRepoOption :: Maybe Bool
generateRepoOptionProtectedBranch = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:generateRepoOptionTopics:GenerateRepoOption :: Maybe Bool
generateRepoOptionTopics = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:generateRepoOptionWebhooks:GenerateRepoOption :: Maybe Bool
generateRepoOptionWebhooks = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** GitBlobResponse
-- | GitBlobResponse
-- GitBlobResponse represents a git blob
data GitBlobResponse = GitBlobResponse
  { GitBlobResponse -> Maybe Text
gitBlobResponseContent :: !(Maybe Text) -- ^ "content"
  , GitBlobResponse -> Maybe Text
gitBlobResponseEncoding :: !(Maybe Text) -- ^ "encoding"
  , GitBlobResponse -> Maybe Text
gitBlobResponseSha :: !(Maybe Text) -- ^ "sha"
  , GitBlobResponse -> Maybe Integer
gitBlobResponseSize :: !(Maybe Integer) -- ^ "size"
  , GitBlobResponse -> Maybe Text
gitBlobResponseUrl :: !(Maybe Text) -- ^ "url"
  } deriving (Int -> GitBlobResponse -> ShowS
[GitBlobResponse] -> ShowS
GitBlobResponse -> [Char]
(Int -> GitBlobResponse -> ShowS)
-> (GitBlobResponse -> [Char])
-> ([GitBlobResponse] -> ShowS)
-> Show GitBlobResponse
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GitBlobResponse -> ShowS
showsPrec :: Int -> GitBlobResponse -> ShowS
$cshow :: GitBlobResponse -> [Char]
show :: GitBlobResponse -> [Char]
$cshowList :: [GitBlobResponse] -> ShowS
showList :: [GitBlobResponse] -> ShowS
P.Show, GitBlobResponse -> GitBlobResponse -> Bool
(GitBlobResponse -> GitBlobResponse -> Bool)
-> (GitBlobResponse -> GitBlobResponse -> Bool)
-> Eq GitBlobResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GitBlobResponse -> GitBlobResponse -> Bool
== :: GitBlobResponse -> GitBlobResponse -> Bool
$c/= :: GitBlobResponse -> GitBlobResponse -> Bool
/= :: GitBlobResponse -> GitBlobResponse -> Bool
P.Eq, P.Typeable)

-- | FromJSON GitBlobResponse
instance A.FromJSON GitBlobResponse where
  parseJSON :: Value -> Parser GitBlobResponse
parseJSON = [Char]
-> (Object -> Parser GitBlobResponse)
-> Value
-> Parser GitBlobResponse
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"GitBlobResponse" ((Object -> Parser GitBlobResponse)
 -> Value -> Parser GitBlobResponse)
-> (Object -> Parser GitBlobResponse)
-> Value
-> Parser GitBlobResponse
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> GitBlobResponse
GitBlobResponse
      (Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Text
 -> GitBlobResponse)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe Integer -> Maybe Text -> GitBlobResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"content")
      Parser
  (Maybe Text
   -> Maybe Text -> Maybe Integer -> Maybe Text -> GitBlobResponse)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Integer -> Maybe Text -> GitBlobResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"encoding")
      Parser
  (Maybe Text -> Maybe Integer -> Maybe Text -> GitBlobResponse)
-> Parser (Maybe Text)
-> Parser (Maybe Integer -> Maybe Text -> GitBlobResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sha")
      Parser (Maybe Integer -> Maybe Text -> GitBlobResponse)
-> Parser (Maybe Integer) -> Parser (Maybe Text -> GitBlobResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"size")
      Parser (Maybe Text -> GitBlobResponse)
-> Parser (Maybe Text) -> Parser GitBlobResponse
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")

-- | ToJSON GitBlobResponse
instance A.ToJSON GitBlobResponse where
  toJSON :: GitBlobResponse -> Value
toJSON GitBlobResponse {Maybe Integer
Maybe Text
$sel:gitBlobResponseContent:GitBlobResponse :: GitBlobResponse -> Maybe Text
$sel:gitBlobResponseEncoding:GitBlobResponse :: GitBlobResponse -> Maybe Text
$sel:gitBlobResponseSha:GitBlobResponse :: GitBlobResponse -> Maybe Text
$sel:gitBlobResponseSize:GitBlobResponse :: GitBlobResponse -> Maybe Integer
$sel:gitBlobResponseUrl:GitBlobResponse :: GitBlobResponse -> Maybe Text
gitBlobResponseContent :: Maybe Text
gitBlobResponseEncoding :: Maybe Text
gitBlobResponseSha :: Maybe Text
gitBlobResponseSize :: Maybe Integer
gitBlobResponseUrl :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"content" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
gitBlobResponseContent
      , Key
"encoding" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
gitBlobResponseEncoding
      , Key
"sha" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
gitBlobResponseSha
      , Key
"size" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
gitBlobResponseSize
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
gitBlobResponseUrl
      ]


-- | Construct a value of type 'GitBlobResponse' (by applying it's required fields, if any)
mkGitBlobResponse
  :: GitBlobResponse
mkGitBlobResponse :: GitBlobResponse
mkGitBlobResponse =
  GitBlobResponse
  { $sel:gitBlobResponseContent:GitBlobResponse :: Maybe Text
gitBlobResponseContent = Maybe Text
forall a. Maybe a
Nothing
  , $sel:gitBlobResponseEncoding:GitBlobResponse :: Maybe Text
gitBlobResponseEncoding = Maybe Text
forall a. Maybe a
Nothing
  , $sel:gitBlobResponseSha:GitBlobResponse :: Maybe Text
gitBlobResponseSha = Maybe Text
forall a. Maybe a
Nothing
  , $sel:gitBlobResponseSize:GitBlobResponse :: Maybe Integer
gitBlobResponseSize = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:gitBlobResponseUrl:GitBlobResponse :: Maybe Text
gitBlobResponseUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** GitEntry
-- | GitEntry
-- GitEntry represents a git tree
data GitEntry = GitEntry
  { GitEntry -> Maybe Text
gitEntryMode :: !(Maybe Text) -- ^ "mode"
  , GitEntry -> Maybe Text
gitEntryPath :: !(Maybe Text) -- ^ "path"
  , GitEntry -> Maybe Text
gitEntrySha :: !(Maybe Text) -- ^ "sha"
  , GitEntry -> Maybe Integer
gitEntrySize :: !(Maybe Integer) -- ^ "size"
  , GitEntry -> Maybe Text
gitEntryType :: !(Maybe Text) -- ^ "type"
  , GitEntry -> Maybe Text
gitEntryUrl :: !(Maybe Text) -- ^ "url"
  } deriving (Int -> GitEntry -> ShowS
[GitEntry] -> ShowS
GitEntry -> [Char]
(Int -> GitEntry -> ShowS)
-> (GitEntry -> [Char]) -> ([GitEntry] -> ShowS) -> Show GitEntry
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GitEntry -> ShowS
showsPrec :: Int -> GitEntry -> ShowS
$cshow :: GitEntry -> [Char]
show :: GitEntry -> [Char]
$cshowList :: [GitEntry] -> ShowS
showList :: [GitEntry] -> ShowS
P.Show, GitEntry -> GitEntry -> Bool
(GitEntry -> GitEntry -> Bool)
-> (GitEntry -> GitEntry -> Bool) -> Eq GitEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GitEntry -> GitEntry -> Bool
== :: GitEntry -> GitEntry -> Bool
$c/= :: GitEntry -> GitEntry -> Bool
/= :: GitEntry -> GitEntry -> Bool
P.Eq, P.Typeable)

-- | FromJSON GitEntry
instance A.FromJSON GitEntry where
  parseJSON :: Value -> Parser GitEntry
parseJSON = [Char] -> (Object -> Parser GitEntry) -> Value -> Parser GitEntry
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"GitEntry" ((Object -> Parser GitEntry) -> Value -> Parser GitEntry)
-> (Object -> Parser GitEntry) -> Value -> Parser GitEntry
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> GitEntry
GitEntry
      (Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Text
 -> GitEntry)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> GitEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mode")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> GitEntry)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Integer -> Maybe Text -> Maybe Text -> GitEntry)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"path")
      Parser
  (Maybe Text
   -> Maybe Integer -> Maybe Text -> Maybe Text -> GitEntry)
-> Parser (Maybe Text)
-> Parser (Maybe Integer -> Maybe Text -> Maybe Text -> GitEntry)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sha")
      Parser (Maybe Integer -> Maybe Text -> Maybe Text -> GitEntry)
-> Parser (Maybe Integer)
-> Parser (Maybe Text -> Maybe Text -> GitEntry)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"size")
      Parser (Maybe Text -> Maybe Text -> GitEntry)
-> Parser (Maybe Text) -> Parser (Maybe Text -> GitEntry)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"type")
      Parser (Maybe Text -> GitEntry)
-> Parser (Maybe Text) -> Parser GitEntry
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")

-- | ToJSON GitEntry
instance A.ToJSON GitEntry where
  toJSON :: GitEntry -> Value
toJSON GitEntry {Maybe Integer
Maybe Text
$sel:gitEntryMode:GitEntry :: GitEntry -> Maybe Text
$sel:gitEntryPath:GitEntry :: GitEntry -> Maybe Text
$sel:gitEntrySha:GitEntry :: GitEntry -> Maybe Text
$sel:gitEntrySize:GitEntry :: GitEntry -> Maybe Integer
$sel:gitEntryType:GitEntry :: GitEntry -> Maybe Text
$sel:gitEntryUrl:GitEntry :: GitEntry -> Maybe Text
gitEntryMode :: Maybe Text
gitEntryPath :: Maybe Text
gitEntrySha :: Maybe Text
gitEntrySize :: Maybe Integer
gitEntryType :: Maybe Text
gitEntryUrl :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"mode" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
gitEntryMode
      , Key
"path" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
gitEntryPath
      , Key
"sha" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
gitEntrySha
      , Key
"size" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
gitEntrySize
      , Key
"type" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
gitEntryType
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
gitEntryUrl
      ]


-- | Construct a value of type 'GitEntry' (by applying it's required fields, if any)
mkGitEntry
  :: GitEntry
mkGitEntry :: GitEntry
mkGitEntry =
  GitEntry
  { $sel:gitEntryMode:GitEntry :: Maybe Text
gitEntryMode = Maybe Text
forall a. Maybe a
Nothing
  , $sel:gitEntryPath:GitEntry :: Maybe Text
gitEntryPath = Maybe Text
forall a. Maybe a
Nothing
  , $sel:gitEntrySha:GitEntry :: Maybe Text
gitEntrySha = Maybe Text
forall a. Maybe a
Nothing
  , $sel:gitEntrySize:GitEntry :: Maybe Integer
gitEntrySize = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:gitEntryType:GitEntry :: Maybe Text
gitEntryType = Maybe Text
forall a. Maybe a
Nothing
  , $sel:gitEntryUrl:GitEntry :: Maybe Text
gitEntryUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** GitHook
-- | GitHook
-- GitHook represents a Git repository hook
data GitHook = GitHook
  { GitHook -> Maybe Text
gitHookContent :: !(Maybe Text) -- ^ "content"
  , GitHook -> Maybe Bool
gitHookIsActive :: !(Maybe Bool) -- ^ "is_active"
  , GitHook -> Maybe Text
gitHookName :: !(Maybe Text) -- ^ "name"
  } deriving (Int -> GitHook -> ShowS
[GitHook] -> ShowS
GitHook -> [Char]
(Int -> GitHook -> ShowS)
-> (GitHook -> [Char]) -> ([GitHook] -> ShowS) -> Show GitHook
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GitHook -> ShowS
showsPrec :: Int -> GitHook -> ShowS
$cshow :: GitHook -> [Char]
show :: GitHook -> [Char]
$cshowList :: [GitHook] -> ShowS
showList :: [GitHook] -> ShowS
P.Show, GitHook -> GitHook -> Bool
(GitHook -> GitHook -> Bool)
-> (GitHook -> GitHook -> Bool) -> Eq GitHook
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GitHook -> GitHook -> Bool
== :: GitHook -> GitHook -> Bool
$c/= :: GitHook -> GitHook -> Bool
/= :: GitHook -> GitHook -> Bool
P.Eq, P.Typeable)

-- | FromJSON GitHook
instance A.FromJSON GitHook where
  parseJSON :: Value -> Parser GitHook
parseJSON = [Char] -> (Object -> Parser GitHook) -> Value -> Parser GitHook
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"GitHook" ((Object -> Parser GitHook) -> Value -> Parser GitHook)
-> (Object -> Parser GitHook) -> Value -> Parser GitHook
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Bool -> Maybe Text -> GitHook
GitHook
      (Maybe Text -> Maybe Bool -> Maybe Text -> GitHook)
-> Parser (Maybe Text)
-> Parser (Maybe Bool -> Maybe Text -> GitHook)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"content")
      Parser (Maybe Bool -> Maybe Text -> GitHook)
-> Parser (Maybe Bool) -> Parser (Maybe Text -> GitHook)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_active")
      Parser (Maybe Text -> GitHook)
-> Parser (Maybe Text) -> Parser GitHook
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")

-- | ToJSON GitHook
instance A.ToJSON GitHook where
  toJSON :: GitHook -> Value
toJSON GitHook {Maybe Bool
Maybe Text
$sel:gitHookContent:GitHook :: GitHook -> Maybe Text
$sel:gitHookIsActive:GitHook :: GitHook -> Maybe Bool
$sel:gitHookName:GitHook :: GitHook -> Maybe Text
gitHookContent :: Maybe Text
gitHookIsActive :: Maybe Bool
gitHookName :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"content" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
gitHookContent
      , Key
"is_active" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
gitHookIsActive
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
gitHookName
      ]


-- | Construct a value of type 'GitHook' (by applying it's required fields, if any)
mkGitHook
  :: GitHook
mkGitHook :: GitHook
mkGitHook =
  GitHook
  { $sel:gitHookContent:GitHook :: Maybe Text
gitHookContent = Maybe Text
forall a. Maybe a
Nothing
  , $sel:gitHookIsActive:GitHook :: Maybe Bool
gitHookIsActive = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:gitHookName:GitHook :: Maybe Text
gitHookName = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** GitObject
-- | GitObject
-- GitObject represents a Git object.
-- 
data GitObject = GitObject
  { GitObject -> Maybe Text
gitObjectSha :: !(Maybe Text) -- ^ "sha"
  , GitObject -> Maybe Text
gitObjectType :: !(Maybe Text) -- ^ "type"
  , GitObject -> Maybe Text
gitObjectUrl :: !(Maybe Text) -- ^ "url"
  } deriving (Int -> GitObject -> ShowS
[GitObject] -> ShowS
GitObject -> [Char]
(Int -> GitObject -> ShowS)
-> (GitObject -> [Char])
-> ([GitObject] -> ShowS)
-> Show GitObject
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GitObject -> ShowS
showsPrec :: Int -> GitObject -> ShowS
$cshow :: GitObject -> [Char]
show :: GitObject -> [Char]
$cshowList :: [GitObject] -> ShowS
showList :: [GitObject] -> ShowS
P.Show, GitObject -> GitObject -> Bool
(GitObject -> GitObject -> Bool)
-> (GitObject -> GitObject -> Bool) -> Eq GitObject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GitObject -> GitObject -> Bool
== :: GitObject -> GitObject -> Bool
$c/= :: GitObject -> GitObject -> Bool
/= :: GitObject -> GitObject -> Bool
P.Eq, P.Typeable)

-- | FromJSON GitObject
instance A.FromJSON GitObject where
  parseJSON :: Value -> Parser GitObject
parseJSON = [Char] -> (Object -> Parser GitObject) -> Value -> Parser GitObject
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"GitObject" ((Object -> Parser GitObject) -> Value -> Parser GitObject)
-> (Object -> Parser GitObject) -> Value -> Parser GitObject
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Text -> Maybe Text -> GitObject
GitObject
      (Maybe Text -> Maybe Text -> Maybe Text -> GitObject)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> GitObject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sha")
      Parser (Maybe Text -> Maybe Text -> GitObject)
-> Parser (Maybe Text) -> Parser (Maybe Text -> GitObject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"type")
      Parser (Maybe Text -> GitObject)
-> Parser (Maybe Text) -> Parser GitObject
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")

-- | ToJSON GitObject
instance A.ToJSON GitObject where
  toJSON :: GitObject -> Value
toJSON GitObject {Maybe Text
$sel:gitObjectSha:GitObject :: GitObject -> Maybe Text
$sel:gitObjectType:GitObject :: GitObject -> Maybe Text
$sel:gitObjectUrl:GitObject :: GitObject -> Maybe Text
gitObjectSha :: Maybe Text
gitObjectType :: Maybe Text
gitObjectUrl :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"sha" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
gitObjectSha
      , Key
"type" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
gitObjectType
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
gitObjectUrl
      ]


-- | Construct a value of type 'GitObject' (by applying it's required fields, if any)
mkGitObject
  :: GitObject
mkGitObject :: GitObject
mkGitObject =
  GitObject
  { $sel:gitObjectSha:GitObject :: Maybe Text
gitObjectSha = Maybe Text
forall a. Maybe a
Nothing
  , $sel:gitObjectType:GitObject :: Maybe Text
gitObjectType = Maybe Text
forall a. Maybe a
Nothing
  , $sel:gitObjectUrl:GitObject :: Maybe Text
gitObjectUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** GitTreeResponse
-- | GitTreeResponse
-- GitTreeResponse returns a git tree
data GitTreeResponse = GitTreeResponse
  { GitTreeResponse -> Maybe Integer
gitTreeResponsePage :: !(Maybe Integer) -- ^ "page"
  , GitTreeResponse -> Maybe Text
gitTreeResponseSha :: !(Maybe Text) -- ^ "sha"
  , GitTreeResponse -> Maybe Integer
gitTreeResponseTotalCount :: !(Maybe Integer) -- ^ "total_count"
  , GitTreeResponse -> Maybe [GitEntry]
gitTreeResponseTree :: !(Maybe [GitEntry]) -- ^ "tree"
  , GitTreeResponse -> Maybe Bool
gitTreeResponseTruncated :: !(Maybe Bool) -- ^ "truncated"
  , GitTreeResponse -> Maybe Text
gitTreeResponseUrl :: !(Maybe Text) -- ^ "url"
  } deriving (Int -> GitTreeResponse -> ShowS
[GitTreeResponse] -> ShowS
GitTreeResponse -> [Char]
(Int -> GitTreeResponse -> ShowS)
-> (GitTreeResponse -> [Char])
-> ([GitTreeResponse] -> ShowS)
-> Show GitTreeResponse
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GitTreeResponse -> ShowS
showsPrec :: Int -> GitTreeResponse -> ShowS
$cshow :: GitTreeResponse -> [Char]
show :: GitTreeResponse -> [Char]
$cshowList :: [GitTreeResponse] -> ShowS
showList :: [GitTreeResponse] -> ShowS
P.Show, GitTreeResponse -> GitTreeResponse -> Bool
(GitTreeResponse -> GitTreeResponse -> Bool)
-> (GitTreeResponse -> GitTreeResponse -> Bool)
-> Eq GitTreeResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GitTreeResponse -> GitTreeResponse -> Bool
== :: GitTreeResponse -> GitTreeResponse -> Bool
$c/= :: GitTreeResponse -> GitTreeResponse -> Bool
/= :: GitTreeResponse -> GitTreeResponse -> Bool
P.Eq, P.Typeable)

-- | FromJSON GitTreeResponse
instance A.FromJSON GitTreeResponse where
  parseJSON :: Value -> Parser GitTreeResponse
parseJSON = [Char]
-> (Object -> Parser GitTreeResponse)
-> Value
-> Parser GitTreeResponse
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"GitTreeResponse" ((Object -> Parser GitTreeResponse)
 -> Value -> Parser GitTreeResponse)
-> (Object -> Parser GitTreeResponse)
-> Value
-> Parser GitTreeResponse
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Integer
-> Maybe Text
-> Maybe Integer
-> Maybe [GitEntry]
-> Maybe Bool
-> Maybe Text
-> GitTreeResponse
GitTreeResponse
      (Maybe Integer
 -> Maybe Text
 -> Maybe Integer
 -> Maybe [GitEntry]
 -> Maybe Bool
 -> Maybe Text
 -> GitTreeResponse)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe [GitEntry]
      -> Maybe Bool
      -> Maybe Text
      -> GitTreeResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"page")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe [GitEntry]
   -> Maybe Bool
   -> Maybe Text
   -> GitTreeResponse)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe [GitEntry] -> Maybe Bool -> Maybe Text -> GitTreeResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sha")
      Parser
  (Maybe Integer
   -> Maybe [GitEntry] -> Maybe Bool -> Maybe Text -> GitTreeResponse)
-> Parser (Maybe Integer)
-> Parser
     (Maybe [GitEntry] -> Maybe Bool -> Maybe Text -> GitTreeResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"total_count")
      Parser
  (Maybe [GitEntry] -> Maybe Bool -> Maybe Text -> GitTreeResponse)
-> Parser (Maybe [GitEntry])
-> Parser (Maybe Bool -> Maybe Text -> GitTreeResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [GitEntry])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tree")
      Parser (Maybe Bool -> Maybe Text -> GitTreeResponse)
-> Parser (Maybe Bool) -> Parser (Maybe Text -> GitTreeResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"truncated")
      Parser (Maybe Text -> GitTreeResponse)
-> Parser (Maybe Text) -> Parser GitTreeResponse
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")

-- | ToJSON GitTreeResponse
instance A.ToJSON GitTreeResponse where
  toJSON :: GitTreeResponse -> Value
toJSON GitTreeResponse {Maybe Bool
Maybe Integer
Maybe [GitEntry]
Maybe Text
$sel:gitTreeResponsePage:GitTreeResponse :: GitTreeResponse -> Maybe Integer
$sel:gitTreeResponseSha:GitTreeResponse :: GitTreeResponse -> Maybe Text
$sel:gitTreeResponseTotalCount:GitTreeResponse :: GitTreeResponse -> Maybe Integer
$sel:gitTreeResponseTree:GitTreeResponse :: GitTreeResponse -> Maybe [GitEntry]
$sel:gitTreeResponseTruncated:GitTreeResponse :: GitTreeResponse -> Maybe Bool
$sel:gitTreeResponseUrl:GitTreeResponse :: GitTreeResponse -> Maybe Text
gitTreeResponsePage :: Maybe Integer
gitTreeResponseSha :: Maybe Text
gitTreeResponseTotalCount :: Maybe Integer
gitTreeResponseTree :: Maybe [GitEntry]
gitTreeResponseTruncated :: Maybe Bool
gitTreeResponseUrl :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"page" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
gitTreeResponsePage
      , Key
"sha" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
gitTreeResponseSha
      , Key
"total_count" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
gitTreeResponseTotalCount
      , Key
"tree" Key -> Maybe [GitEntry] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [GitEntry]
gitTreeResponseTree
      , Key
"truncated" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
gitTreeResponseTruncated
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
gitTreeResponseUrl
      ]


-- | Construct a value of type 'GitTreeResponse' (by applying it's required fields, if any)
mkGitTreeResponse
  :: GitTreeResponse
mkGitTreeResponse :: GitTreeResponse
mkGitTreeResponse =
  GitTreeResponse
  { $sel:gitTreeResponsePage:GitTreeResponse :: Maybe Integer
gitTreeResponsePage = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:gitTreeResponseSha:GitTreeResponse :: Maybe Text
gitTreeResponseSha = Maybe Text
forall a. Maybe a
Nothing
  , $sel:gitTreeResponseTotalCount:GitTreeResponse :: Maybe Integer
gitTreeResponseTotalCount = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:gitTreeResponseTree:GitTreeResponse :: Maybe [GitEntry]
gitTreeResponseTree = Maybe [GitEntry]
forall a. Maybe a
Nothing
  , $sel:gitTreeResponseTruncated:GitTreeResponse :: Maybe Bool
gitTreeResponseTruncated = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:gitTreeResponseUrl:GitTreeResponse :: Maybe Text
gitTreeResponseUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** GitignoreTemplateInfo
-- | GitignoreTemplateInfo
-- GitignoreTemplateInfo name and text of a gitignore template
data GitignoreTemplateInfo = GitignoreTemplateInfo
  { GitignoreTemplateInfo -> Maybe Text
gitignoreTemplateInfoName :: !(Maybe Text) -- ^ "name"
  , GitignoreTemplateInfo -> Maybe Text
gitignoreTemplateInfoSource :: !(Maybe Text) -- ^ "source"
  } deriving (Int -> GitignoreTemplateInfo -> ShowS
[GitignoreTemplateInfo] -> ShowS
GitignoreTemplateInfo -> [Char]
(Int -> GitignoreTemplateInfo -> ShowS)
-> (GitignoreTemplateInfo -> [Char])
-> ([GitignoreTemplateInfo] -> ShowS)
-> Show GitignoreTemplateInfo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GitignoreTemplateInfo -> ShowS
showsPrec :: Int -> GitignoreTemplateInfo -> ShowS
$cshow :: GitignoreTemplateInfo -> [Char]
show :: GitignoreTemplateInfo -> [Char]
$cshowList :: [GitignoreTemplateInfo] -> ShowS
showList :: [GitignoreTemplateInfo] -> ShowS
P.Show, GitignoreTemplateInfo -> GitignoreTemplateInfo -> Bool
(GitignoreTemplateInfo -> GitignoreTemplateInfo -> Bool)
-> (GitignoreTemplateInfo -> GitignoreTemplateInfo -> Bool)
-> Eq GitignoreTemplateInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GitignoreTemplateInfo -> GitignoreTemplateInfo -> Bool
== :: GitignoreTemplateInfo -> GitignoreTemplateInfo -> Bool
$c/= :: GitignoreTemplateInfo -> GitignoreTemplateInfo -> Bool
/= :: GitignoreTemplateInfo -> GitignoreTemplateInfo -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON GitignoreTemplateInfo
instance A.ToJSON GitignoreTemplateInfo where
  toJSON :: GitignoreTemplateInfo -> Value
toJSON GitignoreTemplateInfo {Maybe Text
$sel:gitignoreTemplateInfoName:GitignoreTemplateInfo :: GitignoreTemplateInfo -> Maybe Text
$sel:gitignoreTemplateInfoSource:GitignoreTemplateInfo :: GitignoreTemplateInfo -> Maybe Text
gitignoreTemplateInfoName :: Maybe Text
gitignoreTemplateInfoSource :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
gitignoreTemplateInfoName
      , Key
"source" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
gitignoreTemplateInfoSource
      ]


-- | Construct a value of type 'GitignoreTemplateInfo' (by applying it's required fields, if any)
mkGitignoreTemplateInfo
  :: GitignoreTemplateInfo
mkGitignoreTemplateInfo :: GitignoreTemplateInfo
mkGitignoreTemplateInfo =
  GitignoreTemplateInfo
  { $sel:gitignoreTemplateInfoName:GitignoreTemplateInfo :: Maybe Text
gitignoreTemplateInfoName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:gitignoreTemplateInfoSource:GitignoreTemplateInfo :: Maybe Text
gitignoreTemplateInfoSource = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** Hook
-- | Hook
-- Hook a hook is a web hook when one repository changed
data Hook = Hook
  { Hook -> Maybe Bool
hookActive :: !(Maybe Bool) -- ^ "active"
  , Hook -> Maybe Text
hookAuthorizationHeader :: !(Maybe Text) -- ^ "authorization_header"
  , Hook -> Maybe Text
hookBranchFilter :: !(Maybe Text) -- ^ "branch_filter"
  , Hook -> Maybe (Map [Char] Text)
hookConfig :: !(Maybe (Map.Map String Text)) -- ^ "config"
  , Hook -> Maybe DateTime
hookCreatedAt :: !(Maybe DateTime) -- ^ "created_at"
  , Hook -> Maybe [Text]
hookEvents :: !(Maybe [Text]) -- ^ "events"
  , Hook -> Maybe Integer
hookId :: !(Maybe Integer) -- ^ "id"
  , Hook -> Maybe Text
hookType :: !(Maybe Text) -- ^ "type"
  , Hook -> Maybe DateTime
hookUpdatedAt :: !(Maybe DateTime) -- ^ "updated_at"
  } deriving (Int -> Hook -> ShowS
[Hook] -> ShowS
Hook -> [Char]
(Int -> Hook -> ShowS)
-> (Hook -> [Char]) -> ([Hook] -> ShowS) -> Show Hook
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hook -> ShowS
showsPrec :: Int -> Hook -> ShowS
$cshow :: Hook -> [Char]
show :: Hook -> [Char]
$cshowList :: [Hook] -> ShowS
showList :: [Hook] -> ShowS
P.Show, Hook -> Hook -> Bool
(Hook -> Hook -> Bool) -> (Hook -> Hook -> Bool) -> Eq Hook
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hook -> Hook -> Bool
== :: Hook -> Hook -> Bool
$c/= :: Hook -> Hook -> Bool
/= :: Hook -> Hook -> Bool
P.Eq, P.Typeable)

-- | FromJSON Hook
instance A.FromJSON Hook where
  parseJSON :: Value -> Parser Hook
parseJSON = [Char] -> (Object -> Parser Hook) -> Value -> Parser Hook
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Hook" ((Object -> Parser Hook) -> Value -> Parser Hook)
-> (Object -> Parser Hook) -> Value -> Parser Hook
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe (Map [Char] Text)
-> Maybe DateTime
-> Maybe [Text]
-> Maybe Integer
-> Maybe Text
-> Maybe DateTime
-> Hook
Hook
      (Maybe Bool
 -> Maybe Text
 -> Maybe Text
 -> Maybe (Map [Char] Text)
 -> Maybe DateTime
 -> Maybe [Text]
 -> Maybe Integer
 -> Maybe Text
 -> Maybe DateTime
 -> Hook)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe (Map [Char] Text)
      -> Maybe DateTime
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe DateTime
      -> Hook)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"active")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe (Map [Char] Text)
   -> Maybe DateTime
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe DateTime
   -> Hook)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe (Map [Char] Text)
      -> Maybe DateTime
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe DateTime
      -> Hook)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"authorization_header")
      Parser
  (Maybe Text
   -> Maybe (Map [Char] Text)
   -> Maybe DateTime
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe DateTime
   -> Hook)
-> Parser (Maybe Text)
-> Parser
     (Maybe (Map [Char] Text)
      -> Maybe DateTime
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe DateTime
      -> Hook)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"branch_filter")
      Parser
  (Maybe (Map [Char] Text)
   -> Maybe DateTime
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe DateTime
   -> Hook)
-> Parser (Maybe (Map [Char] Text))
-> Parser
     (Maybe DateTime
      -> Maybe [Text]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe DateTime
      -> Hook)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe (Map [Char] Text))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"config")
      Parser
  (Maybe DateTime
   -> Maybe [Text]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe DateTime
   -> Hook)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe [Text]
      -> Maybe Integer -> Maybe Text -> Maybe DateTime -> Hook)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_at")
      Parser
  (Maybe [Text]
   -> Maybe Integer -> Maybe Text -> Maybe DateTime -> Hook)
-> Parser (Maybe [Text])
-> Parser (Maybe Integer -> Maybe Text -> Maybe DateTime -> Hook)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"events")
      Parser (Maybe Integer -> Maybe Text -> Maybe DateTime -> Hook)
-> Parser (Maybe Integer)
-> Parser (Maybe Text -> Maybe DateTime -> Hook)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser (Maybe Text -> Maybe DateTime -> Hook)
-> Parser (Maybe Text) -> Parser (Maybe DateTime -> Hook)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"type")
      Parser (Maybe DateTime -> Hook)
-> Parser (Maybe DateTime) -> Parser Hook
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated_at")

-- | ToJSON Hook
instance A.ToJSON Hook where
  toJSON :: Hook -> Value
toJSON Hook {Maybe Bool
Maybe Integer
Maybe [Text]
Maybe (Map [Char] Text)
Maybe Text
Maybe DateTime
$sel:hookActive:Hook :: Hook -> Maybe Bool
$sel:hookAuthorizationHeader:Hook :: Hook -> Maybe Text
$sel:hookBranchFilter:Hook :: Hook -> Maybe Text
$sel:hookConfig:Hook :: Hook -> Maybe (Map [Char] Text)
$sel:hookCreatedAt:Hook :: Hook -> Maybe DateTime
$sel:hookEvents:Hook :: Hook -> Maybe [Text]
$sel:hookId:Hook :: Hook -> Maybe Integer
$sel:hookType:Hook :: Hook -> Maybe Text
$sel:hookUpdatedAt:Hook :: Hook -> Maybe DateTime
hookActive :: Maybe Bool
hookAuthorizationHeader :: Maybe Text
hookBranchFilter :: Maybe Text
hookConfig :: Maybe (Map [Char] Text)
hookCreatedAt :: Maybe DateTime
hookEvents :: Maybe [Text]
hookId :: Maybe Integer
hookType :: Maybe Text
hookUpdatedAt :: Maybe DateTime
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"active" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
hookActive
      , Key
"authorization_header" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
hookAuthorizationHeader
      , Key
"branch_filter" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
hookBranchFilter
      , Key
"config" Key -> Maybe (Map [Char] Text) -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe (Map [Char] Text)
hookConfig
      , Key
"created_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
hookCreatedAt
      , Key
"events" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
hookEvents
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
hookId
      , Key
"type" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
hookType
      , Key
"updated_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
hookUpdatedAt
      ]


-- | Construct a value of type 'Hook' (by applying it's required fields, if any)
mkHook
  :: Hook
mkHook :: Hook
mkHook =
  Hook
  { $sel:hookActive:Hook :: Maybe Bool
hookActive = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:hookAuthorizationHeader:Hook :: Maybe Text
hookAuthorizationHeader = Maybe Text
forall a. Maybe a
Nothing
  , $sel:hookBranchFilter:Hook :: Maybe Text
hookBranchFilter = Maybe Text
forall a. Maybe a
Nothing
  , $sel:hookConfig:Hook :: Maybe (Map [Char] Text)
hookConfig = Maybe (Map [Char] Text)
forall a. Maybe a
Nothing
  , $sel:hookCreatedAt:Hook :: Maybe DateTime
hookCreatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:hookEvents:Hook :: Maybe [Text]
hookEvents = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:hookId:Hook :: Maybe Integer
hookId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:hookType:Hook :: Maybe Text
hookType = Maybe Text
forall a. Maybe a
Nothing
  , $sel:hookUpdatedAt:Hook :: Maybe DateTime
hookUpdatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  }

-- ** Identity
-- | Identity
-- Identity for a person's identity like an author or committer
data Identity = Identity
  { Identity -> Maybe Text
identityEmail :: !(Maybe Text) -- ^ "email"
  , Identity -> Maybe Text
identityName :: !(Maybe Text) -- ^ "name"
  } deriving (Int -> Identity -> ShowS
[Identity] -> ShowS
Identity -> [Char]
(Int -> Identity -> ShowS)
-> (Identity -> [Char]) -> ([Identity] -> ShowS) -> Show Identity
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Identity -> ShowS
showsPrec :: Int -> Identity -> ShowS
$cshow :: Identity -> [Char]
show :: Identity -> [Char]
$cshowList :: [Identity] -> ShowS
showList :: [Identity] -> ShowS
P.Show, Identity -> Identity -> Bool
(Identity -> Identity -> Bool)
-> (Identity -> Identity -> Bool) -> Eq Identity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Identity -> Identity -> Bool
== :: Identity -> Identity -> Bool
$c/= :: Identity -> Identity -> Bool
/= :: Identity -> Identity -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON Identity
instance A.ToJSON Identity where
  toJSON :: Identity -> Value
toJSON Identity {Maybe Text
$sel:identityEmail:Identity :: Identity -> Maybe Text
$sel:identityName:Identity :: Identity -> Maybe Text
identityEmail :: Maybe Text
identityName :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"email" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
identityEmail
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
identityName
      ]


-- | Construct a value of type 'Identity' (by applying it's required fields, if any)
mkIdentity
  :: Identity
mkIdentity :: Identity
mkIdentity =
  Identity
  { $sel:identityEmail:Identity :: Maybe Text
identityEmail = Maybe Text
forall a. Maybe a
Nothing
  , $sel:identityName:Identity :: Maybe Text
identityName = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** InternalTracker
-- | InternalTracker
-- InternalTracker represents settings for internal tracker
data InternalTracker = InternalTracker
  { InternalTracker -> Maybe Bool
internalTrackerAllowOnlyContributorsToTrackTime :: !(Maybe Bool) -- ^ "allow_only_contributors_to_track_time" - Let only contributors track time (Built-in issue tracker)
  , InternalTracker -> Maybe Bool
internalTrackerEnableIssueDependencies :: !(Maybe Bool) -- ^ "enable_issue_dependencies" - Enable dependencies for issues and pull requests (Built-in issue tracker)
  , InternalTracker -> Maybe Bool
internalTrackerEnableTimeTracker :: !(Maybe Bool) -- ^ "enable_time_tracker" - Enable time tracking (Built-in issue tracker)
  } deriving (Int -> InternalTracker -> ShowS
[InternalTracker] -> ShowS
InternalTracker -> [Char]
(Int -> InternalTracker -> ShowS)
-> (InternalTracker -> [Char])
-> ([InternalTracker] -> ShowS)
-> Show InternalTracker
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InternalTracker -> ShowS
showsPrec :: Int -> InternalTracker -> ShowS
$cshow :: InternalTracker -> [Char]
show :: InternalTracker -> [Char]
$cshowList :: [InternalTracker] -> ShowS
showList :: [InternalTracker] -> ShowS
P.Show, InternalTracker -> InternalTracker -> Bool
(InternalTracker -> InternalTracker -> Bool)
-> (InternalTracker -> InternalTracker -> Bool)
-> Eq InternalTracker
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InternalTracker -> InternalTracker -> Bool
== :: InternalTracker -> InternalTracker -> Bool
$c/= :: InternalTracker -> InternalTracker -> Bool
/= :: InternalTracker -> InternalTracker -> Bool
P.Eq, P.Typeable)

-- | FromJSON InternalTracker
instance A.FromJSON InternalTracker where
  parseJSON :: Value -> Parser InternalTracker
parseJSON = [Char]
-> (Object -> Parser InternalTracker)
-> Value
-> Parser InternalTracker
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"InternalTracker" ((Object -> Parser InternalTracker)
 -> Value -> Parser InternalTracker)
-> (Object -> Parser InternalTracker)
-> Value
-> Parser InternalTracker
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool -> Maybe Bool -> Maybe Bool -> InternalTracker
InternalTracker
      (Maybe Bool -> Maybe Bool -> Maybe Bool -> InternalTracker)
-> Parser (Maybe Bool)
-> Parser (Maybe Bool -> Maybe Bool -> InternalTracker)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allow_only_contributors_to_track_time")
      Parser (Maybe Bool -> Maybe Bool -> InternalTracker)
-> Parser (Maybe Bool) -> Parser (Maybe Bool -> InternalTracker)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enable_issue_dependencies")
      Parser (Maybe Bool -> InternalTracker)
-> Parser (Maybe Bool) -> Parser InternalTracker
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enable_time_tracker")

-- | ToJSON InternalTracker
instance A.ToJSON InternalTracker where
  toJSON :: InternalTracker -> Value
toJSON InternalTracker {Maybe Bool
$sel:internalTrackerAllowOnlyContributorsToTrackTime:InternalTracker :: InternalTracker -> Maybe Bool
$sel:internalTrackerEnableIssueDependencies:InternalTracker :: InternalTracker -> Maybe Bool
$sel:internalTrackerEnableTimeTracker:InternalTracker :: InternalTracker -> Maybe Bool
internalTrackerAllowOnlyContributorsToTrackTime :: Maybe Bool
internalTrackerEnableIssueDependencies :: Maybe Bool
internalTrackerEnableTimeTracker :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"allow_only_contributors_to_track_time" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
internalTrackerAllowOnlyContributorsToTrackTime
      , Key
"enable_issue_dependencies" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
internalTrackerEnableIssueDependencies
      , Key
"enable_time_tracker" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
internalTrackerEnableTimeTracker
      ]


-- | Construct a value of type 'InternalTracker' (by applying it's required fields, if any)
mkInternalTracker
  :: InternalTracker
mkInternalTracker :: InternalTracker
mkInternalTracker =
  InternalTracker
  { $sel:internalTrackerAllowOnlyContributorsToTrackTime:InternalTracker :: Maybe Bool
internalTrackerAllowOnlyContributorsToTrackTime = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:internalTrackerEnableIssueDependencies:InternalTracker :: Maybe Bool
internalTrackerEnableIssueDependencies = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:internalTrackerEnableTimeTracker:InternalTracker :: Maybe Bool
internalTrackerEnableTimeTracker = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** Issue
-- | Issue
-- Issue represents an issue in a repository
data Issue = Issue
  { Issue -> Maybe [Attachment]
issueAssets :: !(Maybe [Attachment]) -- ^ "assets"
  , Issue -> Maybe User
issueAssignee :: !(Maybe User) -- ^ "assignee"
  , Issue -> Maybe [User]
issueAssignees :: !(Maybe [User]) -- ^ "assignees"
  , Issue -> Maybe Text
issueBody :: !(Maybe Text) -- ^ "body"
  , Issue -> Maybe DateTime
issueClosedAt :: !(Maybe DateTime) -- ^ "closed_at"
  , Issue -> Maybe Integer
issueComments :: !(Maybe Integer) -- ^ "comments"
  , Issue -> Maybe DateTime
issueCreatedAt :: !(Maybe DateTime) -- ^ "created_at"
  , Issue -> Maybe DateTime
issueDueDate :: !(Maybe DateTime) -- ^ "due_date"
  , Issue -> Maybe Text
issueHtmlUrl :: !(Maybe Text) -- ^ "html_url"
  , Issue -> Maybe Integer
issueId :: !(Maybe Integer) -- ^ "id"
  , Issue -> Maybe Bool
issueIsLocked :: !(Maybe Bool) -- ^ "is_locked"
  , Issue -> Maybe [Label]
issueLabels :: !(Maybe [Label]) -- ^ "labels"
  , Issue -> Maybe Milestone
issueMilestone :: !(Maybe Milestone) -- ^ "milestone"
  , Issue -> Maybe Integer
issueNumber :: !(Maybe Integer) -- ^ "number"
  , Issue -> Maybe Text
issueOriginalAuthor :: !(Maybe Text) -- ^ "original_author"
  , Issue -> Maybe Integer
issueOriginalAuthorId :: !(Maybe Integer) -- ^ "original_author_id"
  , Issue -> Maybe Integer
issuePinOrder :: !(Maybe Integer) -- ^ "pin_order"
  , Issue -> Maybe PullRequestMeta
issuePullRequest :: !(Maybe PullRequestMeta) -- ^ "pull_request"
  , Issue -> Maybe Text
issueRef :: !(Maybe Text) -- ^ "ref"
  , Issue -> Maybe RepositoryMeta
issueRepository :: !(Maybe RepositoryMeta) -- ^ "repository"
  , Issue -> Maybe Text
issueState :: !(Maybe Text) -- ^ "state" - StateType issue state type
  , Issue -> Maybe Text
issueTitle :: !(Maybe Text) -- ^ "title"
  , Issue -> Maybe DateTime
issueUpdatedAt :: !(Maybe DateTime) -- ^ "updated_at"
  , Issue -> Maybe Text
issueUrl :: !(Maybe Text) -- ^ "url"
  , Issue -> Maybe User
issueUser :: !(Maybe User) -- ^ "user"
  } deriving (Int -> Issue -> ShowS
[Issue] -> ShowS
Issue -> [Char]
(Int -> Issue -> ShowS)
-> (Issue -> [Char]) -> ([Issue] -> ShowS) -> Show Issue
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Issue -> ShowS
showsPrec :: Int -> Issue -> ShowS
$cshow :: Issue -> [Char]
show :: Issue -> [Char]
$cshowList :: [Issue] -> ShowS
showList :: [Issue] -> ShowS
P.Show, Issue -> Issue -> Bool
(Issue -> Issue -> Bool) -> (Issue -> Issue -> Bool) -> Eq Issue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Issue -> Issue -> Bool
== :: Issue -> Issue -> Bool
$c/= :: Issue -> Issue -> Bool
/= :: Issue -> Issue -> Bool
P.Eq, P.Typeable)

-- | FromJSON Issue
instance A.FromJSON Issue where
  parseJSON :: Value -> Parser Issue
parseJSON = [Char] -> (Object -> Parser Issue) -> Value -> Parser Issue
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Issue" ((Object -> Parser Issue) -> Value -> Parser Issue)
-> (Object -> Parser Issue) -> Value -> Parser Issue
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Attachment]
-> Maybe User
-> Maybe [User]
-> Maybe Text
-> Maybe DateTime
-> Maybe Integer
-> Maybe DateTime
-> Maybe DateTime
-> Maybe Text
-> Maybe Integer
-> Maybe Bool
-> Maybe [Label]
-> Maybe Milestone
-> Maybe Integer
-> Maybe Text
-> Maybe Integer
-> Maybe Integer
-> Maybe PullRequestMeta
-> Maybe Text
-> Maybe RepositoryMeta
-> Maybe Text
-> Maybe Text
-> Maybe DateTime
-> Maybe Text
-> Maybe User
-> Issue
Issue
      (Maybe [Attachment]
 -> Maybe User
 -> Maybe [User]
 -> Maybe Text
 -> Maybe DateTime
 -> Maybe Integer
 -> Maybe DateTime
 -> Maybe DateTime
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Bool
 -> Maybe [Label]
 -> Maybe Milestone
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Integer
 -> Maybe PullRequestMeta
 -> Maybe Text
 -> Maybe RepositoryMeta
 -> Maybe Text
 -> Maybe Text
 -> Maybe DateTime
 -> Maybe Text
 -> Maybe User
 -> Issue)
-> Parser (Maybe [Attachment])
-> Parser
     (Maybe User
      -> Maybe [User]
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Label]
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe PullRequestMeta
      -> Maybe Text
      -> Maybe RepositoryMeta
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> Issue)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [Attachment])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"assets")
      Parser
  (Maybe User
   -> Maybe [User]
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Label]
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe PullRequestMeta
   -> Maybe Text
   -> Maybe RepositoryMeta
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> Issue)
-> Parser (Maybe User)
-> Parser
     (Maybe [User]
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Label]
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe PullRequestMeta
      -> Maybe Text
      -> Maybe RepositoryMeta
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> Issue)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"assignee")
      Parser
  (Maybe [User]
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Label]
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe PullRequestMeta
   -> Maybe Text
   -> Maybe RepositoryMeta
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> Issue)
-> Parser (Maybe [User])
-> Parser
     (Maybe Text
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Label]
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe PullRequestMeta
      -> Maybe Text
      -> Maybe RepositoryMeta
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> Issue)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [User])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"assignees")
      Parser
  (Maybe Text
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Label]
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe PullRequestMeta
   -> Maybe Text
   -> Maybe RepositoryMeta
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> Issue)
-> Parser (Maybe Text)
-> Parser
     (Maybe DateTime
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Label]
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe PullRequestMeta
      -> Maybe Text
      -> Maybe RepositoryMeta
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> Issue)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"body")
      Parser
  (Maybe DateTime
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Label]
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe PullRequestMeta
   -> Maybe Text
   -> Maybe RepositoryMeta
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> Issue)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Integer
      -> Maybe DateTime
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Label]
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe PullRequestMeta
      -> Maybe Text
      -> Maybe RepositoryMeta
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> Issue)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"closed_at")
      Parser
  (Maybe Integer
   -> Maybe DateTime
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Label]
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe PullRequestMeta
   -> Maybe Text
   -> Maybe RepositoryMeta
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> Issue)
-> Parser (Maybe Integer)
-> Parser
     (Maybe DateTime
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Label]
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe PullRequestMeta
      -> Maybe Text
      -> Maybe RepositoryMeta
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> Issue)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"comments")
      Parser
  (Maybe DateTime
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Label]
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe PullRequestMeta
   -> Maybe Text
   -> Maybe RepositoryMeta
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> Issue)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Label]
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe PullRequestMeta
      -> Maybe Text
      -> Maybe RepositoryMeta
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> Issue)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_at")
      Parser
  (Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Label]
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe PullRequestMeta
   -> Maybe Text
   -> Maybe RepositoryMeta
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> Issue)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Label]
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe PullRequestMeta
      -> Maybe Text
      -> Maybe RepositoryMeta
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> Issue)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"due_date")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Label]
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe PullRequestMeta
   -> Maybe Text
   -> Maybe RepositoryMeta
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> Issue)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Bool
      -> Maybe [Label]
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe PullRequestMeta
      -> Maybe Text
      -> Maybe RepositoryMeta
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> Issue)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"html_url")
      Parser
  (Maybe Integer
   -> Maybe Bool
   -> Maybe [Label]
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe PullRequestMeta
   -> Maybe Text
   -> Maybe RepositoryMeta
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> Issue)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Bool
      -> Maybe [Label]
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe PullRequestMeta
      -> Maybe Text
      -> Maybe RepositoryMeta
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> Issue)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Bool
   -> Maybe [Label]
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe PullRequestMeta
   -> Maybe Text
   -> Maybe RepositoryMeta
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> Issue)
-> Parser (Maybe Bool)
-> Parser
     (Maybe [Label]
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe PullRequestMeta
      -> Maybe Text
      -> Maybe RepositoryMeta
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> Issue)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_locked")
      Parser
  (Maybe [Label]
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe PullRequestMeta
   -> Maybe Text
   -> Maybe RepositoryMeta
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> Issue)
-> Parser (Maybe [Label])
-> Parser
     (Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe PullRequestMeta
      -> Maybe Text
      -> Maybe RepositoryMeta
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> Issue)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Label])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"labels")
      Parser
  (Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe PullRequestMeta
   -> Maybe Text
   -> Maybe RepositoryMeta
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> Issue)
-> Parser (Maybe Milestone)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe PullRequestMeta
      -> Maybe Text
      -> Maybe RepositoryMeta
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> Issue)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Milestone)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"milestone")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe PullRequestMeta
   -> Maybe Text
   -> Maybe RepositoryMeta
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> Issue)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe PullRequestMeta
      -> Maybe Text
      -> Maybe RepositoryMeta
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> Issue)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"number")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe PullRequestMeta
   -> Maybe Text
   -> Maybe RepositoryMeta
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> Issue)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Integer
      -> Maybe PullRequestMeta
      -> Maybe Text
      -> Maybe RepositoryMeta
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> Issue)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"original_author")
      Parser
  (Maybe Integer
   -> Maybe Integer
   -> Maybe PullRequestMeta
   -> Maybe Text
   -> Maybe RepositoryMeta
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> Issue)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Integer
      -> Maybe PullRequestMeta
      -> Maybe Text
      -> Maybe RepositoryMeta
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> Issue)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"original_author_id")
      Parser
  (Maybe Integer
   -> Maybe PullRequestMeta
   -> Maybe Text
   -> Maybe RepositoryMeta
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> Issue)
-> Parser (Maybe Integer)
-> Parser
     (Maybe PullRequestMeta
      -> Maybe Text
      -> Maybe RepositoryMeta
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> Issue)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pin_order")
      Parser
  (Maybe PullRequestMeta
   -> Maybe Text
   -> Maybe RepositoryMeta
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> Issue)
-> Parser (Maybe PullRequestMeta)
-> Parser
     (Maybe Text
      -> Maybe RepositoryMeta
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> Issue)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe PullRequestMeta)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pull_request")
      Parser
  (Maybe Text
   -> Maybe RepositoryMeta
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> Issue)
-> Parser (Maybe Text)
-> Parser
     (Maybe RepositoryMeta
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> Issue)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ref")
      Parser
  (Maybe RepositoryMeta
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> Issue)
-> Parser (Maybe RepositoryMeta)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> Issue)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe RepositoryMeta)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"repository")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> Issue)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe DateTime -> Maybe Text -> Maybe User -> Issue)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"state")
      Parser
  (Maybe Text -> Maybe DateTime -> Maybe Text -> Maybe User -> Issue)
-> Parser (Maybe Text)
-> Parser (Maybe DateTime -> Maybe Text -> Maybe User -> Issue)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title")
      Parser (Maybe DateTime -> Maybe Text -> Maybe User -> Issue)
-> Parser (Maybe DateTime)
-> Parser (Maybe Text -> Maybe User -> Issue)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated_at")
      Parser (Maybe Text -> Maybe User -> Issue)
-> Parser (Maybe Text) -> Parser (Maybe User -> Issue)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")
      Parser (Maybe User -> Issue) -> Parser (Maybe User) -> Parser Issue
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user")

-- | ToJSON Issue
instance A.ToJSON Issue where
  toJSON :: Issue -> Value
toJSON Issue {Maybe Bool
Maybe Integer
Maybe [User]
Maybe [Label]
Maybe [Attachment]
Maybe Text
Maybe DateTime
Maybe User
Maybe RepositoryMeta
Maybe PullRequestMeta
Maybe Milestone
$sel:issueAssets:Issue :: Issue -> Maybe [Attachment]
$sel:issueAssignee:Issue :: Issue -> Maybe User
$sel:issueAssignees:Issue :: Issue -> Maybe [User]
$sel:issueBody:Issue :: Issue -> Maybe Text
$sel:issueClosedAt:Issue :: Issue -> Maybe DateTime
$sel:issueComments:Issue :: Issue -> Maybe Integer
$sel:issueCreatedAt:Issue :: Issue -> Maybe DateTime
$sel:issueDueDate:Issue :: Issue -> Maybe DateTime
$sel:issueHtmlUrl:Issue :: Issue -> Maybe Text
$sel:issueId:Issue :: Issue -> Maybe Integer
$sel:issueIsLocked:Issue :: Issue -> Maybe Bool
$sel:issueLabels:Issue :: Issue -> Maybe [Label]
$sel:issueMilestone:Issue :: Issue -> Maybe Milestone
$sel:issueNumber:Issue :: Issue -> Maybe Integer
$sel:issueOriginalAuthor:Issue :: Issue -> Maybe Text
$sel:issueOriginalAuthorId:Issue :: Issue -> Maybe Integer
$sel:issuePinOrder:Issue :: Issue -> Maybe Integer
$sel:issuePullRequest:Issue :: Issue -> Maybe PullRequestMeta
$sel:issueRef:Issue :: Issue -> Maybe Text
$sel:issueRepository:Issue :: Issue -> Maybe RepositoryMeta
$sel:issueState:Issue :: Issue -> Maybe Text
$sel:issueTitle:Issue :: Issue -> Maybe Text
$sel:issueUpdatedAt:Issue :: Issue -> Maybe DateTime
$sel:issueUrl:Issue :: Issue -> Maybe Text
$sel:issueUser:Issue :: Issue -> Maybe User
issueAssets :: Maybe [Attachment]
issueAssignee :: Maybe User
issueAssignees :: Maybe [User]
issueBody :: Maybe Text
issueClosedAt :: Maybe DateTime
issueComments :: Maybe Integer
issueCreatedAt :: Maybe DateTime
issueDueDate :: Maybe DateTime
issueHtmlUrl :: Maybe Text
issueId :: Maybe Integer
issueIsLocked :: Maybe Bool
issueLabels :: Maybe [Label]
issueMilestone :: Maybe Milestone
issueNumber :: Maybe Integer
issueOriginalAuthor :: Maybe Text
issueOriginalAuthorId :: Maybe Integer
issuePinOrder :: Maybe Integer
issuePullRequest :: Maybe PullRequestMeta
issueRef :: Maybe Text
issueRepository :: Maybe RepositoryMeta
issueState :: Maybe Text
issueTitle :: Maybe Text
issueUpdatedAt :: Maybe DateTime
issueUrl :: Maybe Text
issueUser :: Maybe User
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"assets" Key -> Maybe [Attachment] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Attachment]
issueAssets
      , Key
"assignee" Key -> Maybe User -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe User
issueAssignee
      , Key
"assignees" Key -> Maybe [User] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [User]
issueAssignees
      , Key
"body" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
issueBody
      , Key
"closed_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
issueClosedAt
      , Key
"comments" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
issueComments
      , Key
"created_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
issueCreatedAt
      , Key
"due_date" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
issueDueDate
      , Key
"html_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
issueHtmlUrl
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
issueId
      , Key
"is_locked" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
issueIsLocked
      , Key
"labels" Key -> Maybe [Label] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Label]
issueLabels
      , Key
"milestone" Key -> Maybe Milestone -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Milestone
issueMilestone
      , Key
"number" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
issueNumber
      , Key
"original_author" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
issueOriginalAuthor
      , Key
"original_author_id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
issueOriginalAuthorId
      , Key
"pin_order" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
issuePinOrder
      , Key
"pull_request" Key -> Maybe PullRequestMeta -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe PullRequestMeta
issuePullRequest
      , Key
"ref" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
issueRef
      , Key
"repository" Key -> Maybe RepositoryMeta -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe RepositoryMeta
issueRepository
      , Key
"state" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
issueState
      , Key
"title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
issueTitle
      , Key
"updated_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
issueUpdatedAt
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
issueUrl
      , Key
"user" Key -> Maybe User -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe User
issueUser
      ]


-- | Construct a value of type 'Issue' (by applying it's required fields, if any)
mkIssue
  :: Issue
mkIssue :: Issue
mkIssue =
  Issue
  { $sel:issueAssets:Issue :: Maybe [Attachment]
issueAssets = Maybe [Attachment]
forall a. Maybe a
Nothing
  , $sel:issueAssignee:Issue :: Maybe User
issueAssignee = Maybe User
forall a. Maybe a
Nothing
  , $sel:issueAssignees:Issue :: Maybe [User]
issueAssignees = Maybe [User]
forall a. Maybe a
Nothing
  , $sel:issueBody:Issue :: Maybe Text
issueBody = Maybe Text
forall a. Maybe a
Nothing
  , $sel:issueClosedAt:Issue :: Maybe DateTime
issueClosedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:issueComments:Issue :: Maybe Integer
issueComments = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:issueCreatedAt:Issue :: Maybe DateTime
issueCreatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:issueDueDate:Issue :: Maybe DateTime
issueDueDate = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:issueHtmlUrl:Issue :: Maybe Text
issueHtmlUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:issueId:Issue :: Maybe Integer
issueId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:issueIsLocked:Issue :: Maybe Bool
issueIsLocked = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:issueLabels:Issue :: Maybe [Label]
issueLabels = Maybe [Label]
forall a. Maybe a
Nothing
  , $sel:issueMilestone:Issue :: Maybe Milestone
issueMilestone = Maybe Milestone
forall a. Maybe a
Nothing
  , $sel:issueNumber:Issue :: Maybe Integer
issueNumber = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:issueOriginalAuthor:Issue :: Maybe Text
issueOriginalAuthor = Maybe Text
forall a. Maybe a
Nothing
  , $sel:issueOriginalAuthorId:Issue :: Maybe Integer
issueOriginalAuthorId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:issuePinOrder:Issue :: Maybe Integer
issuePinOrder = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:issuePullRequest:Issue :: Maybe PullRequestMeta
issuePullRequest = Maybe PullRequestMeta
forall a. Maybe a
Nothing
  , $sel:issueRef:Issue :: Maybe Text
issueRef = Maybe Text
forall a. Maybe a
Nothing
  , $sel:issueRepository:Issue :: Maybe RepositoryMeta
issueRepository = Maybe RepositoryMeta
forall a. Maybe a
Nothing
  , $sel:issueState:Issue :: Maybe Text
issueState = Maybe Text
forall a. Maybe a
Nothing
  , $sel:issueTitle:Issue :: Maybe Text
issueTitle = Maybe Text
forall a. Maybe a
Nothing
  , $sel:issueUpdatedAt:Issue :: Maybe DateTime
issueUpdatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:issueUrl:Issue :: Maybe Text
issueUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:issueUser:Issue :: Maybe User
issueUser = Maybe User
forall a. Maybe a
Nothing
  }

-- ** IssueConfig
-- | IssueConfig
data IssueConfig = IssueConfig
  { IssueConfig -> Maybe Bool
issueConfigBlankIssuesEnabled :: !(Maybe Bool) -- ^ "blank_issues_enabled"
  , IssueConfig -> Maybe [IssueConfigContactLink]
issueConfigContactLinks :: !(Maybe [IssueConfigContactLink]) -- ^ "contact_links"
  } deriving (Int -> IssueConfig -> ShowS
[IssueConfig] -> ShowS
IssueConfig -> [Char]
(Int -> IssueConfig -> ShowS)
-> (IssueConfig -> [Char])
-> ([IssueConfig] -> ShowS)
-> Show IssueConfig
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IssueConfig -> ShowS
showsPrec :: Int -> IssueConfig -> ShowS
$cshow :: IssueConfig -> [Char]
show :: IssueConfig -> [Char]
$cshowList :: [IssueConfig] -> ShowS
showList :: [IssueConfig] -> ShowS
P.Show, IssueConfig -> IssueConfig -> Bool
(IssueConfig -> IssueConfig -> Bool)
-> (IssueConfig -> IssueConfig -> Bool) -> Eq IssueConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IssueConfig -> IssueConfig -> Bool
== :: IssueConfig -> IssueConfig -> Bool
$c/= :: IssueConfig -> IssueConfig -> Bool
/= :: IssueConfig -> IssueConfig -> Bool
P.Eq, P.Typeable)

-- | FromJSON IssueConfig
instance A.FromJSON IssueConfig where
  parseJSON :: Value -> Parser IssueConfig
parseJSON = [Char]
-> (Object -> Parser IssueConfig) -> Value -> Parser IssueConfig
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"IssueConfig" ((Object -> Parser IssueConfig) -> Value -> Parser IssueConfig)
-> (Object -> Parser IssueConfig) -> Value -> Parser IssueConfig
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool -> Maybe [IssueConfigContactLink] -> IssueConfig
IssueConfig
      (Maybe Bool -> Maybe [IssueConfigContactLink] -> IssueConfig)
-> Parser (Maybe Bool)
-> Parser (Maybe [IssueConfigContactLink] -> IssueConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"blank_issues_enabled")
      Parser (Maybe [IssueConfigContactLink] -> IssueConfig)
-> Parser (Maybe [IssueConfigContactLink]) -> Parser IssueConfig
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [IssueConfigContactLink])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"contact_links")

-- | ToJSON IssueConfig
instance A.ToJSON IssueConfig where
  toJSON :: IssueConfig -> Value
toJSON IssueConfig {Maybe Bool
Maybe [IssueConfigContactLink]
$sel:issueConfigBlankIssuesEnabled:IssueConfig :: IssueConfig -> Maybe Bool
$sel:issueConfigContactLinks:IssueConfig :: IssueConfig -> Maybe [IssueConfigContactLink]
issueConfigBlankIssuesEnabled :: Maybe Bool
issueConfigContactLinks :: Maybe [IssueConfigContactLink]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"blank_issues_enabled" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
issueConfigBlankIssuesEnabled
      , Key
"contact_links" Key -> Maybe [IssueConfigContactLink] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [IssueConfigContactLink]
issueConfigContactLinks
      ]


-- | Construct a value of type 'IssueConfig' (by applying it's required fields, if any)
mkIssueConfig
  :: IssueConfig
mkIssueConfig :: IssueConfig
mkIssueConfig =
  IssueConfig
  { $sel:issueConfigBlankIssuesEnabled:IssueConfig :: Maybe Bool
issueConfigBlankIssuesEnabled = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:issueConfigContactLinks:IssueConfig :: Maybe [IssueConfigContactLink]
issueConfigContactLinks = Maybe [IssueConfigContactLink]
forall a. Maybe a
Nothing
  }

-- ** IssueConfigContactLink
-- | IssueConfigContactLink
data IssueConfigContactLink = IssueConfigContactLink
  { IssueConfigContactLink -> Maybe Text
issueConfigContactLinkAbout :: !(Maybe Text) -- ^ "about"
  , IssueConfigContactLink -> Maybe Text
issueConfigContactLinkName :: !(Maybe Text) -- ^ "name"
  , IssueConfigContactLink -> Maybe Text
issueConfigContactLinkUrl :: !(Maybe Text) -- ^ "url"
  } deriving (Int -> IssueConfigContactLink -> ShowS
[IssueConfigContactLink] -> ShowS
IssueConfigContactLink -> [Char]
(Int -> IssueConfigContactLink -> ShowS)
-> (IssueConfigContactLink -> [Char])
-> ([IssueConfigContactLink] -> ShowS)
-> Show IssueConfigContactLink
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IssueConfigContactLink -> ShowS
showsPrec :: Int -> IssueConfigContactLink -> ShowS
$cshow :: IssueConfigContactLink -> [Char]
show :: IssueConfigContactLink -> [Char]
$cshowList :: [IssueConfigContactLink] -> ShowS
showList :: [IssueConfigContactLink] -> ShowS
P.Show, IssueConfigContactLink -> IssueConfigContactLink -> Bool
(IssueConfigContactLink -> IssueConfigContactLink -> Bool)
-> (IssueConfigContactLink -> IssueConfigContactLink -> Bool)
-> Eq IssueConfigContactLink
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IssueConfigContactLink -> IssueConfigContactLink -> Bool
== :: IssueConfigContactLink -> IssueConfigContactLink -> Bool
$c/= :: IssueConfigContactLink -> IssueConfigContactLink -> Bool
/= :: IssueConfigContactLink -> IssueConfigContactLink -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON IssueConfigContactLink
instance A.ToJSON IssueConfigContactLink where
  toJSON :: IssueConfigContactLink -> Value
toJSON IssueConfigContactLink {Maybe Text
$sel:issueConfigContactLinkAbout:IssueConfigContactLink :: IssueConfigContactLink -> Maybe Text
$sel:issueConfigContactLinkName:IssueConfigContactLink :: IssueConfigContactLink -> Maybe Text
$sel:issueConfigContactLinkUrl:IssueConfigContactLink :: IssueConfigContactLink -> Maybe Text
issueConfigContactLinkAbout :: Maybe Text
issueConfigContactLinkName :: Maybe Text
issueConfigContactLinkUrl :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"about" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
issueConfigContactLinkAbout
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
issueConfigContactLinkName
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
issueConfigContactLinkUrl
      ]


-- | Construct a value of type 'IssueConfigContactLink' (by applying it's required fields, if any)
mkIssueConfigContactLink
  :: IssueConfigContactLink
mkIssueConfigContactLink :: IssueConfigContactLink
mkIssueConfigContactLink =
  IssueConfigContactLink
  { $sel:issueConfigContactLinkAbout:IssueConfigContactLink :: Maybe Text
issueConfigContactLinkAbout = Maybe Text
forall a. Maybe a
Nothing
  , $sel:issueConfigContactLinkName:IssueConfigContactLink :: Maybe Text
issueConfigContactLinkName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:issueConfigContactLinkUrl:IssueConfigContactLink :: Maybe Text
issueConfigContactLinkUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** IssueConfigValidation
-- | IssueConfigValidation
data IssueConfigValidation = IssueConfigValidation
  { IssueConfigValidation -> Maybe Text
issueConfigValidationMessage :: !(Maybe Text) -- ^ "message"
  , IssueConfigValidation -> Maybe Bool
issueConfigValidationValid :: !(Maybe Bool) -- ^ "valid"
  } deriving (Int -> IssueConfigValidation -> ShowS
[IssueConfigValidation] -> ShowS
IssueConfigValidation -> [Char]
(Int -> IssueConfigValidation -> ShowS)
-> (IssueConfigValidation -> [Char])
-> ([IssueConfigValidation] -> ShowS)
-> Show IssueConfigValidation
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IssueConfigValidation -> ShowS
showsPrec :: Int -> IssueConfigValidation -> ShowS
$cshow :: IssueConfigValidation -> [Char]
show :: IssueConfigValidation -> [Char]
$cshowList :: [IssueConfigValidation] -> ShowS
showList :: [IssueConfigValidation] -> ShowS
P.Show, IssueConfigValidation -> IssueConfigValidation -> Bool
(IssueConfigValidation -> IssueConfigValidation -> Bool)
-> (IssueConfigValidation -> IssueConfigValidation -> Bool)
-> Eq IssueConfigValidation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IssueConfigValidation -> IssueConfigValidation -> Bool
== :: IssueConfigValidation -> IssueConfigValidation -> Bool
$c/= :: IssueConfigValidation -> IssueConfigValidation -> Bool
/= :: IssueConfigValidation -> IssueConfigValidation -> Bool
P.Eq, P.Typeable)

-- | FromJSON IssueConfigValidation
instance A.FromJSON IssueConfigValidation where
  parseJSON :: Value -> Parser IssueConfigValidation
parseJSON = [Char]
-> (Object -> Parser IssueConfigValidation)
-> Value
-> Parser IssueConfigValidation
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"IssueConfigValidation" ((Object -> Parser IssueConfigValidation)
 -> Value -> Parser IssueConfigValidation)
-> (Object -> Parser IssueConfigValidation)
-> Value
-> Parser IssueConfigValidation
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Bool -> IssueConfigValidation
IssueConfigValidation
      (Maybe Text -> Maybe Bool -> IssueConfigValidation)
-> Parser (Maybe Text)
-> Parser (Maybe Bool -> IssueConfigValidation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"message")
      Parser (Maybe Bool -> IssueConfigValidation)
-> Parser (Maybe Bool) -> Parser IssueConfigValidation
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"valid")

-- | ToJSON IssueConfigValidation
instance A.ToJSON IssueConfigValidation where
  toJSON :: IssueConfigValidation -> Value
toJSON IssueConfigValidation {Maybe Bool
Maybe Text
$sel:issueConfigValidationMessage:IssueConfigValidation :: IssueConfigValidation -> Maybe Text
$sel:issueConfigValidationValid:IssueConfigValidation :: IssueConfigValidation -> Maybe Bool
issueConfigValidationMessage :: Maybe Text
issueConfigValidationValid :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"message" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
issueConfigValidationMessage
      , Key
"valid" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
issueConfigValidationValid
      ]


-- | Construct a value of type 'IssueConfigValidation' (by applying it's required fields, if any)
mkIssueConfigValidation
  :: IssueConfigValidation
mkIssueConfigValidation :: IssueConfigValidation
mkIssueConfigValidation =
  IssueConfigValidation
  { $sel:issueConfigValidationMessage:IssueConfigValidation :: Maybe Text
issueConfigValidationMessage = Maybe Text
forall a. Maybe a
Nothing
  , $sel:issueConfigValidationValid:IssueConfigValidation :: Maybe Bool
issueConfigValidationValid = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** IssueDeadline
-- | IssueDeadline
-- IssueDeadline represents an issue deadline
data IssueDeadline = IssueDeadline
  { IssueDeadline -> Maybe DateTime
issueDeadlineDueDate :: !(Maybe DateTime) -- ^ "due_date"
  } deriving (Int -> IssueDeadline -> ShowS
[IssueDeadline] -> ShowS
IssueDeadline -> [Char]
(Int -> IssueDeadline -> ShowS)
-> (IssueDeadline -> [Char])
-> ([IssueDeadline] -> ShowS)
-> Show IssueDeadline
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IssueDeadline -> ShowS
showsPrec :: Int -> IssueDeadline -> ShowS
$cshow :: IssueDeadline -> [Char]
show :: IssueDeadline -> [Char]
$cshowList :: [IssueDeadline] -> ShowS
showList :: [IssueDeadline] -> ShowS
P.Show, IssueDeadline -> IssueDeadline -> Bool
(IssueDeadline -> IssueDeadline -> Bool)
-> (IssueDeadline -> IssueDeadline -> Bool) -> Eq IssueDeadline
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IssueDeadline -> IssueDeadline -> Bool
== :: IssueDeadline -> IssueDeadline -> Bool
$c/= :: IssueDeadline -> IssueDeadline -> Bool
/= :: IssueDeadline -> IssueDeadline -> Bool
P.Eq, P.Typeable)

-- | FromJSON IssueDeadline
instance A.FromJSON IssueDeadline where
  parseJSON :: Value -> Parser IssueDeadline
parseJSON = [Char]
-> (Object -> Parser IssueDeadline)
-> Value
-> Parser IssueDeadline
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"IssueDeadline" ((Object -> Parser IssueDeadline) -> Value -> Parser IssueDeadline)
-> (Object -> Parser IssueDeadline)
-> Value
-> Parser IssueDeadline
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe DateTime -> IssueDeadline
IssueDeadline
      (Maybe DateTime -> IssueDeadline)
-> Parser (Maybe DateTime) -> Parser IssueDeadline
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"due_date")

-- | ToJSON IssueDeadline
instance A.ToJSON IssueDeadline where
  toJSON :: IssueDeadline -> Value
toJSON IssueDeadline {Maybe DateTime
$sel:issueDeadlineDueDate:IssueDeadline :: IssueDeadline -> Maybe DateTime
issueDeadlineDueDate :: Maybe DateTime
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"due_date" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
issueDeadlineDueDate
      ]


-- | Construct a value of type 'IssueDeadline' (by applying it's required fields, if any)
mkIssueDeadline
  :: IssueDeadline
mkIssueDeadline :: IssueDeadline
mkIssueDeadline =
  IssueDeadline
  { $sel:issueDeadlineDueDate:IssueDeadline :: Maybe DateTime
issueDeadlineDueDate = Maybe DateTime
forall a. Maybe a
Nothing
  }

-- ** IssueFormField
-- | IssueFormField
-- IssueFormField represents a form field
data IssueFormField = IssueFormField
  { IssueFormField -> Maybe (Map [Char] Value)
issueFormFieldAttributes :: !(Maybe (Map.Map String A.Value)) -- ^ "attributes"
  , IssueFormField -> Maybe Text
issueFormFieldId :: !(Maybe Text) -- ^ "id"
  , IssueFormField -> Maybe Text
issueFormFieldType :: !(Maybe Text) -- ^ "type"
  , IssueFormField -> Maybe (Map [Char] Value)
issueFormFieldValidations :: !(Maybe (Map.Map String A.Value)) -- ^ "validations"
  , IssueFormField -> Maybe [Text]
issueFormFieldVisible :: !(Maybe [Text]) -- ^ "visible"
  } deriving (Int -> IssueFormField -> ShowS
[IssueFormField] -> ShowS
IssueFormField -> [Char]
(Int -> IssueFormField -> ShowS)
-> (IssueFormField -> [Char])
-> ([IssueFormField] -> ShowS)
-> Show IssueFormField
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IssueFormField -> ShowS
showsPrec :: Int -> IssueFormField -> ShowS
$cshow :: IssueFormField -> [Char]
show :: IssueFormField -> [Char]
$cshowList :: [IssueFormField] -> ShowS
showList :: [IssueFormField] -> ShowS
P.Show, IssueFormField -> IssueFormField -> Bool
(IssueFormField -> IssueFormField -> Bool)
-> (IssueFormField -> IssueFormField -> Bool) -> Eq IssueFormField
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IssueFormField -> IssueFormField -> Bool
== :: IssueFormField -> IssueFormField -> Bool
$c/= :: IssueFormField -> IssueFormField -> Bool
/= :: IssueFormField -> IssueFormField -> Bool
P.Eq, P.Typeable)

-- | FromJSON IssueFormField
instance A.FromJSON IssueFormField where
  parseJSON :: Value -> Parser IssueFormField
parseJSON = [Char]
-> (Object -> Parser IssueFormField)
-> Value
-> Parser IssueFormField
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"IssueFormField" ((Object -> Parser IssueFormField)
 -> Value -> Parser IssueFormField)
-> (Object -> Parser IssueFormField)
-> Value
-> Parser IssueFormField
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe (Map [Char] Value)
-> Maybe Text
-> Maybe Text
-> Maybe (Map [Char] Value)
-> Maybe [Text]
-> IssueFormField
IssueFormField
      (Maybe (Map [Char] Value)
 -> Maybe Text
 -> Maybe Text
 -> Maybe (Map [Char] Value)
 -> Maybe [Text]
 -> IssueFormField)
-> Parser (Maybe (Map [Char] Value))
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe (Map [Char] Value)
      -> Maybe [Text]
      -> IssueFormField)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe (Map [Char] Value))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"attributes")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe (Map [Char] Value)
   -> Maybe [Text]
   -> IssueFormField)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe (Map [Char] Value) -> Maybe [Text] -> IssueFormField)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Text
   -> Maybe (Map [Char] Value) -> Maybe [Text] -> IssueFormField)
-> Parser (Maybe Text)
-> Parser
     (Maybe (Map [Char] Value) -> Maybe [Text] -> IssueFormField)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"type")
      Parser (Maybe (Map [Char] Value) -> Maybe [Text] -> IssueFormField)
-> Parser (Maybe (Map [Char] Value))
-> Parser (Maybe [Text] -> IssueFormField)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe (Map [Char] Value))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"validations")
      Parser (Maybe [Text] -> IssueFormField)
-> Parser (Maybe [Text]) -> Parser IssueFormField
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"visible")

-- | ToJSON IssueFormField
instance A.ToJSON IssueFormField where
  toJSON :: IssueFormField -> Value
toJSON IssueFormField {Maybe [Text]
Maybe (Map [Char] Value)
Maybe Text
$sel:issueFormFieldAttributes:IssueFormField :: IssueFormField -> Maybe (Map [Char] Value)
$sel:issueFormFieldId:IssueFormField :: IssueFormField -> Maybe Text
$sel:issueFormFieldType:IssueFormField :: IssueFormField -> Maybe Text
$sel:issueFormFieldValidations:IssueFormField :: IssueFormField -> Maybe (Map [Char] Value)
$sel:issueFormFieldVisible:IssueFormField :: IssueFormField -> Maybe [Text]
issueFormFieldAttributes :: Maybe (Map [Char] Value)
issueFormFieldId :: Maybe Text
issueFormFieldType :: Maybe Text
issueFormFieldValidations :: Maybe (Map [Char] Value)
issueFormFieldVisible :: Maybe [Text]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"attributes" Key -> Maybe (Map [Char] Value) -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe (Map [Char] Value)
issueFormFieldAttributes
      , Key
"id" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
issueFormFieldId
      , Key
"type" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
issueFormFieldType
      , Key
"validations" Key -> Maybe (Map [Char] Value) -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe (Map [Char] Value)
issueFormFieldValidations
      , Key
"visible" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
issueFormFieldVisible
      ]


-- | Construct a value of type 'IssueFormField' (by applying it's required fields, if any)
mkIssueFormField
  :: IssueFormField
mkIssueFormField :: IssueFormField
mkIssueFormField =
  IssueFormField
  { $sel:issueFormFieldAttributes:IssueFormField :: Maybe (Map [Char] Value)
issueFormFieldAttributes = Maybe (Map [Char] Value)
forall a. Maybe a
Nothing
  , $sel:issueFormFieldId:IssueFormField :: Maybe Text
issueFormFieldId = Maybe Text
forall a. Maybe a
Nothing
  , $sel:issueFormFieldType:IssueFormField :: Maybe Text
issueFormFieldType = Maybe Text
forall a. Maybe a
Nothing
  , $sel:issueFormFieldValidations:IssueFormField :: Maybe (Map [Char] Value)
issueFormFieldValidations = Maybe (Map [Char] Value)
forall a. Maybe a
Nothing
  , $sel:issueFormFieldVisible:IssueFormField :: Maybe [Text]
issueFormFieldVisible = Maybe [Text]
forall a. Maybe a
Nothing
  }

-- ** IssueLabelsOption
-- | IssueLabelsOption
-- IssueLabelsOption a collection of labels
data IssueLabelsOption = IssueLabelsOption
  { IssueLabelsOption -> Maybe [Value]
issueLabelsOptionLabels :: !(Maybe [A.Value]) -- ^ "labels" - Labels can be a list of integers representing label IDs or a list of strings representing label names
  } deriving (Int -> IssueLabelsOption -> ShowS
[IssueLabelsOption] -> ShowS
IssueLabelsOption -> [Char]
(Int -> IssueLabelsOption -> ShowS)
-> (IssueLabelsOption -> [Char])
-> ([IssueLabelsOption] -> ShowS)
-> Show IssueLabelsOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IssueLabelsOption -> ShowS
showsPrec :: Int -> IssueLabelsOption -> ShowS
$cshow :: IssueLabelsOption -> [Char]
show :: IssueLabelsOption -> [Char]
$cshowList :: [IssueLabelsOption] -> ShowS
showList :: [IssueLabelsOption] -> ShowS
P.Show, IssueLabelsOption -> IssueLabelsOption -> Bool
(IssueLabelsOption -> IssueLabelsOption -> Bool)
-> (IssueLabelsOption -> IssueLabelsOption -> Bool)
-> Eq IssueLabelsOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IssueLabelsOption -> IssueLabelsOption -> Bool
== :: IssueLabelsOption -> IssueLabelsOption -> Bool
$c/= :: IssueLabelsOption -> IssueLabelsOption -> Bool
/= :: IssueLabelsOption -> IssueLabelsOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON IssueLabelsOption
instance A.FromJSON IssueLabelsOption where
  parseJSON :: Value -> Parser IssueLabelsOption
parseJSON = [Char]
-> (Object -> Parser IssueLabelsOption)
-> Value
-> Parser IssueLabelsOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"IssueLabelsOption" ((Object -> Parser IssueLabelsOption)
 -> Value -> Parser IssueLabelsOption)
-> (Object -> Parser IssueLabelsOption)
-> Value
-> Parser IssueLabelsOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Value] -> IssueLabelsOption
IssueLabelsOption
      (Maybe [Value] -> IssueLabelsOption)
-> Parser (Maybe [Value]) -> Parser IssueLabelsOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [Value])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"labels")

-- | ToJSON IssueLabelsOption
instance A.ToJSON IssueLabelsOption where
  toJSON :: IssueLabelsOption -> Value
toJSON IssueLabelsOption {Maybe [Value]
$sel:issueLabelsOptionLabels:IssueLabelsOption :: IssueLabelsOption -> Maybe [Value]
issueLabelsOptionLabels :: Maybe [Value]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"labels" Key -> Maybe [Value] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Value]
issueLabelsOptionLabels
      ]


-- | Construct a value of type 'IssueLabelsOption' (by applying it's required fields, if any)
mkIssueLabelsOption
  :: IssueLabelsOption
mkIssueLabelsOption :: IssueLabelsOption
mkIssueLabelsOption =
  IssueLabelsOption
  { $sel:issueLabelsOptionLabels:IssueLabelsOption :: Maybe [Value]
issueLabelsOptionLabels = Maybe [Value]
forall a. Maybe a
Nothing
  }

-- ** IssueMeta
-- | IssueMeta
-- IssueMeta basic issue information
data IssueMeta = IssueMeta
  { IssueMeta -> Maybe Integer
issueMetaIndex :: !(Maybe Integer) -- ^ "index"
  , IssueMeta -> Maybe Text
issueMetaOwner :: !(Maybe Text) -- ^ "owner"
  , IssueMeta -> Maybe Text
issueMetaRepo :: !(Maybe Text) -- ^ "repo"
  } deriving (Int -> IssueMeta -> ShowS
[IssueMeta] -> ShowS
IssueMeta -> [Char]
(Int -> IssueMeta -> ShowS)
-> (IssueMeta -> [Char])
-> ([IssueMeta] -> ShowS)
-> Show IssueMeta
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IssueMeta -> ShowS
showsPrec :: Int -> IssueMeta -> ShowS
$cshow :: IssueMeta -> [Char]
show :: IssueMeta -> [Char]
$cshowList :: [IssueMeta] -> ShowS
showList :: [IssueMeta] -> ShowS
P.Show, IssueMeta -> IssueMeta -> Bool
(IssueMeta -> IssueMeta -> Bool)
-> (IssueMeta -> IssueMeta -> Bool) -> Eq IssueMeta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IssueMeta -> IssueMeta -> Bool
== :: IssueMeta -> IssueMeta -> Bool
$c/= :: IssueMeta -> IssueMeta -> Bool
/= :: IssueMeta -> IssueMeta -> Bool
P.Eq, P.Typeable)

-- | FromJSON IssueMeta
instance A.FromJSON IssueMeta where
  parseJSON :: Value -> Parser IssueMeta
parseJSON = [Char] -> (Object -> Parser IssueMeta) -> Value -> Parser IssueMeta
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"IssueMeta" ((Object -> Parser IssueMeta) -> Value -> Parser IssueMeta)
-> (Object -> Parser IssueMeta) -> Value -> Parser IssueMeta
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Integer -> Maybe Text -> Maybe Text -> IssueMeta
IssueMeta
      (Maybe Integer -> Maybe Text -> Maybe Text -> IssueMeta)
-> Parser (Maybe Integer)
-> Parser (Maybe Text -> Maybe Text -> IssueMeta)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"index")
      Parser (Maybe Text -> Maybe Text -> IssueMeta)
-> Parser (Maybe Text) -> Parser (Maybe Text -> IssueMeta)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"owner")
      Parser (Maybe Text -> IssueMeta)
-> Parser (Maybe Text) -> Parser IssueMeta
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"repo")

-- | ToJSON IssueMeta
instance A.ToJSON IssueMeta where
  toJSON :: IssueMeta -> Value
toJSON IssueMeta {Maybe Integer
Maybe Text
$sel:issueMetaIndex:IssueMeta :: IssueMeta -> Maybe Integer
$sel:issueMetaOwner:IssueMeta :: IssueMeta -> Maybe Text
$sel:issueMetaRepo:IssueMeta :: IssueMeta -> Maybe Text
issueMetaIndex :: Maybe Integer
issueMetaOwner :: Maybe Text
issueMetaRepo :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"index" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
issueMetaIndex
      , Key
"owner" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
issueMetaOwner
      , Key
"repo" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
issueMetaRepo
      ]


-- | Construct a value of type 'IssueMeta' (by applying it's required fields, if any)
mkIssueMeta
  :: IssueMeta
mkIssueMeta :: IssueMeta
mkIssueMeta =
  IssueMeta
  { $sel:issueMetaIndex:IssueMeta :: Maybe Integer
issueMetaIndex = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:issueMetaOwner:IssueMeta :: Maybe Text
issueMetaOwner = Maybe Text
forall a. Maybe a
Nothing
  , $sel:issueMetaRepo:IssueMeta :: Maybe Text
issueMetaRepo = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** IssueTemplate
-- | IssueTemplate
-- IssueTemplate represents an issue template for a repository
data IssueTemplate = IssueTemplate
  { IssueTemplate -> Maybe Text
issueTemplateAbout :: !(Maybe Text) -- ^ "about"
  , IssueTemplate -> Maybe [Text]
issueTemplateAssignees :: !(Maybe [Text]) -- ^ "assignees"
  , IssueTemplate -> Maybe [IssueFormField]
issueTemplateBody :: !(Maybe [IssueFormField]) -- ^ "body"
  , IssueTemplate -> Maybe Text
issueTemplateContent :: !(Maybe Text) -- ^ "content"
  , IssueTemplate -> Maybe Text
issueTemplateFileName :: !(Maybe Text) -- ^ "file_name"
  , IssueTemplate -> Maybe [Text]
issueTemplateLabels :: !(Maybe [Text]) -- ^ "labels"
  , IssueTemplate -> Maybe Text
issueTemplateName :: !(Maybe Text) -- ^ "name"
  , IssueTemplate -> Maybe Text
issueTemplateRef :: !(Maybe Text) -- ^ "ref"
  , IssueTemplate -> Maybe Text
issueTemplateTitle :: !(Maybe Text) -- ^ "title"
  } deriving (Int -> IssueTemplate -> ShowS
[IssueTemplate] -> ShowS
IssueTemplate -> [Char]
(Int -> IssueTemplate -> ShowS)
-> (IssueTemplate -> [Char])
-> ([IssueTemplate] -> ShowS)
-> Show IssueTemplate
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IssueTemplate -> ShowS
showsPrec :: Int -> IssueTemplate -> ShowS
$cshow :: IssueTemplate -> [Char]
show :: IssueTemplate -> [Char]
$cshowList :: [IssueTemplate] -> ShowS
showList :: [IssueTemplate] -> ShowS
P.Show, IssueTemplate -> IssueTemplate -> Bool
(IssueTemplate -> IssueTemplate -> Bool)
-> (IssueTemplate -> IssueTemplate -> Bool) -> Eq IssueTemplate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IssueTemplate -> IssueTemplate -> Bool
== :: IssueTemplate -> IssueTemplate -> Bool
$c/= :: IssueTemplate -> IssueTemplate -> Bool
/= :: IssueTemplate -> IssueTemplate -> Bool
P.Eq, P.Typeable)

-- | FromJSON IssueTemplate
instance A.FromJSON IssueTemplate where
  parseJSON :: Value -> Parser IssueTemplate
parseJSON = [Char]
-> (Object -> Parser IssueTemplate)
-> Value
-> Parser IssueTemplate
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"IssueTemplate" ((Object -> Parser IssueTemplate) -> Value -> Parser IssueTemplate)
-> (Object -> Parser IssueTemplate)
-> Value
-> Parser IssueTemplate
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe [Text]
-> Maybe [IssueFormField]
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> IssueTemplate
IssueTemplate
      (Maybe Text
 -> Maybe [Text]
 -> Maybe [IssueFormField]
 -> Maybe Text
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> IssueTemplate)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text]
      -> Maybe [IssueFormField]
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> IssueTemplate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"about")
      Parser
  (Maybe [Text]
   -> Maybe [IssueFormField]
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> IssueTemplate)
-> Parser (Maybe [Text])
-> Parser
     (Maybe [IssueFormField]
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> IssueTemplate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"assignees")
      Parser
  (Maybe [IssueFormField]
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> IssueTemplate)
-> Parser (Maybe [IssueFormField])
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> IssueTemplate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [IssueFormField])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"body")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> IssueTemplate)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> IssueTemplate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"content")
      Parser
  (Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> IssueTemplate)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text]
      -> Maybe Text -> Maybe Text -> Maybe Text -> IssueTemplate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"file_name")
      Parser
  (Maybe [Text]
   -> Maybe Text -> Maybe Text -> Maybe Text -> IssueTemplate)
-> Parser (Maybe [Text])
-> Parser (Maybe Text -> Maybe Text -> Maybe Text -> IssueTemplate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"labels")
      Parser (Maybe Text -> Maybe Text -> Maybe Text -> IssueTemplate)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> IssueTemplate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser (Maybe Text -> Maybe Text -> IssueTemplate)
-> Parser (Maybe Text) -> Parser (Maybe Text -> IssueTemplate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ref")
      Parser (Maybe Text -> IssueTemplate)
-> Parser (Maybe Text) -> Parser IssueTemplate
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title")

-- | ToJSON IssueTemplate
instance A.ToJSON IssueTemplate where
  toJSON :: IssueTemplate -> Value
toJSON IssueTemplate {Maybe [Text]
Maybe [IssueFormField]
Maybe Text
$sel:issueTemplateAbout:IssueTemplate :: IssueTemplate -> Maybe Text
$sel:issueTemplateAssignees:IssueTemplate :: IssueTemplate -> Maybe [Text]
$sel:issueTemplateBody:IssueTemplate :: IssueTemplate -> Maybe [IssueFormField]
$sel:issueTemplateContent:IssueTemplate :: IssueTemplate -> Maybe Text
$sel:issueTemplateFileName:IssueTemplate :: IssueTemplate -> Maybe Text
$sel:issueTemplateLabels:IssueTemplate :: IssueTemplate -> Maybe [Text]
$sel:issueTemplateName:IssueTemplate :: IssueTemplate -> Maybe Text
$sel:issueTemplateRef:IssueTemplate :: IssueTemplate -> Maybe Text
$sel:issueTemplateTitle:IssueTemplate :: IssueTemplate -> Maybe Text
issueTemplateAbout :: Maybe Text
issueTemplateAssignees :: Maybe [Text]
issueTemplateBody :: Maybe [IssueFormField]
issueTemplateContent :: Maybe Text
issueTemplateFileName :: Maybe Text
issueTemplateLabels :: Maybe [Text]
issueTemplateName :: Maybe Text
issueTemplateRef :: Maybe Text
issueTemplateTitle :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"about" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
issueTemplateAbout
      , Key
"assignees" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
issueTemplateAssignees
      , Key
"body" Key -> Maybe [IssueFormField] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [IssueFormField]
issueTemplateBody
      , Key
"content" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
issueTemplateContent
      , Key
"file_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
issueTemplateFileName
      , Key
"labels" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
issueTemplateLabels
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
issueTemplateName
      , Key
"ref" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
issueTemplateRef
      , Key
"title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
issueTemplateTitle
      ]


-- | Construct a value of type 'IssueTemplate' (by applying it's required fields, if any)
mkIssueTemplate
  :: IssueTemplate
mkIssueTemplate :: IssueTemplate
mkIssueTemplate =
  IssueTemplate
  { $sel:issueTemplateAbout:IssueTemplate :: Maybe Text
issueTemplateAbout = Maybe Text
forall a. Maybe a
Nothing
  , $sel:issueTemplateAssignees:IssueTemplate :: Maybe [Text]
issueTemplateAssignees = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:issueTemplateBody:IssueTemplate :: Maybe [IssueFormField]
issueTemplateBody = Maybe [IssueFormField]
forall a. Maybe a
Nothing
  , $sel:issueTemplateContent:IssueTemplate :: Maybe Text
issueTemplateContent = Maybe Text
forall a. Maybe a
Nothing
  , $sel:issueTemplateFileName:IssueTemplate :: Maybe Text
issueTemplateFileName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:issueTemplateLabels:IssueTemplate :: Maybe [Text]
issueTemplateLabels = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:issueTemplateName:IssueTemplate :: Maybe Text
issueTemplateName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:issueTemplateRef:IssueTemplate :: Maybe Text
issueTemplateRef = Maybe Text
forall a. Maybe a
Nothing
  , $sel:issueTemplateTitle:IssueTemplate :: Maybe Text
issueTemplateTitle = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** Label
-- | Label
-- Label a label to an issue or a pr
data Label = Label
  { Label -> Maybe Text
labelColor :: !(Maybe Text) -- ^ "color"
  , Label -> Maybe Text
labelDescription :: !(Maybe Text) -- ^ "description"
  , Label -> Maybe Bool
labelExclusive :: !(Maybe Bool) -- ^ "exclusive"
  , Label -> Maybe Integer
labelId :: !(Maybe Integer) -- ^ "id"
  , Label -> Maybe Bool
labelIsArchived :: !(Maybe Bool) -- ^ "is_archived"
  , Label -> Maybe Text
labelName :: !(Maybe Text) -- ^ "name"
  , Label -> Maybe Text
labelUrl :: !(Maybe Text) -- ^ "url"
  } deriving (Int -> Label -> ShowS
[Label] -> ShowS
Label -> [Char]
(Int -> Label -> ShowS)
-> (Label -> [Char]) -> ([Label] -> ShowS) -> Show Label
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Label -> ShowS
showsPrec :: Int -> Label -> ShowS
$cshow :: Label -> [Char]
show :: Label -> [Char]
$cshowList :: [Label] -> ShowS
showList :: [Label] -> ShowS
P.Show, Label -> Label -> Bool
(Label -> Label -> Bool) -> (Label -> Label -> Bool) -> Eq Label
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Label -> Label -> Bool
== :: Label -> Label -> Bool
$c/= :: Label -> Label -> Bool
/= :: Label -> Label -> Bool
P.Eq, P.Typeable)

-- | FromJSON Label
instance A.FromJSON Label where
  parseJSON :: Value -> Parser Label
parseJSON = [Char] -> (Object -> Parser Label) -> Value -> Parser Label
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Label" ((Object -> Parser Label) -> Value -> Parser Label)
-> (Object -> Parser Label) -> Value -> Parser Label
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Integer
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Label
Label
      (Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Integer
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Text
 -> Label)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Label)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"color")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Label)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Label)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe Bool
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Label)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Integer -> Maybe Bool -> Maybe Text -> Maybe Text -> Label)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"exclusive")
      Parser
  (Maybe Integer -> Maybe Bool -> Maybe Text -> Maybe Text -> Label)
-> Parser (Maybe Integer)
-> Parser (Maybe Bool -> Maybe Text -> Maybe Text -> Label)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser (Maybe Bool -> Maybe Text -> Maybe Text -> Label)
-> Parser (Maybe Bool)
-> Parser (Maybe Text -> Maybe Text -> Label)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_archived")
      Parser (Maybe Text -> Maybe Text -> Label)
-> Parser (Maybe Text) -> Parser (Maybe Text -> Label)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser (Maybe Text -> Label) -> Parser (Maybe Text) -> Parser Label
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")

-- | ToJSON Label
instance A.ToJSON Label where
  toJSON :: Label -> Value
toJSON Label {Maybe Bool
Maybe Integer
Maybe Text
$sel:labelColor:Label :: Label -> Maybe Text
$sel:labelDescription:Label :: Label -> Maybe Text
$sel:labelExclusive:Label :: Label -> Maybe Bool
$sel:labelId:Label :: Label -> Maybe Integer
$sel:labelIsArchived:Label :: Label -> Maybe Bool
$sel:labelName:Label :: Label -> Maybe Text
$sel:labelUrl:Label :: Label -> Maybe Text
labelColor :: Maybe Text
labelDescription :: Maybe Text
labelExclusive :: Maybe Bool
labelId :: Maybe Integer
labelIsArchived :: Maybe Bool
labelName :: Maybe Text
labelUrl :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"color" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
labelColor
      , Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
labelDescription
      , Key
"exclusive" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
labelExclusive
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
labelId
      , Key
"is_archived" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
labelIsArchived
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
labelName
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
labelUrl
      ]


-- | Construct a value of type 'Label' (by applying it's required fields, if any)
mkLabel
  :: Label
mkLabel :: Label
mkLabel =
  Label
  { $sel:labelColor:Label :: Maybe Text
labelColor = Maybe Text
forall a. Maybe a
Nothing
  , $sel:labelDescription:Label :: Maybe Text
labelDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:labelExclusive:Label :: Maybe Bool
labelExclusive = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:labelId:Label :: Maybe Integer
labelId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:labelIsArchived:Label :: Maybe Bool
labelIsArchived = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:labelName:Label :: Maybe Text
labelName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:labelUrl:Label :: Maybe Text
labelUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** LabelTemplate
-- | LabelTemplate
-- LabelTemplate info of a Label template
data LabelTemplate = LabelTemplate
  { LabelTemplate -> Maybe Text
labelTemplateColor :: !(Maybe Text) -- ^ "color"
  , LabelTemplate -> Maybe Text
labelTemplateDescription :: !(Maybe Text) -- ^ "description"
  , LabelTemplate -> Maybe Bool
labelTemplateExclusive :: !(Maybe Bool) -- ^ "exclusive"
  , LabelTemplate -> Maybe Text
labelTemplateName :: !(Maybe Text) -- ^ "name"
  } deriving (Int -> LabelTemplate -> ShowS
[LabelTemplate] -> ShowS
LabelTemplate -> [Char]
(Int -> LabelTemplate -> ShowS)
-> (LabelTemplate -> [Char])
-> ([LabelTemplate] -> ShowS)
-> Show LabelTemplate
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LabelTemplate -> ShowS
showsPrec :: Int -> LabelTemplate -> ShowS
$cshow :: LabelTemplate -> [Char]
show :: LabelTemplate -> [Char]
$cshowList :: [LabelTemplate] -> ShowS
showList :: [LabelTemplate] -> ShowS
P.Show, LabelTemplate -> LabelTemplate -> Bool
(LabelTemplate -> LabelTemplate -> Bool)
-> (LabelTemplate -> LabelTemplate -> Bool) -> Eq LabelTemplate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LabelTemplate -> LabelTemplate -> Bool
== :: LabelTemplate -> LabelTemplate -> Bool
$c/= :: LabelTemplate -> LabelTemplate -> Bool
/= :: LabelTemplate -> LabelTemplate -> Bool
P.Eq, P.Typeable)

-- | FromJSON LabelTemplate
instance A.FromJSON LabelTemplate where
  parseJSON :: Value -> Parser LabelTemplate
parseJSON = [Char]
-> (Object -> Parser LabelTemplate)
-> Value
-> Parser LabelTemplate
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"LabelTemplate" ((Object -> Parser LabelTemplate) -> Value -> Parser LabelTemplate)
-> (Object -> Parser LabelTemplate)
-> Value
-> Parser LabelTemplate
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text -> Maybe Bool -> Maybe Text -> LabelTemplate
LabelTemplate
      (Maybe Text
 -> Maybe Text -> Maybe Bool -> Maybe Text -> LabelTemplate)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Bool -> Maybe Text -> LabelTemplate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"color")
      Parser (Maybe Text -> Maybe Bool -> Maybe Text -> LabelTemplate)
-> Parser (Maybe Text)
-> Parser (Maybe Bool -> Maybe Text -> LabelTemplate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser (Maybe Bool -> Maybe Text -> LabelTemplate)
-> Parser (Maybe Bool) -> Parser (Maybe Text -> LabelTemplate)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"exclusive")
      Parser (Maybe Text -> LabelTemplate)
-> Parser (Maybe Text) -> Parser LabelTemplate
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")

-- | ToJSON LabelTemplate
instance A.ToJSON LabelTemplate where
  toJSON :: LabelTemplate -> Value
toJSON LabelTemplate {Maybe Bool
Maybe Text
$sel:labelTemplateColor:LabelTemplate :: LabelTemplate -> Maybe Text
$sel:labelTemplateDescription:LabelTemplate :: LabelTemplate -> Maybe Text
$sel:labelTemplateExclusive:LabelTemplate :: LabelTemplate -> Maybe Bool
$sel:labelTemplateName:LabelTemplate :: LabelTemplate -> Maybe Text
labelTemplateColor :: Maybe Text
labelTemplateDescription :: Maybe Text
labelTemplateExclusive :: Maybe Bool
labelTemplateName :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"color" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
labelTemplateColor
      , Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
labelTemplateDescription
      , Key
"exclusive" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
labelTemplateExclusive
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
labelTemplateName
      ]


-- | Construct a value of type 'LabelTemplate' (by applying it's required fields, if any)
mkLabelTemplate
  :: LabelTemplate
mkLabelTemplate :: LabelTemplate
mkLabelTemplate =
  LabelTemplate
  { $sel:labelTemplateColor:LabelTemplate :: Maybe Text
labelTemplateColor = Maybe Text
forall a. Maybe a
Nothing
  , $sel:labelTemplateDescription:LabelTemplate :: Maybe Text
labelTemplateDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:labelTemplateExclusive:LabelTemplate :: Maybe Bool
labelTemplateExclusive = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:labelTemplateName:LabelTemplate :: Maybe Text
labelTemplateName = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** LicenseTemplateInfo
-- | LicenseTemplateInfo
-- LicensesInfo contains information about a License
data LicenseTemplateInfo = LicenseTemplateInfo
  { LicenseTemplateInfo -> Maybe Text
licenseTemplateInfoBody :: !(Maybe Text) -- ^ "body"
  , LicenseTemplateInfo -> Maybe Text
licenseTemplateInfoImplementation :: !(Maybe Text) -- ^ "implementation"
  , LicenseTemplateInfo -> Maybe Text
licenseTemplateInfoKey :: !(Maybe Text) -- ^ "key"
  , LicenseTemplateInfo -> Maybe Text
licenseTemplateInfoName :: !(Maybe Text) -- ^ "name"
  , LicenseTemplateInfo -> Maybe Text
licenseTemplateInfoUrl :: !(Maybe Text) -- ^ "url"
  } deriving (Int -> LicenseTemplateInfo -> ShowS
[LicenseTemplateInfo] -> ShowS
LicenseTemplateInfo -> [Char]
(Int -> LicenseTemplateInfo -> ShowS)
-> (LicenseTemplateInfo -> [Char])
-> ([LicenseTemplateInfo] -> ShowS)
-> Show LicenseTemplateInfo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LicenseTemplateInfo -> ShowS
showsPrec :: Int -> LicenseTemplateInfo -> ShowS
$cshow :: LicenseTemplateInfo -> [Char]
show :: LicenseTemplateInfo -> [Char]
$cshowList :: [LicenseTemplateInfo] -> ShowS
showList :: [LicenseTemplateInfo] -> ShowS
P.Show, LicenseTemplateInfo -> LicenseTemplateInfo -> Bool
(LicenseTemplateInfo -> LicenseTemplateInfo -> Bool)
-> (LicenseTemplateInfo -> LicenseTemplateInfo -> Bool)
-> Eq LicenseTemplateInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LicenseTemplateInfo -> LicenseTemplateInfo -> Bool
== :: LicenseTemplateInfo -> LicenseTemplateInfo -> Bool
$c/= :: LicenseTemplateInfo -> LicenseTemplateInfo -> Bool
/= :: LicenseTemplateInfo -> LicenseTemplateInfo -> Bool
P.Eq, P.Typeable)

-- | FromJSON LicenseTemplateInfo
instance A.FromJSON LicenseTemplateInfo where
  parseJSON :: Value -> Parser LicenseTemplateInfo
parseJSON = [Char]
-> (Object -> Parser LicenseTemplateInfo)
-> Value
-> Parser LicenseTemplateInfo
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"LicenseTemplateInfo" ((Object -> Parser LicenseTemplateInfo)
 -> Value -> Parser LicenseTemplateInfo)
-> (Object -> Parser LicenseTemplateInfo)
-> Value
-> Parser LicenseTemplateInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> LicenseTemplateInfo
LicenseTemplateInfo
      (Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> LicenseTemplateInfo)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe Text -> Maybe Text -> LicenseTemplateInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"body")
      Parser
  (Maybe Text
   -> Maybe Text -> Maybe Text -> Maybe Text -> LicenseTemplateInfo)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Text -> Maybe Text -> LicenseTemplateInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"implementation")
      Parser
  (Maybe Text -> Maybe Text -> Maybe Text -> LicenseTemplateInfo)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> LicenseTemplateInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"key")
      Parser (Maybe Text -> Maybe Text -> LicenseTemplateInfo)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> LicenseTemplateInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser (Maybe Text -> LicenseTemplateInfo)
-> Parser (Maybe Text) -> Parser LicenseTemplateInfo
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")

-- | ToJSON LicenseTemplateInfo
instance A.ToJSON LicenseTemplateInfo where
  toJSON :: LicenseTemplateInfo -> Value
toJSON LicenseTemplateInfo {Maybe Text
$sel:licenseTemplateInfoBody:LicenseTemplateInfo :: LicenseTemplateInfo -> Maybe Text
$sel:licenseTemplateInfoImplementation:LicenseTemplateInfo :: LicenseTemplateInfo -> Maybe Text
$sel:licenseTemplateInfoKey:LicenseTemplateInfo :: LicenseTemplateInfo -> Maybe Text
$sel:licenseTemplateInfoName:LicenseTemplateInfo :: LicenseTemplateInfo -> Maybe Text
$sel:licenseTemplateInfoUrl:LicenseTemplateInfo :: LicenseTemplateInfo -> Maybe Text
licenseTemplateInfoBody :: Maybe Text
licenseTemplateInfoImplementation :: Maybe Text
licenseTemplateInfoKey :: Maybe Text
licenseTemplateInfoName :: Maybe Text
licenseTemplateInfoUrl :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"body" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
licenseTemplateInfoBody
      , Key
"implementation" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
licenseTemplateInfoImplementation
      , Key
"key" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
licenseTemplateInfoKey
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
licenseTemplateInfoName
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
licenseTemplateInfoUrl
      ]


-- | Construct a value of type 'LicenseTemplateInfo' (by applying it's required fields, if any)
mkLicenseTemplateInfo
  :: LicenseTemplateInfo
mkLicenseTemplateInfo :: LicenseTemplateInfo
mkLicenseTemplateInfo =
  LicenseTemplateInfo
  { $sel:licenseTemplateInfoBody:LicenseTemplateInfo :: Maybe Text
licenseTemplateInfoBody = Maybe Text
forall a. Maybe a
Nothing
  , $sel:licenseTemplateInfoImplementation:LicenseTemplateInfo :: Maybe Text
licenseTemplateInfoImplementation = Maybe Text
forall a. Maybe a
Nothing
  , $sel:licenseTemplateInfoKey:LicenseTemplateInfo :: Maybe Text
licenseTemplateInfoKey = Maybe Text
forall a. Maybe a
Nothing
  , $sel:licenseTemplateInfoName:LicenseTemplateInfo :: Maybe Text
licenseTemplateInfoName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:licenseTemplateInfoUrl:LicenseTemplateInfo :: Maybe Text
licenseTemplateInfoUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** LicensesTemplateListEntry
-- | LicensesTemplateListEntry
-- LicensesListEntry is used for the API
data LicensesTemplateListEntry = LicensesTemplateListEntry
  { LicensesTemplateListEntry -> Maybe Text
licensesTemplateListEntryKey :: !(Maybe Text) -- ^ "key"
  , LicensesTemplateListEntry -> Maybe Text
licensesTemplateListEntryName :: !(Maybe Text) -- ^ "name"
  , LicensesTemplateListEntry -> Maybe Text
licensesTemplateListEntryUrl :: !(Maybe Text) -- ^ "url"
  } deriving (Int -> LicensesTemplateListEntry -> ShowS
[LicensesTemplateListEntry] -> ShowS
LicensesTemplateListEntry -> [Char]
(Int -> LicensesTemplateListEntry -> ShowS)
-> (LicensesTemplateListEntry -> [Char])
-> ([LicensesTemplateListEntry] -> ShowS)
-> Show LicensesTemplateListEntry
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LicensesTemplateListEntry -> ShowS
showsPrec :: Int -> LicensesTemplateListEntry -> ShowS
$cshow :: LicensesTemplateListEntry -> [Char]
show :: LicensesTemplateListEntry -> [Char]
$cshowList :: [LicensesTemplateListEntry] -> ShowS
showList :: [LicensesTemplateListEntry] -> ShowS
P.Show, LicensesTemplateListEntry -> LicensesTemplateListEntry -> Bool
(LicensesTemplateListEntry -> LicensesTemplateListEntry -> Bool)
-> (LicensesTemplateListEntry -> LicensesTemplateListEntry -> Bool)
-> Eq LicensesTemplateListEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LicensesTemplateListEntry -> LicensesTemplateListEntry -> Bool
== :: LicensesTemplateListEntry -> LicensesTemplateListEntry -> Bool
$c/= :: LicensesTemplateListEntry -> LicensesTemplateListEntry -> Bool
/= :: LicensesTemplateListEntry -> LicensesTemplateListEntry -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON LicensesTemplateListEntry
instance A.ToJSON LicensesTemplateListEntry where
  toJSON :: LicensesTemplateListEntry -> Value
toJSON LicensesTemplateListEntry {Maybe Text
$sel:licensesTemplateListEntryKey:LicensesTemplateListEntry :: LicensesTemplateListEntry -> Maybe Text
$sel:licensesTemplateListEntryName:LicensesTemplateListEntry :: LicensesTemplateListEntry -> Maybe Text
$sel:licensesTemplateListEntryUrl:LicensesTemplateListEntry :: LicensesTemplateListEntry -> Maybe Text
licensesTemplateListEntryKey :: Maybe Text
licensesTemplateListEntryName :: Maybe Text
licensesTemplateListEntryUrl :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"key" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
licensesTemplateListEntryKey
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
licensesTemplateListEntryName
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
licensesTemplateListEntryUrl
      ]


-- | Construct a value of type 'LicensesTemplateListEntry' (by applying it's required fields, if any)
mkLicensesTemplateListEntry
  :: LicensesTemplateListEntry
mkLicensesTemplateListEntry :: LicensesTemplateListEntry
mkLicensesTemplateListEntry =
  LicensesTemplateListEntry
  { $sel:licensesTemplateListEntryKey:LicensesTemplateListEntry :: Maybe Text
licensesTemplateListEntryKey = Maybe Text
forall a. Maybe a
Nothing
  , $sel:licensesTemplateListEntryName:LicensesTemplateListEntry :: Maybe Text
licensesTemplateListEntryName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:licensesTemplateListEntryUrl:LicensesTemplateListEntry :: Maybe Text
licensesTemplateListEntryUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** MarkdownOption
-- | MarkdownOption
-- MarkdownOption markdown options
data MarkdownOption = MarkdownOption
  { MarkdownOption -> Maybe Text
markdownOptionContext :: !(Maybe Text) -- ^ "Context" - URL path for rendering issue, media and file links Expected format: /subpath/{user}/{repo}/src/{branch, commit, tag}/{identifier/path}/{file/dir}  in: body
  , MarkdownOption -> Maybe Text
markdownOptionMode :: !(Maybe Text) -- ^ "Mode" - Mode to render (markdown, comment, wiki, file)  in: body
  , MarkdownOption -> Maybe Text
markdownOptionText :: !(Maybe Text) -- ^ "Text" - Text markdown to render  in: body
  , MarkdownOption -> Maybe Bool
markdownOptionWiki :: !(Maybe Bool) -- ^ "Wiki" - Is it a wiki page? (use mode&#x3D;wiki instead)  Deprecated: true in: body
  } deriving (Int -> MarkdownOption -> ShowS
[MarkdownOption] -> ShowS
MarkdownOption -> [Char]
(Int -> MarkdownOption -> ShowS)
-> (MarkdownOption -> [Char])
-> ([MarkdownOption] -> ShowS)
-> Show MarkdownOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MarkdownOption -> ShowS
showsPrec :: Int -> MarkdownOption -> ShowS
$cshow :: MarkdownOption -> [Char]
show :: MarkdownOption -> [Char]
$cshowList :: [MarkdownOption] -> ShowS
showList :: [MarkdownOption] -> ShowS
P.Show, MarkdownOption -> MarkdownOption -> Bool
(MarkdownOption -> MarkdownOption -> Bool)
-> (MarkdownOption -> MarkdownOption -> Bool) -> Eq MarkdownOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MarkdownOption -> MarkdownOption -> Bool
== :: MarkdownOption -> MarkdownOption -> Bool
$c/= :: MarkdownOption -> MarkdownOption -> Bool
/= :: MarkdownOption -> MarkdownOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON MarkdownOption
instance A.FromJSON MarkdownOption where
  parseJSON :: Value -> Parser MarkdownOption
parseJSON = [Char]
-> (Object -> Parser MarkdownOption)
-> Value
-> Parser MarkdownOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"MarkdownOption" ((Object -> Parser MarkdownOption)
 -> Value -> Parser MarkdownOption)
-> (Object -> Parser MarkdownOption)
-> Value
-> Parser MarkdownOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text -> Maybe Text -> Maybe Bool -> MarkdownOption
MarkdownOption
      (Maybe Text
 -> Maybe Text -> Maybe Text -> Maybe Bool -> MarkdownOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Text -> Maybe Bool -> MarkdownOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"Context")
      Parser (Maybe Text -> Maybe Text -> Maybe Bool -> MarkdownOption)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Bool -> MarkdownOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"Mode")
      Parser (Maybe Text -> Maybe Bool -> MarkdownOption)
-> Parser (Maybe Text) -> Parser (Maybe Bool -> MarkdownOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"Text")
      Parser (Maybe Bool -> MarkdownOption)
-> Parser (Maybe Bool) -> Parser MarkdownOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"Wiki")

-- | ToJSON MarkdownOption
instance A.ToJSON MarkdownOption where
  toJSON :: MarkdownOption -> Value
toJSON MarkdownOption {Maybe Bool
Maybe Text
$sel:markdownOptionContext:MarkdownOption :: MarkdownOption -> Maybe Text
$sel:markdownOptionMode:MarkdownOption :: MarkdownOption -> Maybe Text
$sel:markdownOptionText:MarkdownOption :: MarkdownOption -> Maybe Text
$sel:markdownOptionWiki:MarkdownOption :: MarkdownOption -> Maybe Bool
markdownOptionContext :: Maybe Text
markdownOptionMode :: Maybe Text
markdownOptionText :: Maybe Text
markdownOptionWiki :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"Context" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
markdownOptionContext
      , Key
"Mode" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
markdownOptionMode
      , Key
"Text" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
markdownOptionText
      , Key
"Wiki" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
markdownOptionWiki
      ]


-- | Construct a value of type 'MarkdownOption' (by applying it's required fields, if any)
mkMarkdownOption
  :: MarkdownOption
mkMarkdownOption :: MarkdownOption
mkMarkdownOption =
  MarkdownOption
  { $sel:markdownOptionContext:MarkdownOption :: Maybe Text
markdownOptionContext = Maybe Text
forall a. Maybe a
Nothing
  , $sel:markdownOptionMode:MarkdownOption :: Maybe Text
markdownOptionMode = Maybe Text
forall a. Maybe a
Nothing
  , $sel:markdownOptionText:MarkdownOption :: Maybe Text
markdownOptionText = Maybe Text
forall a. Maybe a
Nothing
  , $sel:markdownOptionWiki:MarkdownOption :: Maybe Bool
markdownOptionWiki = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** MarkupOption
-- | MarkupOption
-- MarkupOption markup options
data MarkupOption = MarkupOption
  { MarkupOption -> Maybe Text
markupOptionContext :: !(Maybe Text) -- ^ "Context" - URL path for rendering issue, media and file links Expected format: /subpath/{user}/{repo}/src/{branch, commit, tag}/{identifier/path}/{file/dir}  in: body
  , MarkupOption -> Maybe Text
markupOptionFilePath :: !(Maybe Text) -- ^ "FilePath" - File path for detecting extension in file mode  in: body
  , MarkupOption -> Maybe Text
markupOptionMode :: !(Maybe Text) -- ^ "Mode" - Mode to render (markdown, comment, wiki, file)  in: body
  , MarkupOption -> Maybe Text
markupOptionText :: !(Maybe Text) -- ^ "Text" - Text markup to render  in: body
  , MarkupOption -> Maybe Bool
markupOptionWiki :: !(Maybe Bool) -- ^ "Wiki" - Is it a wiki page? (use mode&#x3D;wiki instead)  Deprecated: true in: body
  } deriving (Int -> MarkupOption -> ShowS
[MarkupOption] -> ShowS
MarkupOption -> [Char]
(Int -> MarkupOption -> ShowS)
-> (MarkupOption -> [Char])
-> ([MarkupOption] -> ShowS)
-> Show MarkupOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MarkupOption -> ShowS
showsPrec :: Int -> MarkupOption -> ShowS
$cshow :: MarkupOption -> [Char]
show :: MarkupOption -> [Char]
$cshowList :: [MarkupOption] -> ShowS
showList :: [MarkupOption] -> ShowS
P.Show, MarkupOption -> MarkupOption -> Bool
(MarkupOption -> MarkupOption -> Bool)
-> (MarkupOption -> MarkupOption -> Bool) -> Eq MarkupOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MarkupOption -> MarkupOption -> Bool
== :: MarkupOption -> MarkupOption -> Bool
$c/= :: MarkupOption -> MarkupOption -> Bool
/= :: MarkupOption -> MarkupOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON MarkupOption
instance A.FromJSON MarkupOption where
  parseJSON :: Value -> Parser MarkupOption
parseJSON = [Char]
-> (Object -> Parser MarkupOption) -> Value -> Parser MarkupOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"MarkupOption" ((Object -> Parser MarkupOption) -> Value -> Parser MarkupOption)
-> (Object -> Parser MarkupOption) -> Value -> Parser MarkupOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> MarkupOption
MarkupOption
      (Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> MarkupOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe Text -> Maybe Bool -> MarkupOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"Context")
      Parser
  (Maybe Text
   -> Maybe Text -> Maybe Text -> Maybe Bool -> MarkupOption)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> Maybe Bool -> MarkupOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"FilePath")
      Parser (Maybe Text -> Maybe Text -> Maybe Bool -> MarkupOption)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Bool -> MarkupOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"Mode")
      Parser (Maybe Text -> Maybe Bool -> MarkupOption)
-> Parser (Maybe Text) -> Parser (Maybe Bool -> MarkupOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"Text")
      Parser (Maybe Bool -> MarkupOption)
-> Parser (Maybe Bool) -> Parser MarkupOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"Wiki")

-- | ToJSON MarkupOption
instance A.ToJSON MarkupOption where
  toJSON :: MarkupOption -> Value
toJSON MarkupOption {Maybe Bool
Maybe Text
$sel:markupOptionContext:MarkupOption :: MarkupOption -> Maybe Text
$sel:markupOptionFilePath:MarkupOption :: MarkupOption -> Maybe Text
$sel:markupOptionMode:MarkupOption :: MarkupOption -> Maybe Text
$sel:markupOptionText:MarkupOption :: MarkupOption -> Maybe Text
$sel:markupOptionWiki:MarkupOption :: MarkupOption -> Maybe Bool
markupOptionContext :: Maybe Text
markupOptionFilePath :: Maybe Text
markupOptionMode :: Maybe Text
markupOptionText :: Maybe Text
markupOptionWiki :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"Context" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
markupOptionContext
      , Key
"FilePath" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
markupOptionFilePath
      , Key
"Mode" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
markupOptionMode
      , Key
"Text" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
markupOptionText
      , Key
"Wiki" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
markupOptionWiki
      ]


-- | Construct a value of type 'MarkupOption' (by applying it's required fields, if any)
mkMarkupOption
  :: MarkupOption
mkMarkupOption :: MarkupOption
mkMarkupOption =
  MarkupOption
  { $sel:markupOptionContext:MarkupOption :: Maybe Text
markupOptionContext = Maybe Text
forall a. Maybe a
Nothing
  , $sel:markupOptionFilePath:MarkupOption :: Maybe Text
markupOptionFilePath = Maybe Text
forall a. Maybe a
Nothing
  , $sel:markupOptionMode:MarkupOption :: Maybe Text
markupOptionMode = Maybe Text
forall a. Maybe a
Nothing
  , $sel:markupOptionText:MarkupOption :: Maybe Text
markupOptionText = Maybe Text
forall a. Maybe a
Nothing
  , $sel:markupOptionWiki:MarkupOption :: Maybe Bool
markupOptionWiki = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** MergePullRequestOption
-- | MergePullRequestOption
-- MergePullRequestForm form for merging Pull Request
data MergePullRequestOption = MergePullRequestOption
  { MergePullRequestOption -> E'Do
mergePullRequestOptionDo :: !(E'Do) -- ^ /Required/ "Do"
  , MergePullRequestOption -> Maybe Text
mergePullRequestOptionMergeCommitId :: !(Maybe Text) -- ^ "MergeCommitID"
  , MergePullRequestOption -> Maybe Text
mergePullRequestOptionMergeMessageField :: !(Maybe Text) -- ^ "MergeMessageField"
  , MergePullRequestOption -> Maybe Text
mergePullRequestOptionMergeTitleField :: !(Maybe Text) -- ^ "MergeTitleField"
  , MergePullRequestOption -> Maybe Bool
mergePullRequestOptionDeleteBranchAfterMerge :: !(Maybe Bool) -- ^ "delete_branch_after_merge"
  , MergePullRequestOption -> Maybe Bool
mergePullRequestOptionForceMerge :: !(Maybe Bool) -- ^ "force_merge"
  , MergePullRequestOption -> Maybe Text
mergePullRequestOptionHeadCommitId :: !(Maybe Text) -- ^ "head_commit_id"
  , MergePullRequestOption -> Maybe Bool
mergePullRequestOptionMergeWhenChecksSucceed :: !(Maybe Bool) -- ^ "merge_when_checks_succeed"
  } deriving (Int -> MergePullRequestOption -> ShowS
[MergePullRequestOption] -> ShowS
MergePullRequestOption -> [Char]
(Int -> MergePullRequestOption -> ShowS)
-> (MergePullRequestOption -> [Char])
-> ([MergePullRequestOption] -> ShowS)
-> Show MergePullRequestOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MergePullRequestOption -> ShowS
showsPrec :: Int -> MergePullRequestOption -> ShowS
$cshow :: MergePullRequestOption -> [Char]
show :: MergePullRequestOption -> [Char]
$cshowList :: [MergePullRequestOption] -> ShowS
showList :: [MergePullRequestOption] -> ShowS
P.Show, MergePullRequestOption -> MergePullRequestOption -> Bool
(MergePullRequestOption -> MergePullRequestOption -> Bool)
-> (MergePullRequestOption -> MergePullRequestOption -> Bool)
-> Eq MergePullRequestOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MergePullRequestOption -> MergePullRequestOption -> Bool
== :: MergePullRequestOption -> MergePullRequestOption -> Bool
$c/= :: MergePullRequestOption -> MergePullRequestOption -> Bool
/= :: MergePullRequestOption -> MergePullRequestOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON MergePullRequestOption
instance A.FromJSON MergePullRequestOption where
  parseJSON :: Value -> Parser MergePullRequestOption
parseJSON = [Char]
-> (Object -> Parser MergePullRequestOption)
-> Value
-> Parser MergePullRequestOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"MergePullRequestOption" ((Object -> Parser MergePullRequestOption)
 -> Value -> Parser MergePullRequestOption)
-> (Object -> Parser MergePullRequestOption)
-> Value
-> Parser MergePullRequestOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    E'Do
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> MergePullRequestOption
MergePullRequestOption
      (E'Do
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Bool
 -> MergePullRequestOption)
-> Parser E'Do
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> MergePullRequestOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser E'Do
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"Do")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> MergePullRequestOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> MergePullRequestOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"MergeCommitID")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> MergePullRequestOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> MergePullRequestOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"MergeMessageField")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> MergePullRequestOption)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> MergePullRequestOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"MergeTitleField")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> MergePullRequestOption)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool -> Maybe Text -> Maybe Bool -> MergePullRequestOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"delete_branch_after_merge")
      Parser
  (Maybe Bool -> Maybe Text -> Maybe Bool -> MergePullRequestOption)
-> Parser (Maybe Bool)
-> Parser (Maybe Text -> Maybe Bool -> MergePullRequestOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"force_merge")
      Parser (Maybe Text -> Maybe Bool -> MergePullRequestOption)
-> Parser (Maybe Text)
-> Parser (Maybe Bool -> MergePullRequestOption)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"head_commit_id")
      Parser (Maybe Bool -> MergePullRequestOption)
-> Parser (Maybe Bool) -> Parser MergePullRequestOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"merge_when_checks_succeed")

-- | ToJSON MergePullRequestOption
instance A.ToJSON MergePullRequestOption where
  toJSON :: MergePullRequestOption -> Value
toJSON MergePullRequestOption {Maybe Bool
Maybe Text
E'Do
$sel:mergePullRequestOptionDo:MergePullRequestOption :: MergePullRequestOption -> E'Do
$sel:mergePullRequestOptionMergeCommitId:MergePullRequestOption :: MergePullRequestOption -> Maybe Text
$sel:mergePullRequestOptionMergeMessageField:MergePullRequestOption :: MergePullRequestOption -> Maybe Text
$sel:mergePullRequestOptionMergeTitleField:MergePullRequestOption :: MergePullRequestOption -> Maybe Text
$sel:mergePullRequestOptionDeleteBranchAfterMerge:MergePullRequestOption :: MergePullRequestOption -> Maybe Bool
$sel:mergePullRequestOptionForceMerge:MergePullRequestOption :: MergePullRequestOption -> Maybe Bool
$sel:mergePullRequestOptionHeadCommitId:MergePullRequestOption :: MergePullRequestOption -> Maybe Text
$sel:mergePullRequestOptionMergeWhenChecksSucceed:MergePullRequestOption :: MergePullRequestOption -> Maybe Bool
mergePullRequestOptionDo :: E'Do
mergePullRequestOptionMergeCommitId :: Maybe Text
mergePullRequestOptionMergeMessageField :: Maybe Text
mergePullRequestOptionMergeTitleField :: Maybe Text
mergePullRequestOptionDeleteBranchAfterMerge :: Maybe Bool
mergePullRequestOptionForceMerge :: Maybe Bool
mergePullRequestOptionHeadCommitId :: Maybe Text
mergePullRequestOptionMergeWhenChecksSucceed :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"Do" Key -> E'Do -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= E'Do
mergePullRequestOptionDo
      , Key
"MergeCommitID" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
mergePullRequestOptionMergeCommitId
      , Key
"MergeMessageField" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
mergePullRequestOptionMergeMessageField
      , Key
"MergeTitleField" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
mergePullRequestOptionMergeTitleField
      , Key
"delete_branch_after_merge" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
mergePullRequestOptionDeleteBranchAfterMerge
      , Key
"force_merge" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
mergePullRequestOptionForceMerge
      , Key
"head_commit_id" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
mergePullRequestOptionHeadCommitId
      , Key
"merge_when_checks_succeed" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
mergePullRequestOptionMergeWhenChecksSucceed
      ]


-- | Construct a value of type 'MergePullRequestOption' (by applying it's required fields, if any)
mkMergePullRequestOption
  :: E'Do -- ^ 'mergePullRequestOptionDo' 
  -> MergePullRequestOption
mkMergePullRequestOption :: E'Do -> MergePullRequestOption
mkMergePullRequestOption E'Do
mergePullRequestOptionDo =
  MergePullRequestOption
  { E'Do
$sel:mergePullRequestOptionDo:MergePullRequestOption :: E'Do
mergePullRequestOptionDo :: E'Do
mergePullRequestOptionDo
  , $sel:mergePullRequestOptionMergeCommitId:MergePullRequestOption :: Maybe Text
mergePullRequestOptionMergeCommitId = Maybe Text
forall a. Maybe a
Nothing
  , $sel:mergePullRequestOptionMergeMessageField:MergePullRequestOption :: Maybe Text
mergePullRequestOptionMergeMessageField = Maybe Text
forall a. Maybe a
Nothing
  , $sel:mergePullRequestOptionMergeTitleField:MergePullRequestOption :: Maybe Text
mergePullRequestOptionMergeTitleField = Maybe Text
forall a. Maybe a
Nothing
  , $sel:mergePullRequestOptionDeleteBranchAfterMerge:MergePullRequestOption :: Maybe Bool
mergePullRequestOptionDeleteBranchAfterMerge = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:mergePullRequestOptionForceMerge:MergePullRequestOption :: Maybe Bool
mergePullRequestOptionForceMerge = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:mergePullRequestOptionHeadCommitId:MergePullRequestOption :: Maybe Text
mergePullRequestOptionHeadCommitId = Maybe Text
forall a. Maybe a
Nothing
  , $sel:mergePullRequestOptionMergeWhenChecksSucceed:MergePullRequestOption :: Maybe Bool
mergePullRequestOptionMergeWhenChecksSucceed = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** MergeUpstreamRequest
-- | MergeUpstreamRequest
data MergeUpstreamRequest = MergeUpstreamRequest
  { MergeUpstreamRequest -> Maybe Text
mergeUpstreamRequestBranch :: !(Maybe Text) -- ^ "branch"
  } deriving (Int -> MergeUpstreamRequest -> ShowS
[MergeUpstreamRequest] -> ShowS
MergeUpstreamRequest -> [Char]
(Int -> MergeUpstreamRequest -> ShowS)
-> (MergeUpstreamRequest -> [Char])
-> ([MergeUpstreamRequest] -> ShowS)
-> Show MergeUpstreamRequest
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MergeUpstreamRequest -> ShowS
showsPrec :: Int -> MergeUpstreamRequest -> ShowS
$cshow :: MergeUpstreamRequest -> [Char]
show :: MergeUpstreamRequest -> [Char]
$cshowList :: [MergeUpstreamRequest] -> ShowS
showList :: [MergeUpstreamRequest] -> ShowS
P.Show, MergeUpstreamRequest -> MergeUpstreamRequest -> Bool
(MergeUpstreamRequest -> MergeUpstreamRequest -> Bool)
-> (MergeUpstreamRequest -> MergeUpstreamRequest -> Bool)
-> Eq MergeUpstreamRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MergeUpstreamRequest -> MergeUpstreamRequest -> Bool
== :: MergeUpstreamRequest -> MergeUpstreamRequest -> Bool
$c/= :: MergeUpstreamRequest -> MergeUpstreamRequest -> Bool
/= :: MergeUpstreamRequest -> MergeUpstreamRequest -> Bool
P.Eq, P.Typeable)

-- | FromJSON MergeUpstreamRequest
instance A.FromJSON MergeUpstreamRequest where
  parseJSON :: Value -> Parser MergeUpstreamRequest
parseJSON = [Char]
-> (Object -> Parser MergeUpstreamRequest)
-> Value
-> Parser MergeUpstreamRequest
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"MergeUpstreamRequest" ((Object -> Parser MergeUpstreamRequest)
 -> Value -> Parser MergeUpstreamRequest)
-> (Object -> Parser MergeUpstreamRequest)
-> Value
-> Parser MergeUpstreamRequest
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> MergeUpstreamRequest
MergeUpstreamRequest
      (Maybe Text -> MergeUpstreamRequest)
-> Parser (Maybe Text) -> Parser MergeUpstreamRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"branch")

-- | ToJSON MergeUpstreamRequest
instance A.ToJSON MergeUpstreamRequest where
  toJSON :: MergeUpstreamRequest -> Value
toJSON MergeUpstreamRequest {Maybe Text
$sel:mergeUpstreamRequestBranch:MergeUpstreamRequest :: MergeUpstreamRequest -> Maybe Text
mergeUpstreamRequestBranch :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"branch" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
mergeUpstreamRequestBranch
      ]


-- | Construct a value of type 'MergeUpstreamRequest' (by applying it's required fields, if any)
mkMergeUpstreamRequest
  :: MergeUpstreamRequest
mkMergeUpstreamRequest :: MergeUpstreamRequest
mkMergeUpstreamRequest =
  MergeUpstreamRequest
  { $sel:mergeUpstreamRequestBranch:MergeUpstreamRequest :: Maybe Text
mergeUpstreamRequestBranch = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** MergeUpstreamResponse
-- | MergeUpstreamResponse
data MergeUpstreamResponse = MergeUpstreamResponse
  { MergeUpstreamResponse -> Maybe Text
mergeUpstreamResponseMergeType :: !(Maybe Text) -- ^ "merge_type"
  } deriving (Int -> MergeUpstreamResponse -> ShowS
[MergeUpstreamResponse] -> ShowS
MergeUpstreamResponse -> [Char]
(Int -> MergeUpstreamResponse -> ShowS)
-> (MergeUpstreamResponse -> [Char])
-> ([MergeUpstreamResponse] -> ShowS)
-> Show MergeUpstreamResponse
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MergeUpstreamResponse -> ShowS
showsPrec :: Int -> MergeUpstreamResponse -> ShowS
$cshow :: MergeUpstreamResponse -> [Char]
show :: MergeUpstreamResponse -> [Char]
$cshowList :: [MergeUpstreamResponse] -> ShowS
showList :: [MergeUpstreamResponse] -> ShowS
P.Show, MergeUpstreamResponse -> MergeUpstreamResponse -> Bool
(MergeUpstreamResponse -> MergeUpstreamResponse -> Bool)
-> (MergeUpstreamResponse -> MergeUpstreamResponse -> Bool)
-> Eq MergeUpstreamResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MergeUpstreamResponse -> MergeUpstreamResponse -> Bool
== :: MergeUpstreamResponse -> MergeUpstreamResponse -> Bool
$c/= :: MergeUpstreamResponse -> MergeUpstreamResponse -> Bool
/= :: MergeUpstreamResponse -> MergeUpstreamResponse -> Bool
P.Eq, P.Typeable)

-- | FromJSON MergeUpstreamResponse
instance A.FromJSON MergeUpstreamResponse where
  parseJSON :: Value -> Parser MergeUpstreamResponse
parseJSON = [Char]
-> (Object -> Parser MergeUpstreamResponse)
-> Value
-> Parser MergeUpstreamResponse
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"MergeUpstreamResponse" ((Object -> Parser MergeUpstreamResponse)
 -> Value -> Parser MergeUpstreamResponse)
-> (Object -> Parser MergeUpstreamResponse)
-> Value
-> Parser MergeUpstreamResponse
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> MergeUpstreamResponse
MergeUpstreamResponse
      (Maybe Text -> MergeUpstreamResponse)
-> Parser (Maybe Text) -> Parser MergeUpstreamResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"merge_type")

-- | ToJSON MergeUpstreamResponse
instance A.ToJSON MergeUpstreamResponse where
  toJSON :: MergeUpstreamResponse -> Value
toJSON MergeUpstreamResponse {Maybe Text
$sel:mergeUpstreamResponseMergeType:MergeUpstreamResponse :: MergeUpstreamResponse -> Maybe Text
mergeUpstreamResponseMergeType :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"merge_type" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
mergeUpstreamResponseMergeType
      ]


-- | Construct a value of type 'MergeUpstreamResponse' (by applying it's required fields, if any)
mkMergeUpstreamResponse
  :: MergeUpstreamResponse
mkMergeUpstreamResponse :: MergeUpstreamResponse
mkMergeUpstreamResponse =
  MergeUpstreamResponse
  { $sel:mergeUpstreamResponseMergeType:MergeUpstreamResponse :: Maybe Text
mergeUpstreamResponseMergeType = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** MigrateRepoOptions
-- | MigrateRepoOptions
-- MigrateRepoOptions options for migrating repository's this is used to interact with api v1
data MigrateRepoOptions = MigrateRepoOptions
  { MigrateRepoOptions -> Maybe Text
migrateRepoOptionsAuthPassword :: !(Maybe Text) -- ^ "auth_password"
  , MigrateRepoOptions -> Maybe Text
migrateRepoOptionsAuthToken :: !(Maybe Text) -- ^ "auth_token"
  , MigrateRepoOptions -> Maybe Text
migrateRepoOptionsAuthUsername :: !(Maybe Text) -- ^ "auth_username"
  , MigrateRepoOptions -> Maybe Text
migrateRepoOptionsAwsAccessKeyId :: !(Maybe Text) -- ^ "aws_access_key_id"
  , MigrateRepoOptions -> Maybe Text
migrateRepoOptionsAwsSecretAccessKey :: !(Maybe Text) -- ^ "aws_secret_access_key"
  , MigrateRepoOptions -> Text
migrateRepoOptionsCloneAddr :: !(Text) -- ^ /Required/ "clone_addr"
  , MigrateRepoOptions -> Maybe Text
migrateRepoOptionsDescription :: !(Maybe Text) -- ^ "description"
  , MigrateRepoOptions -> Maybe Bool
migrateRepoOptionsIssues :: !(Maybe Bool) -- ^ "issues"
  , MigrateRepoOptions -> Maybe Bool
migrateRepoOptionsLabels :: !(Maybe Bool) -- ^ "labels"
  , MigrateRepoOptions -> Maybe Bool
migrateRepoOptionsLfs :: !(Maybe Bool) -- ^ "lfs"
  , MigrateRepoOptions -> Maybe Text
migrateRepoOptionsLfsEndpoint :: !(Maybe Text) -- ^ "lfs_endpoint"
  , MigrateRepoOptions -> Maybe Bool
migrateRepoOptionsMilestones :: !(Maybe Bool) -- ^ "milestones"
  , MigrateRepoOptions -> Maybe Bool
migrateRepoOptionsMirror :: !(Maybe Bool) -- ^ "mirror"
  , MigrateRepoOptions -> Maybe Text
migrateRepoOptionsMirrorInterval :: !(Maybe Text) -- ^ "mirror_interval"
  , MigrateRepoOptions -> Maybe Bool
migrateRepoOptionsPrivate :: !(Maybe Bool) -- ^ "private"
  , MigrateRepoOptions -> Maybe Bool
migrateRepoOptionsPullRequests :: !(Maybe Bool) -- ^ "pull_requests"
  , MigrateRepoOptions -> Maybe Bool
migrateRepoOptionsReleases :: !(Maybe Bool) -- ^ "releases"
  , MigrateRepoOptions -> Text
migrateRepoOptionsRepoName :: !(Text) -- ^ /Required/ "repo_name"
  , MigrateRepoOptions -> Maybe Text
migrateRepoOptionsRepoOwner :: !(Maybe Text) -- ^ "repo_owner" - Name of User or Organisation who will own Repo after migration
  , MigrateRepoOptions -> Maybe E'Service
migrateRepoOptionsService :: !(Maybe E'Service) -- ^ "service"
  , MigrateRepoOptions -> Maybe Integer
migrateRepoOptionsUid :: !(Maybe Integer) -- ^ "uid" - deprecated (only for backwards compatibility)
  , MigrateRepoOptions -> Maybe Bool
migrateRepoOptionsWiki :: !(Maybe Bool) -- ^ "wiki"
  } deriving (Int -> MigrateRepoOptions -> ShowS
[MigrateRepoOptions] -> ShowS
MigrateRepoOptions -> [Char]
(Int -> MigrateRepoOptions -> ShowS)
-> (MigrateRepoOptions -> [Char])
-> ([MigrateRepoOptions] -> ShowS)
-> Show MigrateRepoOptions
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MigrateRepoOptions -> ShowS
showsPrec :: Int -> MigrateRepoOptions -> ShowS
$cshow :: MigrateRepoOptions -> [Char]
show :: MigrateRepoOptions -> [Char]
$cshowList :: [MigrateRepoOptions] -> ShowS
showList :: [MigrateRepoOptions] -> ShowS
P.Show, MigrateRepoOptions -> MigrateRepoOptions -> Bool
(MigrateRepoOptions -> MigrateRepoOptions -> Bool)
-> (MigrateRepoOptions -> MigrateRepoOptions -> Bool)
-> Eq MigrateRepoOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MigrateRepoOptions -> MigrateRepoOptions -> Bool
== :: MigrateRepoOptions -> MigrateRepoOptions -> Bool
$c/= :: MigrateRepoOptions -> MigrateRepoOptions -> Bool
/= :: MigrateRepoOptions -> MigrateRepoOptions -> Bool
P.Eq, P.Typeable)

-- | FromJSON MigrateRepoOptions
instance A.FromJSON MigrateRepoOptions where
  parseJSON :: Value -> Parser MigrateRepoOptions
parseJSON = [Char]
-> (Object -> Parser MigrateRepoOptions)
-> Value
-> Parser MigrateRepoOptions
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"MigrateRepoOptions" ((Object -> Parser MigrateRepoOptions)
 -> Value -> Parser MigrateRepoOptions)
-> (Object -> Parser MigrateRepoOptions)
-> Value
-> Parser MigrateRepoOptions
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Text
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Text
-> Maybe Text
-> Maybe E'Service
-> Maybe Integer
-> Maybe Bool
-> MigrateRepoOptions
MigrateRepoOptions
      (Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Text
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Text
 -> Maybe Text
 -> Maybe E'Service
 -> Maybe Integer
 -> Maybe Bool
 -> MigrateRepoOptions)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Text
      -> Maybe Text
      -> Maybe E'Service
      -> Maybe Integer
      -> Maybe Bool
      -> MigrateRepoOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"auth_password")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Text
   -> Maybe Text
   -> Maybe E'Service
   -> Maybe Integer
   -> Maybe Bool
   -> MigrateRepoOptions)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Text
      -> Maybe Text
      -> Maybe E'Service
      -> Maybe Integer
      -> Maybe Bool
      -> MigrateRepoOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"auth_token")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Text
   -> Maybe Text
   -> Maybe E'Service
   -> Maybe Integer
   -> Maybe Bool
   -> MigrateRepoOptions)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Text
      -> Maybe Text
      -> Maybe E'Service
      -> Maybe Integer
      -> Maybe Bool
      -> MigrateRepoOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"auth_username")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Text
   -> Maybe Text
   -> Maybe E'Service
   -> Maybe Integer
   -> Maybe Bool
   -> MigrateRepoOptions)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Text
      -> Maybe Text
      -> Maybe E'Service
      -> Maybe Integer
      -> Maybe Bool
      -> MigrateRepoOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"aws_access_key_id")
      Parser
  (Maybe Text
   -> Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Text
   -> Maybe Text
   -> Maybe E'Service
   -> Maybe Integer
   -> Maybe Bool
   -> MigrateRepoOptions)
-> Parser (Maybe Text)
-> Parser
     (Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Text
      -> Maybe Text
      -> Maybe E'Service
      -> Maybe Integer
      -> Maybe Bool
      -> MigrateRepoOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"aws_secret_access_key")
      Parser
  (Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Text
   -> Maybe Text
   -> Maybe E'Service
   -> Maybe Integer
   -> Maybe Bool
   -> MigrateRepoOptions)
-> Parser Text
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Text
      -> Maybe Text
      -> Maybe E'Service
      -> Maybe Integer
      -> Maybe Bool
      -> MigrateRepoOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"clone_addr")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Text
   -> Maybe Text
   -> Maybe E'Service
   -> Maybe Integer
   -> Maybe Bool
   -> MigrateRepoOptions)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Text
      -> Maybe Text
      -> Maybe E'Service
      -> Maybe Integer
      -> Maybe Bool
      -> MigrateRepoOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Text
   -> Maybe Text
   -> Maybe E'Service
   -> Maybe Integer
   -> Maybe Bool
   -> MigrateRepoOptions)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Text
      -> Maybe Text
      -> Maybe E'Service
      -> Maybe Integer
      -> Maybe Bool
      -> MigrateRepoOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"issues")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Text
   -> Maybe Text
   -> Maybe E'Service
   -> Maybe Integer
   -> Maybe Bool
   -> MigrateRepoOptions)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Text
      -> Maybe Text
      -> Maybe E'Service
      -> Maybe Integer
      -> Maybe Bool
      -> MigrateRepoOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"labels")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Text
   -> Maybe Text
   -> Maybe E'Service
   -> Maybe Integer
   -> Maybe Bool
   -> MigrateRepoOptions)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Text
      -> Maybe Text
      -> Maybe E'Service
      -> Maybe Integer
      -> Maybe Bool
      -> MigrateRepoOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lfs")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Text
   -> Maybe Text
   -> Maybe E'Service
   -> Maybe Integer
   -> Maybe Bool
   -> MigrateRepoOptions)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Text
      -> Maybe Text
      -> Maybe E'Service
      -> Maybe Integer
      -> Maybe Bool
      -> MigrateRepoOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"lfs_endpoint")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Text
   -> Maybe Text
   -> Maybe E'Service
   -> Maybe Integer
   -> Maybe Bool
   -> MigrateRepoOptions)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Text
      -> Maybe Text
      -> Maybe E'Service
      -> Maybe Integer
      -> Maybe Bool
      -> MigrateRepoOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"milestones")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Text
   -> Maybe Text
   -> Maybe E'Service
   -> Maybe Integer
   -> Maybe Bool
   -> MigrateRepoOptions)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Text
      -> Maybe Text
      -> Maybe E'Service
      -> Maybe Integer
      -> Maybe Bool
      -> MigrateRepoOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mirror")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Text
   -> Maybe Text
   -> Maybe E'Service
   -> Maybe Integer
   -> Maybe Bool
   -> MigrateRepoOptions)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Text
      -> Maybe Text
      -> Maybe E'Service
      -> Maybe Integer
      -> Maybe Bool
      -> MigrateRepoOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mirror_interval")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Text
   -> Maybe Text
   -> Maybe E'Service
   -> Maybe Integer
   -> Maybe Bool
   -> MigrateRepoOptions)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Text
      -> Maybe Text
      -> Maybe E'Service
      -> Maybe Integer
      -> Maybe Bool
      -> MigrateRepoOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"private")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Text
   -> Maybe Text
   -> Maybe E'Service
   -> Maybe Integer
   -> Maybe Bool
   -> MigrateRepoOptions)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Text
      -> Maybe Text
      -> Maybe E'Service
      -> Maybe Integer
      -> Maybe Bool
      -> MigrateRepoOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pull_requests")
      Parser
  (Maybe Bool
   -> Text
   -> Maybe Text
   -> Maybe E'Service
   -> Maybe Integer
   -> Maybe Bool
   -> MigrateRepoOptions)
-> Parser (Maybe Bool)
-> Parser
     (Text
      -> Maybe Text
      -> Maybe E'Service
      -> Maybe Integer
      -> Maybe Bool
      -> MigrateRepoOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"releases")
      Parser
  (Text
   -> Maybe Text
   -> Maybe E'Service
   -> Maybe Integer
   -> Maybe Bool
   -> MigrateRepoOptions)
-> Parser Text
-> Parser
     (Maybe Text
      -> Maybe E'Service
      -> Maybe Integer
      -> Maybe Bool
      -> MigrateRepoOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"repo_name")
      Parser
  (Maybe Text
   -> Maybe E'Service
   -> Maybe Integer
   -> Maybe Bool
   -> MigrateRepoOptions)
-> Parser (Maybe Text)
-> Parser
     (Maybe E'Service
      -> Maybe Integer -> Maybe Bool -> MigrateRepoOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"repo_owner")
      Parser
  (Maybe E'Service
   -> Maybe Integer -> Maybe Bool -> MigrateRepoOptions)
-> Parser (Maybe E'Service)
-> Parser (Maybe Integer -> Maybe Bool -> MigrateRepoOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe E'Service)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"service")
      Parser (Maybe Integer -> Maybe Bool -> MigrateRepoOptions)
-> Parser (Maybe Integer)
-> Parser (Maybe Bool -> MigrateRepoOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"uid")
      Parser (Maybe Bool -> MigrateRepoOptions)
-> Parser (Maybe Bool) -> Parser MigrateRepoOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"wiki")

-- | ToJSON MigrateRepoOptions
instance A.ToJSON MigrateRepoOptions where
  toJSON :: MigrateRepoOptions -> Value
toJSON MigrateRepoOptions {Maybe Bool
Maybe Integer
Maybe Text
Maybe E'Service
Text
$sel:migrateRepoOptionsAuthPassword:MigrateRepoOptions :: MigrateRepoOptions -> Maybe Text
$sel:migrateRepoOptionsAuthToken:MigrateRepoOptions :: MigrateRepoOptions -> Maybe Text
$sel:migrateRepoOptionsAuthUsername:MigrateRepoOptions :: MigrateRepoOptions -> Maybe Text
$sel:migrateRepoOptionsAwsAccessKeyId:MigrateRepoOptions :: MigrateRepoOptions -> Maybe Text
$sel:migrateRepoOptionsAwsSecretAccessKey:MigrateRepoOptions :: MigrateRepoOptions -> Maybe Text
$sel:migrateRepoOptionsCloneAddr:MigrateRepoOptions :: MigrateRepoOptions -> Text
$sel:migrateRepoOptionsDescription:MigrateRepoOptions :: MigrateRepoOptions -> Maybe Text
$sel:migrateRepoOptionsIssues:MigrateRepoOptions :: MigrateRepoOptions -> Maybe Bool
$sel:migrateRepoOptionsLabels:MigrateRepoOptions :: MigrateRepoOptions -> Maybe Bool
$sel:migrateRepoOptionsLfs:MigrateRepoOptions :: MigrateRepoOptions -> Maybe Bool
$sel:migrateRepoOptionsLfsEndpoint:MigrateRepoOptions :: MigrateRepoOptions -> Maybe Text
$sel:migrateRepoOptionsMilestones:MigrateRepoOptions :: MigrateRepoOptions -> Maybe Bool
$sel:migrateRepoOptionsMirror:MigrateRepoOptions :: MigrateRepoOptions -> Maybe Bool
$sel:migrateRepoOptionsMirrorInterval:MigrateRepoOptions :: MigrateRepoOptions -> Maybe Text
$sel:migrateRepoOptionsPrivate:MigrateRepoOptions :: MigrateRepoOptions -> Maybe Bool
$sel:migrateRepoOptionsPullRequests:MigrateRepoOptions :: MigrateRepoOptions -> Maybe Bool
$sel:migrateRepoOptionsReleases:MigrateRepoOptions :: MigrateRepoOptions -> Maybe Bool
$sel:migrateRepoOptionsRepoName:MigrateRepoOptions :: MigrateRepoOptions -> Text
$sel:migrateRepoOptionsRepoOwner:MigrateRepoOptions :: MigrateRepoOptions -> Maybe Text
$sel:migrateRepoOptionsService:MigrateRepoOptions :: MigrateRepoOptions -> Maybe E'Service
$sel:migrateRepoOptionsUid:MigrateRepoOptions :: MigrateRepoOptions -> Maybe Integer
$sel:migrateRepoOptionsWiki:MigrateRepoOptions :: MigrateRepoOptions -> Maybe Bool
migrateRepoOptionsAuthPassword :: Maybe Text
migrateRepoOptionsAuthToken :: Maybe Text
migrateRepoOptionsAuthUsername :: Maybe Text
migrateRepoOptionsAwsAccessKeyId :: Maybe Text
migrateRepoOptionsAwsSecretAccessKey :: Maybe Text
migrateRepoOptionsCloneAddr :: Text
migrateRepoOptionsDescription :: Maybe Text
migrateRepoOptionsIssues :: Maybe Bool
migrateRepoOptionsLabels :: Maybe Bool
migrateRepoOptionsLfs :: Maybe Bool
migrateRepoOptionsLfsEndpoint :: Maybe Text
migrateRepoOptionsMilestones :: Maybe Bool
migrateRepoOptionsMirror :: Maybe Bool
migrateRepoOptionsMirrorInterval :: Maybe Text
migrateRepoOptionsPrivate :: Maybe Bool
migrateRepoOptionsPullRequests :: Maybe Bool
migrateRepoOptionsReleases :: Maybe Bool
migrateRepoOptionsRepoName :: Text
migrateRepoOptionsRepoOwner :: Maybe Text
migrateRepoOptionsService :: Maybe E'Service
migrateRepoOptionsUid :: Maybe Integer
migrateRepoOptionsWiki :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"auth_password" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
migrateRepoOptionsAuthPassword
      , Key
"auth_token" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
migrateRepoOptionsAuthToken
      , Key
"auth_username" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
migrateRepoOptionsAuthUsername
      , Key
"aws_access_key_id" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
migrateRepoOptionsAwsAccessKeyId
      , Key
"aws_secret_access_key" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
migrateRepoOptionsAwsSecretAccessKey
      , Key
"clone_addr" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
migrateRepoOptionsCloneAddr
      , Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
migrateRepoOptionsDescription
      , Key
"issues" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
migrateRepoOptionsIssues
      , Key
"labels" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
migrateRepoOptionsLabels
      , Key
"lfs" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
migrateRepoOptionsLfs
      , Key
"lfs_endpoint" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
migrateRepoOptionsLfsEndpoint
      , Key
"milestones" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
migrateRepoOptionsMilestones
      , Key
"mirror" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
migrateRepoOptionsMirror
      , Key
"mirror_interval" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
migrateRepoOptionsMirrorInterval
      , Key
"private" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
migrateRepoOptionsPrivate
      , Key
"pull_requests" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
migrateRepoOptionsPullRequests
      , Key
"releases" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
migrateRepoOptionsReleases
      , Key
"repo_name" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
migrateRepoOptionsRepoName
      , Key
"repo_owner" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
migrateRepoOptionsRepoOwner
      , Key
"service" Key -> Maybe E'Service -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe E'Service
migrateRepoOptionsService
      , Key
"uid" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
migrateRepoOptionsUid
      , Key
"wiki" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
migrateRepoOptionsWiki
      ]


-- | Construct a value of type 'MigrateRepoOptions' (by applying it's required fields, if any)
mkMigrateRepoOptions
  :: Text -- ^ 'migrateRepoOptionsCloneAddr' 
  -> Text -- ^ 'migrateRepoOptionsRepoName' 
  -> MigrateRepoOptions
mkMigrateRepoOptions :: Text -> Text -> MigrateRepoOptions
mkMigrateRepoOptions Text
migrateRepoOptionsCloneAddr Text
migrateRepoOptionsRepoName =
  MigrateRepoOptions
  { $sel:migrateRepoOptionsAuthPassword:MigrateRepoOptions :: Maybe Text
migrateRepoOptionsAuthPassword = Maybe Text
forall a. Maybe a
Nothing
  , $sel:migrateRepoOptionsAuthToken:MigrateRepoOptions :: Maybe Text
migrateRepoOptionsAuthToken = Maybe Text
forall a. Maybe a
Nothing
  , $sel:migrateRepoOptionsAuthUsername:MigrateRepoOptions :: Maybe Text
migrateRepoOptionsAuthUsername = Maybe Text
forall a. Maybe a
Nothing
  , $sel:migrateRepoOptionsAwsAccessKeyId:MigrateRepoOptions :: Maybe Text
migrateRepoOptionsAwsAccessKeyId = Maybe Text
forall a. Maybe a
Nothing
  , $sel:migrateRepoOptionsAwsSecretAccessKey:MigrateRepoOptions :: Maybe Text
migrateRepoOptionsAwsSecretAccessKey = Maybe Text
forall a. Maybe a
Nothing
  , Text
$sel:migrateRepoOptionsCloneAddr:MigrateRepoOptions :: Text
migrateRepoOptionsCloneAddr :: Text
migrateRepoOptionsCloneAddr
  , $sel:migrateRepoOptionsDescription:MigrateRepoOptions :: Maybe Text
migrateRepoOptionsDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:migrateRepoOptionsIssues:MigrateRepoOptions :: Maybe Bool
migrateRepoOptionsIssues = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:migrateRepoOptionsLabels:MigrateRepoOptions :: Maybe Bool
migrateRepoOptionsLabels = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:migrateRepoOptionsLfs:MigrateRepoOptions :: Maybe Bool
migrateRepoOptionsLfs = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:migrateRepoOptionsLfsEndpoint:MigrateRepoOptions :: Maybe Text
migrateRepoOptionsLfsEndpoint = Maybe Text
forall a. Maybe a
Nothing
  , $sel:migrateRepoOptionsMilestones:MigrateRepoOptions :: Maybe Bool
migrateRepoOptionsMilestones = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:migrateRepoOptionsMirror:MigrateRepoOptions :: Maybe Bool
migrateRepoOptionsMirror = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:migrateRepoOptionsMirrorInterval:MigrateRepoOptions :: Maybe Text
migrateRepoOptionsMirrorInterval = Maybe Text
forall a. Maybe a
Nothing
  , $sel:migrateRepoOptionsPrivate:MigrateRepoOptions :: Maybe Bool
migrateRepoOptionsPrivate = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:migrateRepoOptionsPullRequests:MigrateRepoOptions :: Maybe Bool
migrateRepoOptionsPullRequests = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:migrateRepoOptionsReleases:MigrateRepoOptions :: Maybe Bool
migrateRepoOptionsReleases = Maybe Bool
forall a. Maybe a
Nothing
  , Text
$sel:migrateRepoOptionsRepoName:MigrateRepoOptions :: Text
migrateRepoOptionsRepoName :: Text
migrateRepoOptionsRepoName
  , $sel:migrateRepoOptionsRepoOwner:MigrateRepoOptions :: Maybe Text
migrateRepoOptionsRepoOwner = Maybe Text
forall a. Maybe a
Nothing
  , $sel:migrateRepoOptionsService:MigrateRepoOptions :: Maybe E'Service
migrateRepoOptionsService = Maybe E'Service
forall a. Maybe a
Nothing
  , $sel:migrateRepoOptionsUid:MigrateRepoOptions :: Maybe Integer
migrateRepoOptionsUid = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:migrateRepoOptionsWiki:MigrateRepoOptions :: Maybe Bool
migrateRepoOptionsWiki = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** Milestone
-- | Milestone
-- Milestone milestone is a collection of issues on one repository
data Milestone = Milestone
  { Milestone -> Maybe DateTime
milestoneClosedAt :: !(Maybe DateTime) -- ^ "closed_at"
  , Milestone -> Maybe Integer
milestoneClosedIssues :: !(Maybe Integer) -- ^ "closed_issues"
  , Milestone -> Maybe DateTime
milestoneCreatedAt :: !(Maybe DateTime) -- ^ "created_at"
  , Milestone -> Maybe Text
milestoneDescription :: !(Maybe Text) -- ^ "description"
  , Milestone -> Maybe DateTime
milestoneDueOn :: !(Maybe DateTime) -- ^ "due_on"
  , Milestone -> Maybe Integer
milestoneId :: !(Maybe Integer) -- ^ "id"
  , Milestone -> Maybe Integer
milestoneOpenIssues :: !(Maybe Integer) -- ^ "open_issues"
  , Milestone -> Maybe Text
milestoneState :: !(Maybe Text) -- ^ "state" - StateType issue state type
  , Milestone -> Maybe Text
milestoneTitle :: !(Maybe Text) -- ^ "title"
  , Milestone -> Maybe DateTime
milestoneUpdatedAt :: !(Maybe DateTime) -- ^ "updated_at"
  } deriving (Int -> Milestone -> ShowS
[Milestone] -> ShowS
Milestone -> [Char]
(Int -> Milestone -> ShowS)
-> (Milestone -> [Char])
-> ([Milestone] -> ShowS)
-> Show Milestone
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Milestone -> ShowS
showsPrec :: Int -> Milestone -> ShowS
$cshow :: Milestone -> [Char]
show :: Milestone -> [Char]
$cshowList :: [Milestone] -> ShowS
showList :: [Milestone] -> ShowS
P.Show, Milestone -> Milestone -> Bool
(Milestone -> Milestone -> Bool)
-> (Milestone -> Milestone -> Bool) -> Eq Milestone
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Milestone -> Milestone -> Bool
== :: Milestone -> Milestone -> Bool
$c/= :: Milestone -> Milestone -> Bool
/= :: Milestone -> Milestone -> Bool
P.Eq, P.Typeable)

-- | FromJSON Milestone
instance A.FromJSON Milestone where
  parseJSON :: Value -> Parser Milestone
parseJSON = [Char] -> (Object -> Parser Milestone) -> Value -> Parser Milestone
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Milestone" ((Object -> Parser Milestone) -> Value -> Parser Milestone)
-> (Object -> Parser Milestone) -> Value -> Parser Milestone
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe DateTime
-> Maybe Integer
-> Maybe DateTime
-> Maybe Text
-> Maybe DateTime
-> Maybe Integer
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe DateTime
-> Milestone
Milestone
      (Maybe DateTime
 -> Maybe Integer
 -> Maybe DateTime
 -> Maybe Text
 -> Maybe DateTime
 -> Maybe Integer
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Text
 -> Maybe DateTime
 -> Milestone)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Integer
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Milestone)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"closed_at")
      Parser
  (Maybe Integer
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Milestone)
-> Parser (Maybe Integer)
-> Parser
     (Maybe DateTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Milestone)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"closed_issues")
      Parser
  (Maybe DateTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Milestone)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Text
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Milestone)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_at")
      Parser
  (Maybe Text
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Milestone)
-> Parser (Maybe Text)
-> Parser
     (Maybe DateTime
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Milestone)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe DateTime
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Milestone)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Milestone)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"due_on")
      Parser
  (Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Milestone)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Integer
      -> Maybe Text -> Maybe Text -> Maybe DateTime -> Milestone)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Integer
   -> Maybe Text -> Maybe Text -> Maybe DateTime -> Milestone)
-> Parser (Maybe Integer)
-> Parser (Maybe Text -> Maybe Text -> Maybe DateTime -> Milestone)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"open_issues")
      Parser (Maybe Text -> Maybe Text -> Maybe DateTime -> Milestone)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe DateTime -> Milestone)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"state")
      Parser (Maybe Text -> Maybe DateTime -> Milestone)
-> Parser (Maybe Text) -> Parser (Maybe DateTime -> Milestone)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title")
      Parser (Maybe DateTime -> Milestone)
-> Parser (Maybe DateTime) -> Parser Milestone
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated_at")

-- | ToJSON Milestone
instance A.ToJSON Milestone where
  toJSON :: Milestone -> Value
toJSON Milestone {Maybe Integer
Maybe Text
Maybe DateTime
$sel:milestoneClosedAt:Milestone :: Milestone -> Maybe DateTime
$sel:milestoneClosedIssues:Milestone :: Milestone -> Maybe Integer
$sel:milestoneCreatedAt:Milestone :: Milestone -> Maybe DateTime
$sel:milestoneDescription:Milestone :: Milestone -> Maybe Text
$sel:milestoneDueOn:Milestone :: Milestone -> Maybe DateTime
$sel:milestoneId:Milestone :: Milestone -> Maybe Integer
$sel:milestoneOpenIssues:Milestone :: Milestone -> Maybe Integer
$sel:milestoneState:Milestone :: Milestone -> Maybe Text
$sel:milestoneTitle:Milestone :: Milestone -> Maybe Text
$sel:milestoneUpdatedAt:Milestone :: Milestone -> Maybe DateTime
milestoneClosedAt :: Maybe DateTime
milestoneClosedIssues :: Maybe Integer
milestoneCreatedAt :: Maybe DateTime
milestoneDescription :: Maybe Text
milestoneDueOn :: Maybe DateTime
milestoneId :: Maybe Integer
milestoneOpenIssues :: Maybe Integer
milestoneState :: Maybe Text
milestoneTitle :: Maybe Text
milestoneUpdatedAt :: Maybe DateTime
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"closed_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
milestoneClosedAt
      , Key
"closed_issues" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
milestoneClosedIssues
      , Key
"created_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
milestoneCreatedAt
      , Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
milestoneDescription
      , Key
"due_on" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
milestoneDueOn
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
milestoneId
      , Key
"open_issues" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
milestoneOpenIssues
      , Key
"state" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
milestoneState
      , Key
"title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
milestoneTitle
      , Key
"updated_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
milestoneUpdatedAt
      ]


-- | Construct a value of type 'Milestone' (by applying it's required fields, if any)
mkMilestone
  :: Milestone
mkMilestone :: Milestone
mkMilestone =
  Milestone
  { $sel:milestoneClosedAt:Milestone :: Maybe DateTime
milestoneClosedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:milestoneClosedIssues:Milestone :: Maybe Integer
milestoneClosedIssues = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:milestoneCreatedAt:Milestone :: Maybe DateTime
milestoneCreatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:milestoneDescription:Milestone :: Maybe Text
milestoneDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:milestoneDueOn:Milestone :: Maybe DateTime
milestoneDueOn = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:milestoneId:Milestone :: Maybe Integer
milestoneId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:milestoneOpenIssues:Milestone :: Maybe Integer
milestoneOpenIssues = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:milestoneState:Milestone :: Maybe Text
milestoneState = Maybe Text
forall a. Maybe a
Nothing
  , $sel:milestoneTitle:Milestone :: Maybe Text
milestoneTitle = Maybe Text
forall a. Maybe a
Nothing
  , $sel:milestoneUpdatedAt:Milestone :: Maybe DateTime
milestoneUpdatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  }

-- ** NewIssuePinsAllowed
-- | NewIssuePinsAllowed
-- NewIssuePinsAllowed represents an API response that says if new Issue Pins are allowed
data NewIssuePinsAllowed = NewIssuePinsAllowed
  { NewIssuePinsAllowed -> Maybe Bool
newIssuePinsAllowedIssues :: !(Maybe Bool) -- ^ "issues"
  , NewIssuePinsAllowed -> Maybe Bool
newIssuePinsAllowedPullRequests :: !(Maybe Bool) -- ^ "pull_requests"
  } deriving (Int -> NewIssuePinsAllowed -> ShowS
[NewIssuePinsAllowed] -> ShowS
NewIssuePinsAllowed -> [Char]
(Int -> NewIssuePinsAllowed -> ShowS)
-> (NewIssuePinsAllowed -> [Char])
-> ([NewIssuePinsAllowed] -> ShowS)
-> Show NewIssuePinsAllowed
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NewIssuePinsAllowed -> ShowS
showsPrec :: Int -> NewIssuePinsAllowed -> ShowS
$cshow :: NewIssuePinsAllowed -> [Char]
show :: NewIssuePinsAllowed -> [Char]
$cshowList :: [NewIssuePinsAllowed] -> ShowS
showList :: [NewIssuePinsAllowed] -> ShowS
P.Show, NewIssuePinsAllowed -> NewIssuePinsAllowed -> Bool
(NewIssuePinsAllowed -> NewIssuePinsAllowed -> Bool)
-> (NewIssuePinsAllowed -> NewIssuePinsAllowed -> Bool)
-> Eq NewIssuePinsAllowed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NewIssuePinsAllowed -> NewIssuePinsAllowed -> Bool
== :: NewIssuePinsAllowed -> NewIssuePinsAllowed -> Bool
$c/= :: NewIssuePinsAllowed -> NewIssuePinsAllowed -> Bool
/= :: NewIssuePinsAllowed -> NewIssuePinsAllowed -> Bool
P.Eq, P.Typeable)

-- | FromJSON NewIssuePinsAllowed
instance A.FromJSON NewIssuePinsAllowed where
  parseJSON :: Value -> Parser NewIssuePinsAllowed
parseJSON = [Char]
-> (Object -> Parser NewIssuePinsAllowed)
-> Value
-> Parser NewIssuePinsAllowed
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"NewIssuePinsAllowed" ((Object -> Parser NewIssuePinsAllowed)
 -> Value -> Parser NewIssuePinsAllowed)
-> (Object -> Parser NewIssuePinsAllowed)
-> Value
-> Parser NewIssuePinsAllowed
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool -> Maybe Bool -> NewIssuePinsAllowed
NewIssuePinsAllowed
      (Maybe Bool -> Maybe Bool -> NewIssuePinsAllowed)
-> Parser (Maybe Bool)
-> Parser (Maybe Bool -> NewIssuePinsAllowed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"issues")
      Parser (Maybe Bool -> NewIssuePinsAllowed)
-> Parser (Maybe Bool) -> Parser NewIssuePinsAllowed
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pull_requests")

-- | ToJSON NewIssuePinsAllowed
instance A.ToJSON NewIssuePinsAllowed where
  toJSON :: NewIssuePinsAllowed -> Value
toJSON NewIssuePinsAllowed {Maybe Bool
$sel:newIssuePinsAllowedIssues:NewIssuePinsAllowed :: NewIssuePinsAllowed -> Maybe Bool
$sel:newIssuePinsAllowedPullRequests:NewIssuePinsAllowed :: NewIssuePinsAllowed -> Maybe Bool
newIssuePinsAllowedIssues :: Maybe Bool
newIssuePinsAllowedPullRequests :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"issues" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
newIssuePinsAllowedIssues
      , Key
"pull_requests" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
newIssuePinsAllowedPullRequests
      ]


-- | Construct a value of type 'NewIssuePinsAllowed' (by applying it's required fields, if any)
mkNewIssuePinsAllowed
  :: NewIssuePinsAllowed
mkNewIssuePinsAllowed :: NewIssuePinsAllowed
mkNewIssuePinsAllowed =
  NewIssuePinsAllowed
  { $sel:newIssuePinsAllowedIssues:NewIssuePinsAllowed :: Maybe Bool
newIssuePinsAllowedIssues = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:newIssuePinsAllowedPullRequests:NewIssuePinsAllowed :: Maybe Bool
newIssuePinsAllowedPullRequests = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** NodeInfo
-- | NodeInfo
-- NodeInfo contains standardized way of exposing metadata about a server running one of the distributed social networks
data NodeInfo = NodeInfo
  { NodeInfo -> Maybe Value
nodeInfoMetadata :: !(Maybe A.Value) -- ^ "metadata"
  , NodeInfo -> Maybe Bool
nodeInfoOpenRegistrations :: !(Maybe Bool) -- ^ "openRegistrations"
  , NodeInfo -> Maybe [Text]
nodeInfoProtocols :: !(Maybe [Text]) -- ^ "protocols"
  , NodeInfo -> Maybe NodeInfoServices
nodeInfoServices :: !(Maybe NodeInfoServices) -- ^ "services"
  , NodeInfo -> Maybe NodeInfoSoftware
nodeInfoSoftware :: !(Maybe NodeInfoSoftware) -- ^ "software"
  , NodeInfo -> Maybe NodeInfoUsage
nodeInfoUsage :: !(Maybe NodeInfoUsage) -- ^ "usage"
  , NodeInfo -> Maybe Text
nodeInfoVersion :: !(Maybe Text) -- ^ "version"
  } deriving (Int -> NodeInfo -> ShowS
[NodeInfo] -> ShowS
NodeInfo -> [Char]
(Int -> NodeInfo -> ShowS)
-> (NodeInfo -> [Char]) -> ([NodeInfo] -> ShowS) -> Show NodeInfo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeInfo -> ShowS
showsPrec :: Int -> NodeInfo -> ShowS
$cshow :: NodeInfo -> [Char]
show :: NodeInfo -> [Char]
$cshowList :: [NodeInfo] -> ShowS
showList :: [NodeInfo] -> ShowS
P.Show, NodeInfo -> NodeInfo -> Bool
(NodeInfo -> NodeInfo -> Bool)
-> (NodeInfo -> NodeInfo -> Bool) -> Eq NodeInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeInfo -> NodeInfo -> Bool
== :: NodeInfo -> NodeInfo -> Bool
$c/= :: NodeInfo -> NodeInfo -> Bool
/= :: NodeInfo -> NodeInfo -> Bool
P.Eq, P.Typeable)

-- | FromJSON NodeInfo
instance A.FromJSON NodeInfo where
  parseJSON :: Value -> Parser NodeInfo
parseJSON = [Char] -> (Object -> Parser NodeInfo) -> Value -> Parser NodeInfo
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"NodeInfo" ((Object -> Parser NodeInfo) -> Value -> Parser NodeInfo)
-> (Object -> Parser NodeInfo) -> Value -> Parser NodeInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Value
-> Maybe Bool
-> Maybe [Text]
-> Maybe NodeInfoServices
-> Maybe NodeInfoSoftware
-> Maybe NodeInfoUsage
-> Maybe Text
-> NodeInfo
NodeInfo
      (Maybe Value
 -> Maybe Bool
 -> Maybe [Text]
 -> Maybe NodeInfoServices
 -> Maybe NodeInfoSoftware
 -> Maybe NodeInfoUsage
 -> Maybe Text
 -> NodeInfo)
-> Parser (Maybe Value)
-> Parser
     (Maybe Bool
      -> Maybe [Text]
      -> Maybe NodeInfoServices
      -> Maybe NodeInfoSoftware
      -> Maybe NodeInfoUsage
      -> Maybe Text
      -> NodeInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"metadata")
      Parser
  (Maybe Bool
   -> Maybe [Text]
   -> Maybe NodeInfoServices
   -> Maybe NodeInfoSoftware
   -> Maybe NodeInfoUsage
   -> Maybe Text
   -> NodeInfo)
-> Parser (Maybe Bool)
-> Parser
     (Maybe [Text]
      -> Maybe NodeInfoServices
      -> Maybe NodeInfoSoftware
      -> Maybe NodeInfoUsage
      -> Maybe Text
      -> NodeInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"openRegistrations")
      Parser
  (Maybe [Text]
   -> Maybe NodeInfoServices
   -> Maybe NodeInfoSoftware
   -> Maybe NodeInfoUsage
   -> Maybe Text
   -> NodeInfo)
-> Parser (Maybe [Text])
-> Parser
     (Maybe NodeInfoServices
      -> Maybe NodeInfoSoftware
      -> Maybe NodeInfoUsage
      -> Maybe Text
      -> NodeInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"protocols")
      Parser
  (Maybe NodeInfoServices
   -> Maybe NodeInfoSoftware
   -> Maybe NodeInfoUsage
   -> Maybe Text
   -> NodeInfo)
-> Parser (Maybe NodeInfoServices)
-> Parser
     (Maybe NodeInfoSoftware
      -> Maybe NodeInfoUsage -> Maybe Text -> NodeInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe NodeInfoServices)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"services")
      Parser
  (Maybe NodeInfoSoftware
   -> Maybe NodeInfoUsage -> Maybe Text -> NodeInfo)
-> Parser (Maybe NodeInfoSoftware)
-> Parser (Maybe NodeInfoUsage -> Maybe Text -> NodeInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe NodeInfoSoftware)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"software")
      Parser (Maybe NodeInfoUsage -> Maybe Text -> NodeInfo)
-> Parser (Maybe NodeInfoUsage) -> Parser (Maybe Text -> NodeInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe NodeInfoUsage)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"usage")
      Parser (Maybe Text -> NodeInfo)
-> Parser (Maybe Text) -> Parser NodeInfo
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"version")

-- | ToJSON NodeInfo
instance A.ToJSON NodeInfo where
  toJSON :: NodeInfo -> Value
toJSON NodeInfo {Maybe Bool
Maybe [Text]
Maybe Value
Maybe Text
Maybe NodeInfoUsage
Maybe NodeInfoSoftware
Maybe NodeInfoServices
$sel:nodeInfoMetadata:NodeInfo :: NodeInfo -> Maybe Value
$sel:nodeInfoOpenRegistrations:NodeInfo :: NodeInfo -> Maybe Bool
$sel:nodeInfoProtocols:NodeInfo :: NodeInfo -> Maybe [Text]
$sel:nodeInfoServices:NodeInfo :: NodeInfo -> Maybe NodeInfoServices
$sel:nodeInfoSoftware:NodeInfo :: NodeInfo -> Maybe NodeInfoSoftware
$sel:nodeInfoUsage:NodeInfo :: NodeInfo -> Maybe NodeInfoUsage
$sel:nodeInfoVersion:NodeInfo :: NodeInfo -> Maybe Text
nodeInfoMetadata :: Maybe Value
nodeInfoOpenRegistrations :: Maybe Bool
nodeInfoProtocols :: Maybe [Text]
nodeInfoServices :: Maybe NodeInfoServices
nodeInfoSoftware :: Maybe NodeInfoSoftware
nodeInfoUsage :: Maybe NodeInfoUsage
nodeInfoVersion :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"metadata" Key -> Maybe Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Value
nodeInfoMetadata
      , Key
"openRegistrations" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
nodeInfoOpenRegistrations
      , Key
"protocols" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
nodeInfoProtocols
      , Key
"services" Key -> Maybe NodeInfoServices -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe NodeInfoServices
nodeInfoServices
      , Key
"software" Key -> Maybe NodeInfoSoftware -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe NodeInfoSoftware
nodeInfoSoftware
      , Key
"usage" Key -> Maybe NodeInfoUsage -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe NodeInfoUsage
nodeInfoUsage
      , Key
"version" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
nodeInfoVersion
      ]


-- | Construct a value of type 'NodeInfo' (by applying it's required fields, if any)
mkNodeInfo
  :: NodeInfo
mkNodeInfo :: NodeInfo
mkNodeInfo =
  NodeInfo
  { $sel:nodeInfoMetadata:NodeInfo :: Maybe Value
nodeInfoMetadata = Maybe Value
forall a. Maybe a
Nothing
  , $sel:nodeInfoOpenRegistrations:NodeInfo :: Maybe Bool
nodeInfoOpenRegistrations = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:nodeInfoProtocols:NodeInfo :: Maybe [Text]
nodeInfoProtocols = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:nodeInfoServices:NodeInfo :: Maybe NodeInfoServices
nodeInfoServices = Maybe NodeInfoServices
forall a. Maybe a
Nothing
  , $sel:nodeInfoSoftware:NodeInfo :: Maybe NodeInfoSoftware
nodeInfoSoftware = Maybe NodeInfoSoftware
forall a. Maybe a
Nothing
  , $sel:nodeInfoUsage:NodeInfo :: Maybe NodeInfoUsage
nodeInfoUsage = Maybe NodeInfoUsage
forall a. Maybe a
Nothing
  , $sel:nodeInfoVersion:NodeInfo :: Maybe Text
nodeInfoVersion = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** NodeInfoServices
-- | NodeInfoServices
-- NodeInfoServices contains the third party sites this server can connect to via their application API
data NodeInfoServices = NodeInfoServices
  { NodeInfoServices -> Maybe [Text]
nodeInfoServicesInbound :: !(Maybe [Text]) -- ^ "inbound"
  , NodeInfoServices -> Maybe [Text]
nodeInfoServicesOutbound :: !(Maybe [Text]) -- ^ "outbound"
  } deriving (Int -> NodeInfoServices -> ShowS
[NodeInfoServices] -> ShowS
NodeInfoServices -> [Char]
(Int -> NodeInfoServices -> ShowS)
-> (NodeInfoServices -> [Char])
-> ([NodeInfoServices] -> ShowS)
-> Show NodeInfoServices
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeInfoServices -> ShowS
showsPrec :: Int -> NodeInfoServices -> ShowS
$cshow :: NodeInfoServices -> [Char]
show :: NodeInfoServices -> [Char]
$cshowList :: [NodeInfoServices] -> ShowS
showList :: [NodeInfoServices] -> ShowS
P.Show, NodeInfoServices -> NodeInfoServices -> Bool
(NodeInfoServices -> NodeInfoServices -> Bool)
-> (NodeInfoServices -> NodeInfoServices -> Bool)
-> Eq NodeInfoServices
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeInfoServices -> NodeInfoServices -> Bool
== :: NodeInfoServices -> NodeInfoServices -> Bool
$c/= :: NodeInfoServices -> NodeInfoServices -> Bool
/= :: NodeInfoServices -> NodeInfoServices -> Bool
P.Eq, P.Typeable)

-- | FromJSON NodeInfoServices
instance A.FromJSON NodeInfoServices where
  parseJSON :: Value -> Parser NodeInfoServices
parseJSON = [Char]
-> (Object -> Parser NodeInfoServices)
-> Value
-> Parser NodeInfoServices
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"NodeInfoServices" ((Object -> Parser NodeInfoServices)
 -> Value -> Parser NodeInfoServices)
-> (Object -> Parser NodeInfoServices)
-> Value
-> Parser NodeInfoServices
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Text] -> Maybe [Text] -> NodeInfoServices
NodeInfoServices
      (Maybe [Text] -> Maybe [Text] -> NodeInfoServices)
-> Parser (Maybe [Text])
-> Parser (Maybe [Text] -> NodeInfoServices)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"inbound")
      Parser (Maybe [Text] -> NodeInfoServices)
-> Parser (Maybe [Text]) -> Parser NodeInfoServices
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"outbound")

-- | ToJSON NodeInfoServices
instance A.ToJSON NodeInfoServices where
  toJSON :: NodeInfoServices -> Value
toJSON NodeInfoServices {Maybe [Text]
$sel:nodeInfoServicesInbound:NodeInfoServices :: NodeInfoServices -> Maybe [Text]
$sel:nodeInfoServicesOutbound:NodeInfoServices :: NodeInfoServices -> Maybe [Text]
nodeInfoServicesInbound :: Maybe [Text]
nodeInfoServicesOutbound :: Maybe [Text]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"inbound" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
nodeInfoServicesInbound
      , Key
"outbound" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
nodeInfoServicesOutbound
      ]


-- | Construct a value of type 'NodeInfoServices' (by applying it's required fields, if any)
mkNodeInfoServices
  :: NodeInfoServices
mkNodeInfoServices :: NodeInfoServices
mkNodeInfoServices =
  NodeInfoServices
  { $sel:nodeInfoServicesInbound:NodeInfoServices :: Maybe [Text]
nodeInfoServicesInbound = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:nodeInfoServicesOutbound:NodeInfoServices :: Maybe [Text]
nodeInfoServicesOutbound = Maybe [Text]
forall a. Maybe a
Nothing
  }

-- ** NodeInfoSoftware
-- | NodeInfoSoftware
-- NodeInfoSoftware contains Metadata about server software in use
data NodeInfoSoftware = NodeInfoSoftware
  { NodeInfoSoftware -> Maybe Text
nodeInfoSoftwareHomepage :: !(Maybe Text) -- ^ "homepage"
  , NodeInfoSoftware -> Maybe Text
nodeInfoSoftwareName :: !(Maybe Text) -- ^ "name"
  , NodeInfoSoftware -> Maybe Text
nodeInfoSoftwareRepository :: !(Maybe Text) -- ^ "repository"
  , NodeInfoSoftware -> Maybe Text
nodeInfoSoftwareVersion :: !(Maybe Text) -- ^ "version"
  } deriving (Int -> NodeInfoSoftware -> ShowS
[NodeInfoSoftware] -> ShowS
NodeInfoSoftware -> [Char]
(Int -> NodeInfoSoftware -> ShowS)
-> (NodeInfoSoftware -> [Char])
-> ([NodeInfoSoftware] -> ShowS)
-> Show NodeInfoSoftware
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeInfoSoftware -> ShowS
showsPrec :: Int -> NodeInfoSoftware -> ShowS
$cshow :: NodeInfoSoftware -> [Char]
show :: NodeInfoSoftware -> [Char]
$cshowList :: [NodeInfoSoftware] -> ShowS
showList :: [NodeInfoSoftware] -> ShowS
P.Show, NodeInfoSoftware -> NodeInfoSoftware -> Bool
(NodeInfoSoftware -> NodeInfoSoftware -> Bool)
-> (NodeInfoSoftware -> NodeInfoSoftware -> Bool)
-> Eq NodeInfoSoftware
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeInfoSoftware -> NodeInfoSoftware -> Bool
== :: NodeInfoSoftware -> NodeInfoSoftware -> Bool
$c/= :: NodeInfoSoftware -> NodeInfoSoftware -> Bool
/= :: NodeInfoSoftware -> NodeInfoSoftware -> Bool
P.Eq, P.Typeable)

-- | FromJSON NodeInfoSoftware
instance A.FromJSON NodeInfoSoftware where
  parseJSON :: Value -> Parser NodeInfoSoftware
parseJSON = [Char]
-> (Object -> Parser NodeInfoSoftware)
-> Value
-> Parser NodeInfoSoftware
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"NodeInfoSoftware" ((Object -> Parser NodeInfoSoftware)
 -> Value -> Parser NodeInfoSoftware)
-> (Object -> Parser NodeInfoSoftware)
-> Value
-> Parser NodeInfoSoftware
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text -> Maybe Text -> Maybe Text -> NodeInfoSoftware
NodeInfoSoftware
      (Maybe Text
 -> Maybe Text -> Maybe Text -> Maybe Text -> NodeInfoSoftware)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Text -> Maybe Text -> NodeInfoSoftware)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"homepage")
      Parser (Maybe Text -> Maybe Text -> Maybe Text -> NodeInfoSoftware)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> NodeInfoSoftware)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser (Maybe Text -> Maybe Text -> NodeInfoSoftware)
-> Parser (Maybe Text) -> Parser (Maybe Text -> NodeInfoSoftware)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"repository")
      Parser (Maybe Text -> NodeInfoSoftware)
-> Parser (Maybe Text) -> Parser NodeInfoSoftware
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"version")

-- | ToJSON NodeInfoSoftware
instance A.ToJSON NodeInfoSoftware where
  toJSON :: NodeInfoSoftware -> Value
toJSON NodeInfoSoftware {Maybe Text
$sel:nodeInfoSoftwareHomepage:NodeInfoSoftware :: NodeInfoSoftware -> Maybe Text
$sel:nodeInfoSoftwareName:NodeInfoSoftware :: NodeInfoSoftware -> Maybe Text
$sel:nodeInfoSoftwareRepository:NodeInfoSoftware :: NodeInfoSoftware -> Maybe Text
$sel:nodeInfoSoftwareVersion:NodeInfoSoftware :: NodeInfoSoftware -> Maybe Text
nodeInfoSoftwareHomepage :: Maybe Text
nodeInfoSoftwareName :: Maybe Text
nodeInfoSoftwareRepository :: Maybe Text
nodeInfoSoftwareVersion :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"homepage" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
nodeInfoSoftwareHomepage
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
nodeInfoSoftwareName
      , Key
"repository" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
nodeInfoSoftwareRepository
      , Key
"version" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
nodeInfoSoftwareVersion
      ]


-- | Construct a value of type 'NodeInfoSoftware' (by applying it's required fields, if any)
mkNodeInfoSoftware
  :: NodeInfoSoftware
mkNodeInfoSoftware :: NodeInfoSoftware
mkNodeInfoSoftware =
  NodeInfoSoftware
  { $sel:nodeInfoSoftwareHomepage:NodeInfoSoftware :: Maybe Text
nodeInfoSoftwareHomepage = Maybe Text
forall a. Maybe a
Nothing
  , $sel:nodeInfoSoftwareName:NodeInfoSoftware :: Maybe Text
nodeInfoSoftwareName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:nodeInfoSoftwareRepository:NodeInfoSoftware :: Maybe Text
nodeInfoSoftwareRepository = Maybe Text
forall a. Maybe a
Nothing
  , $sel:nodeInfoSoftwareVersion:NodeInfoSoftware :: Maybe Text
nodeInfoSoftwareVersion = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** NodeInfoUsage
-- | NodeInfoUsage
-- NodeInfoUsage contains usage statistics for this server
data NodeInfoUsage = NodeInfoUsage
  { NodeInfoUsage -> Maybe Integer
nodeInfoUsageLocalComments :: !(Maybe Integer) -- ^ "localComments"
  , NodeInfoUsage -> Maybe Integer
nodeInfoUsageLocalPosts :: !(Maybe Integer) -- ^ "localPosts"
  , NodeInfoUsage -> Maybe NodeInfoUsageUsers
nodeInfoUsageUsers :: !(Maybe NodeInfoUsageUsers) -- ^ "users"
  } deriving (Int -> NodeInfoUsage -> ShowS
[NodeInfoUsage] -> ShowS
NodeInfoUsage -> [Char]
(Int -> NodeInfoUsage -> ShowS)
-> (NodeInfoUsage -> [Char])
-> ([NodeInfoUsage] -> ShowS)
-> Show NodeInfoUsage
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeInfoUsage -> ShowS
showsPrec :: Int -> NodeInfoUsage -> ShowS
$cshow :: NodeInfoUsage -> [Char]
show :: NodeInfoUsage -> [Char]
$cshowList :: [NodeInfoUsage] -> ShowS
showList :: [NodeInfoUsage] -> ShowS
P.Show, NodeInfoUsage -> NodeInfoUsage -> Bool
(NodeInfoUsage -> NodeInfoUsage -> Bool)
-> (NodeInfoUsage -> NodeInfoUsage -> Bool) -> Eq NodeInfoUsage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeInfoUsage -> NodeInfoUsage -> Bool
== :: NodeInfoUsage -> NodeInfoUsage -> Bool
$c/= :: NodeInfoUsage -> NodeInfoUsage -> Bool
/= :: NodeInfoUsage -> NodeInfoUsage -> Bool
P.Eq, P.Typeable)

-- | FromJSON NodeInfoUsage
instance A.FromJSON NodeInfoUsage where
  parseJSON :: Value -> Parser NodeInfoUsage
parseJSON = [Char]
-> (Object -> Parser NodeInfoUsage)
-> Value
-> Parser NodeInfoUsage
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"NodeInfoUsage" ((Object -> Parser NodeInfoUsage) -> Value -> Parser NodeInfoUsage)
-> (Object -> Parser NodeInfoUsage)
-> Value
-> Parser NodeInfoUsage
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Integer
-> Maybe Integer -> Maybe NodeInfoUsageUsers -> NodeInfoUsage
NodeInfoUsage
      (Maybe Integer
 -> Maybe Integer -> Maybe NodeInfoUsageUsers -> NodeInfoUsage)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Integer -> Maybe NodeInfoUsageUsers -> NodeInfoUsage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"localComments")
      Parser (Maybe Integer -> Maybe NodeInfoUsageUsers -> NodeInfoUsage)
-> Parser (Maybe Integer)
-> Parser (Maybe NodeInfoUsageUsers -> NodeInfoUsage)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"localPosts")
      Parser (Maybe NodeInfoUsageUsers -> NodeInfoUsage)
-> Parser (Maybe NodeInfoUsageUsers) -> Parser NodeInfoUsage
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe NodeInfoUsageUsers)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"users")

-- | ToJSON NodeInfoUsage
instance A.ToJSON NodeInfoUsage where
  toJSON :: NodeInfoUsage -> Value
toJSON NodeInfoUsage {Maybe Integer
Maybe NodeInfoUsageUsers
$sel:nodeInfoUsageLocalComments:NodeInfoUsage :: NodeInfoUsage -> Maybe Integer
$sel:nodeInfoUsageLocalPosts:NodeInfoUsage :: NodeInfoUsage -> Maybe Integer
$sel:nodeInfoUsageUsers:NodeInfoUsage :: NodeInfoUsage -> Maybe NodeInfoUsageUsers
nodeInfoUsageLocalComments :: Maybe Integer
nodeInfoUsageLocalPosts :: Maybe Integer
nodeInfoUsageUsers :: Maybe NodeInfoUsageUsers
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"localComments" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
nodeInfoUsageLocalComments
      , Key
"localPosts" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
nodeInfoUsageLocalPosts
      , Key
"users" Key -> Maybe NodeInfoUsageUsers -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe NodeInfoUsageUsers
nodeInfoUsageUsers
      ]


-- | Construct a value of type 'NodeInfoUsage' (by applying it's required fields, if any)
mkNodeInfoUsage
  :: NodeInfoUsage
mkNodeInfoUsage :: NodeInfoUsage
mkNodeInfoUsage =
  NodeInfoUsage
  { $sel:nodeInfoUsageLocalComments:NodeInfoUsage :: Maybe Integer
nodeInfoUsageLocalComments = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:nodeInfoUsageLocalPosts:NodeInfoUsage :: Maybe Integer
nodeInfoUsageLocalPosts = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:nodeInfoUsageUsers:NodeInfoUsage :: Maybe NodeInfoUsageUsers
nodeInfoUsageUsers = Maybe NodeInfoUsageUsers
forall a. Maybe a
Nothing
  }

-- ** NodeInfoUsageUsers
-- | NodeInfoUsageUsers
-- NodeInfoUsageUsers contains statistics about the users of this server
data NodeInfoUsageUsers = NodeInfoUsageUsers
  { NodeInfoUsageUsers -> Maybe Integer
nodeInfoUsageUsersActiveHalfyear :: !(Maybe Integer) -- ^ "activeHalfyear"
  , NodeInfoUsageUsers -> Maybe Integer
nodeInfoUsageUsersActiveMonth :: !(Maybe Integer) -- ^ "activeMonth"
  , NodeInfoUsageUsers -> Maybe Integer
nodeInfoUsageUsersTotal :: !(Maybe Integer) -- ^ "total"
  } deriving (Int -> NodeInfoUsageUsers -> ShowS
[NodeInfoUsageUsers] -> ShowS
NodeInfoUsageUsers -> [Char]
(Int -> NodeInfoUsageUsers -> ShowS)
-> (NodeInfoUsageUsers -> [Char])
-> ([NodeInfoUsageUsers] -> ShowS)
-> Show NodeInfoUsageUsers
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NodeInfoUsageUsers -> ShowS
showsPrec :: Int -> NodeInfoUsageUsers -> ShowS
$cshow :: NodeInfoUsageUsers -> [Char]
show :: NodeInfoUsageUsers -> [Char]
$cshowList :: [NodeInfoUsageUsers] -> ShowS
showList :: [NodeInfoUsageUsers] -> ShowS
P.Show, NodeInfoUsageUsers -> NodeInfoUsageUsers -> Bool
(NodeInfoUsageUsers -> NodeInfoUsageUsers -> Bool)
-> (NodeInfoUsageUsers -> NodeInfoUsageUsers -> Bool)
-> Eq NodeInfoUsageUsers
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NodeInfoUsageUsers -> NodeInfoUsageUsers -> Bool
== :: NodeInfoUsageUsers -> NodeInfoUsageUsers -> Bool
$c/= :: NodeInfoUsageUsers -> NodeInfoUsageUsers -> Bool
/= :: NodeInfoUsageUsers -> NodeInfoUsageUsers -> Bool
P.Eq, P.Typeable)

-- | FromJSON NodeInfoUsageUsers
instance A.FromJSON NodeInfoUsageUsers where
  parseJSON :: Value -> Parser NodeInfoUsageUsers
parseJSON = [Char]
-> (Object -> Parser NodeInfoUsageUsers)
-> Value
-> Parser NodeInfoUsageUsers
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"NodeInfoUsageUsers" ((Object -> Parser NodeInfoUsageUsers)
 -> Value -> Parser NodeInfoUsageUsers)
-> (Object -> Parser NodeInfoUsageUsers)
-> Value
-> Parser NodeInfoUsageUsers
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Integer
-> Maybe Integer -> Maybe Integer -> NodeInfoUsageUsers
NodeInfoUsageUsers
      (Maybe Integer
 -> Maybe Integer -> Maybe Integer -> NodeInfoUsageUsers)
-> Parser (Maybe Integer)
-> Parser (Maybe Integer -> Maybe Integer -> NodeInfoUsageUsers)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"activeHalfyear")
      Parser (Maybe Integer -> Maybe Integer -> NodeInfoUsageUsers)
-> Parser (Maybe Integer)
-> Parser (Maybe Integer -> NodeInfoUsageUsers)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"activeMonth")
      Parser (Maybe Integer -> NodeInfoUsageUsers)
-> Parser (Maybe Integer) -> Parser NodeInfoUsageUsers
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"total")

-- | ToJSON NodeInfoUsageUsers
instance A.ToJSON NodeInfoUsageUsers where
  toJSON :: NodeInfoUsageUsers -> Value
toJSON NodeInfoUsageUsers {Maybe Integer
$sel:nodeInfoUsageUsersActiveHalfyear:NodeInfoUsageUsers :: NodeInfoUsageUsers -> Maybe Integer
$sel:nodeInfoUsageUsersActiveMonth:NodeInfoUsageUsers :: NodeInfoUsageUsers -> Maybe Integer
$sel:nodeInfoUsageUsersTotal:NodeInfoUsageUsers :: NodeInfoUsageUsers -> Maybe Integer
nodeInfoUsageUsersActiveHalfyear :: Maybe Integer
nodeInfoUsageUsersActiveMonth :: Maybe Integer
nodeInfoUsageUsersTotal :: Maybe Integer
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"activeHalfyear" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
nodeInfoUsageUsersActiveHalfyear
      , Key
"activeMonth" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
nodeInfoUsageUsersActiveMonth
      , Key
"total" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
nodeInfoUsageUsersTotal
      ]


-- | Construct a value of type 'NodeInfoUsageUsers' (by applying it's required fields, if any)
mkNodeInfoUsageUsers
  :: NodeInfoUsageUsers
mkNodeInfoUsageUsers :: NodeInfoUsageUsers
mkNodeInfoUsageUsers =
  NodeInfoUsageUsers
  { $sel:nodeInfoUsageUsersActiveHalfyear:NodeInfoUsageUsers :: Maybe Integer
nodeInfoUsageUsersActiveHalfyear = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:nodeInfoUsageUsersActiveMonth:NodeInfoUsageUsers :: Maybe Integer
nodeInfoUsageUsersActiveMonth = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:nodeInfoUsageUsersTotal:NodeInfoUsageUsers :: Maybe Integer
nodeInfoUsageUsersTotal = Maybe Integer
forall a. Maybe a
Nothing
  }

-- ** Note
-- | Note
-- Note contains information related to a git note
data Note = Note
  { Note -> Maybe Commit
noteCommit :: !(Maybe Commit) -- ^ "commit"
  , Note -> Maybe Text
noteMessage :: !(Maybe Text) -- ^ "message"
  } deriving (Int -> Note -> ShowS
[Note] -> ShowS
Note -> [Char]
(Int -> Note -> ShowS)
-> (Note -> [Char]) -> ([Note] -> ShowS) -> Show Note
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Note -> ShowS
showsPrec :: Int -> Note -> ShowS
$cshow :: Note -> [Char]
show :: Note -> [Char]
$cshowList :: [Note] -> ShowS
showList :: [Note] -> ShowS
P.Show, Note -> Note -> Bool
(Note -> Note -> Bool) -> (Note -> Note -> Bool) -> Eq Note
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Note -> Note -> Bool
== :: Note -> Note -> Bool
$c/= :: Note -> Note -> Bool
/= :: Note -> Note -> Bool
P.Eq, P.Typeable)

-- | FromJSON Note
instance A.FromJSON Note where
  parseJSON :: Value -> Parser Note
parseJSON = [Char] -> (Object -> Parser Note) -> Value -> Parser Note
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Note" ((Object -> Parser Note) -> Value -> Parser Note)
-> (Object -> Parser Note) -> Value -> Parser Note
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Commit -> Maybe Text -> Note
Note
      (Maybe Commit -> Maybe Text -> Note)
-> Parser (Maybe Commit) -> Parser (Maybe Text -> Note)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Commit)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"commit")
      Parser (Maybe Text -> Note) -> Parser (Maybe Text) -> Parser Note
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"message")

-- | ToJSON Note
instance A.ToJSON Note where
  toJSON :: Note -> Value
toJSON Note {Maybe Text
Maybe Commit
$sel:noteCommit:Note :: Note -> Maybe Commit
$sel:noteMessage:Note :: Note -> Maybe Text
noteCommit :: Maybe Commit
noteMessage :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"commit" Key -> Maybe Commit -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Commit
noteCommit
      , Key
"message" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
noteMessage
      ]


-- | Construct a value of type 'Note' (by applying it's required fields, if any)
mkNote
  :: Note
mkNote :: Note
mkNote =
  Note
  { $sel:noteCommit:Note :: Maybe Commit
noteCommit = Maybe Commit
forall a. Maybe a
Nothing
  , $sel:noteMessage:Note :: Maybe Text
noteMessage = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** NotificationCount
-- | NotificationCount
-- NotificationCount number of unread notifications
data NotificationCount = NotificationCount
  { NotificationCount -> Maybe Integer
notificationCountNew :: !(Maybe Integer) -- ^ "new"
  } deriving (Int -> NotificationCount -> ShowS
[NotificationCount] -> ShowS
NotificationCount -> [Char]
(Int -> NotificationCount -> ShowS)
-> (NotificationCount -> [Char])
-> ([NotificationCount] -> ShowS)
-> Show NotificationCount
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotificationCount -> ShowS
showsPrec :: Int -> NotificationCount -> ShowS
$cshow :: NotificationCount -> [Char]
show :: NotificationCount -> [Char]
$cshowList :: [NotificationCount] -> ShowS
showList :: [NotificationCount] -> ShowS
P.Show, NotificationCount -> NotificationCount -> Bool
(NotificationCount -> NotificationCount -> Bool)
-> (NotificationCount -> NotificationCount -> Bool)
-> Eq NotificationCount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NotificationCount -> NotificationCount -> Bool
== :: NotificationCount -> NotificationCount -> Bool
$c/= :: NotificationCount -> NotificationCount -> Bool
/= :: NotificationCount -> NotificationCount -> Bool
P.Eq, P.Typeable)

-- | FromJSON NotificationCount
instance A.FromJSON NotificationCount where
  parseJSON :: Value -> Parser NotificationCount
parseJSON = [Char]
-> (Object -> Parser NotificationCount)
-> Value
-> Parser NotificationCount
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"NotificationCount" ((Object -> Parser NotificationCount)
 -> Value -> Parser NotificationCount)
-> (Object -> Parser NotificationCount)
-> Value
-> Parser NotificationCount
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Integer -> NotificationCount
NotificationCount
      (Maybe Integer -> NotificationCount)
-> Parser (Maybe Integer) -> Parser NotificationCount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"new")

-- | ToJSON NotificationCount
instance A.ToJSON NotificationCount where
  toJSON :: NotificationCount -> Value
toJSON NotificationCount {Maybe Integer
$sel:notificationCountNew:NotificationCount :: NotificationCount -> Maybe Integer
notificationCountNew :: Maybe Integer
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"new" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
notificationCountNew
      ]


-- | Construct a value of type 'NotificationCount' (by applying it's required fields, if any)
mkNotificationCount
  :: NotificationCount
mkNotificationCount :: NotificationCount
mkNotificationCount =
  NotificationCount
  { $sel:notificationCountNew:NotificationCount :: Maybe Integer
notificationCountNew = Maybe Integer
forall a. Maybe a
Nothing
  }

-- ** NotificationSubject
-- | NotificationSubject
-- NotificationSubject contains the notification subject (Issue/Pull/Commit)
data NotificationSubject = NotificationSubject
  { NotificationSubject -> Maybe Text
notificationSubjectHtmlUrl :: !(Maybe Text) -- ^ "html_url"
  , NotificationSubject -> Maybe Text
notificationSubjectLatestCommentHtmlUrl :: !(Maybe Text) -- ^ "latest_comment_html_url"
  , NotificationSubject -> Maybe Text
notificationSubjectLatestCommentUrl :: !(Maybe Text) -- ^ "latest_comment_url"
  , NotificationSubject -> Maybe Text
notificationSubjectState :: !(Maybe Text) -- ^ "state" - StateType issue state type
  , NotificationSubject -> Maybe Text
notificationSubjectTitle :: !(Maybe Text) -- ^ "title"
  , NotificationSubject -> Maybe Text
notificationSubjectType :: !(Maybe Text) -- ^ "type" - NotifySubjectType represent type of notification subject
  , NotificationSubject -> Maybe Text
notificationSubjectUrl :: !(Maybe Text) -- ^ "url"
  } deriving (Int -> NotificationSubject -> ShowS
[NotificationSubject] -> ShowS
NotificationSubject -> [Char]
(Int -> NotificationSubject -> ShowS)
-> (NotificationSubject -> [Char])
-> ([NotificationSubject] -> ShowS)
-> Show NotificationSubject
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotificationSubject -> ShowS
showsPrec :: Int -> NotificationSubject -> ShowS
$cshow :: NotificationSubject -> [Char]
show :: NotificationSubject -> [Char]
$cshowList :: [NotificationSubject] -> ShowS
showList :: [NotificationSubject] -> ShowS
P.Show, NotificationSubject -> NotificationSubject -> Bool
(NotificationSubject -> NotificationSubject -> Bool)
-> (NotificationSubject -> NotificationSubject -> Bool)
-> Eq NotificationSubject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NotificationSubject -> NotificationSubject -> Bool
== :: NotificationSubject -> NotificationSubject -> Bool
$c/= :: NotificationSubject -> NotificationSubject -> Bool
/= :: NotificationSubject -> NotificationSubject -> Bool
P.Eq, P.Typeable)

-- | FromJSON NotificationSubject
instance A.FromJSON NotificationSubject where
  parseJSON :: Value -> Parser NotificationSubject
parseJSON = [Char]
-> (Object -> Parser NotificationSubject)
-> Value
-> Parser NotificationSubject
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"NotificationSubject" ((Object -> Parser NotificationSubject)
 -> Value -> Parser NotificationSubject)
-> (Object -> Parser NotificationSubject)
-> Value
-> Parser NotificationSubject
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> NotificationSubject
NotificationSubject
      (Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> NotificationSubject)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> NotificationSubject)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"html_url")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> NotificationSubject)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> NotificationSubject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"latest_comment_html_url")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> NotificationSubject)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe Text -> Maybe Text -> NotificationSubject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"latest_comment_url")
      Parser
  (Maybe Text
   -> Maybe Text -> Maybe Text -> Maybe Text -> NotificationSubject)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Text -> Maybe Text -> NotificationSubject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"state")
      Parser
  (Maybe Text -> Maybe Text -> Maybe Text -> NotificationSubject)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> NotificationSubject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title")
      Parser (Maybe Text -> Maybe Text -> NotificationSubject)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> NotificationSubject)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"type")
      Parser (Maybe Text -> NotificationSubject)
-> Parser (Maybe Text) -> Parser NotificationSubject
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")

-- | ToJSON NotificationSubject
instance A.ToJSON NotificationSubject where
  toJSON :: NotificationSubject -> Value
toJSON NotificationSubject {Maybe Text
$sel:notificationSubjectHtmlUrl:NotificationSubject :: NotificationSubject -> Maybe Text
$sel:notificationSubjectLatestCommentHtmlUrl:NotificationSubject :: NotificationSubject -> Maybe Text
$sel:notificationSubjectLatestCommentUrl:NotificationSubject :: NotificationSubject -> Maybe Text
$sel:notificationSubjectState:NotificationSubject :: NotificationSubject -> Maybe Text
$sel:notificationSubjectTitle:NotificationSubject :: NotificationSubject -> Maybe Text
$sel:notificationSubjectType:NotificationSubject :: NotificationSubject -> Maybe Text
$sel:notificationSubjectUrl:NotificationSubject :: NotificationSubject -> Maybe Text
notificationSubjectHtmlUrl :: Maybe Text
notificationSubjectLatestCommentHtmlUrl :: Maybe Text
notificationSubjectLatestCommentUrl :: Maybe Text
notificationSubjectState :: Maybe Text
notificationSubjectTitle :: Maybe Text
notificationSubjectType :: Maybe Text
notificationSubjectUrl :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"html_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
notificationSubjectHtmlUrl
      , Key
"latest_comment_html_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
notificationSubjectLatestCommentHtmlUrl
      , Key
"latest_comment_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
notificationSubjectLatestCommentUrl
      , Key
"state" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
notificationSubjectState
      , Key
"title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
notificationSubjectTitle
      , Key
"type" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
notificationSubjectType
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
notificationSubjectUrl
      ]


-- | Construct a value of type 'NotificationSubject' (by applying it's required fields, if any)
mkNotificationSubject
  :: NotificationSubject
mkNotificationSubject :: NotificationSubject
mkNotificationSubject =
  NotificationSubject
  { $sel:notificationSubjectHtmlUrl:NotificationSubject :: Maybe Text
notificationSubjectHtmlUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:notificationSubjectLatestCommentHtmlUrl:NotificationSubject :: Maybe Text
notificationSubjectLatestCommentHtmlUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:notificationSubjectLatestCommentUrl:NotificationSubject :: Maybe Text
notificationSubjectLatestCommentUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:notificationSubjectState:NotificationSubject :: Maybe Text
notificationSubjectState = Maybe Text
forall a. Maybe a
Nothing
  , $sel:notificationSubjectTitle:NotificationSubject :: Maybe Text
notificationSubjectTitle = Maybe Text
forall a. Maybe a
Nothing
  , $sel:notificationSubjectType:NotificationSubject :: Maybe Text
notificationSubjectType = Maybe Text
forall a. Maybe a
Nothing
  , $sel:notificationSubjectUrl:NotificationSubject :: Maybe Text
notificationSubjectUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** NotificationThread
-- | NotificationThread
-- NotificationThread expose Notification on API
data NotificationThread = NotificationThread
  { NotificationThread -> Maybe Integer
notificationThreadId :: !(Maybe Integer) -- ^ "id"
  , NotificationThread -> Maybe Bool
notificationThreadPinned :: !(Maybe Bool) -- ^ "pinned"
  , NotificationThread -> Maybe Repository
notificationThreadRepository :: !(Maybe Repository) -- ^ "repository"
  , NotificationThread -> Maybe NotificationSubject
notificationThreadSubject :: !(Maybe NotificationSubject) -- ^ "subject"
  , NotificationThread -> Maybe Bool
notificationThreadUnread :: !(Maybe Bool) -- ^ "unread"
  , NotificationThread -> Maybe DateTime
notificationThreadUpdatedAt :: !(Maybe DateTime) -- ^ "updated_at"
  , NotificationThread -> Maybe Text
notificationThreadUrl :: !(Maybe Text) -- ^ "url"
  } deriving (Int -> NotificationThread -> ShowS
[NotificationThread] -> ShowS
NotificationThread -> [Char]
(Int -> NotificationThread -> ShowS)
-> (NotificationThread -> [Char])
-> ([NotificationThread] -> ShowS)
-> Show NotificationThread
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotificationThread -> ShowS
showsPrec :: Int -> NotificationThread -> ShowS
$cshow :: NotificationThread -> [Char]
show :: NotificationThread -> [Char]
$cshowList :: [NotificationThread] -> ShowS
showList :: [NotificationThread] -> ShowS
P.Show, NotificationThread -> NotificationThread -> Bool
(NotificationThread -> NotificationThread -> Bool)
-> (NotificationThread -> NotificationThread -> Bool)
-> Eq NotificationThread
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NotificationThread -> NotificationThread -> Bool
== :: NotificationThread -> NotificationThread -> Bool
$c/= :: NotificationThread -> NotificationThread -> Bool
/= :: NotificationThread -> NotificationThread -> Bool
P.Eq, P.Typeable)

-- | FromJSON NotificationThread
instance A.FromJSON NotificationThread where
  parseJSON :: Value -> Parser NotificationThread
parseJSON = [Char]
-> (Object -> Parser NotificationThread)
-> Value
-> Parser NotificationThread
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"NotificationThread" ((Object -> Parser NotificationThread)
 -> Value -> Parser NotificationThread)
-> (Object -> Parser NotificationThread)
-> Value
-> Parser NotificationThread
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Integer
-> Maybe Bool
-> Maybe Repository
-> Maybe NotificationSubject
-> Maybe Bool
-> Maybe DateTime
-> Maybe Text
-> NotificationThread
NotificationThread
      (Maybe Integer
 -> Maybe Bool
 -> Maybe Repository
 -> Maybe NotificationSubject
 -> Maybe Bool
 -> Maybe DateTime
 -> Maybe Text
 -> NotificationThread)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Bool
      -> Maybe Repository
      -> Maybe NotificationSubject
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe Text
      -> NotificationThread)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Bool
   -> Maybe Repository
   -> Maybe NotificationSubject
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe Text
   -> NotificationThread)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Repository
      -> Maybe NotificationSubject
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe Text
      -> NotificationThread)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pinned")
      Parser
  (Maybe Repository
   -> Maybe NotificationSubject
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe Text
   -> NotificationThread)
-> Parser (Maybe Repository)
-> Parser
     (Maybe NotificationSubject
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe Text
      -> NotificationThread)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Repository)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"repository")
      Parser
  (Maybe NotificationSubject
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe Text
   -> NotificationThread)
-> Parser (Maybe NotificationSubject)
-> Parser
     (Maybe Bool -> Maybe DateTime -> Maybe Text -> NotificationThread)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe NotificationSubject)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"subject")
      Parser
  (Maybe Bool -> Maybe DateTime -> Maybe Text -> NotificationThread)
-> Parser (Maybe Bool)
-> Parser (Maybe DateTime -> Maybe Text -> NotificationThread)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"unread")
      Parser (Maybe DateTime -> Maybe Text -> NotificationThread)
-> Parser (Maybe DateTime)
-> Parser (Maybe Text -> NotificationThread)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated_at")
      Parser (Maybe Text -> NotificationThread)
-> Parser (Maybe Text) -> Parser NotificationThread
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")

-- | ToJSON NotificationThread
instance A.ToJSON NotificationThread where
  toJSON :: NotificationThread -> Value
toJSON NotificationThread {Maybe Bool
Maybe Integer
Maybe Text
Maybe DateTime
Maybe Repository
Maybe NotificationSubject
$sel:notificationThreadId:NotificationThread :: NotificationThread -> Maybe Integer
$sel:notificationThreadPinned:NotificationThread :: NotificationThread -> Maybe Bool
$sel:notificationThreadRepository:NotificationThread :: NotificationThread -> Maybe Repository
$sel:notificationThreadSubject:NotificationThread :: NotificationThread -> Maybe NotificationSubject
$sel:notificationThreadUnread:NotificationThread :: NotificationThread -> Maybe Bool
$sel:notificationThreadUpdatedAt:NotificationThread :: NotificationThread -> Maybe DateTime
$sel:notificationThreadUrl:NotificationThread :: NotificationThread -> Maybe Text
notificationThreadId :: Maybe Integer
notificationThreadPinned :: Maybe Bool
notificationThreadRepository :: Maybe Repository
notificationThreadSubject :: Maybe NotificationSubject
notificationThreadUnread :: Maybe Bool
notificationThreadUpdatedAt :: Maybe DateTime
notificationThreadUrl :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
notificationThreadId
      , Key
"pinned" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
notificationThreadPinned
      , Key
"repository" Key -> Maybe Repository -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Repository
notificationThreadRepository
      , Key
"subject" Key -> Maybe NotificationSubject -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe NotificationSubject
notificationThreadSubject
      , Key
"unread" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
notificationThreadUnread
      , Key
"updated_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
notificationThreadUpdatedAt
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
notificationThreadUrl
      ]


-- | Construct a value of type 'NotificationThread' (by applying it's required fields, if any)
mkNotificationThread
  :: NotificationThread
mkNotificationThread :: NotificationThread
mkNotificationThread =
  NotificationThread
  { $sel:notificationThreadId:NotificationThread :: Maybe Integer
notificationThreadId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:notificationThreadPinned:NotificationThread :: Maybe Bool
notificationThreadPinned = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:notificationThreadRepository:NotificationThread :: Maybe Repository
notificationThreadRepository = Maybe Repository
forall a. Maybe a
Nothing
  , $sel:notificationThreadSubject:NotificationThread :: Maybe NotificationSubject
notificationThreadSubject = Maybe NotificationSubject
forall a. Maybe a
Nothing
  , $sel:notificationThreadUnread:NotificationThread :: Maybe Bool
notificationThreadUnread = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:notificationThreadUpdatedAt:NotificationThread :: Maybe DateTime
notificationThreadUpdatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:notificationThreadUrl:NotificationThread :: Maybe Text
notificationThreadUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** OAuth2Application
-- | OAuth2Application
-- OAuth2Application represents an OAuth2 application.
-- 
data OAuth2Application = OAuth2Application
  { OAuth2Application -> Maybe Text
oAuth2ApplicationClientId :: !(Maybe Text) -- ^ "client_id"
  , OAuth2Application -> Maybe Text
oAuth2ApplicationClientSecret :: !(Maybe Text) -- ^ "client_secret"
  , OAuth2Application -> Maybe Bool
oAuth2ApplicationConfidentialClient :: !(Maybe Bool) -- ^ "confidential_client"
  , OAuth2Application -> Maybe DateTime
oAuth2ApplicationCreated :: !(Maybe DateTime) -- ^ "created"
  , OAuth2Application -> Maybe Integer
oAuth2ApplicationId :: !(Maybe Integer) -- ^ "id"
  , OAuth2Application -> Maybe Text
oAuth2ApplicationName :: !(Maybe Text) -- ^ "name"
  , OAuth2Application -> Maybe [Text]
oAuth2ApplicationRedirectUris :: !(Maybe [Text]) -- ^ "redirect_uris"
  , OAuth2Application -> Maybe Bool
oAuth2ApplicationSkipSecondaryAuthorization :: !(Maybe Bool) -- ^ "skip_secondary_authorization"
  } deriving (Int -> OAuth2Application -> ShowS
[OAuth2Application] -> ShowS
OAuth2Application -> [Char]
(Int -> OAuth2Application -> ShowS)
-> (OAuth2Application -> [Char])
-> ([OAuth2Application] -> ShowS)
-> Show OAuth2Application
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OAuth2Application -> ShowS
showsPrec :: Int -> OAuth2Application -> ShowS
$cshow :: OAuth2Application -> [Char]
show :: OAuth2Application -> [Char]
$cshowList :: [OAuth2Application] -> ShowS
showList :: [OAuth2Application] -> ShowS
P.Show, OAuth2Application -> OAuth2Application -> Bool
(OAuth2Application -> OAuth2Application -> Bool)
-> (OAuth2Application -> OAuth2Application -> Bool)
-> Eq OAuth2Application
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OAuth2Application -> OAuth2Application -> Bool
== :: OAuth2Application -> OAuth2Application -> Bool
$c/= :: OAuth2Application -> OAuth2Application -> Bool
/= :: OAuth2Application -> OAuth2Application -> Bool
P.Eq, P.Typeable)

-- | FromJSON OAuth2Application
instance A.FromJSON OAuth2Application where
  parseJSON :: Value -> Parser OAuth2Application
parseJSON = [Char]
-> (Object -> Parser OAuth2Application)
-> Value
-> Parser OAuth2Application
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"OAuth2Application" ((Object -> Parser OAuth2Application)
 -> Value -> Parser OAuth2Application)
-> (Object -> Parser OAuth2Application)
-> Value
-> Parser OAuth2Application
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe DateTime
-> Maybe Integer
-> Maybe Text
-> Maybe [Text]
-> Maybe Bool
-> OAuth2Application
OAuth2Application
      (Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Maybe DateTime
 -> Maybe Integer
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe Bool
 -> OAuth2Application)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Bool
      -> OAuth2Application)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"client_id")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Bool
   -> OAuth2Application)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Bool
      -> OAuth2Application)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"client_secret")
      Parser
  (Maybe Bool
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Bool
   -> OAuth2Application)
-> Parser (Maybe Bool)
-> Parser
     (Maybe DateTime
      -> Maybe Integer
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Bool
      -> OAuth2Application)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"confidential_client")
      Parser
  (Maybe DateTime
   -> Maybe Integer
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Bool
   -> OAuth2Application)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Integer
      -> Maybe Text -> Maybe [Text] -> Maybe Bool -> OAuth2Application)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe Integer
   -> Maybe Text -> Maybe [Text] -> Maybe Bool -> OAuth2Application)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text -> Maybe [Text] -> Maybe Bool -> OAuth2Application)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Text -> Maybe [Text] -> Maybe Bool -> OAuth2Application)
-> Parser (Maybe Text)
-> Parser (Maybe [Text] -> Maybe Bool -> OAuth2Application)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser (Maybe [Text] -> Maybe Bool -> OAuth2Application)
-> Parser (Maybe [Text])
-> Parser (Maybe Bool -> OAuth2Application)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"redirect_uris")
      Parser (Maybe Bool -> OAuth2Application)
-> Parser (Maybe Bool) -> Parser OAuth2Application
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"skip_secondary_authorization")

-- | ToJSON OAuth2Application
instance A.ToJSON OAuth2Application where
  toJSON :: OAuth2Application -> Value
toJSON OAuth2Application {Maybe Bool
Maybe Integer
Maybe [Text]
Maybe Text
Maybe DateTime
$sel:oAuth2ApplicationClientId:OAuth2Application :: OAuth2Application -> Maybe Text
$sel:oAuth2ApplicationClientSecret:OAuth2Application :: OAuth2Application -> Maybe Text
$sel:oAuth2ApplicationConfidentialClient:OAuth2Application :: OAuth2Application -> Maybe Bool
$sel:oAuth2ApplicationCreated:OAuth2Application :: OAuth2Application -> Maybe DateTime
$sel:oAuth2ApplicationId:OAuth2Application :: OAuth2Application -> Maybe Integer
$sel:oAuth2ApplicationName:OAuth2Application :: OAuth2Application -> Maybe Text
$sel:oAuth2ApplicationRedirectUris:OAuth2Application :: OAuth2Application -> Maybe [Text]
$sel:oAuth2ApplicationSkipSecondaryAuthorization:OAuth2Application :: OAuth2Application -> Maybe Bool
oAuth2ApplicationClientId :: Maybe Text
oAuth2ApplicationClientSecret :: Maybe Text
oAuth2ApplicationConfidentialClient :: Maybe Bool
oAuth2ApplicationCreated :: Maybe DateTime
oAuth2ApplicationId :: Maybe Integer
oAuth2ApplicationName :: Maybe Text
oAuth2ApplicationRedirectUris :: Maybe [Text]
oAuth2ApplicationSkipSecondaryAuthorization :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"client_id" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
oAuth2ApplicationClientId
      , Key
"client_secret" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
oAuth2ApplicationClientSecret
      , Key
"confidential_client" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
oAuth2ApplicationConfidentialClient
      , Key
"created" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
oAuth2ApplicationCreated
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
oAuth2ApplicationId
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
oAuth2ApplicationName
      , Key
"redirect_uris" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
oAuth2ApplicationRedirectUris
      , Key
"skip_secondary_authorization" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
oAuth2ApplicationSkipSecondaryAuthorization
      ]


-- | Construct a value of type 'OAuth2Application' (by applying it's required fields, if any)
mkOAuth2Application
  :: OAuth2Application
mkOAuth2Application :: OAuth2Application
mkOAuth2Application =
  OAuth2Application
  { $sel:oAuth2ApplicationClientId:OAuth2Application :: Maybe Text
oAuth2ApplicationClientId = Maybe Text
forall a. Maybe a
Nothing
  , $sel:oAuth2ApplicationClientSecret:OAuth2Application :: Maybe Text
oAuth2ApplicationClientSecret = Maybe Text
forall a. Maybe a
Nothing
  , $sel:oAuth2ApplicationConfidentialClient:OAuth2Application :: Maybe Bool
oAuth2ApplicationConfidentialClient = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:oAuth2ApplicationCreated:OAuth2Application :: Maybe DateTime
oAuth2ApplicationCreated = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:oAuth2ApplicationId:OAuth2Application :: Maybe Integer
oAuth2ApplicationId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:oAuth2ApplicationName:OAuth2Application :: Maybe Text
oAuth2ApplicationName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:oAuth2ApplicationRedirectUris:OAuth2Application :: Maybe [Text]
oAuth2ApplicationRedirectUris = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:oAuth2ApplicationSkipSecondaryAuthorization:OAuth2Application :: Maybe Bool
oAuth2ApplicationSkipSecondaryAuthorization = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** Organization
-- | Organization
-- Organization represents an organization
data Organization = Organization
  { Organization -> Maybe Text
organizationAvatarUrl :: !(Maybe Text) -- ^ "avatar_url"
  , Organization -> Maybe Text
organizationDescription :: !(Maybe Text) -- ^ "description"
  , Organization -> Maybe Text
organizationEmail :: !(Maybe Text) -- ^ "email"
  , Organization -> Maybe Text
organizationFullName :: !(Maybe Text) -- ^ "full_name"
  , Organization -> Maybe Integer
organizationId :: !(Maybe Integer) -- ^ "id"
  , Organization -> Maybe Text
organizationLocation :: !(Maybe Text) -- ^ "location"
  , Organization -> Maybe Text
organizationName :: !(Maybe Text) -- ^ "name"
  , Organization -> Maybe Bool
organizationRepoAdminChangeTeamAccess :: !(Maybe Bool) -- ^ "repo_admin_change_team_access"
  , Organization -> Maybe Text
organizationUsername :: !(Maybe Text) -- ^ "username" - deprecated
  , Organization -> Maybe Text
organizationVisibility :: !(Maybe Text) -- ^ "visibility"
  , Organization -> Maybe Text
organizationWebsite :: !(Maybe Text) -- ^ "website"
  } deriving (Int -> Organization -> ShowS
[Organization] -> ShowS
Organization -> [Char]
(Int -> Organization -> ShowS)
-> (Organization -> [Char])
-> ([Organization] -> ShowS)
-> Show Organization
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Organization -> ShowS
showsPrec :: Int -> Organization -> ShowS
$cshow :: Organization -> [Char]
show :: Organization -> [Char]
$cshowList :: [Organization] -> ShowS
showList :: [Organization] -> ShowS
P.Show, Organization -> Organization -> Bool
(Organization -> Organization -> Bool)
-> (Organization -> Organization -> Bool) -> Eq Organization
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Organization -> Organization -> Bool
== :: Organization -> Organization -> Bool
$c/= :: Organization -> Organization -> Bool
/= :: Organization -> Organization -> Bool
P.Eq, P.Typeable)

-- | FromJSON Organization
instance A.FromJSON Organization where
  parseJSON :: Value -> Parser Organization
parseJSON = [Char]
-> (Object -> Parser Organization) -> Value -> Parser Organization
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Organization" ((Object -> Parser Organization) -> Value -> Parser Organization)
-> (Object -> Parser Organization) -> Value -> Parser Organization
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Organization
Organization
      (Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Organization)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Organization)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"avatar_url")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Organization)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Organization)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Organization)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Organization)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"email")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Organization)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Organization)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"full_name")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Organization)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Organization)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Organization)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Organization)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"location")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Organization)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Text -> Maybe Text -> Maybe Text -> Organization)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser
  (Maybe Bool
   -> Maybe Text -> Maybe Text -> Maybe Text -> Organization)
-> Parser (Maybe Bool)
-> Parser (Maybe Text -> Maybe Text -> Maybe Text -> Organization)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"repo_admin_change_team_access")
      Parser (Maybe Text -> Maybe Text -> Maybe Text -> Organization)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> Organization)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"username")
      Parser (Maybe Text -> Maybe Text -> Organization)
-> Parser (Maybe Text) -> Parser (Maybe Text -> Organization)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"visibility")
      Parser (Maybe Text -> Organization)
-> Parser (Maybe Text) -> Parser Organization
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"website")

-- | ToJSON Organization
instance A.ToJSON Organization where
  toJSON :: Organization -> Value
toJSON Organization {Maybe Bool
Maybe Integer
Maybe Text
$sel:organizationAvatarUrl:Organization :: Organization -> Maybe Text
$sel:organizationDescription:Organization :: Organization -> Maybe Text
$sel:organizationEmail:Organization :: Organization -> Maybe Text
$sel:organizationFullName:Organization :: Organization -> Maybe Text
$sel:organizationId:Organization :: Organization -> Maybe Integer
$sel:organizationLocation:Organization :: Organization -> Maybe Text
$sel:organizationName:Organization :: Organization -> Maybe Text
$sel:organizationRepoAdminChangeTeamAccess:Organization :: Organization -> Maybe Bool
$sel:organizationUsername:Organization :: Organization -> Maybe Text
$sel:organizationVisibility:Organization :: Organization -> Maybe Text
$sel:organizationWebsite:Organization :: Organization -> Maybe Text
organizationAvatarUrl :: Maybe Text
organizationDescription :: Maybe Text
organizationEmail :: Maybe Text
organizationFullName :: Maybe Text
organizationId :: Maybe Integer
organizationLocation :: Maybe Text
organizationName :: Maybe Text
organizationRepoAdminChangeTeamAccess :: Maybe Bool
organizationUsername :: Maybe Text
organizationVisibility :: Maybe Text
organizationWebsite :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"avatar_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
organizationAvatarUrl
      , Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
organizationDescription
      , Key
"email" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
organizationEmail
      , Key
"full_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
organizationFullName
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
organizationId
      , Key
"location" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
organizationLocation
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
organizationName
      , Key
"repo_admin_change_team_access" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
organizationRepoAdminChangeTeamAccess
      , Key
"username" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
organizationUsername
      , Key
"visibility" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
organizationVisibility
      , Key
"website" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
organizationWebsite
      ]


-- | Construct a value of type 'Organization' (by applying it's required fields, if any)
mkOrganization
  :: Organization
mkOrganization :: Organization
mkOrganization =
  Organization
  { $sel:organizationAvatarUrl:Organization :: Maybe Text
organizationAvatarUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:organizationDescription:Organization :: Maybe Text
organizationDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:organizationEmail:Organization :: Maybe Text
organizationEmail = Maybe Text
forall a. Maybe a
Nothing
  , $sel:organizationFullName:Organization :: Maybe Text
organizationFullName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:organizationId:Organization :: Maybe Integer
organizationId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:organizationLocation:Organization :: Maybe Text
organizationLocation = Maybe Text
forall a. Maybe a
Nothing
  , $sel:organizationName:Organization :: Maybe Text
organizationName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:organizationRepoAdminChangeTeamAccess:Organization :: Maybe Bool
organizationRepoAdminChangeTeamAccess = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:organizationUsername:Organization :: Maybe Text
organizationUsername = Maybe Text
forall a. Maybe a
Nothing
  , $sel:organizationVisibility:Organization :: Maybe Text
organizationVisibility = Maybe Text
forall a. Maybe a
Nothing
  , $sel:organizationWebsite:Organization :: Maybe Text
organizationWebsite = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** OrganizationPermissions
-- | OrganizationPermissions
-- OrganizationPermissions list different users permissions on an organization
data OrganizationPermissions = OrganizationPermissions
  { OrganizationPermissions -> Maybe Bool
organizationPermissionsCanCreateRepository :: !(Maybe Bool) -- ^ "can_create_repository"
  , OrganizationPermissions -> Maybe Bool
organizationPermissionsCanRead :: !(Maybe Bool) -- ^ "can_read"
  , OrganizationPermissions -> Maybe Bool
organizationPermissionsCanWrite :: !(Maybe Bool) -- ^ "can_write"
  , OrganizationPermissions -> Maybe Bool
organizationPermissionsIsAdmin :: !(Maybe Bool) -- ^ "is_admin"
  , OrganizationPermissions -> Maybe Bool
organizationPermissionsIsOwner :: !(Maybe Bool) -- ^ "is_owner"
  } deriving (Int -> OrganizationPermissions -> ShowS
[OrganizationPermissions] -> ShowS
OrganizationPermissions -> [Char]
(Int -> OrganizationPermissions -> ShowS)
-> (OrganizationPermissions -> [Char])
-> ([OrganizationPermissions] -> ShowS)
-> Show OrganizationPermissions
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> OrganizationPermissions -> ShowS
showsPrec :: Int -> OrganizationPermissions -> ShowS
$cshow :: OrganizationPermissions -> [Char]
show :: OrganizationPermissions -> [Char]
$cshowList :: [OrganizationPermissions] -> ShowS
showList :: [OrganizationPermissions] -> ShowS
P.Show, OrganizationPermissions -> OrganizationPermissions -> Bool
(OrganizationPermissions -> OrganizationPermissions -> Bool)
-> (OrganizationPermissions -> OrganizationPermissions -> Bool)
-> Eq OrganizationPermissions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OrganizationPermissions -> OrganizationPermissions -> Bool
== :: OrganizationPermissions -> OrganizationPermissions -> Bool
$c/= :: OrganizationPermissions -> OrganizationPermissions -> Bool
/= :: OrganizationPermissions -> OrganizationPermissions -> Bool
P.Eq, P.Typeable)

-- | FromJSON OrganizationPermissions
instance A.FromJSON OrganizationPermissions where
  parseJSON :: Value -> Parser OrganizationPermissions
parseJSON = [Char]
-> (Object -> Parser OrganizationPermissions)
-> Value
-> Parser OrganizationPermissions
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"OrganizationPermissions" ((Object -> Parser OrganizationPermissions)
 -> Value -> Parser OrganizationPermissions)
-> (Object -> Parser OrganizationPermissions)
-> Value
-> Parser OrganizationPermissions
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> OrganizationPermissions
OrganizationPermissions
      (Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> OrganizationPermissions)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> OrganizationPermissions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"can_create_repository")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> OrganizationPermissions)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool -> Maybe Bool -> Maybe Bool -> OrganizationPermissions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"can_read")
      Parser
  (Maybe Bool -> Maybe Bool -> Maybe Bool -> OrganizationPermissions)
-> Parser (Maybe Bool)
-> Parser (Maybe Bool -> Maybe Bool -> OrganizationPermissions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"can_write")
      Parser (Maybe Bool -> Maybe Bool -> OrganizationPermissions)
-> Parser (Maybe Bool)
-> Parser (Maybe Bool -> OrganizationPermissions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_admin")
      Parser (Maybe Bool -> OrganizationPermissions)
-> Parser (Maybe Bool) -> Parser OrganizationPermissions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_owner")

-- | ToJSON OrganizationPermissions
instance A.ToJSON OrganizationPermissions where
  toJSON :: OrganizationPermissions -> Value
toJSON OrganizationPermissions {Maybe Bool
$sel:organizationPermissionsCanCreateRepository:OrganizationPermissions :: OrganizationPermissions -> Maybe Bool
$sel:organizationPermissionsCanRead:OrganizationPermissions :: OrganizationPermissions -> Maybe Bool
$sel:organizationPermissionsCanWrite:OrganizationPermissions :: OrganizationPermissions -> Maybe Bool
$sel:organizationPermissionsIsAdmin:OrganizationPermissions :: OrganizationPermissions -> Maybe Bool
$sel:organizationPermissionsIsOwner:OrganizationPermissions :: OrganizationPermissions -> Maybe Bool
organizationPermissionsCanCreateRepository :: Maybe Bool
organizationPermissionsCanRead :: Maybe Bool
organizationPermissionsCanWrite :: Maybe Bool
organizationPermissionsIsAdmin :: Maybe Bool
organizationPermissionsIsOwner :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"can_create_repository" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
organizationPermissionsCanCreateRepository
      , Key
"can_read" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
organizationPermissionsCanRead
      , Key
"can_write" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
organizationPermissionsCanWrite
      , Key
"is_admin" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
organizationPermissionsIsAdmin
      , Key
"is_owner" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
organizationPermissionsIsOwner
      ]


-- | Construct a value of type 'OrganizationPermissions' (by applying it's required fields, if any)
mkOrganizationPermissions
  :: OrganizationPermissions
mkOrganizationPermissions :: OrganizationPermissions
mkOrganizationPermissions =
  OrganizationPermissions
  { $sel:organizationPermissionsCanCreateRepository:OrganizationPermissions :: Maybe Bool
organizationPermissionsCanCreateRepository = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:organizationPermissionsCanRead:OrganizationPermissions :: Maybe Bool
organizationPermissionsCanRead = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:organizationPermissionsCanWrite:OrganizationPermissions :: Maybe Bool
organizationPermissionsCanWrite = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:organizationPermissionsIsAdmin:OrganizationPermissions :: Maybe Bool
organizationPermissionsIsAdmin = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:organizationPermissionsIsOwner:OrganizationPermissions :: Maybe Bool
organizationPermissionsIsOwner = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** PRBranchInfo
-- | PRBranchInfo
-- PRBranchInfo information about a branch
data PRBranchInfo = PRBranchInfo
  { PRBranchInfo -> Maybe Text
pRBranchInfoLabel :: !(Maybe Text) -- ^ "label"
  , PRBranchInfo -> Maybe Text
pRBranchInfoRef :: !(Maybe Text) -- ^ "ref"
  , PRBranchInfo -> Maybe Repository
pRBranchInfoRepo :: !(Maybe Repository) -- ^ "repo"
  , PRBranchInfo -> Maybe Integer
pRBranchInfoRepoId :: !(Maybe Integer) -- ^ "repo_id"
  , PRBranchInfo -> Maybe Text
pRBranchInfoSha :: !(Maybe Text) -- ^ "sha"
  } deriving (Int -> PRBranchInfo -> ShowS
[PRBranchInfo] -> ShowS
PRBranchInfo -> [Char]
(Int -> PRBranchInfo -> ShowS)
-> (PRBranchInfo -> [Char])
-> ([PRBranchInfo] -> ShowS)
-> Show PRBranchInfo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PRBranchInfo -> ShowS
showsPrec :: Int -> PRBranchInfo -> ShowS
$cshow :: PRBranchInfo -> [Char]
show :: PRBranchInfo -> [Char]
$cshowList :: [PRBranchInfo] -> ShowS
showList :: [PRBranchInfo] -> ShowS
P.Show, PRBranchInfo -> PRBranchInfo -> Bool
(PRBranchInfo -> PRBranchInfo -> Bool)
-> (PRBranchInfo -> PRBranchInfo -> Bool) -> Eq PRBranchInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PRBranchInfo -> PRBranchInfo -> Bool
== :: PRBranchInfo -> PRBranchInfo -> Bool
$c/= :: PRBranchInfo -> PRBranchInfo -> Bool
/= :: PRBranchInfo -> PRBranchInfo -> Bool
P.Eq, P.Typeable)

-- | FromJSON PRBranchInfo
instance A.FromJSON PRBranchInfo where
  parseJSON :: Value -> Parser PRBranchInfo
parseJSON = [Char]
-> (Object -> Parser PRBranchInfo) -> Value -> Parser PRBranchInfo
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"PRBranchInfo" ((Object -> Parser PRBranchInfo) -> Value -> Parser PRBranchInfo)
-> (Object -> Parser PRBranchInfo) -> Value -> Parser PRBranchInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Repository
-> Maybe Integer
-> Maybe Text
-> PRBranchInfo
PRBranchInfo
      (Maybe Text
 -> Maybe Text
 -> Maybe Repository
 -> Maybe Integer
 -> Maybe Text
 -> PRBranchInfo)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Repository -> Maybe Integer -> Maybe Text -> PRBranchInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"label")
      Parser
  (Maybe Text
   -> Maybe Repository -> Maybe Integer -> Maybe Text -> PRBranchInfo)
-> Parser (Maybe Text)
-> Parser
     (Maybe Repository -> Maybe Integer -> Maybe Text -> PRBranchInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ref")
      Parser
  (Maybe Repository -> Maybe Integer -> Maybe Text -> PRBranchInfo)
-> Parser (Maybe Repository)
-> Parser (Maybe Integer -> Maybe Text -> PRBranchInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Repository)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"repo")
      Parser (Maybe Integer -> Maybe Text -> PRBranchInfo)
-> Parser (Maybe Integer) -> Parser (Maybe Text -> PRBranchInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"repo_id")
      Parser (Maybe Text -> PRBranchInfo)
-> Parser (Maybe Text) -> Parser PRBranchInfo
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sha")

-- | ToJSON PRBranchInfo
instance A.ToJSON PRBranchInfo where
  toJSON :: PRBranchInfo -> Value
toJSON PRBranchInfo {Maybe Integer
Maybe Text
Maybe Repository
$sel:pRBranchInfoLabel:PRBranchInfo :: PRBranchInfo -> Maybe Text
$sel:pRBranchInfoRef:PRBranchInfo :: PRBranchInfo -> Maybe Text
$sel:pRBranchInfoRepo:PRBranchInfo :: PRBranchInfo -> Maybe Repository
$sel:pRBranchInfoRepoId:PRBranchInfo :: PRBranchInfo -> Maybe Integer
$sel:pRBranchInfoSha:PRBranchInfo :: PRBranchInfo -> Maybe Text
pRBranchInfoLabel :: Maybe Text
pRBranchInfoRef :: Maybe Text
pRBranchInfoRepo :: Maybe Repository
pRBranchInfoRepoId :: Maybe Integer
pRBranchInfoSha :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"label" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pRBranchInfoLabel
      , Key
"ref" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pRBranchInfoRef
      , Key
"repo" Key -> Maybe Repository -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Repository
pRBranchInfoRepo
      , Key
"repo_id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
pRBranchInfoRepoId
      , Key
"sha" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pRBranchInfoSha
      ]


-- | Construct a value of type 'PRBranchInfo' (by applying it's required fields, if any)
mkPRBranchInfo
  :: PRBranchInfo
mkPRBranchInfo :: PRBranchInfo
mkPRBranchInfo =
  PRBranchInfo
  { $sel:pRBranchInfoLabel:PRBranchInfo :: Maybe Text
pRBranchInfoLabel = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pRBranchInfoRef:PRBranchInfo :: Maybe Text
pRBranchInfoRef = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pRBranchInfoRepo:PRBranchInfo :: Maybe Repository
pRBranchInfoRepo = Maybe Repository
forall a. Maybe a
Nothing
  , $sel:pRBranchInfoRepoId:PRBranchInfo :: Maybe Integer
pRBranchInfoRepoId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:pRBranchInfoSha:PRBranchInfo :: Maybe Text
pRBranchInfoSha = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** Package
-- | Package
-- Package represents a package
data Package = Package
  { Package -> Maybe DateTime
packageCreatedAt :: !(Maybe DateTime) -- ^ "created_at"
  , Package -> Maybe User
packageCreator :: !(Maybe User) -- ^ "creator"
  , Package -> Maybe Text
packageHtmlUrl :: !(Maybe Text) -- ^ "html_url"
  , Package -> Maybe Integer
packageId :: !(Maybe Integer) -- ^ "id"
  , Package -> Maybe Text
packageName :: !(Maybe Text) -- ^ "name"
  , Package -> Maybe User
packageOwner :: !(Maybe User) -- ^ "owner"
  , Package -> Maybe Repository
packageRepository :: !(Maybe Repository) -- ^ "repository"
  , Package -> Maybe Text
packageType :: !(Maybe Text) -- ^ "type"
  , Package -> Maybe Text
packageVersion :: !(Maybe Text) -- ^ "version"
  } deriving (Int -> Package -> ShowS
[Package] -> ShowS
Package -> [Char]
(Int -> Package -> ShowS)
-> (Package -> [Char]) -> ([Package] -> ShowS) -> Show Package
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Package -> ShowS
showsPrec :: Int -> Package -> ShowS
$cshow :: Package -> [Char]
show :: Package -> [Char]
$cshowList :: [Package] -> ShowS
showList :: [Package] -> ShowS
P.Show, Package -> Package -> Bool
(Package -> Package -> Bool)
-> (Package -> Package -> Bool) -> Eq Package
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Package -> Package -> Bool
== :: Package -> Package -> Bool
$c/= :: Package -> Package -> Bool
/= :: Package -> Package -> Bool
P.Eq, P.Typeable)

-- | FromJSON Package
instance A.FromJSON Package where
  parseJSON :: Value -> Parser Package
parseJSON = [Char] -> (Object -> Parser Package) -> Value -> Parser Package
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Package" ((Object -> Parser Package) -> Value -> Parser Package)
-> (Object -> Parser Package) -> Value -> Parser Package
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe DateTime
-> Maybe User
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe User
-> Maybe Repository
-> Maybe Text
-> Maybe Text
-> Package
Package
      (Maybe DateTime
 -> Maybe User
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Text
 -> Maybe User
 -> Maybe Repository
 -> Maybe Text
 -> Maybe Text
 -> Package)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe User
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Text
      -> Maybe Text
      -> Package)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_at")
      Parser
  (Maybe User
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Text
   -> Maybe Text
   -> Package)
-> Parser (Maybe User)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Text
      -> Maybe Text
      -> Package)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"creator")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Text
   -> Maybe Text
   -> Package)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Text
      -> Maybe Text
      -> Package)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"html_url")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Text
   -> Maybe Text
   -> Package)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Text
      -> Maybe Text
      -> Package)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Text
   -> Maybe Text
   -> Package)
-> Parser (Maybe Text)
-> Parser
     (Maybe User
      -> Maybe Repository -> Maybe Text -> Maybe Text -> Package)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser
  (Maybe User
   -> Maybe Repository -> Maybe Text -> Maybe Text -> Package)
-> Parser (Maybe User)
-> Parser (Maybe Repository -> Maybe Text -> Maybe Text -> Package)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"owner")
      Parser (Maybe Repository -> Maybe Text -> Maybe Text -> Package)
-> Parser (Maybe Repository)
-> Parser (Maybe Text -> Maybe Text -> Package)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Repository)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"repository")
      Parser (Maybe Text -> Maybe Text -> Package)
-> Parser (Maybe Text) -> Parser (Maybe Text -> Package)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"type")
      Parser (Maybe Text -> Package)
-> Parser (Maybe Text) -> Parser Package
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"version")

-- | ToJSON Package
instance A.ToJSON Package where
  toJSON :: Package -> Value
toJSON Package {Maybe Integer
Maybe Text
Maybe DateTime
Maybe User
Maybe Repository
$sel:packageCreatedAt:Package :: Package -> Maybe DateTime
$sel:packageCreator:Package :: Package -> Maybe User
$sel:packageHtmlUrl:Package :: Package -> Maybe Text
$sel:packageId:Package :: Package -> Maybe Integer
$sel:packageName:Package :: Package -> Maybe Text
$sel:packageOwner:Package :: Package -> Maybe User
$sel:packageRepository:Package :: Package -> Maybe Repository
$sel:packageType:Package :: Package -> Maybe Text
$sel:packageVersion:Package :: Package -> Maybe Text
packageCreatedAt :: Maybe DateTime
packageCreator :: Maybe User
packageHtmlUrl :: Maybe Text
packageId :: Maybe Integer
packageName :: Maybe Text
packageOwner :: Maybe User
packageRepository :: Maybe Repository
packageType :: Maybe Text
packageVersion :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
packageCreatedAt
      , Key
"creator" Key -> Maybe User -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe User
packageCreator
      , Key
"html_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
packageHtmlUrl
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
packageId
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
packageName
      , Key
"owner" Key -> Maybe User -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe User
packageOwner
      , Key
"repository" Key -> Maybe Repository -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Repository
packageRepository
      , Key
"type" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
packageType
      , Key
"version" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
packageVersion
      ]


-- | Construct a value of type 'Package' (by applying it's required fields, if any)
mkPackage
  :: Package
mkPackage :: Package
mkPackage =
  Package
  { $sel:packageCreatedAt:Package :: Maybe DateTime
packageCreatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:packageCreator:Package :: Maybe User
packageCreator = Maybe User
forall a. Maybe a
Nothing
  , $sel:packageHtmlUrl:Package :: Maybe Text
packageHtmlUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:packageId:Package :: Maybe Integer
packageId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:packageName:Package :: Maybe Text
packageName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:packageOwner:Package :: Maybe User
packageOwner = Maybe User
forall a. Maybe a
Nothing
  , $sel:packageRepository:Package :: Maybe Repository
packageRepository = Maybe Repository
forall a. Maybe a
Nothing
  , $sel:packageType:Package :: Maybe Text
packageType = Maybe Text
forall a. Maybe a
Nothing
  , $sel:packageVersion:Package :: Maybe Text
packageVersion = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** PackageFile
-- | PackageFile
-- PackageFile represents a package file
data PackageFile = PackageFile
  { PackageFile -> Maybe Integer
packageFileSize :: !(Maybe Integer) -- ^ "Size"
  , PackageFile -> Maybe Integer
packageFileId :: !(Maybe Integer) -- ^ "id"
  , PackageFile -> Maybe Text
packageFileMd5 :: !(Maybe Text) -- ^ "md5"
  , PackageFile -> Maybe Text
packageFileName :: !(Maybe Text) -- ^ "name"
  , PackageFile -> Maybe Text
packageFileSha1 :: !(Maybe Text) -- ^ "sha1"
  , PackageFile -> Maybe Text
packageFileSha256 :: !(Maybe Text) -- ^ "sha256"
  , PackageFile -> Maybe Text
packageFileSha512 :: !(Maybe Text) -- ^ "sha512"
  } deriving (Int -> PackageFile -> ShowS
[PackageFile] -> ShowS
PackageFile -> [Char]
(Int -> PackageFile -> ShowS)
-> (PackageFile -> [Char])
-> ([PackageFile] -> ShowS)
-> Show PackageFile
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PackageFile -> ShowS
showsPrec :: Int -> PackageFile -> ShowS
$cshow :: PackageFile -> [Char]
show :: PackageFile -> [Char]
$cshowList :: [PackageFile] -> ShowS
showList :: [PackageFile] -> ShowS
P.Show, PackageFile -> PackageFile -> Bool
(PackageFile -> PackageFile -> Bool)
-> (PackageFile -> PackageFile -> Bool) -> Eq PackageFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PackageFile -> PackageFile -> Bool
== :: PackageFile -> PackageFile -> Bool
$c/= :: PackageFile -> PackageFile -> Bool
/= :: PackageFile -> PackageFile -> Bool
P.Eq, P.Typeable)

-- | FromJSON PackageFile
instance A.FromJSON PackageFile where
  parseJSON :: Value -> Parser PackageFile
parseJSON = [Char]
-> (Object -> Parser PackageFile) -> Value -> Parser PackageFile
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"PackageFile" ((Object -> Parser PackageFile) -> Value -> Parser PackageFile)
-> (Object -> Parser PackageFile) -> Value -> Parser PackageFile
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Integer
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> PackageFile
PackageFile
      (Maybe Integer
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> PackageFile)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PackageFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"Size")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PackageFile)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> PackageFile)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> PackageFile)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe Text -> Maybe Text -> PackageFile)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"md5")
      Parser
  (Maybe Text
   -> Maybe Text -> Maybe Text -> Maybe Text -> PackageFile)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> Maybe Text -> PackageFile)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser (Maybe Text -> Maybe Text -> Maybe Text -> PackageFile)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> PackageFile)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sha1")
      Parser (Maybe Text -> Maybe Text -> PackageFile)
-> Parser (Maybe Text) -> Parser (Maybe Text -> PackageFile)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sha256")
      Parser (Maybe Text -> PackageFile)
-> Parser (Maybe Text) -> Parser PackageFile
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sha512")

-- | ToJSON PackageFile
instance A.ToJSON PackageFile where
  toJSON :: PackageFile -> Value
toJSON PackageFile {Maybe Integer
Maybe Text
$sel:packageFileSize:PackageFile :: PackageFile -> Maybe Integer
$sel:packageFileId:PackageFile :: PackageFile -> Maybe Integer
$sel:packageFileMd5:PackageFile :: PackageFile -> Maybe Text
$sel:packageFileName:PackageFile :: PackageFile -> Maybe Text
$sel:packageFileSha1:PackageFile :: PackageFile -> Maybe Text
$sel:packageFileSha256:PackageFile :: PackageFile -> Maybe Text
$sel:packageFileSha512:PackageFile :: PackageFile -> Maybe Text
packageFileSize :: Maybe Integer
packageFileId :: Maybe Integer
packageFileMd5 :: Maybe Text
packageFileName :: Maybe Text
packageFileSha1 :: Maybe Text
packageFileSha256 :: Maybe Text
packageFileSha512 :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"Size" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
packageFileSize
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
packageFileId
      , Key
"md5" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
packageFileMd5
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
packageFileName
      , Key
"sha1" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
packageFileSha1
      , Key
"sha256" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
packageFileSha256
      , Key
"sha512" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
packageFileSha512
      ]


-- | Construct a value of type 'PackageFile' (by applying it's required fields, if any)
mkPackageFile
  :: PackageFile
mkPackageFile :: PackageFile
mkPackageFile =
  PackageFile
  { $sel:packageFileSize:PackageFile :: Maybe Integer
packageFileSize = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:packageFileId:PackageFile :: Maybe Integer
packageFileId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:packageFileMd5:PackageFile :: Maybe Text
packageFileMd5 = Maybe Text
forall a. Maybe a
Nothing
  , $sel:packageFileName:PackageFile :: Maybe Text
packageFileName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:packageFileSha1:PackageFile :: Maybe Text
packageFileSha1 = Maybe Text
forall a. Maybe a
Nothing
  , $sel:packageFileSha256:PackageFile :: Maybe Text
packageFileSha256 = Maybe Text
forall a. Maybe a
Nothing
  , $sel:packageFileSha512:PackageFile :: Maybe Text
packageFileSha512 = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** PayloadCommit
-- | PayloadCommit
-- PayloadCommit represents a commit
data PayloadCommit = PayloadCommit
  { PayloadCommit -> Maybe [Text]
payloadCommitAdded :: !(Maybe [Text]) -- ^ "added"
  , PayloadCommit -> Maybe PayloadUser
payloadCommitAuthor :: !(Maybe PayloadUser) -- ^ "author"
  , PayloadCommit -> Maybe PayloadUser
payloadCommitCommitter :: !(Maybe PayloadUser) -- ^ "committer"
  , PayloadCommit -> Maybe Text
payloadCommitId :: !(Maybe Text) -- ^ "id" - sha1 hash of the commit
  , PayloadCommit -> Maybe Text
payloadCommitMessage :: !(Maybe Text) -- ^ "message"
  , PayloadCommit -> Maybe [Text]
payloadCommitModified :: !(Maybe [Text]) -- ^ "modified"
  , PayloadCommit -> Maybe [Text]
payloadCommitRemoved :: !(Maybe [Text]) -- ^ "removed"
  , PayloadCommit -> Maybe DateTime
payloadCommitTimestamp :: !(Maybe DateTime) -- ^ "timestamp"
  , PayloadCommit -> Maybe Text
payloadCommitUrl :: !(Maybe Text) -- ^ "url"
  , PayloadCommit -> Maybe PayloadCommitVerification
payloadCommitVerification :: !(Maybe PayloadCommitVerification) -- ^ "verification"
  } deriving (Int -> PayloadCommit -> ShowS
[PayloadCommit] -> ShowS
PayloadCommit -> [Char]
(Int -> PayloadCommit -> ShowS)
-> (PayloadCommit -> [Char])
-> ([PayloadCommit] -> ShowS)
-> Show PayloadCommit
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PayloadCommit -> ShowS
showsPrec :: Int -> PayloadCommit -> ShowS
$cshow :: PayloadCommit -> [Char]
show :: PayloadCommit -> [Char]
$cshowList :: [PayloadCommit] -> ShowS
showList :: [PayloadCommit] -> ShowS
P.Show, PayloadCommit -> PayloadCommit -> Bool
(PayloadCommit -> PayloadCommit -> Bool)
-> (PayloadCommit -> PayloadCommit -> Bool) -> Eq PayloadCommit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PayloadCommit -> PayloadCommit -> Bool
== :: PayloadCommit -> PayloadCommit -> Bool
$c/= :: PayloadCommit -> PayloadCommit -> Bool
/= :: PayloadCommit -> PayloadCommit -> Bool
P.Eq, P.Typeable)

-- | FromJSON PayloadCommit
instance A.FromJSON PayloadCommit where
  parseJSON :: Value -> Parser PayloadCommit
parseJSON = [Char]
-> (Object -> Parser PayloadCommit)
-> Value
-> Parser PayloadCommit
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"PayloadCommit" ((Object -> Parser PayloadCommit) -> Value -> Parser PayloadCommit)
-> (Object -> Parser PayloadCommit)
-> Value
-> Parser PayloadCommit
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Text]
-> Maybe PayloadUser
-> Maybe PayloadUser
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe [Text]
-> Maybe DateTime
-> Maybe Text
-> Maybe PayloadCommitVerification
-> PayloadCommit
PayloadCommit
      (Maybe [Text]
 -> Maybe PayloadUser
 -> Maybe PayloadUser
 -> Maybe Text
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe [Text]
 -> Maybe DateTime
 -> Maybe Text
 -> Maybe PayloadCommitVerification
 -> PayloadCommit)
-> Parser (Maybe [Text])
-> Parser
     (Maybe PayloadUser
      -> Maybe PayloadUser
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe PayloadCommitVerification
      -> PayloadCommit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"added")
      Parser
  (Maybe PayloadUser
   -> Maybe PayloadUser
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe PayloadCommitVerification
   -> PayloadCommit)
-> Parser (Maybe PayloadUser)
-> Parser
     (Maybe PayloadUser
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe PayloadCommitVerification
      -> PayloadCommit)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe PayloadUser)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"author")
      Parser
  (Maybe PayloadUser
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe PayloadCommitVerification
   -> PayloadCommit)
-> Parser (Maybe PayloadUser)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe PayloadCommitVerification
      -> PayloadCommit)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe PayloadUser)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"committer")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe PayloadCommitVerification
   -> PayloadCommit)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe PayloadCommitVerification
      -> PayloadCommit)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Text
   -> Maybe [Text]
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe PayloadCommitVerification
   -> PayloadCommit)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text]
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe PayloadCommitVerification
      -> PayloadCommit)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"message")
      Parser
  (Maybe [Text]
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe PayloadCommitVerification
   -> PayloadCommit)
-> Parser (Maybe [Text])
-> Parser
     (Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe PayloadCommitVerification
      -> PayloadCommit)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"modified")
      Parser
  (Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe PayloadCommitVerification
   -> PayloadCommit)
-> Parser (Maybe [Text])
-> Parser
     (Maybe DateTime
      -> Maybe Text -> Maybe PayloadCommitVerification -> PayloadCommit)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"removed")
      Parser
  (Maybe DateTime
   -> Maybe Text -> Maybe PayloadCommitVerification -> PayloadCommit)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Text -> Maybe PayloadCommitVerification -> PayloadCommit)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"timestamp")
      Parser
  (Maybe Text -> Maybe PayloadCommitVerification -> PayloadCommit)
-> Parser (Maybe Text)
-> Parser (Maybe PayloadCommitVerification -> PayloadCommit)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")
      Parser (Maybe PayloadCommitVerification -> PayloadCommit)
-> Parser (Maybe PayloadCommitVerification) -> Parser PayloadCommit
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe PayloadCommitVerification)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"verification")

-- | ToJSON PayloadCommit
instance A.ToJSON PayloadCommit where
  toJSON :: PayloadCommit -> Value
toJSON PayloadCommit {Maybe [Text]
Maybe Text
Maybe DateTime
Maybe PayloadUser
Maybe PayloadCommitVerification
$sel:payloadCommitAdded:PayloadCommit :: PayloadCommit -> Maybe [Text]
$sel:payloadCommitAuthor:PayloadCommit :: PayloadCommit -> Maybe PayloadUser
$sel:payloadCommitCommitter:PayloadCommit :: PayloadCommit -> Maybe PayloadUser
$sel:payloadCommitId:PayloadCommit :: PayloadCommit -> Maybe Text
$sel:payloadCommitMessage:PayloadCommit :: PayloadCommit -> Maybe Text
$sel:payloadCommitModified:PayloadCommit :: PayloadCommit -> Maybe [Text]
$sel:payloadCommitRemoved:PayloadCommit :: PayloadCommit -> Maybe [Text]
$sel:payloadCommitTimestamp:PayloadCommit :: PayloadCommit -> Maybe DateTime
$sel:payloadCommitUrl:PayloadCommit :: PayloadCommit -> Maybe Text
$sel:payloadCommitVerification:PayloadCommit :: PayloadCommit -> Maybe PayloadCommitVerification
payloadCommitAdded :: Maybe [Text]
payloadCommitAuthor :: Maybe PayloadUser
payloadCommitCommitter :: Maybe PayloadUser
payloadCommitId :: Maybe Text
payloadCommitMessage :: Maybe Text
payloadCommitModified :: Maybe [Text]
payloadCommitRemoved :: Maybe [Text]
payloadCommitTimestamp :: Maybe DateTime
payloadCommitUrl :: Maybe Text
payloadCommitVerification :: Maybe PayloadCommitVerification
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"added" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
payloadCommitAdded
      , Key
"author" Key -> Maybe PayloadUser -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe PayloadUser
payloadCommitAuthor
      , Key
"committer" Key -> Maybe PayloadUser -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe PayloadUser
payloadCommitCommitter
      , Key
"id" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
payloadCommitId
      , Key
"message" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
payloadCommitMessage
      , Key
"modified" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
payloadCommitModified
      , Key
"removed" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
payloadCommitRemoved
      , Key
"timestamp" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
payloadCommitTimestamp
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
payloadCommitUrl
      , Key
"verification" Key -> Maybe PayloadCommitVerification -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe PayloadCommitVerification
payloadCommitVerification
      ]


-- | Construct a value of type 'PayloadCommit' (by applying it's required fields, if any)
mkPayloadCommit
  :: PayloadCommit
mkPayloadCommit :: PayloadCommit
mkPayloadCommit =
  PayloadCommit
  { $sel:payloadCommitAdded:PayloadCommit :: Maybe [Text]
payloadCommitAdded = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:payloadCommitAuthor:PayloadCommit :: Maybe PayloadUser
payloadCommitAuthor = Maybe PayloadUser
forall a. Maybe a
Nothing
  , $sel:payloadCommitCommitter:PayloadCommit :: Maybe PayloadUser
payloadCommitCommitter = Maybe PayloadUser
forall a. Maybe a
Nothing
  , $sel:payloadCommitId:PayloadCommit :: Maybe Text
payloadCommitId = Maybe Text
forall a. Maybe a
Nothing
  , $sel:payloadCommitMessage:PayloadCommit :: Maybe Text
payloadCommitMessage = Maybe Text
forall a. Maybe a
Nothing
  , $sel:payloadCommitModified:PayloadCommit :: Maybe [Text]
payloadCommitModified = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:payloadCommitRemoved:PayloadCommit :: Maybe [Text]
payloadCommitRemoved = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:payloadCommitTimestamp:PayloadCommit :: Maybe DateTime
payloadCommitTimestamp = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:payloadCommitUrl:PayloadCommit :: Maybe Text
payloadCommitUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:payloadCommitVerification:PayloadCommit :: Maybe PayloadCommitVerification
payloadCommitVerification = Maybe PayloadCommitVerification
forall a. Maybe a
Nothing
  }

-- ** PayloadCommitVerification
-- | PayloadCommitVerification
-- PayloadCommitVerification represents the GPG verification of a commit
data PayloadCommitVerification = PayloadCommitVerification
  { PayloadCommitVerification -> Maybe Text
payloadCommitVerificationPayload :: !(Maybe Text) -- ^ "payload"
  , PayloadCommitVerification -> Maybe Text
payloadCommitVerificationReason :: !(Maybe Text) -- ^ "reason"
  , PayloadCommitVerification -> Maybe Text
payloadCommitVerificationSignature :: !(Maybe Text) -- ^ "signature"
  , PayloadCommitVerification -> Maybe PayloadUser
payloadCommitVerificationSigner :: !(Maybe PayloadUser) -- ^ "signer"
  , PayloadCommitVerification -> Maybe Bool
payloadCommitVerificationVerified :: !(Maybe Bool) -- ^ "verified"
  } deriving (Int -> PayloadCommitVerification -> ShowS
[PayloadCommitVerification] -> ShowS
PayloadCommitVerification -> [Char]
(Int -> PayloadCommitVerification -> ShowS)
-> (PayloadCommitVerification -> [Char])
-> ([PayloadCommitVerification] -> ShowS)
-> Show PayloadCommitVerification
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PayloadCommitVerification -> ShowS
showsPrec :: Int -> PayloadCommitVerification -> ShowS
$cshow :: PayloadCommitVerification -> [Char]
show :: PayloadCommitVerification -> [Char]
$cshowList :: [PayloadCommitVerification] -> ShowS
showList :: [PayloadCommitVerification] -> ShowS
P.Show, PayloadCommitVerification -> PayloadCommitVerification -> Bool
(PayloadCommitVerification -> PayloadCommitVerification -> Bool)
-> (PayloadCommitVerification -> PayloadCommitVerification -> Bool)
-> Eq PayloadCommitVerification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PayloadCommitVerification -> PayloadCommitVerification -> Bool
== :: PayloadCommitVerification -> PayloadCommitVerification -> Bool
$c/= :: PayloadCommitVerification -> PayloadCommitVerification -> Bool
/= :: PayloadCommitVerification -> PayloadCommitVerification -> Bool
P.Eq, P.Typeable)

-- | FromJSON PayloadCommitVerification
instance A.FromJSON PayloadCommitVerification where
  parseJSON :: Value -> Parser PayloadCommitVerification
parseJSON = [Char]
-> (Object -> Parser PayloadCommitVerification)
-> Value
-> Parser PayloadCommitVerification
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"PayloadCommitVerification" ((Object -> Parser PayloadCommitVerification)
 -> Value -> Parser PayloadCommitVerification)
-> (Object -> Parser PayloadCommitVerification)
-> Value
-> Parser PayloadCommitVerification
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PayloadUser
-> Maybe Bool
-> PayloadCommitVerification
PayloadCommitVerification
      (Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe PayloadUser
 -> Maybe Bool
 -> PayloadCommitVerification)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe PayloadUser
      -> Maybe Bool
      -> PayloadCommitVerification)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"payload")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe PayloadUser
   -> Maybe Bool
   -> PayloadCommitVerification)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe PayloadUser -> Maybe Bool -> PayloadCommitVerification)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"reason")
      Parser
  (Maybe Text
   -> Maybe PayloadUser -> Maybe Bool -> PayloadCommitVerification)
-> Parser (Maybe Text)
-> Parser
     (Maybe PayloadUser -> Maybe Bool -> PayloadCommitVerification)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"signature")
      Parser
  (Maybe PayloadUser -> Maybe Bool -> PayloadCommitVerification)
-> Parser (Maybe PayloadUser)
-> Parser (Maybe Bool -> PayloadCommitVerification)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe PayloadUser)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"signer")
      Parser (Maybe Bool -> PayloadCommitVerification)
-> Parser (Maybe Bool) -> Parser PayloadCommitVerification
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"verified")

-- | ToJSON PayloadCommitVerification
instance A.ToJSON PayloadCommitVerification where
  toJSON :: PayloadCommitVerification -> Value
toJSON PayloadCommitVerification {Maybe Bool
Maybe Text
Maybe PayloadUser
$sel:payloadCommitVerificationPayload:PayloadCommitVerification :: PayloadCommitVerification -> Maybe Text
$sel:payloadCommitVerificationReason:PayloadCommitVerification :: PayloadCommitVerification -> Maybe Text
$sel:payloadCommitVerificationSignature:PayloadCommitVerification :: PayloadCommitVerification -> Maybe Text
$sel:payloadCommitVerificationSigner:PayloadCommitVerification :: PayloadCommitVerification -> Maybe PayloadUser
$sel:payloadCommitVerificationVerified:PayloadCommitVerification :: PayloadCommitVerification -> Maybe Bool
payloadCommitVerificationPayload :: Maybe Text
payloadCommitVerificationReason :: Maybe Text
payloadCommitVerificationSignature :: Maybe Text
payloadCommitVerificationSigner :: Maybe PayloadUser
payloadCommitVerificationVerified :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"payload" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
payloadCommitVerificationPayload
      , Key
"reason" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
payloadCommitVerificationReason
      , Key
"signature" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
payloadCommitVerificationSignature
      , Key
"signer" Key -> Maybe PayloadUser -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe PayloadUser
payloadCommitVerificationSigner
      , Key
"verified" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
payloadCommitVerificationVerified
      ]


-- | Construct a value of type 'PayloadCommitVerification' (by applying it's required fields, if any)
mkPayloadCommitVerification
  :: PayloadCommitVerification
mkPayloadCommitVerification :: PayloadCommitVerification
mkPayloadCommitVerification =
  PayloadCommitVerification
  { $sel:payloadCommitVerificationPayload:PayloadCommitVerification :: Maybe Text
payloadCommitVerificationPayload = Maybe Text
forall a. Maybe a
Nothing
  , $sel:payloadCommitVerificationReason:PayloadCommitVerification :: Maybe Text
payloadCommitVerificationReason = Maybe Text
forall a. Maybe a
Nothing
  , $sel:payloadCommitVerificationSignature:PayloadCommitVerification :: Maybe Text
payloadCommitVerificationSignature = Maybe Text
forall a. Maybe a
Nothing
  , $sel:payloadCommitVerificationSigner:PayloadCommitVerification :: Maybe PayloadUser
payloadCommitVerificationSigner = Maybe PayloadUser
forall a. Maybe a
Nothing
  , $sel:payloadCommitVerificationVerified:PayloadCommitVerification :: Maybe Bool
payloadCommitVerificationVerified = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** PayloadUser
-- | PayloadUser
-- PayloadUser represents the author or committer of a commit
data PayloadUser = PayloadUser
  { PayloadUser -> Maybe Text
payloadUserEmail :: !(Maybe Text) -- ^ "email"
  , PayloadUser -> Maybe Text
payloadUserName :: !(Maybe Text) -- ^ "name" - Full name of the commit author
  , PayloadUser -> Maybe Text
payloadUserUsername :: !(Maybe Text) -- ^ "username"
  } deriving (Int -> PayloadUser -> ShowS
[PayloadUser] -> ShowS
PayloadUser -> [Char]
(Int -> PayloadUser -> ShowS)
-> (PayloadUser -> [Char])
-> ([PayloadUser] -> ShowS)
-> Show PayloadUser
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PayloadUser -> ShowS
showsPrec :: Int -> PayloadUser -> ShowS
$cshow :: PayloadUser -> [Char]
show :: PayloadUser -> [Char]
$cshowList :: [PayloadUser] -> ShowS
showList :: [PayloadUser] -> ShowS
P.Show, PayloadUser -> PayloadUser -> Bool
(PayloadUser -> PayloadUser -> Bool)
-> (PayloadUser -> PayloadUser -> Bool) -> Eq PayloadUser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PayloadUser -> PayloadUser -> Bool
== :: PayloadUser -> PayloadUser -> Bool
$c/= :: PayloadUser -> PayloadUser -> Bool
/= :: PayloadUser -> PayloadUser -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON PayloadUser
instance A.ToJSON PayloadUser where
  toJSON :: PayloadUser -> Value
toJSON PayloadUser {Maybe Text
$sel:payloadUserEmail:PayloadUser :: PayloadUser -> Maybe Text
$sel:payloadUserName:PayloadUser :: PayloadUser -> Maybe Text
$sel:payloadUserUsername:PayloadUser :: PayloadUser -> Maybe Text
payloadUserEmail :: Maybe Text
payloadUserName :: Maybe Text
payloadUserUsername :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"email" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
payloadUserEmail
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
payloadUserName
      , Key
"username" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
payloadUserUsername
      ]


-- | Construct a value of type 'PayloadUser' (by applying it's required fields, if any)
mkPayloadUser
  :: PayloadUser
mkPayloadUser :: PayloadUser
mkPayloadUser =
  PayloadUser
  { $sel:payloadUserEmail:PayloadUser :: Maybe Text
payloadUserEmail = Maybe Text
forall a. Maybe a
Nothing
  , $sel:payloadUserName:PayloadUser :: Maybe Text
payloadUserName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:payloadUserUsername:PayloadUser :: Maybe Text
payloadUserUsername = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** Permission
-- | Permission
-- Permission represents a set of permissions
data Permission = Permission
  { Permission -> Maybe Bool
permissionAdmin :: !(Maybe Bool) -- ^ "admin"
  , Permission -> Maybe Bool
permissionPull :: !(Maybe Bool) -- ^ "pull"
  , Permission -> Maybe Bool
permissionPush :: !(Maybe Bool) -- ^ "push"
  } deriving (Int -> Permission -> ShowS
[Permission] -> ShowS
Permission -> [Char]
(Int -> Permission -> ShowS)
-> (Permission -> [Char])
-> ([Permission] -> ShowS)
-> Show Permission
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Permission -> ShowS
showsPrec :: Int -> Permission -> ShowS
$cshow :: Permission -> [Char]
show :: Permission -> [Char]
$cshowList :: [Permission] -> ShowS
showList :: [Permission] -> ShowS
P.Show, Permission -> Permission -> Bool
(Permission -> Permission -> Bool)
-> (Permission -> Permission -> Bool) -> Eq Permission
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Permission -> Permission -> Bool
== :: Permission -> Permission -> Bool
$c/= :: Permission -> Permission -> Bool
/= :: Permission -> Permission -> Bool
P.Eq, P.Typeable)

-- | FromJSON Permission
instance A.FromJSON Permission where
  parseJSON :: Value -> Parser Permission
parseJSON = [Char]
-> (Object -> Parser Permission) -> Value -> Parser Permission
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Permission" ((Object -> Parser Permission) -> Value -> Parser Permission)
-> (Object -> Parser Permission) -> Value -> Parser Permission
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool -> Maybe Bool -> Maybe Bool -> Permission
Permission
      (Maybe Bool -> Maybe Bool -> Maybe Bool -> Permission)
-> Parser (Maybe Bool)
-> Parser (Maybe Bool -> Maybe Bool -> Permission)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"admin")
      Parser (Maybe Bool -> Maybe Bool -> Permission)
-> Parser (Maybe Bool) -> Parser (Maybe Bool -> Permission)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pull")
      Parser (Maybe Bool -> Permission)
-> Parser (Maybe Bool) -> Parser Permission
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"push")

-- | ToJSON Permission
instance A.ToJSON Permission where
  toJSON :: Permission -> Value
toJSON Permission {Maybe Bool
$sel:permissionAdmin:Permission :: Permission -> Maybe Bool
$sel:permissionPull:Permission :: Permission -> Maybe Bool
$sel:permissionPush:Permission :: Permission -> Maybe Bool
permissionAdmin :: Maybe Bool
permissionPull :: Maybe Bool
permissionPush :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"admin" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
permissionAdmin
      , Key
"pull" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
permissionPull
      , Key
"push" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
permissionPush
      ]


-- | Construct a value of type 'Permission' (by applying it's required fields, if any)
mkPermission
  :: Permission
mkPermission :: Permission
mkPermission =
  Permission
  { $sel:permissionAdmin:Permission :: Maybe Bool
permissionAdmin = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:permissionPull:Permission :: Maybe Bool
permissionPull = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:permissionPush:Permission :: Maybe Bool
permissionPush = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** PublicKey
-- | PublicKey
-- PublicKey publickey is a user key to push code to repository
data PublicKey = PublicKey
  { PublicKey -> Maybe DateTime
publicKeyCreatedAt :: !(Maybe DateTime) -- ^ "created_at"
  , PublicKey -> Maybe Text
publicKeyFingerprint :: !(Maybe Text) -- ^ "fingerprint"
  , PublicKey -> Maybe Integer
publicKeyId :: !(Maybe Integer) -- ^ "id"
  , PublicKey -> Maybe Text
publicKeyKey :: !(Maybe Text) -- ^ "key"
  , PublicKey -> Maybe Text
publicKeyKeyType :: !(Maybe Text) -- ^ "key_type"
  , PublicKey -> Maybe Bool
publicKeyReadOnly :: !(Maybe Bool) -- ^ "read_only"
  , PublicKey -> Maybe Text
publicKeyTitle :: !(Maybe Text) -- ^ "title"
  , PublicKey -> Maybe Text
publicKeyUrl :: !(Maybe Text) -- ^ "url"
  , PublicKey -> Maybe User
publicKeyUser :: !(Maybe User) -- ^ "user"
  } deriving (Int -> PublicKey -> ShowS
[PublicKey] -> ShowS
PublicKey -> [Char]
(Int -> PublicKey -> ShowS)
-> (PublicKey -> [Char])
-> ([PublicKey] -> ShowS)
-> Show PublicKey
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PublicKey -> ShowS
showsPrec :: Int -> PublicKey -> ShowS
$cshow :: PublicKey -> [Char]
show :: PublicKey -> [Char]
$cshowList :: [PublicKey] -> ShowS
showList :: [PublicKey] -> ShowS
P.Show, PublicKey -> PublicKey -> Bool
(PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool) -> Eq PublicKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PublicKey -> PublicKey -> Bool
== :: PublicKey -> PublicKey -> Bool
$c/= :: PublicKey -> PublicKey -> Bool
/= :: PublicKey -> PublicKey -> Bool
P.Eq, P.Typeable)

-- | FromJSON PublicKey
instance A.FromJSON PublicKey where
  parseJSON :: Value -> Parser PublicKey
parseJSON = [Char] -> (Object -> Parser PublicKey) -> Value -> Parser PublicKey
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"PublicKey" ((Object -> Parser PublicKey) -> Value -> Parser PublicKey)
-> (Object -> Parser PublicKey) -> Value -> Parser PublicKey
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe DateTime
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe User
-> PublicKey
PublicKey
      (Maybe DateTime
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Text
 -> Maybe User
 -> PublicKey)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe User
      -> PublicKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_at")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe User
   -> PublicKey)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe User
      -> PublicKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"fingerprint")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe User
   -> PublicKey)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe User
      -> PublicKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe User
   -> PublicKey)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe User
      -> PublicKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"key")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe User
   -> PublicKey)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool -> Maybe Text -> Maybe Text -> Maybe User -> PublicKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"key_type")
      Parser
  (Maybe Bool -> Maybe Text -> Maybe Text -> Maybe User -> PublicKey)
-> Parser (Maybe Bool)
-> Parser (Maybe Text -> Maybe Text -> Maybe User -> PublicKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"read_only")
      Parser (Maybe Text -> Maybe Text -> Maybe User -> PublicKey)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe User -> PublicKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title")
      Parser (Maybe Text -> Maybe User -> PublicKey)
-> Parser (Maybe Text) -> Parser (Maybe User -> PublicKey)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")
      Parser (Maybe User -> PublicKey)
-> Parser (Maybe User) -> Parser PublicKey
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user")

-- | ToJSON PublicKey
instance A.ToJSON PublicKey where
  toJSON :: PublicKey -> Value
toJSON PublicKey {Maybe Bool
Maybe Integer
Maybe Text
Maybe DateTime
Maybe User
$sel:publicKeyCreatedAt:PublicKey :: PublicKey -> Maybe DateTime
$sel:publicKeyFingerprint:PublicKey :: PublicKey -> Maybe Text
$sel:publicKeyId:PublicKey :: PublicKey -> Maybe Integer
$sel:publicKeyKey:PublicKey :: PublicKey -> Maybe Text
$sel:publicKeyKeyType:PublicKey :: PublicKey -> Maybe Text
$sel:publicKeyReadOnly:PublicKey :: PublicKey -> Maybe Bool
$sel:publicKeyTitle:PublicKey :: PublicKey -> Maybe Text
$sel:publicKeyUrl:PublicKey :: PublicKey -> Maybe Text
$sel:publicKeyUser:PublicKey :: PublicKey -> Maybe User
publicKeyCreatedAt :: Maybe DateTime
publicKeyFingerprint :: Maybe Text
publicKeyId :: Maybe Integer
publicKeyKey :: Maybe Text
publicKeyKeyType :: Maybe Text
publicKeyReadOnly :: Maybe Bool
publicKeyTitle :: Maybe Text
publicKeyUrl :: Maybe Text
publicKeyUser :: Maybe User
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
publicKeyCreatedAt
      , Key
"fingerprint" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
publicKeyFingerprint
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
publicKeyId
      , Key
"key" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
publicKeyKey
      , Key
"key_type" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
publicKeyKeyType
      , Key
"read_only" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
publicKeyReadOnly
      , Key
"title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
publicKeyTitle
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
publicKeyUrl
      , Key
"user" Key -> Maybe User -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe User
publicKeyUser
      ]


-- | Construct a value of type 'PublicKey' (by applying it's required fields, if any)
mkPublicKey
  :: PublicKey
mkPublicKey :: PublicKey
mkPublicKey =
  PublicKey
  { $sel:publicKeyCreatedAt:PublicKey :: Maybe DateTime
publicKeyCreatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:publicKeyFingerprint:PublicKey :: Maybe Text
publicKeyFingerprint = Maybe Text
forall a. Maybe a
Nothing
  , $sel:publicKeyId:PublicKey :: Maybe Integer
publicKeyId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:publicKeyKey:PublicKey :: Maybe Text
publicKeyKey = Maybe Text
forall a. Maybe a
Nothing
  , $sel:publicKeyKeyType:PublicKey :: Maybe Text
publicKeyKeyType = Maybe Text
forall a. Maybe a
Nothing
  , $sel:publicKeyReadOnly:PublicKey :: Maybe Bool
publicKeyReadOnly = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:publicKeyTitle:PublicKey :: Maybe Text
publicKeyTitle = Maybe Text
forall a. Maybe a
Nothing
  , $sel:publicKeyUrl:PublicKey :: Maybe Text
publicKeyUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:publicKeyUser:PublicKey :: Maybe User
publicKeyUser = Maybe User
forall a. Maybe a
Nothing
  }

-- ** PullRequest
-- | PullRequest
-- PullRequest represents a pull request
data PullRequest = PullRequest
  { PullRequest -> Maybe Integer
pullRequestAdditions :: !(Maybe Integer) -- ^ "additions"
  , PullRequest -> Maybe Bool
pullRequestAllowMaintainerEdit :: !(Maybe Bool) -- ^ "allow_maintainer_edit"
  , PullRequest -> Maybe User
pullRequestAssignee :: !(Maybe User) -- ^ "assignee"
  , PullRequest -> Maybe [User]
pullRequestAssignees :: !(Maybe [User]) -- ^ "assignees"
  , PullRequest -> Maybe PRBranchInfo
pullRequestBase :: !(Maybe PRBranchInfo) -- ^ "base"
  , PullRequest -> Maybe Text
pullRequestBody :: !(Maybe Text) -- ^ "body"
  , PullRequest -> Maybe Integer
pullRequestChangedFiles :: !(Maybe Integer) -- ^ "changed_files"
  , PullRequest -> Maybe DateTime
pullRequestClosedAt :: !(Maybe DateTime) -- ^ "closed_at"
  , PullRequest -> Maybe Integer
pullRequestComments :: !(Maybe Integer) -- ^ "comments"
  , PullRequest -> Maybe DateTime
pullRequestCreatedAt :: !(Maybe DateTime) -- ^ "created_at"
  , PullRequest -> Maybe Integer
pullRequestDeletions :: !(Maybe Integer) -- ^ "deletions"
  , PullRequest -> Maybe Text
pullRequestDiffUrl :: !(Maybe Text) -- ^ "diff_url"
  , PullRequest -> Maybe Bool
pullRequestDraft :: !(Maybe Bool) -- ^ "draft"
  , PullRequest -> Maybe DateTime
pullRequestDueDate :: !(Maybe DateTime) -- ^ "due_date"
  , PullRequest -> Maybe PRBranchInfo
pullRequestHead :: !(Maybe PRBranchInfo) -- ^ "head"
  , PullRequest -> Maybe Text
pullRequestHtmlUrl :: !(Maybe Text) -- ^ "html_url"
  , PullRequest -> Maybe Integer
pullRequestId :: !(Maybe Integer) -- ^ "id"
  , PullRequest -> Maybe Bool
pullRequestIsLocked :: !(Maybe Bool) -- ^ "is_locked"
  , PullRequest -> Maybe [Label]
pullRequestLabels :: !(Maybe [Label]) -- ^ "labels"
  , PullRequest -> Maybe Text
pullRequestMergeBase :: !(Maybe Text) -- ^ "merge_base"
  , PullRequest -> Maybe Text
pullRequestMergeCommitSha :: !(Maybe Text) -- ^ "merge_commit_sha"
  , PullRequest -> Maybe Bool
pullRequestMergeable :: !(Maybe Bool) -- ^ "mergeable"
  , PullRequest -> Maybe Bool
pullRequestMerged :: !(Maybe Bool) -- ^ "merged"
  , PullRequest -> Maybe DateTime
pullRequestMergedAt :: !(Maybe DateTime) -- ^ "merged_at"
  , PullRequest -> Maybe User
pullRequestMergedBy :: !(Maybe User) -- ^ "merged_by"
  , PullRequest -> Maybe Milestone
pullRequestMilestone :: !(Maybe Milestone) -- ^ "milestone"
  , PullRequest -> Maybe Integer
pullRequestNumber :: !(Maybe Integer) -- ^ "number"
  , PullRequest -> Maybe Text
pullRequestPatchUrl :: !(Maybe Text) -- ^ "patch_url"
  , PullRequest -> Maybe Integer
pullRequestPinOrder :: !(Maybe Integer) -- ^ "pin_order"
  , PullRequest -> Maybe [User]
pullRequestRequestedReviewers :: !(Maybe [User]) -- ^ "requested_reviewers"
  , PullRequest -> Maybe [Team]
pullRequestRequestedReviewersTeams :: !(Maybe [Team]) -- ^ "requested_reviewers_teams"
  , PullRequest -> Maybe Integer
pullRequestReviewComments :: !(Maybe Integer) -- ^ "review_comments" - number of review comments made on the diff of a PR review (not including comments on commits or issues in a PR)
  , PullRequest -> Maybe Text
pullRequestState :: !(Maybe Text) -- ^ "state" - StateType issue state type
  , PullRequest -> Maybe Text
pullRequestTitle :: !(Maybe Text) -- ^ "title"
  , PullRequest -> Maybe DateTime
pullRequestUpdatedAt :: !(Maybe DateTime) -- ^ "updated_at"
  , PullRequest -> Maybe Text
pullRequestUrl :: !(Maybe Text) -- ^ "url"
  , PullRequest -> Maybe User
pullRequestUser :: !(Maybe User) -- ^ "user"
  } deriving (Int -> PullRequest -> ShowS
[PullRequest] -> ShowS
PullRequest -> [Char]
(Int -> PullRequest -> ShowS)
-> (PullRequest -> [Char])
-> ([PullRequest] -> ShowS)
-> Show PullRequest
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PullRequest -> ShowS
showsPrec :: Int -> PullRequest -> ShowS
$cshow :: PullRequest -> [Char]
show :: PullRequest -> [Char]
$cshowList :: [PullRequest] -> ShowS
showList :: [PullRequest] -> ShowS
P.Show, PullRequest -> PullRequest -> Bool
(PullRequest -> PullRequest -> Bool)
-> (PullRequest -> PullRequest -> Bool) -> Eq PullRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PullRequest -> PullRequest -> Bool
== :: PullRequest -> PullRequest -> Bool
$c/= :: PullRequest -> PullRequest -> Bool
/= :: PullRequest -> PullRequest -> Bool
P.Eq, P.Typeable)

-- | FromJSON PullRequest
instance A.FromJSON PullRequest where
  parseJSON :: Value -> Parser PullRequest
parseJSON = [Char]
-> (Object -> Parser PullRequest) -> Value -> Parser PullRequest
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"PullRequest" ((Object -> Parser PullRequest) -> Value -> Parser PullRequest)
-> (Object -> Parser PullRequest) -> Value -> Parser PullRequest
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Integer
-> Maybe Bool
-> Maybe User
-> Maybe [User]
-> Maybe PRBranchInfo
-> Maybe Text
-> Maybe Integer
-> Maybe DateTime
-> Maybe Integer
-> Maybe DateTime
-> Maybe Integer
-> Maybe Text
-> Maybe Bool
-> Maybe DateTime
-> Maybe PRBranchInfo
-> Maybe Text
-> Maybe Integer
-> Maybe Bool
-> Maybe [Label]
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe DateTime
-> Maybe User
-> Maybe Milestone
-> Maybe Integer
-> Maybe Text
-> Maybe Integer
-> Maybe [User]
-> Maybe [Team]
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe DateTime
-> Maybe Text
-> Maybe User
-> PullRequest
PullRequest
      (Maybe Integer
 -> Maybe Bool
 -> Maybe User
 -> Maybe [User]
 -> Maybe PRBranchInfo
 -> Maybe Text
 -> Maybe Integer
 -> Maybe DateTime
 -> Maybe Integer
 -> Maybe DateTime
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Bool
 -> Maybe DateTime
 -> Maybe PRBranchInfo
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Bool
 -> Maybe [Label]
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe DateTime
 -> Maybe User
 -> Maybe Milestone
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Integer
 -> Maybe [User]
 -> Maybe [Team]
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Text
 -> Maybe DateTime
 -> Maybe Text
 -> Maybe User
 -> PullRequest)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Bool
      -> Maybe User
      -> Maybe [User]
      -> Maybe PRBranchInfo
      -> Maybe Text
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe PRBranchInfo
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Label]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe User
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"additions")
      Parser
  (Maybe Bool
   -> Maybe User
   -> Maybe [User]
   -> Maybe PRBranchInfo
   -> Maybe Text
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe PRBranchInfo
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Label]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe User
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe Bool)
-> Parser
     (Maybe User
      -> Maybe [User]
      -> Maybe PRBranchInfo
      -> Maybe Text
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe PRBranchInfo
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Label]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe User
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allow_maintainer_edit")
      Parser
  (Maybe User
   -> Maybe [User]
   -> Maybe PRBranchInfo
   -> Maybe Text
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe PRBranchInfo
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Label]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe User
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe User)
-> Parser
     (Maybe [User]
      -> Maybe PRBranchInfo
      -> Maybe Text
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe PRBranchInfo
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Label]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe User
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"assignee")
      Parser
  (Maybe [User]
   -> Maybe PRBranchInfo
   -> Maybe Text
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe PRBranchInfo
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Label]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe User
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe [User])
-> Parser
     (Maybe PRBranchInfo
      -> Maybe Text
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe PRBranchInfo
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Label]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe User
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [User])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"assignees")
      Parser
  (Maybe PRBranchInfo
   -> Maybe Text
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe PRBranchInfo
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Label]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe User
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe PRBranchInfo)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe PRBranchInfo
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Label]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe User
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe PRBranchInfo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"base")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe PRBranchInfo
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Label]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe User
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe PRBranchInfo
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Label]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe User
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"body")
      Parser
  (Maybe Integer
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe PRBranchInfo
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Label]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe User
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe Integer)
-> Parser
     (Maybe DateTime
      -> Maybe Integer
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe PRBranchInfo
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Label]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe User
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"changed_files")
      Parser
  (Maybe DateTime
   -> Maybe Integer
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe PRBranchInfo
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Label]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe User
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Integer
      -> Maybe DateTime
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe PRBranchInfo
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Label]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe User
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"closed_at")
      Parser
  (Maybe Integer
   -> Maybe DateTime
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe PRBranchInfo
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Label]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe User
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe Integer)
-> Parser
     (Maybe DateTime
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe PRBranchInfo
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Label]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe User
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"comments")
      Parser
  (Maybe DateTime
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe PRBranchInfo
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Label]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe User
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe PRBranchInfo
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Label]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe User
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_at")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe PRBranchInfo
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Label]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe User
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe PRBranchInfo
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Label]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe User
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"deletions")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe PRBranchInfo
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Label]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe User
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe DateTime
      -> Maybe PRBranchInfo
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Label]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe User
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"diff_url")
      Parser
  (Maybe Bool
   -> Maybe DateTime
   -> Maybe PRBranchInfo
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Label]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe User
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe Bool)
-> Parser
     (Maybe DateTime
      -> Maybe PRBranchInfo
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Label]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe User
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"draft")
      Parser
  (Maybe DateTime
   -> Maybe PRBranchInfo
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Label]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe User
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe PRBranchInfo
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Label]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe User
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"due_date")
      Parser
  (Maybe PRBranchInfo
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Label]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe User
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe PRBranchInfo)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Label]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe User
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe PRBranchInfo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"head")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Label]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe User
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Bool
      -> Maybe [Label]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe User
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"html_url")
      Parser
  (Maybe Integer
   -> Maybe Bool
   -> Maybe [Label]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe User
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Bool
      -> Maybe [Label]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe User
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Bool
   -> Maybe [Label]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe User
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe Bool)
-> Parser
     (Maybe [Label]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe User
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_locked")
      Parser
  (Maybe [Label]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe User
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe [Label])
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe User
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Label])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"labels")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe User
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe User
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"merge_base")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe User
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe User
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"merge_commit_sha")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe User
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe DateTime
      -> Maybe User
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mergeable")
      Parser
  (Maybe Bool
   -> Maybe DateTime
   -> Maybe User
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe Bool)
-> Parser
     (Maybe DateTime
      -> Maybe User
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"merged")
      Parser
  (Maybe DateTime
   -> Maybe User
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe User
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"merged_at")
      Parser
  (Maybe User
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe User)
-> Parser
     (Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"merged_by")
      Parser
  (Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe Milestone)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Milestone)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"milestone")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"number")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"patch_url")
      Parser
  (Maybe Integer
   -> Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe Integer)
-> Parser
     (Maybe [User]
      -> Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pin_order")
      Parser
  (Maybe [User]
   -> Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe [User])
-> Parser
     (Maybe [Team]
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [User])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"requested_reviewers")
      Parser
  (Maybe [Team]
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe [Team])
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Team])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"requested_reviewers_teams")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe User
      -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"review_comments")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe User
   -> PullRequest)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe DateTime -> Maybe Text -> Maybe User -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"state")
      Parser
  (Maybe Text
   -> Maybe DateTime -> Maybe Text -> Maybe User -> PullRequest)
-> Parser (Maybe Text)
-> Parser
     (Maybe DateTime -> Maybe Text -> Maybe User -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title")
      Parser (Maybe DateTime -> Maybe Text -> Maybe User -> PullRequest)
-> Parser (Maybe DateTime)
-> Parser (Maybe Text -> Maybe User -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated_at")
      Parser (Maybe Text -> Maybe User -> PullRequest)
-> Parser (Maybe Text) -> Parser (Maybe User -> PullRequest)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")
      Parser (Maybe User -> PullRequest)
-> Parser (Maybe User) -> Parser PullRequest
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user")

-- | ToJSON PullRequest
instance A.ToJSON PullRequest where
  toJSON :: PullRequest -> Value
toJSON PullRequest {Maybe Bool
Maybe Integer
Maybe [User]
Maybe [Team]
Maybe [Label]
Maybe Text
Maybe DateTime
Maybe User
Maybe PRBranchInfo
Maybe Milestone
$sel:pullRequestAdditions:PullRequest :: PullRequest -> Maybe Integer
$sel:pullRequestAllowMaintainerEdit:PullRequest :: PullRequest -> Maybe Bool
$sel:pullRequestAssignee:PullRequest :: PullRequest -> Maybe User
$sel:pullRequestAssignees:PullRequest :: PullRequest -> Maybe [User]
$sel:pullRequestBase:PullRequest :: PullRequest -> Maybe PRBranchInfo
$sel:pullRequestBody:PullRequest :: PullRequest -> Maybe Text
$sel:pullRequestChangedFiles:PullRequest :: PullRequest -> Maybe Integer
$sel:pullRequestClosedAt:PullRequest :: PullRequest -> Maybe DateTime
$sel:pullRequestComments:PullRequest :: PullRequest -> Maybe Integer
$sel:pullRequestCreatedAt:PullRequest :: PullRequest -> Maybe DateTime
$sel:pullRequestDeletions:PullRequest :: PullRequest -> Maybe Integer
$sel:pullRequestDiffUrl:PullRequest :: PullRequest -> Maybe Text
$sel:pullRequestDraft:PullRequest :: PullRequest -> Maybe Bool
$sel:pullRequestDueDate:PullRequest :: PullRequest -> Maybe DateTime
$sel:pullRequestHead:PullRequest :: PullRequest -> Maybe PRBranchInfo
$sel:pullRequestHtmlUrl:PullRequest :: PullRequest -> Maybe Text
$sel:pullRequestId:PullRequest :: PullRequest -> Maybe Integer
$sel:pullRequestIsLocked:PullRequest :: PullRequest -> Maybe Bool
$sel:pullRequestLabels:PullRequest :: PullRequest -> Maybe [Label]
$sel:pullRequestMergeBase:PullRequest :: PullRequest -> Maybe Text
$sel:pullRequestMergeCommitSha:PullRequest :: PullRequest -> Maybe Text
$sel:pullRequestMergeable:PullRequest :: PullRequest -> Maybe Bool
$sel:pullRequestMerged:PullRequest :: PullRequest -> Maybe Bool
$sel:pullRequestMergedAt:PullRequest :: PullRequest -> Maybe DateTime
$sel:pullRequestMergedBy:PullRequest :: PullRequest -> Maybe User
$sel:pullRequestMilestone:PullRequest :: PullRequest -> Maybe Milestone
$sel:pullRequestNumber:PullRequest :: PullRequest -> Maybe Integer
$sel:pullRequestPatchUrl:PullRequest :: PullRequest -> Maybe Text
$sel:pullRequestPinOrder:PullRequest :: PullRequest -> Maybe Integer
$sel:pullRequestRequestedReviewers:PullRequest :: PullRequest -> Maybe [User]
$sel:pullRequestRequestedReviewersTeams:PullRequest :: PullRequest -> Maybe [Team]
$sel:pullRequestReviewComments:PullRequest :: PullRequest -> Maybe Integer
$sel:pullRequestState:PullRequest :: PullRequest -> Maybe Text
$sel:pullRequestTitle:PullRequest :: PullRequest -> Maybe Text
$sel:pullRequestUpdatedAt:PullRequest :: PullRequest -> Maybe DateTime
$sel:pullRequestUrl:PullRequest :: PullRequest -> Maybe Text
$sel:pullRequestUser:PullRequest :: PullRequest -> Maybe User
pullRequestAdditions :: Maybe Integer
pullRequestAllowMaintainerEdit :: Maybe Bool
pullRequestAssignee :: Maybe User
pullRequestAssignees :: Maybe [User]
pullRequestBase :: Maybe PRBranchInfo
pullRequestBody :: Maybe Text
pullRequestChangedFiles :: Maybe Integer
pullRequestClosedAt :: Maybe DateTime
pullRequestComments :: Maybe Integer
pullRequestCreatedAt :: Maybe DateTime
pullRequestDeletions :: Maybe Integer
pullRequestDiffUrl :: Maybe Text
pullRequestDraft :: Maybe Bool
pullRequestDueDate :: Maybe DateTime
pullRequestHead :: Maybe PRBranchInfo
pullRequestHtmlUrl :: Maybe Text
pullRequestId :: Maybe Integer
pullRequestIsLocked :: Maybe Bool
pullRequestLabels :: Maybe [Label]
pullRequestMergeBase :: Maybe Text
pullRequestMergeCommitSha :: Maybe Text
pullRequestMergeable :: Maybe Bool
pullRequestMerged :: Maybe Bool
pullRequestMergedAt :: Maybe DateTime
pullRequestMergedBy :: Maybe User
pullRequestMilestone :: Maybe Milestone
pullRequestNumber :: Maybe Integer
pullRequestPatchUrl :: Maybe Text
pullRequestPinOrder :: Maybe Integer
pullRequestRequestedReviewers :: Maybe [User]
pullRequestRequestedReviewersTeams :: Maybe [Team]
pullRequestReviewComments :: Maybe Integer
pullRequestState :: Maybe Text
pullRequestTitle :: Maybe Text
pullRequestUpdatedAt :: Maybe DateTime
pullRequestUrl :: Maybe Text
pullRequestUser :: Maybe User
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"additions" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
pullRequestAdditions
      , Key
"allow_maintainer_edit" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
pullRequestAllowMaintainerEdit
      , Key
"assignee" Key -> Maybe User -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe User
pullRequestAssignee
      , Key
"assignees" Key -> Maybe [User] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [User]
pullRequestAssignees
      , Key
"base" Key -> Maybe PRBranchInfo -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe PRBranchInfo
pullRequestBase
      , Key
"body" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pullRequestBody
      , Key
"changed_files" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
pullRequestChangedFiles
      , Key
"closed_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
pullRequestClosedAt
      , Key
"comments" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
pullRequestComments
      , Key
"created_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
pullRequestCreatedAt
      , Key
"deletions" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
pullRequestDeletions
      , Key
"diff_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pullRequestDiffUrl
      , Key
"draft" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
pullRequestDraft
      , Key
"due_date" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
pullRequestDueDate
      , Key
"head" Key -> Maybe PRBranchInfo -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe PRBranchInfo
pullRequestHead
      , Key
"html_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pullRequestHtmlUrl
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
pullRequestId
      , Key
"is_locked" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
pullRequestIsLocked
      , Key
"labels" Key -> Maybe [Label] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Label]
pullRequestLabels
      , Key
"merge_base" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pullRequestMergeBase
      , Key
"merge_commit_sha" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pullRequestMergeCommitSha
      , Key
"mergeable" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
pullRequestMergeable
      , Key
"merged" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
pullRequestMerged
      , Key
"merged_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
pullRequestMergedAt
      , Key
"merged_by" Key -> Maybe User -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe User
pullRequestMergedBy
      , Key
"milestone" Key -> Maybe Milestone -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Milestone
pullRequestMilestone
      , Key
"number" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
pullRequestNumber
      , Key
"patch_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pullRequestPatchUrl
      , Key
"pin_order" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
pullRequestPinOrder
      , Key
"requested_reviewers" Key -> Maybe [User] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [User]
pullRequestRequestedReviewers
      , Key
"requested_reviewers_teams" Key -> Maybe [Team] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Team]
pullRequestRequestedReviewersTeams
      , Key
"review_comments" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
pullRequestReviewComments
      , Key
"state" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pullRequestState
      , Key
"title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pullRequestTitle
      , Key
"updated_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
pullRequestUpdatedAt
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pullRequestUrl
      , Key
"user" Key -> Maybe User -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe User
pullRequestUser
      ]


-- | Construct a value of type 'PullRequest' (by applying it's required fields, if any)
mkPullRequest
  :: PullRequest
mkPullRequest :: PullRequest
mkPullRequest =
  PullRequest
  { $sel:pullRequestAdditions:PullRequest :: Maybe Integer
pullRequestAdditions = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:pullRequestAllowMaintainerEdit:PullRequest :: Maybe Bool
pullRequestAllowMaintainerEdit = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:pullRequestAssignee:PullRequest :: Maybe User
pullRequestAssignee = Maybe User
forall a. Maybe a
Nothing
  , $sel:pullRequestAssignees:PullRequest :: Maybe [User]
pullRequestAssignees = Maybe [User]
forall a. Maybe a
Nothing
  , $sel:pullRequestBase:PullRequest :: Maybe PRBranchInfo
pullRequestBase = Maybe PRBranchInfo
forall a. Maybe a
Nothing
  , $sel:pullRequestBody:PullRequest :: Maybe Text
pullRequestBody = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pullRequestChangedFiles:PullRequest :: Maybe Integer
pullRequestChangedFiles = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:pullRequestClosedAt:PullRequest :: Maybe DateTime
pullRequestClosedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:pullRequestComments:PullRequest :: Maybe Integer
pullRequestComments = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:pullRequestCreatedAt:PullRequest :: Maybe DateTime
pullRequestCreatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:pullRequestDeletions:PullRequest :: Maybe Integer
pullRequestDeletions = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:pullRequestDiffUrl:PullRequest :: Maybe Text
pullRequestDiffUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pullRequestDraft:PullRequest :: Maybe Bool
pullRequestDraft = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:pullRequestDueDate:PullRequest :: Maybe DateTime
pullRequestDueDate = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:pullRequestHead:PullRequest :: Maybe PRBranchInfo
pullRequestHead = Maybe PRBranchInfo
forall a. Maybe a
Nothing
  , $sel:pullRequestHtmlUrl:PullRequest :: Maybe Text
pullRequestHtmlUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pullRequestId:PullRequest :: Maybe Integer
pullRequestId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:pullRequestIsLocked:PullRequest :: Maybe Bool
pullRequestIsLocked = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:pullRequestLabels:PullRequest :: Maybe [Label]
pullRequestLabels = Maybe [Label]
forall a. Maybe a
Nothing
  , $sel:pullRequestMergeBase:PullRequest :: Maybe Text
pullRequestMergeBase = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pullRequestMergeCommitSha:PullRequest :: Maybe Text
pullRequestMergeCommitSha = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pullRequestMergeable:PullRequest :: Maybe Bool
pullRequestMergeable = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:pullRequestMerged:PullRequest :: Maybe Bool
pullRequestMerged = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:pullRequestMergedAt:PullRequest :: Maybe DateTime
pullRequestMergedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:pullRequestMergedBy:PullRequest :: Maybe User
pullRequestMergedBy = Maybe User
forall a. Maybe a
Nothing
  , $sel:pullRequestMilestone:PullRequest :: Maybe Milestone
pullRequestMilestone = Maybe Milestone
forall a. Maybe a
Nothing
  , $sel:pullRequestNumber:PullRequest :: Maybe Integer
pullRequestNumber = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:pullRequestPatchUrl:PullRequest :: Maybe Text
pullRequestPatchUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pullRequestPinOrder:PullRequest :: Maybe Integer
pullRequestPinOrder = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:pullRequestRequestedReviewers:PullRequest :: Maybe [User]
pullRequestRequestedReviewers = Maybe [User]
forall a. Maybe a
Nothing
  , $sel:pullRequestRequestedReviewersTeams:PullRequest :: Maybe [Team]
pullRequestRequestedReviewersTeams = Maybe [Team]
forall a. Maybe a
Nothing
  , $sel:pullRequestReviewComments:PullRequest :: Maybe Integer
pullRequestReviewComments = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:pullRequestState:PullRequest :: Maybe Text
pullRequestState = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pullRequestTitle:PullRequest :: Maybe Text
pullRequestTitle = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pullRequestUpdatedAt:PullRequest :: Maybe DateTime
pullRequestUpdatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:pullRequestUrl:PullRequest :: Maybe Text
pullRequestUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pullRequestUser:PullRequest :: Maybe User
pullRequestUser = Maybe User
forall a. Maybe a
Nothing
  }

-- ** PullRequestMeta
-- | PullRequestMeta
-- PullRequestMeta PR info if an issue is a PR
data PullRequestMeta = PullRequestMeta
  { PullRequestMeta -> Maybe Bool
pullRequestMetaDraft :: !(Maybe Bool) -- ^ "draft"
  , PullRequestMeta -> Maybe Text
pullRequestMetaHtmlUrl :: !(Maybe Text) -- ^ "html_url"
  , PullRequestMeta -> Maybe Bool
pullRequestMetaMerged :: !(Maybe Bool) -- ^ "merged"
  , PullRequestMeta -> Maybe DateTime
pullRequestMetaMergedAt :: !(Maybe DateTime) -- ^ "merged_at"
  } deriving (Int -> PullRequestMeta -> ShowS
[PullRequestMeta] -> ShowS
PullRequestMeta -> [Char]
(Int -> PullRequestMeta -> ShowS)
-> (PullRequestMeta -> [Char])
-> ([PullRequestMeta] -> ShowS)
-> Show PullRequestMeta
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PullRequestMeta -> ShowS
showsPrec :: Int -> PullRequestMeta -> ShowS
$cshow :: PullRequestMeta -> [Char]
show :: PullRequestMeta -> [Char]
$cshowList :: [PullRequestMeta] -> ShowS
showList :: [PullRequestMeta] -> ShowS
P.Show, PullRequestMeta -> PullRequestMeta -> Bool
(PullRequestMeta -> PullRequestMeta -> Bool)
-> (PullRequestMeta -> PullRequestMeta -> Bool)
-> Eq PullRequestMeta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PullRequestMeta -> PullRequestMeta -> Bool
== :: PullRequestMeta -> PullRequestMeta -> Bool
$c/= :: PullRequestMeta -> PullRequestMeta -> Bool
/= :: PullRequestMeta -> PullRequestMeta -> Bool
P.Eq, P.Typeable)

-- | FromJSON PullRequestMeta
instance A.FromJSON PullRequestMeta where
  parseJSON :: Value -> Parser PullRequestMeta
parseJSON = [Char]
-> (Object -> Parser PullRequestMeta)
-> Value
-> Parser PullRequestMeta
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"PullRequestMeta" ((Object -> Parser PullRequestMeta)
 -> Value -> Parser PullRequestMeta)
-> (Object -> Parser PullRequestMeta)
-> Value
-> Parser PullRequestMeta
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool
-> Maybe Text -> Maybe Bool -> Maybe DateTime -> PullRequestMeta
PullRequestMeta
      (Maybe Bool
 -> Maybe Text -> Maybe Bool -> Maybe DateTime -> PullRequestMeta)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text -> Maybe Bool -> Maybe DateTime -> PullRequestMeta)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"draft")
      Parser
  (Maybe Text -> Maybe Bool -> Maybe DateTime -> PullRequestMeta)
-> Parser (Maybe Text)
-> Parser (Maybe Bool -> Maybe DateTime -> PullRequestMeta)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"html_url")
      Parser (Maybe Bool -> Maybe DateTime -> PullRequestMeta)
-> Parser (Maybe Bool)
-> Parser (Maybe DateTime -> PullRequestMeta)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"merged")
      Parser (Maybe DateTime -> PullRequestMeta)
-> Parser (Maybe DateTime) -> Parser PullRequestMeta
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"merged_at")

-- | ToJSON PullRequestMeta
instance A.ToJSON PullRequestMeta where
  toJSON :: PullRequestMeta -> Value
toJSON PullRequestMeta {Maybe Bool
Maybe Text
Maybe DateTime
$sel:pullRequestMetaDraft:PullRequestMeta :: PullRequestMeta -> Maybe Bool
$sel:pullRequestMetaHtmlUrl:PullRequestMeta :: PullRequestMeta -> Maybe Text
$sel:pullRequestMetaMerged:PullRequestMeta :: PullRequestMeta -> Maybe Bool
$sel:pullRequestMetaMergedAt:PullRequestMeta :: PullRequestMeta -> Maybe DateTime
pullRequestMetaDraft :: Maybe Bool
pullRequestMetaHtmlUrl :: Maybe Text
pullRequestMetaMerged :: Maybe Bool
pullRequestMetaMergedAt :: Maybe DateTime
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"draft" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
pullRequestMetaDraft
      , Key
"html_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pullRequestMetaHtmlUrl
      , Key
"merged" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
pullRequestMetaMerged
      , Key
"merged_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
pullRequestMetaMergedAt
      ]


-- | Construct a value of type 'PullRequestMeta' (by applying it's required fields, if any)
mkPullRequestMeta
  :: PullRequestMeta
mkPullRequestMeta :: PullRequestMeta
mkPullRequestMeta =
  PullRequestMeta
  { $sel:pullRequestMetaDraft:PullRequestMeta :: Maybe Bool
pullRequestMetaDraft = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:pullRequestMetaHtmlUrl:PullRequestMeta :: Maybe Text
pullRequestMetaHtmlUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pullRequestMetaMerged:PullRequestMeta :: Maybe Bool
pullRequestMetaMerged = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:pullRequestMetaMergedAt:PullRequestMeta :: Maybe DateTime
pullRequestMetaMergedAt = Maybe DateTime
forall a. Maybe a
Nothing
  }

-- ** PullReview
-- | PullReview
-- PullReview represents a pull request review
data PullReview = PullReview
  { PullReview -> Maybe Text
pullReviewBody :: !(Maybe Text) -- ^ "body"
  , PullReview -> Maybe Integer
pullReviewCommentsCount :: !(Maybe Integer) -- ^ "comments_count"
  , PullReview -> Maybe Text
pullReviewCommitId :: !(Maybe Text) -- ^ "commit_id"
  , PullReview -> Maybe Bool
pullReviewDismissed :: !(Maybe Bool) -- ^ "dismissed"
  , PullReview -> Maybe Text
pullReviewHtmlUrl :: !(Maybe Text) -- ^ "html_url"
  , PullReview -> Maybe Integer
pullReviewId :: !(Maybe Integer) -- ^ "id"
  , PullReview -> Maybe Bool
pullReviewOfficial :: !(Maybe Bool) -- ^ "official"
  , PullReview -> Maybe Text
pullReviewPullRequestUrl :: !(Maybe Text) -- ^ "pull_request_url"
  , PullReview -> Maybe Bool
pullReviewStale :: !(Maybe Bool) -- ^ "stale"
  , PullReview -> Maybe Text
pullReviewState :: !(Maybe Text) -- ^ "state" - ReviewStateType review state type
  , PullReview -> Maybe DateTime
pullReviewSubmittedAt :: !(Maybe DateTime) -- ^ "submitted_at"
  , PullReview -> Maybe Team
pullReviewTeam :: !(Maybe Team) -- ^ "team"
  , PullReview -> Maybe DateTime
pullReviewUpdatedAt :: !(Maybe DateTime) -- ^ "updated_at"
  , PullReview -> Maybe User
pullReviewUser :: !(Maybe User) -- ^ "user"
  } deriving (Int -> PullReview -> ShowS
[PullReview] -> ShowS
PullReview -> [Char]
(Int -> PullReview -> ShowS)
-> (PullReview -> [Char])
-> ([PullReview] -> ShowS)
-> Show PullReview
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PullReview -> ShowS
showsPrec :: Int -> PullReview -> ShowS
$cshow :: PullReview -> [Char]
show :: PullReview -> [Char]
$cshowList :: [PullReview] -> ShowS
showList :: [PullReview] -> ShowS
P.Show, PullReview -> PullReview -> Bool
(PullReview -> PullReview -> Bool)
-> (PullReview -> PullReview -> Bool) -> Eq PullReview
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PullReview -> PullReview -> Bool
== :: PullReview -> PullReview -> Bool
$c/= :: PullReview -> PullReview -> Bool
/= :: PullReview -> PullReview -> Bool
P.Eq, P.Typeable)

-- | FromJSON PullReview
instance A.FromJSON PullReview where
  parseJSON :: Value -> Parser PullReview
parseJSON = [Char]
-> (Object -> Parser PullReview) -> Value -> Parser PullReview
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"PullReview" ((Object -> Parser PullReview) -> Value -> Parser PullReview)
-> (Object -> Parser PullReview) -> Value -> Parser PullReview
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Integer
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe DateTime
-> Maybe Team
-> Maybe DateTime
-> Maybe User
-> PullReview
PullReview
      (Maybe Text
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Text
 -> Maybe DateTime
 -> Maybe Team
 -> Maybe DateTime
 -> Maybe User
 -> PullReview)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Team
      -> Maybe DateTime
      -> Maybe User
      -> PullReview)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"body")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Team
   -> Maybe DateTime
   -> Maybe User
   -> PullReview)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Team
      -> Maybe DateTime
      -> Maybe User
      -> PullReview)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"comments_count")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Team
   -> Maybe DateTime
   -> Maybe User
   -> PullReview)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Team
      -> Maybe DateTime
      -> Maybe User
      -> PullReview)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"commit_id")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Team
   -> Maybe DateTime
   -> Maybe User
   -> PullReview)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Team
      -> Maybe DateTime
      -> Maybe User
      -> PullReview)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"dismissed")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Team
   -> Maybe DateTime
   -> Maybe User
   -> PullReview)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Team
      -> Maybe DateTime
      -> Maybe User
      -> PullReview)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"html_url")
      Parser
  (Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Team
   -> Maybe DateTime
   -> Maybe User
   -> PullReview)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Team
      -> Maybe DateTime
      -> Maybe User
      -> PullReview)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Team
   -> Maybe DateTime
   -> Maybe User
   -> PullReview)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Team
      -> Maybe DateTime
      -> Maybe User
      -> PullReview)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"official")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Team
   -> Maybe DateTime
   -> Maybe User
   -> PullReview)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Team
      -> Maybe DateTime
      -> Maybe User
      -> PullReview)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pull_request_url")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Team
   -> Maybe DateTime
   -> Maybe User
   -> PullReview)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe DateTime
      -> Maybe Team
      -> Maybe DateTime
      -> Maybe User
      -> PullReview)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"stale")
      Parser
  (Maybe Text
   -> Maybe DateTime
   -> Maybe Team
   -> Maybe DateTime
   -> Maybe User
   -> PullReview)
-> Parser (Maybe Text)
-> Parser
     (Maybe DateTime
      -> Maybe Team -> Maybe DateTime -> Maybe User -> PullReview)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"state")
      Parser
  (Maybe DateTime
   -> Maybe Team -> Maybe DateTime -> Maybe User -> PullReview)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Team -> Maybe DateTime -> Maybe User -> PullReview)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"submitted_at")
      Parser (Maybe Team -> Maybe DateTime -> Maybe User -> PullReview)
-> Parser (Maybe Team)
-> Parser (Maybe DateTime -> Maybe User -> PullReview)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Team)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"team")
      Parser (Maybe DateTime -> Maybe User -> PullReview)
-> Parser (Maybe DateTime) -> Parser (Maybe User -> PullReview)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated_at")
      Parser (Maybe User -> PullReview)
-> Parser (Maybe User) -> Parser PullReview
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user")

-- | ToJSON PullReview
instance A.ToJSON PullReview where
  toJSON :: PullReview -> Value
toJSON PullReview {Maybe Bool
Maybe Integer
Maybe Text
Maybe DateTime
Maybe User
Maybe Team
$sel:pullReviewBody:PullReview :: PullReview -> Maybe Text
$sel:pullReviewCommentsCount:PullReview :: PullReview -> Maybe Integer
$sel:pullReviewCommitId:PullReview :: PullReview -> Maybe Text
$sel:pullReviewDismissed:PullReview :: PullReview -> Maybe Bool
$sel:pullReviewHtmlUrl:PullReview :: PullReview -> Maybe Text
$sel:pullReviewId:PullReview :: PullReview -> Maybe Integer
$sel:pullReviewOfficial:PullReview :: PullReview -> Maybe Bool
$sel:pullReviewPullRequestUrl:PullReview :: PullReview -> Maybe Text
$sel:pullReviewStale:PullReview :: PullReview -> Maybe Bool
$sel:pullReviewState:PullReview :: PullReview -> Maybe Text
$sel:pullReviewSubmittedAt:PullReview :: PullReview -> Maybe DateTime
$sel:pullReviewTeam:PullReview :: PullReview -> Maybe Team
$sel:pullReviewUpdatedAt:PullReview :: PullReview -> Maybe DateTime
$sel:pullReviewUser:PullReview :: PullReview -> Maybe User
pullReviewBody :: Maybe Text
pullReviewCommentsCount :: Maybe Integer
pullReviewCommitId :: Maybe Text
pullReviewDismissed :: Maybe Bool
pullReviewHtmlUrl :: Maybe Text
pullReviewId :: Maybe Integer
pullReviewOfficial :: Maybe Bool
pullReviewPullRequestUrl :: Maybe Text
pullReviewStale :: Maybe Bool
pullReviewState :: Maybe Text
pullReviewSubmittedAt :: Maybe DateTime
pullReviewTeam :: Maybe Team
pullReviewUpdatedAt :: Maybe DateTime
pullReviewUser :: Maybe User
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"body" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pullReviewBody
      , Key
"comments_count" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
pullReviewCommentsCount
      , Key
"commit_id" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pullReviewCommitId
      , Key
"dismissed" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
pullReviewDismissed
      , Key
"html_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pullReviewHtmlUrl
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
pullReviewId
      , Key
"official" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
pullReviewOfficial
      , Key
"pull_request_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pullReviewPullRequestUrl
      , Key
"stale" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
pullReviewStale
      , Key
"state" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pullReviewState
      , Key
"submitted_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
pullReviewSubmittedAt
      , Key
"team" Key -> Maybe Team -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Team
pullReviewTeam
      , Key
"updated_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
pullReviewUpdatedAt
      , Key
"user" Key -> Maybe User -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe User
pullReviewUser
      ]


-- | Construct a value of type 'PullReview' (by applying it's required fields, if any)
mkPullReview
  :: PullReview
mkPullReview :: PullReview
mkPullReview =
  PullReview
  { $sel:pullReviewBody:PullReview :: Maybe Text
pullReviewBody = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pullReviewCommentsCount:PullReview :: Maybe Integer
pullReviewCommentsCount = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:pullReviewCommitId:PullReview :: Maybe Text
pullReviewCommitId = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pullReviewDismissed:PullReview :: Maybe Bool
pullReviewDismissed = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:pullReviewHtmlUrl:PullReview :: Maybe Text
pullReviewHtmlUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pullReviewId:PullReview :: Maybe Integer
pullReviewId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:pullReviewOfficial:PullReview :: Maybe Bool
pullReviewOfficial = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:pullReviewPullRequestUrl:PullReview :: Maybe Text
pullReviewPullRequestUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pullReviewStale:PullReview :: Maybe Bool
pullReviewStale = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:pullReviewState:PullReview :: Maybe Text
pullReviewState = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pullReviewSubmittedAt:PullReview :: Maybe DateTime
pullReviewSubmittedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:pullReviewTeam:PullReview :: Maybe Team
pullReviewTeam = Maybe Team
forall a. Maybe a
Nothing
  , $sel:pullReviewUpdatedAt:PullReview :: Maybe DateTime
pullReviewUpdatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:pullReviewUser:PullReview :: Maybe User
pullReviewUser = Maybe User
forall a. Maybe a
Nothing
  }

-- ** PullReviewComment
-- | PullReviewComment
-- PullReviewComment represents a comment on a pull request review
data PullReviewComment = PullReviewComment
  { PullReviewComment -> Maybe Text
pullReviewCommentBody :: !(Maybe Text) -- ^ "body"
  , PullReviewComment -> Maybe Text
pullReviewCommentCommitId :: !(Maybe Text) -- ^ "commit_id"
  , PullReviewComment -> Maybe DateTime
pullReviewCommentCreatedAt :: !(Maybe DateTime) -- ^ "created_at"
  , PullReviewComment -> Maybe Text
pullReviewCommentDiffHunk :: !(Maybe Text) -- ^ "diff_hunk"
  , PullReviewComment -> Maybe Text
pullReviewCommentHtmlUrl :: !(Maybe Text) -- ^ "html_url"
  , PullReviewComment -> Maybe Integer
pullReviewCommentId :: !(Maybe Integer) -- ^ "id"
  , PullReviewComment -> Maybe Text
pullReviewCommentOriginalCommitId :: !(Maybe Text) -- ^ "original_commit_id"
  , PullReviewComment -> Maybe Int
pullReviewCommentOriginalPosition :: !(Maybe Int) -- ^ "original_position"
  , PullReviewComment -> Maybe Text
pullReviewCommentPath :: !(Maybe Text) -- ^ "path"
  , PullReviewComment -> Maybe Int
pullReviewCommentPosition :: !(Maybe Int) -- ^ "position"
  , PullReviewComment -> Maybe Integer
pullReviewCommentPullRequestReviewId :: !(Maybe Integer) -- ^ "pull_request_review_id"
  , PullReviewComment -> Maybe Text
pullReviewCommentPullRequestUrl :: !(Maybe Text) -- ^ "pull_request_url"
  , PullReviewComment -> Maybe User
pullReviewCommentResolver :: !(Maybe User) -- ^ "resolver"
  , PullReviewComment -> Maybe DateTime
pullReviewCommentUpdatedAt :: !(Maybe DateTime) -- ^ "updated_at"
  , PullReviewComment -> Maybe User
pullReviewCommentUser :: !(Maybe User) -- ^ "user"
  } deriving (Int -> PullReviewComment -> ShowS
[PullReviewComment] -> ShowS
PullReviewComment -> [Char]
(Int -> PullReviewComment -> ShowS)
-> (PullReviewComment -> [Char])
-> ([PullReviewComment] -> ShowS)
-> Show PullReviewComment
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PullReviewComment -> ShowS
showsPrec :: Int -> PullReviewComment -> ShowS
$cshow :: PullReviewComment -> [Char]
show :: PullReviewComment -> [Char]
$cshowList :: [PullReviewComment] -> ShowS
showList :: [PullReviewComment] -> ShowS
P.Show, PullReviewComment -> PullReviewComment -> Bool
(PullReviewComment -> PullReviewComment -> Bool)
-> (PullReviewComment -> PullReviewComment -> Bool)
-> Eq PullReviewComment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PullReviewComment -> PullReviewComment -> Bool
== :: PullReviewComment -> PullReviewComment -> Bool
$c/= :: PullReviewComment -> PullReviewComment -> Bool
/= :: PullReviewComment -> PullReviewComment -> Bool
P.Eq, P.Typeable)

-- | FromJSON PullReviewComment
instance A.FromJSON PullReviewComment where
  parseJSON :: Value -> Parser PullReviewComment
parseJSON = [Char]
-> (Object -> Parser PullReviewComment)
-> Value
-> Parser PullReviewComment
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"PullReviewComment" ((Object -> Parser PullReviewComment)
 -> Value -> Parser PullReviewComment)
-> (Object -> Parser PullReviewComment)
-> Value
-> Parser PullReviewComment
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe DateTime
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe Int
-> Maybe Text
-> Maybe Int
-> Maybe Integer
-> Maybe Text
-> Maybe User
-> Maybe DateTime
-> Maybe User
-> PullReviewComment
PullReviewComment
      (Maybe Text
 -> Maybe Text
 -> Maybe DateTime
 -> Maybe Text
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Int
 -> Maybe Text
 -> Maybe Int
 -> Maybe Integer
 -> Maybe Text
 -> Maybe User
 -> Maybe DateTime
 -> Maybe User
 -> PullReviewComment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe DateTime
      -> Maybe User
      -> PullReviewComment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"body")
      Parser
  (Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe DateTime
   -> Maybe User
   -> PullReviewComment)
-> Parser (Maybe Text)
-> Parser
     (Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe DateTime
      -> Maybe User
      -> PullReviewComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"commit_id")
      Parser
  (Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe DateTime
   -> Maybe User
   -> PullReviewComment)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe DateTime
      -> Maybe User
      -> PullReviewComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_at")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe DateTime
   -> Maybe User
   -> PullReviewComment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe DateTime
      -> Maybe User
      -> PullReviewComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"diff_hunk")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe DateTime
   -> Maybe User
   -> PullReviewComment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe DateTime
      -> Maybe User
      -> PullReviewComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"html_url")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe DateTime
   -> Maybe User
   -> PullReviewComment)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe DateTime
      -> Maybe User
      -> PullReviewComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe DateTime
   -> Maybe User
   -> PullReviewComment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Maybe Int
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe DateTime
      -> Maybe User
      -> PullReviewComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"original_commit_id")
      Parser
  (Maybe Int
   -> Maybe Text
   -> Maybe Int
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe DateTime
   -> Maybe User
   -> PullReviewComment)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Maybe Int
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe DateTime
      -> Maybe User
      -> PullReviewComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"original_position")
      Parser
  (Maybe Text
   -> Maybe Int
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe DateTime
   -> Maybe User
   -> PullReviewComment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Int
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe DateTime
      -> Maybe User
      -> PullReviewComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"path")
      Parser
  (Maybe Int
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe DateTime
   -> Maybe User
   -> PullReviewComment)
-> Parser (Maybe Int)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe DateTime
      -> Maybe User
      -> PullReviewComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"position")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe DateTime
   -> Maybe User
   -> PullReviewComment)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe User -> Maybe DateTime -> Maybe User -> PullReviewComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pull_request_review_id")
      Parser
  (Maybe Text
   -> Maybe User -> Maybe DateTime -> Maybe User -> PullReviewComment)
-> Parser (Maybe Text)
-> Parser
     (Maybe User -> Maybe DateTime -> Maybe User -> PullReviewComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pull_request_url")
      Parser
  (Maybe User -> Maybe DateTime -> Maybe User -> PullReviewComment)
-> Parser (Maybe User)
-> Parser (Maybe DateTime -> Maybe User -> PullReviewComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"resolver")
      Parser (Maybe DateTime -> Maybe User -> PullReviewComment)
-> Parser (Maybe DateTime)
-> Parser (Maybe User -> PullReviewComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated_at")
      Parser (Maybe User -> PullReviewComment)
-> Parser (Maybe User) -> Parser PullReviewComment
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user")

-- | ToJSON PullReviewComment
instance A.ToJSON PullReviewComment where
  toJSON :: PullReviewComment -> Value
toJSON PullReviewComment {Maybe Int
Maybe Integer
Maybe Text
Maybe DateTime
Maybe User
$sel:pullReviewCommentBody:PullReviewComment :: PullReviewComment -> Maybe Text
$sel:pullReviewCommentCommitId:PullReviewComment :: PullReviewComment -> Maybe Text
$sel:pullReviewCommentCreatedAt:PullReviewComment :: PullReviewComment -> Maybe DateTime
$sel:pullReviewCommentDiffHunk:PullReviewComment :: PullReviewComment -> Maybe Text
$sel:pullReviewCommentHtmlUrl:PullReviewComment :: PullReviewComment -> Maybe Text
$sel:pullReviewCommentId:PullReviewComment :: PullReviewComment -> Maybe Integer
$sel:pullReviewCommentOriginalCommitId:PullReviewComment :: PullReviewComment -> Maybe Text
$sel:pullReviewCommentOriginalPosition:PullReviewComment :: PullReviewComment -> Maybe Int
$sel:pullReviewCommentPath:PullReviewComment :: PullReviewComment -> Maybe Text
$sel:pullReviewCommentPosition:PullReviewComment :: PullReviewComment -> Maybe Int
$sel:pullReviewCommentPullRequestReviewId:PullReviewComment :: PullReviewComment -> Maybe Integer
$sel:pullReviewCommentPullRequestUrl:PullReviewComment :: PullReviewComment -> Maybe Text
$sel:pullReviewCommentResolver:PullReviewComment :: PullReviewComment -> Maybe User
$sel:pullReviewCommentUpdatedAt:PullReviewComment :: PullReviewComment -> Maybe DateTime
$sel:pullReviewCommentUser:PullReviewComment :: PullReviewComment -> Maybe User
pullReviewCommentBody :: Maybe Text
pullReviewCommentCommitId :: Maybe Text
pullReviewCommentCreatedAt :: Maybe DateTime
pullReviewCommentDiffHunk :: Maybe Text
pullReviewCommentHtmlUrl :: Maybe Text
pullReviewCommentId :: Maybe Integer
pullReviewCommentOriginalCommitId :: Maybe Text
pullReviewCommentOriginalPosition :: Maybe Int
pullReviewCommentPath :: Maybe Text
pullReviewCommentPosition :: Maybe Int
pullReviewCommentPullRequestReviewId :: Maybe Integer
pullReviewCommentPullRequestUrl :: Maybe Text
pullReviewCommentResolver :: Maybe User
pullReviewCommentUpdatedAt :: Maybe DateTime
pullReviewCommentUser :: Maybe User
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"body" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pullReviewCommentBody
      , Key
"commit_id" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pullReviewCommentCommitId
      , Key
"created_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
pullReviewCommentCreatedAt
      , Key
"diff_hunk" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pullReviewCommentDiffHunk
      , Key
"html_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pullReviewCommentHtmlUrl
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
pullReviewCommentId
      , Key
"original_commit_id" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pullReviewCommentOriginalCommitId
      , Key
"original_position" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Int
pullReviewCommentOriginalPosition
      , Key
"path" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pullReviewCommentPath
      , Key
"position" Key -> Maybe Int -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Int
pullReviewCommentPosition
      , Key
"pull_request_review_id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
pullReviewCommentPullRequestReviewId
      , Key
"pull_request_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pullReviewCommentPullRequestUrl
      , Key
"resolver" Key -> Maybe User -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe User
pullReviewCommentResolver
      , Key
"updated_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
pullReviewCommentUpdatedAt
      , Key
"user" Key -> Maybe User -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe User
pullReviewCommentUser
      ]


-- | Construct a value of type 'PullReviewComment' (by applying it's required fields, if any)
mkPullReviewComment
  :: PullReviewComment
mkPullReviewComment :: PullReviewComment
mkPullReviewComment =
  PullReviewComment
  { $sel:pullReviewCommentBody:PullReviewComment :: Maybe Text
pullReviewCommentBody = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pullReviewCommentCommitId:PullReviewComment :: Maybe Text
pullReviewCommentCommitId = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pullReviewCommentCreatedAt:PullReviewComment :: Maybe DateTime
pullReviewCommentCreatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:pullReviewCommentDiffHunk:PullReviewComment :: Maybe Text
pullReviewCommentDiffHunk = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pullReviewCommentHtmlUrl:PullReviewComment :: Maybe Text
pullReviewCommentHtmlUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pullReviewCommentId:PullReviewComment :: Maybe Integer
pullReviewCommentId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:pullReviewCommentOriginalCommitId:PullReviewComment :: Maybe Text
pullReviewCommentOriginalCommitId = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pullReviewCommentOriginalPosition:PullReviewComment :: Maybe Int
pullReviewCommentOriginalPosition = Maybe Int
forall a. Maybe a
Nothing
  , $sel:pullReviewCommentPath:PullReviewComment :: Maybe Text
pullReviewCommentPath = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pullReviewCommentPosition:PullReviewComment :: Maybe Int
pullReviewCommentPosition = Maybe Int
forall a. Maybe a
Nothing
  , $sel:pullReviewCommentPullRequestReviewId:PullReviewComment :: Maybe Integer
pullReviewCommentPullRequestReviewId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:pullReviewCommentPullRequestUrl:PullReviewComment :: Maybe Text
pullReviewCommentPullRequestUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pullReviewCommentResolver:PullReviewComment :: Maybe User
pullReviewCommentResolver = Maybe User
forall a. Maybe a
Nothing
  , $sel:pullReviewCommentUpdatedAt:PullReviewComment :: Maybe DateTime
pullReviewCommentUpdatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:pullReviewCommentUser:PullReviewComment :: Maybe User
pullReviewCommentUser = Maybe User
forall a. Maybe a
Nothing
  }

-- ** PullReviewRequestOptions
-- | PullReviewRequestOptions
-- PullReviewRequestOptions are options to add or remove pull review requests
data PullReviewRequestOptions = PullReviewRequestOptions
  { PullReviewRequestOptions -> Maybe [Text]
pullReviewRequestOptionsReviewers :: !(Maybe [Text]) -- ^ "reviewers"
  , PullReviewRequestOptions -> Maybe [Text]
pullReviewRequestOptionsTeamReviewers :: !(Maybe [Text]) -- ^ "team_reviewers"
  } deriving (Int -> PullReviewRequestOptions -> ShowS
[PullReviewRequestOptions] -> ShowS
PullReviewRequestOptions -> [Char]
(Int -> PullReviewRequestOptions -> ShowS)
-> (PullReviewRequestOptions -> [Char])
-> ([PullReviewRequestOptions] -> ShowS)
-> Show PullReviewRequestOptions
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PullReviewRequestOptions -> ShowS
showsPrec :: Int -> PullReviewRequestOptions -> ShowS
$cshow :: PullReviewRequestOptions -> [Char]
show :: PullReviewRequestOptions -> [Char]
$cshowList :: [PullReviewRequestOptions] -> ShowS
showList :: [PullReviewRequestOptions] -> ShowS
P.Show, PullReviewRequestOptions -> PullReviewRequestOptions -> Bool
(PullReviewRequestOptions -> PullReviewRequestOptions -> Bool)
-> (PullReviewRequestOptions -> PullReviewRequestOptions -> Bool)
-> Eq PullReviewRequestOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PullReviewRequestOptions -> PullReviewRequestOptions -> Bool
== :: PullReviewRequestOptions -> PullReviewRequestOptions -> Bool
$c/= :: PullReviewRequestOptions -> PullReviewRequestOptions -> Bool
/= :: PullReviewRequestOptions -> PullReviewRequestOptions -> Bool
P.Eq, P.Typeable)

-- | FromJSON PullReviewRequestOptions
instance A.FromJSON PullReviewRequestOptions where
  parseJSON :: Value -> Parser PullReviewRequestOptions
parseJSON = [Char]
-> (Object -> Parser PullReviewRequestOptions)
-> Value
-> Parser PullReviewRequestOptions
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"PullReviewRequestOptions" ((Object -> Parser PullReviewRequestOptions)
 -> Value -> Parser PullReviewRequestOptions)
-> (Object -> Parser PullReviewRequestOptions)
-> Value
-> Parser PullReviewRequestOptions
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Text] -> Maybe [Text] -> PullReviewRequestOptions
PullReviewRequestOptions
      (Maybe [Text] -> Maybe [Text] -> PullReviewRequestOptions)
-> Parser (Maybe [Text])
-> Parser (Maybe [Text] -> PullReviewRequestOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"reviewers")
      Parser (Maybe [Text] -> PullReviewRequestOptions)
-> Parser (Maybe [Text]) -> Parser PullReviewRequestOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"team_reviewers")

-- | ToJSON PullReviewRequestOptions
instance A.ToJSON PullReviewRequestOptions where
  toJSON :: PullReviewRequestOptions -> Value
toJSON PullReviewRequestOptions {Maybe [Text]
$sel:pullReviewRequestOptionsReviewers:PullReviewRequestOptions :: PullReviewRequestOptions -> Maybe [Text]
$sel:pullReviewRequestOptionsTeamReviewers:PullReviewRequestOptions :: PullReviewRequestOptions -> Maybe [Text]
pullReviewRequestOptionsReviewers :: Maybe [Text]
pullReviewRequestOptionsTeamReviewers :: Maybe [Text]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"reviewers" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
pullReviewRequestOptionsReviewers
      , Key
"team_reviewers" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
pullReviewRequestOptionsTeamReviewers
      ]


-- | Construct a value of type 'PullReviewRequestOptions' (by applying it's required fields, if any)
mkPullReviewRequestOptions
  :: PullReviewRequestOptions
mkPullReviewRequestOptions :: PullReviewRequestOptions
mkPullReviewRequestOptions =
  PullReviewRequestOptions
  { $sel:pullReviewRequestOptionsReviewers:PullReviewRequestOptions :: Maybe [Text]
pullReviewRequestOptionsReviewers = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:pullReviewRequestOptionsTeamReviewers:PullReviewRequestOptions :: Maybe [Text]
pullReviewRequestOptionsTeamReviewers = Maybe [Text]
forall a. Maybe a
Nothing
  }

-- ** PushMirror
-- | PushMirror
-- PushMirror represents information of a push mirror
data PushMirror = PushMirror
  { PushMirror -> Maybe DateTime
pushMirrorCreated :: !(Maybe DateTime) -- ^ "created"
  , PushMirror -> Maybe Text
pushMirrorInterval :: !(Maybe Text) -- ^ "interval"
  , PushMirror -> Maybe Text
pushMirrorLastError :: !(Maybe Text) -- ^ "last_error"
  , PushMirror -> Maybe DateTime
pushMirrorLastUpdate :: !(Maybe DateTime) -- ^ "last_update"
  , PushMirror -> Maybe Text
pushMirrorRemoteAddress :: !(Maybe Text) -- ^ "remote_address"
  , PushMirror -> Maybe Text
pushMirrorRemoteName :: !(Maybe Text) -- ^ "remote_name"
  , PushMirror -> Maybe Text
pushMirrorRepoName :: !(Maybe Text) -- ^ "repo_name"
  , PushMirror -> Maybe Bool
pushMirrorSyncOnCommit :: !(Maybe Bool) -- ^ "sync_on_commit"
  } deriving (Int -> PushMirror -> ShowS
[PushMirror] -> ShowS
PushMirror -> [Char]
(Int -> PushMirror -> ShowS)
-> (PushMirror -> [Char])
-> ([PushMirror] -> ShowS)
-> Show PushMirror
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PushMirror -> ShowS
showsPrec :: Int -> PushMirror -> ShowS
$cshow :: PushMirror -> [Char]
show :: PushMirror -> [Char]
$cshowList :: [PushMirror] -> ShowS
showList :: [PushMirror] -> ShowS
P.Show, PushMirror -> PushMirror -> Bool
(PushMirror -> PushMirror -> Bool)
-> (PushMirror -> PushMirror -> Bool) -> Eq PushMirror
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PushMirror -> PushMirror -> Bool
== :: PushMirror -> PushMirror -> Bool
$c/= :: PushMirror -> PushMirror -> Bool
/= :: PushMirror -> PushMirror -> Bool
P.Eq, P.Typeable)

-- | FromJSON PushMirror
instance A.FromJSON PushMirror where
  parseJSON :: Value -> Parser PushMirror
parseJSON = [Char]
-> (Object -> Parser PushMirror) -> Value -> Parser PushMirror
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"PushMirror" ((Object -> Parser PushMirror) -> Value -> Parser PushMirror)
-> (Object -> Parser PushMirror) -> Value -> Parser PushMirror
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe DateTime
-> Maybe Text
-> Maybe Text
-> Maybe DateTime
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> PushMirror
PushMirror
      (Maybe DateTime
 -> Maybe Text
 -> Maybe Text
 -> Maybe DateTime
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> PushMirror)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> PushMirror)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> PushMirror)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> PushMirror)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"interval")
      Parser
  (Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> PushMirror)
-> Parser (Maybe Text)
-> Parser
     (Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> PushMirror)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"last_error")
      Parser
  (Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> PushMirror)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe Text -> Maybe Bool -> PushMirror)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"last_update")
      Parser
  (Maybe Text
   -> Maybe Text -> Maybe Text -> Maybe Bool -> PushMirror)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> Maybe Bool -> PushMirror)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"remote_address")
      Parser (Maybe Text -> Maybe Text -> Maybe Bool -> PushMirror)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Bool -> PushMirror)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"remote_name")
      Parser (Maybe Text -> Maybe Bool -> PushMirror)
-> Parser (Maybe Text) -> Parser (Maybe Bool -> PushMirror)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"repo_name")
      Parser (Maybe Bool -> PushMirror)
-> Parser (Maybe Bool) -> Parser PushMirror
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sync_on_commit")

-- | ToJSON PushMirror
instance A.ToJSON PushMirror where
  toJSON :: PushMirror -> Value
toJSON PushMirror {Maybe Bool
Maybe Text
Maybe DateTime
$sel:pushMirrorCreated:PushMirror :: PushMirror -> Maybe DateTime
$sel:pushMirrorInterval:PushMirror :: PushMirror -> Maybe Text
$sel:pushMirrorLastError:PushMirror :: PushMirror -> Maybe Text
$sel:pushMirrorLastUpdate:PushMirror :: PushMirror -> Maybe DateTime
$sel:pushMirrorRemoteAddress:PushMirror :: PushMirror -> Maybe Text
$sel:pushMirrorRemoteName:PushMirror :: PushMirror -> Maybe Text
$sel:pushMirrorRepoName:PushMirror :: PushMirror -> Maybe Text
$sel:pushMirrorSyncOnCommit:PushMirror :: PushMirror -> Maybe Bool
pushMirrorCreated :: Maybe DateTime
pushMirrorInterval :: Maybe Text
pushMirrorLastError :: Maybe Text
pushMirrorLastUpdate :: Maybe DateTime
pushMirrorRemoteAddress :: Maybe Text
pushMirrorRemoteName :: Maybe Text
pushMirrorRepoName :: Maybe Text
pushMirrorSyncOnCommit :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
pushMirrorCreated
      , Key
"interval" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pushMirrorInterval
      , Key
"last_error" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pushMirrorLastError
      , Key
"last_update" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
pushMirrorLastUpdate
      , Key
"remote_address" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pushMirrorRemoteAddress
      , Key
"remote_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pushMirrorRemoteName
      , Key
"repo_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
pushMirrorRepoName
      , Key
"sync_on_commit" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
pushMirrorSyncOnCommit
      ]


-- | Construct a value of type 'PushMirror' (by applying it's required fields, if any)
mkPushMirror
  :: PushMirror
mkPushMirror :: PushMirror
mkPushMirror =
  PushMirror
  { $sel:pushMirrorCreated:PushMirror :: Maybe DateTime
pushMirrorCreated = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:pushMirrorInterval:PushMirror :: Maybe Text
pushMirrorInterval = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pushMirrorLastError:PushMirror :: Maybe Text
pushMirrorLastError = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pushMirrorLastUpdate:PushMirror :: Maybe DateTime
pushMirrorLastUpdate = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:pushMirrorRemoteAddress:PushMirror :: Maybe Text
pushMirrorRemoteAddress = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pushMirrorRemoteName:PushMirror :: Maybe Text
pushMirrorRemoteName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pushMirrorRepoName:PushMirror :: Maybe Text
pushMirrorRepoName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:pushMirrorSyncOnCommit:PushMirror :: Maybe Bool
pushMirrorSyncOnCommit = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** Reaction
-- | Reaction
-- Reaction contain one reaction
data Reaction = Reaction
  { Reaction -> Maybe Text
reactionContent :: !(Maybe Text) -- ^ "content"
  , Reaction -> Maybe DateTime
reactionCreatedAt :: !(Maybe DateTime) -- ^ "created_at"
  , Reaction -> Maybe User
reactionUser :: !(Maybe User) -- ^ "user"
  } deriving (Int -> Reaction -> ShowS
[Reaction] -> ShowS
Reaction -> [Char]
(Int -> Reaction -> ShowS)
-> (Reaction -> [Char]) -> ([Reaction] -> ShowS) -> Show Reaction
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Reaction -> ShowS
showsPrec :: Int -> Reaction -> ShowS
$cshow :: Reaction -> [Char]
show :: Reaction -> [Char]
$cshowList :: [Reaction] -> ShowS
showList :: [Reaction] -> ShowS
P.Show, Reaction -> Reaction -> Bool
(Reaction -> Reaction -> Bool)
-> (Reaction -> Reaction -> Bool) -> Eq Reaction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Reaction -> Reaction -> Bool
== :: Reaction -> Reaction -> Bool
$c/= :: Reaction -> Reaction -> Bool
/= :: Reaction -> Reaction -> Bool
P.Eq, P.Typeable)

-- | FromJSON Reaction
instance A.FromJSON Reaction where
  parseJSON :: Value -> Parser Reaction
parseJSON = [Char] -> (Object -> Parser Reaction) -> Value -> Parser Reaction
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Reaction" ((Object -> Parser Reaction) -> Value -> Parser Reaction)
-> (Object -> Parser Reaction) -> Value -> Parser Reaction
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe DateTime -> Maybe User -> Reaction
Reaction
      (Maybe Text -> Maybe DateTime -> Maybe User -> Reaction)
-> Parser (Maybe Text)
-> Parser (Maybe DateTime -> Maybe User -> Reaction)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"content")
      Parser (Maybe DateTime -> Maybe User -> Reaction)
-> Parser (Maybe DateTime) -> Parser (Maybe User -> Reaction)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_at")
      Parser (Maybe User -> Reaction)
-> Parser (Maybe User) -> Parser Reaction
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user")

-- | ToJSON Reaction
instance A.ToJSON Reaction where
  toJSON :: Reaction -> Value
toJSON Reaction {Maybe Text
Maybe DateTime
Maybe User
$sel:reactionContent:Reaction :: Reaction -> Maybe Text
$sel:reactionCreatedAt:Reaction :: Reaction -> Maybe DateTime
$sel:reactionUser:Reaction :: Reaction -> Maybe User
reactionContent :: Maybe Text
reactionCreatedAt :: Maybe DateTime
reactionUser :: Maybe User
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"content" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
reactionContent
      , Key
"created_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
reactionCreatedAt
      , Key
"user" Key -> Maybe User -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe User
reactionUser
      ]


-- | Construct a value of type 'Reaction' (by applying it's required fields, if any)
mkReaction
  :: Reaction
mkReaction :: Reaction
mkReaction =
  Reaction
  { $sel:reactionContent:Reaction :: Maybe Text
reactionContent = Maybe Text
forall a. Maybe a
Nothing
  , $sel:reactionCreatedAt:Reaction :: Maybe DateTime
reactionCreatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:reactionUser:Reaction :: Maybe User
reactionUser = Maybe User
forall a. Maybe a
Nothing
  }

-- ** Reference
-- | Reference
-- Reference represents a Git reference.
-- 
data Reference = Reference
  { Reference -> Maybe GitObject
referenceObject :: !(Maybe GitObject) -- ^ "object"
  , Reference -> Maybe Text
referenceRef :: !(Maybe Text) -- ^ "ref"
  , Reference -> Maybe Text
referenceUrl :: !(Maybe Text) -- ^ "url"
  } deriving (Int -> Reference -> ShowS
[Reference] -> ShowS
Reference -> [Char]
(Int -> Reference -> ShowS)
-> (Reference -> [Char])
-> ([Reference] -> ShowS)
-> Show Reference
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Reference -> ShowS
showsPrec :: Int -> Reference -> ShowS
$cshow :: Reference -> [Char]
show :: Reference -> [Char]
$cshowList :: [Reference] -> ShowS
showList :: [Reference] -> ShowS
P.Show, Reference -> Reference -> Bool
(Reference -> Reference -> Bool)
-> (Reference -> Reference -> Bool) -> Eq Reference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Reference -> Reference -> Bool
== :: Reference -> Reference -> Bool
$c/= :: Reference -> Reference -> Bool
/= :: Reference -> Reference -> Bool
P.Eq, P.Typeable)

-- | FromJSON Reference
instance A.FromJSON Reference where
  parseJSON :: Value -> Parser Reference
parseJSON = [Char] -> (Object -> Parser Reference) -> Value -> Parser Reference
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Reference" ((Object -> Parser Reference) -> Value -> Parser Reference)
-> (Object -> Parser Reference) -> Value -> Parser Reference
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe GitObject -> Maybe Text -> Maybe Text -> Reference
Reference
      (Maybe GitObject -> Maybe Text -> Maybe Text -> Reference)
-> Parser (Maybe GitObject)
-> Parser (Maybe Text -> Maybe Text -> Reference)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe GitObject)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"object")
      Parser (Maybe Text -> Maybe Text -> Reference)
-> Parser (Maybe Text) -> Parser (Maybe Text -> Reference)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ref")
      Parser (Maybe Text -> Reference)
-> Parser (Maybe Text) -> Parser Reference
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")

-- | ToJSON Reference
instance A.ToJSON Reference where
  toJSON :: Reference -> Value
toJSON Reference {Maybe Text
Maybe GitObject
$sel:referenceObject:Reference :: Reference -> Maybe GitObject
$sel:referenceRef:Reference :: Reference -> Maybe Text
$sel:referenceUrl:Reference :: Reference -> Maybe Text
referenceObject :: Maybe GitObject
referenceRef :: Maybe Text
referenceUrl :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"object" Key -> Maybe GitObject -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe GitObject
referenceObject
      , Key
"ref" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
referenceRef
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
referenceUrl
      ]


-- | Construct a value of type 'Reference' (by applying it's required fields, if any)
mkReference
  :: Reference
mkReference :: Reference
mkReference =
  Reference
  { $sel:referenceObject:Reference :: Maybe GitObject
referenceObject = Maybe GitObject
forall a. Maybe a
Nothing
  , $sel:referenceRef:Reference :: Maybe Text
referenceRef = Maybe Text
forall a. Maybe a
Nothing
  , $sel:referenceUrl:Reference :: Maybe Text
referenceUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** Release
-- | Release
-- Release represents a repository release
data Release = Release
  { Release -> Maybe [Attachment]
releaseAssets :: !(Maybe [Attachment]) -- ^ "assets"
  , Release -> Maybe User
releaseAuthor :: !(Maybe User) -- ^ "author"
  , Release -> Maybe Text
releaseBody :: !(Maybe Text) -- ^ "body"
  , Release -> Maybe DateTime
releaseCreatedAt :: !(Maybe DateTime) -- ^ "created_at"
  , Release -> Maybe Bool
releaseDraft :: !(Maybe Bool) -- ^ "draft"
  , Release -> Maybe Text
releaseHtmlUrl :: !(Maybe Text) -- ^ "html_url"
  , Release -> Maybe Integer
releaseId :: !(Maybe Integer) -- ^ "id"
  , Release -> Maybe Text
releaseName :: !(Maybe Text) -- ^ "name"
  , Release -> Maybe Bool
releasePrerelease :: !(Maybe Bool) -- ^ "prerelease"
  , Release -> Maybe DateTime
releasePublishedAt :: !(Maybe DateTime) -- ^ "published_at"
  , Release -> Maybe Text
releaseTagName :: !(Maybe Text) -- ^ "tag_name"
  , Release -> Maybe Text
releaseTarballUrl :: !(Maybe Text) -- ^ "tarball_url"
  , Release -> Maybe Text
releaseTargetCommitish :: !(Maybe Text) -- ^ "target_commitish"
  , Release -> Maybe Text
releaseUploadUrl :: !(Maybe Text) -- ^ "upload_url"
  , Release -> Maybe Text
releaseUrl :: !(Maybe Text) -- ^ "url"
  , Release -> Maybe Text
releaseZipballUrl :: !(Maybe Text) -- ^ "zipball_url"
  } deriving (Int -> Release -> ShowS
[Release] -> ShowS
Release -> [Char]
(Int -> Release -> ShowS)
-> (Release -> [Char]) -> ([Release] -> ShowS) -> Show Release
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Release -> ShowS
showsPrec :: Int -> Release -> ShowS
$cshow :: Release -> [Char]
show :: Release -> [Char]
$cshowList :: [Release] -> ShowS
showList :: [Release] -> ShowS
P.Show, Release -> Release -> Bool
(Release -> Release -> Bool)
-> (Release -> Release -> Bool) -> Eq Release
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Release -> Release -> Bool
== :: Release -> Release -> Bool
$c/= :: Release -> Release -> Bool
/= :: Release -> Release -> Bool
P.Eq, P.Typeable)

-- | FromJSON Release
instance A.FromJSON Release where
  parseJSON :: Value -> Parser Release
parseJSON = [Char] -> (Object -> Parser Release) -> Value -> Parser Release
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Release" ((Object -> Parser Release) -> Value -> Parser Release)
-> (Object -> Parser Release) -> Value -> Parser Release
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Attachment]
-> Maybe User
-> Maybe Text
-> Maybe DateTime
-> Maybe Bool
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe Bool
-> Maybe DateTime
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Release
Release
      (Maybe [Attachment]
 -> Maybe User
 -> Maybe Text
 -> Maybe DateTime
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Bool
 -> Maybe DateTime
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Release)
-> Parser (Maybe [Attachment])
-> Parser
     (Maybe User
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Release)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [Attachment])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"assets")
      Parser
  (Maybe User
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Release)
-> Parser (Maybe User)
-> Parser
     (Maybe Text
      -> Maybe DateTime
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Release)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"author")
      Parser
  (Maybe Text
   -> Maybe DateTime
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Release)
-> Parser (Maybe Text)
-> Parser
     (Maybe DateTime
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Release)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"body")
      Parser
  (Maybe DateTime
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Release)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Release)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_at")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Release)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Release)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"draft")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Release)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Release)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"html_url")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Release)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Release)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Release)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Release)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser
  (Maybe Bool
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Release)
-> Parser (Maybe Bool)
-> Parser
     (Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Release)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prerelease")
      Parser
  (Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Release)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Release)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"published_at")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Release)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Release)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tag_name")
      Parser
  (Maybe Text
   -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Release)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Release)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tarball_url")
      Parser
  (Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Release)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> Maybe Text -> Release)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"target_commitish")
      Parser (Maybe Text -> Maybe Text -> Maybe Text -> Release)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> Release)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"upload_url")
      Parser (Maybe Text -> Maybe Text -> Release)
-> Parser (Maybe Text) -> Parser (Maybe Text -> Release)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")
      Parser (Maybe Text -> Release)
-> Parser (Maybe Text) -> Parser Release
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"zipball_url")

-- | ToJSON Release
instance A.ToJSON Release where
  toJSON :: Release -> Value
toJSON Release {Maybe Bool
Maybe Integer
Maybe [Attachment]
Maybe Text
Maybe DateTime
Maybe User
$sel:releaseAssets:Release :: Release -> Maybe [Attachment]
$sel:releaseAuthor:Release :: Release -> Maybe User
$sel:releaseBody:Release :: Release -> Maybe Text
$sel:releaseCreatedAt:Release :: Release -> Maybe DateTime
$sel:releaseDraft:Release :: Release -> Maybe Bool
$sel:releaseHtmlUrl:Release :: Release -> Maybe Text
$sel:releaseId:Release :: Release -> Maybe Integer
$sel:releaseName:Release :: Release -> Maybe Text
$sel:releasePrerelease:Release :: Release -> Maybe Bool
$sel:releasePublishedAt:Release :: Release -> Maybe DateTime
$sel:releaseTagName:Release :: Release -> Maybe Text
$sel:releaseTarballUrl:Release :: Release -> Maybe Text
$sel:releaseTargetCommitish:Release :: Release -> Maybe Text
$sel:releaseUploadUrl:Release :: Release -> Maybe Text
$sel:releaseUrl:Release :: Release -> Maybe Text
$sel:releaseZipballUrl:Release :: Release -> Maybe Text
releaseAssets :: Maybe [Attachment]
releaseAuthor :: Maybe User
releaseBody :: Maybe Text
releaseCreatedAt :: Maybe DateTime
releaseDraft :: Maybe Bool
releaseHtmlUrl :: Maybe Text
releaseId :: Maybe Integer
releaseName :: Maybe Text
releasePrerelease :: Maybe Bool
releasePublishedAt :: Maybe DateTime
releaseTagName :: Maybe Text
releaseTarballUrl :: Maybe Text
releaseTargetCommitish :: Maybe Text
releaseUploadUrl :: Maybe Text
releaseUrl :: Maybe Text
releaseZipballUrl :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"assets" Key -> Maybe [Attachment] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Attachment]
releaseAssets
      , Key
"author" Key -> Maybe User -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe User
releaseAuthor
      , Key
"body" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
releaseBody
      , Key
"created_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
releaseCreatedAt
      , Key
"draft" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
releaseDraft
      , Key
"html_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
releaseHtmlUrl
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
releaseId
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
releaseName
      , Key
"prerelease" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
releasePrerelease
      , Key
"published_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
releasePublishedAt
      , Key
"tag_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
releaseTagName
      , Key
"tarball_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
releaseTarballUrl
      , Key
"target_commitish" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
releaseTargetCommitish
      , Key
"upload_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
releaseUploadUrl
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
releaseUrl
      , Key
"zipball_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
releaseZipballUrl
      ]


-- | Construct a value of type 'Release' (by applying it's required fields, if any)
mkRelease
  :: Release
mkRelease :: Release
mkRelease =
  Release
  { $sel:releaseAssets:Release :: Maybe [Attachment]
releaseAssets = Maybe [Attachment]
forall a. Maybe a
Nothing
  , $sel:releaseAuthor:Release :: Maybe User
releaseAuthor = Maybe User
forall a. Maybe a
Nothing
  , $sel:releaseBody:Release :: Maybe Text
releaseBody = Maybe Text
forall a. Maybe a
Nothing
  , $sel:releaseCreatedAt:Release :: Maybe DateTime
releaseCreatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:releaseDraft:Release :: Maybe Bool
releaseDraft = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:releaseHtmlUrl:Release :: Maybe Text
releaseHtmlUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:releaseId:Release :: Maybe Integer
releaseId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:releaseName:Release :: Maybe Text
releaseName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:releasePrerelease:Release :: Maybe Bool
releasePrerelease = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:releasePublishedAt:Release :: Maybe DateTime
releasePublishedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:releaseTagName:Release :: Maybe Text
releaseTagName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:releaseTarballUrl:Release :: Maybe Text
releaseTarballUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:releaseTargetCommitish:Release :: Maybe Text
releaseTargetCommitish = Maybe Text
forall a. Maybe a
Nothing
  , $sel:releaseUploadUrl:Release :: Maybe Text
releaseUploadUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:releaseUrl:Release :: Maybe Text
releaseUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:releaseZipballUrl:Release :: Maybe Text
releaseZipballUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** RenameUserOption
-- | RenameUserOption
-- RenameUserOption options when renaming a user
data RenameUserOption = RenameUserOption
  { RenameUserOption -> Text
renameUserOptionNewUsername :: !(Text) -- ^ /Required/ "new_username" - New username for this user. This name cannot be in use yet by any other user.
  } deriving (Int -> RenameUserOption -> ShowS
[RenameUserOption] -> ShowS
RenameUserOption -> [Char]
(Int -> RenameUserOption -> ShowS)
-> (RenameUserOption -> [Char])
-> ([RenameUserOption] -> ShowS)
-> Show RenameUserOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RenameUserOption -> ShowS
showsPrec :: Int -> RenameUserOption -> ShowS
$cshow :: RenameUserOption -> [Char]
show :: RenameUserOption -> [Char]
$cshowList :: [RenameUserOption] -> ShowS
showList :: [RenameUserOption] -> ShowS
P.Show, RenameUserOption -> RenameUserOption -> Bool
(RenameUserOption -> RenameUserOption -> Bool)
-> (RenameUserOption -> RenameUserOption -> Bool)
-> Eq RenameUserOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RenameUserOption -> RenameUserOption -> Bool
== :: RenameUserOption -> RenameUserOption -> Bool
$c/= :: RenameUserOption -> RenameUserOption -> Bool
/= :: RenameUserOption -> RenameUserOption -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON RenameUserOption
instance A.ToJSON RenameUserOption where
  toJSON :: RenameUserOption -> Value
toJSON RenameUserOption {Text
$sel:renameUserOptionNewUsername:RenameUserOption :: RenameUserOption -> Text
renameUserOptionNewUsername :: Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"new_username" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
renameUserOptionNewUsername
      ]


-- | Construct a value of type 'RenameUserOption' (by applying it's required fields, if any)
mkRenameUserOption
  :: Text -- ^ 'renameUserOptionNewUsername': New username for this user. This name cannot be in use yet by any other user.
  -> RenameUserOption
mkRenameUserOption :: Text -> RenameUserOption
mkRenameUserOption Text
renameUserOptionNewUsername =
  RenameUserOption
  { Text
$sel:renameUserOptionNewUsername:RenameUserOption :: Text
renameUserOptionNewUsername :: Text
renameUserOptionNewUsername
  }

-- ** RepoCollaboratorPermission
-- | RepoCollaboratorPermission
-- RepoCollaboratorPermission to get repository permission for a collaborator
data RepoCollaboratorPermission = RepoCollaboratorPermission
  { RepoCollaboratorPermission -> Maybe Text
repoCollaboratorPermissionPermission :: !(Maybe Text) -- ^ "permission"
  , RepoCollaboratorPermission -> Maybe Text
repoCollaboratorPermissionRoleName :: !(Maybe Text) -- ^ "role_name"
  , RepoCollaboratorPermission -> Maybe User
repoCollaboratorPermissionUser :: !(Maybe User) -- ^ "user"
  } deriving (Int -> RepoCollaboratorPermission -> ShowS
[RepoCollaboratorPermission] -> ShowS
RepoCollaboratorPermission -> [Char]
(Int -> RepoCollaboratorPermission -> ShowS)
-> (RepoCollaboratorPermission -> [Char])
-> ([RepoCollaboratorPermission] -> ShowS)
-> Show RepoCollaboratorPermission
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RepoCollaboratorPermission -> ShowS
showsPrec :: Int -> RepoCollaboratorPermission -> ShowS
$cshow :: RepoCollaboratorPermission -> [Char]
show :: RepoCollaboratorPermission -> [Char]
$cshowList :: [RepoCollaboratorPermission] -> ShowS
showList :: [RepoCollaboratorPermission] -> ShowS
P.Show, RepoCollaboratorPermission -> RepoCollaboratorPermission -> Bool
(RepoCollaboratorPermission -> RepoCollaboratorPermission -> Bool)
-> (RepoCollaboratorPermission
    -> RepoCollaboratorPermission -> Bool)
-> Eq RepoCollaboratorPermission
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RepoCollaboratorPermission -> RepoCollaboratorPermission -> Bool
== :: RepoCollaboratorPermission -> RepoCollaboratorPermission -> Bool
$c/= :: RepoCollaboratorPermission -> RepoCollaboratorPermission -> Bool
/= :: RepoCollaboratorPermission -> RepoCollaboratorPermission -> Bool
P.Eq, P.Typeable)

-- | FromJSON RepoCollaboratorPermission
instance A.FromJSON RepoCollaboratorPermission where
  parseJSON :: Value -> Parser RepoCollaboratorPermission
parseJSON = [Char]
-> (Object -> Parser RepoCollaboratorPermission)
-> Value
-> Parser RepoCollaboratorPermission
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"RepoCollaboratorPermission" ((Object -> Parser RepoCollaboratorPermission)
 -> Value -> Parser RepoCollaboratorPermission)
-> (Object -> Parser RepoCollaboratorPermission)
-> Value
-> Parser RepoCollaboratorPermission
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text -> Maybe User -> RepoCollaboratorPermission
RepoCollaboratorPermission
      (Maybe Text
 -> Maybe Text -> Maybe User -> RepoCollaboratorPermission)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe User -> RepoCollaboratorPermission)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"permission")
      Parser (Maybe Text -> Maybe User -> RepoCollaboratorPermission)
-> Parser (Maybe Text)
-> Parser (Maybe User -> RepoCollaboratorPermission)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"role_name")
      Parser (Maybe User -> RepoCollaboratorPermission)
-> Parser (Maybe User) -> Parser RepoCollaboratorPermission
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user")

-- | ToJSON RepoCollaboratorPermission
instance A.ToJSON RepoCollaboratorPermission where
  toJSON :: RepoCollaboratorPermission -> Value
toJSON RepoCollaboratorPermission {Maybe Text
Maybe User
$sel:repoCollaboratorPermissionPermission:RepoCollaboratorPermission :: RepoCollaboratorPermission -> Maybe Text
$sel:repoCollaboratorPermissionRoleName:RepoCollaboratorPermission :: RepoCollaboratorPermission -> Maybe Text
$sel:repoCollaboratorPermissionUser:RepoCollaboratorPermission :: RepoCollaboratorPermission -> Maybe User
repoCollaboratorPermissionPermission :: Maybe Text
repoCollaboratorPermissionRoleName :: Maybe Text
repoCollaboratorPermissionUser :: Maybe User
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"permission" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
repoCollaboratorPermissionPermission
      , Key
"role_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
repoCollaboratorPermissionRoleName
      , Key
"user" Key -> Maybe User -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe User
repoCollaboratorPermissionUser
      ]


-- | Construct a value of type 'RepoCollaboratorPermission' (by applying it's required fields, if any)
mkRepoCollaboratorPermission
  :: RepoCollaboratorPermission
mkRepoCollaboratorPermission :: RepoCollaboratorPermission
mkRepoCollaboratorPermission =
  RepoCollaboratorPermission
  { $sel:repoCollaboratorPermissionPermission:RepoCollaboratorPermission :: Maybe Text
repoCollaboratorPermissionPermission = Maybe Text
forall a. Maybe a
Nothing
  , $sel:repoCollaboratorPermissionRoleName:RepoCollaboratorPermission :: Maybe Text
repoCollaboratorPermissionRoleName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:repoCollaboratorPermissionUser:RepoCollaboratorPermission :: Maybe User
repoCollaboratorPermissionUser = Maybe User
forall a. Maybe a
Nothing
  }

-- ** RepoCommit
-- | RepoCommit
-- RepoCommit contains information of a commit in the context of a repository.
-- 
data RepoCommit = RepoCommit
  { RepoCommit -> Maybe CommitUser
repoCommitAuthor :: !(Maybe CommitUser) -- ^ "author"
  , RepoCommit -> Maybe CommitUser
repoCommitCommitter :: !(Maybe CommitUser) -- ^ "committer"
  , RepoCommit -> Maybe Text
repoCommitMessage :: !(Maybe Text) -- ^ "message"
  , RepoCommit -> Maybe CommitMeta
repoCommitTree :: !(Maybe CommitMeta) -- ^ "tree"
  , RepoCommit -> Maybe Text
repoCommitUrl :: !(Maybe Text) -- ^ "url"
  , RepoCommit -> Maybe PayloadCommitVerification
repoCommitVerification :: !(Maybe PayloadCommitVerification) -- ^ "verification"
  } deriving (Int -> RepoCommit -> ShowS
[RepoCommit] -> ShowS
RepoCommit -> [Char]
(Int -> RepoCommit -> ShowS)
-> (RepoCommit -> [Char])
-> ([RepoCommit] -> ShowS)
-> Show RepoCommit
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RepoCommit -> ShowS
showsPrec :: Int -> RepoCommit -> ShowS
$cshow :: RepoCommit -> [Char]
show :: RepoCommit -> [Char]
$cshowList :: [RepoCommit] -> ShowS
showList :: [RepoCommit] -> ShowS
P.Show, RepoCommit -> RepoCommit -> Bool
(RepoCommit -> RepoCommit -> Bool)
-> (RepoCommit -> RepoCommit -> Bool) -> Eq RepoCommit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RepoCommit -> RepoCommit -> Bool
== :: RepoCommit -> RepoCommit -> Bool
$c/= :: RepoCommit -> RepoCommit -> Bool
/= :: RepoCommit -> RepoCommit -> Bool
P.Eq, P.Typeable)

-- | FromJSON RepoCommit
instance A.FromJSON RepoCommit where
  parseJSON :: Value -> Parser RepoCommit
parseJSON = [Char]
-> (Object -> Parser RepoCommit) -> Value -> Parser RepoCommit
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"RepoCommit" ((Object -> Parser RepoCommit) -> Value -> Parser RepoCommit)
-> (Object -> Parser RepoCommit) -> Value -> Parser RepoCommit
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe CommitUser
-> Maybe CommitUser
-> Maybe Text
-> Maybe CommitMeta
-> Maybe Text
-> Maybe PayloadCommitVerification
-> RepoCommit
RepoCommit
      (Maybe CommitUser
 -> Maybe CommitUser
 -> Maybe Text
 -> Maybe CommitMeta
 -> Maybe Text
 -> Maybe PayloadCommitVerification
 -> RepoCommit)
-> Parser (Maybe CommitUser)
-> Parser
     (Maybe CommitUser
      -> Maybe Text
      -> Maybe CommitMeta
      -> Maybe Text
      -> Maybe PayloadCommitVerification
      -> RepoCommit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe CommitUser)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"author")
      Parser
  (Maybe CommitUser
   -> Maybe Text
   -> Maybe CommitMeta
   -> Maybe Text
   -> Maybe PayloadCommitVerification
   -> RepoCommit)
-> Parser (Maybe CommitUser)
-> Parser
     (Maybe Text
      -> Maybe CommitMeta
      -> Maybe Text
      -> Maybe PayloadCommitVerification
      -> RepoCommit)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe CommitUser)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"committer")
      Parser
  (Maybe Text
   -> Maybe CommitMeta
   -> Maybe Text
   -> Maybe PayloadCommitVerification
   -> RepoCommit)
-> Parser (Maybe Text)
-> Parser
     (Maybe CommitMeta
      -> Maybe Text -> Maybe PayloadCommitVerification -> RepoCommit)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"message")
      Parser
  (Maybe CommitMeta
   -> Maybe Text -> Maybe PayloadCommitVerification -> RepoCommit)
-> Parser (Maybe CommitMeta)
-> Parser
     (Maybe Text -> Maybe PayloadCommitVerification -> RepoCommit)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe CommitMeta)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tree")
      Parser
  (Maybe Text -> Maybe PayloadCommitVerification -> RepoCommit)
-> Parser (Maybe Text)
-> Parser (Maybe PayloadCommitVerification -> RepoCommit)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")
      Parser (Maybe PayloadCommitVerification -> RepoCommit)
-> Parser (Maybe PayloadCommitVerification) -> Parser RepoCommit
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe PayloadCommitVerification)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"verification")

-- | ToJSON RepoCommit
instance A.ToJSON RepoCommit where
  toJSON :: RepoCommit -> Value
toJSON RepoCommit {Maybe Text
Maybe PayloadCommitVerification
Maybe CommitUser
Maybe CommitMeta
$sel:repoCommitAuthor:RepoCommit :: RepoCommit -> Maybe CommitUser
$sel:repoCommitCommitter:RepoCommit :: RepoCommit -> Maybe CommitUser
$sel:repoCommitMessage:RepoCommit :: RepoCommit -> Maybe Text
$sel:repoCommitTree:RepoCommit :: RepoCommit -> Maybe CommitMeta
$sel:repoCommitUrl:RepoCommit :: RepoCommit -> Maybe Text
$sel:repoCommitVerification:RepoCommit :: RepoCommit -> Maybe PayloadCommitVerification
repoCommitAuthor :: Maybe CommitUser
repoCommitCommitter :: Maybe CommitUser
repoCommitMessage :: Maybe Text
repoCommitTree :: Maybe CommitMeta
repoCommitUrl :: Maybe Text
repoCommitVerification :: Maybe PayloadCommitVerification
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"author" Key -> Maybe CommitUser -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe CommitUser
repoCommitAuthor
      , Key
"committer" Key -> Maybe CommitUser -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe CommitUser
repoCommitCommitter
      , Key
"message" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
repoCommitMessage
      , Key
"tree" Key -> Maybe CommitMeta -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe CommitMeta
repoCommitTree
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
repoCommitUrl
      , Key
"verification" Key -> Maybe PayloadCommitVerification -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe PayloadCommitVerification
repoCommitVerification
      ]


-- | Construct a value of type 'RepoCommit' (by applying it's required fields, if any)
mkRepoCommit
  :: RepoCommit
mkRepoCommit :: RepoCommit
mkRepoCommit =
  RepoCommit
  { $sel:repoCommitAuthor:RepoCommit :: Maybe CommitUser
repoCommitAuthor = Maybe CommitUser
forall a. Maybe a
Nothing
  , $sel:repoCommitCommitter:RepoCommit :: Maybe CommitUser
repoCommitCommitter = Maybe CommitUser
forall a. Maybe a
Nothing
  , $sel:repoCommitMessage:RepoCommit :: Maybe Text
repoCommitMessage = Maybe Text
forall a. Maybe a
Nothing
  , $sel:repoCommitTree:RepoCommit :: Maybe CommitMeta
repoCommitTree = Maybe CommitMeta
forall a. Maybe a
Nothing
  , $sel:repoCommitUrl:RepoCommit :: Maybe Text
repoCommitUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:repoCommitVerification:RepoCommit :: Maybe PayloadCommitVerification
repoCommitVerification = Maybe PayloadCommitVerification
forall a. Maybe a
Nothing
  }

-- ** RepoCreateReleaseAttachmentRequest
-- | RepoCreateReleaseAttachmentRequest
data RepoCreateReleaseAttachmentRequest = RepoCreateReleaseAttachmentRequest
  { RepoCreateReleaseAttachmentRequest -> Maybe [Char]
repoCreateReleaseAttachmentRequestAttachment :: !(Maybe FilePath) -- ^ "attachment" - attachment to upload
  } deriving (Int -> RepoCreateReleaseAttachmentRequest -> ShowS
[RepoCreateReleaseAttachmentRequest] -> ShowS
RepoCreateReleaseAttachmentRequest -> [Char]
(Int -> RepoCreateReleaseAttachmentRequest -> ShowS)
-> (RepoCreateReleaseAttachmentRequest -> [Char])
-> ([RepoCreateReleaseAttachmentRequest] -> ShowS)
-> Show RepoCreateReleaseAttachmentRequest
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RepoCreateReleaseAttachmentRequest -> ShowS
showsPrec :: Int -> RepoCreateReleaseAttachmentRequest -> ShowS
$cshow :: RepoCreateReleaseAttachmentRequest -> [Char]
show :: RepoCreateReleaseAttachmentRequest -> [Char]
$cshowList :: [RepoCreateReleaseAttachmentRequest] -> ShowS
showList :: [RepoCreateReleaseAttachmentRequest] -> ShowS
P.Show, RepoCreateReleaseAttachmentRequest
-> RepoCreateReleaseAttachmentRequest -> Bool
(RepoCreateReleaseAttachmentRequest
 -> RepoCreateReleaseAttachmentRequest -> Bool)
-> (RepoCreateReleaseAttachmentRequest
    -> RepoCreateReleaseAttachmentRequest -> Bool)
-> Eq RepoCreateReleaseAttachmentRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RepoCreateReleaseAttachmentRequest
-> RepoCreateReleaseAttachmentRequest -> Bool
== :: RepoCreateReleaseAttachmentRequest
-> RepoCreateReleaseAttachmentRequest -> Bool
$c/= :: RepoCreateReleaseAttachmentRequest
-> RepoCreateReleaseAttachmentRequest -> Bool
/= :: RepoCreateReleaseAttachmentRequest
-> RepoCreateReleaseAttachmentRequest -> Bool
P.Eq, P.Typeable)

-- | FromJSON RepoCreateReleaseAttachmentRequest
instance A.FromJSON RepoCreateReleaseAttachmentRequest where
  parseJSON :: Value -> Parser RepoCreateReleaseAttachmentRequest
parseJSON = [Char]
-> (Object -> Parser RepoCreateReleaseAttachmentRequest)
-> Value
-> Parser RepoCreateReleaseAttachmentRequest
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"RepoCreateReleaseAttachmentRequest" ((Object -> Parser RepoCreateReleaseAttachmentRequest)
 -> Value -> Parser RepoCreateReleaseAttachmentRequest)
-> (Object -> Parser RepoCreateReleaseAttachmentRequest)
-> Value
-> Parser RepoCreateReleaseAttachmentRequest
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Char] -> RepoCreateReleaseAttachmentRequest
RepoCreateReleaseAttachmentRequest
      (Maybe [Char] -> RepoCreateReleaseAttachmentRequest)
-> Parser (Maybe [Char])
-> Parser RepoCreateReleaseAttachmentRequest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [Char])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"attachment")

-- | ToJSON RepoCreateReleaseAttachmentRequest
instance A.ToJSON RepoCreateReleaseAttachmentRequest where
  toJSON :: RepoCreateReleaseAttachmentRequest -> Value
toJSON RepoCreateReleaseAttachmentRequest {Maybe [Char]
$sel:repoCreateReleaseAttachmentRequestAttachment:RepoCreateReleaseAttachmentRequest :: RepoCreateReleaseAttachmentRequest -> Maybe [Char]
repoCreateReleaseAttachmentRequestAttachment :: Maybe [Char]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"attachment" Key -> Maybe [Char] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Char]
repoCreateReleaseAttachmentRequestAttachment
      ]


-- | Construct a value of type 'RepoCreateReleaseAttachmentRequest' (by applying it's required fields, if any)
mkRepoCreateReleaseAttachmentRequest
  :: RepoCreateReleaseAttachmentRequest
mkRepoCreateReleaseAttachmentRequest :: RepoCreateReleaseAttachmentRequest
mkRepoCreateReleaseAttachmentRequest =
  RepoCreateReleaseAttachmentRequest
  { $sel:repoCreateReleaseAttachmentRequestAttachment:RepoCreateReleaseAttachmentRequest :: Maybe [Char]
repoCreateReleaseAttachmentRequestAttachment = Maybe [Char]
forall a. Maybe a
Nothing
  }

-- ** RepoTopicOptions
-- | RepoTopicOptions
-- RepoTopicOptions a collection of repo topic names
data RepoTopicOptions = RepoTopicOptions
  { RepoTopicOptions -> Maybe [Text]
repoTopicOptionsTopics :: !(Maybe [Text]) -- ^ "topics" - list of topic names
  } deriving (Int -> RepoTopicOptions -> ShowS
[RepoTopicOptions] -> ShowS
RepoTopicOptions -> [Char]
(Int -> RepoTopicOptions -> ShowS)
-> (RepoTopicOptions -> [Char])
-> ([RepoTopicOptions] -> ShowS)
-> Show RepoTopicOptions
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RepoTopicOptions -> ShowS
showsPrec :: Int -> RepoTopicOptions -> ShowS
$cshow :: RepoTopicOptions -> [Char]
show :: RepoTopicOptions -> [Char]
$cshowList :: [RepoTopicOptions] -> ShowS
showList :: [RepoTopicOptions] -> ShowS
P.Show, RepoTopicOptions -> RepoTopicOptions -> Bool
(RepoTopicOptions -> RepoTopicOptions -> Bool)
-> (RepoTopicOptions -> RepoTopicOptions -> Bool)
-> Eq RepoTopicOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RepoTopicOptions -> RepoTopicOptions -> Bool
== :: RepoTopicOptions -> RepoTopicOptions -> Bool
$c/= :: RepoTopicOptions -> RepoTopicOptions -> Bool
/= :: RepoTopicOptions -> RepoTopicOptions -> Bool
P.Eq, P.Typeable)

-- | FromJSON RepoTopicOptions
instance A.FromJSON RepoTopicOptions where
  parseJSON :: Value -> Parser RepoTopicOptions
parseJSON = [Char]
-> (Object -> Parser RepoTopicOptions)
-> Value
-> Parser RepoTopicOptions
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"RepoTopicOptions" ((Object -> Parser RepoTopicOptions)
 -> Value -> Parser RepoTopicOptions)
-> (Object -> Parser RepoTopicOptions)
-> Value
-> Parser RepoTopicOptions
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Text] -> RepoTopicOptions
RepoTopicOptions
      (Maybe [Text] -> RepoTopicOptions)
-> Parser (Maybe [Text]) -> Parser RepoTopicOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"topics")

-- | ToJSON RepoTopicOptions
instance A.ToJSON RepoTopicOptions where
  toJSON :: RepoTopicOptions -> Value
toJSON RepoTopicOptions {Maybe [Text]
$sel:repoTopicOptionsTopics:RepoTopicOptions :: RepoTopicOptions -> Maybe [Text]
repoTopicOptionsTopics :: Maybe [Text]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"topics" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
repoTopicOptionsTopics
      ]


-- | Construct a value of type 'RepoTopicOptions' (by applying it's required fields, if any)
mkRepoTopicOptions
  :: RepoTopicOptions
mkRepoTopicOptions :: RepoTopicOptions
mkRepoTopicOptions =
  RepoTopicOptions
  { $sel:repoTopicOptionsTopics:RepoTopicOptions :: Maybe [Text]
repoTopicOptionsTopics = Maybe [Text]
forall a. Maybe a
Nothing
  }

-- ** RepoTransfer
-- | RepoTransfer
-- RepoTransfer represents a pending repo transfer
data RepoTransfer = RepoTransfer
  { RepoTransfer -> Maybe User
repoTransferDoer :: !(Maybe User) -- ^ "doer"
  , RepoTransfer -> Maybe User
repoTransferRecipient :: !(Maybe User) -- ^ "recipient"
  , RepoTransfer -> Maybe [Team]
repoTransferTeams :: !(Maybe [Team]) -- ^ "teams"
  } deriving (Int -> RepoTransfer -> ShowS
[RepoTransfer] -> ShowS
RepoTransfer -> [Char]
(Int -> RepoTransfer -> ShowS)
-> (RepoTransfer -> [Char])
-> ([RepoTransfer] -> ShowS)
-> Show RepoTransfer
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RepoTransfer -> ShowS
showsPrec :: Int -> RepoTransfer -> ShowS
$cshow :: RepoTransfer -> [Char]
show :: RepoTransfer -> [Char]
$cshowList :: [RepoTransfer] -> ShowS
showList :: [RepoTransfer] -> ShowS
P.Show, RepoTransfer -> RepoTransfer -> Bool
(RepoTransfer -> RepoTransfer -> Bool)
-> (RepoTransfer -> RepoTransfer -> Bool) -> Eq RepoTransfer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RepoTransfer -> RepoTransfer -> Bool
== :: RepoTransfer -> RepoTransfer -> Bool
$c/= :: RepoTransfer -> RepoTransfer -> Bool
/= :: RepoTransfer -> RepoTransfer -> Bool
P.Eq, P.Typeable)

-- | FromJSON RepoTransfer
instance A.FromJSON RepoTransfer where
  parseJSON :: Value -> Parser RepoTransfer
parseJSON = [Char]
-> (Object -> Parser RepoTransfer) -> Value -> Parser RepoTransfer
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"RepoTransfer" ((Object -> Parser RepoTransfer) -> Value -> Parser RepoTransfer)
-> (Object -> Parser RepoTransfer) -> Value -> Parser RepoTransfer
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe User -> Maybe User -> Maybe [Team] -> RepoTransfer
RepoTransfer
      (Maybe User -> Maybe User -> Maybe [Team] -> RepoTransfer)
-> Parser (Maybe User)
-> Parser (Maybe User -> Maybe [Team] -> RepoTransfer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"doer")
      Parser (Maybe User -> Maybe [Team] -> RepoTransfer)
-> Parser (Maybe User) -> Parser (Maybe [Team] -> RepoTransfer)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"recipient")
      Parser (Maybe [Team] -> RepoTransfer)
-> Parser (Maybe [Team]) -> Parser RepoTransfer
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Team])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"teams")

-- | ToJSON RepoTransfer
instance A.ToJSON RepoTransfer where
  toJSON :: RepoTransfer -> Value
toJSON RepoTransfer {Maybe [Team]
Maybe User
$sel:repoTransferDoer:RepoTransfer :: RepoTransfer -> Maybe User
$sel:repoTransferRecipient:RepoTransfer :: RepoTransfer -> Maybe User
$sel:repoTransferTeams:RepoTransfer :: RepoTransfer -> Maybe [Team]
repoTransferDoer :: Maybe User
repoTransferRecipient :: Maybe User
repoTransferTeams :: Maybe [Team]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"doer" Key -> Maybe User -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe User
repoTransferDoer
      , Key
"recipient" Key -> Maybe User -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe User
repoTransferRecipient
      , Key
"teams" Key -> Maybe [Team] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Team]
repoTransferTeams
      ]


-- | Construct a value of type 'RepoTransfer' (by applying it's required fields, if any)
mkRepoTransfer
  :: RepoTransfer
mkRepoTransfer :: RepoTransfer
mkRepoTransfer =
  RepoTransfer
  { $sel:repoTransferDoer:RepoTransfer :: Maybe User
repoTransferDoer = Maybe User
forall a. Maybe a
Nothing
  , $sel:repoTransferRecipient:RepoTransfer :: Maybe User
repoTransferRecipient = Maybe User
forall a. Maybe a
Nothing
  , $sel:repoTransferTeams:RepoTransfer :: Maybe [Team]
repoTransferTeams = Maybe [Team]
forall a. Maybe a
Nothing
  }

-- ** Repository
-- | Repository
-- Repository represents a repository
data Repository = Repository
  { Repository -> Maybe Bool
repositoryAllowFastForwardOnlyMerge :: !(Maybe Bool) -- ^ "allow_fast_forward_only_merge"
  , Repository -> Maybe Bool
repositoryAllowMergeCommits :: !(Maybe Bool) -- ^ "allow_merge_commits"
  , Repository -> Maybe Bool
repositoryAllowRebase :: !(Maybe Bool) -- ^ "allow_rebase"
  , Repository -> Maybe Bool
repositoryAllowRebaseExplicit :: !(Maybe Bool) -- ^ "allow_rebase_explicit"
  , Repository -> Maybe Bool
repositoryAllowRebaseUpdate :: !(Maybe Bool) -- ^ "allow_rebase_update"
  , Repository -> Maybe Bool
repositoryAllowSquashMerge :: !(Maybe Bool) -- ^ "allow_squash_merge"
  , Repository -> Maybe Bool
repositoryArchived :: !(Maybe Bool) -- ^ "archived"
  , Repository -> Maybe DateTime
repositoryArchivedAt :: !(Maybe DateTime) -- ^ "archived_at"
  , Repository -> Maybe Text
repositoryAvatarUrl :: !(Maybe Text) -- ^ "avatar_url"
  , Repository -> Maybe Text
repositoryCloneUrl :: !(Maybe Text) -- ^ "clone_url"
  , Repository -> Maybe DateTime
repositoryCreatedAt :: !(Maybe DateTime) -- ^ "created_at"
  , Repository -> Maybe Bool
repositoryDefaultAllowMaintainerEdit :: !(Maybe Bool) -- ^ "default_allow_maintainer_edit"
  , Repository -> Maybe Text
repositoryDefaultBranch :: !(Maybe Text) -- ^ "default_branch"
  , Repository -> Maybe Bool
repositoryDefaultDeleteBranchAfterMerge :: !(Maybe Bool) -- ^ "default_delete_branch_after_merge"
  , Repository -> Maybe Text
repositoryDefaultMergeStyle :: !(Maybe Text) -- ^ "default_merge_style"
  , Repository -> Maybe Text
repositoryDescription :: !(Maybe Text) -- ^ "description"
  , Repository -> Maybe Bool
repositoryEmpty :: !(Maybe Bool) -- ^ "empty"
  , Repository -> Maybe ExternalTracker
repositoryExternalTracker :: !(Maybe ExternalTracker) -- ^ "external_tracker"
  , Repository -> Maybe ExternalWiki
repositoryExternalWiki :: !(Maybe ExternalWiki) -- ^ "external_wiki"
  , Repository -> Maybe Bool
repositoryFork :: !(Maybe Bool) -- ^ "fork"
  , Repository -> Maybe Integer
repositoryForksCount :: !(Maybe Integer) -- ^ "forks_count"
  , Repository -> Maybe Text
repositoryFullName :: !(Maybe Text) -- ^ "full_name"
  , Repository -> Maybe Bool
repositoryHasActions :: !(Maybe Bool) -- ^ "has_actions"
  , Repository -> Maybe Bool
repositoryHasIssues :: !(Maybe Bool) -- ^ "has_issues"
  , Repository -> Maybe Bool
repositoryHasPackages :: !(Maybe Bool) -- ^ "has_packages"
  , Repository -> Maybe Bool
repositoryHasProjects :: !(Maybe Bool) -- ^ "has_projects"
  , Repository -> Maybe Bool
repositoryHasPullRequests :: !(Maybe Bool) -- ^ "has_pull_requests"
  , Repository -> Maybe Bool
repositoryHasReleases :: !(Maybe Bool) -- ^ "has_releases"
  , Repository -> Maybe Bool
repositoryHasWiki :: !(Maybe Bool) -- ^ "has_wiki"
  , Repository -> Maybe Text
repositoryHtmlUrl :: !(Maybe Text) -- ^ "html_url"
  , Repository -> Maybe Integer
repositoryId :: !(Maybe Integer) -- ^ "id"
  , Repository -> Maybe Bool
repositoryIgnoreWhitespaceConflicts :: !(Maybe Bool) -- ^ "ignore_whitespace_conflicts"
  , Repository -> Maybe Bool
repositoryInternal :: !(Maybe Bool) -- ^ "internal"
  , Repository -> Maybe InternalTracker
repositoryInternalTracker :: !(Maybe InternalTracker) -- ^ "internal_tracker"
  , Repository -> Maybe Text
repositoryLanguage :: !(Maybe Text) -- ^ "language"
  , Repository -> Maybe Text
repositoryLanguagesUrl :: !(Maybe Text) -- ^ "languages_url"
  , Repository -> Maybe [Text]
repositoryLicenses :: !(Maybe [Text]) -- ^ "licenses"
  , Repository -> Maybe Text
repositoryLink :: !(Maybe Text) -- ^ "link"
  , Repository -> Maybe Bool
repositoryMirror :: !(Maybe Bool) -- ^ "mirror"
  , Repository -> Maybe Text
repositoryMirrorInterval :: !(Maybe Text) -- ^ "mirror_interval"
  , Repository -> Maybe DateTime
repositoryMirrorUpdated :: !(Maybe DateTime) -- ^ "mirror_updated"
  , Repository -> Maybe Text
repositoryName :: !(Maybe Text) -- ^ "name"
  , Repository -> Maybe E'ObjectFormatName
repositoryObjectFormatName :: !(Maybe E'ObjectFormatName) -- ^ "object_format_name" - ObjectFormatName of the underlying git repository
  , Repository -> Maybe Integer
repositoryOpenIssuesCount :: !(Maybe Integer) -- ^ "open_issues_count"
  , Repository -> Maybe Integer
repositoryOpenPrCounter :: !(Maybe Integer) -- ^ "open_pr_counter"
  , Repository -> Maybe Text
repositoryOriginalUrl :: !(Maybe Text) -- ^ "original_url"
  , Repository -> Maybe User
repositoryOwner :: !(Maybe User) -- ^ "owner"
  , Repository -> Maybe Repository
repositoryParent :: !(Maybe Repository) -- ^ "parent"
  , Repository -> Maybe Permission
repositoryPermissions :: !(Maybe Permission) -- ^ "permissions"
  , Repository -> Maybe Bool
repositoryPrivate :: !(Maybe Bool) -- ^ "private"
  , Repository -> Maybe Text
repositoryProjectsMode :: !(Maybe Text) -- ^ "projects_mode"
  , Repository -> Maybe Integer
repositoryReleaseCounter :: !(Maybe Integer) -- ^ "release_counter"
  , Repository -> Maybe RepoTransfer
repositoryRepoTransfer :: !(Maybe RepoTransfer) -- ^ "repo_transfer"
  , Repository -> Maybe Integer
repositorySize :: !(Maybe Integer) -- ^ "size"
  , Repository -> Maybe Text
repositorySshUrl :: !(Maybe Text) -- ^ "ssh_url"
  , Repository -> Maybe Integer
repositoryStarsCount :: !(Maybe Integer) -- ^ "stars_count"
  , Repository -> Maybe Bool
repositoryTemplate :: !(Maybe Bool) -- ^ "template"
  , Repository -> Maybe [Text]
repositoryTopics :: !(Maybe [Text]) -- ^ "topics"
  , Repository -> Maybe DateTime
repositoryUpdatedAt :: !(Maybe DateTime) -- ^ "updated_at"
  , Repository -> Maybe Text
repositoryUrl :: !(Maybe Text) -- ^ "url"
  , Repository -> Maybe Integer
repositoryWatchersCount :: !(Maybe Integer) -- ^ "watchers_count"
  , Repository -> Maybe Text
repositoryWebsite :: !(Maybe Text) -- ^ "website"
  } deriving (Int -> Repository -> ShowS
[Repository] -> ShowS
Repository -> [Char]
(Int -> Repository -> ShowS)
-> (Repository -> [Char])
-> ([Repository] -> ShowS)
-> Show Repository
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Repository -> ShowS
showsPrec :: Int -> Repository -> ShowS
$cshow :: Repository -> [Char]
show :: Repository -> [Char]
$cshowList :: [Repository] -> ShowS
showList :: [Repository] -> ShowS
P.Show, Repository -> Repository -> Bool
(Repository -> Repository -> Bool)
-> (Repository -> Repository -> Bool) -> Eq Repository
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Repository -> Repository -> Bool
== :: Repository -> Repository -> Bool
$c/= :: Repository -> Repository -> Bool
/= :: Repository -> Repository -> Bool
P.Eq, P.Typeable)

-- | FromJSON Repository
instance A.FromJSON Repository where
  parseJSON :: Value -> Parser Repository
parseJSON = [Char]
-> (Object -> Parser Repository) -> Value -> Parser Repository
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Repository" ((Object -> Parser Repository) -> Value -> Parser Repository)
-> (Object -> Parser Repository) -> Value -> Parser Repository
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe DateTime
-> Maybe Text
-> Maybe Text
-> Maybe DateTime
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe ExternalTracker
-> Maybe ExternalWiki
-> Maybe Bool
-> Maybe Integer
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Integer
-> Maybe Bool
-> Maybe Bool
-> Maybe InternalTracker
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe DateTime
-> Maybe Text
-> Maybe E'ObjectFormatName
-> Maybe Integer
-> Maybe Integer
-> Maybe Text
-> Maybe User
-> Maybe Repository
-> Maybe Permission
-> Maybe Bool
-> Maybe Text
-> Maybe Integer
-> Maybe RepoTransfer
-> Maybe Integer
-> Maybe Text
-> Maybe Integer
-> Maybe Bool
-> Maybe [Text]
-> Maybe DateTime
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Repository
Repository
      (Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe DateTime
 -> Maybe Text
 -> Maybe Text
 -> Maybe DateTime
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Maybe ExternalTracker
 -> Maybe ExternalWiki
 -> Maybe Bool
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe InternalTracker
 -> Maybe Text
 -> Maybe Text
 -> Maybe [Text]
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Text
 -> Maybe DateTime
 -> Maybe Text
 -> Maybe E'ObjectFormatName
 -> Maybe Integer
 -> Maybe Integer
 -> Maybe Text
 -> Maybe User
 -> Maybe Repository
 -> Maybe Permission
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Integer
 -> Maybe RepoTransfer
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Bool
 -> Maybe [Text]
 -> Maybe DateTime
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Text
 -> Repository)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allow_fast_forward_only_merge")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allow_merge_commits")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allow_rebase")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allow_rebase_explicit")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allow_rebase_update")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"allow_squash_merge")
      Parser
  (Maybe Bool
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Bool)
-> Parser
     (Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"archived")
      Parser
  (Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"archived_at")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe DateTime
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"avatar_url")
      Parser
  (Maybe Text
   -> Maybe DateTime
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Text)
-> Parser
     (Maybe DateTime
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"clone_url")
      Parser
  (Maybe DateTime
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_at")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"default_allow_maintainer_edit")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"default_branch")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"default_delete_branch_after_merge")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"default_merge_style")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe Bool
   -> Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Bool)
-> Parser
     (Maybe ExternalTracker
      -> Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"empty")
      Parser
  (Maybe ExternalTracker
   -> Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe ExternalTracker)
-> Parser
     (Maybe ExternalWiki
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe ExternalTracker)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"external_tracker")
      Parser
  (Maybe ExternalWiki
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe ExternalWiki)
-> Parser
     (Maybe Bool
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe ExternalWiki)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"external_wiki")
      Parser
  (Maybe Bool
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"fork")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"forks_count")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"full_name")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"has_actions")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"has_issues")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"has_packages")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"has_projects")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"has_pull_requests")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"has_releases")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"has_wiki")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"html_url")
      Parser
  (Maybe Integer
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ignore_whitespace_conflicts")
      Parser
  (Maybe Bool
   -> Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Bool)
-> Parser
     (Maybe InternalTracker
      -> Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"internal")
      Parser
  (Maybe InternalTracker
   -> Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe InternalTracker)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe InternalTracker)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"internal_tracker")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"language")
      Parser
  (Maybe Text
   -> Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Text)
-> Parser
     (Maybe [Text]
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"languages_url")
      Parser
  (Maybe [Text]
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe [Text])
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"licenses")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"link")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mirror")
      Parser
  (Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Text)
-> Parser
     (Maybe DateTime
      -> Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mirror_interval")
      Parser
  (Maybe DateTime
   -> Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Text
      -> Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"mirror_updated")
      Parser
  (Maybe Text
   -> Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Text)
-> Parser
     (Maybe E'ObjectFormatName
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser
  (Maybe E'ObjectFormatName
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe E'ObjectFormatName)
-> Parser
     (Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe E'ObjectFormatName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"object_format_name")
      Parser
  (Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"open_issues_count")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"open_pr_counter")
      Parser
  (Maybe Text
   -> Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Text)
-> Parser
     (Maybe User
      -> Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"original_url")
      Parser
  (Maybe User
   -> Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe User)
-> Parser
     (Maybe Repository
      -> Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"owner")
      Parser
  (Maybe Repository
   -> Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Repository)
-> Parser
     (Maybe Permission
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Repository)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"parent")
      Parser
  (Maybe Permission
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Permission)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Permission)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"permissions")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"private")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"projects_mode")
      Parser
  (Maybe Integer
   -> Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Integer)
-> Parser
     (Maybe RepoTransfer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"release_counter")
      Parser
  (Maybe RepoTransfer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe RepoTransfer)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe RepoTransfer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"repo_transfer")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"size")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ssh_url")
      Parser
  (Maybe Integer
   -> Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Bool
      -> Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"stars_count")
      Parser
  (Maybe Bool
   -> Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe Bool)
-> Parser
     (Maybe [Text]
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"template")
      Parser
  (Maybe [Text]
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Repository)
-> Parser (Maybe [Text])
-> Parser
     (Maybe DateTime
      -> Maybe Text -> Maybe Integer -> Maybe Text -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"topics")
      Parser
  (Maybe DateTime
   -> Maybe Text -> Maybe Integer -> Maybe Text -> Repository)
-> Parser (Maybe DateTime)
-> Parser (Maybe Text -> Maybe Integer -> Maybe Text -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated_at")
      Parser (Maybe Text -> Maybe Integer -> Maybe Text -> Repository)
-> Parser (Maybe Text)
-> Parser (Maybe Integer -> Maybe Text -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")
      Parser (Maybe Integer -> Maybe Text -> Repository)
-> Parser (Maybe Integer) -> Parser (Maybe Text -> Repository)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"watchers_count")
      Parser (Maybe Text -> Repository)
-> Parser (Maybe Text) -> Parser Repository
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"website")

-- | ToJSON Repository
instance A.ToJSON Repository where
  toJSON :: Repository -> Value
toJSON Repository {Maybe Bool
Maybe Integer
Maybe [Text]
Maybe Text
Maybe DateTime
Maybe E'ObjectFormatName
Maybe User
Maybe Repository
Maybe RepoTransfer
Maybe Permission
Maybe InternalTracker
Maybe ExternalWiki
Maybe ExternalTracker
$sel:repositoryAllowFastForwardOnlyMerge:Repository :: Repository -> Maybe Bool
$sel:repositoryAllowMergeCommits:Repository :: Repository -> Maybe Bool
$sel:repositoryAllowRebase:Repository :: Repository -> Maybe Bool
$sel:repositoryAllowRebaseExplicit:Repository :: Repository -> Maybe Bool
$sel:repositoryAllowRebaseUpdate:Repository :: Repository -> Maybe Bool
$sel:repositoryAllowSquashMerge:Repository :: Repository -> Maybe Bool
$sel:repositoryArchived:Repository :: Repository -> Maybe Bool
$sel:repositoryArchivedAt:Repository :: Repository -> Maybe DateTime
$sel:repositoryAvatarUrl:Repository :: Repository -> Maybe Text
$sel:repositoryCloneUrl:Repository :: Repository -> Maybe Text
$sel:repositoryCreatedAt:Repository :: Repository -> Maybe DateTime
$sel:repositoryDefaultAllowMaintainerEdit:Repository :: Repository -> Maybe Bool
$sel:repositoryDefaultBranch:Repository :: Repository -> Maybe Text
$sel:repositoryDefaultDeleteBranchAfterMerge:Repository :: Repository -> Maybe Bool
$sel:repositoryDefaultMergeStyle:Repository :: Repository -> Maybe Text
$sel:repositoryDescription:Repository :: Repository -> Maybe Text
$sel:repositoryEmpty:Repository :: Repository -> Maybe Bool
$sel:repositoryExternalTracker:Repository :: Repository -> Maybe ExternalTracker
$sel:repositoryExternalWiki:Repository :: Repository -> Maybe ExternalWiki
$sel:repositoryFork:Repository :: Repository -> Maybe Bool
$sel:repositoryForksCount:Repository :: Repository -> Maybe Integer
$sel:repositoryFullName:Repository :: Repository -> Maybe Text
$sel:repositoryHasActions:Repository :: Repository -> Maybe Bool
$sel:repositoryHasIssues:Repository :: Repository -> Maybe Bool
$sel:repositoryHasPackages:Repository :: Repository -> Maybe Bool
$sel:repositoryHasProjects:Repository :: Repository -> Maybe Bool
$sel:repositoryHasPullRequests:Repository :: Repository -> Maybe Bool
$sel:repositoryHasReleases:Repository :: Repository -> Maybe Bool
$sel:repositoryHasWiki:Repository :: Repository -> Maybe Bool
$sel:repositoryHtmlUrl:Repository :: Repository -> Maybe Text
$sel:repositoryId:Repository :: Repository -> Maybe Integer
$sel:repositoryIgnoreWhitespaceConflicts:Repository :: Repository -> Maybe Bool
$sel:repositoryInternal:Repository :: Repository -> Maybe Bool
$sel:repositoryInternalTracker:Repository :: Repository -> Maybe InternalTracker
$sel:repositoryLanguage:Repository :: Repository -> Maybe Text
$sel:repositoryLanguagesUrl:Repository :: Repository -> Maybe Text
$sel:repositoryLicenses:Repository :: Repository -> Maybe [Text]
$sel:repositoryLink:Repository :: Repository -> Maybe Text
$sel:repositoryMirror:Repository :: Repository -> Maybe Bool
$sel:repositoryMirrorInterval:Repository :: Repository -> Maybe Text
$sel:repositoryMirrorUpdated:Repository :: Repository -> Maybe DateTime
$sel:repositoryName:Repository :: Repository -> Maybe Text
$sel:repositoryObjectFormatName:Repository :: Repository -> Maybe E'ObjectFormatName
$sel:repositoryOpenIssuesCount:Repository :: Repository -> Maybe Integer
$sel:repositoryOpenPrCounter:Repository :: Repository -> Maybe Integer
$sel:repositoryOriginalUrl:Repository :: Repository -> Maybe Text
$sel:repositoryOwner:Repository :: Repository -> Maybe User
$sel:repositoryParent:Repository :: Repository -> Maybe Repository
$sel:repositoryPermissions:Repository :: Repository -> Maybe Permission
$sel:repositoryPrivate:Repository :: Repository -> Maybe Bool
$sel:repositoryProjectsMode:Repository :: Repository -> Maybe Text
$sel:repositoryReleaseCounter:Repository :: Repository -> Maybe Integer
$sel:repositoryRepoTransfer:Repository :: Repository -> Maybe RepoTransfer
$sel:repositorySize:Repository :: Repository -> Maybe Integer
$sel:repositorySshUrl:Repository :: Repository -> Maybe Text
$sel:repositoryStarsCount:Repository :: Repository -> Maybe Integer
$sel:repositoryTemplate:Repository :: Repository -> Maybe Bool
$sel:repositoryTopics:Repository :: Repository -> Maybe [Text]
$sel:repositoryUpdatedAt:Repository :: Repository -> Maybe DateTime
$sel:repositoryUrl:Repository :: Repository -> Maybe Text
$sel:repositoryWatchersCount:Repository :: Repository -> Maybe Integer
$sel:repositoryWebsite:Repository :: Repository -> Maybe Text
repositoryAllowFastForwardOnlyMerge :: Maybe Bool
repositoryAllowMergeCommits :: Maybe Bool
repositoryAllowRebase :: Maybe Bool
repositoryAllowRebaseExplicit :: Maybe Bool
repositoryAllowRebaseUpdate :: Maybe Bool
repositoryAllowSquashMerge :: Maybe Bool
repositoryArchived :: Maybe Bool
repositoryArchivedAt :: Maybe DateTime
repositoryAvatarUrl :: Maybe Text
repositoryCloneUrl :: Maybe Text
repositoryCreatedAt :: Maybe DateTime
repositoryDefaultAllowMaintainerEdit :: Maybe Bool
repositoryDefaultBranch :: Maybe Text
repositoryDefaultDeleteBranchAfterMerge :: Maybe Bool
repositoryDefaultMergeStyle :: Maybe Text
repositoryDescription :: Maybe Text
repositoryEmpty :: Maybe Bool
repositoryExternalTracker :: Maybe ExternalTracker
repositoryExternalWiki :: Maybe ExternalWiki
repositoryFork :: Maybe Bool
repositoryForksCount :: Maybe Integer
repositoryFullName :: Maybe Text
repositoryHasActions :: Maybe Bool
repositoryHasIssues :: Maybe Bool
repositoryHasPackages :: Maybe Bool
repositoryHasProjects :: Maybe Bool
repositoryHasPullRequests :: Maybe Bool
repositoryHasReleases :: Maybe Bool
repositoryHasWiki :: Maybe Bool
repositoryHtmlUrl :: Maybe Text
repositoryId :: Maybe Integer
repositoryIgnoreWhitespaceConflicts :: Maybe Bool
repositoryInternal :: Maybe Bool
repositoryInternalTracker :: Maybe InternalTracker
repositoryLanguage :: Maybe Text
repositoryLanguagesUrl :: Maybe Text
repositoryLicenses :: Maybe [Text]
repositoryLink :: Maybe Text
repositoryMirror :: Maybe Bool
repositoryMirrorInterval :: Maybe Text
repositoryMirrorUpdated :: Maybe DateTime
repositoryName :: Maybe Text
repositoryObjectFormatName :: Maybe E'ObjectFormatName
repositoryOpenIssuesCount :: Maybe Integer
repositoryOpenPrCounter :: Maybe Integer
repositoryOriginalUrl :: Maybe Text
repositoryOwner :: Maybe User
repositoryParent :: Maybe Repository
repositoryPermissions :: Maybe Permission
repositoryPrivate :: Maybe Bool
repositoryProjectsMode :: Maybe Text
repositoryReleaseCounter :: Maybe Integer
repositoryRepoTransfer :: Maybe RepoTransfer
repositorySize :: Maybe Integer
repositorySshUrl :: Maybe Text
repositoryStarsCount :: Maybe Integer
repositoryTemplate :: Maybe Bool
repositoryTopics :: Maybe [Text]
repositoryUpdatedAt :: Maybe DateTime
repositoryUrl :: Maybe Text
repositoryWatchersCount :: Maybe Integer
repositoryWebsite :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"allow_fast_forward_only_merge" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
repositoryAllowFastForwardOnlyMerge
      , Key
"allow_merge_commits" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
repositoryAllowMergeCommits
      , Key
"allow_rebase" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
repositoryAllowRebase
      , Key
"allow_rebase_explicit" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
repositoryAllowRebaseExplicit
      , Key
"allow_rebase_update" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
repositoryAllowRebaseUpdate
      , Key
"allow_squash_merge" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
repositoryAllowSquashMerge
      , Key
"archived" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
repositoryArchived
      , Key
"archived_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
repositoryArchivedAt
      , Key
"avatar_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
repositoryAvatarUrl
      , Key
"clone_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
repositoryCloneUrl
      , Key
"created_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
repositoryCreatedAt
      , Key
"default_allow_maintainer_edit" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
repositoryDefaultAllowMaintainerEdit
      , Key
"default_branch" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
repositoryDefaultBranch
      , Key
"default_delete_branch_after_merge" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
repositoryDefaultDeleteBranchAfterMerge
      , Key
"default_merge_style" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
repositoryDefaultMergeStyle
      , Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
repositoryDescription
      , Key
"empty" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
repositoryEmpty
      , Key
"external_tracker" Key -> Maybe ExternalTracker -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe ExternalTracker
repositoryExternalTracker
      , Key
"external_wiki" Key -> Maybe ExternalWiki -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe ExternalWiki
repositoryExternalWiki
      , Key
"fork" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
repositoryFork
      , Key
"forks_count" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
repositoryForksCount
      , Key
"full_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
repositoryFullName
      , Key
"has_actions" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
repositoryHasActions
      , Key
"has_issues" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
repositoryHasIssues
      , Key
"has_packages" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
repositoryHasPackages
      , Key
"has_projects" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
repositoryHasProjects
      , Key
"has_pull_requests" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
repositoryHasPullRequests
      , Key
"has_releases" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
repositoryHasReleases
      , Key
"has_wiki" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
repositoryHasWiki
      , Key
"html_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
repositoryHtmlUrl
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
repositoryId
      , Key
"ignore_whitespace_conflicts" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
repositoryIgnoreWhitespaceConflicts
      , Key
"internal" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
repositoryInternal
      , Key
"internal_tracker" Key -> Maybe InternalTracker -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe InternalTracker
repositoryInternalTracker
      , Key
"language" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
repositoryLanguage
      , Key
"languages_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
repositoryLanguagesUrl
      , Key
"licenses" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
repositoryLicenses
      , Key
"link" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
repositoryLink
      , Key
"mirror" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
repositoryMirror
      , Key
"mirror_interval" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
repositoryMirrorInterval
      , Key
"mirror_updated" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
repositoryMirrorUpdated
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
repositoryName
      , Key
"object_format_name" Key -> Maybe E'ObjectFormatName -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe E'ObjectFormatName
repositoryObjectFormatName
      , Key
"open_issues_count" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
repositoryOpenIssuesCount
      , Key
"open_pr_counter" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
repositoryOpenPrCounter
      , Key
"original_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
repositoryOriginalUrl
      , Key
"owner" Key -> Maybe User -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe User
repositoryOwner
      , Key
"parent" Key -> Maybe Repository -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Repository
repositoryParent
      , Key
"permissions" Key -> Maybe Permission -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Permission
repositoryPermissions
      , Key
"private" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
repositoryPrivate
      , Key
"projects_mode" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
repositoryProjectsMode
      , Key
"release_counter" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
repositoryReleaseCounter
      , Key
"repo_transfer" Key -> Maybe RepoTransfer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe RepoTransfer
repositoryRepoTransfer
      , Key
"size" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
repositorySize
      , Key
"ssh_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
repositorySshUrl
      , Key
"stars_count" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
repositoryStarsCount
      , Key
"template" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
repositoryTemplate
      , Key
"topics" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
repositoryTopics
      , Key
"updated_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
repositoryUpdatedAt
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
repositoryUrl
      , Key
"watchers_count" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
repositoryWatchersCount
      , Key
"website" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
repositoryWebsite
      ]


-- | Construct a value of type 'Repository' (by applying it's required fields, if any)
mkRepository
  :: Repository
mkRepository :: Repository
mkRepository =
  Repository
  { $sel:repositoryAllowFastForwardOnlyMerge:Repository :: Maybe Bool
repositoryAllowFastForwardOnlyMerge = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:repositoryAllowMergeCommits:Repository :: Maybe Bool
repositoryAllowMergeCommits = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:repositoryAllowRebase:Repository :: Maybe Bool
repositoryAllowRebase = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:repositoryAllowRebaseExplicit:Repository :: Maybe Bool
repositoryAllowRebaseExplicit = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:repositoryAllowRebaseUpdate:Repository :: Maybe Bool
repositoryAllowRebaseUpdate = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:repositoryAllowSquashMerge:Repository :: Maybe Bool
repositoryAllowSquashMerge = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:repositoryArchived:Repository :: Maybe Bool
repositoryArchived = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:repositoryArchivedAt:Repository :: Maybe DateTime
repositoryArchivedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:repositoryAvatarUrl:Repository :: Maybe Text
repositoryAvatarUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:repositoryCloneUrl:Repository :: Maybe Text
repositoryCloneUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:repositoryCreatedAt:Repository :: Maybe DateTime
repositoryCreatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:repositoryDefaultAllowMaintainerEdit:Repository :: Maybe Bool
repositoryDefaultAllowMaintainerEdit = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:repositoryDefaultBranch:Repository :: Maybe Text
repositoryDefaultBranch = Maybe Text
forall a. Maybe a
Nothing
  , $sel:repositoryDefaultDeleteBranchAfterMerge:Repository :: Maybe Bool
repositoryDefaultDeleteBranchAfterMerge = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:repositoryDefaultMergeStyle:Repository :: Maybe Text
repositoryDefaultMergeStyle = Maybe Text
forall a. Maybe a
Nothing
  , $sel:repositoryDescription:Repository :: Maybe Text
repositoryDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:repositoryEmpty:Repository :: Maybe Bool
repositoryEmpty = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:repositoryExternalTracker:Repository :: Maybe ExternalTracker
repositoryExternalTracker = Maybe ExternalTracker
forall a. Maybe a
Nothing
  , $sel:repositoryExternalWiki:Repository :: Maybe ExternalWiki
repositoryExternalWiki = Maybe ExternalWiki
forall a. Maybe a
Nothing
  , $sel:repositoryFork:Repository :: Maybe Bool
repositoryFork = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:repositoryForksCount:Repository :: Maybe Integer
repositoryForksCount = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:repositoryFullName:Repository :: Maybe Text
repositoryFullName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:repositoryHasActions:Repository :: Maybe Bool
repositoryHasActions = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:repositoryHasIssues:Repository :: Maybe Bool
repositoryHasIssues = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:repositoryHasPackages:Repository :: Maybe Bool
repositoryHasPackages = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:repositoryHasProjects:Repository :: Maybe Bool
repositoryHasProjects = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:repositoryHasPullRequests:Repository :: Maybe Bool
repositoryHasPullRequests = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:repositoryHasReleases:Repository :: Maybe Bool
repositoryHasReleases = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:repositoryHasWiki:Repository :: Maybe Bool
repositoryHasWiki = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:repositoryHtmlUrl:Repository :: Maybe Text
repositoryHtmlUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:repositoryId:Repository :: Maybe Integer
repositoryId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:repositoryIgnoreWhitespaceConflicts:Repository :: Maybe Bool
repositoryIgnoreWhitespaceConflicts = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:repositoryInternal:Repository :: Maybe Bool
repositoryInternal = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:repositoryInternalTracker:Repository :: Maybe InternalTracker
repositoryInternalTracker = Maybe InternalTracker
forall a. Maybe a
Nothing
  , $sel:repositoryLanguage:Repository :: Maybe Text
repositoryLanguage = Maybe Text
forall a. Maybe a
Nothing
  , $sel:repositoryLanguagesUrl:Repository :: Maybe Text
repositoryLanguagesUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:repositoryLicenses:Repository :: Maybe [Text]
repositoryLicenses = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:repositoryLink:Repository :: Maybe Text
repositoryLink = Maybe Text
forall a. Maybe a
Nothing
  , $sel:repositoryMirror:Repository :: Maybe Bool
repositoryMirror = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:repositoryMirrorInterval:Repository :: Maybe Text
repositoryMirrorInterval = Maybe Text
forall a. Maybe a
Nothing
  , $sel:repositoryMirrorUpdated:Repository :: Maybe DateTime
repositoryMirrorUpdated = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:repositoryName:Repository :: Maybe Text
repositoryName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:repositoryObjectFormatName:Repository :: Maybe E'ObjectFormatName
repositoryObjectFormatName = Maybe E'ObjectFormatName
forall a. Maybe a
Nothing
  , $sel:repositoryOpenIssuesCount:Repository :: Maybe Integer
repositoryOpenIssuesCount = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:repositoryOpenPrCounter:Repository :: Maybe Integer
repositoryOpenPrCounter = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:repositoryOriginalUrl:Repository :: Maybe Text
repositoryOriginalUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:repositoryOwner:Repository :: Maybe User
repositoryOwner = Maybe User
forall a. Maybe a
Nothing
  , $sel:repositoryParent:Repository :: Maybe Repository
repositoryParent = Maybe Repository
forall a. Maybe a
Nothing
  , $sel:repositoryPermissions:Repository :: Maybe Permission
repositoryPermissions = Maybe Permission
forall a. Maybe a
Nothing
  , $sel:repositoryPrivate:Repository :: Maybe Bool
repositoryPrivate = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:repositoryProjectsMode:Repository :: Maybe Text
repositoryProjectsMode = Maybe Text
forall a. Maybe a
Nothing
  , $sel:repositoryReleaseCounter:Repository :: Maybe Integer
repositoryReleaseCounter = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:repositoryRepoTransfer:Repository :: Maybe RepoTransfer
repositoryRepoTransfer = Maybe RepoTransfer
forall a. Maybe a
Nothing
  , $sel:repositorySize:Repository :: Maybe Integer
repositorySize = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:repositorySshUrl:Repository :: Maybe Text
repositorySshUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:repositoryStarsCount:Repository :: Maybe Integer
repositoryStarsCount = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:repositoryTemplate:Repository :: Maybe Bool
repositoryTemplate = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:repositoryTopics:Repository :: Maybe [Text]
repositoryTopics = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:repositoryUpdatedAt:Repository :: Maybe DateTime
repositoryUpdatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:repositoryUrl:Repository :: Maybe Text
repositoryUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:repositoryWatchersCount:Repository :: Maybe Integer
repositoryWatchersCount = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:repositoryWebsite:Repository :: Maybe Text
repositoryWebsite = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** RepositoryMeta
-- | RepositoryMeta
-- RepositoryMeta basic repository information
data RepositoryMeta = RepositoryMeta
  { RepositoryMeta -> Maybe Text
repositoryMetaFullName :: !(Maybe Text) -- ^ "full_name"
  , RepositoryMeta -> Maybe Integer
repositoryMetaId :: !(Maybe Integer) -- ^ "id"
  , RepositoryMeta -> Maybe Text
repositoryMetaName :: !(Maybe Text) -- ^ "name"
  , RepositoryMeta -> Maybe Text
repositoryMetaOwner :: !(Maybe Text) -- ^ "owner"
  } deriving (Int -> RepositoryMeta -> ShowS
[RepositoryMeta] -> ShowS
RepositoryMeta -> [Char]
(Int -> RepositoryMeta -> ShowS)
-> (RepositoryMeta -> [Char])
-> ([RepositoryMeta] -> ShowS)
-> Show RepositoryMeta
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RepositoryMeta -> ShowS
showsPrec :: Int -> RepositoryMeta -> ShowS
$cshow :: RepositoryMeta -> [Char]
show :: RepositoryMeta -> [Char]
$cshowList :: [RepositoryMeta] -> ShowS
showList :: [RepositoryMeta] -> ShowS
P.Show, RepositoryMeta -> RepositoryMeta -> Bool
(RepositoryMeta -> RepositoryMeta -> Bool)
-> (RepositoryMeta -> RepositoryMeta -> Bool) -> Eq RepositoryMeta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RepositoryMeta -> RepositoryMeta -> Bool
== :: RepositoryMeta -> RepositoryMeta -> Bool
$c/= :: RepositoryMeta -> RepositoryMeta -> Bool
/= :: RepositoryMeta -> RepositoryMeta -> Bool
P.Eq, P.Typeable)

-- | FromJSON RepositoryMeta
instance A.FromJSON RepositoryMeta where
  parseJSON :: Value -> Parser RepositoryMeta
parseJSON = [Char]
-> (Object -> Parser RepositoryMeta)
-> Value
-> Parser RepositoryMeta
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"RepositoryMeta" ((Object -> Parser RepositoryMeta)
 -> Value -> Parser RepositoryMeta)
-> (Object -> Parser RepositoryMeta)
-> Value
-> Parser RepositoryMeta
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Integer -> Maybe Text -> Maybe Text -> RepositoryMeta
RepositoryMeta
      (Maybe Text
 -> Maybe Integer -> Maybe Text -> Maybe Text -> RepositoryMeta)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer -> Maybe Text -> Maybe Text -> RepositoryMeta)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"full_name")
      Parser
  (Maybe Integer -> Maybe Text -> Maybe Text -> RepositoryMeta)
-> Parser (Maybe Integer)
-> Parser (Maybe Text -> Maybe Text -> RepositoryMeta)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser (Maybe Text -> Maybe Text -> RepositoryMeta)
-> Parser (Maybe Text) -> Parser (Maybe Text -> RepositoryMeta)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser (Maybe Text -> RepositoryMeta)
-> Parser (Maybe Text) -> Parser RepositoryMeta
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"owner")

-- | ToJSON RepositoryMeta
instance A.ToJSON RepositoryMeta where
  toJSON :: RepositoryMeta -> Value
toJSON RepositoryMeta {Maybe Integer
Maybe Text
$sel:repositoryMetaFullName:RepositoryMeta :: RepositoryMeta -> Maybe Text
$sel:repositoryMetaId:RepositoryMeta :: RepositoryMeta -> Maybe Integer
$sel:repositoryMetaName:RepositoryMeta :: RepositoryMeta -> Maybe Text
$sel:repositoryMetaOwner:RepositoryMeta :: RepositoryMeta -> Maybe Text
repositoryMetaFullName :: Maybe Text
repositoryMetaId :: Maybe Integer
repositoryMetaName :: Maybe Text
repositoryMetaOwner :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"full_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
repositoryMetaFullName
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
repositoryMetaId
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
repositoryMetaName
      , Key
"owner" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
repositoryMetaOwner
      ]


-- | Construct a value of type 'RepositoryMeta' (by applying it's required fields, if any)
mkRepositoryMeta
  :: RepositoryMeta
mkRepositoryMeta :: RepositoryMeta
mkRepositoryMeta =
  RepositoryMeta
  { $sel:repositoryMetaFullName:RepositoryMeta :: Maybe Text
repositoryMetaFullName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:repositoryMetaId:RepositoryMeta :: Maybe Integer
repositoryMetaId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:repositoryMetaName:RepositoryMeta :: Maybe Text
repositoryMetaName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:repositoryMetaOwner:RepositoryMeta :: Maybe Text
repositoryMetaOwner = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** SearchResults
-- | SearchResults
-- SearchResults results of a successful search
data SearchResults = SearchResults
  { SearchResults -> Maybe [Repository]
searchResultsData :: !(Maybe [Repository]) -- ^ "data"
  , SearchResults -> Maybe Bool
searchResultsOk :: !(Maybe Bool) -- ^ "ok"
  } deriving (Int -> SearchResults -> ShowS
[SearchResults] -> ShowS
SearchResults -> [Char]
(Int -> SearchResults -> ShowS)
-> (SearchResults -> [Char])
-> ([SearchResults] -> ShowS)
-> Show SearchResults
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SearchResults -> ShowS
showsPrec :: Int -> SearchResults -> ShowS
$cshow :: SearchResults -> [Char]
show :: SearchResults -> [Char]
$cshowList :: [SearchResults] -> ShowS
showList :: [SearchResults] -> ShowS
P.Show, SearchResults -> SearchResults -> Bool
(SearchResults -> SearchResults -> Bool)
-> (SearchResults -> SearchResults -> Bool) -> Eq SearchResults
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SearchResults -> SearchResults -> Bool
== :: SearchResults -> SearchResults -> Bool
$c/= :: SearchResults -> SearchResults -> Bool
/= :: SearchResults -> SearchResults -> Bool
P.Eq, P.Typeable)

-- | FromJSON SearchResults
instance A.FromJSON SearchResults where
  parseJSON :: Value -> Parser SearchResults
parseJSON = [Char]
-> (Object -> Parser SearchResults)
-> Value
-> Parser SearchResults
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"SearchResults" ((Object -> Parser SearchResults) -> Value -> Parser SearchResults)
-> (Object -> Parser SearchResults)
-> Value
-> Parser SearchResults
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Repository] -> Maybe Bool -> SearchResults
SearchResults
      (Maybe [Repository] -> Maybe Bool -> SearchResults)
-> Parser (Maybe [Repository])
-> Parser (Maybe Bool -> SearchResults)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [Repository])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"data")
      Parser (Maybe Bool -> SearchResults)
-> Parser (Maybe Bool) -> Parser SearchResults
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ok")

-- | ToJSON SearchResults
instance A.ToJSON SearchResults where
  toJSON :: SearchResults -> Value
toJSON SearchResults {Maybe Bool
Maybe [Repository]
$sel:searchResultsData:SearchResults :: SearchResults -> Maybe [Repository]
$sel:searchResultsOk:SearchResults :: SearchResults -> Maybe Bool
searchResultsData :: Maybe [Repository]
searchResultsOk :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"data" Key -> Maybe [Repository] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Repository]
searchResultsData
      , Key
"ok" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
searchResultsOk
      ]


-- | Construct a value of type 'SearchResults' (by applying it's required fields, if any)
mkSearchResults
  :: SearchResults
mkSearchResults :: SearchResults
mkSearchResults =
  SearchResults
  { $sel:searchResultsData:SearchResults :: Maybe [Repository]
searchResultsData = Maybe [Repository]
forall a. Maybe a
Nothing
  , $sel:searchResultsOk:SearchResults :: Maybe Bool
searchResultsOk = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** Secret
-- | Secret
-- Secret represents a secret
data Secret = Secret
  { Secret -> Maybe DateTime
secretCreatedAt :: !(Maybe DateTime) -- ^ "created_at"
  , Secret -> Maybe Text
secretName :: !(Maybe Text) -- ^ "name" - the secret&#39;s name
  } deriving (Int -> Secret -> ShowS
[Secret] -> ShowS
Secret -> [Char]
(Int -> Secret -> ShowS)
-> (Secret -> [Char]) -> ([Secret] -> ShowS) -> Show Secret
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Secret -> ShowS
showsPrec :: Int -> Secret -> ShowS
$cshow :: Secret -> [Char]
show :: Secret -> [Char]
$cshowList :: [Secret] -> ShowS
showList :: [Secret] -> ShowS
P.Show, Secret -> Secret -> Bool
(Secret -> Secret -> Bool)
-> (Secret -> Secret -> Bool) -> Eq Secret
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Secret -> Secret -> Bool
== :: Secret -> Secret -> Bool
$c/= :: Secret -> Secret -> Bool
/= :: Secret -> Secret -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON Secret
instance A.ToJSON Secret where
  toJSON :: Secret -> Value
toJSON Secret {Maybe Text
Maybe DateTime
$sel:secretCreatedAt:Secret :: Secret -> Maybe DateTime
$sel:secretName:Secret :: Secret -> Maybe Text
secretCreatedAt :: Maybe DateTime
secretName :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
secretCreatedAt
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
secretName
      ]


-- | Construct a value of type 'Secret' (by applying it's required fields, if any)
mkSecret
  :: Secret
mkSecret :: Secret
mkSecret =
  Secret
  { $sel:secretCreatedAt:Secret :: Maybe DateTime
secretCreatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:secretName:Secret :: Maybe Text
secretName = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** ServerVersion
-- | ServerVersion
-- ServerVersion wraps the version of the server
data ServerVersion = ServerVersion
  { ServerVersion -> Maybe Text
serverVersionVersion :: !(Maybe Text) -- ^ "version"
  } deriving (Int -> ServerVersion -> ShowS
[ServerVersion] -> ShowS
ServerVersion -> [Char]
(Int -> ServerVersion -> ShowS)
-> (ServerVersion -> [Char])
-> ([ServerVersion] -> ShowS)
-> Show ServerVersion
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ServerVersion -> ShowS
showsPrec :: Int -> ServerVersion -> ShowS
$cshow :: ServerVersion -> [Char]
show :: ServerVersion -> [Char]
$cshowList :: [ServerVersion] -> ShowS
showList :: [ServerVersion] -> ShowS
P.Show, ServerVersion -> ServerVersion -> Bool
(ServerVersion -> ServerVersion -> Bool)
-> (ServerVersion -> ServerVersion -> Bool) -> Eq ServerVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ServerVersion -> ServerVersion -> Bool
== :: ServerVersion -> ServerVersion -> Bool
$c/= :: ServerVersion -> ServerVersion -> Bool
/= :: ServerVersion -> ServerVersion -> Bool
P.Eq, P.Typeable)

-- | FromJSON ServerVersion
instance A.FromJSON ServerVersion where
  parseJSON :: Value -> Parser ServerVersion
parseJSON = [Char]
-> (Object -> Parser ServerVersion)
-> Value
-> Parser ServerVersion
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"ServerVersion" ((Object -> Parser ServerVersion) -> Value -> Parser ServerVersion)
-> (Object -> Parser ServerVersion)
-> Value
-> Parser ServerVersion
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> ServerVersion
ServerVersion
      (Maybe Text -> ServerVersion)
-> Parser (Maybe Text) -> Parser ServerVersion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"version")

-- | ToJSON ServerVersion
instance A.ToJSON ServerVersion where
  toJSON :: ServerVersion -> Value
toJSON ServerVersion {Maybe Text
$sel:serverVersionVersion:ServerVersion :: ServerVersion -> Maybe Text
serverVersionVersion :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"version" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
serverVersionVersion
      ]


-- | Construct a value of type 'ServerVersion' (by applying it's required fields, if any)
mkServerVersion
  :: ServerVersion
mkServerVersion :: ServerVersion
mkServerVersion =
  ServerVersion
  { $sel:serverVersionVersion:ServerVersion :: Maybe Text
serverVersionVersion = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** StopWatch
-- | StopWatch
-- StopWatch represent a running stopwatch
data StopWatch = StopWatch
  { StopWatch -> Maybe DateTime
stopWatchCreated :: !(Maybe DateTime) -- ^ "created"
  , StopWatch -> Maybe Text
stopWatchDuration :: !(Maybe Text) -- ^ "duration"
  , StopWatch -> Maybe Integer
stopWatchIssueIndex :: !(Maybe Integer) -- ^ "issue_index"
  , StopWatch -> Maybe Text
stopWatchIssueTitle :: !(Maybe Text) -- ^ "issue_title"
  , StopWatch -> Maybe Text
stopWatchRepoName :: !(Maybe Text) -- ^ "repo_name"
  , StopWatch -> Maybe Text
stopWatchRepoOwnerName :: !(Maybe Text) -- ^ "repo_owner_name"
  , StopWatch -> Maybe Integer
stopWatchSeconds :: !(Maybe Integer) -- ^ "seconds"
  } deriving (Int -> StopWatch -> ShowS
[StopWatch] -> ShowS
StopWatch -> [Char]
(Int -> StopWatch -> ShowS)
-> (StopWatch -> [Char])
-> ([StopWatch] -> ShowS)
-> Show StopWatch
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StopWatch -> ShowS
showsPrec :: Int -> StopWatch -> ShowS
$cshow :: StopWatch -> [Char]
show :: StopWatch -> [Char]
$cshowList :: [StopWatch] -> ShowS
showList :: [StopWatch] -> ShowS
P.Show, StopWatch -> StopWatch -> Bool
(StopWatch -> StopWatch -> Bool)
-> (StopWatch -> StopWatch -> Bool) -> Eq StopWatch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StopWatch -> StopWatch -> Bool
== :: StopWatch -> StopWatch -> Bool
$c/= :: StopWatch -> StopWatch -> Bool
/= :: StopWatch -> StopWatch -> Bool
P.Eq, P.Typeable)

-- | FromJSON StopWatch
instance A.FromJSON StopWatch where
  parseJSON :: Value -> Parser StopWatch
parseJSON = [Char] -> (Object -> Parser StopWatch) -> Value -> Parser StopWatch
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"StopWatch" ((Object -> Parser StopWatch) -> Value -> Parser StopWatch)
-> (Object -> Parser StopWatch) -> Value -> Parser StopWatch
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe DateTime
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> StopWatch
StopWatch
      (Maybe DateTime
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Integer
 -> StopWatch)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> StopWatch)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> StopWatch)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> StopWatch)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"duration")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> StopWatch)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe Text -> Maybe Integer -> StopWatch)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"issue_index")
      Parser
  (Maybe Text
   -> Maybe Text -> Maybe Text -> Maybe Integer -> StopWatch)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> Maybe Integer -> StopWatch)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"issue_title")
      Parser (Maybe Text -> Maybe Text -> Maybe Integer -> StopWatch)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Integer -> StopWatch)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"repo_name")
      Parser (Maybe Text -> Maybe Integer -> StopWatch)
-> Parser (Maybe Text) -> Parser (Maybe Integer -> StopWatch)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"repo_owner_name")
      Parser (Maybe Integer -> StopWatch)
-> Parser (Maybe Integer) -> Parser StopWatch
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"seconds")

-- | ToJSON StopWatch
instance A.ToJSON StopWatch where
  toJSON :: StopWatch -> Value
toJSON StopWatch {Maybe Integer
Maybe Text
Maybe DateTime
$sel:stopWatchCreated:StopWatch :: StopWatch -> Maybe DateTime
$sel:stopWatchDuration:StopWatch :: StopWatch -> Maybe Text
$sel:stopWatchIssueIndex:StopWatch :: StopWatch -> Maybe Integer
$sel:stopWatchIssueTitle:StopWatch :: StopWatch -> Maybe Text
$sel:stopWatchRepoName:StopWatch :: StopWatch -> Maybe Text
$sel:stopWatchRepoOwnerName:StopWatch :: StopWatch -> Maybe Text
$sel:stopWatchSeconds:StopWatch :: StopWatch -> Maybe Integer
stopWatchCreated :: Maybe DateTime
stopWatchDuration :: Maybe Text
stopWatchIssueIndex :: Maybe Integer
stopWatchIssueTitle :: Maybe Text
stopWatchRepoName :: Maybe Text
stopWatchRepoOwnerName :: Maybe Text
stopWatchSeconds :: Maybe Integer
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
stopWatchCreated
      , Key
"duration" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
stopWatchDuration
      , Key
"issue_index" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
stopWatchIssueIndex
      , Key
"issue_title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
stopWatchIssueTitle
      , Key
"repo_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
stopWatchRepoName
      , Key
"repo_owner_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
stopWatchRepoOwnerName
      , Key
"seconds" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
stopWatchSeconds
      ]


-- | Construct a value of type 'StopWatch' (by applying it's required fields, if any)
mkStopWatch
  :: StopWatch
mkStopWatch :: StopWatch
mkStopWatch =
  StopWatch
  { $sel:stopWatchCreated:StopWatch :: Maybe DateTime
stopWatchCreated = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:stopWatchDuration:StopWatch :: Maybe Text
stopWatchDuration = Maybe Text
forall a. Maybe a
Nothing
  , $sel:stopWatchIssueIndex:StopWatch :: Maybe Integer
stopWatchIssueIndex = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:stopWatchIssueTitle:StopWatch :: Maybe Text
stopWatchIssueTitle = Maybe Text
forall a. Maybe a
Nothing
  , $sel:stopWatchRepoName:StopWatch :: Maybe Text
stopWatchRepoName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:stopWatchRepoOwnerName:StopWatch :: Maybe Text
stopWatchRepoOwnerName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:stopWatchSeconds:StopWatch :: Maybe Integer
stopWatchSeconds = Maybe Integer
forall a. Maybe a
Nothing
  }

-- ** SubmitPullReviewOptions
-- | SubmitPullReviewOptions
-- SubmitPullReviewOptions are options to submit a pending pull review
data SubmitPullReviewOptions = SubmitPullReviewOptions
  { SubmitPullReviewOptions -> Maybe Text
submitPullReviewOptionsBody :: !(Maybe Text) -- ^ "body"
  , SubmitPullReviewOptions -> Maybe Text
submitPullReviewOptionsEvent :: !(Maybe Text) -- ^ "event" - ReviewStateType review state type
  } deriving (Int -> SubmitPullReviewOptions -> ShowS
[SubmitPullReviewOptions] -> ShowS
SubmitPullReviewOptions -> [Char]
(Int -> SubmitPullReviewOptions -> ShowS)
-> (SubmitPullReviewOptions -> [Char])
-> ([SubmitPullReviewOptions] -> ShowS)
-> Show SubmitPullReviewOptions
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubmitPullReviewOptions -> ShowS
showsPrec :: Int -> SubmitPullReviewOptions -> ShowS
$cshow :: SubmitPullReviewOptions -> [Char]
show :: SubmitPullReviewOptions -> [Char]
$cshowList :: [SubmitPullReviewOptions] -> ShowS
showList :: [SubmitPullReviewOptions] -> ShowS
P.Show, SubmitPullReviewOptions -> SubmitPullReviewOptions -> Bool
(SubmitPullReviewOptions -> SubmitPullReviewOptions -> Bool)
-> (SubmitPullReviewOptions -> SubmitPullReviewOptions -> Bool)
-> Eq SubmitPullReviewOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubmitPullReviewOptions -> SubmitPullReviewOptions -> Bool
== :: SubmitPullReviewOptions -> SubmitPullReviewOptions -> Bool
$c/= :: SubmitPullReviewOptions -> SubmitPullReviewOptions -> Bool
/= :: SubmitPullReviewOptions -> SubmitPullReviewOptions -> Bool
P.Eq, P.Typeable)

-- | FromJSON SubmitPullReviewOptions
instance A.FromJSON SubmitPullReviewOptions where
  parseJSON :: Value -> Parser SubmitPullReviewOptions
parseJSON = [Char]
-> (Object -> Parser SubmitPullReviewOptions)
-> Value
-> Parser SubmitPullReviewOptions
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"SubmitPullReviewOptions" ((Object -> Parser SubmitPullReviewOptions)
 -> Value -> Parser SubmitPullReviewOptions)
-> (Object -> Parser SubmitPullReviewOptions)
-> Value
-> Parser SubmitPullReviewOptions
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> Maybe Text -> SubmitPullReviewOptions
SubmitPullReviewOptions
      (Maybe Text -> Maybe Text -> SubmitPullReviewOptions)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> SubmitPullReviewOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"body")
      Parser (Maybe Text -> SubmitPullReviewOptions)
-> Parser (Maybe Text) -> Parser SubmitPullReviewOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"event")

-- | ToJSON SubmitPullReviewOptions
instance A.ToJSON SubmitPullReviewOptions where
  toJSON :: SubmitPullReviewOptions -> Value
toJSON SubmitPullReviewOptions {Maybe Text
$sel:submitPullReviewOptionsBody:SubmitPullReviewOptions :: SubmitPullReviewOptions -> Maybe Text
$sel:submitPullReviewOptionsEvent:SubmitPullReviewOptions :: SubmitPullReviewOptions -> Maybe Text
submitPullReviewOptionsBody :: Maybe Text
submitPullReviewOptionsEvent :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"body" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
submitPullReviewOptionsBody
      , Key
"event" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
submitPullReviewOptionsEvent
      ]


-- | Construct a value of type 'SubmitPullReviewOptions' (by applying it's required fields, if any)
mkSubmitPullReviewOptions
  :: SubmitPullReviewOptions
mkSubmitPullReviewOptions :: SubmitPullReviewOptions
mkSubmitPullReviewOptions =
  SubmitPullReviewOptions
  { $sel:submitPullReviewOptionsBody:SubmitPullReviewOptions :: Maybe Text
submitPullReviewOptionsBody = Maybe Text
forall a. Maybe a
Nothing
  , $sel:submitPullReviewOptionsEvent:SubmitPullReviewOptions :: Maybe Text
submitPullReviewOptionsEvent = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** Tag
-- | Tag
-- Tag represents a repository tag
data Tag = Tag
  { Tag -> Maybe CommitMeta
tagCommit :: !(Maybe CommitMeta) -- ^ "commit"
  , Tag -> Maybe Text
tagId :: !(Maybe Text) -- ^ "id"
  , Tag -> Maybe Text
tagMessage :: !(Maybe Text) -- ^ "message"
  , Tag -> Maybe Text
tagName :: !(Maybe Text) -- ^ "name"
  , Tag -> Maybe Text
tagTarballUrl :: !(Maybe Text) -- ^ "tarball_url"
  , Tag -> Maybe Text
tagZipballUrl :: !(Maybe Text) -- ^ "zipball_url"
  } deriving (Int -> Tag -> ShowS
[Tag] -> ShowS
Tag -> [Char]
(Int -> Tag -> ShowS)
-> (Tag -> [Char]) -> ([Tag] -> ShowS) -> Show Tag
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tag -> ShowS
showsPrec :: Int -> Tag -> ShowS
$cshow :: Tag -> [Char]
show :: Tag -> [Char]
$cshowList :: [Tag] -> ShowS
showList :: [Tag] -> ShowS
P.Show, Tag -> Tag -> Bool
(Tag -> Tag -> Bool) -> (Tag -> Tag -> Bool) -> Eq Tag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tag -> Tag -> Bool
== :: Tag -> Tag -> Bool
$c/= :: Tag -> Tag -> Bool
/= :: Tag -> Tag -> Bool
P.Eq, P.Typeable)

-- | FromJSON Tag
instance A.FromJSON Tag where
  parseJSON :: Value -> Parser Tag
parseJSON = [Char] -> (Object -> Parser Tag) -> Value -> Parser Tag
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Tag" ((Object -> Parser Tag) -> Value -> Parser Tag)
-> (Object -> Parser Tag) -> Value -> Parser Tag
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe CommitMeta
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Tag
Tag
      (Maybe CommitMeta
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Tag)
-> Parser (Maybe CommitMeta)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Tag)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe CommitMeta)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"commit")
      Parser
  (Maybe Text
   -> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Tag)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Tag)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> Tag)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> Maybe Text -> Tag)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"message")
      Parser (Maybe Text -> Maybe Text -> Maybe Text -> Tag)
-> Parser (Maybe Text) -> Parser (Maybe Text -> Maybe Text -> Tag)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser (Maybe Text -> Maybe Text -> Tag)
-> Parser (Maybe Text) -> Parser (Maybe Text -> Tag)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tarball_url")
      Parser (Maybe Text -> Tag) -> Parser (Maybe Text) -> Parser Tag
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"zipball_url")

-- | ToJSON Tag
instance A.ToJSON Tag where
  toJSON :: Tag -> Value
toJSON Tag {Maybe Text
Maybe CommitMeta
$sel:tagCommit:Tag :: Tag -> Maybe CommitMeta
$sel:tagId:Tag :: Tag -> Maybe Text
$sel:tagMessage:Tag :: Tag -> Maybe Text
$sel:tagName:Tag :: Tag -> Maybe Text
$sel:tagTarballUrl:Tag :: Tag -> Maybe Text
$sel:tagZipballUrl:Tag :: Tag -> Maybe Text
tagCommit :: Maybe CommitMeta
tagId :: Maybe Text
tagMessage :: Maybe Text
tagName :: Maybe Text
tagTarballUrl :: Maybe Text
tagZipballUrl :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"commit" Key -> Maybe CommitMeta -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe CommitMeta
tagCommit
      , Key
"id" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
tagId
      , Key
"message" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
tagMessage
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
tagName
      , Key
"tarball_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
tagTarballUrl
      , Key
"zipball_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
tagZipballUrl
      ]


-- | Construct a value of type 'Tag' (by applying it's required fields, if any)
mkTag
  :: Tag
mkTag :: Tag
mkTag =
  Tag
  { $sel:tagCommit:Tag :: Maybe CommitMeta
tagCommit = Maybe CommitMeta
forall a. Maybe a
Nothing
  , $sel:tagId:Tag :: Maybe Text
tagId = Maybe Text
forall a. Maybe a
Nothing
  , $sel:tagMessage:Tag :: Maybe Text
tagMessage = Maybe Text
forall a. Maybe a
Nothing
  , $sel:tagName:Tag :: Maybe Text
tagName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:tagTarballUrl:Tag :: Maybe Text
tagTarballUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:tagZipballUrl:Tag :: Maybe Text
tagZipballUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** TagProtection
-- | TagProtection
-- TagProtection represents a tag protection
data TagProtection = TagProtection
  { TagProtection -> Maybe DateTime
tagProtectionCreatedAt :: !(Maybe DateTime) -- ^ "created_at"
  , TagProtection -> Maybe Integer
tagProtectionId :: !(Maybe Integer) -- ^ "id"
  , TagProtection -> Maybe Text
tagProtectionNamePattern :: !(Maybe Text) -- ^ "name_pattern"
  , TagProtection -> Maybe DateTime
tagProtectionUpdatedAt :: !(Maybe DateTime) -- ^ "updated_at"
  , TagProtection -> Maybe [Text]
tagProtectionWhitelistTeams :: !(Maybe [Text]) -- ^ "whitelist_teams"
  , TagProtection -> Maybe [Text]
tagProtectionWhitelistUsernames :: !(Maybe [Text]) -- ^ "whitelist_usernames"
  } deriving (Int -> TagProtection -> ShowS
[TagProtection] -> ShowS
TagProtection -> [Char]
(Int -> TagProtection -> ShowS)
-> (TagProtection -> [Char])
-> ([TagProtection] -> ShowS)
-> Show TagProtection
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TagProtection -> ShowS
showsPrec :: Int -> TagProtection -> ShowS
$cshow :: TagProtection -> [Char]
show :: TagProtection -> [Char]
$cshowList :: [TagProtection] -> ShowS
showList :: [TagProtection] -> ShowS
P.Show, TagProtection -> TagProtection -> Bool
(TagProtection -> TagProtection -> Bool)
-> (TagProtection -> TagProtection -> Bool) -> Eq TagProtection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TagProtection -> TagProtection -> Bool
== :: TagProtection -> TagProtection -> Bool
$c/= :: TagProtection -> TagProtection -> Bool
/= :: TagProtection -> TagProtection -> Bool
P.Eq, P.Typeable)

-- | FromJSON TagProtection
instance A.FromJSON TagProtection where
  parseJSON :: Value -> Parser TagProtection
parseJSON = [Char]
-> (Object -> Parser TagProtection)
-> Value
-> Parser TagProtection
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"TagProtection" ((Object -> Parser TagProtection) -> Value -> Parser TagProtection)
-> (Object -> Parser TagProtection)
-> Value
-> Parser TagProtection
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe DateTime
-> Maybe Integer
-> Maybe Text
-> Maybe DateTime
-> Maybe [Text]
-> Maybe [Text]
-> TagProtection
TagProtection
      (Maybe DateTime
 -> Maybe Integer
 -> Maybe Text
 -> Maybe DateTime
 -> Maybe [Text]
 -> Maybe [Text]
 -> TagProtection)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe [Text]
      -> Maybe [Text]
      -> TagProtection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_at")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe [Text]
   -> Maybe [Text]
   -> TagProtection)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe DateTime -> Maybe [Text] -> Maybe [Text] -> TagProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Text
   -> Maybe DateTime -> Maybe [Text] -> Maybe [Text] -> TagProtection)
-> Parser (Maybe Text)
-> Parser
     (Maybe DateTime -> Maybe [Text] -> Maybe [Text] -> TagProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name_pattern")
      Parser
  (Maybe DateTime -> Maybe [Text] -> Maybe [Text] -> TagProtection)
-> Parser (Maybe DateTime)
-> Parser (Maybe [Text] -> Maybe [Text] -> TagProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated_at")
      Parser (Maybe [Text] -> Maybe [Text] -> TagProtection)
-> Parser (Maybe [Text]) -> Parser (Maybe [Text] -> TagProtection)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"whitelist_teams")
      Parser (Maybe [Text] -> TagProtection)
-> Parser (Maybe [Text]) -> Parser TagProtection
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"whitelist_usernames")

-- | ToJSON TagProtection
instance A.ToJSON TagProtection where
  toJSON :: TagProtection -> Value
toJSON TagProtection {Maybe Integer
Maybe [Text]
Maybe Text
Maybe DateTime
$sel:tagProtectionCreatedAt:TagProtection :: TagProtection -> Maybe DateTime
$sel:tagProtectionId:TagProtection :: TagProtection -> Maybe Integer
$sel:tagProtectionNamePattern:TagProtection :: TagProtection -> Maybe Text
$sel:tagProtectionUpdatedAt:TagProtection :: TagProtection -> Maybe DateTime
$sel:tagProtectionWhitelistTeams:TagProtection :: TagProtection -> Maybe [Text]
$sel:tagProtectionWhitelistUsernames:TagProtection :: TagProtection -> Maybe [Text]
tagProtectionCreatedAt :: Maybe DateTime
tagProtectionId :: Maybe Integer
tagProtectionNamePattern :: Maybe Text
tagProtectionUpdatedAt :: Maybe DateTime
tagProtectionWhitelistTeams :: Maybe [Text]
tagProtectionWhitelistUsernames :: Maybe [Text]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
tagProtectionCreatedAt
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
tagProtectionId
      , Key
"name_pattern" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
tagProtectionNamePattern
      , Key
"updated_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
tagProtectionUpdatedAt
      , Key
"whitelist_teams" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
tagProtectionWhitelistTeams
      , Key
"whitelist_usernames" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
tagProtectionWhitelistUsernames
      ]


-- | Construct a value of type 'TagProtection' (by applying it's required fields, if any)
mkTagProtection
  :: TagProtection
mkTagProtection :: TagProtection
mkTagProtection =
  TagProtection
  { $sel:tagProtectionCreatedAt:TagProtection :: Maybe DateTime
tagProtectionCreatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:tagProtectionId:TagProtection :: Maybe Integer
tagProtectionId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:tagProtectionNamePattern:TagProtection :: Maybe Text
tagProtectionNamePattern = Maybe Text
forall a. Maybe a
Nothing
  , $sel:tagProtectionUpdatedAt:TagProtection :: Maybe DateTime
tagProtectionUpdatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:tagProtectionWhitelistTeams:TagProtection :: Maybe [Text]
tagProtectionWhitelistTeams = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:tagProtectionWhitelistUsernames:TagProtection :: Maybe [Text]
tagProtectionWhitelistUsernames = Maybe [Text]
forall a. Maybe a
Nothing
  }

-- ** Team
-- | Team
-- Team represents a team in an organization
data Team = Team
  { Team -> Maybe Bool
teamCanCreateOrgRepo :: !(Maybe Bool) -- ^ "can_create_org_repo"
  , Team -> Maybe Text
teamDescription :: !(Maybe Text) -- ^ "description"
  , Team -> Maybe Integer
teamId :: !(Maybe Integer) -- ^ "id"
  , Team -> Maybe Bool
teamIncludesAllRepositories :: !(Maybe Bool) -- ^ "includes_all_repositories"
  , Team -> Maybe Text
teamName :: !(Maybe Text) -- ^ "name"
  , Team -> Maybe Organization
teamOrganization :: !(Maybe Organization) -- ^ "organization"
  , Team -> Maybe E'Permission2
teamPermission :: !(Maybe E'Permission2) -- ^ "permission"
  , Team -> Maybe [Text]
teamUnits :: !(Maybe [Text]) -- ^ "units"
  , Team -> Maybe (Map [Char] Text)
teamUnitsMap :: !(Maybe (Map.Map String Text)) -- ^ "units_map"
  } deriving (Int -> Team -> ShowS
[Team] -> ShowS
Team -> [Char]
(Int -> Team -> ShowS)
-> (Team -> [Char]) -> ([Team] -> ShowS) -> Show Team
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Team -> ShowS
showsPrec :: Int -> Team -> ShowS
$cshow :: Team -> [Char]
show :: Team -> [Char]
$cshowList :: [Team] -> ShowS
showList :: [Team] -> ShowS
P.Show, Team -> Team -> Bool
(Team -> Team -> Bool) -> (Team -> Team -> Bool) -> Eq Team
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Team -> Team -> Bool
== :: Team -> Team -> Bool
$c/= :: Team -> Team -> Bool
/= :: Team -> Team -> Bool
P.Eq, P.Typeable)

-- | FromJSON Team
instance A.FromJSON Team where
  parseJSON :: Value -> Parser Team
parseJSON = [Char] -> (Object -> Parser Team) -> Value -> Parser Team
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Team" ((Object -> Parser Team) -> Value -> Parser Team)
-> (Object -> Parser Team) -> Value -> Parser Team
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool
-> Maybe Text
-> Maybe Integer
-> Maybe Bool
-> Maybe Text
-> Maybe Organization
-> Maybe E'Permission2
-> Maybe [Text]
-> Maybe (Map [Char] Text)
-> Team
Team
      (Maybe Bool
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Organization
 -> Maybe E'Permission2
 -> Maybe [Text]
 -> Maybe (Map [Char] Text)
 -> Team)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Organization
      -> Maybe E'Permission2
      -> Maybe [Text]
      -> Maybe (Map [Char] Text)
      -> Team)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"can_create_org_repo")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Organization
   -> Maybe E'Permission2
   -> Maybe [Text]
   -> Maybe (Map [Char] Text)
   -> Team)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Organization
      -> Maybe E'Permission2
      -> Maybe [Text]
      -> Maybe (Map [Char] Text)
      -> Team)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Organization
   -> Maybe E'Permission2
   -> Maybe [Text]
   -> Maybe (Map [Char] Text)
   -> Team)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Organization
      -> Maybe E'Permission2
      -> Maybe [Text]
      -> Maybe (Map [Char] Text)
      -> Team)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Organization
   -> Maybe E'Permission2
   -> Maybe [Text]
   -> Maybe (Map [Char] Text)
   -> Team)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Organization
      -> Maybe E'Permission2
      -> Maybe [Text]
      -> Maybe (Map [Char] Text)
      -> Team)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"includes_all_repositories")
      Parser
  (Maybe Text
   -> Maybe Organization
   -> Maybe E'Permission2
   -> Maybe [Text]
   -> Maybe (Map [Char] Text)
   -> Team)
-> Parser (Maybe Text)
-> Parser
     (Maybe Organization
      -> Maybe E'Permission2
      -> Maybe [Text]
      -> Maybe (Map [Char] Text)
      -> Team)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"name")
      Parser
  (Maybe Organization
   -> Maybe E'Permission2
   -> Maybe [Text]
   -> Maybe (Map [Char] Text)
   -> Team)
-> Parser (Maybe Organization)
-> Parser
     (Maybe E'Permission2
      -> Maybe [Text] -> Maybe (Map [Char] Text) -> Team)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Organization)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"organization")
      Parser
  (Maybe E'Permission2
   -> Maybe [Text] -> Maybe (Map [Char] Text) -> Team)
-> Parser (Maybe E'Permission2)
-> Parser (Maybe [Text] -> Maybe (Map [Char] Text) -> Team)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe E'Permission2)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"permission")
      Parser (Maybe [Text] -> Maybe (Map [Char] Text) -> Team)
-> Parser (Maybe [Text])
-> Parser (Maybe (Map [Char] Text) -> Team)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"units")
      Parser (Maybe (Map [Char] Text) -> Team)
-> Parser (Maybe (Map [Char] Text)) -> Parser Team
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe (Map [Char] Text))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"units_map")

-- | ToJSON Team
instance A.ToJSON Team where
  toJSON :: Team -> Value
toJSON Team {Maybe Bool
Maybe Integer
Maybe [Text]
Maybe (Map [Char] Text)
Maybe Text
Maybe E'Permission2
Maybe Organization
$sel:teamCanCreateOrgRepo:Team :: Team -> Maybe Bool
$sel:teamDescription:Team :: Team -> Maybe Text
$sel:teamId:Team :: Team -> Maybe Integer
$sel:teamIncludesAllRepositories:Team :: Team -> Maybe Bool
$sel:teamName:Team :: Team -> Maybe Text
$sel:teamOrganization:Team :: Team -> Maybe Organization
$sel:teamPermission:Team :: Team -> Maybe E'Permission2
$sel:teamUnits:Team :: Team -> Maybe [Text]
$sel:teamUnitsMap:Team :: Team -> Maybe (Map [Char] Text)
teamCanCreateOrgRepo :: Maybe Bool
teamDescription :: Maybe Text
teamId :: Maybe Integer
teamIncludesAllRepositories :: Maybe Bool
teamName :: Maybe Text
teamOrganization :: Maybe Organization
teamPermission :: Maybe E'Permission2
teamUnits :: Maybe [Text]
teamUnitsMap :: Maybe (Map [Char] Text)
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"can_create_org_repo" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
teamCanCreateOrgRepo
      , Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
teamDescription
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
teamId
      , Key
"includes_all_repositories" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
teamIncludesAllRepositories
      , Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
teamName
      , Key
"organization" Key -> Maybe Organization -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Organization
teamOrganization
      , Key
"permission" Key -> Maybe E'Permission2 -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe E'Permission2
teamPermission
      , Key
"units" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
teamUnits
      , Key
"units_map" Key -> Maybe (Map [Char] Text) -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe (Map [Char] Text)
teamUnitsMap
      ]


-- | Construct a value of type 'Team' (by applying it's required fields, if any)
mkTeam
  :: Team
mkTeam :: Team
mkTeam =
  Team
  { $sel:teamCanCreateOrgRepo:Team :: Maybe Bool
teamCanCreateOrgRepo = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:teamDescription:Team :: Maybe Text
teamDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:teamId:Team :: Maybe Integer
teamId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:teamIncludesAllRepositories:Team :: Maybe Bool
teamIncludesAllRepositories = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:teamName:Team :: Maybe Text
teamName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:teamOrganization:Team :: Maybe Organization
teamOrganization = Maybe Organization
forall a. Maybe a
Nothing
  , $sel:teamPermission:Team :: Maybe E'Permission2
teamPermission = Maybe E'Permission2
forall a. Maybe a
Nothing
  , $sel:teamUnits:Team :: Maybe [Text]
teamUnits = Maybe [Text]
forall a. Maybe a
Nothing
  , $sel:teamUnitsMap:Team :: Maybe (Map [Char] Text)
teamUnitsMap = Maybe (Map [Char] Text)
forall a. Maybe a
Nothing
  }

-- ** TeamSearch200Response
-- | TeamSearch200Response
data TeamSearch200Response = TeamSearch200Response
  { TeamSearch200Response -> Maybe [Team]
teamSearch200ResponseData :: !(Maybe [Team]) -- ^ "data"
  , TeamSearch200Response -> Maybe Bool
teamSearch200ResponseOk :: !(Maybe Bool) -- ^ "ok"
  } deriving (Int -> TeamSearch200Response -> ShowS
[TeamSearch200Response] -> ShowS
TeamSearch200Response -> [Char]
(Int -> TeamSearch200Response -> ShowS)
-> (TeamSearch200Response -> [Char])
-> ([TeamSearch200Response] -> ShowS)
-> Show TeamSearch200Response
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TeamSearch200Response -> ShowS
showsPrec :: Int -> TeamSearch200Response -> ShowS
$cshow :: TeamSearch200Response -> [Char]
show :: TeamSearch200Response -> [Char]
$cshowList :: [TeamSearch200Response] -> ShowS
showList :: [TeamSearch200Response] -> ShowS
P.Show, TeamSearch200Response -> TeamSearch200Response -> Bool
(TeamSearch200Response -> TeamSearch200Response -> Bool)
-> (TeamSearch200Response -> TeamSearch200Response -> Bool)
-> Eq TeamSearch200Response
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TeamSearch200Response -> TeamSearch200Response -> Bool
== :: TeamSearch200Response -> TeamSearch200Response -> Bool
$c/= :: TeamSearch200Response -> TeamSearch200Response -> Bool
/= :: TeamSearch200Response -> TeamSearch200Response -> Bool
P.Eq, P.Typeable)

-- | FromJSON TeamSearch200Response
instance A.FromJSON TeamSearch200Response where
  parseJSON :: Value -> Parser TeamSearch200Response
parseJSON = [Char]
-> (Object -> Parser TeamSearch200Response)
-> Value
-> Parser TeamSearch200Response
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"TeamSearch200Response" ((Object -> Parser TeamSearch200Response)
 -> Value -> Parser TeamSearch200Response)
-> (Object -> Parser TeamSearch200Response)
-> Value
-> Parser TeamSearch200Response
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Team] -> Maybe Bool -> TeamSearch200Response
TeamSearch200Response
      (Maybe [Team] -> Maybe Bool -> TeamSearch200Response)
-> Parser (Maybe [Team])
-> Parser (Maybe Bool -> TeamSearch200Response)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [Team])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"data")
      Parser (Maybe Bool -> TeamSearch200Response)
-> Parser (Maybe Bool) -> Parser TeamSearch200Response
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ok")

-- | ToJSON TeamSearch200Response
instance A.ToJSON TeamSearch200Response where
  toJSON :: TeamSearch200Response -> Value
toJSON TeamSearch200Response {Maybe Bool
Maybe [Team]
$sel:teamSearch200ResponseData:TeamSearch200Response :: TeamSearch200Response -> Maybe [Team]
$sel:teamSearch200ResponseOk:TeamSearch200Response :: TeamSearch200Response -> Maybe Bool
teamSearch200ResponseData :: Maybe [Team]
teamSearch200ResponseOk :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"data" Key -> Maybe [Team] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Team]
teamSearch200ResponseData
      , Key
"ok" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
teamSearch200ResponseOk
      ]


-- | Construct a value of type 'TeamSearch200Response' (by applying it's required fields, if any)
mkTeamSearch200Response
  :: TeamSearch200Response
mkTeamSearch200Response :: TeamSearch200Response
mkTeamSearch200Response =
  TeamSearch200Response
  { $sel:teamSearch200ResponseData:TeamSearch200Response :: Maybe [Team]
teamSearch200ResponseData = Maybe [Team]
forall a. Maybe a
Nothing
  , $sel:teamSearch200ResponseOk:TeamSearch200Response :: Maybe Bool
teamSearch200ResponseOk = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** TimelineComment
-- | TimelineComment
-- TimelineComment represents a timeline comment (comment of any type) on a commit or issue
data TimelineComment = TimelineComment
  { TimelineComment -> Maybe User
timelineCommentAssignee :: !(Maybe User) -- ^ "assignee"
  , TimelineComment -> Maybe Team
timelineCommentAssigneeTeam :: !(Maybe Team) -- ^ "assignee_team"
  , TimelineComment -> Maybe Text
timelineCommentBody :: !(Maybe Text) -- ^ "body"
  , TimelineComment -> Maybe DateTime
timelineCommentCreatedAt :: !(Maybe DateTime) -- ^ "created_at"
  , TimelineComment -> Maybe Issue
timelineCommentDependentIssue :: !(Maybe Issue) -- ^ "dependent_issue"
  , TimelineComment -> Maybe Text
timelineCommentHtmlUrl :: !(Maybe Text) -- ^ "html_url"
  , TimelineComment -> Maybe Integer
timelineCommentId :: !(Maybe Integer) -- ^ "id"
  , TimelineComment -> Maybe Text
timelineCommentIssueUrl :: !(Maybe Text) -- ^ "issue_url"
  , TimelineComment -> Maybe Label
timelineCommentLabel :: !(Maybe Label) -- ^ "label"
  , TimelineComment -> Maybe Milestone
timelineCommentMilestone :: !(Maybe Milestone) -- ^ "milestone"
  , TimelineComment -> Maybe Text
timelineCommentNewRef :: !(Maybe Text) -- ^ "new_ref"
  , TimelineComment -> Maybe Text
timelineCommentNewTitle :: !(Maybe Text) -- ^ "new_title"
  , TimelineComment -> Maybe Milestone
timelineCommentOldMilestone :: !(Maybe Milestone) -- ^ "old_milestone"
  , TimelineComment -> Maybe Integer
timelineCommentOldProjectId :: !(Maybe Integer) -- ^ "old_project_id"
  , TimelineComment -> Maybe Text
timelineCommentOldRef :: !(Maybe Text) -- ^ "old_ref"
  , TimelineComment -> Maybe Text
timelineCommentOldTitle :: !(Maybe Text) -- ^ "old_title"
  , TimelineComment -> Maybe Integer
timelineCommentProjectId :: !(Maybe Integer) -- ^ "project_id"
  , TimelineComment -> Maybe Text
timelineCommentPullRequestUrl :: !(Maybe Text) -- ^ "pull_request_url"
  , TimelineComment -> Maybe Text
timelineCommentRefAction :: !(Maybe Text) -- ^ "ref_action"
  , TimelineComment -> Maybe Comment
timelineCommentRefComment :: !(Maybe Comment) -- ^ "ref_comment"
  , TimelineComment -> Maybe Text
timelineCommentRefCommitSha :: !(Maybe Text) -- ^ "ref_commit_sha" - commit SHA where issue/PR was referenced
  , TimelineComment -> Maybe Issue
timelineCommentRefIssue :: !(Maybe Issue) -- ^ "ref_issue"
  , TimelineComment -> Maybe Bool
timelineCommentRemovedAssignee :: !(Maybe Bool) -- ^ "removed_assignee" - whether the assignees were removed or added
  , TimelineComment -> Maybe User
timelineCommentResolveDoer :: !(Maybe User) -- ^ "resolve_doer"
  , TimelineComment -> Maybe Integer
timelineCommentReviewId :: !(Maybe Integer) -- ^ "review_id"
  , TimelineComment -> Maybe TrackedTime
timelineCommentTrackedTime :: !(Maybe TrackedTime) -- ^ "tracked_time"
  , TimelineComment -> Maybe Text
timelineCommentType :: !(Maybe Text) -- ^ "type"
  , TimelineComment -> Maybe DateTime
timelineCommentUpdatedAt :: !(Maybe DateTime) -- ^ "updated_at"
  , TimelineComment -> Maybe User
timelineCommentUser :: !(Maybe User) -- ^ "user"
  } deriving (Int -> TimelineComment -> ShowS
[TimelineComment] -> ShowS
TimelineComment -> [Char]
(Int -> TimelineComment -> ShowS)
-> (TimelineComment -> [Char])
-> ([TimelineComment] -> ShowS)
-> Show TimelineComment
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TimelineComment -> ShowS
showsPrec :: Int -> TimelineComment -> ShowS
$cshow :: TimelineComment -> [Char]
show :: TimelineComment -> [Char]
$cshowList :: [TimelineComment] -> ShowS
showList :: [TimelineComment] -> ShowS
P.Show, TimelineComment -> TimelineComment -> Bool
(TimelineComment -> TimelineComment -> Bool)
-> (TimelineComment -> TimelineComment -> Bool)
-> Eq TimelineComment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimelineComment -> TimelineComment -> Bool
== :: TimelineComment -> TimelineComment -> Bool
$c/= :: TimelineComment -> TimelineComment -> Bool
/= :: TimelineComment -> TimelineComment -> Bool
P.Eq, P.Typeable)

-- | FromJSON TimelineComment
instance A.FromJSON TimelineComment where
  parseJSON :: Value -> Parser TimelineComment
parseJSON = [Char]
-> (Object -> Parser TimelineComment)
-> Value
-> Parser TimelineComment
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"TimelineComment" ((Object -> Parser TimelineComment)
 -> Value -> Parser TimelineComment)
-> (Object -> Parser TimelineComment)
-> Value
-> Parser TimelineComment
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe User
-> Maybe Team
-> Maybe Text
-> Maybe DateTime
-> Maybe Issue
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe Label
-> Maybe Milestone
-> Maybe Text
-> Maybe Text
-> Maybe Milestone
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Comment
-> Maybe Text
-> Maybe Issue
-> Maybe Bool
-> Maybe User
-> Maybe Integer
-> Maybe TrackedTime
-> Maybe Text
-> Maybe DateTime
-> Maybe User
-> TimelineComment
TimelineComment
      (Maybe User
 -> Maybe Team
 -> Maybe Text
 -> Maybe DateTime
 -> Maybe Issue
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Label
 -> Maybe Milestone
 -> Maybe Text
 -> Maybe Text
 -> Maybe Milestone
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Text
 -> Maybe Comment
 -> Maybe Text
 -> Maybe Issue
 -> Maybe Bool
 -> Maybe User
 -> Maybe Integer
 -> Maybe TrackedTime
 -> Maybe Text
 -> Maybe DateTime
 -> Maybe User
 -> TimelineComment)
-> Parser (Maybe User)
-> Parser
     (Maybe Team
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Issue
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Label
      -> Maybe Milestone
      -> Maybe Text
      -> Maybe Text
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Comment
      -> Maybe Text
      -> Maybe Issue
      -> Maybe Bool
      -> Maybe User
      -> Maybe Integer
      -> Maybe TrackedTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> TimelineComment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"assignee")
      Parser
  (Maybe Team
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Issue
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Label
   -> Maybe Milestone
   -> Maybe Text
   -> Maybe Text
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Comment
   -> Maybe Text
   -> Maybe Issue
   -> Maybe Bool
   -> Maybe User
   -> Maybe Integer
   -> Maybe TrackedTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> TimelineComment)
-> Parser (Maybe Team)
-> Parser
     (Maybe Text
      -> Maybe DateTime
      -> Maybe Issue
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Label
      -> Maybe Milestone
      -> Maybe Text
      -> Maybe Text
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Comment
      -> Maybe Text
      -> Maybe Issue
      -> Maybe Bool
      -> Maybe User
      -> Maybe Integer
      -> Maybe TrackedTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Team)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"assignee_team")
      Parser
  (Maybe Text
   -> Maybe DateTime
   -> Maybe Issue
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Label
   -> Maybe Milestone
   -> Maybe Text
   -> Maybe Text
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Comment
   -> Maybe Text
   -> Maybe Issue
   -> Maybe Bool
   -> Maybe User
   -> Maybe Integer
   -> Maybe TrackedTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> TimelineComment)
-> Parser (Maybe Text)
-> Parser
     (Maybe DateTime
      -> Maybe Issue
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Label
      -> Maybe Milestone
      -> Maybe Text
      -> Maybe Text
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Comment
      -> Maybe Text
      -> Maybe Issue
      -> Maybe Bool
      -> Maybe User
      -> Maybe Integer
      -> Maybe TrackedTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"body")
      Parser
  (Maybe DateTime
   -> Maybe Issue
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Label
   -> Maybe Milestone
   -> Maybe Text
   -> Maybe Text
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Comment
   -> Maybe Text
   -> Maybe Issue
   -> Maybe Bool
   -> Maybe User
   -> Maybe Integer
   -> Maybe TrackedTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> TimelineComment)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Issue
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Label
      -> Maybe Milestone
      -> Maybe Text
      -> Maybe Text
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Comment
      -> Maybe Text
      -> Maybe Issue
      -> Maybe Bool
      -> Maybe User
      -> Maybe Integer
      -> Maybe TrackedTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_at")
      Parser
  (Maybe Issue
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Label
   -> Maybe Milestone
   -> Maybe Text
   -> Maybe Text
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Comment
   -> Maybe Text
   -> Maybe Issue
   -> Maybe Bool
   -> Maybe User
   -> Maybe Integer
   -> Maybe TrackedTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> TimelineComment)
-> Parser (Maybe Issue)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Label
      -> Maybe Milestone
      -> Maybe Text
      -> Maybe Text
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Comment
      -> Maybe Text
      -> Maybe Issue
      -> Maybe Bool
      -> Maybe User
      -> Maybe Integer
      -> Maybe TrackedTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Issue)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"dependent_issue")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Label
   -> Maybe Milestone
   -> Maybe Text
   -> Maybe Text
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Comment
   -> Maybe Text
   -> Maybe Issue
   -> Maybe Bool
   -> Maybe User
   -> Maybe Integer
   -> Maybe TrackedTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> TimelineComment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Label
      -> Maybe Milestone
      -> Maybe Text
      -> Maybe Text
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Comment
      -> Maybe Text
      -> Maybe Issue
      -> Maybe Bool
      -> Maybe User
      -> Maybe Integer
      -> Maybe TrackedTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"html_url")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Label
   -> Maybe Milestone
   -> Maybe Text
   -> Maybe Text
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Comment
   -> Maybe Text
   -> Maybe Issue
   -> Maybe Bool
   -> Maybe User
   -> Maybe Integer
   -> Maybe TrackedTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> TimelineComment)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Label
      -> Maybe Milestone
      -> Maybe Text
      -> Maybe Text
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Comment
      -> Maybe Text
      -> Maybe Issue
      -> Maybe Bool
      -> Maybe User
      -> Maybe Integer
      -> Maybe TrackedTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Text
   -> Maybe Label
   -> Maybe Milestone
   -> Maybe Text
   -> Maybe Text
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Comment
   -> Maybe Text
   -> Maybe Issue
   -> Maybe Bool
   -> Maybe User
   -> Maybe Integer
   -> Maybe TrackedTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> TimelineComment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Label
      -> Maybe Milestone
      -> Maybe Text
      -> Maybe Text
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Comment
      -> Maybe Text
      -> Maybe Issue
      -> Maybe Bool
      -> Maybe User
      -> Maybe Integer
      -> Maybe TrackedTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"issue_url")
      Parser
  (Maybe Label
   -> Maybe Milestone
   -> Maybe Text
   -> Maybe Text
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Comment
   -> Maybe Text
   -> Maybe Issue
   -> Maybe Bool
   -> Maybe User
   -> Maybe Integer
   -> Maybe TrackedTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> TimelineComment)
-> Parser (Maybe Label)
-> Parser
     (Maybe Milestone
      -> Maybe Text
      -> Maybe Text
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Comment
      -> Maybe Text
      -> Maybe Issue
      -> Maybe Bool
      -> Maybe User
      -> Maybe Integer
      -> Maybe TrackedTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Label)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"label")
      Parser
  (Maybe Milestone
   -> Maybe Text
   -> Maybe Text
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Comment
   -> Maybe Text
   -> Maybe Issue
   -> Maybe Bool
   -> Maybe User
   -> Maybe Integer
   -> Maybe TrackedTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> TimelineComment)
-> Parser (Maybe Milestone)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Comment
      -> Maybe Text
      -> Maybe Issue
      -> Maybe Bool
      -> Maybe User
      -> Maybe Integer
      -> Maybe TrackedTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Milestone)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"milestone")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Comment
   -> Maybe Text
   -> Maybe Issue
   -> Maybe Bool
   -> Maybe User
   -> Maybe Integer
   -> Maybe TrackedTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> TimelineComment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Comment
      -> Maybe Text
      -> Maybe Issue
      -> Maybe Bool
      -> Maybe User
      -> Maybe Integer
      -> Maybe TrackedTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"new_ref")
      Parser
  (Maybe Text
   -> Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Comment
   -> Maybe Text
   -> Maybe Issue
   -> Maybe Bool
   -> Maybe User
   -> Maybe Integer
   -> Maybe TrackedTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> TimelineComment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Milestone
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Comment
      -> Maybe Text
      -> Maybe Issue
      -> Maybe Bool
      -> Maybe User
      -> Maybe Integer
      -> Maybe TrackedTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"new_title")
      Parser
  (Maybe Milestone
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Comment
   -> Maybe Text
   -> Maybe Issue
   -> Maybe Bool
   -> Maybe User
   -> Maybe Integer
   -> Maybe TrackedTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> TimelineComment)
-> Parser (Maybe Milestone)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Comment
      -> Maybe Text
      -> Maybe Issue
      -> Maybe Bool
      -> Maybe User
      -> Maybe Integer
      -> Maybe TrackedTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Milestone)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"old_milestone")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Comment
   -> Maybe Text
   -> Maybe Issue
   -> Maybe Bool
   -> Maybe User
   -> Maybe Integer
   -> Maybe TrackedTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> TimelineComment)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Comment
      -> Maybe Text
      -> Maybe Issue
      -> Maybe Bool
      -> Maybe User
      -> Maybe Integer
      -> Maybe TrackedTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"old_project_id")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Comment
   -> Maybe Text
   -> Maybe Issue
   -> Maybe Bool
   -> Maybe User
   -> Maybe Integer
   -> Maybe TrackedTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> TimelineComment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Comment
      -> Maybe Text
      -> Maybe Issue
      -> Maybe Bool
      -> Maybe User
      -> Maybe Integer
      -> Maybe TrackedTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"old_ref")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Comment
   -> Maybe Text
   -> Maybe Issue
   -> Maybe Bool
   -> Maybe User
   -> Maybe Integer
   -> Maybe TrackedTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> TimelineComment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Comment
      -> Maybe Text
      -> Maybe Issue
      -> Maybe Bool
      -> Maybe User
      -> Maybe Integer
      -> Maybe TrackedTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"old_title")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Comment
   -> Maybe Text
   -> Maybe Issue
   -> Maybe Bool
   -> Maybe User
   -> Maybe Integer
   -> Maybe TrackedTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> TimelineComment)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Comment
      -> Maybe Text
      -> Maybe Issue
      -> Maybe Bool
      -> Maybe User
      -> Maybe Integer
      -> Maybe TrackedTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"project_id")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Comment
   -> Maybe Text
   -> Maybe Issue
   -> Maybe Bool
   -> Maybe User
   -> Maybe Integer
   -> Maybe TrackedTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> TimelineComment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Comment
      -> Maybe Text
      -> Maybe Issue
      -> Maybe Bool
      -> Maybe User
      -> Maybe Integer
      -> Maybe TrackedTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pull_request_url")
      Parser
  (Maybe Text
   -> Maybe Comment
   -> Maybe Text
   -> Maybe Issue
   -> Maybe Bool
   -> Maybe User
   -> Maybe Integer
   -> Maybe TrackedTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> TimelineComment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Comment
      -> Maybe Text
      -> Maybe Issue
      -> Maybe Bool
      -> Maybe User
      -> Maybe Integer
      -> Maybe TrackedTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ref_action")
      Parser
  (Maybe Comment
   -> Maybe Text
   -> Maybe Issue
   -> Maybe Bool
   -> Maybe User
   -> Maybe Integer
   -> Maybe TrackedTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> TimelineComment)
-> Parser (Maybe Comment)
-> Parser
     (Maybe Text
      -> Maybe Issue
      -> Maybe Bool
      -> Maybe User
      -> Maybe Integer
      -> Maybe TrackedTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Comment)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ref_comment")
      Parser
  (Maybe Text
   -> Maybe Issue
   -> Maybe Bool
   -> Maybe User
   -> Maybe Integer
   -> Maybe TrackedTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> TimelineComment)
-> Parser (Maybe Text)
-> Parser
     (Maybe Issue
      -> Maybe Bool
      -> Maybe User
      -> Maybe Integer
      -> Maybe TrackedTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ref_commit_sha")
      Parser
  (Maybe Issue
   -> Maybe Bool
   -> Maybe User
   -> Maybe Integer
   -> Maybe TrackedTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> TimelineComment)
-> Parser (Maybe Issue)
-> Parser
     (Maybe Bool
      -> Maybe User
      -> Maybe Integer
      -> Maybe TrackedTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Issue)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ref_issue")
      Parser
  (Maybe Bool
   -> Maybe User
   -> Maybe Integer
   -> Maybe TrackedTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> TimelineComment)
-> Parser (Maybe Bool)
-> Parser
     (Maybe User
      -> Maybe Integer
      -> Maybe TrackedTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"removed_assignee")
      Parser
  (Maybe User
   -> Maybe Integer
   -> Maybe TrackedTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> TimelineComment)
-> Parser (Maybe User)
-> Parser
     (Maybe Integer
      -> Maybe TrackedTime
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe User
      -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"resolve_doer")
      Parser
  (Maybe Integer
   -> Maybe TrackedTime
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe User
   -> TimelineComment)
-> Parser (Maybe Integer)
-> Parser
     (Maybe TrackedTime
      -> Maybe Text -> Maybe DateTime -> Maybe User -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"review_id")
      Parser
  (Maybe TrackedTime
   -> Maybe Text -> Maybe DateTime -> Maybe User -> TimelineComment)
-> Parser (Maybe TrackedTime)
-> Parser
     (Maybe Text -> Maybe DateTime -> Maybe User -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe TrackedTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"tracked_time")
      Parser
  (Maybe Text -> Maybe DateTime -> Maybe User -> TimelineComment)
-> Parser (Maybe Text)
-> Parser (Maybe DateTime -> Maybe User -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"type")
      Parser (Maybe DateTime -> Maybe User -> TimelineComment)
-> Parser (Maybe DateTime)
-> Parser (Maybe User -> TimelineComment)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated_at")
      Parser (Maybe User -> TimelineComment)
-> Parser (Maybe User) -> Parser TimelineComment
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe User)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user")

-- | ToJSON TimelineComment
instance A.ToJSON TimelineComment where
  toJSON :: TimelineComment -> Value
toJSON TimelineComment {Maybe Bool
Maybe Integer
Maybe Text
Maybe DateTime
Maybe User
Maybe TrackedTime
Maybe Team
Maybe Milestone
Maybe Label
Maybe Issue
Maybe Comment
$sel:timelineCommentAssignee:TimelineComment :: TimelineComment -> Maybe User
$sel:timelineCommentAssigneeTeam:TimelineComment :: TimelineComment -> Maybe Team
$sel:timelineCommentBody:TimelineComment :: TimelineComment -> Maybe Text
$sel:timelineCommentCreatedAt:TimelineComment :: TimelineComment -> Maybe DateTime
$sel:timelineCommentDependentIssue:TimelineComment :: TimelineComment -> Maybe Issue
$sel:timelineCommentHtmlUrl:TimelineComment :: TimelineComment -> Maybe Text
$sel:timelineCommentId:TimelineComment :: TimelineComment -> Maybe Integer
$sel:timelineCommentIssueUrl:TimelineComment :: TimelineComment -> Maybe Text
$sel:timelineCommentLabel:TimelineComment :: TimelineComment -> Maybe Label
$sel:timelineCommentMilestone:TimelineComment :: TimelineComment -> Maybe Milestone
$sel:timelineCommentNewRef:TimelineComment :: TimelineComment -> Maybe Text
$sel:timelineCommentNewTitle:TimelineComment :: TimelineComment -> Maybe Text
$sel:timelineCommentOldMilestone:TimelineComment :: TimelineComment -> Maybe Milestone
$sel:timelineCommentOldProjectId:TimelineComment :: TimelineComment -> Maybe Integer
$sel:timelineCommentOldRef:TimelineComment :: TimelineComment -> Maybe Text
$sel:timelineCommentOldTitle:TimelineComment :: TimelineComment -> Maybe Text
$sel:timelineCommentProjectId:TimelineComment :: TimelineComment -> Maybe Integer
$sel:timelineCommentPullRequestUrl:TimelineComment :: TimelineComment -> Maybe Text
$sel:timelineCommentRefAction:TimelineComment :: TimelineComment -> Maybe Text
$sel:timelineCommentRefComment:TimelineComment :: TimelineComment -> Maybe Comment
$sel:timelineCommentRefCommitSha:TimelineComment :: TimelineComment -> Maybe Text
$sel:timelineCommentRefIssue:TimelineComment :: TimelineComment -> Maybe Issue
$sel:timelineCommentRemovedAssignee:TimelineComment :: TimelineComment -> Maybe Bool
$sel:timelineCommentResolveDoer:TimelineComment :: TimelineComment -> Maybe User
$sel:timelineCommentReviewId:TimelineComment :: TimelineComment -> Maybe Integer
$sel:timelineCommentTrackedTime:TimelineComment :: TimelineComment -> Maybe TrackedTime
$sel:timelineCommentType:TimelineComment :: TimelineComment -> Maybe Text
$sel:timelineCommentUpdatedAt:TimelineComment :: TimelineComment -> Maybe DateTime
$sel:timelineCommentUser:TimelineComment :: TimelineComment -> Maybe User
timelineCommentAssignee :: Maybe User
timelineCommentAssigneeTeam :: Maybe Team
timelineCommentBody :: Maybe Text
timelineCommentCreatedAt :: Maybe DateTime
timelineCommentDependentIssue :: Maybe Issue
timelineCommentHtmlUrl :: Maybe Text
timelineCommentId :: Maybe Integer
timelineCommentIssueUrl :: Maybe Text
timelineCommentLabel :: Maybe Label
timelineCommentMilestone :: Maybe Milestone
timelineCommentNewRef :: Maybe Text
timelineCommentNewTitle :: Maybe Text
timelineCommentOldMilestone :: Maybe Milestone
timelineCommentOldProjectId :: Maybe Integer
timelineCommentOldRef :: Maybe Text
timelineCommentOldTitle :: Maybe Text
timelineCommentProjectId :: Maybe Integer
timelineCommentPullRequestUrl :: Maybe Text
timelineCommentRefAction :: Maybe Text
timelineCommentRefComment :: Maybe Comment
timelineCommentRefCommitSha :: Maybe Text
timelineCommentRefIssue :: Maybe Issue
timelineCommentRemovedAssignee :: Maybe Bool
timelineCommentResolveDoer :: Maybe User
timelineCommentReviewId :: Maybe Integer
timelineCommentTrackedTime :: Maybe TrackedTime
timelineCommentType :: Maybe Text
timelineCommentUpdatedAt :: Maybe DateTime
timelineCommentUser :: Maybe User
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"assignee" Key -> Maybe User -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe User
timelineCommentAssignee
      , Key
"assignee_team" Key -> Maybe Team -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Team
timelineCommentAssigneeTeam
      , Key
"body" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
timelineCommentBody
      , Key
"created_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
timelineCommentCreatedAt
      , Key
"dependent_issue" Key -> Maybe Issue -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Issue
timelineCommentDependentIssue
      , Key
"html_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
timelineCommentHtmlUrl
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
timelineCommentId
      , Key
"issue_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
timelineCommentIssueUrl
      , Key
"label" Key -> Maybe Label -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Label
timelineCommentLabel
      , Key
"milestone" Key -> Maybe Milestone -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Milestone
timelineCommentMilestone
      , Key
"new_ref" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
timelineCommentNewRef
      , Key
"new_title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
timelineCommentNewTitle
      , Key
"old_milestone" Key -> Maybe Milestone -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Milestone
timelineCommentOldMilestone
      , Key
"old_project_id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
timelineCommentOldProjectId
      , Key
"old_ref" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
timelineCommentOldRef
      , Key
"old_title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
timelineCommentOldTitle
      , Key
"project_id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
timelineCommentProjectId
      , Key
"pull_request_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
timelineCommentPullRequestUrl
      , Key
"ref_action" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
timelineCommentRefAction
      , Key
"ref_comment" Key -> Maybe Comment -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Comment
timelineCommentRefComment
      , Key
"ref_commit_sha" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
timelineCommentRefCommitSha
      , Key
"ref_issue" Key -> Maybe Issue -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Issue
timelineCommentRefIssue
      , Key
"removed_assignee" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
timelineCommentRemovedAssignee
      , Key
"resolve_doer" Key -> Maybe User -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe User
timelineCommentResolveDoer
      , Key
"review_id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
timelineCommentReviewId
      , Key
"tracked_time" Key -> Maybe TrackedTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe TrackedTime
timelineCommentTrackedTime
      , Key
"type" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
timelineCommentType
      , Key
"updated_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
timelineCommentUpdatedAt
      , Key
"user" Key -> Maybe User -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe User
timelineCommentUser
      ]


-- | Construct a value of type 'TimelineComment' (by applying it's required fields, if any)
mkTimelineComment
  :: TimelineComment
mkTimelineComment :: TimelineComment
mkTimelineComment =
  TimelineComment
  { $sel:timelineCommentAssignee:TimelineComment :: Maybe User
timelineCommentAssignee = Maybe User
forall a. Maybe a
Nothing
  , $sel:timelineCommentAssigneeTeam:TimelineComment :: Maybe Team
timelineCommentAssigneeTeam = Maybe Team
forall a. Maybe a
Nothing
  , $sel:timelineCommentBody:TimelineComment :: Maybe Text
timelineCommentBody = Maybe Text
forall a. Maybe a
Nothing
  , $sel:timelineCommentCreatedAt:TimelineComment :: Maybe DateTime
timelineCommentCreatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:timelineCommentDependentIssue:TimelineComment :: Maybe Issue
timelineCommentDependentIssue = Maybe Issue
forall a. Maybe a
Nothing
  , $sel:timelineCommentHtmlUrl:TimelineComment :: Maybe Text
timelineCommentHtmlUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:timelineCommentId:TimelineComment :: Maybe Integer
timelineCommentId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:timelineCommentIssueUrl:TimelineComment :: Maybe Text
timelineCommentIssueUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:timelineCommentLabel:TimelineComment :: Maybe Label
timelineCommentLabel = Maybe Label
forall a. Maybe a
Nothing
  , $sel:timelineCommentMilestone:TimelineComment :: Maybe Milestone
timelineCommentMilestone = Maybe Milestone
forall a. Maybe a
Nothing
  , $sel:timelineCommentNewRef:TimelineComment :: Maybe Text
timelineCommentNewRef = Maybe Text
forall a. Maybe a
Nothing
  , $sel:timelineCommentNewTitle:TimelineComment :: Maybe Text
timelineCommentNewTitle = Maybe Text
forall a. Maybe a
Nothing
  , $sel:timelineCommentOldMilestone:TimelineComment :: Maybe Milestone
timelineCommentOldMilestone = Maybe Milestone
forall a. Maybe a
Nothing
  , $sel:timelineCommentOldProjectId:TimelineComment :: Maybe Integer
timelineCommentOldProjectId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:timelineCommentOldRef:TimelineComment :: Maybe Text
timelineCommentOldRef = Maybe Text
forall a. Maybe a
Nothing
  , $sel:timelineCommentOldTitle:TimelineComment :: Maybe Text
timelineCommentOldTitle = Maybe Text
forall a. Maybe a
Nothing
  , $sel:timelineCommentProjectId:TimelineComment :: Maybe Integer
timelineCommentProjectId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:timelineCommentPullRequestUrl:TimelineComment :: Maybe Text
timelineCommentPullRequestUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:timelineCommentRefAction:TimelineComment :: Maybe Text
timelineCommentRefAction = Maybe Text
forall a. Maybe a
Nothing
  , $sel:timelineCommentRefComment:TimelineComment :: Maybe Comment
timelineCommentRefComment = Maybe Comment
forall a. Maybe a
Nothing
  , $sel:timelineCommentRefCommitSha:TimelineComment :: Maybe Text
timelineCommentRefCommitSha = Maybe Text
forall a. Maybe a
Nothing
  , $sel:timelineCommentRefIssue:TimelineComment :: Maybe Issue
timelineCommentRefIssue = Maybe Issue
forall a. Maybe a
Nothing
  , $sel:timelineCommentRemovedAssignee:TimelineComment :: Maybe Bool
timelineCommentRemovedAssignee = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:timelineCommentResolveDoer:TimelineComment :: Maybe User
timelineCommentResolveDoer = Maybe User
forall a. Maybe a
Nothing
  , $sel:timelineCommentReviewId:TimelineComment :: Maybe Integer
timelineCommentReviewId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:timelineCommentTrackedTime:TimelineComment :: Maybe TrackedTime
timelineCommentTrackedTime = Maybe TrackedTime
forall a. Maybe a
Nothing
  , $sel:timelineCommentType:TimelineComment :: Maybe Text
timelineCommentType = Maybe Text
forall a. Maybe a
Nothing
  , $sel:timelineCommentUpdatedAt:TimelineComment :: Maybe DateTime
timelineCommentUpdatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:timelineCommentUser:TimelineComment :: Maybe User
timelineCommentUser = Maybe User
forall a. Maybe a
Nothing
  }

-- ** TopicName
-- | TopicName
-- TopicName a list of repo topic names
data TopicName = TopicName
  { TopicName -> Maybe [Text]
topicNameTopics :: !(Maybe [Text]) -- ^ "topics"
  } deriving (Int -> TopicName -> ShowS
[TopicName] -> ShowS
TopicName -> [Char]
(Int -> TopicName -> ShowS)
-> (TopicName -> [Char])
-> ([TopicName] -> ShowS)
-> Show TopicName
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TopicName -> ShowS
showsPrec :: Int -> TopicName -> ShowS
$cshow :: TopicName -> [Char]
show :: TopicName -> [Char]
$cshowList :: [TopicName] -> ShowS
showList :: [TopicName] -> ShowS
P.Show, TopicName -> TopicName -> Bool
(TopicName -> TopicName -> Bool)
-> (TopicName -> TopicName -> Bool) -> Eq TopicName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TopicName -> TopicName -> Bool
== :: TopicName -> TopicName -> Bool
$c/= :: TopicName -> TopicName -> Bool
/= :: TopicName -> TopicName -> Bool
P.Eq, P.Typeable)

-- | FromJSON TopicName
instance A.FromJSON TopicName where
  parseJSON :: Value -> Parser TopicName
parseJSON = [Char] -> (Object -> Parser TopicName) -> Value -> Parser TopicName
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"TopicName" ((Object -> Parser TopicName) -> Value -> Parser TopicName)
-> (Object -> Parser TopicName) -> Value -> Parser TopicName
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Text] -> TopicName
TopicName
      (Maybe [Text] -> TopicName)
-> Parser (Maybe [Text]) -> Parser TopicName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"topics")

-- | ToJSON TopicName
instance A.ToJSON TopicName where
  toJSON :: TopicName -> Value
toJSON TopicName {Maybe [Text]
$sel:topicNameTopics:TopicName :: TopicName -> Maybe [Text]
topicNameTopics :: Maybe [Text]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"topics" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
topicNameTopics
      ]


-- | Construct a value of type 'TopicName' (by applying it's required fields, if any)
mkTopicName
  :: TopicName
mkTopicName :: TopicName
mkTopicName =
  TopicName
  { $sel:topicNameTopics:TopicName :: Maybe [Text]
topicNameTopics = Maybe [Text]
forall a. Maybe a
Nothing
  }

-- ** TopicResponse
-- | TopicResponse
-- TopicResponse for returning topics
data TopicResponse = TopicResponse
  { TopicResponse -> Maybe DateTime
topicResponseCreated :: !(Maybe DateTime) -- ^ "created"
  , TopicResponse -> Maybe Integer
topicResponseId :: !(Maybe Integer) -- ^ "id"
  , TopicResponse -> Maybe Integer
topicResponseRepoCount :: !(Maybe Integer) -- ^ "repo_count"
  , TopicResponse -> Maybe Text
topicResponseTopicName :: !(Maybe Text) -- ^ "topic_name"
  , TopicResponse -> Maybe DateTime
topicResponseUpdated :: !(Maybe DateTime) -- ^ "updated"
  } deriving (Int -> TopicResponse -> ShowS
[TopicResponse] -> ShowS
TopicResponse -> [Char]
(Int -> TopicResponse -> ShowS)
-> (TopicResponse -> [Char])
-> ([TopicResponse] -> ShowS)
-> Show TopicResponse
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TopicResponse -> ShowS
showsPrec :: Int -> TopicResponse -> ShowS
$cshow :: TopicResponse -> [Char]
show :: TopicResponse -> [Char]
$cshowList :: [TopicResponse] -> ShowS
showList :: [TopicResponse] -> ShowS
P.Show, TopicResponse -> TopicResponse -> Bool
(TopicResponse -> TopicResponse -> Bool)
-> (TopicResponse -> TopicResponse -> Bool) -> Eq TopicResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TopicResponse -> TopicResponse -> Bool
== :: TopicResponse -> TopicResponse -> Bool
$c/= :: TopicResponse -> TopicResponse -> Bool
/= :: TopicResponse -> TopicResponse -> Bool
P.Eq, P.Typeable)

-- | FromJSON TopicResponse
instance A.FromJSON TopicResponse where
  parseJSON :: Value -> Parser TopicResponse
parseJSON = [Char]
-> (Object -> Parser TopicResponse)
-> Value
-> Parser TopicResponse
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"TopicResponse" ((Object -> Parser TopicResponse) -> Value -> Parser TopicResponse)
-> (Object -> Parser TopicResponse)
-> Value
-> Parser TopicResponse
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe DateTime
-> Maybe Integer
-> Maybe Integer
-> Maybe Text
-> Maybe DateTime
-> TopicResponse
TopicResponse
      (Maybe DateTime
 -> Maybe Integer
 -> Maybe Integer
 -> Maybe Text
 -> Maybe DateTime
 -> TopicResponse)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Integer
      -> Maybe Integer -> Maybe Text -> Maybe DateTime -> TopicResponse)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe Integer
   -> Maybe Integer -> Maybe Text -> Maybe DateTime -> TopicResponse)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Integer -> Maybe Text -> Maybe DateTime -> TopicResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Integer -> Maybe Text -> Maybe DateTime -> TopicResponse)
-> Parser (Maybe Integer)
-> Parser (Maybe Text -> Maybe DateTime -> TopicResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"repo_count")
      Parser (Maybe Text -> Maybe DateTime -> TopicResponse)
-> Parser (Maybe Text) -> Parser (Maybe DateTime -> TopicResponse)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"topic_name")
      Parser (Maybe DateTime -> TopicResponse)
-> Parser (Maybe DateTime) -> Parser TopicResponse
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"updated")

-- | ToJSON TopicResponse
instance A.ToJSON TopicResponse where
  toJSON :: TopicResponse -> Value
toJSON TopicResponse {Maybe Integer
Maybe Text
Maybe DateTime
$sel:topicResponseCreated:TopicResponse :: TopicResponse -> Maybe DateTime
$sel:topicResponseId:TopicResponse :: TopicResponse -> Maybe Integer
$sel:topicResponseRepoCount:TopicResponse :: TopicResponse -> Maybe Integer
$sel:topicResponseTopicName:TopicResponse :: TopicResponse -> Maybe Text
$sel:topicResponseUpdated:TopicResponse :: TopicResponse -> Maybe DateTime
topicResponseCreated :: Maybe DateTime
topicResponseId :: Maybe Integer
topicResponseRepoCount :: Maybe Integer
topicResponseTopicName :: Maybe Text
topicResponseUpdated :: Maybe DateTime
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
topicResponseCreated
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
topicResponseId
      , Key
"repo_count" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
topicResponseRepoCount
      , Key
"topic_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
topicResponseTopicName
      , Key
"updated" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
topicResponseUpdated
      ]


-- | Construct a value of type 'TopicResponse' (by applying it's required fields, if any)
mkTopicResponse
  :: TopicResponse
mkTopicResponse :: TopicResponse
mkTopicResponse =
  TopicResponse
  { $sel:topicResponseCreated:TopicResponse :: Maybe DateTime
topicResponseCreated = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:topicResponseId:TopicResponse :: Maybe Integer
topicResponseId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:topicResponseRepoCount:TopicResponse :: Maybe Integer
topicResponseRepoCount = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:topicResponseTopicName:TopicResponse :: Maybe Text
topicResponseTopicName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:topicResponseUpdated:TopicResponse :: Maybe DateTime
topicResponseUpdated = Maybe DateTime
forall a. Maybe a
Nothing
  }

-- ** TrackedTime
-- | TrackedTime
-- TrackedTime worked time for an issue / pr
data TrackedTime = TrackedTime
  { TrackedTime -> Maybe DateTime
trackedTimeCreated :: !(Maybe DateTime) -- ^ "created"
  , TrackedTime -> Maybe Integer
trackedTimeId :: !(Maybe Integer) -- ^ "id"
  , TrackedTime -> Maybe Issue
trackedTimeIssue :: !(Maybe Issue) -- ^ "issue"
  , TrackedTime -> Maybe Integer
trackedTimeIssueId :: !(Maybe Integer) -- ^ "issue_id" - deprecated (only for backwards compatibility)
  , TrackedTime -> Maybe Integer
trackedTimeTime :: !(Maybe Integer) -- ^ "time" - Time in seconds
  , TrackedTime -> Maybe Integer
trackedTimeUserId :: !(Maybe Integer) -- ^ "user_id" - deprecated (only for backwards compatibility)
  , TrackedTime -> Maybe Text
trackedTimeUserName :: !(Maybe Text) -- ^ "user_name"
  } deriving (Int -> TrackedTime -> ShowS
[TrackedTime] -> ShowS
TrackedTime -> [Char]
(Int -> TrackedTime -> ShowS)
-> (TrackedTime -> [Char])
-> ([TrackedTime] -> ShowS)
-> Show TrackedTime
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TrackedTime -> ShowS
showsPrec :: Int -> TrackedTime -> ShowS
$cshow :: TrackedTime -> [Char]
show :: TrackedTime -> [Char]
$cshowList :: [TrackedTime] -> ShowS
showList :: [TrackedTime] -> ShowS
P.Show, TrackedTime -> TrackedTime -> Bool
(TrackedTime -> TrackedTime -> Bool)
-> (TrackedTime -> TrackedTime -> Bool) -> Eq TrackedTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TrackedTime -> TrackedTime -> Bool
== :: TrackedTime -> TrackedTime -> Bool
$c/= :: TrackedTime -> TrackedTime -> Bool
/= :: TrackedTime -> TrackedTime -> Bool
P.Eq, P.Typeable)

-- | FromJSON TrackedTime
instance A.FromJSON TrackedTime where
  parseJSON :: Value -> Parser TrackedTime
parseJSON = [Char]
-> (Object -> Parser TrackedTime) -> Value -> Parser TrackedTime
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"TrackedTime" ((Object -> Parser TrackedTime) -> Value -> Parser TrackedTime)
-> (Object -> Parser TrackedTime) -> Value -> Parser TrackedTime
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe DateTime
-> Maybe Integer
-> Maybe Issue
-> Maybe Integer
-> Maybe Integer
-> Maybe Integer
-> Maybe Text
-> TrackedTime
TrackedTime
      (Maybe DateTime
 -> Maybe Integer
 -> Maybe Issue
 -> Maybe Integer
 -> Maybe Integer
 -> Maybe Integer
 -> Maybe Text
 -> TrackedTime)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Integer
      -> Maybe Issue
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> TrackedTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe Integer
   -> Maybe Issue
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> TrackedTime)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Issue
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> TrackedTime)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Issue
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> TrackedTime)
-> Parser (Maybe Issue)
-> Parser
     (Maybe Integer
      -> Maybe Integer -> Maybe Integer -> Maybe Text -> TrackedTime)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Issue)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"issue")
      Parser
  (Maybe Integer
   -> Maybe Integer -> Maybe Integer -> Maybe Text -> TrackedTime)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Integer -> Maybe Integer -> Maybe Text -> TrackedTime)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"issue_id")
      Parser
  (Maybe Integer -> Maybe Integer -> Maybe Text -> TrackedTime)
-> Parser (Maybe Integer)
-> Parser (Maybe Integer -> Maybe Text -> TrackedTime)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"time")
      Parser (Maybe Integer -> Maybe Text -> TrackedTime)
-> Parser (Maybe Integer) -> Parser (Maybe Text -> TrackedTime)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user_id")
      Parser (Maybe Text -> TrackedTime)
-> Parser (Maybe Text) -> Parser TrackedTime
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"user_name")

-- | ToJSON TrackedTime
instance A.ToJSON TrackedTime where
  toJSON :: TrackedTime -> Value
toJSON TrackedTime {Maybe Integer
Maybe Text
Maybe DateTime
Maybe Issue
$sel:trackedTimeCreated:TrackedTime :: TrackedTime -> Maybe DateTime
$sel:trackedTimeId:TrackedTime :: TrackedTime -> Maybe Integer
$sel:trackedTimeIssue:TrackedTime :: TrackedTime -> Maybe Issue
$sel:trackedTimeIssueId:TrackedTime :: TrackedTime -> Maybe Integer
$sel:trackedTimeTime:TrackedTime :: TrackedTime -> Maybe Integer
$sel:trackedTimeUserId:TrackedTime :: TrackedTime -> Maybe Integer
$sel:trackedTimeUserName:TrackedTime :: TrackedTime -> Maybe Text
trackedTimeCreated :: Maybe DateTime
trackedTimeId :: Maybe Integer
trackedTimeIssue :: Maybe Issue
trackedTimeIssueId :: Maybe Integer
trackedTimeTime :: Maybe Integer
trackedTimeUserId :: Maybe Integer
trackedTimeUserName :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
trackedTimeCreated
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
trackedTimeId
      , Key
"issue" Key -> Maybe Issue -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Issue
trackedTimeIssue
      , Key
"issue_id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
trackedTimeIssueId
      , Key
"time" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
trackedTimeTime
      , Key
"user_id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
trackedTimeUserId
      , Key
"user_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
trackedTimeUserName
      ]


-- | Construct a value of type 'TrackedTime' (by applying it's required fields, if any)
mkTrackedTime
  :: TrackedTime
mkTrackedTime :: TrackedTime
mkTrackedTime =
  TrackedTime
  { $sel:trackedTimeCreated:TrackedTime :: Maybe DateTime
trackedTimeCreated = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:trackedTimeId:TrackedTime :: Maybe Integer
trackedTimeId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:trackedTimeIssue:TrackedTime :: Maybe Issue
trackedTimeIssue = Maybe Issue
forall a. Maybe a
Nothing
  , $sel:trackedTimeIssueId:TrackedTime :: Maybe Integer
trackedTimeIssueId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:trackedTimeTime:TrackedTime :: Maybe Integer
trackedTimeTime = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:trackedTimeUserId:TrackedTime :: Maybe Integer
trackedTimeUserId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:trackedTimeUserName:TrackedTime :: Maybe Text
trackedTimeUserName = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** TransferRepoOption
-- | TransferRepoOption
-- TransferRepoOption options when transfer a repository's ownership
data TransferRepoOption = TransferRepoOption
  { TransferRepoOption -> Text
transferRepoOptionNewOwner :: !(Text) -- ^ /Required/ "new_owner"
  , TransferRepoOption -> Maybe [Integer]
transferRepoOptionTeamIds :: !(Maybe [Integer]) -- ^ "team_ids" - ID of the team or teams to add to the repository. Teams can only be added to organization-owned repositories.
  } deriving (Int -> TransferRepoOption -> ShowS
[TransferRepoOption] -> ShowS
TransferRepoOption -> [Char]
(Int -> TransferRepoOption -> ShowS)
-> (TransferRepoOption -> [Char])
-> ([TransferRepoOption] -> ShowS)
-> Show TransferRepoOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TransferRepoOption -> ShowS
showsPrec :: Int -> TransferRepoOption -> ShowS
$cshow :: TransferRepoOption -> [Char]
show :: TransferRepoOption -> [Char]
$cshowList :: [TransferRepoOption] -> ShowS
showList :: [TransferRepoOption] -> ShowS
P.Show, TransferRepoOption -> TransferRepoOption -> Bool
(TransferRepoOption -> TransferRepoOption -> Bool)
-> (TransferRepoOption -> TransferRepoOption -> Bool)
-> Eq TransferRepoOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TransferRepoOption -> TransferRepoOption -> Bool
== :: TransferRepoOption -> TransferRepoOption -> Bool
$c/= :: TransferRepoOption -> TransferRepoOption -> Bool
/= :: TransferRepoOption -> TransferRepoOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON TransferRepoOption
instance A.FromJSON TransferRepoOption where
  parseJSON :: Value -> Parser TransferRepoOption
parseJSON = [Char]
-> (Object -> Parser TransferRepoOption)
-> Value
-> Parser TransferRepoOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"TransferRepoOption" ((Object -> Parser TransferRepoOption)
 -> Value -> Parser TransferRepoOption)
-> (Object -> Parser TransferRepoOption)
-> Value
-> Parser TransferRepoOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Maybe [Integer] -> TransferRepoOption
TransferRepoOption
      (Text -> Maybe [Integer] -> TransferRepoOption)
-> Parser Text -> Parser (Maybe [Integer] -> TransferRepoOption)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"new_owner")
      Parser (Maybe [Integer] -> TransferRepoOption)
-> Parser (Maybe [Integer]) -> Parser TransferRepoOption
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [Integer])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"team_ids")

-- | ToJSON TransferRepoOption
instance A.ToJSON TransferRepoOption where
  toJSON :: TransferRepoOption -> Value
toJSON TransferRepoOption {Maybe [Integer]
Text
$sel:transferRepoOptionNewOwner:TransferRepoOption :: TransferRepoOption -> Text
$sel:transferRepoOptionTeamIds:TransferRepoOption :: TransferRepoOption -> Maybe [Integer]
transferRepoOptionNewOwner :: Text
transferRepoOptionTeamIds :: Maybe [Integer]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"new_owner" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
transferRepoOptionNewOwner
      , Key
"team_ids" Key -> Maybe [Integer] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Integer]
transferRepoOptionTeamIds
      ]


-- | Construct a value of type 'TransferRepoOption' (by applying it's required fields, if any)
mkTransferRepoOption
  :: Text -- ^ 'transferRepoOptionNewOwner' 
  -> TransferRepoOption
mkTransferRepoOption :: Text -> TransferRepoOption
mkTransferRepoOption Text
transferRepoOptionNewOwner =
  TransferRepoOption
  { Text
$sel:transferRepoOptionNewOwner:TransferRepoOption :: Text
transferRepoOptionNewOwner :: Text
transferRepoOptionNewOwner
  , $sel:transferRepoOptionTeamIds:TransferRepoOption :: Maybe [Integer]
transferRepoOptionTeamIds = Maybe [Integer]
forall a. Maybe a
Nothing
  }

-- ** UpdateBranchProtectionPriories
-- | UpdateBranchProtectionPriories
-- UpdateBranchProtectionPriories a list to update the branch protection rule priorities
data UpdateBranchProtectionPriories = UpdateBranchProtectionPriories
  { UpdateBranchProtectionPriories -> Maybe [Integer]
updateBranchProtectionPrioriesIds :: !(Maybe [Integer]) -- ^ "ids"
  } deriving (Int -> UpdateBranchProtectionPriories -> ShowS
[UpdateBranchProtectionPriories] -> ShowS
UpdateBranchProtectionPriories -> [Char]
(Int -> UpdateBranchProtectionPriories -> ShowS)
-> (UpdateBranchProtectionPriories -> [Char])
-> ([UpdateBranchProtectionPriories] -> ShowS)
-> Show UpdateBranchProtectionPriories
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateBranchProtectionPriories -> ShowS
showsPrec :: Int -> UpdateBranchProtectionPriories -> ShowS
$cshow :: UpdateBranchProtectionPriories -> [Char]
show :: UpdateBranchProtectionPriories -> [Char]
$cshowList :: [UpdateBranchProtectionPriories] -> ShowS
showList :: [UpdateBranchProtectionPriories] -> ShowS
P.Show, UpdateBranchProtectionPriories
-> UpdateBranchProtectionPriories -> Bool
(UpdateBranchProtectionPriories
 -> UpdateBranchProtectionPriories -> Bool)
-> (UpdateBranchProtectionPriories
    -> UpdateBranchProtectionPriories -> Bool)
-> Eq UpdateBranchProtectionPriories
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdateBranchProtectionPriories
-> UpdateBranchProtectionPriories -> Bool
== :: UpdateBranchProtectionPriories
-> UpdateBranchProtectionPriories -> Bool
$c/= :: UpdateBranchProtectionPriories
-> UpdateBranchProtectionPriories -> Bool
/= :: UpdateBranchProtectionPriories
-> UpdateBranchProtectionPriories -> Bool
P.Eq, P.Typeable)

-- | FromJSON UpdateBranchProtectionPriories
instance A.FromJSON UpdateBranchProtectionPriories where
  parseJSON :: Value -> Parser UpdateBranchProtectionPriories
parseJSON = [Char]
-> (Object -> Parser UpdateBranchProtectionPriories)
-> Value
-> Parser UpdateBranchProtectionPriories
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"UpdateBranchProtectionPriories" ((Object -> Parser UpdateBranchProtectionPriories)
 -> Value -> Parser UpdateBranchProtectionPriories)
-> (Object -> Parser UpdateBranchProtectionPriories)
-> Value
-> Parser UpdateBranchProtectionPriories
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Integer] -> UpdateBranchProtectionPriories
UpdateBranchProtectionPriories
      (Maybe [Integer] -> UpdateBranchProtectionPriories)
-> Parser (Maybe [Integer])
-> Parser UpdateBranchProtectionPriories
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [Integer])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ids")

-- | ToJSON UpdateBranchProtectionPriories
instance A.ToJSON UpdateBranchProtectionPriories where
  toJSON :: UpdateBranchProtectionPriories -> Value
toJSON UpdateBranchProtectionPriories {Maybe [Integer]
$sel:updateBranchProtectionPrioriesIds:UpdateBranchProtectionPriories :: UpdateBranchProtectionPriories -> Maybe [Integer]
updateBranchProtectionPrioriesIds :: Maybe [Integer]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"ids" Key -> Maybe [Integer] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Integer]
updateBranchProtectionPrioriesIds
      ]


-- | Construct a value of type 'UpdateBranchProtectionPriories' (by applying it's required fields, if any)
mkUpdateBranchProtectionPriories
  :: UpdateBranchProtectionPriories
mkUpdateBranchProtectionPriories :: UpdateBranchProtectionPriories
mkUpdateBranchProtectionPriories =
  UpdateBranchProtectionPriories
  { $sel:updateBranchProtectionPrioriesIds:UpdateBranchProtectionPriories :: Maybe [Integer]
updateBranchProtectionPrioriesIds = Maybe [Integer]
forall a. Maybe a
Nothing
  }

-- ** UpdateBranchRepoOption
-- | UpdateBranchRepoOption
-- UpdateBranchRepoOption options when updating a branch in a repository
data UpdateBranchRepoOption = UpdateBranchRepoOption
  { UpdateBranchRepoOption -> Text
updateBranchRepoOptionName :: !(Text) -- ^ /Required/ "name" - New branch name
  } deriving (Int -> UpdateBranchRepoOption -> ShowS
[UpdateBranchRepoOption] -> ShowS
UpdateBranchRepoOption -> [Char]
(Int -> UpdateBranchRepoOption -> ShowS)
-> (UpdateBranchRepoOption -> [Char])
-> ([UpdateBranchRepoOption] -> ShowS)
-> Show UpdateBranchRepoOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateBranchRepoOption -> ShowS
showsPrec :: Int -> UpdateBranchRepoOption -> ShowS
$cshow :: UpdateBranchRepoOption -> [Char]
show :: UpdateBranchRepoOption -> [Char]
$cshowList :: [UpdateBranchRepoOption] -> ShowS
showList :: [UpdateBranchRepoOption] -> ShowS
P.Show, UpdateBranchRepoOption -> UpdateBranchRepoOption -> Bool
(UpdateBranchRepoOption -> UpdateBranchRepoOption -> Bool)
-> (UpdateBranchRepoOption -> UpdateBranchRepoOption -> Bool)
-> Eq UpdateBranchRepoOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdateBranchRepoOption -> UpdateBranchRepoOption -> Bool
== :: UpdateBranchRepoOption -> UpdateBranchRepoOption -> Bool
$c/= :: UpdateBranchRepoOption -> UpdateBranchRepoOption -> Bool
/= :: UpdateBranchRepoOption -> UpdateBranchRepoOption -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON UpdateBranchRepoOption
instance A.ToJSON UpdateBranchRepoOption where
  toJSON :: UpdateBranchRepoOption -> Value
toJSON UpdateBranchRepoOption {Text
$sel:updateBranchRepoOptionName:UpdateBranchRepoOption :: UpdateBranchRepoOption -> Text
updateBranchRepoOptionName :: Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"name" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
updateBranchRepoOptionName
      ]


-- | Construct a value of type 'UpdateBranchRepoOption' (by applying it's required fields, if any)
mkUpdateBranchRepoOption
  :: Text -- ^ 'updateBranchRepoOptionName': New branch name
  -> UpdateBranchRepoOption
mkUpdateBranchRepoOption :: Text -> UpdateBranchRepoOption
mkUpdateBranchRepoOption Text
updateBranchRepoOptionName =
  UpdateBranchRepoOption
  { Text
$sel:updateBranchRepoOptionName:UpdateBranchRepoOption :: Text
updateBranchRepoOptionName :: Text
updateBranchRepoOptionName
  }

-- ** UpdateFileOptions
-- | UpdateFileOptions
-- UpdateFileOptions options for updating files Note: `author` and `committer` are optional (if only one is given, it will be used for the other, otherwise the authenticated user will be used)
data UpdateFileOptions = UpdateFileOptions
  { UpdateFileOptions -> Maybe Identity
updateFileOptionsAuthor :: !(Maybe Identity) -- ^ "author"
  , UpdateFileOptions -> Maybe Text
updateFileOptionsBranch :: !(Maybe Text) -- ^ "branch" - branch (optional) to base this file from. if not given, the default branch is used
  , UpdateFileOptions -> Maybe Identity
updateFileOptionsCommitter :: !(Maybe Identity) -- ^ "committer"
  , UpdateFileOptions -> Text
updateFileOptionsContent :: !(Text) -- ^ /Required/ "content" - content must be base64 encoded
  , UpdateFileOptions -> Maybe CommitDateOptions
updateFileOptionsDates :: !(Maybe CommitDateOptions) -- ^ "dates"
  , UpdateFileOptions -> Maybe Text
updateFileOptionsFromPath :: !(Maybe Text) -- ^ "from_path" - from_path (optional) is the path of the original file which will be moved/renamed to the path in the URL
  , UpdateFileOptions -> Maybe Text
updateFileOptionsMessage :: !(Maybe Text) -- ^ "message" - message (optional) for the commit of this file. if not supplied, a default message will be used
  , UpdateFileOptions -> Maybe Text
updateFileOptionsNewBranch :: !(Maybe Text) -- ^ "new_branch" - new_branch (optional) will make a new branch from &#x60;branch&#x60; before creating the file
  , UpdateFileOptions -> Text
updateFileOptionsSha :: !(Text) -- ^ /Required/ "sha" - sha is the SHA for the file that already exists
  , UpdateFileOptions -> Maybe Bool
updateFileOptionsSignoff :: !(Maybe Bool) -- ^ "signoff" - Add a Signed-off-by trailer by the committer at the end of the commit log message.
  } deriving (Int -> UpdateFileOptions -> ShowS
[UpdateFileOptions] -> ShowS
UpdateFileOptions -> [Char]
(Int -> UpdateFileOptions -> ShowS)
-> (UpdateFileOptions -> [Char])
-> ([UpdateFileOptions] -> ShowS)
-> Show UpdateFileOptions
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateFileOptions -> ShowS
showsPrec :: Int -> UpdateFileOptions -> ShowS
$cshow :: UpdateFileOptions -> [Char]
show :: UpdateFileOptions -> [Char]
$cshowList :: [UpdateFileOptions] -> ShowS
showList :: [UpdateFileOptions] -> ShowS
P.Show, UpdateFileOptions -> UpdateFileOptions -> Bool
(UpdateFileOptions -> UpdateFileOptions -> Bool)
-> (UpdateFileOptions -> UpdateFileOptions -> Bool)
-> Eq UpdateFileOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdateFileOptions -> UpdateFileOptions -> Bool
== :: UpdateFileOptions -> UpdateFileOptions -> Bool
$c/= :: UpdateFileOptions -> UpdateFileOptions -> Bool
/= :: UpdateFileOptions -> UpdateFileOptions -> Bool
P.Eq, P.Typeable)

-- | FromJSON UpdateFileOptions
instance A.FromJSON UpdateFileOptions where
  parseJSON :: Value -> Parser UpdateFileOptions
parseJSON = [Char]
-> (Object -> Parser UpdateFileOptions)
-> Value
-> Parser UpdateFileOptions
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"UpdateFileOptions" ((Object -> Parser UpdateFileOptions)
 -> Value -> Parser UpdateFileOptions)
-> (Object -> Parser UpdateFileOptions)
-> Value
-> Parser UpdateFileOptions
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Identity
-> Maybe Text
-> Maybe Identity
-> Text
-> Maybe CommitDateOptions
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Text
-> Maybe Bool
-> UpdateFileOptions
UpdateFileOptions
      (Maybe Identity
 -> Maybe Text
 -> Maybe Identity
 -> Text
 -> Maybe CommitDateOptions
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Text
 -> Maybe Bool
 -> UpdateFileOptions)
-> Parser (Maybe Identity)
-> Parser
     (Maybe Text
      -> Maybe Identity
      -> Text
      -> Maybe CommitDateOptions
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Bool
      -> UpdateFileOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Identity)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"author")
      Parser
  (Maybe Text
   -> Maybe Identity
   -> Text
   -> Maybe CommitDateOptions
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Bool
   -> UpdateFileOptions)
-> Parser (Maybe Text)
-> Parser
     (Maybe Identity
      -> Text
      -> Maybe CommitDateOptions
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Bool
      -> UpdateFileOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"branch")
      Parser
  (Maybe Identity
   -> Text
   -> Maybe CommitDateOptions
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Bool
   -> UpdateFileOptions)
-> Parser (Maybe Identity)
-> Parser
     (Text
      -> Maybe CommitDateOptions
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Bool
      -> UpdateFileOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Identity)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"committer")
      Parser
  (Text
   -> Maybe CommitDateOptions
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Bool
   -> UpdateFileOptions)
-> Parser Text
-> Parser
     (Maybe CommitDateOptions
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Bool
      -> UpdateFileOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"content")
      Parser
  (Maybe CommitDateOptions
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Bool
   -> UpdateFileOptions)
-> Parser (Maybe CommitDateOptions)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Text
      -> Maybe Bool
      -> UpdateFileOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe CommitDateOptions)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"dates")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Text
   -> Maybe Bool
   -> UpdateFileOptions)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text -> Text -> Maybe Bool -> UpdateFileOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"from_path")
      Parser
  (Maybe Text
   -> Maybe Text -> Text -> Maybe Bool -> UpdateFileOptions)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Text -> Maybe Bool -> UpdateFileOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"message")
      Parser (Maybe Text -> Text -> Maybe Bool -> UpdateFileOptions)
-> Parser (Maybe Text)
-> Parser (Text -> Maybe Bool -> UpdateFileOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"new_branch")
      Parser (Text -> Maybe Bool -> UpdateFileOptions)
-> Parser Text -> Parser (Maybe Bool -> UpdateFileOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"sha")
      Parser (Maybe Bool -> UpdateFileOptions)
-> Parser (Maybe Bool) -> Parser UpdateFileOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"signoff")

-- | ToJSON UpdateFileOptions
instance A.ToJSON UpdateFileOptions where
  toJSON :: UpdateFileOptions -> Value
toJSON UpdateFileOptions {Maybe Bool
Maybe Text
Maybe Identity
Maybe CommitDateOptions
Text
$sel:updateFileOptionsAuthor:UpdateFileOptions :: UpdateFileOptions -> Maybe Identity
$sel:updateFileOptionsBranch:UpdateFileOptions :: UpdateFileOptions -> Maybe Text
$sel:updateFileOptionsCommitter:UpdateFileOptions :: UpdateFileOptions -> Maybe Identity
$sel:updateFileOptionsContent:UpdateFileOptions :: UpdateFileOptions -> Text
$sel:updateFileOptionsDates:UpdateFileOptions :: UpdateFileOptions -> Maybe CommitDateOptions
$sel:updateFileOptionsFromPath:UpdateFileOptions :: UpdateFileOptions -> Maybe Text
$sel:updateFileOptionsMessage:UpdateFileOptions :: UpdateFileOptions -> Maybe Text
$sel:updateFileOptionsNewBranch:UpdateFileOptions :: UpdateFileOptions -> Maybe Text
$sel:updateFileOptionsSha:UpdateFileOptions :: UpdateFileOptions -> Text
$sel:updateFileOptionsSignoff:UpdateFileOptions :: UpdateFileOptions -> Maybe Bool
updateFileOptionsAuthor :: Maybe Identity
updateFileOptionsBranch :: Maybe Text
updateFileOptionsCommitter :: Maybe Identity
updateFileOptionsContent :: Text
updateFileOptionsDates :: Maybe CommitDateOptions
updateFileOptionsFromPath :: Maybe Text
updateFileOptionsMessage :: Maybe Text
updateFileOptionsNewBranch :: Maybe Text
updateFileOptionsSha :: Text
updateFileOptionsSignoff :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"author" Key -> Maybe Identity -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Identity
updateFileOptionsAuthor
      , Key
"branch" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
updateFileOptionsBranch
      , Key
"committer" Key -> Maybe Identity -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Identity
updateFileOptionsCommitter
      , Key
"content" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
updateFileOptionsContent
      , Key
"dates" Key -> Maybe CommitDateOptions -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe CommitDateOptions
updateFileOptionsDates
      , Key
"from_path" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
updateFileOptionsFromPath
      , Key
"message" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
updateFileOptionsMessage
      , Key
"new_branch" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
updateFileOptionsNewBranch
      , Key
"sha" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
updateFileOptionsSha
      , Key
"signoff" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
updateFileOptionsSignoff
      ]


-- | Construct a value of type 'UpdateFileOptions' (by applying it's required fields, if any)
mkUpdateFileOptions
  :: Text -- ^ 'updateFileOptionsContent': content must be base64 encoded
  -> Text -- ^ 'updateFileOptionsSha': sha is the SHA for the file that already exists
  -> UpdateFileOptions
mkUpdateFileOptions :: Text -> Text -> UpdateFileOptions
mkUpdateFileOptions Text
updateFileOptionsContent Text
updateFileOptionsSha =
  UpdateFileOptions
  { $sel:updateFileOptionsAuthor:UpdateFileOptions :: Maybe Identity
updateFileOptionsAuthor = Maybe Identity
forall a. Maybe a
Nothing
  , $sel:updateFileOptionsBranch:UpdateFileOptions :: Maybe Text
updateFileOptionsBranch = Maybe Text
forall a. Maybe a
Nothing
  , $sel:updateFileOptionsCommitter:UpdateFileOptions :: Maybe Identity
updateFileOptionsCommitter = Maybe Identity
forall a. Maybe a
Nothing
  , Text
$sel:updateFileOptionsContent:UpdateFileOptions :: Text
updateFileOptionsContent :: Text
updateFileOptionsContent
  , $sel:updateFileOptionsDates:UpdateFileOptions :: Maybe CommitDateOptions
updateFileOptionsDates = Maybe CommitDateOptions
forall a. Maybe a
Nothing
  , $sel:updateFileOptionsFromPath:UpdateFileOptions :: Maybe Text
updateFileOptionsFromPath = Maybe Text
forall a. Maybe a
Nothing
  , $sel:updateFileOptionsMessage:UpdateFileOptions :: Maybe Text
updateFileOptionsMessage = Maybe Text
forall a. Maybe a
Nothing
  , $sel:updateFileOptionsNewBranch:UpdateFileOptions :: Maybe Text
updateFileOptionsNewBranch = Maybe Text
forall a. Maybe a
Nothing
  , Text
$sel:updateFileOptionsSha:UpdateFileOptions :: Text
updateFileOptionsSha :: Text
updateFileOptionsSha
  , $sel:updateFileOptionsSignoff:UpdateFileOptions :: Maybe Bool
updateFileOptionsSignoff = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** UpdateRepoAvatarOption
-- | UpdateRepoAvatarOption
-- UpdateRepoAvatarUserOption options when updating the repo avatar
data UpdateRepoAvatarOption = UpdateRepoAvatarOption
  { UpdateRepoAvatarOption -> Maybe Text
updateRepoAvatarOptionImage :: !(Maybe Text) -- ^ "image" - image must be base64 encoded
  } deriving (Int -> UpdateRepoAvatarOption -> ShowS
[UpdateRepoAvatarOption] -> ShowS
UpdateRepoAvatarOption -> [Char]
(Int -> UpdateRepoAvatarOption -> ShowS)
-> (UpdateRepoAvatarOption -> [Char])
-> ([UpdateRepoAvatarOption] -> ShowS)
-> Show UpdateRepoAvatarOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateRepoAvatarOption -> ShowS
showsPrec :: Int -> UpdateRepoAvatarOption -> ShowS
$cshow :: UpdateRepoAvatarOption -> [Char]
show :: UpdateRepoAvatarOption -> [Char]
$cshowList :: [UpdateRepoAvatarOption] -> ShowS
showList :: [UpdateRepoAvatarOption] -> ShowS
P.Show, UpdateRepoAvatarOption -> UpdateRepoAvatarOption -> Bool
(UpdateRepoAvatarOption -> UpdateRepoAvatarOption -> Bool)
-> (UpdateRepoAvatarOption -> UpdateRepoAvatarOption -> Bool)
-> Eq UpdateRepoAvatarOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdateRepoAvatarOption -> UpdateRepoAvatarOption -> Bool
== :: UpdateRepoAvatarOption -> UpdateRepoAvatarOption -> Bool
$c/= :: UpdateRepoAvatarOption -> UpdateRepoAvatarOption -> Bool
/= :: UpdateRepoAvatarOption -> UpdateRepoAvatarOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON UpdateRepoAvatarOption
instance A.FromJSON UpdateRepoAvatarOption where
  parseJSON :: Value -> Parser UpdateRepoAvatarOption
parseJSON = [Char]
-> (Object -> Parser UpdateRepoAvatarOption)
-> Value
-> Parser UpdateRepoAvatarOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"UpdateRepoAvatarOption" ((Object -> Parser UpdateRepoAvatarOption)
 -> Value -> Parser UpdateRepoAvatarOption)
-> (Object -> Parser UpdateRepoAvatarOption)
-> Value
-> Parser UpdateRepoAvatarOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> UpdateRepoAvatarOption
UpdateRepoAvatarOption
      (Maybe Text -> UpdateRepoAvatarOption)
-> Parser (Maybe Text) -> Parser UpdateRepoAvatarOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"image")

-- | ToJSON UpdateRepoAvatarOption
instance A.ToJSON UpdateRepoAvatarOption where
  toJSON :: UpdateRepoAvatarOption -> Value
toJSON UpdateRepoAvatarOption {Maybe Text
$sel:updateRepoAvatarOptionImage:UpdateRepoAvatarOption :: UpdateRepoAvatarOption -> Maybe Text
updateRepoAvatarOptionImage :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"image" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
updateRepoAvatarOptionImage
      ]


-- | Construct a value of type 'UpdateRepoAvatarOption' (by applying it's required fields, if any)
mkUpdateRepoAvatarOption
  :: UpdateRepoAvatarOption
mkUpdateRepoAvatarOption :: UpdateRepoAvatarOption
mkUpdateRepoAvatarOption =
  UpdateRepoAvatarOption
  { $sel:updateRepoAvatarOptionImage:UpdateRepoAvatarOption :: Maybe Text
updateRepoAvatarOptionImage = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** UpdateUserAvatarOption
-- | UpdateUserAvatarOption
-- UpdateUserAvatarUserOption options when updating the user avatar
data UpdateUserAvatarOption = UpdateUserAvatarOption
  { UpdateUserAvatarOption -> Maybe Text
updateUserAvatarOptionImage :: !(Maybe Text) -- ^ "image" - image must be base64 encoded
  } deriving (Int -> UpdateUserAvatarOption -> ShowS
[UpdateUserAvatarOption] -> ShowS
UpdateUserAvatarOption -> [Char]
(Int -> UpdateUserAvatarOption -> ShowS)
-> (UpdateUserAvatarOption -> [Char])
-> ([UpdateUserAvatarOption] -> ShowS)
-> Show UpdateUserAvatarOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateUserAvatarOption -> ShowS
showsPrec :: Int -> UpdateUserAvatarOption -> ShowS
$cshow :: UpdateUserAvatarOption -> [Char]
show :: UpdateUserAvatarOption -> [Char]
$cshowList :: [UpdateUserAvatarOption] -> ShowS
showList :: [UpdateUserAvatarOption] -> ShowS
P.Show, UpdateUserAvatarOption -> UpdateUserAvatarOption -> Bool
(UpdateUserAvatarOption -> UpdateUserAvatarOption -> Bool)
-> (UpdateUserAvatarOption -> UpdateUserAvatarOption -> Bool)
-> Eq UpdateUserAvatarOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdateUserAvatarOption -> UpdateUserAvatarOption -> Bool
== :: UpdateUserAvatarOption -> UpdateUserAvatarOption -> Bool
$c/= :: UpdateUserAvatarOption -> UpdateUserAvatarOption -> Bool
/= :: UpdateUserAvatarOption -> UpdateUserAvatarOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON UpdateUserAvatarOption
instance A.FromJSON UpdateUserAvatarOption where
  parseJSON :: Value -> Parser UpdateUserAvatarOption
parseJSON = [Char]
-> (Object -> Parser UpdateUserAvatarOption)
-> Value
-> Parser UpdateUserAvatarOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"UpdateUserAvatarOption" ((Object -> Parser UpdateUserAvatarOption)
 -> Value -> Parser UpdateUserAvatarOption)
-> (Object -> Parser UpdateUserAvatarOption)
-> Value
-> Parser UpdateUserAvatarOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text -> UpdateUserAvatarOption
UpdateUserAvatarOption
      (Maybe Text -> UpdateUserAvatarOption)
-> Parser (Maybe Text) -> Parser UpdateUserAvatarOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"image")

-- | ToJSON UpdateUserAvatarOption
instance A.ToJSON UpdateUserAvatarOption where
  toJSON :: UpdateUserAvatarOption -> Value
toJSON UpdateUserAvatarOption {Maybe Text
$sel:updateUserAvatarOptionImage:UpdateUserAvatarOption :: UpdateUserAvatarOption -> Maybe Text
updateUserAvatarOptionImage :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"image" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
updateUserAvatarOptionImage
      ]


-- | Construct a value of type 'UpdateUserAvatarOption' (by applying it's required fields, if any)
mkUpdateUserAvatarOption
  :: UpdateUserAvatarOption
mkUpdateUserAvatarOption :: UpdateUserAvatarOption
mkUpdateUserAvatarOption =
  UpdateUserAvatarOption
  { $sel:updateUserAvatarOptionImage:UpdateUserAvatarOption :: Maybe Text
updateUserAvatarOptionImage = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** UpdateVariableOption
-- | UpdateVariableOption
-- UpdateVariableOption the option when updating variable
data UpdateVariableOption = UpdateVariableOption
  { UpdateVariableOption -> Maybe Text
updateVariableOptionName :: !(Maybe Text) -- ^ "name" - New name for the variable. If the field is empty, the variable name won&#39;t be updated.
  , UpdateVariableOption -> Text
updateVariableOptionValue :: !(Text) -- ^ /Required/ "value" - Value of the variable to update
  } deriving (Int -> UpdateVariableOption -> ShowS
[UpdateVariableOption] -> ShowS
UpdateVariableOption -> [Char]
(Int -> UpdateVariableOption -> ShowS)
-> (UpdateVariableOption -> [Char])
-> ([UpdateVariableOption] -> ShowS)
-> Show UpdateVariableOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateVariableOption -> ShowS
showsPrec :: Int -> UpdateVariableOption -> ShowS
$cshow :: UpdateVariableOption -> [Char]
show :: UpdateVariableOption -> [Char]
$cshowList :: [UpdateVariableOption] -> ShowS
showList :: [UpdateVariableOption] -> ShowS
P.Show, UpdateVariableOption -> UpdateVariableOption -> Bool
(UpdateVariableOption -> UpdateVariableOption -> Bool)
-> (UpdateVariableOption -> UpdateVariableOption -> Bool)
-> Eq UpdateVariableOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdateVariableOption -> UpdateVariableOption -> Bool
== :: UpdateVariableOption -> UpdateVariableOption -> Bool
$c/= :: UpdateVariableOption -> UpdateVariableOption -> Bool
/= :: UpdateVariableOption -> UpdateVariableOption -> Bool
P.Eq, P.Typeable)

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

-- | ToJSON UpdateVariableOption
instance A.ToJSON UpdateVariableOption where
  toJSON :: UpdateVariableOption -> Value
toJSON UpdateVariableOption {Maybe Text
Text
$sel:updateVariableOptionName:UpdateVariableOption :: UpdateVariableOption -> Maybe Text
$sel:updateVariableOptionValue:UpdateVariableOption :: UpdateVariableOption -> Text
updateVariableOptionName :: Maybe Text
updateVariableOptionValue :: Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
updateVariableOptionName
      , Key
"value" Key -> Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Text
updateVariableOptionValue
      ]


-- | Construct a value of type 'UpdateVariableOption' (by applying it's required fields, if any)
mkUpdateVariableOption
  :: Text -- ^ 'updateVariableOptionValue': Value of the variable to update
  -> UpdateVariableOption
mkUpdateVariableOption :: Text -> UpdateVariableOption
mkUpdateVariableOption Text
updateVariableOptionValue =
  UpdateVariableOption
  { $sel:updateVariableOptionName:UpdateVariableOption :: Maybe Text
updateVariableOptionName = Maybe Text
forall a. Maybe a
Nothing
  , Text
$sel:updateVariableOptionValue:UpdateVariableOption :: Text
updateVariableOptionValue :: Text
updateVariableOptionValue
  }

-- ** User
-- | User
-- User represents a user
data User = User
  { User -> Maybe Bool
userActive :: !(Maybe Bool) -- ^ "active" - Is user active
  , User -> Maybe Text
userAvatarUrl :: !(Maybe Text) -- ^ "avatar_url" - URL to the user&#39;s avatar
  , User -> Maybe DateTime
userCreated :: !(Maybe DateTime) -- ^ "created"
  , User -> Maybe Text
userDescription :: !(Maybe Text) -- ^ "description" - the user&#39;s description
  , User -> Maybe Text
userEmail :: !(Maybe Text) -- ^ "email"
  , User -> Maybe Integer
userFollowersCount :: !(Maybe Integer) -- ^ "followers_count" - user counts
  , User -> Maybe Integer
userFollowingCount :: !(Maybe Integer) -- ^ "following_count"
  , User -> Maybe Text
userFullName :: !(Maybe Text) -- ^ "full_name" - the user&#39;s full name
  , User -> Maybe Text
userHtmlUrl :: !(Maybe Text) -- ^ "html_url" - URL to the user&#39;s gitea page
  , User -> Maybe Integer
userId :: !(Maybe Integer) -- ^ "id" - the user&#39;s id
  , User -> Maybe Bool
userIsAdmin :: !(Maybe Bool) -- ^ "is_admin" - Is the user an administrator
  , User -> Maybe Text
userLanguage :: !(Maybe Text) -- ^ "language" - User locale
  , User -> Maybe DateTime
userLastLogin :: !(Maybe DateTime) -- ^ "last_login"
  , User -> Maybe Text
userLocation :: !(Maybe Text) -- ^ "location" - the user&#39;s location
  , User -> Maybe Text
userLogin :: !(Maybe Text) -- ^ "login" - the user&#39;s username
  , User -> Maybe Text
userLoginName :: !(Maybe Text) -- ^ "login_name" - the user&#39;s authentication sign-in name.
  , User -> Maybe Bool
userProhibitLogin :: !(Maybe Bool) -- ^ "prohibit_login" - Is user login prohibited
  , User -> Maybe Bool
userRestricted :: !(Maybe Bool) -- ^ "restricted" - Is user restricted
  , User -> Maybe Integer
userSourceId :: !(Maybe Integer) -- ^ "source_id" - The ID of the user&#39;s Authentication Source
  , User -> Maybe Integer
userStarredReposCount :: !(Maybe Integer) -- ^ "starred_repos_count"
  , User -> Maybe Text
userVisibility :: !(Maybe Text) -- ^ "visibility" - User visibility level option: public, limited, private
  , User -> Maybe Text
userWebsite :: !(Maybe Text) -- ^ "website" - the user&#39;s website
  } deriving (Int -> User -> ShowS
[User] -> ShowS
User -> [Char]
(Int -> User -> ShowS)
-> (User -> [Char]) -> ([User] -> ShowS) -> Show User
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> User -> ShowS
showsPrec :: Int -> User -> ShowS
$cshow :: User -> [Char]
show :: User -> [Char]
$cshowList :: [User] -> ShowS
showList :: [User] -> ShowS
P.Show, User -> User -> Bool
(User -> User -> Bool) -> (User -> User -> Bool) -> Eq User
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: User -> User -> Bool
== :: User -> User -> Bool
$c/= :: User -> User -> Bool
/= :: User -> User -> Bool
P.Eq, P.Typeable)

-- | FromJSON User
instance A.FromJSON User where
  parseJSON :: Value -> Parser User
parseJSON = [Char] -> (Object -> Parser User) -> Value -> Parser User
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"User" ((Object -> Parser User) -> Value -> Parser User)
-> (Object -> Parser User) -> Value -> Parser User
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Bool
-> Maybe Text
-> Maybe DateTime
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> Maybe Bool
-> Maybe Text
-> Maybe DateTime
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Integer
-> Maybe Integer
-> Maybe Text
-> Maybe Text
-> User
User
      (Maybe Bool
 -> Maybe Text
 -> Maybe DateTime
 -> Maybe Text
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Text
 -> Maybe Integer
 -> Maybe Bool
 -> Maybe Text
 -> Maybe DateTime
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Integer
 -> Maybe Integer
 -> Maybe Text
 -> Maybe Text
 -> User)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> User)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"active")
      Parser
  (Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> User)
-> Parser (Maybe Text)
-> Parser
     (Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> User)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"avatar_url")
      Parser
  (Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> User)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> User)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> User)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> User)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> User)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> User)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"email")
      Parser
  (Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> User)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> User)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"followers_count")
      Parser
  (Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> User)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> User)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"following_count")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> User)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> User)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"full_name")
      Parser
  (Maybe Text
   -> Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> User)
-> Parser (Maybe Text)
-> Parser
     (Maybe Integer
      -> Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> User)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"html_url")
      Parser
  (Maybe Integer
   -> Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> User)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> User)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> User)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> User)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"is_admin")
      Parser
  (Maybe Text
   -> Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> User)
-> Parser (Maybe Text)
-> Parser
     (Maybe DateTime
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> User)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"language")
      Parser
  (Maybe DateTime
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> User)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> User)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"last_login")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> User)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> User)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"location")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> User)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> User)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"login")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> User)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> User)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"login_name")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> User)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Integer
      -> Maybe Integer
      -> Maybe Text
      -> Maybe Text
      -> User)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"prohibit_login")
      Parser
  (Maybe Bool
   -> Maybe Integer
   -> Maybe Integer
   -> Maybe Text
   -> Maybe Text
   -> User)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Integer
      -> Maybe Integer -> Maybe Text -> Maybe Text -> User)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"restricted")
      Parser
  (Maybe Integer
   -> Maybe Integer -> Maybe Text -> Maybe Text -> User)
-> Parser (Maybe Integer)
-> Parser (Maybe Integer -> Maybe Text -> Maybe Text -> User)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source_id")
      Parser (Maybe Integer -> Maybe Text -> Maybe Text -> User)
-> Parser (Maybe Integer)
-> Parser (Maybe Text -> Maybe Text -> User)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"starred_repos_count")
      Parser (Maybe Text -> Maybe Text -> User)
-> Parser (Maybe Text) -> Parser (Maybe Text -> User)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"visibility")
      Parser (Maybe Text -> User) -> Parser (Maybe Text) -> Parser User
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"website")

-- | ToJSON User
instance A.ToJSON User where
  toJSON :: User -> Value
toJSON User {Maybe Bool
Maybe Integer
Maybe Text
Maybe DateTime
$sel:userActive:User :: User -> Maybe Bool
$sel:userAvatarUrl:User :: User -> Maybe Text
$sel:userCreated:User :: User -> Maybe DateTime
$sel:userDescription:User :: User -> Maybe Text
$sel:userEmail:User :: User -> Maybe Text
$sel:userFollowersCount:User :: User -> Maybe Integer
$sel:userFollowingCount:User :: User -> Maybe Integer
$sel:userFullName:User :: User -> Maybe Text
$sel:userHtmlUrl:User :: User -> Maybe Text
$sel:userId:User :: User -> Maybe Integer
$sel:userIsAdmin:User :: User -> Maybe Bool
$sel:userLanguage:User :: User -> Maybe Text
$sel:userLastLogin:User :: User -> Maybe DateTime
$sel:userLocation:User :: User -> Maybe Text
$sel:userLogin:User :: User -> Maybe Text
$sel:userLoginName:User :: User -> Maybe Text
$sel:userProhibitLogin:User :: User -> Maybe Bool
$sel:userRestricted:User :: User -> Maybe Bool
$sel:userSourceId:User :: User -> Maybe Integer
$sel:userStarredReposCount:User :: User -> Maybe Integer
$sel:userVisibility:User :: User -> Maybe Text
$sel:userWebsite:User :: User -> Maybe Text
userActive :: Maybe Bool
userAvatarUrl :: Maybe Text
userCreated :: Maybe DateTime
userDescription :: Maybe Text
userEmail :: Maybe Text
userFollowersCount :: Maybe Integer
userFollowingCount :: Maybe Integer
userFullName :: Maybe Text
userHtmlUrl :: Maybe Text
userId :: Maybe Integer
userIsAdmin :: Maybe Bool
userLanguage :: Maybe Text
userLastLogin :: Maybe DateTime
userLocation :: Maybe Text
userLogin :: Maybe Text
userLoginName :: Maybe Text
userProhibitLogin :: Maybe Bool
userRestricted :: Maybe Bool
userSourceId :: Maybe Integer
userStarredReposCount :: Maybe Integer
userVisibility :: Maybe Text
userWebsite :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"active" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
userActive
      , Key
"avatar_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
userAvatarUrl
      , Key
"created" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
userCreated
      , Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
userDescription
      , Key
"email" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
userEmail
      , Key
"followers_count" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
userFollowersCount
      , Key
"following_count" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
userFollowingCount
      , Key
"full_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
userFullName
      , Key
"html_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
userHtmlUrl
      , Key
"id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
userId
      , Key
"is_admin" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
userIsAdmin
      , Key
"language" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
userLanguage
      , Key
"last_login" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
userLastLogin
      , Key
"location" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
userLocation
      , Key
"login" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
userLogin
      , Key
"login_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
userLoginName
      , Key
"prohibit_login" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
userProhibitLogin
      , Key
"restricted" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
userRestricted
      , Key
"source_id" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
userSourceId
      , Key
"starred_repos_count" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
userStarredReposCount
      , Key
"visibility" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
userVisibility
      , Key
"website" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
userWebsite
      ]


-- | Construct a value of type 'User' (by applying it's required fields, if any)
mkUser
  :: User
mkUser :: User
mkUser =
  User
  { $sel:userActive:User :: Maybe Bool
userActive = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:userAvatarUrl:User :: Maybe Text
userAvatarUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userCreated:User :: Maybe DateTime
userCreated = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:userDescription:User :: Maybe Text
userDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userEmail:User :: Maybe Text
userEmail = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userFollowersCount:User :: Maybe Integer
userFollowersCount = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:userFollowingCount:User :: Maybe Integer
userFollowingCount = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:userFullName:User :: Maybe Text
userFullName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userHtmlUrl:User :: Maybe Text
userHtmlUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userId:User :: Maybe Integer
userId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:userIsAdmin:User :: Maybe Bool
userIsAdmin = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:userLanguage:User :: Maybe Text
userLanguage = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userLastLogin:User :: Maybe DateTime
userLastLogin = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:userLocation:User :: Maybe Text
userLocation = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userLogin:User :: Maybe Text
userLogin = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userLoginName:User :: Maybe Text
userLoginName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userProhibitLogin:User :: Maybe Bool
userProhibitLogin = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:userRestricted:User :: Maybe Bool
userRestricted = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:userSourceId:User :: Maybe Integer
userSourceId = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:userStarredReposCount:User :: Maybe Integer
userStarredReposCount = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:userVisibility:User :: Maybe Text
userVisibility = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userWebsite:User :: Maybe Text
userWebsite = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** UserBadgeOption
-- | UserBadgeOption
-- UserBadgeOption options for link between users and badges
data UserBadgeOption = UserBadgeOption
  { UserBadgeOption -> Maybe [Text]
userBadgeOptionBadgeSlugs :: !(Maybe [Text]) -- ^ "badge_slugs"
  } deriving (Int -> UserBadgeOption -> ShowS
[UserBadgeOption] -> ShowS
UserBadgeOption -> [Char]
(Int -> UserBadgeOption -> ShowS)
-> (UserBadgeOption -> [Char])
-> ([UserBadgeOption] -> ShowS)
-> Show UserBadgeOption
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserBadgeOption -> ShowS
showsPrec :: Int -> UserBadgeOption -> ShowS
$cshow :: UserBadgeOption -> [Char]
show :: UserBadgeOption -> [Char]
$cshowList :: [UserBadgeOption] -> ShowS
showList :: [UserBadgeOption] -> ShowS
P.Show, UserBadgeOption -> UserBadgeOption -> Bool
(UserBadgeOption -> UserBadgeOption -> Bool)
-> (UserBadgeOption -> UserBadgeOption -> Bool)
-> Eq UserBadgeOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserBadgeOption -> UserBadgeOption -> Bool
== :: UserBadgeOption -> UserBadgeOption -> Bool
$c/= :: UserBadgeOption -> UserBadgeOption -> Bool
/= :: UserBadgeOption -> UserBadgeOption -> Bool
P.Eq, P.Typeable)

-- | FromJSON UserBadgeOption
instance A.FromJSON UserBadgeOption where
  parseJSON :: Value -> Parser UserBadgeOption
parseJSON = [Char]
-> (Object -> Parser UserBadgeOption)
-> Value
-> Parser UserBadgeOption
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"UserBadgeOption" ((Object -> Parser UserBadgeOption)
 -> Value -> Parser UserBadgeOption)
-> (Object -> Parser UserBadgeOption)
-> Value
-> Parser UserBadgeOption
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Text] -> UserBadgeOption
UserBadgeOption
      (Maybe [Text] -> UserBadgeOption)
-> Parser (Maybe [Text]) -> Parser UserBadgeOption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"badge_slugs")

-- | ToJSON UserBadgeOption
instance A.ToJSON UserBadgeOption where
  toJSON :: UserBadgeOption -> Value
toJSON UserBadgeOption {Maybe [Text]
$sel:userBadgeOptionBadgeSlugs:UserBadgeOption :: UserBadgeOption -> Maybe [Text]
userBadgeOptionBadgeSlugs :: Maybe [Text]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"badge_slugs" Key -> Maybe [Text] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [Text]
userBadgeOptionBadgeSlugs
      ]


-- | Construct a value of type 'UserBadgeOption' (by applying it's required fields, if any)
mkUserBadgeOption
  :: UserBadgeOption
mkUserBadgeOption :: UserBadgeOption
mkUserBadgeOption =
  UserBadgeOption
  { $sel:userBadgeOptionBadgeSlugs:UserBadgeOption :: Maybe [Text]
userBadgeOptionBadgeSlugs = Maybe [Text]
forall a. Maybe a
Nothing
  }

-- ** UserHeatmapData
-- | UserHeatmapData
-- UserHeatmapData represents the data needed to create a heatmap
data UserHeatmapData = UserHeatmapData
  { UserHeatmapData -> Maybe Integer
userHeatmapDataContributions :: !(Maybe Integer) -- ^ "contributions"
  , UserHeatmapData -> Maybe Integer
userHeatmapDataTimestamp :: !(Maybe Integer) -- ^ "timestamp" - TimeStamp defines a timestamp
  } deriving (Int -> UserHeatmapData -> ShowS
[UserHeatmapData] -> ShowS
UserHeatmapData -> [Char]
(Int -> UserHeatmapData -> ShowS)
-> (UserHeatmapData -> [Char])
-> ([UserHeatmapData] -> ShowS)
-> Show UserHeatmapData
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserHeatmapData -> ShowS
showsPrec :: Int -> UserHeatmapData -> ShowS
$cshow :: UserHeatmapData -> [Char]
show :: UserHeatmapData -> [Char]
$cshowList :: [UserHeatmapData] -> ShowS
showList :: [UserHeatmapData] -> ShowS
P.Show, UserHeatmapData -> UserHeatmapData -> Bool
(UserHeatmapData -> UserHeatmapData -> Bool)
-> (UserHeatmapData -> UserHeatmapData -> Bool)
-> Eq UserHeatmapData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserHeatmapData -> UserHeatmapData -> Bool
== :: UserHeatmapData -> UserHeatmapData -> Bool
$c/= :: UserHeatmapData -> UserHeatmapData -> Bool
/= :: UserHeatmapData -> UserHeatmapData -> Bool
P.Eq, P.Typeable)

-- | FromJSON UserHeatmapData
instance A.FromJSON UserHeatmapData where
  parseJSON :: Value -> Parser UserHeatmapData
parseJSON = [Char]
-> (Object -> Parser UserHeatmapData)
-> Value
-> Parser UserHeatmapData
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"UserHeatmapData" ((Object -> Parser UserHeatmapData)
 -> Value -> Parser UserHeatmapData)
-> (Object -> Parser UserHeatmapData)
-> Value
-> Parser UserHeatmapData
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Integer -> Maybe Integer -> UserHeatmapData
UserHeatmapData
      (Maybe Integer -> Maybe Integer -> UserHeatmapData)
-> Parser (Maybe Integer)
-> Parser (Maybe Integer -> UserHeatmapData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"contributions")
      Parser (Maybe Integer -> UserHeatmapData)
-> Parser (Maybe Integer) -> Parser UserHeatmapData
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"timestamp")

-- | ToJSON UserHeatmapData
instance A.ToJSON UserHeatmapData where
  toJSON :: UserHeatmapData -> Value
toJSON UserHeatmapData {Maybe Integer
$sel:userHeatmapDataContributions:UserHeatmapData :: UserHeatmapData -> Maybe Integer
$sel:userHeatmapDataTimestamp:UserHeatmapData :: UserHeatmapData -> Maybe Integer
userHeatmapDataContributions :: Maybe Integer
userHeatmapDataTimestamp :: Maybe Integer
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"contributions" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
userHeatmapDataContributions
      , Key
"timestamp" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
userHeatmapDataTimestamp
      ]


-- | Construct a value of type 'UserHeatmapData' (by applying it's required fields, if any)
mkUserHeatmapData
  :: UserHeatmapData
mkUserHeatmapData :: UserHeatmapData
mkUserHeatmapData =
  UserHeatmapData
  { $sel:userHeatmapDataContributions:UserHeatmapData :: Maybe Integer
userHeatmapDataContributions = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:userHeatmapDataTimestamp:UserHeatmapData :: Maybe Integer
userHeatmapDataTimestamp = Maybe Integer
forall a. Maybe a
Nothing
  }

-- ** UserSearch200Response
-- | UserSearch200Response
data UserSearch200Response = UserSearch200Response
  { UserSearch200Response -> Maybe [User]
userSearch200ResponseData :: !(Maybe [User]) -- ^ "data"
  , UserSearch200Response -> Maybe Bool
userSearch200ResponseOk :: !(Maybe Bool) -- ^ "ok"
  } deriving (Int -> UserSearch200Response -> ShowS
[UserSearch200Response] -> ShowS
UserSearch200Response -> [Char]
(Int -> UserSearch200Response -> ShowS)
-> (UserSearch200Response -> [Char])
-> ([UserSearch200Response] -> ShowS)
-> Show UserSearch200Response
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserSearch200Response -> ShowS
showsPrec :: Int -> UserSearch200Response -> ShowS
$cshow :: UserSearch200Response -> [Char]
show :: UserSearch200Response -> [Char]
$cshowList :: [UserSearch200Response] -> ShowS
showList :: [UserSearch200Response] -> ShowS
P.Show, UserSearch200Response -> UserSearch200Response -> Bool
(UserSearch200Response -> UserSearch200Response -> Bool)
-> (UserSearch200Response -> UserSearch200Response -> Bool)
-> Eq UserSearch200Response
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserSearch200Response -> UserSearch200Response -> Bool
== :: UserSearch200Response -> UserSearch200Response -> Bool
$c/= :: UserSearch200Response -> UserSearch200Response -> Bool
/= :: UserSearch200Response -> UserSearch200Response -> Bool
P.Eq, P.Typeable)

-- | FromJSON UserSearch200Response
instance A.FromJSON UserSearch200Response where
  parseJSON :: Value -> Parser UserSearch200Response
parseJSON = [Char]
-> (Object -> Parser UserSearch200Response)
-> Value
-> Parser UserSearch200Response
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"UserSearch200Response" ((Object -> Parser UserSearch200Response)
 -> Value -> Parser UserSearch200Response)
-> (Object -> Parser UserSearch200Response)
-> Value
-> Parser UserSearch200Response
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [User] -> Maybe Bool -> UserSearch200Response
UserSearch200Response
      (Maybe [User] -> Maybe Bool -> UserSearch200Response)
-> Parser (Maybe [User])
-> Parser (Maybe Bool -> UserSearch200Response)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [User])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"data")
      Parser (Maybe Bool -> UserSearch200Response)
-> Parser (Maybe Bool) -> Parser UserSearch200Response
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ok")

-- | ToJSON UserSearch200Response
instance A.ToJSON UserSearch200Response where
  toJSON :: UserSearch200Response -> Value
toJSON UserSearch200Response {Maybe Bool
Maybe [User]
$sel:userSearch200ResponseData:UserSearch200Response :: UserSearch200Response -> Maybe [User]
$sel:userSearch200ResponseOk:UserSearch200Response :: UserSearch200Response -> Maybe Bool
userSearch200ResponseData :: Maybe [User]
userSearch200ResponseOk :: Maybe Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"data" Key -> Maybe [User] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [User]
userSearch200ResponseData
      , Key
"ok" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
userSearch200ResponseOk
      ]


-- | Construct a value of type 'UserSearch200Response' (by applying it's required fields, if any)
mkUserSearch200Response
  :: UserSearch200Response
mkUserSearch200Response :: UserSearch200Response
mkUserSearch200Response =
  UserSearch200Response
  { $sel:userSearch200ResponseData:UserSearch200Response :: Maybe [User]
userSearch200ResponseData = Maybe [User]
forall a. Maybe a
Nothing
  , $sel:userSearch200ResponseOk:UserSearch200Response :: Maybe Bool
userSearch200ResponseOk = Maybe Bool
forall a. Maybe a
Nothing
  }

-- ** UserSettings
-- | UserSettings
-- UserSettings represents user settings
data UserSettings = UserSettings
  { UserSettings -> Maybe Text
userSettingsDescription :: !(Maybe Text) -- ^ "description"
  , UserSettings -> Maybe Text
userSettingsDiffViewStyle :: !(Maybe Text) -- ^ "diff_view_style"
  , UserSettings -> Maybe Text
userSettingsFullName :: !(Maybe Text) -- ^ "full_name"
  , UserSettings -> Maybe Bool
userSettingsHideActivity :: !(Maybe Bool) -- ^ "hide_activity"
  , UserSettings -> Maybe Bool
userSettingsHideEmail :: !(Maybe Bool) -- ^ "hide_email" - Privacy
  , UserSettings -> Maybe Text
userSettingsLanguage :: !(Maybe Text) -- ^ "language"
  , UserSettings -> Maybe Text
userSettingsLocation :: !(Maybe Text) -- ^ "location"
  , UserSettings -> Maybe Text
userSettingsTheme :: !(Maybe Text) -- ^ "theme"
  , UserSettings -> Maybe Text
userSettingsWebsite :: !(Maybe Text) -- ^ "website"
  } deriving (Int -> UserSettings -> ShowS
[UserSettings] -> ShowS
UserSettings -> [Char]
(Int -> UserSettings -> ShowS)
-> (UserSettings -> [Char])
-> ([UserSettings] -> ShowS)
-> Show UserSettings
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserSettings -> ShowS
showsPrec :: Int -> UserSettings -> ShowS
$cshow :: UserSettings -> [Char]
show :: UserSettings -> [Char]
$cshowList :: [UserSettings] -> ShowS
showList :: [UserSettings] -> ShowS
P.Show, UserSettings -> UserSettings -> Bool
(UserSettings -> UserSettings -> Bool)
-> (UserSettings -> UserSettings -> Bool) -> Eq UserSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserSettings -> UserSettings -> Bool
== :: UserSettings -> UserSettings -> Bool
$c/= :: UserSettings -> UserSettings -> Bool
/= :: UserSettings -> UserSettings -> Bool
P.Eq, P.Typeable)

-- | FromJSON UserSettings
instance A.FromJSON UserSettings where
  parseJSON :: Value -> Parser UserSettings
parseJSON = [Char]
-> (Object -> Parser UserSettings) -> Value -> Parser UserSettings
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"UserSettings" ((Object -> Parser UserSettings) -> Value -> Parser UserSettings)
-> (Object -> Parser UserSettings) -> Value -> Parser UserSettings
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> UserSettings
UserSettings
      (Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> UserSettings)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> UserSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> UserSettings)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> UserSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"diff_view_style")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> UserSettings)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> UserSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"full_name")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> UserSettings)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> UserSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"hide_activity")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> UserSettings)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe Text -> Maybe Text -> UserSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"hide_email")
      Parser
  (Maybe Text
   -> Maybe Text -> Maybe Text -> Maybe Text -> UserSettings)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> Maybe Text -> UserSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"language")
      Parser (Maybe Text -> Maybe Text -> Maybe Text -> UserSettings)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> UserSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"location")
      Parser (Maybe Text -> Maybe Text -> UserSettings)
-> Parser (Maybe Text) -> Parser (Maybe Text -> UserSettings)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"theme")
      Parser (Maybe Text -> UserSettings)
-> Parser (Maybe Text) -> Parser UserSettings
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"website")

-- | ToJSON UserSettings
instance A.ToJSON UserSettings where
  toJSON :: UserSettings -> Value
toJSON UserSettings {Maybe Bool
Maybe Text
$sel:userSettingsDescription:UserSettings :: UserSettings -> Maybe Text
$sel:userSettingsDiffViewStyle:UserSettings :: UserSettings -> Maybe Text
$sel:userSettingsFullName:UserSettings :: UserSettings -> Maybe Text
$sel:userSettingsHideActivity:UserSettings :: UserSettings -> Maybe Bool
$sel:userSettingsHideEmail:UserSettings :: UserSettings -> Maybe Bool
$sel:userSettingsLanguage:UserSettings :: UserSettings -> Maybe Text
$sel:userSettingsLocation:UserSettings :: UserSettings -> Maybe Text
$sel:userSettingsTheme:UserSettings :: UserSettings -> Maybe Text
$sel:userSettingsWebsite:UserSettings :: UserSettings -> Maybe Text
userSettingsDescription :: Maybe Text
userSettingsDiffViewStyle :: Maybe Text
userSettingsFullName :: Maybe Text
userSettingsHideActivity :: Maybe Bool
userSettingsHideEmail :: Maybe Bool
userSettingsLanguage :: Maybe Text
userSettingsLocation :: Maybe Text
userSettingsTheme :: Maybe Text
userSettingsWebsite :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
userSettingsDescription
      , Key
"diff_view_style" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
userSettingsDiffViewStyle
      , Key
"full_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
userSettingsFullName
      , Key
"hide_activity" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
userSettingsHideActivity
      , Key
"hide_email" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
userSettingsHideEmail
      , Key
"language" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
userSettingsLanguage
      , Key
"location" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
userSettingsLocation
      , Key
"theme" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
userSettingsTheme
      , Key
"website" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
userSettingsWebsite
      ]


-- | Construct a value of type 'UserSettings' (by applying it's required fields, if any)
mkUserSettings
  :: UserSettings
mkUserSettings :: UserSettings
mkUserSettings =
  UserSettings
  { $sel:userSettingsDescription:UserSettings :: Maybe Text
userSettingsDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userSettingsDiffViewStyle:UserSettings :: Maybe Text
userSettingsDiffViewStyle = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userSettingsFullName:UserSettings :: Maybe Text
userSettingsFullName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userSettingsHideActivity:UserSettings :: Maybe Bool
userSettingsHideActivity = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:userSettingsHideEmail:UserSettings :: Maybe Bool
userSettingsHideEmail = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:userSettingsLanguage:UserSettings :: Maybe Text
userSettingsLanguage = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userSettingsLocation:UserSettings :: Maybe Text
userSettingsLocation = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userSettingsTheme:UserSettings :: Maybe Text
userSettingsTheme = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userSettingsWebsite:UserSettings :: Maybe Text
userSettingsWebsite = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** UserSettingsOptions
-- | UserSettingsOptions
-- UserSettingsOptions represents options to change user settings
data UserSettingsOptions = UserSettingsOptions
  { UserSettingsOptions -> Maybe Text
userSettingsOptionsDescription :: !(Maybe Text) -- ^ "description"
  , UserSettingsOptions -> Maybe Text
userSettingsOptionsDiffViewStyle :: !(Maybe Text) -- ^ "diff_view_style"
  , UserSettingsOptions -> Maybe Text
userSettingsOptionsFullName :: !(Maybe Text) -- ^ "full_name"
  , UserSettingsOptions -> Maybe Bool
userSettingsOptionsHideActivity :: !(Maybe Bool) -- ^ "hide_activity"
  , UserSettingsOptions -> Maybe Bool
userSettingsOptionsHideEmail :: !(Maybe Bool) -- ^ "hide_email" - Privacy
  , UserSettingsOptions -> Maybe Text
userSettingsOptionsLanguage :: !(Maybe Text) -- ^ "language"
  , UserSettingsOptions -> Maybe Text
userSettingsOptionsLocation :: !(Maybe Text) -- ^ "location"
  , UserSettingsOptions -> Maybe Text
userSettingsOptionsTheme :: !(Maybe Text) -- ^ "theme"
  , UserSettingsOptions -> Maybe Text
userSettingsOptionsWebsite :: !(Maybe Text) -- ^ "website"
  } deriving (Int -> UserSettingsOptions -> ShowS
[UserSettingsOptions] -> ShowS
UserSettingsOptions -> [Char]
(Int -> UserSettingsOptions -> ShowS)
-> (UserSettingsOptions -> [Char])
-> ([UserSettingsOptions] -> ShowS)
-> Show UserSettingsOptions
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserSettingsOptions -> ShowS
showsPrec :: Int -> UserSettingsOptions -> ShowS
$cshow :: UserSettingsOptions -> [Char]
show :: UserSettingsOptions -> [Char]
$cshowList :: [UserSettingsOptions] -> ShowS
showList :: [UserSettingsOptions] -> ShowS
P.Show, UserSettingsOptions -> UserSettingsOptions -> Bool
(UserSettingsOptions -> UserSettingsOptions -> Bool)
-> (UserSettingsOptions -> UserSettingsOptions -> Bool)
-> Eq UserSettingsOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserSettingsOptions -> UserSettingsOptions -> Bool
== :: UserSettingsOptions -> UserSettingsOptions -> Bool
$c/= :: UserSettingsOptions -> UserSettingsOptions -> Bool
/= :: UserSettingsOptions -> UserSettingsOptions -> Bool
P.Eq, P.Typeable)

-- | FromJSON UserSettingsOptions
instance A.FromJSON UserSettingsOptions where
  parseJSON :: Value -> Parser UserSettingsOptions
parseJSON = [Char]
-> (Object -> Parser UserSettingsOptions)
-> Value
-> Parser UserSettingsOptions
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"UserSettingsOptions" ((Object -> Parser UserSettingsOptions)
 -> Value -> Parser UserSettingsOptions)
-> (Object -> Parser UserSettingsOptions)
-> Value
-> Parser UserSettingsOptions
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> UserSettingsOptions
UserSettingsOptions
      (Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Bool
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> UserSettingsOptions)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> UserSettingsOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> UserSettingsOptions)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> UserSettingsOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"diff_view_style")
      Parser
  (Maybe Text
   -> Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> UserSettingsOptions)
-> Parser (Maybe Text)
-> Parser
     (Maybe Bool
      -> Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> UserSettingsOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"full_name")
      Parser
  (Maybe Bool
   -> Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> UserSettingsOptions)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Bool
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> UserSettingsOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"hide_activity")
      Parser
  (Maybe Bool
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> UserSettingsOptions)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Text
      -> Maybe Text -> Maybe Text -> Maybe Text -> UserSettingsOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"hide_email")
      Parser
  (Maybe Text
   -> Maybe Text -> Maybe Text -> Maybe Text -> UserSettingsOptions)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Text -> Maybe Text -> UserSettingsOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"language")
      Parser
  (Maybe Text -> Maybe Text -> Maybe Text -> UserSettingsOptions)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> UserSettingsOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"location")
      Parser (Maybe Text -> Maybe Text -> UserSettingsOptions)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> UserSettingsOptions)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"theme")
      Parser (Maybe Text -> UserSettingsOptions)
-> Parser (Maybe Text) -> Parser UserSettingsOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"website")

-- | ToJSON UserSettingsOptions
instance A.ToJSON UserSettingsOptions where
  toJSON :: UserSettingsOptions -> Value
toJSON UserSettingsOptions {Maybe Bool
Maybe Text
$sel:userSettingsOptionsDescription:UserSettingsOptions :: UserSettingsOptions -> Maybe Text
$sel:userSettingsOptionsDiffViewStyle:UserSettingsOptions :: UserSettingsOptions -> Maybe Text
$sel:userSettingsOptionsFullName:UserSettingsOptions :: UserSettingsOptions -> Maybe Text
$sel:userSettingsOptionsHideActivity:UserSettingsOptions :: UserSettingsOptions -> Maybe Bool
$sel:userSettingsOptionsHideEmail:UserSettingsOptions :: UserSettingsOptions -> Maybe Bool
$sel:userSettingsOptionsLanguage:UserSettingsOptions :: UserSettingsOptions -> Maybe Text
$sel:userSettingsOptionsLocation:UserSettingsOptions :: UserSettingsOptions -> Maybe Text
$sel:userSettingsOptionsTheme:UserSettingsOptions :: UserSettingsOptions -> Maybe Text
$sel:userSettingsOptionsWebsite:UserSettingsOptions :: UserSettingsOptions -> Maybe Text
userSettingsOptionsDescription :: Maybe Text
userSettingsOptionsDiffViewStyle :: Maybe Text
userSettingsOptionsFullName :: Maybe Text
userSettingsOptionsHideActivity :: Maybe Bool
userSettingsOptionsHideEmail :: Maybe Bool
userSettingsOptionsLanguage :: Maybe Text
userSettingsOptionsLocation :: Maybe Text
userSettingsOptionsTheme :: Maybe Text
userSettingsOptionsWebsite :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"description" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
userSettingsOptionsDescription
      , Key
"diff_view_style" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
userSettingsOptionsDiffViewStyle
      , Key
"full_name" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
userSettingsOptionsFullName
      , Key
"hide_activity" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
userSettingsOptionsHideActivity
      , Key
"hide_email" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
userSettingsOptionsHideEmail
      , Key
"language" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
userSettingsOptionsLanguage
      , Key
"location" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
userSettingsOptionsLocation
      , Key
"theme" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
userSettingsOptionsTheme
      , Key
"website" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
userSettingsOptionsWebsite
      ]


-- | Construct a value of type 'UserSettingsOptions' (by applying it's required fields, if any)
mkUserSettingsOptions
  :: UserSettingsOptions
mkUserSettingsOptions :: UserSettingsOptions
mkUserSettingsOptions =
  UserSettingsOptions
  { $sel:userSettingsOptionsDescription:UserSettingsOptions :: Maybe Text
userSettingsOptionsDescription = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userSettingsOptionsDiffViewStyle:UserSettingsOptions :: Maybe Text
userSettingsOptionsDiffViewStyle = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userSettingsOptionsFullName:UserSettingsOptions :: Maybe Text
userSettingsOptionsFullName = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userSettingsOptionsHideActivity:UserSettingsOptions :: Maybe Bool
userSettingsOptionsHideActivity = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:userSettingsOptionsHideEmail:UserSettingsOptions :: Maybe Bool
userSettingsOptionsHideEmail = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:userSettingsOptionsLanguage:UserSettingsOptions :: Maybe Text
userSettingsOptionsLanguage = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userSettingsOptionsLocation:UserSettingsOptions :: Maybe Text
userSettingsOptionsLocation = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userSettingsOptionsTheme:UserSettingsOptions :: Maybe Text
userSettingsOptionsTheme = Maybe Text
forall a. Maybe a
Nothing
  , $sel:userSettingsOptionsWebsite:UserSettingsOptions :: Maybe Text
userSettingsOptionsWebsite = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** WatchInfo
-- | WatchInfo
-- WatchInfo represents an API watch status of one repository
data WatchInfo = WatchInfo
  { WatchInfo -> Maybe DateTime
watchInfoCreatedAt :: !(Maybe DateTime) -- ^ "created_at"
  , WatchInfo -> Maybe Bool
watchInfoIgnored :: !(Maybe Bool) -- ^ "ignored"
  , WatchInfo -> Maybe Value
watchInfoReason :: !(Maybe A.Value) -- ^ "reason"
  , WatchInfo -> Maybe Text
watchInfoRepositoryUrl :: !(Maybe Text) -- ^ "repository_url"
  , WatchInfo -> Maybe Bool
watchInfoSubscribed :: !(Maybe Bool) -- ^ "subscribed"
  , WatchInfo -> Maybe Text
watchInfoUrl :: !(Maybe Text) -- ^ "url"
  } deriving (Int -> WatchInfo -> ShowS
[WatchInfo] -> ShowS
WatchInfo -> [Char]
(Int -> WatchInfo -> ShowS)
-> (WatchInfo -> [Char])
-> ([WatchInfo] -> ShowS)
-> Show WatchInfo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WatchInfo -> ShowS
showsPrec :: Int -> WatchInfo -> ShowS
$cshow :: WatchInfo -> [Char]
show :: WatchInfo -> [Char]
$cshowList :: [WatchInfo] -> ShowS
showList :: [WatchInfo] -> ShowS
P.Show, WatchInfo -> WatchInfo -> Bool
(WatchInfo -> WatchInfo -> Bool)
-> (WatchInfo -> WatchInfo -> Bool) -> Eq WatchInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WatchInfo -> WatchInfo -> Bool
== :: WatchInfo -> WatchInfo -> Bool
$c/= :: WatchInfo -> WatchInfo -> Bool
/= :: WatchInfo -> WatchInfo -> Bool
P.Eq, P.Typeable)

-- | FromJSON WatchInfo
instance A.FromJSON WatchInfo where
  parseJSON :: Value -> Parser WatchInfo
parseJSON = [Char] -> (Object -> Parser WatchInfo) -> Value -> Parser WatchInfo
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"WatchInfo" ((Object -> Parser WatchInfo) -> Value -> Parser WatchInfo)
-> (Object -> Parser WatchInfo) -> Value -> Parser WatchInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe DateTime
-> Maybe Bool
-> Maybe Value
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> WatchInfo
WatchInfo
      (Maybe DateTime
 -> Maybe Bool
 -> Maybe Value
 -> Maybe Text
 -> Maybe Bool
 -> Maybe Text
 -> WatchInfo)
-> Parser (Maybe DateTime)
-> Parser
     (Maybe Bool
      -> Maybe Value
      -> Maybe Text
      -> Maybe Bool
      -> Maybe Text
      -> WatchInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe DateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"created_at")
      Parser
  (Maybe Bool
   -> Maybe Value
   -> Maybe Text
   -> Maybe Bool
   -> Maybe Text
   -> WatchInfo)
-> Parser (Maybe Bool)
-> Parser
     (Maybe Value
      -> Maybe Text -> Maybe Bool -> Maybe Text -> WatchInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ignored")
      Parser
  (Maybe Value
   -> Maybe Text -> Maybe Bool -> Maybe Text -> WatchInfo)
-> Parser (Maybe Value)
-> Parser (Maybe Text -> Maybe Bool -> Maybe Text -> WatchInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"reason")
      Parser (Maybe Text -> Maybe Bool -> Maybe Text -> WatchInfo)
-> Parser (Maybe Text)
-> Parser (Maybe Bool -> Maybe Text -> WatchInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"repository_url")
      Parser (Maybe Bool -> Maybe Text -> WatchInfo)
-> Parser (Maybe Bool) -> Parser (Maybe Text -> WatchInfo)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"subscribed")
      Parser (Maybe Text -> WatchInfo)
-> Parser (Maybe Text) -> Parser WatchInfo
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"url")

-- | ToJSON WatchInfo
instance A.ToJSON WatchInfo where
  toJSON :: WatchInfo -> Value
toJSON WatchInfo {Maybe Bool
Maybe Value
Maybe Text
Maybe DateTime
$sel:watchInfoCreatedAt:WatchInfo :: WatchInfo -> Maybe DateTime
$sel:watchInfoIgnored:WatchInfo :: WatchInfo -> Maybe Bool
$sel:watchInfoReason:WatchInfo :: WatchInfo -> Maybe Value
$sel:watchInfoRepositoryUrl:WatchInfo :: WatchInfo -> Maybe Text
$sel:watchInfoSubscribed:WatchInfo :: WatchInfo -> Maybe Bool
$sel:watchInfoUrl:WatchInfo :: WatchInfo -> Maybe Text
watchInfoCreatedAt :: Maybe DateTime
watchInfoIgnored :: Maybe Bool
watchInfoReason :: Maybe Value
watchInfoRepositoryUrl :: Maybe Text
watchInfoSubscribed :: Maybe Bool
watchInfoUrl :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"created_at" Key -> Maybe DateTime -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe DateTime
watchInfoCreatedAt
      , Key
"ignored" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
watchInfoIgnored
      , Key
"reason" Key -> Maybe Value -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Value
watchInfoReason
      , Key
"repository_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
watchInfoRepositoryUrl
      , Key
"subscribed" Key -> Maybe Bool -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Bool
watchInfoSubscribed
      , Key
"url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
watchInfoUrl
      ]


-- | Construct a value of type 'WatchInfo' (by applying it's required fields, if any)
mkWatchInfo
  :: WatchInfo
mkWatchInfo :: WatchInfo
mkWatchInfo =
  WatchInfo
  { $sel:watchInfoCreatedAt:WatchInfo :: Maybe DateTime
watchInfoCreatedAt = Maybe DateTime
forall a. Maybe a
Nothing
  , $sel:watchInfoIgnored:WatchInfo :: Maybe Bool
watchInfoIgnored = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:watchInfoReason:WatchInfo :: Maybe Value
watchInfoReason = Maybe Value
forall a. Maybe a
Nothing
  , $sel:watchInfoRepositoryUrl:WatchInfo :: Maybe Text
watchInfoRepositoryUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:watchInfoSubscribed:WatchInfo :: Maybe Bool
watchInfoSubscribed = Maybe Bool
forall a. Maybe a
Nothing
  , $sel:watchInfoUrl:WatchInfo :: Maybe Text
watchInfoUrl = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** WikiCommit
-- | WikiCommit
-- WikiCommit page commit/revision
data WikiCommit = WikiCommit
  { WikiCommit -> Maybe CommitUser
wikiCommitAuthor :: !(Maybe CommitUser) -- ^ "author"
  , WikiCommit -> Maybe CommitUser
wikiCommitCommiter :: !(Maybe CommitUser) -- ^ "commiter"
  , WikiCommit -> Maybe Text
wikiCommitMessage :: !(Maybe Text) -- ^ "message"
  , WikiCommit -> Maybe Text
wikiCommitSha :: !(Maybe Text) -- ^ "sha"
  } deriving (Int -> WikiCommit -> ShowS
[WikiCommit] -> ShowS
WikiCommit -> [Char]
(Int -> WikiCommit -> ShowS)
-> (WikiCommit -> [Char])
-> ([WikiCommit] -> ShowS)
-> Show WikiCommit
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WikiCommit -> ShowS
showsPrec :: Int -> WikiCommit -> ShowS
$cshow :: WikiCommit -> [Char]
show :: WikiCommit -> [Char]
$cshowList :: [WikiCommit] -> ShowS
showList :: [WikiCommit] -> ShowS
P.Show, WikiCommit -> WikiCommit -> Bool
(WikiCommit -> WikiCommit -> Bool)
-> (WikiCommit -> WikiCommit -> Bool) -> Eq WikiCommit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WikiCommit -> WikiCommit -> Bool
== :: WikiCommit -> WikiCommit -> Bool
$c/= :: WikiCommit -> WikiCommit -> Bool
/= :: WikiCommit -> WikiCommit -> Bool
P.Eq, P.Typeable)

-- | FromJSON WikiCommit
instance A.FromJSON WikiCommit where
  parseJSON :: Value -> Parser WikiCommit
parseJSON = [Char]
-> (Object -> Parser WikiCommit) -> Value -> Parser WikiCommit
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"WikiCommit" ((Object -> Parser WikiCommit) -> Value -> Parser WikiCommit)
-> (Object -> Parser WikiCommit) -> Value -> Parser WikiCommit
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe CommitUser
-> Maybe CommitUser -> Maybe Text -> Maybe Text -> WikiCommit
WikiCommit
      (Maybe CommitUser
 -> Maybe CommitUser -> Maybe Text -> Maybe Text -> WikiCommit)
-> Parser (Maybe CommitUser)
-> Parser
     (Maybe CommitUser -> Maybe Text -> Maybe Text -> WikiCommit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe CommitUser)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"author")
      Parser (Maybe CommitUser -> Maybe Text -> Maybe Text -> WikiCommit)
-> Parser (Maybe CommitUser)
-> Parser (Maybe Text -> Maybe Text -> WikiCommit)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe CommitUser)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"commiter")
      Parser (Maybe Text -> Maybe Text -> WikiCommit)
-> Parser (Maybe Text) -> Parser (Maybe Text -> WikiCommit)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"message")
      Parser (Maybe Text -> WikiCommit)
-> Parser (Maybe Text) -> Parser WikiCommit
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sha")

-- | ToJSON WikiCommit
instance A.ToJSON WikiCommit where
  toJSON :: WikiCommit -> Value
toJSON WikiCommit {Maybe Text
Maybe CommitUser
$sel:wikiCommitAuthor:WikiCommit :: WikiCommit -> Maybe CommitUser
$sel:wikiCommitCommiter:WikiCommit :: WikiCommit -> Maybe CommitUser
$sel:wikiCommitMessage:WikiCommit :: WikiCommit -> Maybe Text
$sel:wikiCommitSha:WikiCommit :: WikiCommit -> Maybe Text
wikiCommitAuthor :: Maybe CommitUser
wikiCommitCommiter :: Maybe CommitUser
wikiCommitMessage :: Maybe Text
wikiCommitSha :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"author" Key -> Maybe CommitUser -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe CommitUser
wikiCommitAuthor
      , Key
"commiter" Key -> Maybe CommitUser -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe CommitUser
wikiCommitCommiter
      , Key
"message" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
wikiCommitMessage
      , Key
"sha" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
wikiCommitSha
      ]


-- | Construct a value of type 'WikiCommit' (by applying it's required fields, if any)
mkWikiCommit
  :: WikiCommit
mkWikiCommit :: WikiCommit
mkWikiCommit =
  WikiCommit
  { $sel:wikiCommitAuthor:WikiCommit :: Maybe CommitUser
wikiCommitAuthor = Maybe CommitUser
forall a. Maybe a
Nothing
  , $sel:wikiCommitCommiter:WikiCommit :: Maybe CommitUser
wikiCommitCommiter = Maybe CommitUser
forall a. Maybe a
Nothing
  , $sel:wikiCommitMessage:WikiCommit :: Maybe Text
wikiCommitMessage = Maybe Text
forall a. Maybe a
Nothing
  , $sel:wikiCommitSha:WikiCommit :: Maybe Text
wikiCommitSha = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** WikiCommitList
-- | WikiCommitList
-- WikiCommitList commit/revision list
data WikiCommitList = WikiCommitList
  { WikiCommitList -> Maybe [WikiCommit]
wikiCommitListCommits :: !(Maybe [WikiCommit]) -- ^ "commits"
  , WikiCommitList -> Maybe Integer
wikiCommitListCount :: !(Maybe Integer) -- ^ "count"
  } deriving (Int -> WikiCommitList -> ShowS
[WikiCommitList] -> ShowS
WikiCommitList -> [Char]
(Int -> WikiCommitList -> ShowS)
-> (WikiCommitList -> [Char])
-> ([WikiCommitList] -> ShowS)
-> Show WikiCommitList
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WikiCommitList -> ShowS
showsPrec :: Int -> WikiCommitList -> ShowS
$cshow :: WikiCommitList -> [Char]
show :: WikiCommitList -> [Char]
$cshowList :: [WikiCommitList] -> ShowS
showList :: [WikiCommitList] -> ShowS
P.Show, WikiCommitList -> WikiCommitList -> Bool
(WikiCommitList -> WikiCommitList -> Bool)
-> (WikiCommitList -> WikiCommitList -> Bool) -> Eq WikiCommitList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WikiCommitList -> WikiCommitList -> Bool
== :: WikiCommitList -> WikiCommitList -> Bool
$c/= :: WikiCommitList -> WikiCommitList -> Bool
/= :: WikiCommitList -> WikiCommitList -> Bool
P.Eq, P.Typeable)

-- | FromJSON WikiCommitList
instance A.FromJSON WikiCommitList where
  parseJSON :: Value -> Parser WikiCommitList
parseJSON = [Char]
-> (Object -> Parser WikiCommitList)
-> Value
-> Parser WikiCommitList
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"WikiCommitList" ((Object -> Parser WikiCommitList)
 -> Value -> Parser WikiCommitList)
-> (Object -> Parser WikiCommitList)
-> Value
-> Parser WikiCommitList
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [WikiCommit] -> Maybe Integer -> WikiCommitList
WikiCommitList
      (Maybe [WikiCommit] -> Maybe Integer -> WikiCommitList)
-> Parser (Maybe [WikiCommit])
-> Parser (Maybe Integer -> WikiCommitList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [WikiCommit])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"commits")
      Parser (Maybe Integer -> WikiCommitList)
-> Parser (Maybe Integer) -> Parser WikiCommitList
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"count")

-- | ToJSON WikiCommitList
instance A.ToJSON WikiCommitList where
  toJSON :: WikiCommitList -> Value
toJSON WikiCommitList {Maybe Integer
Maybe [WikiCommit]
$sel:wikiCommitListCommits:WikiCommitList :: WikiCommitList -> Maybe [WikiCommit]
$sel:wikiCommitListCount:WikiCommitList :: WikiCommitList -> Maybe Integer
wikiCommitListCommits :: Maybe [WikiCommit]
wikiCommitListCount :: Maybe Integer
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"commits" Key -> Maybe [WikiCommit] -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe [WikiCommit]
wikiCommitListCommits
      , Key
"count" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
wikiCommitListCount
      ]


-- | Construct a value of type 'WikiCommitList' (by applying it's required fields, if any)
mkWikiCommitList
  :: WikiCommitList
mkWikiCommitList :: WikiCommitList
mkWikiCommitList =
  WikiCommitList
  { $sel:wikiCommitListCommits:WikiCommitList :: Maybe [WikiCommit]
wikiCommitListCommits = Maybe [WikiCommit]
forall a. Maybe a
Nothing
  , $sel:wikiCommitListCount:WikiCommitList :: Maybe Integer
wikiCommitListCount = Maybe Integer
forall a. Maybe a
Nothing
  }

-- ** WikiPage
-- | WikiPage
-- WikiPage a wiki page
data WikiPage = WikiPage
  { WikiPage -> Maybe Integer
wikiPageCommitCount :: !(Maybe Integer) -- ^ "commit_count"
  , WikiPage -> Maybe Text
wikiPageContentBase64 :: !(Maybe Text) -- ^ "content_base64" - Page content, base64 encoded
  , WikiPage -> Maybe Text
wikiPageFooter :: !(Maybe Text) -- ^ "footer"
  , WikiPage -> Maybe Text
wikiPageHtmlUrl :: !(Maybe Text) -- ^ "html_url"
  , WikiPage -> Maybe WikiCommit
wikiPageLastCommit :: !(Maybe WikiCommit) -- ^ "last_commit"
  , WikiPage -> Maybe Text
wikiPageSidebar :: !(Maybe Text) -- ^ "sidebar"
  , WikiPage -> Maybe Text
wikiPageSubUrl :: !(Maybe Text) -- ^ "sub_url"
  , WikiPage -> Maybe Text
wikiPageTitle :: !(Maybe Text) -- ^ "title"
  } deriving (Int -> WikiPage -> ShowS
[WikiPage] -> ShowS
WikiPage -> [Char]
(Int -> WikiPage -> ShowS)
-> (WikiPage -> [Char]) -> ([WikiPage] -> ShowS) -> Show WikiPage
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WikiPage -> ShowS
showsPrec :: Int -> WikiPage -> ShowS
$cshow :: WikiPage -> [Char]
show :: WikiPage -> [Char]
$cshowList :: [WikiPage] -> ShowS
showList :: [WikiPage] -> ShowS
P.Show, WikiPage -> WikiPage -> Bool
(WikiPage -> WikiPage -> Bool)
-> (WikiPage -> WikiPage -> Bool) -> Eq WikiPage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WikiPage -> WikiPage -> Bool
== :: WikiPage -> WikiPage -> Bool
$c/= :: WikiPage -> WikiPage -> Bool
/= :: WikiPage -> WikiPage -> Bool
P.Eq, P.Typeable)

-- | FromJSON WikiPage
instance A.FromJSON WikiPage where
  parseJSON :: Value -> Parser WikiPage
parseJSON = [Char] -> (Object -> Parser WikiPage) -> Value -> Parser WikiPage
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"WikiPage" ((Object -> Parser WikiPage) -> Value -> Parser WikiPage)
-> (Object -> Parser WikiPage) -> Value -> Parser WikiPage
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Integer
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe WikiCommit
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> WikiPage
WikiPage
      (Maybe Integer
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe WikiCommit
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> WikiPage)
-> Parser (Maybe Integer)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe WikiCommit
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> WikiPage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"commit_count")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe WikiCommit
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> WikiPage)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe WikiCommit
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> WikiPage)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"content_base64")
      Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe WikiCommit
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> WikiPage)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe WikiCommit
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> WikiPage)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"footer")
      Parser
  (Maybe Text
   -> Maybe WikiCommit
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> WikiPage)
-> Parser (Maybe Text)
-> Parser
     (Maybe WikiCommit
      -> Maybe Text -> Maybe Text -> Maybe Text -> WikiPage)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"html_url")
      Parser
  (Maybe WikiCommit
   -> Maybe Text -> Maybe Text -> Maybe Text -> WikiPage)
-> Parser (Maybe WikiCommit)
-> Parser (Maybe Text -> Maybe Text -> Maybe Text -> WikiPage)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe WikiCommit)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"last_commit")
      Parser (Maybe Text -> Maybe Text -> Maybe Text -> WikiPage)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> WikiPage)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sidebar")
      Parser (Maybe Text -> Maybe Text -> WikiPage)
-> Parser (Maybe Text) -> Parser (Maybe Text -> WikiPage)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sub_url")
      Parser (Maybe Text -> WikiPage)
-> Parser (Maybe Text) -> Parser WikiPage
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title")

-- | ToJSON WikiPage
instance A.ToJSON WikiPage where
  toJSON :: WikiPage -> Value
toJSON WikiPage {Maybe Integer
Maybe Text
Maybe WikiCommit
$sel:wikiPageCommitCount:WikiPage :: WikiPage -> Maybe Integer
$sel:wikiPageContentBase64:WikiPage :: WikiPage -> Maybe Text
$sel:wikiPageFooter:WikiPage :: WikiPage -> Maybe Text
$sel:wikiPageHtmlUrl:WikiPage :: WikiPage -> Maybe Text
$sel:wikiPageLastCommit:WikiPage :: WikiPage -> Maybe WikiCommit
$sel:wikiPageSidebar:WikiPage :: WikiPage -> Maybe Text
$sel:wikiPageSubUrl:WikiPage :: WikiPage -> Maybe Text
$sel:wikiPageTitle:WikiPage :: WikiPage -> Maybe Text
wikiPageCommitCount :: Maybe Integer
wikiPageContentBase64 :: Maybe Text
wikiPageFooter :: Maybe Text
wikiPageHtmlUrl :: Maybe Text
wikiPageLastCommit :: Maybe WikiCommit
wikiPageSidebar :: Maybe Text
wikiPageSubUrl :: Maybe Text
wikiPageTitle :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"commit_count" Key -> Maybe Integer -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Integer
wikiPageCommitCount
      , Key
"content_base64" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
wikiPageContentBase64
      , Key
"footer" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
wikiPageFooter
      , Key
"html_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
wikiPageHtmlUrl
      , Key
"last_commit" Key -> Maybe WikiCommit -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe WikiCommit
wikiPageLastCommit
      , Key
"sidebar" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
wikiPageSidebar
      , Key
"sub_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
wikiPageSubUrl
      , Key
"title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
wikiPageTitle
      ]


-- | Construct a value of type 'WikiPage' (by applying it's required fields, if any)
mkWikiPage
  :: WikiPage
mkWikiPage :: WikiPage
mkWikiPage =
  WikiPage
  { $sel:wikiPageCommitCount:WikiPage :: Maybe Integer
wikiPageCommitCount = Maybe Integer
forall a. Maybe a
Nothing
  , $sel:wikiPageContentBase64:WikiPage :: Maybe Text
wikiPageContentBase64 = Maybe Text
forall a. Maybe a
Nothing
  , $sel:wikiPageFooter:WikiPage :: Maybe Text
wikiPageFooter = Maybe Text
forall a. Maybe a
Nothing
  , $sel:wikiPageHtmlUrl:WikiPage :: Maybe Text
wikiPageHtmlUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:wikiPageLastCommit:WikiPage :: Maybe WikiCommit
wikiPageLastCommit = Maybe WikiCommit
forall a. Maybe a
Nothing
  , $sel:wikiPageSidebar:WikiPage :: Maybe Text
wikiPageSidebar = Maybe Text
forall a. Maybe a
Nothing
  , $sel:wikiPageSubUrl:WikiPage :: Maybe Text
wikiPageSubUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:wikiPageTitle:WikiPage :: Maybe Text
wikiPageTitle = Maybe Text
forall a. Maybe a
Nothing
  }

-- ** WikiPageMetaData
-- | WikiPageMetaData
-- WikiPageMetaData wiki page meta information
data WikiPageMetaData = WikiPageMetaData
  { WikiPageMetaData -> Maybe Text
wikiPageMetaDataHtmlUrl :: !(Maybe Text) -- ^ "html_url"
  , WikiPageMetaData -> Maybe WikiCommit
wikiPageMetaDataLastCommit :: !(Maybe WikiCommit) -- ^ "last_commit"
  , WikiPageMetaData -> Maybe Text
wikiPageMetaDataSubUrl :: !(Maybe Text) -- ^ "sub_url"
  , WikiPageMetaData -> Maybe Text
wikiPageMetaDataTitle :: !(Maybe Text) -- ^ "title"
  } deriving (Int -> WikiPageMetaData -> ShowS
[WikiPageMetaData] -> ShowS
WikiPageMetaData -> [Char]
(Int -> WikiPageMetaData -> ShowS)
-> (WikiPageMetaData -> [Char])
-> ([WikiPageMetaData] -> ShowS)
-> Show WikiPageMetaData
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WikiPageMetaData -> ShowS
showsPrec :: Int -> WikiPageMetaData -> ShowS
$cshow :: WikiPageMetaData -> [Char]
show :: WikiPageMetaData -> [Char]
$cshowList :: [WikiPageMetaData] -> ShowS
showList :: [WikiPageMetaData] -> ShowS
P.Show, WikiPageMetaData -> WikiPageMetaData -> Bool
(WikiPageMetaData -> WikiPageMetaData -> Bool)
-> (WikiPageMetaData -> WikiPageMetaData -> Bool)
-> Eq WikiPageMetaData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WikiPageMetaData -> WikiPageMetaData -> Bool
== :: WikiPageMetaData -> WikiPageMetaData -> Bool
$c/= :: WikiPageMetaData -> WikiPageMetaData -> Bool
/= :: WikiPageMetaData -> WikiPageMetaData -> Bool
P.Eq, P.Typeable)

-- | FromJSON WikiPageMetaData
instance A.FromJSON WikiPageMetaData where
  parseJSON :: Value -> Parser WikiPageMetaData
parseJSON = [Char]
-> (Object -> Parser WikiPageMetaData)
-> Value
-> Parser WikiPageMetaData
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"WikiPageMetaData" ((Object -> Parser WikiPageMetaData)
 -> Value -> Parser WikiPageMetaData)
-> (Object -> Parser WikiPageMetaData)
-> Value
-> Parser WikiPageMetaData
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe WikiCommit -> Maybe Text -> Maybe Text -> WikiPageMetaData
WikiPageMetaData
      (Maybe Text
 -> Maybe WikiCommit
 -> Maybe Text
 -> Maybe Text
 -> WikiPageMetaData)
-> Parser (Maybe Text)
-> Parser
     (Maybe WikiCommit -> Maybe Text -> Maybe Text -> WikiPageMetaData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"html_url")
      Parser
  (Maybe WikiCommit -> Maybe Text -> Maybe Text -> WikiPageMetaData)
-> Parser (Maybe WikiCommit)
-> Parser (Maybe Text -> Maybe Text -> WikiPageMetaData)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe WikiCommit)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"last_commit")
      Parser (Maybe Text -> Maybe Text -> WikiPageMetaData)
-> Parser (Maybe Text) -> Parser (Maybe Text -> WikiPageMetaData)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sub_url")
      Parser (Maybe Text -> WikiPageMetaData)
-> Parser (Maybe Text) -> Parser WikiPageMetaData
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"title")

-- | ToJSON WikiPageMetaData
instance A.ToJSON WikiPageMetaData where
  toJSON :: WikiPageMetaData -> Value
toJSON WikiPageMetaData {Maybe Text
Maybe WikiCommit
$sel:wikiPageMetaDataHtmlUrl:WikiPageMetaData :: WikiPageMetaData -> Maybe Text
$sel:wikiPageMetaDataLastCommit:WikiPageMetaData :: WikiPageMetaData -> Maybe WikiCommit
$sel:wikiPageMetaDataSubUrl:WikiPageMetaData :: WikiPageMetaData -> Maybe Text
$sel:wikiPageMetaDataTitle:WikiPageMetaData :: WikiPageMetaData -> Maybe Text
wikiPageMetaDataHtmlUrl :: Maybe Text
wikiPageMetaDataLastCommit :: Maybe WikiCommit
wikiPageMetaDataSubUrl :: Maybe Text
wikiPageMetaDataTitle :: Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"html_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
wikiPageMetaDataHtmlUrl
      , Key
"last_commit" Key -> Maybe WikiCommit -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe WikiCommit
wikiPageMetaDataLastCommit
      , Key
"sub_url" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
wikiPageMetaDataSubUrl
      , Key
"title" Key -> Maybe Text -> (Key, Value)
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> (Key, Value)
.= Maybe Text
wikiPageMetaDataTitle
      ]


-- | Construct a value of type 'WikiPageMetaData' (by applying it's required fields, if any)
mkWikiPageMetaData
  :: WikiPageMetaData
mkWikiPageMetaData :: WikiPageMetaData
mkWikiPageMetaData =
  WikiPageMetaData
  { $sel:wikiPageMetaDataHtmlUrl:WikiPageMetaData :: Maybe Text
wikiPageMetaDataHtmlUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:wikiPageMetaDataLastCommit:WikiPageMetaData :: Maybe WikiCommit
wikiPageMetaDataLastCommit = Maybe WikiCommit
forall a. Maybe a
Nothing
  , $sel:wikiPageMetaDataSubUrl:WikiPageMetaData :: Maybe Text
wikiPageMetaDataSubUrl = Maybe Text
forall a. Maybe a
Nothing
  , $sel:wikiPageMetaDataTitle:WikiPageMetaData :: Maybe Text
wikiPageMetaDataTitle = Maybe Text
forall a. Maybe a
Nothing
  }


-- * Enums


-- ** E'DiffType

-- | Enum of 'Text'
data E'DiffType
  = E'DiffType'Diff -- ^ @"diff"@
  | E'DiffType'Patch -- ^ @"patch"@
  deriving (Int -> E'DiffType -> ShowS
[E'DiffType] -> ShowS
E'DiffType -> [Char]
(Int -> E'DiffType -> ShowS)
-> (E'DiffType -> [Char])
-> ([E'DiffType] -> ShowS)
-> Show E'DiffType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> E'DiffType -> ShowS
showsPrec :: Int -> E'DiffType -> ShowS
$cshow :: E'DiffType -> [Char]
show :: E'DiffType -> [Char]
$cshowList :: [E'DiffType] -> ShowS
showList :: [E'DiffType] -> ShowS
P.Show, E'DiffType -> E'DiffType -> Bool
(E'DiffType -> E'DiffType -> Bool)
-> (E'DiffType -> E'DiffType -> Bool) -> Eq E'DiffType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: E'DiffType -> E'DiffType -> Bool
== :: E'DiffType -> E'DiffType -> Bool
$c/= :: E'DiffType -> E'DiffType -> Bool
/= :: E'DiffType -> E'DiffType -> Bool
P.Eq, P.Typeable, Eq E'DiffType
Eq E'DiffType =>
(E'DiffType -> E'DiffType -> Ordering)
-> (E'DiffType -> E'DiffType -> Bool)
-> (E'DiffType -> E'DiffType -> Bool)
-> (E'DiffType -> E'DiffType -> Bool)
-> (E'DiffType -> E'DiffType -> Bool)
-> (E'DiffType -> E'DiffType -> E'DiffType)
-> (E'DiffType -> E'DiffType -> E'DiffType)
-> Ord E'DiffType
E'DiffType -> E'DiffType -> Bool
E'DiffType -> E'DiffType -> Ordering
E'DiffType -> E'DiffType -> E'DiffType
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
$ccompare :: E'DiffType -> E'DiffType -> Ordering
compare :: E'DiffType -> E'DiffType -> Ordering
$c< :: E'DiffType -> E'DiffType -> Bool
< :: E'DiffType -> E'DiffType -> Bool
$c<= :: E'DiffType -> E'DiffType -> Bool
<= :: E'DiffType -> E'DiffType -> Bool
$c> :: E'DiffType -> E'DiffType -> Bool
> :: E'DiffType -> E'DiffType -> Bool
$c>= :: E'DiffType -> E'DiffType -> Bool
>= :: E'DiffType -> E'DiffType -> Bool
$cmax :: E'DiffType -> E'DiffType -> E'DiffType
max :: E'DiffType -> E'DiffType -> E'DiffType
$cmin :: E'DiffType -> E'DiffType -> E'DiffType
min :: E'DiffType -> E'DiffType -> E'DiffType
P.Ord, E'DiffType
E'DiffType -> E'DiffType -> Bounded E'DiffType
forall a. a -> a -> Bounded a
$cminBound :: E'DiffType
minBound :: E'DiffType
$cmaxBound :: E'DiffType
maxBound :: E'DiffType
P.Bounded, Int -> E'DiffType
E'DiffType -> Int
E'DiffType -> [E'DiffType]
E'DiffType -> E'DiffType
E'DiffType -> E'DiffType -> [E'DiffType]
E'DiffType -> E'DiffType -> E'DiffType -> [E'DiffType]
(E'DiffType -> E'DiffType)
-> (E'DiffType -> E'DiffType)
-> (Int -> E'DiffType)
-> (E'DiffType -> Int)
-> (E'DiffType -> [E'DiffType])
-> (E'DiffType -> E'DiffType -> [E'DiffType])
-> (E'DiffType -> E'DiffType -> [E'DiffType])
-> (E'DiffType -> E'DiffType -> E'DiffType -> [E'DiffType])
-> Enum E'DiffType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: E'DiffType -> E'DiffType
succ :: E'DiffType -> E'DiffType
$cpred :: E'DiffType -> E'DiffType
pred :: E'DiffType -> E'DiffType
$ctoEnum :: Int -> E'DiffType
toEnum :: Int -> E'DiffType
$cfromEnum :: E'DiffType -> Int
fromEnum :: E'DiffType -> Int
$cenumFrom :: E'DiffType -> [E'DiffType]
enumFrom :: E'DiffType -> [E'DiffType]
$cenumFromThen :: E'DiffType -> E'DiffType -> [E'DiffType]
enumFromThen :: E'DiffType -> E'DiffType -> [E'DiffType]
$cenumFromTo :: E'DiffType -> E'DiffType -> [E'DiffType]
enumFromTo :: E'DiffType -> E'DiffType -> [E'DiffType]
$cenumFromThenTo :: E'DiffType -> E'DiffType -> E'DiffType -> [E'DiffType]
enumFromThenTo :: E'DiffType -> E'DiffType -> E'DiffType -> [E'DiffType]
P.Enum)

instance A.ToJSON E'DiffType where toJSON :: E'DiffType -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value) -> (E'DiffType -> Text) -> E'DiffType -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'DiffType -> Text
fromE'DiffType
instance A.FromJSON E'DiffType where parseJSON :: Value -> Parser E'DiffType
parseJSON Value
o = ([Char] -> Parser E'DiffType)
-> (E'DiffType -> Parser E'DiffType)
-> Either [Char] E'DiffType
-> Parser E'DiffType
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either [Char] -> Parser E'DiffType
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
P.fail (E'DiffType -> Parser E'DiffType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E'DiffType -> Parser E'DiffType)
-> (E'DiffType -> E'DiffType) -> E'DiffType -> Parser E'DiffType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'DiffType -> E'DiffType
forall a. a -> a
P.id) (Either [Char] E'DiffType -> Parser E'DiffType)
-> (Text -> Either [Char] E'DiffType) -> Text -> Parser E'DiffType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'DiffType
toE'DiffType (Text -> Parser E'DiffType) -> Parser Text -> Parser E'DiffType
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData E'DiffType where toQueryParam :: E'DiffType -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text) -> (E'DiffType -> Text) -> E'DiffType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'DiffType -> Text
fromE'DiffType
instance WH.FromHttpApiData E'DiffType where parseQueryParam :: Text -> Either Text E'DiffType
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text E'DiffType) -> Either Text E'DiffType
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> Text)
-> Either [Char] E'DiffType -> Either Text E'DiffType
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left [Char] -> Text
T.pack (Either [Char] E'DiffType -> Either Text E'DiffType)
-> (Text -> Either [Char] E'DiffType)
-> Text
-> Either Text E'DiffType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'DiffType
toE'DiffType
instance MimeRender MimeMultipartFormData E'DiffType where mimeRender :: Proxy MimeMultipartFormData -> E'DiffType -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = E'DiffType -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'E'DiffType' enum
fromE'DiffType :: E'DiffType -> Text
fromE'DiffType :: E'DiffType -> Text
fromE'DiffType = \case
  E'DiffType
E'DiffType'Diff -> Text
"diff"
  E'DiffType
E'DiffType'Patch -> Text
"patch"

-- | parse 'E'DiffType' enum
toE'DiffType :: Text -> P.Either String E'DiffType
toE'DiffType :: Text -> Either [Char] E'DiffType
toE'DiffType = \case
  Text
"diff" -> E'DiffType -> Either [Char] E'DiffType
forall a b. b -> Either a b
P.Right E'DiffType
E'DiffType'Diff
  Text
"patch" -> E'DiffType -> Either [Char] E'DiffType
forall a b. b -> Either a b
P.Right E'DiffType
E'DiffType'Patch
  Text
s -> [Char] -> Either [Char] E'DiffType
forall a b. a -> Either a b
P.Left ([Char] -> Either [Char] E'DiffType)
-> [Char] -> Either [Char] E'DiffType
forall a b. (a -> b) -> a -> b
$ [Char]
"toE'DiffType: enum parse failure: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> [Char]
forall a. Show a => a -> [Char]
P.show Text
s


-- ** E'Do

-- | Enum of 'Text'
data E'Do
  = E'Do'Merge -- ^ @"merge"@
  | E'Do'Rebase -- ^ @"rebase"@
  | E'Do'Rebase_merge -- ^ @"rebase-merge"@
  | E'Do'Squash -- ^ @"squash"@
  | E'Do'Fast_forward_only -- ^ @"fast-forward-only"@
  | E'Do'Manually_merged -- ^ @"manually-merged"@
  deriving (Int -> E'Do -> ShowS
[E'Do] -> ShowS
E'Do -> [Char]
(Int -> E'Do -> ShowS)
-> (E'Do -> [Char]) -> ([E'Do] -> ShowS) -> Show E'Do
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> E'Do -> ShowS
showsPrec :: Int -> E'Do -> ShowS
$cshow :: E'Do -> [Char]
show :: E'Do -> [Char]
$cshowList :: [E'Do] -> ShowS
showList :: [E'Do] -> ShowS
P.Show, E'Do -> E'Do -> Bool
(E'Do -> E'Do -> Bool) -> (E'Do -> E'Do -> Bool) -> Eq E'Do
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: E'Do -> E'Do -> Bool
== :: E'Do -> E'Do -> Bool
$c/= :: E'Do -> E'Do -> Bool
/= :: E'Do -> E'Do -> Bool
P.Eq, P.Typeable, Eq E'Do
Eq E'Do =>
(E'Do -> E'Do -> Ordering)
-> (E'Do -> E'Do -> Bool)
-> (E'Do -> E'Do -> Bool)
-> (E'Do -> E'Do -> Bool)
-> (E'Do -> E'Do -> Bool)
-> (E'Do -> E'Do -> E'Do)
-> (E'Do -> E'Do -> E'Do)
-> Ord E'Do
E'Do -> E'Do -> Bool
E'Do -> E'Do -> Ordering
E'Do -> E'Do -> E'Do
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
$ccompare :: E'Do -> E'Do -> Ordering
compare :: E'Do -> E'Do -> Ordering
$c< :: E'Do -> E'Do -> Bool
< :: E'Do -> E'Do -> Bool
$c<= :: E'Do -> E'Do -> Bool
<= :: E'Do -> E'Do -> Bool
$c> :: E'Do -> E'Do -> Bool
> :: E'Do -> E'Do -> Bool
$c>= :: E'Do -> E'Do -> Bool
>= :: E'Do -> E'Do -> Bool
$cmax :: E'Do -> E'Do -> E'Do
max :: E'Do -> E'Do -> E'Do
$cmin :: E'Do -> E'Do -> E'Do
min :: E'Do -> E'Do -> E'Do
P.Ord, E'Do
E'Do -> E'Do -> Bounded E'Do
forall a. a -> a -> Bounded a
$cminBound :: E'Do
minBound :: E'Do
$cmaxBound :: E'Do
maxBound :: E'Do
P.Bounded, Int -> E'Do
E'Do -> Int
E'Do -> [E'Do]
E'Do -> E'Do
E'Do -> E'Do -> [E'Do]
E'Do -> E'Do -> E'Do -> [E'Do]
(E'Do -> E'Do)
-> (E'Do -> E'Do)
-> (Int -> E'Do)
-> (E'Do -> Int)
-> (E'Do -> [E'Do])
-> (E'Do -> E'Do -> [E'Do])
-> (E'Do -> E'Do -> [E'Do])
-> (E'Do -> E'Do -> E'Do -> [E'Do])
-> Enum E'Do
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: E'Do -> E'Do
succ :: E'Do -> E'Do
$cpred :: E'Do -> E'Do
pred :: E'Do -> E'Do
$ctoEnum :: Int -> E'Do
toEnum :: Int -> E'Do
$cfromEnum :: E'Do -> Int
fromEnum :: E'Do -> Int
$cenumFrom :: E'Do -> [E'Do]
enumFrom :: E'Do -> [E'Do]
$cenumFromThen :: E'Do -> E'Do -> [E'Do]
enumFromThen :: E'Do -> E'Do -> [E'Do]
$cenumFromTo :: E'Do -> E'Do -> [E'Do]
enumFromTo :: E'Do -> E'Do -> [E'Do]
$cenumFromThenTo :: E'Do -> E'Do -> E'Do -> [E'Do]
enumFromThenTo :: E'Do -> E'Do -> E'Do -> [E'Do]
P.Enum)

instance A.ToJSON E'Do where toJSON :: E'Do -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value) -> (E'Do -> Text) -> E'Do -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Do -> Text
fromE'Do
instance A.FromJSON E'Do where parseJSON :: Value -> Parser E'Do
parseJSON Value
o = ([Char] -> Parser E'Do)
-> (E'Do -> Parser E'Do) -> Either [Char] E'Do -> Parser E'Do
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either [Char] -> Parser E'Do
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
P.fail (E'Do -> Parser E'Do
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E'Do -> Parser E'Do) -> (E'Do -> E'Do) -> E'Do -> Parser E'Do
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Do -> E'Do
forall a. a -> a
P.id) (Either [Char] E'Do -> Parser E'Do)
-> (Text -> Either [Char] E'Do) -> Text -> Parser E'Do
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Do
toE'Do (Text -> Parser E'Do) -> Parser Text -> Parser E'Do
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData E'Do where toQueryParam :: E'Do -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text) -> (E'Do -> Text) -> E'Do -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Do -> Text
fromE'Do
instance WH.FromHttpApiData E'Do where parseQueryParam :: Text -> Either Text E'Do
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text -> (Text -> Either Text E'Do) -> Either Text E'Do
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> Text) -> Either [Char] E'Do -> Either Text E'Do
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left [Char] -> Text
T.pack (Either [Char] E'Do -> Either Text E'Do)
-> (Text -> Either [Char] E'Do) -> Text -> Either Text E'Do
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Do
toE'Do
instance MimeRender MimeMultipartFormData E'Do where mimeRender :: Proxy MimeMultipartFormData -> E'Do -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = E'Do -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'E'Do' enum
fromE'Do :: E'Do -> Text
fromE'Do :: E'Do -> Text
fromE'Do = \case
  E'Do
E'Do'Merge -> Text
"merge"
  E'Do
E'Do'Rebase -> Text
"rebase"
  E'Do
E'Do'Rebase_merge -> Text
"rebase-merge"
  E'Do
E'Do'Squash -> Text
"squash"
  E'Do
E'Do'Fast_forward_only -> Text
"fast-forward-only"
  E'Do
E'Do'Manually_merged -> Text
"manually-merged"

-- | parse 'E'Do' enum
toE'Do :: Text -> P.Either String E'Do
toE'Do :: Text -> Either [Char] E'Do
toE'Do = \case
  Text
"merge" -> E'Do -> Either [Char] E'Do
forall a b. b -> Either a b
P.Right E'Do
E'Do'Merge
  Text
"rebase" -> E'Do -> Either [Char] E'Do
forall a b. b -> Either a b
P.Right E'Do
E'Do'Rebase
  Text
"rebase-merge" -> E'Do -> Either [Char] E'Do
forall a b. b -> Either a b
P.Right E'Do
E'Do'Rebase_merge
  Text
"squash" -> E'Do -> Either [Char] E'Do
forall a b. b -> Either a b
P.Right E'Do
E'Do'Squash
  Text
"fast-forward-only" -> E'Do -> Either [Char] E'Do
forall a b. b -> Either a b
P.Right E'Do
E'Do'Fast_forward_only
  Text
"manually-merged" -> E'Do -> Either [Char] E'Do
forall a b. b -> Either a b
P.Right E'Do
E'Do'Manually_merged
  Text
s -> [Char] -> Either [Char] E'Do
forall a b. a -> Either a b
P.Left ([Char] -> Either [Char] E'Do) -> [Char] -> Either [Char] E'Do
forall a b. (a -> b) -> a -> b
$ [Char]
"toE'Do: enum parse failure: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> [Char]
forall a. Show a => a -> [Char]
P.show Text
s


-- ** E'ObjectFormatName

-- | Enum of 'Text' .
-- ObjectFormatName of the underlying git repository
data E'ObjectFormatName
  = E'ObjectFormatName'Sha1 -- ^ @"sha1"@
  | E'ObjectFormatName'Sha256 -- ^ @"sha256"@
  deriving (Int -> E'ObjectFormatName -> ShowS
[E'ObjectFormatName] -> ShowS
E'ObjectFormatName -> [Char]
(Int -> E'ObjectFormatName -> ShowS)
-> (E'ObjectFormatName -> [Char])
-> ([E'ObjectFormatName] -> ShowS)
-> Show E'ObjectFormatName
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> E'ObjectFormatName -> ShowS
showsPrec :: Int -> E'ObjectFormatName -> ShowS
$cshow :: E'ObjectFormatName -> [Char]
show :: E'ObjectFormatName -> [Char]
$cshowList :: [E'ObjectFormatName] -> ShowS
showList :: [E'ObjectFormatName] -> ShowS
P.Show, E'ObjectFormatName -> E'ObjectFormatName -> Bool
(E'ObjectFormatName -> E'ObjectFormatName -> Bool)
-> (E'ObjectFormatName -> E'ObjectFormatName -> Bool)
-> Eq E'ObjectFormatName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: E'ObjectFormatName -> E'ObjectFormatName -> Bool
== :: E'ObjectFormatName -> E'ObjectFormatName -> Bool
$c/= :: E'ObjectFormatName -> E'ObjectFormatName -> Bool
/= :: E'ObjectFormatName -> E'ObjectFormatName -> Bool
P.Eq, P.Typeable, Eq E'ObjectFormatName
Eq E'ObjectFormatName =>
(E'ObjectFormatName -> E'ObjectFormatName -> Ordering)
-> (E'ObjectFormatName -> E'ObjectFormatName -> Bool)
-> (E'ObjectFormatName -> E'ObjectFormatName -> Bool)
-> (E'ObjectFormatName -> E'ObjectFormatName -> Bool)
-> (E'ObjectFormatName -> E'ObjectFormatName -> Bool)
-> (E'ObjectFormatName -> E'ObjectFormatName -> E'ObjectFormatName)
-> (E'ObjectFormatName -> E'ObjectFormatName -> E'ObjectFormatName)
-> Ord E'ObjectFormatName
E'ObjectFormatName -> E'ObjectFormatName -> Bool
E'ObjectFormatName -> E'ObjectFormatName -> Ordering
E'ObjectFormatName -> E'ObjectFormatName -> E'ObjectFormatName
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
$ccompare :: E'ObjectFormatName -> E'ObjectFormatName -> Ordering
compare :: E'ObjectFormatName -> E'ObjectFormatName -> Ordering
$c< :: E'ObjectFormatName -> E'ObjectFormatName -> Bool
< :: E'ObjectFormatName -> E'ObjectFormatName -> Bool
$c<= :: E'ObjectFormatName -> E'ObjectFormatName -> Bool
<= :: E'ObjectFormatName -> E'ObjectFormatName -> Bool
$c> :: E'ObjectFormatName -> E'ObjectFormatName -> Bool
> :: E'ObjectFormatName -> E'ObjectFormatName -> Bool
$c>= :: E'ObjectFormatName -> E'ObjectFormatName -> Bool
>= :: E'ObjectFormatName -> E'ObjectFormatName -> Bool
$cmax :: E'ObjectFormatName -> E'ObjectFormatName -> E'ObjectFormatName
max :: E'ObjectFormatName -> E'ObjectFormatName -> E'ObjectFormatName
$cmin :: E'ObjectFormatName -> E'ObjectFormatName -> E'ObjectFormatName
min :: E'ObjectFormatName -> E'ObjectFormatName -> E'ObjectFormatName
P.Ord, E'ObjectFormatName
E'ObjectFormatName
-> E'ObjectFormatName -> Bounded E'ObjectFormatName
forall a. a -> a -> Bounded a
$cminBound :: E'ObjectFormatName
minBound :: E'ObjectFormatName
$cmaxBound :: E'ObjectFormatName
maxBound :: E'ObjectFormatName
P.Bounded, Int -> E'ObjectFormatName
E'ObjectFormatName -> Int
E'ObjectFormatName -> [E'ObjectFormatName]
E'ObjectFormatName -> E'ObjectFormatName
E'ObjectFormatName -> E'ObjectFormatName -> [E'ObjectFormatName]
E'ObjectFormatName
-> E'ObjectFormatName -> E'ObjectFormatName -> [E'ObjectFormatName]
(E'ObjectFormatName -> E'ObjectFormatName)
-> (E'ObjectFormatName -> E'ObjectFormatName)
-> (Int -> E'ObjectFormatName)
-> (E'ObjectFormatName -> Int)
-> (E'ObjectFormatName -> [E'ObjectFormatName])
-> (E'ObjectFormatName
    -> E'ObjectFormatName -> [E'ObjectFormatName])
-> (E'ObjectFormatName
    -> E'ObjectFormatName -> [E'ObjectFormatName])
-> (E'ObjectFormatName
    -> E'ObjectFormatName
    -> E'ObjectFormatName
    -> [E'ObjectFormatName])
-> Enum E'ObjectFormatName
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: E'ObjectFormatName -> E'ObjectFormatName
succ :: E'ObjectFormatName -> E'ObjectFormatName
$cpred :: E'ObjectFormatName -> E'ObjectFormatName
pred :: E'ObjectFormatName -> E'ObjectFormatName
$ctoEnum :: Int -> E'ObjectFormatName
toEnum :: Int -> E'ObjectFormatName
$cfromEnum :: E'ObjectFormatName -> Int
fromEnum :: E'ObjectFormatName -> Int
$cenumFrom :: E'ObjectFormatName -> [E'ObjectFormatName]
enumFrom :: E'ObjectFormatName -> [E'ObjectFormatName]
$cenumFromThen :: E'ObjectFormatName -> E'ObjectFormatName -> [E'ObjectFormatName]
enumFromThen :: E'ObjectFormatName -> E'ObjectFormatName -> [E'ObjectFormatName]
$cenumFromTo :: E'ObjectFormatName -> E'ObjectFormatName -> [E'ObjectFormatName]
enumFromTo :: E'ObjectFormatName -> E'ObjectFormatName -> [E'ObjectFormatName]
$cenumFromThenTo :: E'ObjectFormatName
-> E'ObjectFormatName -> E'ObjectFormatName -> [E'ObjectFormatName]
enumFromThenTo :: E'ObjectFormatName
-> E'ObjectFormatName -> E'ObjectFormatName -> [E'ObjectFormatName]
P.Enum)

instance A.ToJSON E'ObjectFormatName where toJSON :: E'ObjectFormatName -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value)
-> (E'ObjectFormatName -> Text) -> E'ObjectFormatName -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'ObjectFormatName -> Text
fromE'ObjectFormatName
instance A.FromJSON E'ObjectFormatName where parseJSON :: Value -> Parser E'ObjectFormatName
parseJSON Value
o = ([Char] -> Parser E'ObjectFormatName)
-> (E'ObjectFormatName -> Parser E'ObjectFormatName)
-> Either [Char] E'ObjectFormatName
-> Parser E'ObjectFormatName
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either [Char] -> Parser E'ObjectFormatName
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
P.fail (E'ObjectFormatName -> Parser E'ObjectFormatName
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E'ObjectFormatName -> Parser E'ObjectFormatName)
-> (E'ObjectFormatName -> E'ObjectFormatName)
-> E'ObjectFormatName
-> Parser E'ObjectFormatName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'ObjectFormatName -> E'ObjectFormatName
forall a. a -> a
P.id) (Either [Char] E'ObjectFormatName -> Parser E'ObjectFormatName)
-> (Text -> Either [Char] E'ObjectFormatName)
-> Text
-> Parser E'ObjectFormatName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'ObjectFormatName
toE'ObjectFormatName (Text -> Parser E'ObjectFormatName)
-> Parser Text -> Parser E'ObjectFormatName
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData E'ObjectFormatName where toQueryParam :: E'ObjectFormatName -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text)
-> (E'ObjectFormatName -> Text) -> E'ObjectFormatName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'ObjectFormatName -> Text
fromE'ObjectFormatName
instance WH.FromHttpApiData E'ObjectFormatName where parseQueryParam :: Text -> Either Text E'ObjectFormatName
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text E'ObjectFormatName)
-> Either Text E'ObjectFormatName
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> Text)
-> Either [Char] E'ObjectFormatName
-> Either Text E'ObjectFormatName
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left [Char] -> Text
T.pack (Either [Char] E'ObjectFormatName
 -> Either Text E'ObjectFormatName)
-> (Text -> Either [Char] E'ObjectFormatName)
-> Text
-> Either Text E'ObjectFormatName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'ObjectFormatName
toE'ObjectFormatName
instance MimeRender MimeMultipartFormData E'ObjectFormatName where mimeRender :: Proxy MimeMultipartFormData -> E'ObjectFormatName -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = E'ObjectFormatName -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'E'ObjectFormatName' enum
fromE'ObjectFormatName :: E'ObjectFormatName -> Text
fromE'ObjectFormatName :: E'ObjectFormatName -> Text
fromE'ObjectFormatName = \case
  E'ObjectFormatName
E'ObjectFormatName'Sha1 -> Text
"sha1"
  E'ObjectFormatName
E'ObjectFormatName'Sha256 -> Text
"sha256"

-- | parse 'E'ObjectFormatName' enum
toE'ObjectFormatName :: Text -> P.Either String E'ObjectFormatName
toE'ObjectFormatName :: Text -> Either [Char] E'ObjectFormatName
toE'ObjectFormatName = \case
  Text
"sha1" -> E'ObjectFormatName -> Either [Char] E'ObjectFormatName
forall a b. b -> Either a b
P.Right E'ObjectFormatName
E'ObjectFormatName'Sha1
  Text
"sha256" -> E'ObjectFormatName -> Either [Char] E'ObjectFormatName
forall a b. b -> Either a b
P.Right E'ObjectFormatName
E'ObjectFormatName'Sha256
  Text
s -> [Char] -> Either [Char] E'ObjectFormatName
forall a b. a -> Either a b
P.Left ([Char] -> Either [Char] E'ObjectFormatName)
-> [Char] -> Either [Char] E'ObjectFormatName
forall a b. (a -> b) -> a -> b
$ [Char]
"toE'ObjectFormatName: enum parse failure: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> [Char]
forall a. Show a => a -> [Char]
P.show Text
s


-- ** E'OpType

-- | Enum of 'Text' .
-- the type of action
data E'OpType
  = E'OpType'Create_repo -- ^ @"create_repo"@
  | E'OpType'Rename_repo -- ^ @"rename_repo"@
  | E'OpType'Star_repo -- ^ @"star_repo"@
  | E'OpType'Watch_repo -- ^ @"watch_repo"@
  | E'OpType'Commit_repo -- ^ @"commit_repo"@
  | E'OpType'Create_issue -- ^ @"create_issue"@
  | E'OpType'Create_pull_request -- ^ @"create_pull_request"@
  | E'OpType'Transfer_repo -- ^ @"transfer_repo"@
  | E'OpType'Push_tag -- ^ @"push_tag"@
  | E'OpType'Comment_issue -- ^ @"comment_issue"@
  | E'OpType'Merge_pull_request -- ^ @"merge_pull_request"@
  | E'OpType'Close_issue -- ^ @"close_issue"@
  | E'OpType'Reopen_issue -- ^ @"reopen_issue"@
  | E'OpType'Close_pull_request -- ^ @"close_pull_request"@
  | E'OpType'Reopen_pull_request -- ^ @"reopen_pull_request"@
  | E'OpType'Delete_tag -- ^ @"delete_tag"@
  | E'OpType'Delete_branch -- ^ @"delete_branch"@
  | E'OpType'Mirror_sync_push -- ^ @"mirror_sync_push"@
  | E'OpType'Mirror_sync_create -- ^ @"mirror_sync_create"@
  | E'OpType'Mirror_sync_delete -- ^ @"mirror_sync_delete"@
  | E'OpType'Approve_pull_request -- ^ @"approve_pull_request"@
  | E'OpType'Reject_pull_request -- ^ @"reject_pull_request"@
  | E'OpType'Comment_pull -- ^ @"comment_pull"@
  | E'OpType'Publish_release -- ^ @"publish_release"@
  | E'OpType'Pull_review_dismissed -- ^ @"pull_review_dismissed"@
  | E'OpType'Pull_request_ready_for_review -- ^ @"pull_request_ready_for_review"@
  | E'OpType'Auto_merge_pull_request -- ^ @"auto_merge_pull_request"@
  deriving (Int -> E'OpType -> ShowS
[E'OpType] -> ShowS
E'OpType -> [Char]
(Int -> E'OpType -> ShowS)
-> (E'OpType -> [Char]) -> ([E'OpType] -> ShowS) -> Show E'OpType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> E'OpType -> ShowS
showsPrec :: Int -> E'OpType -> ShowS
$cshow :: E'OpType -> [Char]
show :: E'OpType -> [Char]
$cshowList :: [E'OpType] -> ShowS
showList :: [E'OpType] -> ShowS
P.Show, E'OpType -> E'OpType -> Bool
(E'OpType -> E'OpType -> Bool)
-> (E'OpType -> E'OpType -> Bool) -> Eq E'OpType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: E'OpType -> E'OpType -> Bool
== :: E'OpType -> E'OpType -> Bool
$c/= :: E'OpType -> E'OpType -> Bool
/= :: E'OpType -> E'OpType -> Bool
P.Eq, P.Typeable, Eq E'OpType
Eq E'OpType =>
(E'OpType -> E'OpType -> Ordering)
-> (E'OpType -> E'OpType -> Bool)
-> (E'OpType -> E'OpType -> Bool)
-> (E'OpType -> E'OpType -> Bool)
-> (E'OpType -> E'OpType -> Bool)
-> (E'OpType -> E'OpType -> E'OpType)
-> (E'OpType -> E'OpType -> E'OpType)
-> Ord E'OpType
E'OpType -> E'OpType -> Bool
E'OpType -> E'OpType -> Ordering
E'OpType -> E'OpType -> E'OpType
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
$ccompare :: E'OpType -> E'OpType -> Ordering
compare :: E'OpType -> E'OpType -> Ordering
$c< :: E'OpType -> E'OpType -> Bool
< :: E'OpType -> E'OpType -> Bool
$c<= :: E'OpType -> E'OpType -> Bool
<= :: E'OpType -> E'OpType -> Bool
$c> :: E'OpType -> E'OpType -> Bool
> :: E'OpType -> E'OpType -> Bool
$c>= :: E'OpType -> E'OpType -> Bool
>= :: E'OpType -> E'OpType -> Bool
$cmax :: E'OpType -> E'OpType -> E'OpType
max :: E'OpType -> E'OpType -> E'OpType
$cmin :: E'OpType -> E'OpType -> E'OpType
min :: E'OpType -> E'OpType -> E'OpType
P.Ord, E'OpType
E'OpType -> E'OpType -> Bounded E'OpType
forall a. a -> a -> Bounded a
$cminBound :: E'OpType
minBound :: E'OpType
$cmaxBound :: E'OpType
maxBound :: E'OpType
P.Bounded, Int -> E'OpType
E'OpType -> Int
E'OpType -> [E'OpType]
E'OpType -> E'OpType
E'OpType -> E'OpType -> [E'OpType]
E'OpType -> E'OpType -> E'OpType -> [E'OpType]
(E'OpType -> E'OpType)
-> (E'OpType -> E'OpType)
-> (Int -> E'OpType)
-> (E'OpType -> Int)
-> (E'OpType -> [E'OpType])
-> (E'OpType -> E'OpType -> [E'OpType])
-> (E'OpType -> E'OpType -> [E'OpType])
-> (E'OpType -> E'OpType -> E'OpType -> [E'OpType])
-> Enum E'OpType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: E'OpType -> E'OpType
succ :: E'OpType -> E'OpType
$cpred :: E'OpType -> E'OpType
pred :: E'OpType -> E'OpType
$ctoEnum :: Int -> E'OpType
toEnum :: Int -> E'OpType
$cfromEnum :: E'OpType -> Int
fromEnum :: E'OpType -> Int
$cenumFrom :: E'OpType -> [E'OpType]
enumFrom :: E'OpType -> [E'OpType]
$cenumFromThen :: E'OpType -> E'OpType -> [E'OpType]
enumFromThen :: E'OpType -> E'OpType -> [E'OpType]
$cenumFromTo :: E'OpType -> E'OpType -> [E'OpType]
enumFromTo :: E'OpType -> E'OpType -> [E'OpType]
$cenumFromThenTo :: E'OpType -> E'OpType -> E'OpType -> [E'OpType]
enumFromThenTo :: E'OpType -> E'OpType -> E'OpType -> [E'OpType]
P.Enum)

instance A.ToJSON E'OpType where toJSON :: E'OpType -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value) -> (E'OpType -> Text) -> E'OpType -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'OpType -> Text
fromE'OpType
instance A.FromJSON E'OpType where parseJSON :: Value -> Parser E'OpType
parseJSON Value
o = ([Char] -> Parser E'OpType)
-> (E'OpType -> Parser E'OpType)
-> Either [Char] E'OpType
-> Parser E'OpType
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either [Char] -> Parser E'OpType
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
P.fail (E'OpType -> Parser E'OpType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E'OpType -> Parser E'OpType)
-> (E'OpType -> E'OpType) -> E'OpType -> Parser E'OpType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'OpType -> E'OpType
forall a. a -> a
P.id) (Either [Char] E'OpType -> Parser E'OpType)
-> (Text -> Either [Char] E'OpType) -> Text -> Parser E'OpType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'OpType
toE'OpType (Text -> Parser E'OpType) -> Parser Text -> Parser E'OpType
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData E'OpType where toQueryParam :: E'OpType -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text) -> (E'OpType -> Text) -> E'OpType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'OpType -> Text
fromE'OpType
instance WH.FromHttpApiData E'OpType where parseQueryParam :: Text -> Either Text E'OpType
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text E'OpType) -> Either Text E'OpType
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> Text) -> Either [Char] E'OpType -> Either Text E'OpType
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left [Char] -> Text
T.pack (Either [Char] E'OpType -> Either Text E'OpType)
-> (Text -> Either [Char] E'OpType) -> Text -> Either Text E'OpType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'OpType
toE'OpType
instance MimeRender MimeMultipartFormData E'OpType where mimeRender :: Proxy MimeMultipartFormData -> E'OpType -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = E'OpType -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'E'OpType' enum
fromE'OpType :: E'OpType -> Text
fromE'OpType :: E'OpType -> Text
fromE'OpType = \case
  E'OpType
E'OpType'Create_repo -> Text
"create_repo"
  E'OpType
E'OpType'Rename_repo -> Text
"rename_repo"
  E'OpType
E'OpType'Star_repo -> Text
"star_repo"
  E'OpType
E'OpType'Watch_repo -> Text
"watch_repo"
  E'OpType
E'OpType'Commit_repo -> Text
"commit_repo"
  E'OpType
E'OpType'Create_issue -> Text
"create_issue"
  E'OpType
E'OpType'Create_pull_request -> Text
"create_pull_request"
  E'OpType
E'OpType'Transfer_repo -> Text
"transfer_repo"
  E'OpType
E'OpType'Push_tag -> Text
"push_tag"
  E'OpType
E'OpType'Comment_issue -> Text
"comment_issue"
  E'OpType
E'OpType'Merge_pull_request -> Text
"merge_pull_request"
  E'OpType
E'OpType'Close_issue -> Text
"close_issue"
  E'OpType
E'OpType'Reopen_issue -> Text
"reopen_issue"
  E'OpType
E'OpType'Close_pull_request -> Text
"close_pull_request"
  E'OpType
E'OpType'Reopen_pull_request -> Text
"reopen_pull_request"
  E'OpType
E'OpType'Delete_tag -> Text
"delete_tag"
  E'OpType
E'OpType'Delete_branch -> Text
"delete_branch"
  E'OpType
E'OpType'Mirror_sync_push -> Text
"mirror_sync_push"
  E'OpType
E'OpType'Mirror_sync_create -> Text
"mirror_sync_create"
  E'OpType
E'OpType'Mirror_sync_delete -> Text
"mirror_sync_delete"
  E'OpType
E'OpType'Approve_pull_request -> Text
"approve_pull_request"
  E'OpType
E'OpType'Reject_pull_request -> Text
"reject_pull_request"
  E'OpType
E'OpType'Comment_pull -> Text
"comment_pull"
  E'OpType
E'OpType'Publish_release -> Text
"publish_release"
  E'OpType
E'OpType'Pull_review_dismissed -> Text
"pull_review_dismissed"
  E'OpType
E'OpType'Pull_request_ready_for_review -> Text
"pull_request_ready_for_review"
  E'OpType
E'OpType'Auto_merge_pull_request -> Text
"auto_merge_pull_request"

-- | parse 'E'OpType' enum
toE'OpType :: Text -> P.Either String E'OpType
toE'OpType :: Text -> Either [Char] E'OpType
toE'OpType = \case
  Text
"create_repo" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Create_repo
  Text
"rename_repo" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Rename_repo
  Text
"star_repo" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Star_repo
  Text
"watch_repo" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Watch_repo
  Text
"commit_repo" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Commit_repo
  Text
"create_issue" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Create_issue
  Text
"create_pull_request" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Create_pull_request
  Text
"transfer_repo" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Transfer_repo
  Text
"push_tag" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Push_tag
  Text
"comment_issue" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Comment_issue
  Text
"merge_pull_request" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Merge_pull_request
  Text
"close_issue" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Close_issue
  Text
"reopen_issue" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Reopen_issue
  Text
"close_pull_request" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Close_pull_request
  Text
"reopen_pull_request" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Reopen_pull_request
  Text
"delete_tag" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Delete_tag
  Text
"delete_branch" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Delete_branch
  Text
"mirror_sync_push" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Mirror_sync_push
  Text
"mirror_sync_create" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Mirror_sync_create
  Text
"mirror_sync_delete" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Mirror_sync_delete
  Text
"approve_pull_request" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Approve_pull_request
  Text
"reject_pull_request" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Reject_pull_request
  Text
"comment_pull" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Comment_pull
  Text
"publish_release" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Publish_release
  Text
"pull_review_dismissed" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Pull_review_dismissed
  Text
"pull_request_ready_for_review" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Pull_request_ready_for_review
  Text
"auto_merge_pull_request" -> E'OpType -> Either [Char] E'OpType
forall a b. b -> Either a b
P.Right E'OpType
E'OpType'Auto_merge_pull_request
  Text
s -> [Char] -> Either [Char] E'OpType
forall a b. a -> Either a b
P.Left ([Char] -> Either [Char] E'OpType)
-> [Char] -> Either [Char] E'OpType
forall a b. (a -> b) -> a -> b
$ [Char]
"toE'OpType: enum parse failure: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> [Char]
forall a. Show a => a -> [Char]
P.show Text
s


-- ** E'Operation

-- | Enum of 'Text' .
-- indicates what to do with the file
data E'Operation
  = E'Operation'Create -- ^ @"create"@
  | E'Operation'Update -- ^ @"update"@
  | E'Operation'Delete -- ^ @"delete"@
  deriving (Int -> E'Operation -> ShowS
[E'Operation] -> ShowS
E'Operation -> [Char]
(Int -> E'Operation -> ShowS)
-> (E'Operation -> [Char])
-> ([E'Operation] -> ShowS)
-> Show E'Operation
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> E'Operation -> ShowS
showsPrec :: Int -> E'Operation -> ShowS
$cshow :: E'Operation -> [Char]
show :: E'Operation -> [Char]
$cshowList :: [E'Operation] -> ShowS
showList :: [E'Operation] -> ShowS
P.Show, E'Operation -> E'Operation -> Bool
(E'Operation -> E'Operation -> Bool)
-> (E'Operation -> E'Operation -> Bool) -> Eq E'Operation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: E'Operation -> E'Operation -> Bool
== :: E'Operation -> E'Operation -> Bool
$c/= :: E'Operation -> E'Operation -> Bool
/= :: E'Operation -> E'Operation -> Bool
P.Eq, P.Typeable, Eq E'Operation
Eq E'Operation =>
(E'Operation -> E'Operation -> Ordering)
-> (E'Operation -> E'Operation -> Bool)
-> (E'Operation -> E'Operation -> Bool)
-> (E'Operation -> E'Operation -> Bool)
-> (E'Operation -> E'Operation -> Bool)
-> (E'Operation -> E'Operation -> E'Operation)
-> (E'Operation -> E'Operation -> E'Operation)
-> Ord E'Operation
E'Operation -> E'Operation -> Bool
E'Operation -> E'Operation -> Ordering
E'Operation -> E'Operation -> E'Operation
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
$ccompare :: E'Operation -> E'Operation -> Ordering
compare :: E'Operation -> E'Operation -> Ordering
$c< :: E'Operation -> E'Operation -> Bool
< :: E'Operation -> E'Operation -> Bool
$c<= :: E'Operation -> E'Operation -> Bool
<= :: E'Operation -> E'Operation -> Bool
$c> :: E'Operation -> E'Operation -> Bool
> :: E'Operation -> E'Operation -> Bool
$c>= :: E'Operation -> E'Operation -> Bool
>= :: E'Operation -> E'Operation -> Bool
$cmax :: E'Operation -> E'Operation -> E'Operation
max :: E'Operation -> E'Operation -> E'Operation
$cmin :: E'Operation -> E'Operation -> E'Operation
min :: E'Operation -> E'Operation -> E'Operation
P.Ord, E'Operation
E'Operation -> E'Operation -> Bounded E'Operation
forall a. a -> a -> Bounded a
$cminBound :: E'Operation
minBound :: E'Operation
$cmaxBound :: E'Operation
maxBound :: E'Operation
P.Bounded, Int -> E'Operation
E'Operation -> Int
E'Operation -> [E'Operation]
E'Operation -> E'Operation
E'Operation -> E'Operation -> [E'Operation]
E'Operation -> E'Operation -> E'Operation -> [E'Operation]
(E'Operation -> E'Operation)
-> (E'Operation -> E'Operation)
-> (Int -> E'Operation)
-> (E'Operation -> Int)
-> (E'Operation -> [E'Operation])
-> (E'Operation -> E'Operation -> [E'Operation])
-> (E'Operation -> E'Operation -> [E'Operation])
-> (E'Operation -> E'Operation -> E'Operation -> [E'Operation])
-> Enum E'Operation
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: E'Operation -> E'Operation
succ :: E'Operation -> E'Operation
$cpred :: E'Operation -> E'Operation
pred :: E'Operation -> E'Operation
$ctoEnum :: Int -> E'Operation
toEnum :: Int -> E'Operation
$cfromEnum :: E'Operation -> Int
fromEnum :: E'Operation -> Int
$cenumFrom :: E'Operation -> [E'Operation]
enumFrom :: E'Operation -> [E'Operation]
$cenumFromThen :: E'Operation -> E'Operation -> [E'Operation]
enumFromThen :: E'Operation -> E'Operation -> [E'Operation]
$cenumFromTo :: E'Operation -> E'Operation -> [E'Operation]
enumFromTo :: E'Operation -> E'Operation -> [E'Operation]
$cenumFromThenTo :: E'Operation -> E'Operation -> E'Operation -> [E'Operation]
enumFromThenTo :: E'Operation -> E'Operation -> E'Operation -> [E'Operation]
P.Enum)

instance A.ToJSON E'Operation where toJSON :: E'Operation -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value) -> (E'Operation -> Text) -> E'Operation -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Operation -> Text
fromE'Operation
instance A.FromJSON E'Operation where parseJSON :: Value -> Parser E'Operation
parseJSON Value
o = ([Char] -> Parser E'Operation)
-> (E'Operation -> Parser E'Operation)
-> Either [Char] E'Operation
-> Parser E'Operation
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either [Char] -> Parser E'Operation
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
P.fail (E'Operation -> Parser E'Operation
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E'Operation -> Parser E'Operation)
-> (E'Operation -> E'Operation)
-> E'Operation
-> Parser E'Operation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Operation -> E'Operation
forall a. a -> a
P.id) (Either [Char] E'Operation -> Parser E'Operation)
-> (Text -> Either [Char] E'Operation)
-> Text
-> Parser E'Operation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Operation
toE'Operation (Text -> Parser E'Operation) -> Parser Text -> Parser E'Operation
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData E'Operation where toQueryParam :: E'Operation -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text) -> (E'Operation -> Text) -> E'Operation -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Operation -> Text
fromE'Operation
instance WH.FromHttpApiData E'Operation where parseQueryParam :: Text -> Either Text E'Operation
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text E'Operation) -> Either Text E'Operation
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> Text)
-> Either [Char] E'Operation -> Either Text E'Operation
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left [Char] -> Text
T.pack (Either [Char] E'Operation -> Either Text E'Operation)
-> (Text -> Either [Char] E'Operation)
-> Text
-> Either Text E'Operation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Operation
toE'Operation
instance MimeRender MimeMultipartFormData E'Operation where mimeRender :: Proxy MimeMultipartFormData -> E'Operation -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = E'Operation -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'E'Operation' enum
fromE'Operation :: E'Operation -> Text
fromE'Operation :: E'Operation -> Text
fromE'Operation = \case
  E'Operation
E'Operation'Create -> Text
"create"
  E'Operation
E'Operation'Update -> Text
"update"
  E'Operation
E'Operation'Delete -> Text
"delete"

-- | parse 'E'Operation' enum
toE'Operation :: Text -> P.Either String E'Operation
toE'Operation :: Text -> Either [Char] E'Operation
toE'Operation = \case
  Text
"create" -> E'Operation -> Either [Char] E'Operation
forall a b. b -> Either a b
P.Right E'Operation
E'Operation'Create
  Text
"update" -> E'Operation -> Either [Char] E'Operation
forall a b. b -> Either a b
P.Right E'Operation
E'Operation'Update
  Text
"delete" -> E'Operation -> Either [Char] E'Operation
forall a b. b -> Either a b
P.Right E'Operation
E'Operation'Delete
  Text
s -> [Char] -> Either [Char] E'Operation
forall a b. a -> Either a b
P.Left ([Char] -> Either [Char] E'Operation)
-> [Char] -> Either [Char] E'Operation
forall a b. (a -> b) -> a -> b
$ [Char]
"toE'Operation: enum parse failure: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> [Char]
forall a. Show a => a -> [Char]
P.show Text
s


-- ** E'Permission

-- | Enum of 'Text'
data E'Permission
  = E'Permission'Read -- ^ @"read"@
  | E'Permission'Write -- ^ @"write"@
  | E'Permission'Admin -- ^ @"admin"@
  deriving (Int -> E'Permission -> ShowS
[E'Permission] -> ShowS
E'Permission -> [Char]
(Int -> E'Permission -> ShowS)
-> (E'Permission -> [Char])
-> ([E'Permission] -> ShowS)
-> Show E'Permission
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> E'Permission -> ShowS
showsPrec :: Int -> E'Permission -> ShowS
$cshow :: E'Permission -> [Char]
show :: E'Permission -> [Char]
$cshowList :: [E'Permission] -> ShowS
showList :: [E'Permission] -> ShowS
P.Show, E'Permission -> E'Permission -> Bool
(E'Permission -> E'Permission -> Bool)
-> (E'Permission -> E'Permission -> Bool) -> Eq E'Permission
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: E'Permission -> E'Permission -> Bool
== :: E'Permission -> E'Permission -> Bool
$c/= :: E'Permission -> E'Permission -> Bool
/= :: E'Permission -> E'Permission -> Bool
P.Eq, P.Typeable, Eq E'Permission
Eq E'Permission =>
(E'Permission -> E'Permission -> Ordering)
-> (E'Permission -> E'Permission -> Bool)
-> (E'Permission -> E'Permission -> Bool)
-> (E'Permission -> E'Permission -> Bool)
-> (E'Permission -> E'Permission -> Bool)
-> (E'Permission -> E'Permission -> E'Permission)
-> (E'Permission -> E'Permission -> E'Permission)
-> Ord E'Permission
E'Permission -> E'Permission -> Bool
E'Permission -> E'Permission -> Ordering
E'Permission -> E'Permission -> E'Permission
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
$ccompare :: E'Permission -> E'Permission -> Ordering
compare :: E'Permission -> E'Permission -> Ordering
$c< :: E'Permission -> E'Permission -> Bool
< :: E'Permission -> E'Permission -> Bool
$c<= :: E'Permission -> E'Permission -> Bool
<= :: E'Permission -> E'Permission -> Bool
$c> :: E'Permission -> E'Permission -> Bool
> :: E'Permission -> E'Permission -> Bool
$c>= :: E'Permission -> E'Permission -> Bool
>= :: E'Permission -> E'Permission -> Bool
$cmax :: E'Permission -> E'Permission -> E'Permission
max :: E'Permission -> E'Permission -> E'Permission
$cmin :: E'Permission -> E'Permission -> E'Permission
min :: E'Permission -> E'Permission -> E'Permission
P.Ord, E'Permission
E'Permission -> E'Permission -> Bounded E'Permission
forall a. a -> a -> Bounded a
$cminBound :: E'Permission
minBound :: E'Permission
$cmaxBound :: E'Permission
maxBound :: E'Permission
P.Bounded, Int -> E'Permission
E'Permission -> Int
E'Permission -> [E'Permission]
E'Permission -> E'Permission
E'Permission -> E'Permission -> [E'Permission]
E'Permission -> E'Permission -> E'Permission -> [E'Permission]
(E'Permission -> E'Permission)
-> (E'Permission -> E'Permission)
-> (Int -> E'Permission)
-> (E'Permission -> Int)
-> (E'Permission -> [E'Permission])
-> (E'Permission -> E'Permission -> [E'Permission])
-> (E'Permission -> E'Permission -> [E'Permission])
-> (E'Permission -> E'Permission -> E'Permission -> [E'Permission])
-> Enum E'Permission
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: E'Permission -> E'Permission
succ :: E'Permission -> E'Permission
$cpred :: E'Permission -> E'Permission
pred :: E'Permission -> E'Permission
$ctoEnum :: Int -> E'Permission
toEnum :: Int -> E'Permission
$cfromEnum :: E'Permission -> Int
fromEnum :: E'Permission -> Int
$cenumFrom :: E'Permission -> [E'Permission]
enumFrom :: E'Permission -> [E'Permission]
$cenumFromThen :: E'Permission -> E'Permission -> [E'Permission]
enumFromThen :: E'Permission -> E'Permission -> [E'Permission]
$cenumFromTo :: E'Permission -> E'Permission -> [E'Permission]
enumFromTo :: E'Permission -> E'Permission -> [E'Permission]
$cenumFromThenTo :: E'Permission -> E'Permission -> E'Permission -> [E'Permission]
enumFromThenTo :: E'Permission -> E'Permission -> E'Permission -> [E'Permission]
P.Enum)

instance A.ToJSON E'Permission where toJSON :: E'Permission -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value) -> (E'Permission -> Text) -> E'Permission -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Permission -> Text
fromE'Permission
instance A.FromJSON E'Permission where parseJSON :: Value -> Parser E'Permission
parseJSON Value
o = ([Char] -> Parser E'Permission)
-> (E'Permission -> Parser E'Permission)
-> Either [Char] E'Permission
-> Parser E'Permission
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either [Char] -> Parser E'Permission
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
P.fail (E'Permission -> Parser E'Permission
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E'Permission -> Parser E'Permission)
-> (E'Permission -> E'Permission)
-> E'Permission
-> Parser E'Permission
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Permission -> E'Permission
forall a. a -> a
P.id) (Either [Char] E'Permission -> Parser E'Permission)
-> (Text -> Either [Char] E'Permission)
-> Text
-> Parser E'Permission
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Permission
toE'Permission (Text -> Parser E'Permission) -> Parser Text -> Parser E'Permission
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData E'Permission where toQueryParam :: E'Permission -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text) -> (E'Permission -> Text) -> E'Permission -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Permission -> Text
fromE'Permission
instance WH.FromHttpApiData E'Permission where parseQueryParam :: Text -> Either Text E'Permission
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text E'Permission) -> Either Text E'Permission
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> Text)
-> Either [Char] E'Permission -> Either Text E'Permission
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left [Char] -> Text
T.pack (Either [Char] E'Permission -> Either Text E'Permission)
-> (Text -> Either [Char] E'Permission)
-> Text
-> Either Text E'Permission
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Permission
toE'Permission
instance MimeRender MimeMultipartFormData E'Permission where mimeRender :: Proxy MimeMultipartFormData -> E'Permission -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = E'Permission -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'E'Permission' enum
fromE'Permission :: E'Permission -> Text
fromE'Permission :: E'Permission -> Text
fromE'Permission = \case
  E'Permission
E'Permission'Read -> Text
"read"
  E'Permission
E'Permission'Write -> Text
"write"
  E'Permission
E'Permission'Admin -> Text
"admin"

-- | parse 'E'Permission' enum
toE'Permission :: Text -> P.Either String E'Permission
toE'Permission :: Text -> Either [Char] E'Permission
toE'Permission = \case
  Text
"read" -> E'Permission -> Either [Char] E'Permission
forall a b. b -> Either a b
P.Right E'Permission
E'Permission'Read
  Text
"write" -> E'Permission -> Either [Char] E'Permission
forall a b. b -> Either a b
P.Right E'Permission
E'Permission'Write
  Text
"admin" -> E'Permission -> Either [Char] E'Permission
forall a b. b -> Either a b
P.Right E'Permission
E'Permission'Admin
  Text
s -> [Char] -> Either [Char] E'Permission
forall a b. a -> Either a b
P.Left ([Char] -> Either [Char] E'Permission)
-> [Char] -> Either [Char] E'Permission
forall a b. (a -> b) -> a -> b
$ [Char]
"toE'Permission: enum parse failure: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> [Char]
forall a. Show a => a -> [Char]
P.show Text
s


-- ** E'Permission2

-- | Enum of 'Text'
data E'Permission2
  = E'Permission2'None -- ^ @"none"@
  | E'Permission2'Read -- ^ @"read"@
  | E'Permission2'Write -- ^ @"write"@
  | E'Permission2'Admin -- ^ @"admin"@
  | E'Permission2'Owner -- ^ @"owner"@
  deriving (Int -> E'Permission2 -> ShowS
[E'Permission2] -> ShowS
E'Permission2 -> [Char]
(Int -> E'Permission2 -> ShowS)
-> (E'Permission2 -> [Char])
-> ([E'Permission2] -> ShowS)
-> Show E'Permission2
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> E'Permission2 -> ShowS
showsPrec :: Int -> E'Permission2 -> ShowS
$cshow :: E'Permission2 -> [Char]
show :: E'Permission2 -> [Char]
$cshowList :: [E'Permission2] -> ShowS
showList :: [E'Permission2] -> ShowS
P.Show, E'Permission2 -> E'Permission2 -> Bool
(E'Permission2 -> E'Permission2 -> Bool)
-> (E'Permission2 -> E'Permission2 -> Bool) -> Eq E'Permission2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: E'Permission2 -> E'Permission2 -> Bool
== :: E'Permission2 -> E'Permission2 -> Bool
$c/= :: E'Permission2 -> E'Permission2 -> Bool
/= :: E'Permission2 -> E'Permission2 -> Bool
P.Eq, P.Typeable, Eq E'Permission2
Eq E'Permission2 =>
(E'Permission2 -> E'Permission2 -> Ordering)
-> (E'Permission2 -> E'Permission2 -> Bool)
-> (E'Permission2 -> E'Permission2 -> Bool)
-> (E'Permission2 -> E'Permission2 -> Bool)
-> (E'Permission2 -> E'Permission2 -> Bool)
-> (E'Permission2 -> E'Permission2 -> E'Permission2)
-> (E'Permission2 -> E'Permission2 -> E'Permission2)
-> Ord E'Permission2
E'Permission2 -> E'Permission2 -> Bool
E'Permission2 -> E'Permission2 -> Ordering
E'Permission2 -> E'Permission2 -> E'Permission2
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
$ccompare :: E'Permission2 -> E'Permission2 -> Ordering
compare :: E'Permission2 -> E'Permission2 -> Ordering
$c< :: E'Permission2 -> E'Permission2 -> Bool
< :: E'Permission2 -> E'Permission2 -> Bool
$c<= :: E'Permission2 -> E'Permission2 -> Bool
<= :: E'Permission2 -> E'Permission2 -> Bool
$c> :: E'Permission2 -> E'Permission2 -> Bool
> :: E'Permission2 -> E'Permission2 -> Bool
$c>= :: E'Permission2 -> E'Permission2 -> Bool
>= :: E'Permission2 -> E'Permission2 -> Bool
$cmax :: E'Permission2 -> E'Permission2 -> E'Permission2
max :: E'Permission2 -> E'Permission2 -> E'Permission2
$cmin :: E'Permission2 -> E'Permission2 -> E'Permission2
min :: E'Permission2 -> E'Permission2 -> E'Permission2
P.Ord, E'Permission2
E'Permission2 -> E'Permission2 -> Bounded E'Permission2
forall a. a -> a -> Bounded a
$cminBound :: E'Permission2
minBound :: E'Permission2
$cmaxBound :: E'Permission2
maxBound :: E'Permission2
P.Bounded, Int -> E'Permission2
E'Permission2 -> Int
E'Permission2 -> [E'Permission2]
E'Permission2 -> E'Permission2
E'Permission2 -> E'Permission2 -> [E'Permission2]
E'Permission2 -> E'Permission2 -> E'Permission2 -> [E'Permission2]
(E'Permission2 -> E'Permission2)
-> (E'Permission2 -> E'Permission2)
-> (Int -> E'Permission2)
-> (E'Permission2 -> Int)
-> (E'Permission2 -> [E'Permission2])
-> (E'Permission2 -> E'Permission2 -> [E'Permission2])
-> (E'Permission2 -> E'Permission2 -> [E'Permission2])
-> (E'Permission2
    -> E'Permission2 -> E'Permission2 -> [E'Permission2])
-> Enum E'Permission2
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: E'Permission2 -> E'Permission2
succ :: E'Permission2 -> E'Permission2
$cpred :: E'Permission2 -> E'Permission2
pred :: E'Permission2 -> E'Permission2
$ctoEnum :: Int -> E'Permission2
toEnum :: Int -> E'Permission2
$cfromEnum :: E'Permission2 -> Int
fromEnum :: E'Permission2 -> Int
$cenumFrom :: E'Permission2 -> [E'Permission2]
enumFrom :: E'Permission2 -> [E'Permission2]
$cenumFromThen :: E'Permission2 -> E'Permission2 -> [E'Permission2]
enumFromThen :: E'Permission2 -> E'Permission2 -> [E'Permission2]
$cenumFromTo :: E'Permission2 -> E'Permission2 -> [E'Permission2]
enumFromTo :: E'Permission2 -> E'Permission2 -> [E'Permission2]
$cenumFromThenTo :: E'Permission2 -> E'Permission2 -> E'Permission2 -> [E'Permission2]
enumFromThenTo :: E'Permission2 -> E'Permission2 -> E'Permission2 -> [E'Permission2]
P.Enum)

instance A.ToJSON E'Permission2 where toJSON :: E'Permission2 -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value)
-> (E'Permission2 -> Text) -> E'Permission2 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Permission2 -> Text
fromE'Permission2
instance A.FromJSON E'Permission2 where parseJSON :: Value -> Parser E'Permission2
parseJSON Value
o = ([Char] -> Parser E'Permission2)
-> (E'Permission2 -> Parser E'Permission2)
-> Either [Char] E'Permission2
-> Parser E'Permission2
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either [Char] -> Parser E'Permission2
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
P.fail (E'Permission2 -> Parser E'Permission2
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E'Permission2 -> Parser E'Permission2)
-> (E'Permission2 -> E'Permission2)
-> E'Permission2
-> Parser E'Permission2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Permission2 -> E'Permission2
forall a. a -> a
P.id) (Either [Char] E'Permission2 -> Parser E'Permission2)
-> (Text -> Either [Char] E'Permission2)
-> Text
-> Parser E'Permission2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Permission2
toE'Permission2 (Text -> Parser E'Permission2)
-> Parser Text -> Parser E'Permission2
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData E'Permission2 where toQueryParam :: E'Permission2 -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text) -> (E'Permission2 -> Text) -> E'Permission2 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Permission2 -> Text
fromE'Permission2
instance WH.FromHttpApiData E'Permission2 where parseQueryParam :: Text -> Either Text E'Permission2
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text E'Permission2) -> Either Text E'Permission2
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> Text)
-> Either [Char] E'Permission2 -> Either Text E'Permission2
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left [Char] -> Text
T.pack (Either [Char] E'Permission2 -> Either Text E'Permission2)
-> (Text -> Either [Char] E'Permission2)
-> Text
-> Either Text E'Permission2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Permission2
toE'Permission2
instance MimeRender MimeMultipartFormData E'Permission2 where mimeRender :: Proxy MimeMultipartFormData -> E'Permission2 -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = E'Permission2 -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'E'Permission2' enum
fromE'Permission2 :: E'Permission2 -> Text
fromE'Permission2 :: E'Permission2 -> Text
fromE'Permission2 = \case
  E'Permission2
E'Permission2'None -> Text
"none"
  E'Permission2
E'Permission2'Read -> Text
"read"
  E'Permission2
E'Permission2'Write -> Text
"write"
  E'Permission2
E'Permission2'Admin -> Text
"admin"
  E'Permission2
E'Permission2'Owner -> Text
"owner"

-- | parse 'E'Permission2' enum
toE'Permission2 :: Text -> P.Either String E'Permission2
toE'Permission2 :: Text -> Either [Char] E'Permission2
toE'Permission2 = \case
  Text
"none" -> E'Permission2 -> Either [Char] E'Permission2
forall a b. b -> Either a b
P.Right E'Permission2
E'Permission2'None
  Text
"read" -> E'Permission2 -> Either [Char] E'Permission2
forall a b. b -> Either a b
P.Right E'Permission2
E'Permission2'Read
  Text
"write" -> E'Permission2 -> Either [Char] E'Permission2
forall a b. b -> Either a b
P.Right E'Permission2
E'Permission2'Write
  Text
"admin" -> E'Permission2 -> Either [Char] E'Permission2
forall a b. b -> Either a b
P.Right E'Permission2
E'Permission2'Admin
  Text
"owner" -> E'Permission2 -> Either [Char] E'Permission2
forall a b. b -> Either a b
P.Right E'Permission2
E'Permission2'Owner
  Text
s -> [Char] -> Either [Char] E'Permission2
forall a b. a -> Either a b
P.Left ([Char] -> Either [Char] E'Permission2)
-> [Char] -> Either [Char] E'Permission2
forall a b. (a -> b) -> a -> b
$ [Char]
"toE'Permission2: enum parse failure: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> [Char]
forall a. Show a => a -> [Char]
P.show Text
s


-- ** E'Service

-- | Enum of 'Text'
data E'Service
  = E'Service'Git -- ^ @"git"@
  | E'Service'Github -- ^ @"github"@
  | E'Service'Gitea -- ^ @"gitea"@
  | E'Service'Gitlab -- ^ @"gitlab"@
  | E'Service'Gogs -- ^ @"gogs"@
  | E'Service'Onedev -- ^ @"onedev"@
  | E'Service'Gitbucket -- ^ @"gitbucket"@
  | E'Service'Codebase -- ^ @"codebase"@
  deriving (Int -> E'Service -> ShowS
[E'Service] -> ShowS
E'Service -> [Char]
(Int -> E'Service -> ShowS)
-> (E'Service -> [Char])
-> ([E'Service] -> ShowS)
-> Show E'Service
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> E'Service -> ShowS
showsPrec :: Int -> E'Service -> ShowS
$cshow :: E'Service -> [Char]
show :: E'Service -> [Char]
$cshowList :: [E'Service] -> ShowS
showList :: [E'Service] -> ShowS
P.Show, E'Service -> E'Service -> Bool
(E'Service -> E'Service -> Bool)
-> (E'Service -> E'Service -> Bool) -> Eq E'Service
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: E'Service -> E'Service -> Bool
== :: E'Service -> E'Service -> Bool
$c/= :: E'Service -> E'Service -> Bool
/= :: E'Service -> E'Service -> Bool
P.Eq, P.Typeable, Eq E'Service
Eq E'Service =>
(E'Service -> E'Service -> Ordering)
-> (E'Service -> E'Service -> Bool)
-> (E'Service -> E'Service -> Bool)
-> (E'Service -> E'Service -> Bool)
-> (E'Service -> E'Service -> Bool)
-> (E'Service -> E'Service -> E'Service)
-> (E'Service -> E'Service -> E'Service)
-> Ord E'Service
E'Service -> E'Service -> Bool
E'Service -> E'Service -> Ordering
E'Service -> E'Service -> E'Service
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
$ccompare :: E'Service -> E'Service -> Ordering
compare :: E'Service -> E'Service -> Ordering
$c< :: E'Service -> E'Service -> Bool
< :: E'Service -> E'Service -> Bool
$c<= :: E'Service -> E'Service -> Bool
<= :: E'Service -> E'Service -> Bool
$c> :: E'Service -> E'Service -> Bool
> :: E'Service -> E'Service -> Bool
$c>= :: E'Service -> E'Service -> Bool
>= :: E'Service -> E'Service -> Bool
$cmax :: E'Service -> E'Service -> E'Service
max :: E'Service -> E'Service -> E'Service
$cmin :: E'Service -> E'Service -> E'Service
min :: E'Service -> E'Service -> E'Service
P.Ord, E'Service
E'Service -> E'Service -> Bounded E'Service
forall a. a -> a -> Bounded a
$cminBound :: E'Service
minBound :: E'Service
$cmaxBound :: E'Service
maxBound :: E'Service
P.Bounded, Int -> E'Service
E'Service -> Int
E'Service -> [E'Service]
E'Service -> E'Service
E'Service -> E'Service -> [E'Service]
E'Service -> E'Service -> E'Service -> [E'Service]
(E'Service -> E'Service)
-> (E'Service -> E'Service)
-> (Int -> E'Service)
-> (E'Service -> Int)
-> (E'Service -> [E'Service])
-> (E'Service -> E'Service -> [E'Service])
-> (E'Service -> E'Service -> [E'Service])
-> (E'Service -> E'Service -> E'Service -> [E'Service])
-> Enum E'Service
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: E'Service -> E'Service
succ :: E'Service -> E'Service
$cpred :: E'Service -> E'Service
pred :: E'Service -> E'Service
$ctoEnum :: Int -> E'Service
toEnum :: Int -> E'Service
$cfromEnum :: E'Service -> Int
fromEnum :: E'Service -> Int
$cenumFrom :: E'Service -> [E'Service]
enumFrom :: E'Service -> [E'Service]
$cenumFromThen :: E'Service -> E'Service -> [E'Service]
enumFromThen :: E'Service -> E'Service -> [E'Service]
$cenumFromTo :: E'Service -> E'Service -> [E'Service]
enumFromTo :: E'Service -> E'Service -> [E'Service]
$cenumFromThenTo :: E'Service -> E'Service -> E'Service -> [E'Service]
enumFromThenTo :: E'Service -> E'Service -> E'Service -> [E'Service]
P.Enum)

instance A.ToJSON E'Service where toJSON :: E'Service -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value) -> (E'Service -> Text) -> E'Service -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Service -> Text
fromE'Service
instance A.FromJSON E'Service where parseJSON :: Value -> Parser E'Service
parseJSON Value
o = ([Char] -> Parser E'Service)
-> (E'Service -> Parser E'Service)
-> Either [Char] E'Service
-> Parser E'Service
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either [Char] -> Parser E'Service
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
P.fail (E'Service -> Parser E'Service
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E'Service -> Parser E'Service)
-> (E'Service -> E'Service) -> E'Service -> Parser E'Service
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Service -> E'Service
forall a. a -> a
P.id) (Either [Char] E'Service -> Parser E'Service)
-> (Text -> Either [Char] E'Service) -> Text -> Parser E'Service
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Service
toE'Service (Text -> Parser E'Service) -> Parser Text -> Parser E'Service
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData E'Service where toQueryParam :: E'Service -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text) -> (E'Service -> Text) -> E'Service -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Service -> Text
fromE'Service
instance WH.FromHttpApiData E'Service where parseQueryParam :: Text -> Either Text E'Service
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text E'Service) -> Either Text E'Service
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> Text)
-> Either [Char] E'Service -> Either Text E'Service
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left [Char] -> Text
T.pack (Either [Char] E'Service -> Either Text E'Service)
-> (Text -> Either [Char] E'Service)
-> Text
-> Either Text E'Service
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Service
toE'Service
instance MimeRender MimeMultipartFormData E'Service where mimeRender :: Proxy MimeMultipartFormData -> E'Service -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = E'Service -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'E'Service' enum
fromE'Service :: E'Service -> Text
fromE'Service :: E'Service -> Text
fromE'Service = \case
  E'Service
E'Service'Git -> Text
"git"
  E'Service
E'Service'Github -> Text
"github"
  E'Service
E'Service'Gitea -> Text
"gitea"
  E'Service
E'Service'Gitlab -> Text
"gitlab"
  E'Service
E'Service'Gogs -> Text
"gogs"
  E'Service
E'Service'Onedev -> Text
"onedev"
  E'Service
E'Service'Gitbucket -> Text
"gitbucket"
  E'Service
E'Service'Codebase -> Text
"codebase"

-- | parse 'E'Service' enum
toE'Service :: Text -> P.Either String E'Service
toE'Service :: Text -> Either [Char] E'Service
toE'Service = \case
  Text
"git" -> E'Service -> Either [Char] E'Service
forall a b. b -> Either a b
P.Right E'Service
E'Service'Git
  Text
"github" -> E'Service -> Either [Char] E'Service
forall a b. b -> Either a b
P.Right E'Service
E'Service'Github
  Text
"gitea" -> E'Service -> Either [Char] E'Service
forall a b. b -> Either a b
P.Right E'Service
E'Service'Gitea
  Text
"gitlab" -> E'Service -> Either [Char] E'Service
forall a b. b -> Either a b
P.Right E'Service
E'Service'Gitlab
  Text
"gogs" -> E'Service -> Either [Char] E'Service
forall a b. b -> Either a b
P.Right E'Service
E'Service'Gogs
  Text
"onedev" -> E'Service -> Either [Char] E'Service
forall a b. b -> Either a b
P.Right E'Service
E'Service'Onedev
  Text
"gitbucket" -> E'Service -> Either [Char] E'Service
forall a b. b -> Either a b
P.Right E'Service
E'Service'Gitbucket
  Text
"codebase" -> E'Service -> Either [Char] E'Service
forall a b. b -> Either a b
P.Right E'Service
E'Service'Codebase
  Text
s -> [Char] -> Either [Char] E'Service
forall a b. a -> Either a b
P.Left ([Char] -> Either [Char] E'Service)
-> [Char] -> Either [Char] E'Service
forall a b. (a -> b) -> a -> b
$ [Char]
"toE'Service: enum parse failure: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> [Char]
forall a. Show a => a -> [Char]
P.show Text
s


-- ** E'Sort

-- | Enum of 'Text'
data E'Sort
  = E'Sort'Oldest -- ^ @"oldest"@
  | E'Sort'Recentupdate -- ^ @"recentupdate"@
  | E'Sort'Leastupdate -- ^ @"leastupdate"@
  | E'Sort'Leastindex -- ^ @"leastindex"@
  | E'Sort'Highestindex -- ^ @"highestindex"@
  deriving (Int -> E'Sort -> ShowS
[E'Sort] -> ShowS
E'Sort -> [Char]
(Int -> E'Sort -> ShowS)
-> (E'Sort -> [Char]) -> ([E'Sort] -> ShowS) -> Show E'Sort
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> E'Sort -> ShowS
showsPrec :: Int -> E'Sort -> ShowS
$cshow :: E'Sort -> [Char]
show :: E'Sort -> [Char]
$cshowList :: [E'Sort] -> ShowS
showList :: [E'Sort] -> ShowS
P.Show, E'Sort -> E'Sort -> Bool
(E'Sort -> E'Sort -> Bool)
-> (E'Sort -> E'Sort -> Bool) -> Eq E'Sort
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: E'Sort -> E'Sort -> Bool
== :: E'Sort -> E'Sort -> Bool
$c/= :: E'Sort -> E'Sort -> Bool
/= :: E'Sort -> E'Sort -> Bool
P.Eq, P.Typeable, Eq E'Sort
Eq E'Sort =>
(E'Sort -> E'Sort -> Ordering)
-> (E'Sort -> E'Sort -> Bool)
-> (E'Sort -> E'Sort -> Bool)
-> (E'Sort -> E'Sort -> Bool)
-> (E'Sort -> E'Sort -> Bool)
-> (E'Sort -> E'Sort -> E'Sort)
-> (E'Sort -> E'Sort -> E'Sort)
-> Ord E'Sort
E'Sort -> E'Sort -> Bool
E'Sort -> E'Sort -> Ordering
E'Sort -> E'Sort -> E'Sort
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
$ccompare :: E'Sort -> E'Sort -> Ordering
compare :: E'Sort -> E'Sort -> Ordering
$c< :: E'Sort -> E'Sort -> Bool
< :: E'Sort -> E'Sort -> Bool
$c<= :: E'Sort -> E'Sort -> Bool
<= :: E'Sort -> E'Sort -> Bool
$c> :: E'Sort -> E'Sort -> Bool
> :: E'Sort -> E'Sort -> Bool
$c>= :: E'Sort -> E'Sort -> Bool
>= :: E'Sort -> E'Sort -> Bool
$cmax :: E'Sort -> E'Sort -> E'Sort
max :: E'Sort -> E'Sort -> E'Sort
$cmin :: E'Sort -> E'Sort -> E'Sort
min :: E'Sort -> E'Sort -> E'Sort
P.Ord, E'Sort
E'Sort -> E'Sort -> Bounded E'Sort
forall a. a -> a -> Bounded a
$cminBound :: E'Sort
minBound :: E'Sort
$cmaxBound :: E'Sort
maxBound :: E'Sort
P.Bounded, Int -> E'Sort
E'Sort -> Int
E'Sort -> [E'Sort]
E'Sort -> E'Sort
E'Sort -> E'Sort -> [E'Sort]
E'Sort -> E'Sort -> E'Sort -> [E'Sort]
(E'Sort -> E'Sort)
-> (E'Sort -> E'Sort)
-> (Int -> E'Sort)
-> (E'Sort -> Int)
-> (E'Sort -> [E'Sort])
-> (E'Sort -> E'Sort -> [E'Sort])
-> (E'Sort -> E'Sort -> [E'Sort])
-> (E'Sort -> E'Sort -> E'Sort -> [E'Sort])
-> Enum E'Sort
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: E'Sort -> E'Sort
succ :: E'Sort -> E'Sort
$cpred :: E'Sort -> E'Sort
pred :: E'Sort -> E'Sort
$ctoEnum :: Int -> E'Sort
toEnum :: Int -> E'Sort
$cfromEnum :: E'Sort -> Int
fromEnum :: E'Sort -> Int
$cenumFrom :: E'Sort -> [E'Sort]
enumFrom :: E'Sort -> [E'Sort]
$cenumFromThen :: E'Sort -> E'Sort -> [E'Sort]
enumFromThen :: E'Sort -> E'Sort -> [E'Sort]
$cenumFromTo :: E'Sort -> E'Sort -> [E'Sort]
enumFromTo :: E'Sort -> E'Sort -> [E'Sort]
$cenumFromThenTo :: E'Sort -> E'Sort -> E'Sort -> [E'Sort]
enumFromThenTo :: E'Sort -> E'Sort -> E'Sort -> [E'Sort]
P.Enum)

instance A.ToJSON E'Sort where toJSON :: E'Sort -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value) -> (E'Sort -> Text) -> E'Sort -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Sort -> Text
fromE'Sort
instance A.FromJSON E'Sort where parseJSON :: Value -> Parser E'Sort
parseJSON Value
o = ([Char] -> Parser E'Sort)
-> (E'Sort -> Parser E'Sort)
-> Either [Char] E'Sort
-> Parser E'Sort
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either [Char] -> Parser E'Sort
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
P.fail (E'Sort -> Parser E'Sort
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E'Sort -> Parser E'Sort)
-> (E'Sort -> E'Sort) -> E'Sort -> Parser E'Sort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Sort -> E'Sort
forall a. a -> a
P.id) (Either [Char] E'Sort -> Parser E'Sort)
-> (Text -> Either [Char] E'Sort) -> Text -> Parser E'Sort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Sort
toE'Sort (Text -> Parser E'Sort) -> Parser Text -> Parser E'Sort
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData E'Sort where toQueryParam :: E'Sort -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text) -> (E'Sort -> Text) -> E'Sort -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Sort -> Text
fromE'Sort
instance WH.FromHttpApiData E'Sort where parseQueryParam :: Text -> Either Text E'Sort
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text E'Sort) -> Either Text E'Sort
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> Text) -> Either [Char] E'Sort -> Either Text E'Sort
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left [Char] -> Text
T.pack (Either [Char] E'Sort -> Either Text E'Sort)
-> (Text -> Either [Char] E'Sort) -> Text -> Either Text E'Sort
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Sort
toE'Sort
instance MimeRender MimeMultipartFormData E'Sort where mimeRender :: Proxy MimeMultipartFormData -> E'Sort -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = E'Sort -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'E'Sort' enum
fromE'Sort :: E'Sort -> Text
fromE'Sort :: E'Sort -> Text
fromE'Sort = \case
  E'Sort
E'Sort'Oldest -> Text
"oldest"
  E'Sort
E'Sort'Recentupdate -> Text
"recentupdate"
  E'Sort
E'Sort'Leastupdate -> Text
"leastupdate"
  E'Sort
E'Sort'Leastindex -> Text
"leastindex"
  E'Sort
E'Sort'Highestindex -> Text
"highestindex"

-- | parse 'E'Sort' enum
toE'Sort :: Text -> P.Either String E'Sort
toE'Sort :: Text -> Either [Char] E'Sort
toE'Sort = \case
  Text
"oldest" -> E'Sort -> Either [Char] E'Sort
forall a b. b -> Either a b
P.Right E'Sort
E'Sort'Oldest
  Text
"recentupdate" -> E'Sort -> Either [Char] E'Sort
forall a b. b -> Either a b
P.Right E'Sort
E'Sort'Recentupdate
  Text
"leastupdate" -> E'Sort -> Either [Char] E'Sort
forall a b. b -> Either a b
P.Right E'Sort
E'Sort'Leastupdate
  Text
"leastindex" -> E'Sort -> Either [Char] E'Sort
forall a b. b -> Either a b
P.Right E'Sort
E'Sort'Leastindex
  Text
"highestindex" -> E'Sort -> Either [Char] E'Sort
forall a b. b -> Either a b
P.Right E'Sort
E'Sort'Highestindex
  Text
s -> [Char] -> Either [Char] E'Sort
forall a b. a -> Either a b
P.Left ([Char] -> Either [Char] E'Sort) -> [Char] -> Either [Char] E'Sort
forall a b. (a -> b) -> a -> b
$ [Char]
"toE'Sort: enum parse failure: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> [Char]
forall a. Show a => a -> [Char]
P.show Text
s


-- ** E'Sort2

-- | Enum of 'Text'
data E'Sort2
  = E'Sort2'Oldest -- ^ @"oldest"@
  | E'Sort2'Recentupdate -- ^ @"recentupdate"@
  | E'Sort2'Leastupdate -- ^ @"leastupdate"@
  | E'Sort2'Mostcomment -- ^ @"mostcomment"@
  | E'Sort2'Leastcomment -- ^ @"leastcomment"@
  | E'Sort2'Priority -- ^ @"priority"@
  deriving (Int -> E'Sort2 -> ShowS
[E'Sort2] -> ShowS
E'Sort2 -> [Char]
(Int -> E'Sort2 -> ShowS)
-> (E'Sort2 -> [Char]) -> ([E'Sort2] -> ShowS) -> Show E'Sort2
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> E'Sort2 -> ShowS
showsPrec :: Int -> E'Sort2 -> ShowS
$cshow :: E'Sort2 -> [Char]
show :: E'Sort2 -> [Char]
$cshowList :: [E'Sort2] -> ShowS
showList :: [E'Sort2] -> ShowS
P.Show, E'Sort2 -> E'Sort2 -> Bool
(E'Sort2 -> E'Sort2 -> Bool)
-> (E'Sort2 -> E'Sort2 -> Bool) -> Eq E'Sort2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: E'Sort2 -> E'Sort2 -> Bool
== :: E'Sort2 -> E'Sort2 -> Bool
$c/= :: E'Sort2 -> E'Sort2 -> Bool
/= :: E'Sort2 -> E'Sort2 -> Bool
P.Eq, P.Typeable, Eq E'Sort2
Eq E'Sort2 =>
(E'Sort2 -> E'Sort2 -> Ordering)
-> (E'Sort2 -> E'Sort2 -> Bool)
-> (E'Sort2 -> E'Sort2 -> Bool)
-> (E'Sort2 -> E'Sort2 -> Bool)
-> (E'Sort2 -> E'Sort2 -> Bool)
-> (E'Sort2 -> E'Sort2 -> E'Sort2)
-> (E'Sort2 -> E'Sort2 -> E'Sort2)
-> Ord E'Sort2
E'Sort2 -> E'Sort2 -> Bool
E'Sort2 -> E'Sort2 -> Ordering
E'Sort2 -> E'Sort2 -> E'Sort2
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
$ccompare :: E'Sort2 -> E'Sort2 -> Ordering
compare :: E'Sort2 -> E'Sort2 -> Ordering
$c< :: E'Sort2 -> E'Sort2 -> Bool
< :: E'Sort2 -> E'Sort2 -> Bool
$c<= :: E'Sort2 -> E'Sort2 -> Bool
<= :: E'Sort2 -> E'Sort2 -> Bool
$c> :: E'Sort2 -> E'Sort2 -> Bool
> :: E'Sort2 -> E'Sort2 -> Bool
$c>= :: E'Sort2 -> E'Sort2 -> Bool
>= :: E'Sort2 -> E'Sort2 -> Bool
$cmax :: E'Sort2 -> E'Sort2 -> E'Sort2
max :: E'Sort2 -> E'Sort2 -> E'Sort2
$cmin :: E'Sort2 -> E'Sort2 -> E'Sort2
min :: E'Sort2 -> E'Sort2 -> E'Sort2
P.Ord, E'Sort2
E'Sort2 -> E'Sort2 -> Bounded E'Sort2
forall a. a -> a -> Bounded a
$cminBound :: E'Sort2
minBound :: E'Sort2
$cmaxBound :: E'Sort2
maxBound :: E'Sort2
P.Bounded, Int -> E'Sort2
E'Sort2 -> Int
E'Sort2 -> [E'Sort2]
E'Sort2 -> E'Sort2
E'Sort2 -> E'Sort2 -> [E'Sort2]
E'Sort2 -> E'Sort2 -> E'Sort2 -> [E'Sort2]
(E'Sort2 -> E'Sort2)
-> (E'Sort2 -> E'Sort2)
-> (Int -> E'Sort2)
-> (E'Sort2 -> Int)
-> (E'Sort2 -> [E'Sort2])
-> (E'Sort2 -> E'Sort2 -> [E'Sort2])
-> (E'Sort2 -> E'Sort2 -> [E'Sort2])
-> (E'Sort2 -> E'Sort2 -> E'Sort2 -> [E'Sort2])
-> Enum E'Sort2
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: E'Sort2 -> E'Sort2
succ :: E'Sort2 -> E'Sort2
$cpred :: E'Sort2 -> E'Sort2
pred :: E'Sort2 -> E'Sort2
$ctoEnum :: Int -> E'Sort2
toEnum :: Int -> E'Sort2
$cfromEnum :: E'Sort2 -> Int
fromEnum :: E'Sort2 -> Int
$cenumFrom :: E'Sort2 -> [E'Sort2]
enumFrom :: E'Sort2 -> [E'Sort2]
$cenumFromThen :: E'Sort2 -> E'Sort2 -> [E'Sort2]
enumFromThen :: E'Sort2 -> E'Sort2 -> [E'Sort2]
$cenumFromTo :: E'Sort2 -> E'Sort2 -> [E'Sort2]
enumFromTo :: E'Sort2 -> E'Sort2 -> [E'Sort2]
$cenumFromThenTo :: E'Sort2 -> E'Sort2 -> E'Sort2 -> [E'Sort2]
enumFromThenTo :: E'Sort2 -> E'Sort2 -> E'Sort2 -> [E'Sort2]
P.Enum)

instance A.ToJSON E'Sort2 where toJSON :: E'Sort2 -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value) -> (E'Sort2 -> Text) -> E'Sort2 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Sort2 -> Text
fromE'Sort2
instance A.FromJSON E'Sort2 where parseJSON :: Value -> Parser E'Sort2
parseJSON Value
o = ([Char] -> Parser E'Sort2)
-> (E'Sort2 -> Parser E'Sort2)
-> Either [Char] E'Sort2
-> Parser E'Sort2
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either [Char] -> Parser E'Sort2
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
P.fail (E'Sort2 -> Parser E'Sort2
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E'Sort2 -> Parser E'Sort2)
-> (E'Sort2 -> E'Sort2) -> E'Sort2 -> Parser E'Sort2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Sort2 -> E'Sort2
forall a. a -> a
P.id) (Either [Char] E'Sort2 -> Parser E'Sort2)
-> (Text -> Either [Char] E'Sort2) -> Text -> Parser E'Sort2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Sort2
toE'Sort2 (Text -> Parser E'Sort2) -> Parser Text -> Parser E'Sort2
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData E'Sort2 where toQueryParam :: E'Sort2 -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text) -> (E'Sort2 -> Text) -> E'Sort2 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Sort2 -> Text
fromE'Sort2
instance WH.FromHttpApiData E'Sort2 where parseQueryParam :: Text -> Either Text E'Sort2
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text E'Sort2) -> Either Text E'Sort2
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> Text) -> Either [Char] E'Sort2 -> Either Text E'Sort2
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left [Char] -> Text
T.pack (Either [Char] E'Sort2 -> Either Text E'Sort2)
-> (Text -> Either [Char] E'Sort2) -> Text -> Either Text E'Sort2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Sort2
toE'Sort2
instance MimeRender MimeMultipartFormData E'Sort2 where mimeRender :: Proxy MimeMultipartFormData -> E'Sort2 -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = E'Sort2 -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'E'Sort2' enum
fromE'Sort2 :: E'Sort2 -> Text
fromE'Sort2 :: E'Sort2 -> Text
fromE'Sort2 = \case
  E'Sort2
E'Sort2'Oldest -> Text
"oldest"
  E'Sort2
E'Sort2'Recentupdate -> Text
"recentupdate"
  E'Sort2
E'Sort2'Leastupdate -> Text
"leastupdate"
  E'Sort2
E'Sort2'Mostcomment -> Text
"mostcomment"
  E'Sort2
E'Sort2'Leastcomment -> Text
"leastcomment"
  E'Sort2
E'Sort2'Priority -> Text
"priority"

-- | parse 'E'Sort2' enum
toE'Sort2 :: Text -> P.Either String E'Sort2
toE'Sort2 :: Text -> Either [Char] E'Sort2
toE'Sort2 = \case
  Text
"oldest" -> E'Sort2 -> Either [Char] E'Sort2
forall a b. b -> Either a b
P.Right E'Sort2
E'Sort2'Oldest
  Text
"recentupdate" -> E'Sort2 -> Either [Char] E'Sort2
forall a b. b -> Either a b
P.Right E'Sort2
E'Sort2'Recentupdate
  Text
"leastupdate" -> E'Sort2 -> Either [Char] E'Sort2
forall a b. b -> Either a b
P.Right E'Sort2
E'Sort2'Leastupdate
  Text
"mostcomment" -> E'Sort2 -> Either [Char] E'Sort2
forall a b. b -> Either a b
P.Right E'Sort2
E'Sort2'Mostcomment
  Text
"leastcomment" -> E'Sort2 -> Either [Char] E'Sort2
forall a b. b -> Either a b
P.Right E'Sort2
E'Sort2'Leastcomment
  Text
"priority" -> E'Sort2 -> Either [Char] E'Sort2
forall a b. b -> Either a b
P.Right E'Sort2
E'Sort2'Priority
  Text
s -> [Char] -> Either [Char] E'Sort2
forall a b. a -> Either a b
P.Left ([Char] -> Either [Char] E'Sort2)
-> [Char] -> Either [Char] E'Sort2
forall a b. (a -> b) -> a -> b
$ [Char]
"toE'Sort2: enum parse failure: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> [Char]
forall a. Show a => a -> [Char]
P.show Text
s


-- ** E'State

-- | Enum of 'Text'
data E'State
  = E'State'Open -- ^ @"open"@
  | E'State'Closed -- ^ @"closed"@
  deriving (Int -> E'State -> ShowS
[E'State] -> ShowS
E'State -> [Char]
(Int -> E'State -> ShowS)
-> (E'State -> [Char]) -> ([E'State] -> ShowS) -> Show E'State
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> E'State -> ShowS
showsPrec :: Int -> E'State -> ShowS
$cshow :: E'State -> [Char]
show :: E'State -> [Char]
$cshowList :: [E'State] -> ShowS
showList :: [E'State] -> ShowS
P.Show, E'State -> E'State -> Bool
(E'State -> E'State -> Bool)
-> (E'State -> E'State -> Bool) -> Eq E'State
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: E'State -> E'State -> Bool
== :: E'State -> E'State -> Bool
$c/= :: E'State -> E'State -> Bool
/= :: E'State -> E'State -> Bool
P.Eq, P.Typeable, Eq E'State
Eq E'State =>
(E'State -> E'State -> Ordering)
-> (E'State -> E'State -> Bool)
-> (E'State -> E'State -> Bool)
-> (E'State -> E'State -> Bool)
-> (E'State -> E'State -> Bool)
-> (E'State -> E'State -> E'State)
-> (E'State -> E'State -> E'State)
-> Ord E'State
E'State -> E'State -> Bool
E'State -> E'State -> Ordering
E'State -> E'State -> E'State
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
$ccompare :: E'State -> E'State -> Ordering
compare :: E'State -> E'State -> Ordering
$c< :: E'State -> E'State -> Bool
< :: E'State -> E'State -> Bool
$c<= :: E'State -> E'State -> Bool
<= :: E'State -> E'State -> Bool
$c> :: E'State -> E'State -> Bool
> :: E'State -> E'State -> Bool
$c>= :: E'State -> E'State -> Bool
>= :: E'State -> E'State -> Bool
$cmax :: E'State -> E'State -> E'State
max :: E'State -> E'State -> E'State
$cmin :: E'State -> E'State -> E'State
min :: E'State -> E'State -> E'State
P.Ord, E'State
E'State -> E'State -> Bounded E'State
forall a. a -> a -> Bounded a
$cminBound :: E'State
minBound :: E'State
$cmaxBound :: E'State
maxBound :: E'State
P.Bounded, Int -> E'State
E'State -> Int
E'State -> [E'State]
E'State -> E'State
E'State -> E'State -> [E'State]
E'State -> E'State -> E'State -> [E'State]
(E'State -> E'State)
-> (E'State -> E'State)
-> (Int -> E'State)
-> (E'State -> Int)
-> (E'State -> [E'State])
-> (E'State -> E'State -> [E'State])
-> (E'State -> E'State -> [E'State])
-> (E'State -> E'State -> E'State -> [E'State])
-> Enum E'State
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: E'State -> E'State
succ :: E'State -> E'State
$cpred :: E'State -> E'State
pred :: E'State -> E'State
$ctoEnum :: Int -> E'State
toEnum :: Int -> E'State
$cfromEnum :: E'State -> Int
fromEnum :: E'State -> Int
$cenumFrom :: E'State -> [E'State]
enumFrom :: E'State -> [E'State]
$cenumFromThen :: E'State -> E'State -> [E'State]
enumFromThen :: E'State -> E'State -> [E'State]
$cenumFromTo :: E'State -> E'State -> [E'State]
enumFromTo :: E'State -> E'State -> [E'State]
$cenumFromThenTo :: E'State -> E'State -> E'State -> [E'State]
enumFromThenTo :: E'State -> E'State -> E'State -> [E'State]
P.Enum)

instance A.ToJSON E'State where toJSON :: E'State -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value) -> (E'State -> Text) -> E'State -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'State -> Text
fromE'State
instance A.FromJSON E'State where parseJSON :: Value -> Parser E'State
parseJSON Value
o = ([Char] -> Parser E'State)
-> (E'State -> Parser E'State)
-> Either [Char] E'State
-> Parser E'State
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either [Char] -> Parser E'State
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
P.fail (E'State -> Parser E'State
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E'State -> Parser E'State)
-> (E'State -> E'State) -> E'State -> Parser E'State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'State -> E'State
forall a. a -> a
P.id) (Either [Char] E'State -> Parser E'State)
-> (Text -> Either [Char] E'State) -> Text -> Parser E'State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'State
toE'State (Text -> Parser E'State) -> Parser Text -> Parser E'State
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData E'State where toQueryParam :: E'State -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text) -> (E'State -> Text) -> E'State -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'State -> Text
fromE'State
instance WH.FromHttpApiData E'State where parseQueryParam :: Text -> Either Text E'State
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text E'State) -> Either Text E'State
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> Text) -> Either [Char] E'State -> Either Text E'State
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left [Char] -> Text
T.pack (Either [Char] E'State -> Either Text E'State)
-> (Text -> Either [Char] E'State) -> Text -> Either Text E'State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'State
toE'State
instance MimeRender MimeMultipartFormData E'State where mimeRender :: Proxy MimeMultipartFormData -> E'State -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = E'State -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'E'State' enum
fromE'State :: E'State -> Text
fromE'State :: E'State -> Text
fromE'State = \case
  E'State
E'State'Open -> Text
"open"
  E'State
E'State'Closed -> Text
"closed"

-- | parse 'E'State' enum
toE'State :: Text -> P.Either String E'State
toE'State :: Text -> Either [Char] E'State
toE'State = \case
  Text
"open" -> E'State -> Either [Char] E'State
forall a b. b -> Either a b
P.Right E'State
E'State'Open
  Text
"closed" -> E'State -> Either [Char] E'State
forall a b. b -> Either a b
P.Right E'State
E'State'Closed
  Text
s -> [Char] -> Either [Char] E'State
forall a b. a -> Either a b
P.Left ([Char] -> Either [Char] E'State)
-> [Char] -> Either [Char] E'State
forall a b. (a -> b) -> a -> b
$ [Char]
"toE'State: enum parse failure: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> [Char]
forall a. Show a => a -> [Char]
P.show Text
s


-- ** E'State2

-- | Enum of 'Text'
data E'State2
  = E'State2'Open -- ^ @"open"@
  | E'State2'Closed -- ^ @"closed"@
  | E'State2'All -- ^ @"all"@
  deriving (Int -> E'State2 -> ShowS
[E'State2] -> ShowS
E'State2 -> [Char]
(Int -> E'State2 -> ShowS)
-> (E'State2 -> [Char]) -> ([E'State2] -> ShowS) -> Show E'State2
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> E'State2 -> ShowS
showsPrec :: Int -> E'State2 -> ShowS
$cshow :: E'State2 -> [Char]
show :: E'State2 -> [Char]
$cshowList :: [E'State2] -> ShowS
showList :: [E'State2] -> ShowS
P.Show, E'State2 -> E'State2 -> Bool
(E'State2 -> E'State2 -> Bool)
-> (E'State2 -> E'State2 -> Bool) -> Eq E'State2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: E'State2 -> E'State2 -> Bool
== :: E'State2 -> E'State2 -> Bool
$c/= :: E'State2 -> E'State2 -> Bool
/= :: E'State2 -> E'State2 -> Bool
P.Eq, P.Typeable, Eq E'State2
Eq E'State2 =>
(E'State2 -> E'State2 -> Ordering)
-> (E'State2 -> E'State2 -> Bool)
-> (E'State2 -> E'State2 -> Bool)
-> (E'State2 -> E'State2 -> Bool)
-> (E'State2 -> E'State2 -> Bool)
-> (E'State2 -> E'State2 -> E'State2)
-> (E'State2 -> E'State2 -> E'State2)
-> Ord E'State2
E'State2 -> E'State2 -> Bool
E'State2 -> E'State2 -> Ordering
E'State2 -> E'State2 -> E'State2
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
$ccompare :: E'State2 -> E'State2 -> Ordering
compare :: E'State2 -> E'State2 -> Ordering
$c< :: E'State2 -> E'State2 -> Bool
< :: E'State2 -> E'State2 -> Bool
$c<= :: E'State2 -> E'State2 -> Bool
<= :: E'State2 -> E'State2 -> Bool
$c> :: E'State2 -> E'State2 -> Bool
> :: E'State2 -> E'State2 -> Bool
$c>= :: E'State2 -> E'State2 -> Bool
>= :: E'State2 -> E'State2 -> Bool
$cmax :: E'State2 -> E'State2 -> E'State2
max :: E'State2 -> E'State2 -> E'State2
$cmin :: E'State2 -> E'State2 -> E'State2
min :: E'State2 -> E'State2 -> E'State2
P.Ord, E'State2
E'State2 -> E'State2 -> Bounded E'State2
forall a. a -> a -> Bounded a
$cminBound :: E'State2
minBound :: E'State2
$cmaxBound :: E'State2
maxBound :: E'State2
P.Bounded, Int -> E'State2
E'State2 -> Int
E'State2 -> [E'State2]
E'State2 -> E'State2
E'State2 -> E'State2 -> [E'State2]
E'State2 -> E'State2 -> E'State2 -> [E'State2]
(E'State2 -> E'State2)
-> (E'State2 -> E'State2)
-> (Int -> E'State2)
-> (E'State2 -> Int)
-> (E'State2 -> [E'State2])
-> (E'State2 -> E'State2 -> [E'State2])
-> (E'State2 -> E'State2 -> [E'State2])
-> (E'State2 -> E'State2 -> E'State2 -> [E'State2])
-> Enum E'State2
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: E'State2 -> E'State2
succ :: E'State2 -> E'State2
$cpred :: E'State2 -> E'State2
pred :: E'State2 -> E'State2
$ctoEnum :: Int -> E'State2
toEnum :: Int -> E'State2
$cfromEnum :: E'State2 -> Int
fromEnum :: E'State2 -> Int
$cenumFrom :: E'State2 -> [E'State2]
enumFrom :: E'State2 -> [E'State2]
$cenumFromThen :: E'State2 -> E'State2 -> [E'State2]
enumFromThen :: E'State2 -> E'State2 -> [E'State2]
$cenumFromTo :: E'State2 -> E'State2 -> [E'State2]
enumFromTo :: E'State2 -> E'State2 -> [E'State2]
$cenumFromThenTo :: E'State2 -> E'State2 -> E'State2 -> [E'State2]
enumFromThenTo :: E'State2 -> E'State2 -> E'State2 -> [E'State2]
P.Enum)

instance A.ToJSON E'State2 where toJSON :: E'State2 -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value) -> (E'State2 -> Text) -> E'State2 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'State2 -> Text
fromE'State2
instance A.FromJSON E'State2 where parseJSON :: Value -> Parser E'State2
parseJSON Value
o = ([Char] -> Parser E'State2)
-> (E'State2 -> Parser E'State2)
-> Either [Char] E'State2
-> Parser E'State2
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either [Char] -> Parser E'State2
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
P.fail (E'State2 -> Parser E'State2
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E'State2 -> Parser E'State2)
-> (E'State2 -> E'State2) -> E'State2 -> Parser E'State2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'State2 -> E'State2
forall a. a -> a
P.id) (Either [Char] E'State2 -> Parser E'State2)
-> (Text -> Either [Char] E'State2) -> Text -> Parser E'State2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'State2
toE'State2 (Text -> Parser E'State2) -> Parser Text -> Parser E'State2
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData E'State2 where toQueryParam :: E'State2 -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text) -> (E'State2 -> Text) -> E'State2 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'State2 -> Text
fromE'State2
instance WH.FromHttpApiData E'State2 where parseQueryParam :: Text -> Either Text E'State2
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text E'State2) -> Either Text E'State2
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> Text) -> Either [Char] E'State2 -> Either Text E'State2
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left [Char] -> Text
T.pack (Either [Char] E'State2 -> Either Text E'State2)
-> (Text -> Either [Char] E'State2) -> Text -> Either Text E'State2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'State2
toE'State2
instance MimeRender MimeMultipartFormData E'State2 where mimeRender :: Proxy MimeMultipartFormData -> E'State2 -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = E'State2 -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'E'State2' enum
fromE'State2 :: E'State2 -> Text
fromE'State2 :: E'State2 -> Text
fromE'State2 = \case
  E'State2
E'State2'Open -> Text
"open"
  E'State2
E'State2'Closed -> Text
"closed"
  E'State2
E'State2'All -> Text
"all"

-- | parse 'E'State2' enum
toE'State2 :: Text -> P.Either String E'State2
toE'State2 :: Text -> Either [Char] E'State2
toE'State2 = \case
  Text
"open" -> E'State2 -> Either [Char] E'State2
forall a b. b -> Either a b
P.Right E'State2
E'State2'Open
  Text
"closed" -> E'State2 -> Either [Char] E'State2
forall a b. b -> Either a b
P.Right E'State2
E'State2'Closed
  Text
"all" -> E'State2 -> Either [Char] E'State2
forall a b. b -> Either a b
P.Right E'State2
E'State2'All
  Text
s -> [Char] -> Either [Char] E'State2
forall a b. a -> Either a b
P.Left ([Char] -> Either [Char] E'State2)
-> [Char] -> Either [Char] E'State2
forall a b. (a -> b) -> a -> b
$ [Char]
"toE'State2: enum parse failure: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> [Char]
forall a. Show a => a -> [Char]
P.show Text
s


-- ** E'State3

-- | Enum of 'Text'
data E'State3
  = E'State3'Pending -- ^ @"pending"@
  | E'State3'Success -- ^ @"success"@
  | E'State3'Error -- ^ @"error"@
  | E'State3'Failure -- ^ @"failure"@
  | E'State3'Warning -- ^ @"warning"@
  deriving (Int -> E'State3 -> ShowS
[E'State3] -> ShowS
E'State3 -> [Char]
(Int -> E'State3 -> ShowS)
-> (E'State3 -> [Char]) -> ([E'State3] -> ShowS) -> Show E'State3
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> E'State3 -> ShowS
showsPrec :: Int -> E'State3 -> ShowS
$cshow :: E'State3 -> [Char]
show :: E'State3 -> [Char]
$cshowList :: [E'State3] -> ShowS
showList :: [E'State3] -> ShowS
P.Show, E'State3 -> E'State3 -> Bool
(E'State3 -> E'State3 -> Bool)
-> (E'State3 -> E'State3 -> Bool) -> Eq E'State3
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: E'State3 -> E'State3 -> Bool
== :: E'State3 -> E'State3 -> Bool
$c/= :: E'State3 -> E'State3 -> Bool
/= :: E'State3 -> E'State3 -> Bool
P.Eq, P.Typeable, Eq E'State3
Eq E'State3 =>
(E'State3 -> E'State3 -> Ordering)
-> (E'State3 -> E'State3 -> Bool)
-> (E'State3 -> E'State3 -> Bool)
-> (E'State3 -> E'State3 -> Bool)
-> (E'State3 -> E'State3 -> Bool)
-> (E'State3 -> E'State3 -> E'State3)
-> (E'State3 -> E'State3 -> E'State3)
-> Ord E'State3
E'State3 -> E'State3 -> Bool
E'State3 -> E'State3 -> Ordering
E'State3 -> E'State3 -> E'State3
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
$ccompare :: E'State3 -> E'State3 -> Ordering
compare :: E'State3 -> E'State3 -> Ordering
$c< :: E'State3 -> E'State3 -> Bool
< :: E'State3 -> E'State3 -> Bool
$c<= :: E'State3 -> E'State3 -> Bool
<= :: E'State3 -> E'State3 -> Bool
$c> :: E'State3 -> E'State3 -> Bool
> :: E'State3 -> E'State3 -> Bool
$c>= :: E'State3 -> E'State3 -> Bool
>= :: E'State3 -> E'State3 -> Bool
$cmax :: E'State3 -> E'State3 -> E'State3
max :: E'State3 -> E'State3 -> E'State3
$cmin :: E'State3 -> E'State3 -> E'State3
min :: E'State3 -> E'State3 -> E'State3
P.Ord, E'State3
E'State3 -> E'State3 -> Bounded E'State3
forall a. a -> a -> Bounded a
$cminBound :: E'State3
minBound :: E'State3
$cmaxBound :: E'State3
maxBound :: E'State3
P.Bounded, Int -> E'State3
E'State3 -> Int
E'State3 -> [E'State3]
E'State3 -> E'State3
E'State3 -> E'State3 -> [E'State3]
E'State3 -> E'State3 -> E'State3 -> [E'State3]
(E'State3 -> E'State3)
-> (E'State3 -> E'State3)
-> (Int -> E'State3)
-> (E'State3 -> Int)
-> (E'State3 -> [E'State3])
-> (E'State3 -> E'State3 -> [E'State3])
-> (E'State3 -> E'State3 -> [E'State3])
-> (E'State3 -> E'State3 -> E'State3 -> [E'State3])
-> Enum E'State3
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: E'State3 -> E'State3
succ :: E'State3 -> E'State3
$cpred :: E'State3 -> E'State3
pred :: E'State3 -> E'State3
$ctoEnum :: Int -> E'State3
toEnum :: Int -> E'State3
$cfromEnum :: E'State3 -> Int
fromEnum :: E'State3 -> Int
$cenumFrom :: E'State3 -> [E'State3]
enumFrom :: E'State3 -> [E'State3]
$cenumFromThen :: E'State3 -> E'State3 -> [E'State3]
enumFromThen :: E'State3 -> E'State3 -> [E'State3]
$cenumFromTo :: E'State3 -> E'State3 -> [E'State3]
enumFromTo :: E'State3 -> E'State3 -> [E'State3]
$cenumFromThenTo :: E'State3 -> E'State3 -> E'State3 -> [E'State3]
enumFromThenTo :: E'State3 -> E'State3 -> E'State3 -> [E'State3]
P.Enum)

instance A.ToJSON E'State3 where toJSON :: E'State3 -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value) -> (E'State3 -> Text) -> E'State3 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'State3 -> Text
fromE'State3
instance A.FromJSON E'State3 where parseJSON :: Value -> Parser E'State3
parseJSON Value
o = ([Char] -> Parser E'State3)
-> (E'State3 -> Parser E'State3)
-> Either [Char] E'State3
-> Parser E'State3
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either [Char] -> Parser E'State3
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
P.fail (E'State3 -> Parser E'State3
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E'State3 -> Parser E'State3)
-> (E'State3 -> E'State3) -> E'State3 -> Parser E'State3
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'State3 -> E'State3
forall a. a -> a
P.id) (Either [Char] E'State3 -> Parser E'State3)
-> (Text -> Either [Char] E'State3) -> Text -> Parser E'State3
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'State3
toE'State3 (Text -> Parser E'State3) -> Parser Text -> Parser E'State3
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData E'State3 where toQueryParam :: E'State3 -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text) -> (E'State3 -> Text) -> E'State3 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'State3 -> Text
fromE'State3
instance WH.FromHttpApiData E'State3 where parseQueryParam :: Text -> Either Text E'State3
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text E'State3) -> Either Text E'State3
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> Text) -> Either [Char] E'State3 -> Either Text E'State3
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left [Char] -> Text
T.pack (Either [Char] E'State3 -> Either Text E'State3)
-> (Text -> Either [Char] E'State3) -> Text -> Either Text E'State3
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'State3
toE'State3
instance MimeRender MimeMultipartFormData E'State3 where mimeRender :: Proxy MimeMultipartFormData -> E'State3 -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = E'State3 -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'E'State3' enum
fromE'State3 :: E'State3 -> Text
fromE'State3 :: E'State3 -> Text
fromE'State3 = \case
  E'State3
E'State3'Pending -> Text
"pending"
  E'State3
E'State3'Success -> Text
"success"
  E'State3
E'State3'Error -> Text
"error"
  E'State3
E'State3'Failure -> Text
"failure"
  E'State3
E'State3'Warning -> Text
"warning"

-- | parse 'E'State3' enum
toE'State3 :: Text -> P.Either String E'State3
toE'State3 :: Text -> Either [Char] E'State3
toE'State3 = \case
  Text
"pending" -> E'State3 -> Either [Char] E'State3
forall a b. b -> Either a b
P.Right E'State3
E'State3'Pending
  Text
"success" -> E'State3 -> Either [Char] E'State3
forall a b. b -> Either a b
P.Right E'State3
E'State3'Success
  Text
"error" -> E'State3 -> Either [Char] E'State3
forall a b. b -> Either a b
P.Right E'State3
E'State3'Error
  Text
"failure" -> E'State3 -> Either [Char] E'State3
forall a b. b -> Either a b
P.Right E'State3
E'State3'Failure
  Text
"warning" -> E'State3 -> Either [Char] E'State3
forall a b. b -> Either a b
P.Right E'State3
E'State3'Warning
  Text
s -> [Char] -> Either [Char] E'State3
forall a b. a -> Either a b
P.Left ([Char] -> Either [Char] E'State3)
-> [Char] -> Either [Char] E'State3
forall a b. (a -> b) -> a -> b
$ [Char]
"toE'State3: enum parse failure: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> [Char]
forall a. Show a => a -> [Char]
P.show Text
s


-- ** E'State4

-- | Enum of 'Text'
data E'State4
  = E'State4'Closed -- ^ @"closed"@
  | E'State4'Open -- ^ @"open"@
  | E'State4'All -- ^ @"all"@
  deriving (Int -> E'State4 -> ShowS
[E'State4] -> ShowS
E'State4 -> [Char]
(Int -> E'State4 -> ShowS)
-> (E'State4 -> [Char]) -> ([E'State4] -> ShowS) -> Show E'State4
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> E'State4 -> ShowS
showsPrec :: Int -> E'State4 -> ShowS
$cshow :: E'State4 -> [Char]
show :: E'State4 -> [Char]
$cshowList :: [E'State4] -> ShowS
showList :: [E'State4] -> ShowS
P.Show, E'State4 -> E'State4 -> Bool
(E'State4 -> E'State4 -> Bool)
-> (E'State4 -> E'State4 -> Bool) -> Eq E'State4
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: E'State4 -> E'State4 -> Bool
== :: E'State4 -> E'State4 -> Bool
$c/= :: E'State4 -> E'State4 -> Bool
/= :: E'State4 -> E'State4 -> Bool
P.Eq, P.Typeable, Eq E'State4
Eq E'State4 =>
(E'State4 -> E'State4 -> Ordering)
-> (E'State4 -> E'State4 -> Bool)
-> (E'State4 -> E'State4 -> Bool)
-> (E'State4 -> E'State4 -> Bool)
-> (E'State4 -> E'State4 -> Bool)
-> (E'State4 -> E'State4 -> E'State4)
-> (E'State4 -> E'State4 -> E'State4)
-> Ord E'State4
E'State4 -> E'State4 -> Bool
E'State4 -> E'State4 -> Ordering
E'State4 -> E'State4 -> E'State4
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
$ccompare :: E'State4 -> E'State4 -> Ordering
compare :: E'State4 -> E'State4 -> Ordering
$c< :: E'State4 -> E'State4 -> Bool
< :: E'State4 -> E'State4 -> Bool
$c<= :: E'State4 -> E'State4 -> Bool
<= :: E'State4 -> E'State4 -> Bool
$c> :: E'State4 -> E'State4 -> Bool
> :: E'State4 -> E'State4 -> Bool
$c>= :: E'State4 -> E'State4 -> Bool
>= :: E'State4 -> E'State4 -> Bool
$cmax :: E'State4 -> E'State4 -> E'State4
max :: E'State4 -> E'State4 -> E'State4
$cmin :: E'State4 -> E'State4 -> E'State4
min :: E'State4 -> E'State4 -> E'State4
P.Ord, E'State4
E'State4 -> E'State4 -> Bounded E'State4
forall a. a -> a -> Bounded a
$cminBound :: E'State4
minBound :: E'State4
$cmaxBound :: E'State4
maxBound :: E'State4
P.Bounded, Int -> E'State4
E'State4 -> Int
E'State4 -> [E'State4]
E'State4 -> E'State4
E'State4 -> E'State4 -> [E'State4]
E'State4 -> E'State4 -> E'State4 -> [E'State4]
(E'State4 -> E'State4)
-> (E'State4 -> E'State4)
-> (Int -> E'State4)
-> (E'State4 -> Int)
-> (E'State4 -> [E'State4])
-> (E'State4 -> E'State4 -> [E'State4])
-> (E'State4 -> E'State4 -> [E'State4])
-> (E'State4 -> E'State4 -> E'State4 -> [E'State4])
-> Enum E'State4
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: E'State4 -> E'State4
succ :: E'State4 -> E'State4
$cpred :: E'State4 -> E'State4
pred :: E'State4 -> E'State4
$ctoEnum :: Int -> E'State4
toEnum :: Int -> E'State4
$cfromEnum :: E'State4 -> Int
fromEnum :: E'State4 -> Int
$cenumFrom :: E'State4 -> [E'State4]
enumFrom :: E'State4 -> [E'State4]
$cenumFromThen :: E'State4 -> E'State4 -> [E'State4]
enumFromThen :: E'State4 -> E'State4 -> [E'State4]
$cenumFromTo :: E'State4 -> E'State4 -> [E'State4]
enumFromTo :: E'State4 -> E'State4 -> [E'State4]
$cenumFromThenTo :: E'State4 -> E'State4 -> E'State4 -> [E'State4]
enumFromThenTo :: E'State4 -> E'State4 -> E'State4 -> [E'State4]
P.Enum)

instance A.ToJSON E'State4 where toJSON :: E'State4 -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value) -> (E'State4 -> Text) -> E'State4 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'State4 -> Text
fromE'State4
instance A.FromJSON E'State4 where parseJSON :: Value -> Parser E'State4
parseJSON Value
o = ([Char] -> Parser E'State4)
-> (E'State4 -> Parser E'State4)
-> Either [Char] E'State4
-> Parser E'State4
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either [Char] -> Parser E'State4
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
P.fail (E'State4 -> Parser E'State4
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E'State4 -> Parser E'State4)
-> (E'State4 -> E'State4) -> E'State4 -> Parser E'State4
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'State4 -> E'State4
forall a. a -> a
P.id) (Either [Char] E'State4 -> Parser E'State4)
-> (Text -> Either [Char] E'State4) -> Text -> Parser E'State4
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'State4
toE'State4 (Text -> Parser E'State4) -> Parser Text -> Parser E'State4
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData E'State4 where toQueryParam :: E'State4 -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text) -> (E'State4 -> Text) -> E'State4 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'State4 -> Text
fromE'State4
instance WH.FromHttpApiData E'State4 where parseQueryParam :: Text -> Either Text E'State4
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text E'State4) -> Either Text E'State4
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> Text) -> Either [Char] E'State4 -> Either Text E'State4
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left [Char] -> Text
T.pack (Either [Char] E'State4 -> Either Text E'State4)
-> (Text -> Either [Char] E'State4) -> Text -> Either Text E'State4
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'State4
toE'State4
instance MimeRender MimeMultipartFormData E'State4 where mimeRender :: Proxy MimeMultipartFormData -> E'State4 -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = E'State4 -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'E'State4' enum
fromE'State4 :: E'State4 -> Text
fromE'State4 :: E'State4 -> Text
fromE'State4 = \case
  E'State4
E'State4'Closed -> Text
"closed"
  E'State4
E'State4'Open -> Text
"open"
  E'State4
E'State4'All -> Text
"all"

-- | parse 'E'State4' enum
toE'State4 :: Text -> P.Either String E'State4
toE'State4 :: Text -> Either [Char] E'State4
toE'State4 = \case
  Text
"closed" -> E'State4 -> Either [Char] E'State4
forall a b. b -> Either a b
P.Right E'State4
E'State4'Closed
  Text
"open" -> E'State4 -> Either [Char] E'State4
forall a b. b -> Either a b
P.Right E'State4
E'State4'Open
  Text
"all" -> E'State4 -> Either [Char] E'State4
forall a b. b -> Either a b
P.Right E'State4
E'State4'All
  Text
s -> [Char] -> Either [Char] E'State4
forall a b. a -> Either a b
P.Left ([Char] -> Either [Char] E'State4)
-> [Char] -> Either [Char] E'State4
forall a b. (a -> b) -> a -> b
$ [Char]
"toE'State4: enum parse failure: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> [Char]
forall a. Show a => a -> [Char]
P.show Text
s


-- ** E'Style

-- | Enum of 'Text'
data E'Style
  = E'Style'Merge -- ^ @"merge"@
  | E'Style'Rebase -- ^ @"rebase"@
  deriving (Int -> E'Style -> ShowS
[E'Style] -> ShowS
E'Style -> [Char]
(Int -> E'Style -> ShowS)
-> (E'Style -> [Char]) -> ([E'Style] -> ShowS) -> Show E'Style
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> E'Style -> ShowS
showsPrec :: Int -> E'Style -> ShowS
$cshow :: E'Style -> [Char]
show :: E'Style -> [Char]
$cshowList :: [E'Style] -> ShowS
showList :: [E'Style] -> ShowS
P.Show, E'Style -> E'Style -> Bool
(E'Style -> E'Style -> Bool)
-> (E'Style -> E'Style -> Bool) -> Eq E'Style
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: E'Style -> E'Style -> Bool
== :: E'Style -> E'Style -> Bool
$c/= :: E'Style -> E'Style -> Bool
/= :: E'Style -> E'Style -> Bool
P.Eq, P.Typeable, Eq E'Style
Eq E'Style =>
(E'Style -> E'Style -> Ordering)
-> (E'Style -> E'Style -> Bool)
-> (E'Style -> E'Style -> Bool)
-> (E'Style -> E'Style -> Bool)
-> (E'Style -> E'Style -> Bool)
-> (E'Style -> E'Style -> E'Style)
-> (E'Style -> E'Style -> E'Style)
-> Ord E'Style
E'Style -> E'Style -> Bool
E'Style -> E'Style -> Ordering
E'Style -> E'Style -> E'Style
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
$ccompare :: E'Style -> E'Style -> Ordering
compare :: E'Style -> E'Style -> Ordering
$c< :: E'Style -> E'Style -> Bool
< :: E'Style -> E'Style -> Bool
$c<= :: E'Style -> E'Style -> Bool
<= :: E'Style -> E'Style -> Bool
$c> :: E'Style -> E'Style -> Bool
> :: E'Style -> E'Style -> Bool
$c>= :: E'Style -> E'Style -> Bool
>= :: E'Style -> E'Style -> Bool
$cmax :: E'Style -> E'Style -> E'Style
max :: E'Style -> E'Style -> E'Style
$cmin :: E'Style -> E'Style -> E'Style
min :: E'Style -> E'Style -> E'Style
P.Ord, E'Style
E'Style -> E'Style -> Bounded E'Style
forall a. a -> a -> Bounded a
$cminBound :: E'Style
minBound :: E'Style
$cmaxBound :: E'Style
maxBound :: E'Style
P.Bounded, Int -> E'Style
E'Style -> Int
E'Style -> [E'Style]
E'Style -> E'Style
E'Style -> E'Style -> [E'Style]
E'Style -> E'Style -> E'Style -> [E'Style]
(E'Style -> E'Style)
-> (E'Style -> E'Style)
-> (Int -> E'Style)
-> (E'Style -> Int)
-> (E'Style -> [E'Style])
-> (E'Style -> E'Style -> [E'Style])
-> (E'Style -> E'Style -> [E'Style])
-> (E'Style -> E'Style -> E'Style -> [E'Style])
-> Enum E'Style
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: E'Style -> E'Style
succ :: E'Style -> E'Style
$cpred :: E'Style -> E'Style
pred :: E'Style -> E'Style
$ctoEnum :: Int -> E'Style
toEnum :: Int -> E'Style
$cfromEnum :: E'Style -> Int
fromEnum :: E'Style -> Int
$cenumFrom :: E'Style -> [E'Style]
enumFrom :: E'Style -> [E'Style]
$cenumFromThen :: E'Style -> E'Style -> [E'Style]
enumFromThen :: E'Style -> E'Style -> [E'Style]
$cenumFromTo :: E'Style -> E'Style -> [E'Style]
enumFromTo :: E'Style -> E'Style -> [E'Style]
$cenumFromThenTo :: E'Style -> E'Style -> E'Style -> [E'Style]
enumFromThenTo :: E'Style -> E'Style -> E'Style -> [E'Style]
P.Enum)

instance A.ToJSON E'Style where toJSON :: E'Style -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value) -> (E'Style -> Text) -> E'Style -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Style -> Text
fromE'Style
instance A.FromJSON E'Style where parseJSON :: Value -> Parser E'Style
parseJSON Value
o = ([Char] -> Parser E'Style)
-> (E'Style -> Parser E'Style)
-> Either [Char] E'Style
-> Parser E'Style
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either [Char] -> Parser E'Style
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
P.fail (E'Style -> Parser E'Style
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E'Style -> Parser E'Style)
-> (E'Style -> E'Style) -> E'Style -> Parser E'Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Style -> E'Style
forall a. a -> a
P.id) (Either [Char] E'Style -> Parser E'Style)
-> (Text -> Either [Char] E'Style) -> Text -> Parser E'Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Style
toE'Style (Text -> Parser E'Style) -> Parser Text -> Parser E'Style
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData E'Style where toQueryParam :: E'Style -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text) -> (E'Style -> Text) -> E'Style -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Style -> Text
fromE'Style
instance WH.FromHttpApiData E'Style where parseQueryParam :: Text -> Either Text E'Style
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text E'Style) -> Either Text E'Style
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> Text) -> Either [Char] E'Style -> Either Text E'Style
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left [Char] -> Text
T.pack (Either [Char] E'Style -> Either Text E'Style)
-> (Text -> Either [Char] E'Style) -> Text -> Either Text E'Style
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Style
toE'Style
instance MimeRender MimeMultipartFormData E'Style where mimeRender :: Proxy MimeMultipartFormData -> E'Style -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = E'Style -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'E'Style' enum
fromE'Style :: E'Style -> Text
fromE'Style :: E'Style -> Text
fromE'Style = \case
  E'Style
E'Style'Merge -> Text
"merge"
  E'Style
E'Style'Rebase -> Text
"rebase"

-- | parse 'E'Style' enum
toE'Style :: Text -> P.Either String E'Style
toE'Style :: Text -> Either [Char] E'Style
toE'Style = \case
  Text
"merge" -> E'Style -> Either [Char] E'Style
forall a b. b -> Either a b
P.Right E'Style
E'Style'Merge
  Text
"rebase" -> E'Style -> Either [Char] E'Style
forall a b. b -> Either a b
P.Right E'Style
E'Style'Rebase
  Text
s -> [Char] -> Either [Char] E'Style
forall a b. a -> Either a b
P.Left ([Char] -> Either [Char] E'Style)
-> [Char] -> Either [Char] E'Style
forall a b. (a -> b) -> a -> b
$ [Char]
"toE'Style: enum parse failure: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> [Char]
forall a. Show a => a -> [Char]
P.show Text
s


-- ** E'SubjectType

-- | Enum of 'Text'
data E'SubjectType
  = E'SubjectType'Issue -- ^ @"issue"@
  | E'SubjectType'Pull -- ^ @"pull"@
  | E'SubjectType'Commit -- ^ @"commit"@
  | E'SubjectType'Repository -- ^ @"repository"@
  deriving (Int -> E'SubjectType -> ShowS
[E'SubjectType] -> ShowS
E'SubjectType -> [Char]
(Int -> E'SubjectType -> ShowS)
-> (E'SubjectType -> [Char])
-> ([E'SubjectType] -> ShowS)
-> Show E'SubjectType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> E'SubjectType -> ShowS
showsPrec :: Int -> E'SubjectType -> ShowS
$cshow :: E'SubjectType -> [Char]
show :: E'SubjectType -> [Char]
$cshowList :: [E'SubjectType] -> ShowS
showList :: [E'SubjectType] -> ShowS
P.Show, E'SubjectType -> E'SubjectType -> Bool
(E'SubjectType -> E'SubjectType -> Bool)
-> (E'SubjectType -> E'SubjectType -> Bool) -> Eq E'SubjectType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: E'SubjectType -> E'SubjectType -> Bool
== :: E'SubjectType -> E'SubjectType -> Bool
$c/= :: E'SubjectType -> E'SubjectType -> Bool
/= :: E'SubjectType -> E'SubjectType -> Bool
P.Eq, P.Typeable, Eq E'SubjectType
Eq E'SubjectType =>
(E'SubjectType -> E'SubjectType -> Ordering)
-> (E'SubjectType -> E'SubjectType -> Bool)
-> (E'SubjectType -> E'SubjectType -> Bool)
-> (E'SubjectType -> E'SubjectType -> Bool)
-> (E'SubjectType -> E'SubjectType -> Bool)
-> (E'SubjectType -> E'SubjectType -> E'SubjectType)
-> (E'SubjectType -> E'SubjectType -> E'SubjectType)
-> Ord E'SubjectType
E'SubjectType -> E'SubjectType -> Bool
E'SubjectType -> E'SubjectType -> Ordering
E'SubjectType -> E'SubjectType -> E'SubjectType
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
$ccompare :: E'SubjectType -> E'SubjectType -> Ordering
compare :: E'SubjectType -> E'SubjectType -> Ordering
$c< :: E'SubjectType -> E'SubjectType -> Bool
< :: E'SubjectType -> E'SubjectType -> Bool
$c<= :: E'SubjectType -> E'SubjectType -> Bool
<= :: E'SubjectType -> E'SubjectType -> Bool
$c> :: E'SubjectType -> E'SubjectType -> Bool
> :: E'SubjectType -> E'SubjectType -> Bool
$c>= :: E'SubjectType -> E'SubjectType -> Bool
>= :: E'SubjectType -> E'SubjectType -> Bool
$cmax :: E'SubjectType -> E'SubjectType -> E'SubjectType
max :: E'SubjectType -> E'SubjectType -> E'SubjectType
$cmin :: E'SubjectType -> E'SubjectType -> E'SubjectType
min :: E'SubjectType -> E'SubjectType -> E'SubjectType
P.Ord, E'SubjectType
E'SubjectType -> E'SubjectType -> Bounded E'SubjectType
forall a. a -> a -> Bounded a
$cminBound :: E'SubjectType
minBound :: E'SubjectType
$cmaxBound :: E'SubjectType
maxBound :: E'SubjectType
P.Bounded, Int -> E'SubjectType
E'SubjectType -> Int
E'SubjectType -> [E'SubjectType]
E'SubjectType -> E'SubjectType
E'SubjectType -> E'SubjectType -> [E'SubjectType]
E'SubjectType -> E'SubjectType -> E'SubjectType -> [E'SubjectType]
(E'SubjectType -> E'SubjectType)
-> (E'SubjectType -> E'SubjectType)
-> (Int -> E'SubjectType)
-> (E'SubjectType -> Int)
-> (E'SubjectType -> [E'SubjectType])
-> (E'SubjectType -> E'SubjectType -> [E'SubjectType])
-> (E'SubjectType -> E'SubjectType -> [E'SubjectType])
-> (E'SubjectType
    -> E'SubjectType -> E'SubjectType -> [E'SubjectType])
-> Enum E'SubjectType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: E'SubjectType -> E'SubjectType
succ :: E'SubjectType -> E'SubjectType
$cpred :: E'SubjectType -> E'SubjectType
pred :: E'SubjectType -> E'SubjectType
$ctoEnum :: Int -> E'SubjectType
toEnum :: Int -> E'SubjectType
$cfromEnum :: E'SubjectType -> Int
fromEnum :: E'SubjectType -> Int
$cenumFrom :: E'SubjectType -> [E'SubjectType]
enumFrom :: E'SubjectType -> [E'SubjectType]
$cenumFromThen :: E'SubjectType -> E'SubjectType -> [E'SubjectType]
enumFromThen :: E'SubjectType -> E'SubjectType -> [E'SubjectType]
$cenumFromTo :: E'SubjectType -> E'SubjectType -> [E'SubjectType]
enumFromTo :: E'SubjectType -> E'SubjectType -> [E'SubjectType]
$cenumFromThenTo :: E'SubjectType -> E'SubjectType -> E'SubjectType -> [E'SubjectType]
enumFromThenTo :: E'SubjectType -> E'SubjectType -> E'SubjectType -> [E'SubjectType]
P.Enum)

instance A.ToJSON E'SubjectType where toJSON :: E'SubjectType -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value)
-> (E'SubjectType -> Text) -> E'SubjectType -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'SubjectType -> Text
fromE'SubjectType
instance A.FromJSON E'SubjectType where parseJSON :: Value -> Parser E'SubjectType
parseJSON Value
o = ([Char] -> Parser E'SubjectType)
-> (E'SubjectType -> Parser E'SubjectType)
-> Either [Char] E'SubjectType
-> Parser E'SubjectType
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either [Char] -> Parser E'SubjectType
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
P.fail (E'SubjectType -> Parser E'SubjectType
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E'SubjectType -> Parser E'SubjectType)
-> (E'SubjectType -> E'SubjectType)
-> E'SubjectType
-> Parser E'SubjectType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'SubjectType -> E'SubjectType
forall a. a -> a
P.id) (Either [Char] E'SubjectType -> Parser E'SubjectType)
-> (Text -> Either [Char] E'SubjectType)
-> Text
-> Parser E'SubjectType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'SubjectType
toE'SubjectType (Text -> Parser E'SubjectType)
-> Parser Text -> Parser E'SubjectType
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData E'SubjectType where toQueryParam :: E'SubjectType -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text) -> (E'SubjectType -> Text) -> E'SubjectType -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'SubjectType -> Text
fromE'SubjectType
instance WH.FromHttpApiData E'SubjectType where parseQueryParam :: Text -> Either Text E'SubjectType
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text E'SubjectType) -> Either Text E'SubjectType
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> Text)
-> Either [Char] E'SubjectType -> Either Text E'SubjectType
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left [Char] -> Text
T.pack (Either [Char] E'SubjectType -> Either Text E'SubjectType)
-> (Text -> Either [Char] E'SubjectType)
-> Text
-> Either Text E'SubjectType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'SubjectType
toE'SubjectType
instance MimeRender MimeMultipartFormData E'SubjectType where mimeRender :: Proxy MimeMultipartFormData -> E'SubjectType -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = E'SubjectType -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'E'SubjectType' enum
fromE'SubjectType :: E'SubjectType -> Text
fromE'SubjectType :: E'SubjectType -> Text
fromE'SubjectType = \case
  E'SubjectType
E'SubjectType'Issue -> Text
"issue"
  E'SubjectType
E'SubjectType'Pull -> Text
"pull"
  E'SubjectType
E'SubjectType'Commit -> Text
"commit"
  E'SubjectType
E'SubjectType'Repository -> Text
"repository"

-- | parse 'E'SubjectType' enum
toE'SubjectType :: Text -> P.Either String E'SubjectType
toE'SubjectType :: Text -> Either [Char] E'SubjectType
toE'SubjectType = \case
  Text
"issue" -> E'SubjectType -> Either [Char] E'SubjectType
forall a b. b -> Either a b
P.Right E'SubjectType
E'SubjectType'Issue
  Text
"pull" -> E'SubjectType -> Either [Char] E'SubjectType
forall a b. b -> Either a b
P.Right E'SubjectType
E'SubjectType'Pull
  Text
"commit" -> E'SubjectType -> Either [Char] E'SubjectType
forall a b. b -> Either a b
P.Right E'SubjectType
E'SubjectType'Commit
  Text
"repository" -> E'SubjectType -> Either [Char] E'SubjectType
forall a b. b -> Either a b
P.Right E'SubjectType
E'SubjectType'Repository
  Text
s -> [Char] -> Either [Char] E'SubjectType
forall a b. a -> Either a b
P.Left ([Char] -> Either [Char] E'SubjectType)
-> [Char] -> Either [Char] E'SubjectType
forall a b. (a -> b) -> a -> b
$ [Char]
"toE'SubjectType: enum parse failure: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> [Char]
forall a. Show a => a -> [Char]
P.show Text
s


-- ** E'TrustModel

-- | Enum of 'Text' .
-- TrustModel of the repository
data E'TrustModel
  = E'TrustModel'Default -- ^ @"default"@
  | E'TrustModel'Collaborator -- ^ @"collaborator"@
  | E'TrustModel'Committer -- ^ @"committer"@
  | E'TrustModel'Collaboratorcommitter -- ^ @"collaboratorcommitter"@
  deriving (Int -> E'TrustModel -> ShowS
[E'TrustModel] -> ShowS
E'TrustModel -> [Char]
(Int -> E'TrustModel -> ShowS)
-> (E'TrustModel -> [Char])
-> ([E'TrustModel] -> ShowS)
-> Show E'TrustModel
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> E'TrustModel -> ShowS
showsPrec :: Int -> E'TrustModel -> ShowS
$cshow :: E'TrustModel -> [Char]
show :: E'TrustModel -> [Char]
$cshowList :: [E'TrustModel] -> ShowS
showList :: [E'TrustModel] -> ShowS
P.Show, E'TrustModel -> E'TrustModel -> Bool
(E'TrustModel -> E'TrustModel -> Bool)
-> (E'TrustModel -> E'TrustModel -> Bool) -> Eq E'TrustModel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: E'TrustModel -> E'TrustModel -> Bool
== :: E'TrustModel -> E'TrustModel -> Bool
$c/= :: E'TrustModel -> E'TrustModel -> Bool
/= :: E'TrustModel -> E'TrustModel -> Bool
P.Eq, P.Typeable, Eq E'TrustModel
Eq E'TrustModel =>
(E'TrustModel -> E'TrustModel -> Ordering)
-> (E'TrustModel -> E'TrustModel -> Bool)
-> (E'TrustModel -> E'TrustModel -> Bool)
-> (E'TrustModel -> E'TrustModel -> Bool)
-> (E'TrustModel -> E'TrustModel -> Bool)
-> (E'TrustModel -> E'TrustModel -> E'TrustModel)
-> (E'TrustModel -> E'TrustModel -> E'TrustModel)
-> Ord E'TrustModel
E'TrustModel -> E'TrustModel -> Bool
E'TrustModel -> E'TrustModel -> Ordering
E'TrustModel -> E'TrustModel -> E'TrustModel
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
$ccompare :: E'TrustModel -> E'TrustModel -> Ordering
compare :: E'TrustModel -> E'TrustModel -> Ordering
$c< :: E'TrustModel -> E'TrustModel -> Bool
< :: E'TrustModel -> E'TrustModel -> Bool
$c<= :: E'TrustModel -> E'TrustModel -> Bool
<= :: E'TrustModel -> E'TrustModel -> Bool
$c> :: E'TrustModel -> E'TrustModel -> Bool
> :: E'TrustModel -> E'TrustModel -> Bool
$c>= :: E'TrustModel -> E'TrustModel -> Bool
>= :: E'TrustModel -> E'TrustModel -> Bool
$cmax :: E'TrustModel -> E'TrustModel -> E'TrustModel
max :: E'TrustModel -> E'TrustModel -> E'TrustModel
$cmin :: E'TrustModel -> E'TrustModel -> E'TrustModel
min :: E'TrustModel -> E'TrustModel -> E'TrustModel
P.Ord, E'TrustModel
E'TrustModel -> E'TrustModel -> Bounded E'TrustModel
forall a. a -> a -> Bounded a
$cminBound :: E'TrustModel
minBound :: E'TrustModel
$cmaxBound :: E'TrustModel
maxBound :: E'TrustModel
P.Bounded, Int -> E'TrustModel
E'TrustModel -> Int
E'TrustModel -> [E'TrustModel]
E'TrustModel -> E'TrustModel
E'TrustModel -> E'TrustModel -> [E'TrustModel]
E'TrustModel -> E'TrustModel -> E'TrustModel -> [E'TrustModel]
(E'TrustModel -> E'TrustModel)
-> (E'TrustModel -> E'TrustModel)
-> (Int -> E'TrustModel)
-> (E'TrustModel -> Int)
-> (E'TrustModel -> [E'TrustModel])
-> (E'TrustModel -> E'TrustModel -> [E'TrustModel])
-> (E'TrustModel -> E'TrustModel -> [E'TrustModel])
-> (E'TrustModel -> E'TrustModel -> E'TrustModel -> [E'TrustModel])
-> Enum E'TrustModel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: E'TrustModel -> E'TrustModel
succ :: E'TrustModel -> E'TrustModel
$cpred :: E'TrustModel -> E'TrustModel
pred :: E'TrustModel -> E'TrustModel
$ctoEnum :: Int -> E'TrustModel
toEnum :: Int -> E'TrustModel
$cfromEnum :: E'TrustModel -> Int
fromEnum :: E'TrustModel -> Int
$cenumFrom :: E'TrustModel -> [E'TrustModel]
enumFrom :: E'TrustModel -> [E'TrustModel]
$cenumFromThen :: E'TrustModel -> E'TrustModel -> [E'TrustModel]
enumFromThen :: E'TrustModel -> E'TrustModel -> [E'TrustModel]
$cenumFromTo :: E'TrustModel -> E'TrustModel -> [E'TrustModel]
enumFromTo :: E'TrustModel -> E'TrustModel -> [E'TrustModel]
$cenumFromThenTo :: E'TrustModel -> E'TrustModel -> E'TrustModel -> [E'TrustModel]
enumFromThenTo :: E'TrustModel -> E'TrustModel -> E'TrustModel -> [E'TrustModel]
P.Enum)

instance A.ToJSON E'TrustModel where toJSON :: E'TrustModel -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value) -> (E'TrustModel -> Text) -> E'TrustModel -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'TrustModel -> Text
fromE'TrustModel
instance A.FromJSON E'TrustModel where parseJSON :: Value -> Parser E'TrustModel
parseJSON Value
o = ([Char] -> Parser E'TrustModel)
-> (E'TrustModel -> Parser E'TrustModel)
-> Either [Char] E'TrustModel
-> Parser E'TrustModel
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either [Char] -> Parser E'TrustModel
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
P.fail (E'TrustModel -> Parser E'TrustModel
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E'TrustModel -> Parser E'TrustModel)
-> (E'TrustModel -> E'TrustModel)
-> E'TrustModel
-> Parser E'TrustModel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'TrustModel -> E'TrustModel
forall a. a -> a
P.id) (Either [Char] E'TrustModel -> Parser E'TrustModel)
-> (Text -> Either [Char] E'TrustModel)
-> Text
-> Parser E'TrustModel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'TrustModel
toE'TrustModel (Text -> Parser E'TrustModel) -> Parser Text -> Parser E'TrustModel
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData E'TrustModel where toQueryParam :: E'TrustModel -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text) -> (E'TrustModel -> Text) -> E'TrustModel -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'TrustModel -> Text
fromE'TrustModel
instance WH.FromHttpApiData E'TrustModel where parseQueryParam :: Text -> Either Text E'TrustModel
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text E'TrustModel) -> Either Text E'TrustModel
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> Text)
-> Either [Char] E'TrustModel -> Either Text E'TrustModel
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left [Char] -> Text
T.pack (Either [Char] E'TrustModel -> Either Text E'TrustModel)
-> (Text -> Either [Char] E'TrustModel)
-> Text
-> Either Text E'TrustModel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'TrustModel
toE'TrustModel
instance MimeRender MimeMultipartFormData E'TrustModel where mimeRender :: Proxy MimeMultipartFormData -> E'TrustModel -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = E'TrustModel -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'E'TrustModel' enum
fromE'TrustModel :: E'TrustModel -> Text
fromE'TrustModel :: E'TrustModel -> Text
fromE'TrustModel = \case
  E'TrustModel
E'TrustModel'Default -> Text
"default"
  E'TrustModel
E'TrustModel'Collaborator -> Text
"collaborator"
  E'TrustModel
E'TrustModel'Committer -> Text
"committer"
  E'TrustModel
E'TrustModel'Collaboratorcommitter -> Text
"collaboratorcommitter"

-- | parse 'E'TrustModel' enum
toE'TrustModel :: Text -> P.Either String E'TrustModel
toE'TrustModel :: Text -> Either [Char] E'TrustModel
toE'TrustModel = \case
  Text
"default" -> E'TrustModel -> Either [Char] E'TrustModel
forall a b. b -> Either a b
P.Right E'TrustModel
E'TrustModel'Default
  Text
"collaborator" -> E'TrustModel -> Either [Char] E'TrustModel
forall a b. b -> Either a b
P.Right E'TrustModel
E'TrustModel'Collaborator
  Text
"committer" -> E'TrustModel -> Either [Char] E'TrustModel
forall a b. b -> Either a b
P.Right E'TrustModel
E'TrustModel'Committer
  Text
"collaboratorcommitter" -> E'TrustModel -> Either [Char] E'TrustModel
forall a b. b -> Either a b
P.Right E'TrustModel
E'TrustModel'Collaboratorcommitter
  Text
s -> [Char] -> Either [Char] E'TrustModel
forall a b. a -> Either a b
P.Left ([Char] -> Either [Char] E'TrustModel)
-> [Char] -> Either [Char] E'TrustModel
forall a b. (a -> b) -> a -> b
$ [Char]
"toE'TrustModel: enum parse failure: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> [Char]
forall a. Show a => a -> [Char]
P.show Text
s


-- ** E'Type

-- | Enum of 'Text'
data E'Type
  = E'Type'Dingtalk -- ^ @"dingtalk"@
  | E'Type'Discord -- ^ @"discord"@
  | E'Type'Gitea -- ^ @"gitea"@
  | E'Type'Gogs -- ^ @"gogs"@
  | E'Type'Msteams -- ^ @"msteams"@
  | E'Type'Slack -- ^ @"slack"@
  | E'Type'Telegram -- ^ @"telegram"@
  | E'Type'Feishu -- ^ @"feishu"@
  | E'Type'Wechatwork -- ^ @"wechatwork"@
  | E'Type'Packagist -- ^ @"packagist"@
  deriving (Int -> E'Type -> ShowS
[E'Type] -> ShowS
E'Type -> [Char]
(Int -> E'Type -> ShowS)
-> (E'Type -> [Char]) -> ([E'Type] -> ShowS) -> Show E'Type
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> E'Type -> ShowS
showsPrec :: Int -> E'Type -> ShowS
$cshow :: E'Type -> [Char]
show :: E'Type -> [Char]
$cshowList :: [E'Type] -> ShowS
showList :: [E'Type] -> ShowS
P.Show, E'Type -> E'Type -> Bool
(E'Type -> E'Type -> Bool)
-> (E'Type -> E'Type -> Bool) -> Eq E'Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: E'Type -> E'Type -> Bool
== :: E'Type -> E'Type -> Bool
$c/= :: E'Type -> E'Type -> Bool
/= :: E'Type -> E'Type -> Bool
P.Eq, P.Typeable, Eq E'Type
Eq E'Type =>
(E'Type -> E'Type -> Ordering)
-> (E'Type -> E'Type -> Bool)
-> (E'Type -> E'Type -> Bool)
-> (E'Type -> E'Type -> Bool)
-> (E'Type -> E'Type -> Bool)
-> (E'Type -> E'Type -> E'Type)
-> (E'Type -> E'Type -> E'Type)
-> Ord E'Type
E'Type -> E'Type -> Bool
E'Type -> E'Type -> Ordering
E'Type -> E'Type -> E'Type
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
$ccompare :: E'Type -> E'Type -> Ordering
compare :: E'Type -> E'Type -> Ordering
$c< :: E'Type -> E'Type -> Bool
< :: E'Type -> E'Type -> Bool
$c<= :: E'Type -> E'Type -> Bool
<= :: E'Type -> E'Type -> Bool
$c> :: E'Type -> E'Type -> Bool
> :: E'Type -> E'Type -> Bool
$c>= :: E'Type -> E'Type -> Bool
>= :: E'Type -> E'Type -> Bool
$cmax :: E'Type -> E'Type -> E'Type
max :: E'Type -> E'Type -> E'Type
$cmin :: E'Type -> E'Type -> E'Type
min :: E'Type -> E'Type -> E'Type
P.Ord, E'Type
E'Type -> E'Type -> Bounded E'Type
forall a. a -> a -> Bounded a
$cminBound :: E'Type
minBound :: E'Type
$cmaxBound :: E'Type
maxBound :: E'Type
P.Bounded, Int -> E'Type
E'Type -> Int
E'Type -> [E'Type]
E'Type -> E'Type
E'Type -> E'Type -> [E'Type]
E'Type -> E'Type -> E'Type -> [E'Type]
(E'Type -> E'Type)
-> (E'Type -> E'Type)
-> (Int -> E'Type)
-> (E'Type -> Int)
-> (E'Type -> [E'Type])
-> (E'Type -> E'Type -> [E'Type])
-> (E'Type -> E'Type -> [E'Type])
-> (E'Type -> E'Type -> E'Type -> [E'Type])
-> Enum E'Type
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: E'Type -> E'Type
succ :: E'Type -> E'Type
$cpred :: E'Type -> E'Type
pred :: E'Type -> E'Type
$ctoEnum :: Int -> E'Type
toEnum :: Int -> E'Type
$cfromEnum :: E'Type -> Int
fromEnum :: E'Type -> Int
$cenumFrom :: E'Type -> [E'Type]
enumFrom :: E'Type -> [E'Type]
$cenumFromThen :: E'Type -> E'Type -> [E'Type]
enumFromThen :: E'Type -> E'Type -> [E'Type]
$cenumFromTo :: E'Type -> E'Type -> [E'Type]
enumFromTo :: E'Type -> E'Type -> [E'Type]
$cenumFromThenTo :: E'Type -> E'Type -> E'Type -> [E'Type]
enumFromThenTo :: E'Type -> E'Type -> E'Type -> [E'Type]
P.Enum)

instance A.ToJSON E'Type where toJSON :: E'Type -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value) -> (E'Type -> Text) -> E'Type -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Type -> Text
fromE'Type
instance A.FromJSON E'Type where parseJSON :: Value -> Parser E'Type
parseJSON Value
o = ([Char] -> Parser E'Type)
-> (E'Type -> Parser E'Type)
-> Either [Char] E'Type
-> Parser E'Type
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either [Char] -> Parser E'Type
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
P.fail (E'Type -> Parser E'Type
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E'Type -> Parser E'Type)
-> (E'Type -> E'Type) -> E'Type -> Parser E'Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Type -> E'Type
forall a. a -> a
P.id) (Either [Char] E'Type -> Parser E'Type)
-> (Text -> Either [Char] E'Type) -> Text -> Parser E'Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Type
toE'Type (Text -> Parser E'Type) -> Parser Text -> Parser E'Type
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData E'Type where toQueryParam :: E'Type -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text) -> (E'Type -> Text) -> E'Type -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Type -> Text
fromE'Type
instance WH.FromHttpApiData E'Type where parseQueryParam :: Text -> Either Text E'Type
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text E'Type) -> Either Text E'Type
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> Text) -> Either [Char] E'Type -> Either Text E'Type
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left [Char] -> Text
T.pack (Either [Char] E'Type -> Either Text E'Type)
-> (Text -> Either [Char] E'Type) -> Text -> Either Text E'Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Type
toE'Type
instance MimeRender MimeMultipartFormData E'Type where mimeRender :: Proxy MimeMultipartFormData -> E'Type -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = E'Type -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'E'Type' enum
fromE'Type :: E'Type -> Text
fromE'Type :: E'Type -> Text
fromE'Type = \case
  E'Type
E'Type'Dingtalk -> Text
"dingtalk"
  E'Type
E'Type'Discord -> Text
"discord"
  E'Type
E'Type'Gitea -> Text
"gitea"
  E'Type
E'Type'Gogs -> Text
"gogs"
  E'Type
E'Type'Msteams -> Text
"msteams"
  E'Type
E'Type'Slack -> Text
"slack"
  E'Type
E'Type'Telegram -> Text
"telegram"
  E'Type
E'Type'Feishu -> Text
"feishu"
  E'Type
E'Type'Wechatwork -> Text
"wechatwork"
  E'Type
E'Type'Packagist -> Text
"packagist"

-- | parse 'E'Type' enum
toE'Type :: Text -> P.Either String E'Type
toE'Type :: Text -> Either [Char] E'Type
toE'Type = \case
  Text
"dingtalk" -> E'Type -> Either [Char] E'Type
forall a b. b -> Either a b
P.Right E'Type
E'Type'Dingtalk
  Text
"discord" -> E'Type -> Either [Char] E'Type
forall a b. b -> Either a b
P.Right E'Type
E'Type'Discord
  Text
"gitea" -> E'Type -> Either [Char] E'Type
forall a b. b -> Either a b
P.Right E'Type
E'Type'Gitea
  Text
"gogs" -> E'Type -> Either [Char] E'Type
forall a b. b -> Either a b
P.Right E'Type
E'Type'Gogs
  Text
"msteams" -> E'Type -> Either [Char] E'Type
forall a b. b -> Either a b
P.Right E'Type
E'Type'Msteams
  Text
"slack" -> E'Type -> Either [Char] E'Type
forall a b. b -> Either a b
P.Right E'Type
E'Type'Slack
  Text
"telegram" -> E'Type -> Either [Char] E'Type
forall a b. b -> Either a b
P.Right E'Type
E'Type'Telegram
  Text
"feishu" -> E'Type -> Either [Char] E'Type
forall a b. b -> Either a b
P.Right E'Type
E'Type'Feishu
  Text
"wechatwork" -> E'Type -> Either [Char] E'Type
forall a b. b -> Either a b
P.Right E'Type
E'Type'Wechatwork
  Text
"packagist" -> E'Type -> Either [Char] E'Type
forall a b. b -> Either a b
P.Right E'Type
E'Type'Packagist
  Text
s -> [Char] -> Either [Char] E'Type
forall a b. a -> Either a b
P.Left ([Char] -> Either [Char] E'Type) -> [Char] -> Either [Char] E'Type
forall a b. (a -> b) -> a -> b
$ [Char]
"toE'Type: enum parse failure: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> [Char]
forall a. Show a => a -> [Char]
P.show Text
s


-- ** E'Type2

-- | Enum of 'Text'
data E'Type2
  = E'Type2'Alpine -- ^ @"alpine"@
  | E'Type2'Cargo -- ^ @"cargo"@
  | E'Type2'Chef -- ^ @"chef"@
  | E'Type2'Composer -- ^ @"composer"@
  | E'Type2'Conan -- ^ @"conan"@
  | E'Type2'Conda -- ^ @"conda"@
  | E'Type2'Container -- ^ @"container"@
  | E'Type2'Cran -- ^ @"cran"@
  | E'Type2'Debian -- ^ @"debian"@
  | E'Type2'Generic -- ^ @"generic"@
  | E'Type2'Go -- ^ @"go"@
  | E'Type2'Helm -- ^ @"helm"@
  | E'Type2'Maven -- ^ @"maven"@
  | E'Type2'Npm -- ^ @"npm"@
  | E'Type2'Nuget -- ^ @"nuget"@
  | E'Type2'Pub -- ^ @"pub"@
  | E'Type2'Pypi -- ^ @"pypi"@
  | E'Type2'Rpm -- ^ @"rpm"@
  | E'Type2'Rubygems -- ^ @"rubygems"@
  | E'Type2'Swift -- ^ @"swift"@
  | E'Type2'Vagrant -- ^ @"vagrant"@
  deriving (Int -> E'Type2 -> ShowS
[E'Type2] -> ShowS
E'Type2 -> [Char]
(Int -> E'Type2 -> ShowS)
-> (E'Type2 -> [Char]) -> ([E'Type2] -> ShowS) -> Show E'Type2
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> E'Type2 -> ShowS
showsPrec :: Int -> E'Type2 -> ShowS
$cshow :: E'Type2 -> [Char]
show :: E'Type2 -> [Char]
$cshowList :: [E'Type2] -> ShowS
showList :: [E'Type2] -> ShowS
P.Show, E'Type2 -> E'Type2 -> Bool
(E'Type2 -> E'Type2 -> Bool)
-> (E'Type2 -> E'Type2 -> Bool) -> Eq E'Type2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: E'Type2 -> E'Type2 -> Bool
== :: E'Type2 -> E'Type2 -> Bool
$c/= :: E'Type2 -> E'Type2 -> Bool
/= :: E'Type2 -> E'Type2 -> Bool
P.Eq, P.Typeable, Eq E'Type2
Eq E'Type2 =>
(E'Type2 -> E'Type2 -> Ordering)
-> (E'Type2 -> E'Type2 -> Bool)
-> (E'Type2 -> E'Type2 -> Bool)
-> (E'Type2 -> E'Type2 -> Bool)
-> (E'Type2 -> E'Type2 -> Bool)
-> (E'Type2 -> E'Type2 -> E'Type2)
-> (E'Type2 -> E'Type2 -> E'Type2)
-> Ord E'Type2
E'Type2 -> E'Type2 -> Bool
E'Type2 -> E'Type2 -> Ordering
E'Type2 -> E'Type2 -> E'Type2
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
$ccompare :: E'Type2 -> E'Type2 -> Ordering
compare :: E'Type2 -> E'Type2 -> Ordering
$c< :: E'Type2 -> E'Type2 -> Bool
< :: E'Type2 -> E'Type2 -> Bool
$c<= :: E'Type2 -> E'Type2 -> Bool
<= :: E'Type2 -> E'Type2 -> Bool
$c> :: E'Type2 -> E'Type2 -> Bool
> :: E'Type2 -> E'Type2 -> Bool
$c>= :: E'Type2 -> E'Type2 -> Bool
>= :: E'Type2 -> E'Type2 -> Bool
$cmax :: E'Type2 -> E'Type2 -> E'Type2
max :: E'Type2 -> E'Type2 -> E'Type2
$cmin :: E'Type2 -> E'Type2 -> E'Type2
min :: E'Type2 -> E'Type2 -> E'Type2
P.Ord, E'Type2
E'Type2 -> E'Type2 -> Bounded E'Type2
forall a. a -> a -> Bounded a
$cminBound :: E'Type2
minBound :: E'Type2
$cmaxBound :: E'Type2
maxBound :: E'Type2
P.Bounded, Int -> E'Type2
E'Type2 -> Int
E'Type2 -> [E'Type2]
E'Type2 -> E'Type2
E'Type2 -> E'Type2 -> [E'Type2]
E'Type2 -> E'Type2 -> E'Type2 -> [E'Type2]
(E'Type2 -> E'Type2)
-> (E'Type2 -> E'Type2)
-> (Int -> E'Type2)
-> (E'Type2 -> Int)
-> (E'Type2 -> [E'Type2])
-> (E'Type2 -> E'Type2 -> [E'Type2])
-> (E'Type2 -> E'Type2 -> [E'Type2])
-> (E'Type2 -> E'Type2 -> E'Type2 -> [E'Type2])
-> Enum E'Type2
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: E'Type2 -> E'Type2
succ :: E'Type2 -> E'Type2
$cpred :: E'Type2 -> E'Type2
pred :: E'Type2 -> E'Type2
$ctoEnum :: Int -> E'Type2
toEnum :: Int -> E'Type2
$cfromEnum :: E'Type2 -> Int
fromEnum :: E'Type2 -> Int
$cenumFrom :: E'Type2 -> [E'Type2]
enumFrom :: E'Type2 -> [E'Type2]
$cenumFromThen :: E'Type2 -> E'Type2 -> [E'Type2]
enumFromThen :: E'Type2 -> E'Type2 -> [E'Type2]
$cenumFromTo :: E'Type2 -> E'Type2 -> [E'Type2]
enumFromTo :: E'Type2 -> E'Type2 -> [E'Type2]
$cenumFromThenTo :: E'Type2 -> E'Type2 -> E'Type2 -> [E'Type2]
enumFromThenTo :: E'Type2 -> E'Type2 -> E'Type2 -> [E'Type2]
P.Enum)

instance A.ToJSON E'Type2 where toJSON :: E'Type2 -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value) -> (E'Type2 -> Text) -> E'Type2 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Type2 -> Text
fromE'Type2
instance A.FromJSON E'Type2 where parseJSON :: Value -> Parser E'Type2
parseJSON Value
o = ([Char] -> Parser E'Type2)
-> (E'Type2 -> Parser E'Type2)
-> Either [Char] E'Type2
-> Parser E'Type2
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either [Char] -> Parser E'Type2
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
P.fail (E'Type2 -> Parser E'Type2
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E'Type2 -> Parser E'Type2)
-> (E'Type2 -> E'Type2) -> E'Type2 -> Parser E'Type2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Type2 -> E'Type2
forall a. a -> a
P.id) (Either [Char] E'Type2 -> Parser E'Type2)
-> (Text -> Either [Char] E'Type2) -> Text -> Parser E'Type2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Type2
toE'Type2 (Text -> Parser E'Type2) -> Parser Text -> Parser E'Type2
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData E'Type2 where toQueryParam :: E'Type2 -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text) -> (E'Type2 -> Text) -> E'Type2 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Type2 -> Text
fromE'Type2
instance WH.FromHttpApiData E'Type2 where parseQueryParam :: Text -> Either Text E'Type2
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text E'Type2) -> Either Text E'Type2
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> Text) -> Either [Char] E'Type2 -> Either Text E'Type2
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left [Char] -> Text
T.pack (Either [Char] E'Type2 -> Either Text E'Type2)
-> (Text -> Either [Char] E'Type2) -> Text -> Either Text E'Type2
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Type2
toE'Type2
instance MimeRender MimeMultipartFormData E'Type2 where mimeRender :: Proxy MimeMultipartFormData -> E'Type2 -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = E'Type2 -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'E'Type2' enum
fromE'Type2 :: E'Type2 -> Text
fromE'Type2 :: E'Type2 -> Text
fromE'Type2 = \case
  E'Type2
E'Type2'Alpine -> Text
"alpine"
  E'Type2
E'Type2'Cargo -> Text
"cargo"
  E'Type2
E'Type2'Chef -> Text
"chef"
  E'Type2
E'Type2'Composer -> Text
"composer"
  E'Type2
E'Type2'Conan -> Text
"conan"
  E'Type2
E'Type2'Conda -> Text
"conda"
  E'Type2
E'Type2'Container -> Text
"container"
  E'Type2
E'Type2'Cran -> Text
"cran"
  E'Type2
E'Type2'Debian -> Text
"debian"
  E'Type2
E'Type2'Generic -> Text
"generic"
  E'Type2
E'Type2'Go -> Text
"go"
  E'Type2
E'Type2'Helm -> Text
"helm"
  E'Type2
E'Type2'Maven -> Text
"maven"
  E'Type2
E'Type2'Npm -> Text
"npm"
  E'Type2
E'Type2'Nuget -> Text
"nuget"
  E'Type2
E'Type2'Pub -> Text
"pub"
  E'Type2
E'Type2'Pypi -> Text
"pypi"
  E'Type2
E'Type2'Rpm -> Text
"rpm"
  E'Type2
E'Type2'Rubygems -> Text
"rubygems"
  E'Type2
E'Type2'Swift -> Text
"swift"
  E'Type2
E'Type2'Vagrant -> Text
"vagrant"

-- | parse 'E'Type2' enum
toE'Type2 :: Text -> P.Either String E'Type2
toE'Type2 :: Text -> Either [Char] E'Type2
toE'Type2 = \case
  Text
"alpine" -> E'Type2 -> Either [Char] E'Type2
forall a b. b -> Either a b
P.Right E'Type2
E'Type2'Alpine
  Text
"cargo" -> E'Type2 -> Either [Char] E'Type2
forall a b. b -> Either a b
P.Right E'Type2
E'Type2'Cargo
  Text
"chef" -> E'Type2 -> Either [Char] E'Type2
forall a b. b -> Either a b
P.Right E'Type2
E'Type2'Chef
  Text
"composer" -> E'Type2 -> Either [Char] E'Type2
forall a b. b -> Either a b
P.Right E'Type2
E'Type2'Composer
  Text
"conan" -> E'Type2 -> Either [Char] E'Type2
forall a b. b -> Either a b
P.Right E'Type2
E'Type2'Conan
  Text
"conda" -> E'Type2 -> Either [Char] E'Type2
forall a b. b -> Either a b
P.Right E'Type2
E'Type2'Conda
  Text
"container" -> E'Type2 -> Either [Char] E'Type2
forall a b. b -> Either a b
P.Right E'Type2
E'Type2'Container
  Text
"cran" -> E'Type2 -> Either [Char] E'Type2
forall a b. b -> Either a b
P.Right E'Type2
E'Type2'Cran
  Text
"debian" -> E'Type2 -> Either [Char] E'Type2
forall a b. b -> Either a b
P.Right E'Type2
E'Type2'Debian
  Text
"generic" -> E'Type2 -> Either [Char] E'Type2
forall a b. b -> Either a b
P.Right E'Type2
E'Type2'Generic
  Text
"go" -> E'Type2 -> Either [Char] E'Type2
forall a b. b -> Either a b
P.Right E'Type2
E'Type2'Go
  Text
"helm" -> E'Type2 -> Either [Char] E'Type2
forall a b. b -> Either a b
P.Right E'Type2
E'Type2'Helm
  Text
"maven" -> E'Type2 -> Either [Char] E'Type2
forall a b. b -> Either a b
P.Right E'Type2
E'Type2'Maven
  Text
"npm" -> E'Type2 -> Either [Char] E'Type2
forall a b. b -> Either a b
P.Right E'Type2
E'Type2'Npm
  Text
"nuget" -> E'Type2 -> Either [Char] E'Type2
forall a b. b -> Either a b
P.Right E'Type2
E'Type2'Nuget
  Text
"pub" -> E'Type2 -> Either [Char] E'Type2
forall a b. b -> Either a b
P.Right E'Type2
E'Type2'Pub
  Text
"pypi" -> E'Type2 -> Either [Char] E'Type2
forall a b. b -> Either a b
P.Right E'Type2
E'Type2'Pypi
  Text
"rpm" -> E'Type2 -> Either [Char] E'Type2
forall a b. b -> Either a b
P.Right E'Type2
E'Type2'Rpm
  Text
"rubygems" -> E'Type2 -> Either [Char] E'Type2
forall a b. b -> Either a b
P.Right E'Type2
E'Type2'Rubygems
  Text
"swift" -> E'Type2 -> Either [Char] E'Type2
forall a b. b -> Either a b
P.Right E'Type2
E'Type2'Swift
  Text
"vagrant" -> E'Type2 -> Either [Char] E'Type2
forall a b. b -> Either a b
P.Right E'Type2
E'Type2'Vagrant
  Text
s -> [Char] -> Either [Char] E'Type2
forall a b. a -> Either a b
P.Left ([Char] -> Either [Char] E'Type2)
-> [Char] -> Either [Char] E'Type2
forall a b. (a -> b) -> a -> b
$ [Char]
"toE'Type2: enum parse failure: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> [Char]
forall a. Show a => a -> [Char]
P.show Text
s


-- ** E'Type3

-- | Enum of 'Text'
data E'Type3
  = E'Type3'Issues -- ^ @"issues"@
  | E'Type3'Pulls -- ^ @"pulls"@
  deriving (Int -> E'Type3 -> ShowS
[E'Type3] -> ShowS
E'Type3 -> [Char]
(Int -> E'Type3 -> ShowS)
-> (E'Type3 -> [Char]) -> ([E'Type3] -> ShowS) -> Show E'Type3
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> E'Type3 -> ShowS
showsPrec :: Int -> E'Type3 -> ShowS
$cshow :: E'Type3 -> [Char]
show :: E'Type3 -> [Char]
$cshowList :: [E'Type3] -> ShowS
showList :: [E'Type3] -> ShowS
P.Show, E'Type3 -> E'Type3 -> Bool
(E'Type3 -> E'Type3 -> Bool)
-> (E'Type3 -> E'Type3 -> Bool) -> Eq E'Type3
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: E'Type3 -> E'Type3 -> Bool
== :: E'Type3 -> E'Type3 -> Bool
$c/= :: E'Type3 -> E'Type3 -> Bool
/= :: E'Type3 -> E'Type3 -> Bool
P.Eq, P.Typeable, Eq E'Type3
Eq E'Type3 =>
(E'Type3 -> E'Type3 -> Ordering)
-> (E'Type3 -> E'Type3 -> Bool)
-> (E'Type3 -> E'Type3 -> Bool)
-> (E'Type3 -> E'Type3 -> Bool)
-> (E'Type3 -> E'Type3 -> Bool)
-> (E'Type3 -> E'Type3 -> E'Type3)
-> (E'Type3 -> E'Type3 -> E'Type3)
-> Ord E'Type3
E'Type3 -> E'Type3 -> Bool
E'Type3 -> E'Type3 -> Ordering
E'Type3 -> E'Type3 -> E'Type3
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
$ccompare :: E'Type3 -> E'Type3 -> Ordering
compare :: E'Type3 -> E'Type3 -> Ordering
$c< :: E'Type3 -> E'Type3 -> Bool
< :: E'Type3 -> E'Type3 -> Bool
$c<= :: E'Type3 -> E'Type3 -> Bool
<= :: E'Type3 -> E'Type3 -> Bool
$c> :: E'Type3 -> E'Type3 -> Bool
> :: E'Type3 -> E'Type3 -> Bool
$c>= :: E'Type3 -> E'Type3 -> Bool
>= :: E'Type3 -> E'Type3 -> Bool
$cmax :: E'Type3 -> E'Type3 -> E'Type3
max :: E'Type3 -> E'Type3 -> E'Type3
$cmin :: E'Type3 -> E'Type3 -> E'Type3
min :: E'Type3 -> E'Type3 -> E'Type3
P.Ord, E'Type3
E'Type3 -> E'Type3 -> Bounded E'Type3
forall a. a -> a -> Bounded a
$cminBound :: E'Type3
minBound :: E'Type3
$cmaxBound :: E'Type3
maxBound :: E'Type3
P.Bounded, Int -> E'Type3
E'Type3 -> Int
E'Type3 -> [E'Type3]
E'Type3 -> E'Type3
E'Type3 -> E'Type3 -> [E'Type3]
E'Type3 -> E'Type3 -> E'Type3 -> [E'Type3]
(E'Type3 -> E'Type3)
-> (E'Type3 -> E'Type3)
-> (Int -> E'Type3)
-> (E'Type3 -> Int)
-> (E'Type3 -> [E'Type3])
-> (E'Type3 -> E'Type3 -> [E'Type3])
-> (E'Type3 -> E'Type3 -> [E'Type3])
-> (E'Type3 -> E'Type3 -> E'Type3 -> [E'Type3])
-> Enum E'Type3
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: E'Type3 -> E'Type3
succ :: E'Type3 -> E'Type3
$cpred :: E'Type3 -> E'Type3
pred :: E'Type3 -> E'Type3
$ctoEnum :: Int -> E'Type3
toEnum :: Int -> E'Type3
$cfromEnum :: E'Type3 -> Int
fromEnum :: E'Type3 -> Int
$cenumFrom :: E'Type3 -> [E'Type3]
enumFrom :: E'Type3 -> [E'Type3]
$cenumFromThen :: E'Type3 -> E'Type3 -> [E'Type3]
enumFromThen :: E'Type3 -> E'Type3 -> [E'Type3]
$cenumFromTo :: E'Type3 -> E'Type3 -> [E'Type3]
enumFromTo :: E'Type3 -> E'Type3 -> [E'Type3]
$cenumFromThenTo :: E'Type3 -> E'Type3 -> E'Type3 -> [E'Type3]
enumFromThenTo :: E'Type3 -> E'Type3 -> E'Type3 -> [E'Type3]
P.Enum)

instance A.ToJSON E'Type3 where toJSON :: E'Type3 -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value) -> (E'Type3 -> Text) -> E'Type3 -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Type3 -> Text
fromE'Type3
instance A.FromJSON E'Type3 where parseJSON :: Value -> Parser E'Type3
parseJSON Value
o = ([Char] -> Parser E'Type3)
-> (E'Type3 -> Parser E'Type3)
-> Either [Char] E'Type3
-> Parser E'Type3
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either [Char] -> Parser E'Type3
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
P.fail (E'Type3 -> Parser E'Type3
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E'Type3 -> Parser E'Type3)
-> (E'Type3 -> E'Type3) -> E'Type3 -> Parser E'Type3
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Type3 -> E'Type3
forall a. a -> a
P.id) (Either [Char] E'Type3 -> Parser E'Type3)
-> (Text -> Either [Char] E'Type3) -> Text -> Parser E'Type3
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Type3
toE'Type3 (Text -> Parser E'Type3) -> Parser Text -> Parser E'Type3
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData E'Type3 where toQueryParam :: E'Type3 -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text) -> (E'Type3 -> Text) -> E'Type3 -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Type3 -> Text
fromE'Type3
instance WH.FromHttpApiData E'Type3 where parseQueryParam :: Text -> Either Text E'Type3
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text E'Type3) -> Either Text E'Type3
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> Text) -> Either [Char] E'Type3 -> Either Text E'Type3
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left [Char] -> Text
T.pack (Either [Char] E'Type3 -> Either Text E'Type3)
-> (Text -> Either [Char] E'Type3) -> Text -> Either Text E'Type3
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Type3
toE'Type3
instance MimeRender MimeMultipartFormData E'Type3 where mimeRender :: Proxy MimeMultipartFormData -> E'Type3 -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = E'Type3 -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'E'Type3' enum
fromE'Type3 :: E'Type3 -> Text
fromE'Type3 :: E'Type3 -> Text
fromE'Type3 = \case
  E'Type3
E'Type3'Issues -> Text
"issues"
  E'Type3
E'Type3'Pulls -> Text
"pulls"

-- | parse 'E'Type3' enum
toE'Type3 :: Text -> P.Either String E'Type3
toE'Type3 :: Text -> Either [Char] E'Type3
toE'Type3 = \case
  Text
"issues" -> E'Type3 -> Either [Char] E'Type3
forall a b. b -> Either a b
P.Right E'Type3
E'Type3'Issues
  Text
"pulls" -> E'Type3 -> Either [Char] E'Type3
forall a b. b -> Either a b
P.Right E'Type3
E'Type3'Pulls
  Text
s -> [Char] -> Either [Char] E'Type3
forall a b. a -> Either a b
P.Left ([Char] -> Either [Char] E'Type3)
-> [Char] -> Either [Char] E'Type3
forall a b. (a -> b) -> a -> b
$ [Char]
"toE'Type3: enum parse failure: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> [Char]
forall a. Show a => a -> [Char]
P.show Text
s


-- ** E'Visibility

-- | Enum of 'Text' .
-- possible values are `public` (default), `limited` or `private`
data E'Visibility
  = E'Visibility'Public -- ^ @"public"@
  | E'Visibility'Limited -- ^ @"limited"@
  | E'Visibility'Private -- ^ @"private"@
  deriving (Int -> E'Visibility -> ShowS
[E'Visibility] -> ShowS
E'Visibility -> [Char]
(Int -> E'Visibility -> ShowS)
-> (E'Visibility -> [Char])
-> ([E'Visibility] -> ShowS)
-> Show E'Visibility
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> E'Visibility -> ShowS
showsPrec :: Int -> E'Visibility -> ShowS
$cshow :: E'Visibility -> [Char]
show :: E'Visibility -> [Char]
$cshowList :: [E'Visibility] -> ShowS
showList :: [E'Visibility] -> ShowS
P.Show, E'Visibility -> E'Visibility -> Bool
(E'Visibility -> E'Visibility -> Bool)
-> (E'Visibility -> E'Visibility -> Bool) -> Eq E'Visibility
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: E'Visibility -> E'Visibility -> Bool
== :: E'Visibility -> E'Visibility -> Bool
$c/= :: E'Visibility -> E'Visibility -> Bool
/= :: E'Visibility -> E'Visibility -> Bool
P.Eq, P.Typeable, Eq E'Visibility
Eq E'Visibility =>
(E'Visibility -> E'Visibility -> Ordering)
-> (E'Visibility -> E'Visibility -> Bool)
-> (E'Visibility -> E'Visibility -> Bool)
-> (E'Visibility -> E'Visibility -> Bool)
-> (E'Visibility -> E'Visibility -> Bool)
-> (E'Visibility -> E'Visibility -> E'Visibility)
-> (E'Visibility -> E'Visibility -> E'Visibility)
-> Ord E'Visibility
E'Visibility -> E'Visibility -> Bool
E'Visibility -> E'Visibility -> Ordering
E'Visibility -> E'Visibility -> E'Visibility
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
$ccompare :: E'Visibility -> E'Visibility -> Ordering
compare :: E'Visibility -> E'Visibility -> Ordering
$c< :: E'Visibility -> E'Visibility -> Bool
< :: E'Visibility -> E'Visibility -> Bool
$c<= :: E'Visibility -> E'Visibility -> Bool
<= :: E'Visibility -> E'Visibility -> Bool
$c> :: E'Visibility -> E'Visibility -> Bool
> :: E'Visibility -> E'Visibility -> Bool
$c>= :: E'Visibility -> E'Visibility -> Bool
>= :: E'Visibility -> E'Visibility -> Bool
$cmax :: E'Visibility -> E'Visibility -> E'Visibility
max :: E'Visibility -> E'Visibility -> E'Visibility
$cmin :: E'Visibility -> E'Visibility -> E'Visibility
min :: E'Visibility -> E'Visibility -> E'Visibility
P.Ord, E'Visibility
E'Visibility -> E'Visibility -> Bounded E'Visibility
forall a. a -> a -> Bounded a
$cminBound :: E'Visibility
minBound :: E'Visibility
$cmaxBound :: E'Visibility
maxBound :: E'Visibility
P.Bounded, Int -> E'Visibility
E'Visibility -> Int
E'Visibility -> [E'Visibility]
E'Visibility -> E'Visibility
E'Visibility -> E'Visibility -> [E'Visibility]
E'Visibility -> E'Visibility -> E'Visibility -> [E'Visibility]
(E'Visibility -> E'Visibility)
-> (E'Visibility -> E'Visibility)
-> (Int -> E'Visibility)
-> (E'Visibility -> Int)
-> (E'Visibility -> [E'Visibility])
-> (E'Visibility -> E'Visibility -> [E'Visibility])
-> (E'Visibility -> E'Visibility -> [E'Visibility])
-> (E'Visibility -> E'Visibility -> E'Visibility -> [E'Visibility])
-> Enum E'Visibility
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: E'Visibility -> E'Visibility
succ :: E'Visibility -> E'Visibility
$cpred :: E'Visibility -> E'Visibility
pred :: E'Visibility -> E'Visibility
$ctoEnum :: Int -> E'Visibility
toEnum :: Int -> E'Visibility
$cfromEnum :: E'Visibility -> Int
fromEnum :: E'Visibility -> Int
$cenumFrom :: E'Visibility -> [E'Visibility]
enumFrom :: E'Visibility -> [E'Visibility]
$cenumFromThen :: E'Visibility -> E'Visibility -> [E'Visibility]
enumFromThen :: E'Visibility -> E'Visibility -> [E'Visibility]
$cenumFromTo :: E'Visibility -> E'Visibility -> [E'Visibility]
enumFromTo :: E'Visibility -> E'Visibility -> [E'Visibility]
$cenumFromThenTo :: E'Visibility -> E'Visibility -> E'Visibility -> [E'Visibility]
enumFromThenTo :: E'Visibility -> E'Visibility -> E'Visibility -> [E'Visibility]
P.Enum)

instance A.ToJSON E'Visibility where toJSON :: E'Visibility -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value) -> (E'Visibility -> Text) -> E'Visibility -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Visibility -> Text
fromE'Visibility
instance A.FromJSON E'Visibility where parseJSON :: Value -> Parser E'Visibility
parseJSON Value
o = ([Char] -> Parser E'Visibility)
-> (E'Visibility -> Parser E'Visibility)
-> Either [Char] E'Visibility
-> Parser E'Visibility
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either [Char] -> Parser E'Visibility
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
P.fail (E'Visibility -> Parser E'Visibility
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E'Visibility -> Parser E'Visibility)
-> (E'Visibility -> E'Visibility)
-> E'Visibility
-> Parser E'Visibility
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Visibility -> E'Visibility
forall a. a -> a
P.id) (Either [Char] E'Visibility -> Parser E'Visibility)
-> (Text -> Either [Char] E'Visibility)
-> Text
-> Parser E'Visibility
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Visibility
toE'Visibility (Text -> Parser E'Visibility) -> Parser Text -> Parser E'Visibility
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData E'Visibility where toQueryParam :: E'Visibility -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text) -> (E'Visibility -> Text) -> E'Visibility -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Visibility -> Text
fromE'Visibility
instance WH.FromHttpApiData E'Visibility where parseQueryParam :: Text -> Either Text E'Visibility
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text E'Visibility) -> Either Text E'Visibility
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> Text)
-> Either [Char] E'Visibility -> Either Text E'Visibility
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left [Char] -> Text
T.pack (Either [Char] E'Visibility -> Either Text E'Visibility)
-> (Text -> Either [Char] E'Visibility)
-> Text
-> Either Text E'Visibility
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Visibility
toE'Visibility
instance MimeRender MimeMultipartFormData E'Visibility where mimeRender :: Proxy MimeMultipartFormData -> E'Visibility -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = E'Visibility -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'E'Visibility' enum
fromE'Visibility :: E'Visibility -> Text
fromE'Visibility :: E'Visibility -> Text
fromE'Visibility = \case
  E'Visibility
E'Visibility'Public -> Text
"public"
  E'Visibility
E'Visibility'Limited -> Text
"limited"
  E'Visibility
E'Visibility'Private -> Text
"private"

-- | parse 'E'Visibility' enum
toE'Visibility :: Text -> P.Either String E'Visibility
toE'Visibility :: Text -> Either [Char] E'Visibility
toE'Visibility = \case
  Text
"public" -> E'Visibility -> Either [Char] E'Visibility
forall a b. b -> Either a b
P.Right E'Visibility
E'Visibility'Public
  Text
"limited" -> E'Visibility -> Either [Char] E'Visibility
forall a b. b -> Either a b
P.Right E'Visibility
E'Visibility'Limited
  Text
"private" -> E'Visibility -> Either [Char] E'Visibility
forall a b. b -> Either a b
P.Right E'Visibility
E'Visibility'Private
  Text
s -> [Char] -> Either [Char] E'Visibility
forall a b. a -> Either a b
P.Left ([Char] -> Either [Char] E'Visibility)
-> [Char] -> Either [Char] E'Visibility
forall a b. (a -> b) -> a -> b
$ [Char]
"toE'Visibility: enum parse failure: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> [Char]
forall a. Show a => a -> [Char]
P.show Text
s


-- ** E'Whitespace

-- | Enum of 'Text'
data E'Whitespace
  = E'Whitespace'Ignore_all -- ^ @"ignore-all"@
  | E'Whitespace'Ignore_change -- ^ @"ignore-change"@
  | E'Whitespace'Ignore_eol -- ^ @"ignore-eol"@
  | E'Whitespace'Show_all -- ^ @"show-all"@
  deriving (Int -> E'Whitespace -> ShowS
[E'Whitespace] -> ShowS
E'Whitespace -> [Char]
(Int -> E'Whitespace -> ShowS)
-> (E'Whitespace -> [Char])
-> ([E'Whitespace] -> ShowS)
-> Show E'Whitespace
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> E'Whitespace -> ShowS
showsPrec :: Int -> E'Whitespace -> ShowS
$cshow :: E'Whitespace -> [Char]
show :: E'Whitespace -> [Char]
$cshowList :: [E'Whitespace] -> ShowS
showList :: [E'Whitespace] -> ShowS
P.Show, E'Whitespace -> E'Whitespace -> Bool
(E'Whitespace -> E'Whitespace -> Bool)
-> (E'Whitespace -> E'Whitespace -> Bool) -> Eq E'Whitespace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: E'Whitespace -> E'Whitespace -> Bool
== :: E'Whitespace -> E'Whitespace -> Bool
$c/= :: E'Whitespace -> E'Whitespace -> Bool
/= :: E'Whitespace -> E'Whitespace -> Bool
P.Eq, P.Typeable, Eq E'Whitespace
Eq E'Whitespace =>
(E'Whitespace -> E'Whitespace -> Ordering)
-> (E'Whitespace -> E'Whitespace -> Bool)
-> (E'Whitespace -> E'Whitespace -> Bool)
-> (E'Whitespace -> E'Whitespace -> Bool)
-> (E'Whitespace -> E'Whitespace -> Bool)
-> (E'Whitespace -> E'Whitespace -> E'Whitespace)
-> (E'Whitespace -> E'Whitespace -> E'Whitespace)
-> Ord E'Whitespace
E'Whitespace -> E'Whitespace -> Bool
E'Whitespace -> E'Whitespace -> Ordering
E'Whitespace -> E'Whitespace -> E'Whitespace
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
$ccompare :: E'Whitespace -> E'Whitespace -> Ordering
compare :: E'Whitespace -> E'Whitespace -> Ordering
$c< :: E'Whitespace -> E'Whitespace -> Bool
< :: E'Whitespace -> E'Whitespace -> Bool
$c<= :: E'Whitespace -> E'Whitespace -> Bool
<= :: E'Whitespace -> E'Whitespace -> Bool
$c> :: E'Whitespace -> E'Whitespace -> Bool
> :: E'Whitespace -> E'Whitespace -> Bool
$c>= :: E'Whitespace -> E'Whitespace -> Bool
>= :: E'Whitespace -> E'Whitespace -> Bool
$cmax :: E'Whitespace -> E'Whitespace -> E'Whitespace
max :: E'Whitespace -> E'Whitespace -> E'Whitespace
$cmin :: E'Whitespace -> E'Whitespace -> E'Whitespace
min :: E'Whitespace -> E'Whitespace -> E'Whitespace
P.Ord, E'Whitespace
E'Whitespace -> E'Whitespace -> Bounded E'Whitespace
forall a. a -> a -> Bounded a
$cminBound :: E'Whitespace
minBound :: E'Whitespace
$cmaxBound :: E'Whitespace
maxBound :: E'Whitespace
P.Bounded, Int -> E'Whitespace
E'Whitespace -> Int
E'Whitespace -> [E'Whitespace]
E'Whitespace -> E'Whitespace
E'Whitespace -> E'Whitespace -> [E'Whitespace]
E'Whitespace -> E'Whitespace -> E'Whitespace -> [E'Whitespace]
(E'Whitespace -> E'Whitespace)
-> (E'Whitespace -> E'Whitespace)
-> (Int -> E'Whitespace)
-> (E'Whitespace -> Int)
-> (E'Whitespace -> [E'Whitespace])
-> (E'Whitespace -> E'Whitespace -> [E'Whitespace])
-> (E'Whitespace -> E'Whitespace -> [E'Whitespace])
-> (E'Whitespace -> E'Whitespace -> E'Whitespace -> [E'Whitespace])
-> Enum E'Whitespace
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: E'Whitespace -> E'Whitespace
succ :: E'Whitespace -> E'Whitespace
$cpred :: E'Whitespace -> E'Whitespace
pred :: E'Whitespace -> E'Whitespace
$ctoEnum :: Int -> E'Whitespace
toEnum :: Int -> E'Whitespace
$cfromEnum :: E'Whitespace -> Int
fromEnum :: E'Whitespace -> Int
$cenumFrom :: E'Whitespace -> [E'Whitespace]
enumFrom :: E'Whitespace -> [E'Whitespace]
$cenumFromThen :: E'Whitespace -> E'Whitespace -> [E'Whitespace]
enumFromThen :: E'Whitespace -> E'Whitespace -> [E'Whitespace]
$cenumFromTo :: E'Whitespace -> E'Whitespace -> [E'Whitespace]
enumFromTo :: E'Whitespace -> E'Whitespace -> [E'Whitespace]
$cenumFromThenTo :: E'Whitespace -> E'Whitespace -> E'Whitespace -> [E'Whitespace]
enumFromThenTo :: E'Whitespace -> E'Whitespace -> E'Whitespace -> [E'Whitespace]
P.Enum)

instance A.ToJSON E'Whitespace where toJSON :: E'Whitespace -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Text -> Value) -> (E'Whitespace -> Text) -> E'Whitespace -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Whitespace -> Text
fromE'Whitespace
instance A.FromJSON E'Whitespace where parseJSON :: Value -> Parser E'Whitespace
parseJSON Value
o = ([Char] -> Parser E'Whitespace)
-> (E'Whitespace -> Parser E'Whitespace)
-> Either [Char] E'Whitespace
-> Parser E'Whitespace
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either [Char] -> Parser E'Whitespace
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
P.fail (E'Whitespace -> Parser E'Whitespace
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (E'Whitespace -> Parser E'Whitespace)
-> (E'Whitespace -> E'Whitespace)
-> E'Whitespace
-> Parser E'Whitespace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Whitespace -> E'Whitespace
forall a. a -> a
P.id) (Either [Char] E'Whitespace -> Parser E'Whitespace)
-> (Text -> Either [Char] E'Whitespace)
-> Text
-> Parser E'Whitespace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Whitespace
toE'Whitespace (Text -> Parser E'Whitespace) -> Parser Text -> Parser E'Whitespace
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData E'Whitespace where toQueryParam :: E'Whitespace -> Text
toQueryParam = Text -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam (Text -> Text) -> (E'Whitespace -> Text) -> E'Whitespace -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Whitespace -> Text
fromE'Whitespace
instance WH.FromHttpApiData E'Whitespace where parseQueryParam :: Text -> Either Text E'Whitespace
parseQueryParam Text
o = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o Either Text Text
-> (Text -> Either Text E'Whitespace) -> Either Text E'Whitespace
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([Char] -> Text)
-> Either [Char] E'Whitespace -> Either Text E'Whitespace
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left [Char] -> Text
T.pack (Either [Char] E'Whitespace -> Either Text E'Whitespace)
-> (Text -> Either [Char] E'Whitespace)
-> Text
-> Either Text E'Whitespace
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Whitespace
toE'Whitespace
instance MimeRender MimeMultipartFormData E'Whitespace where mimeRender :: Proxy MimeMultipartFormData -> E'Whitespace -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = E'Whitespace -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'E'Whitespace' enum
fromE'Whitespace :: E'Whitespace -> Text
fromE'Whitespace :: E'Whitespace -> Text
fromE'Whitespace = \case
  E'Whitespace
E'Whitespace'Ignore_all -> Text
"ignore-all"
  E'Whitespace
E'Whitespace'Ignore_change -> Text
"ignore-change"
  E'Whitespace
E'Whitespace'Ignore_eol -> Text
"ignore-eol"
  E'Whitespace
E'Whitespace'Show_all -> Text
"show-all"

-- | parse 'E'Whitespace' enum
toE'Whitespace :: Text -> P.Either String E'Whitespace
toE'Whitespace :: Text -> Either [Char] E'Whitespace
toE'Whitespace = \case
  Text
"ignore-all" -> E'Whitespace -> Either [Char] E'Whitespace
forall a b. b -> Either a b
P.Right E'Whitespace
E'Whitespace'Ignore_all
  Text
"ignore-change" -> E'Whitespace -> Either [Char] E'Whitespace
forall a b. b -> Either a b
P.Right E'Whitespace
E'Whitespace'Ignore_change
  Text
"ignore-eol" -> E'Whitespace -> Either [Char] E'Whitespace
forall a b. b -> Either a b
P.Right E'Whitespace
E'Whitespace'Ignore_eol
  Text
"show-all" -> E'Whitespace -> Either [Char] E'Whitespace
forall a b. b -> Either a b
P.Right E'Whitespace
E'Whitespace'Show_all
  Text
s -> [Char] -> Either [Char] E'Whitespace
forall a b. a -> Either a b
P.Left ([Char] -> Either [Char] E'Whitespace)
-> [Char] -> Either [Char] E'Whitespace
forall a b. (a -> b) -> a -> b
$ [Char]
"toE'Whitespace: enum parse failure: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
P.++ Text -> [Char]
forall a. Show a => a -> [Char]
P.show Text
s


-- * Auth Methods

-- ** AuthApiKeyAccessToken
data AuthApiKeyAccessToken =
  AuthApiKeyAccessToken Text -- ^ secret
  deriving (AuthApiKeyAccessToken -> AuthApiKeyAccessToken -> Bool
(AuthApiKeyAccessToken -> AuthApiKeyAccessToken -> Bool)
-> (AuthApiKeyAccessToken -> AuthApiKeyAccessToken -> Bool)
-> Eq AuthApiKeyAccessToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthApiKeyAccessToken -> AuthApiKeyAccessToken -> Bool
== :: AuthApiKeyAccessToken -> AuthApiKeyAccessToken -> Bool
$c/= :: AuthApiKeyAccessToken -> AuthApiKeyAccessToken -> Bool
/= :: AuthApiKeyAccessToken -> AuthApiKeyAccessToken -> Bool
P.Eq, Int -> AuthApiKeyAccessToken -> ShowS
[AuthApiKeyAccessToken] -> ShowS
AuthApiKeyAccessToken -> [Char]
(Int -> AuthApiKeyAccessToken -> ShowS)
-> (AuthApiKeyAccessToken -> [Char])
-> ([AuthApiKeyAccessToken] -> ShowS)
-> Show AuthApiKeyAccessToken
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthApiKeyAccessToken -> ShowS
showsPrec :: Int -> AuthApiKeyAccessToken -> ShowS
$cshow :: AuthApiKeyAccessToken -> [Char]
show :: AuthApiKeyAccessToken -> [Char]
$cshowList :: [AuthApiKeyAccessToken] -> ShowS
showList :: [AuthApiKeyAccessToken] -> ShowS
P.Show, P.Typeable)

instance AuthMethod AuthApiKeyAccessToken where
  applyAuthMethod :: forall req contentType res accept.
GiteaConfig
-> AuthApiKeyAccessToken
-> GiteaRequest req contentType res accept
-> IO (GiteaRequest req contentType res accept)
applyAuthMethod GiteaConfig
_ a :: AuthApiKeyAccessToken
a@(AuthApiKeyAccessToken Text
secret) GiteaRequest req contentType res accept
req =
    GiteaRequest req contentType res accept
-> IO (GiteaRequest req contentType res accept)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
P.pure (GiteaRequest req contentType res accept
 -> IO (GiteaRequest req contentType res accept))
-> GiteaRequest req contentType res accept
-> IO (GiteaRequest req contentType res accept)
forall a b. (a -> b) -> a -> b
$
    if (AuthApiKeyAccessToken -> TypeRep
forall a. Typeable a => a -> TypeRep
P.typeOf AuthApiKeyAccessToken
a TypeRep -> [TypeRep] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`P.elem` GiteaRequest req contentType res accept -> [TypeRep]
forall req contentType res accept.
GiteaRequest req contentType res accept -> [TypeRep]
rAuthTypes GiteaRequest req contentType res accept
req)
      then GiteaRequest req contentType res accept
req GiteaRequest req contentType res accept
-> [QueryItem] -> GiteaRequest req contentType res accept
forall req contentType res accept.
GiteaRequest req contentType res accept
-> [QueryItem] -> GiteaRequest req contentType res accept
`setQuery` (ByteString, Maybe Text) -> [QueryItem]
forall a. ToHttpApiData a => (ByteString, Maybe a) -> [QueryItem]
toQuery (ByteString
"access_token", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
secret)
           GiteaRequest req contentType res accept
-> (GiteaRequest req contentType res accept
    -> GiteaRequest req contentType res accept)
-> GiteaRequest req contentType res accept
forall a b. a -> (a -> b) -> b
& ASetter
  (GiteaRequest req contentType res accept)
  (GiteaRequest req contentType res accept)
  [TypeRep]
  [TypeRep]
-> ([TypeRep] -> [TypeRep])
-> GiteaRequest req contentType res accept
-> GiteaRequest req contentType res accept
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over ASetter
  (GiteaRequest req contentType res accept)
  (GiteaRequest req contentType res accept)
  [TypeRep]
  [TypeRep]
forall req contentType res accept (f :: * -> *).
Functor f =>
([TypeRep] -> f [TypeRep])
-> GiteaRequest req contentType res accept
-> f (GiteaRequest req contentType res accept)
rAuthTypesL ((TypeRep -> Bool) -> [TypeRep] -> [TypeRep]
forall a. (a -> Bool) -> [a] -> [a]
P.filter (TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
/= AuthApiKeyAccessToken -> TypeRep
forall a. Typeable a => a -> TypeRep
P.typeOf AuthApiKeyAccessToken
a))
      else GiteaRequest req contentType res accept
req

-- ** AuthApiKeyAuthorizationHeaderToken
data AuthApiKeyAuthorizationHeaderToken =
  AuthApiKeyAuthorizationHeaderToken Text -- ^ secret
  deriving (AuthApiKeyAuthorizationHeaderToken
-> AuthApiKeyAuthorizationHeaderToken -> Bool
(AuthApiKeyAuthorizationHeaderToken
 -> AuthApiKeyAuthorizationHeaderToken -> Bool)
-> (AuthApiKeyAuthorizationHeaderToken
    -> AuthApiKeyAuthorizationHeaderToken -> Bool)
-> Eq AuthApiKeyAuthorizationHeaderToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthApiKeyAuthorizationHeaderToken
-> AuthApiKeyAuthorizationHeaderToken -> Bool
== :: AuthApiKeyAuthorizationHeaderToken
-> AuthApiKeyAuthorizationHeaderToken -> Bool
$c/= :: AuthApiKeyAuthorizationHeaderToken
-> AuthApiKeyAuthorizationHeaderToken -> Bool
/= :: AuthApiKeyAuthorizationHeaderToken
-> AuthApiKeyAuthorizationHeaderToken -> Bool
P.Eq, Int -> AuthApiKeyAuthorizationHeaderToken -> ShowS
[AuthApiKeyAuthorizationHeaderToken] -> ShowS
AuthApiKeyAuthorizationHeaderToken -> [Char]
(Int -> AuthApiKeyAuthorizationHeaderToken -> ShowS)
-> (AuthApiKeyAuthorizationHeaderToken -> [Char])
-> ([AuthApiKeyAuthorizationHeaderToken] -> ShowS)
-> Show AuthApiKeyAuthorizationHeaderToken
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthApiKeyAuthorizationHeaderToken -> ShowS
showsPrec :: Int -> AuthApiKeyAuthorizationHeaderToken -> ShowS
$cshow :: AuthApiKeyAuthorizationHeaderToken -> [Char]
show :: AuthApiKeyAuthorizationHeaderToken -> [Char]
$cshowList :: [AuthApiKeyAuthorizationHeaderToken] -> ShowS
showList :: [AuthApiKeyAuthorizationHeaderToken] -> ShowS
P.Show, P.Typeable)

instance AuthMethod AuthApiKeyAuthorizationHeaderToken where
  applyAuthMethod :: forall req contentType res accept.
GiteaConfig
-> AuthApiKeyAuthorizationHeaderToken
-> GiteaRequest req contentType res accept
-> IO (GiteaRequest req contentType res accept)
applyAuthMethod GiteaConfig
_ a :: AuthApiKeyAuthorizationHeaderToken
a@(AuthApiKeyAuthorizationHeaderToken Text
secret) GiteaRequest req contentType res accept
req =
    GiteaRequest req contentType res accept
-> IO (GiteaRequest req contentType res accept)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
P.pure (GiteaRequest req contentType res accept
 -> IO (GiteaRequest req contentType res accept))
-> GiteaRequest req contentType res accept
-> IO (GiteaRequest req contentType res accept)
forall a b. (a -> b) -> a -> b
$
    if (AuthApiKeyAuthorizationHeaderToken -> TypeRep
forall a. Typeable a => a -> TypeRep
P.typeOf AuthApiKeyAuthorizationHeaderToken
a TypeRep -> [TypeRep] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`P.elem` GiteaRequest req contentType res accept -> [TypeRep]
forall req contentType res accept.
GiteaRequest req contentType res accept -> [TypeRep]
rAuthTypes GiteaRequest req contentType res accept
req)
      then GiteaRequest req contentType res accept
req GiteaRequest req contentType res accept
-> [Header] -> GiteaRequest req contentType res accept
forall req contentType res accept.
GiteaRequest req contentType res accept
-> [Header] -> GiteaRequest req contentType res accept
`setHeader` (HeaderName, Text) -> [Header]
forall a. ToHttpApiData a => (HeaderName, a) -> [Header]
toHeader (HeaderName
"Authorization", Text
secret)
           GiteaRequest req contentType res accept
-> (GiteaRequest req contentType res accept
    -> GiteaRequest req contentType res accept)
-> GiteaRequest req contentType res accept
forall a b. a -> (a -> b) -> b
& ASetter
  (GiteaRequest req contentType res accept)
  (GiteaRequest req contentType res accept)
  [TypeRep]
  [TypeRep]
-> ([TypeRep] -> [TypeRep])
-> GiteaRequest req contentType res accept
-> GiteaRequest req contentType res accept
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over ASetter
  (GiteaRequest req contentType res accept)
  (GiteaRequest req contentType res accept)
  [TypeRep]
  [TypeRep]
forall req contentType res accept (f :: * -> *).
Functor f =>
([TypeRep] -> f [TypeRep])
-> GiteaRequest req contentType res accept
-> f (GiteaRequest req contentType res accept)
rAuthTypesL ((TypeRep -> Bool) -> [TypeRep] -> [TypeRep]
forall a. (a -> Bool) -> [a] -> [a]
P.filter (TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
/= AuthApiKeyAuthorizationHeaderToken -> TypeRep
forall a. Typeable a => a -> TypeRep
P.typeOf AuthApiKeyAuthorizationHeaderToken
a))
      else GiteaRequest req contentType res accept
req

-- ** AuthBasicBasicAuth
data AuthBasicBasicAuth =
  AuthBasicBasicAuth B.ByteString B.ByteString -- ^ username password
  deriving (AuthBasicBasicAuth -> AuthBasicBasicAuth -> Bool
(AuthBasicBasicAuth -> AuthBasicBasicAuth -> Bool)
-> (AuthBasicBasicAuth -> AuthBasicBasicAuth -> Bool)
-> Eq AuthBasicBasicAuth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthBasicBasicAuth -> AuthBasicBasicAuth -> Bool
== :: AuthBasicBasicAuth -> AuthBasicBasicAuth -> Bool
$c/= :: AuthBasicBasicAuth -> AuthBasicBasicAuth -> Bool
/= :: AuthBasicBasicAuth -> AuthBasicBasicAuth -> Bool
P.Eq, Int -> AuthBasicBasicAuth -> ShowS
[AuthBasicBasicAuth] -> ShowS
AuthBasicBasicAuth -> [Char]
(Int -> AuthBasicBasicAuth -> ShowS)
-> (AuthBasicBasicAuth -> [Char])
-> ([AuthBasicBasicAuth] -> ShowS)
-> Show AuthBasicBasicAuth
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthBasicBasicAuth -> ShowS
showsPrec :: Int -> AuthBasicBasicAuth -> ShowS
$cshow :: AuthBasicBasicAuth -> [Char]
show :: AuthBasicBasicAuth -> [Char]
$cshowList :: [AuthBasicBasicAuth] -> ShowS
showList :: [AuthBasicBasicAuth] -> ShowS
P.Show, P.Typeable)

instance AuthMethod AuthBasicBasicAuth where
  applyAuthMethod :: forall req contentType res accept.
GiteaConfig
-> AuthBasicBasicAuth
-> GiteaRequest req contentType res accept
-> IO (GiteaRequest req contentType res accept)
applyAuthMethod GiteaConfig
_ a :: AuthBasicBasicAuth
a@(AuthBasicBasicAuth ByteString
user ByteString
pw) GiteaRequest req contentType res accept
req =
    GiteaRequest req contentType res accept
-> IO (GiteaRequest req contentType res accept)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
P.pure (GiteaRequest req contentType res accept
 -> IO (GiteaRequest req contentType res accept))
-> GiteaRequest req contentType res accept
-> IO (GiteaRequest req contentType res accept)
forall a b. (a -> b) -> a -> b
$
    if (AuthBasicBasicAuth -> TypeRep
forall a. Typeable a => a -> TypeRep
P.typeOf AuthBasicBasicAuth
a TypeRep -> [TypeRep] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`P.elem` GiteaRequest req contentType res accept -> [TypeRep]
forall req contentType res accept.
GiteaRequest req contentType res accept -> [TypeRep]
rAuthTypes GiteaRequest req contentType res accept
req)
      then GiteaRequest req contentType res accept
req GiteaRequest req contentType res accept
-> [Header] -> GiteaRequest req contentType res accept
forall req contentType res accept.
GiteaRequest req contentType res accept
-> [Header] -> GiteaRequest req contentType res accept
`setHeader` (HeaderName, Text) -> [Header]
forall a. ToHttpApiData a => (HeaderName, a) -> [Header]
toHeader (HeaderName
"Authorization", ByteString -> Text
T.decodeUtf8 ByteString
cred)
           GiteaRequest req contentType res accept
-> (GiteaRequest req contentType res accept
    -> GiteaRequest req contentType res accept)
-> GiteaRequest req contentType res accept
forall a b. a -> (a -> b) -> b
& ASetter
  (GiteaRequest req contentType res accept)
  (GiteaRequest req contentType res accept)
  [TypeRep]
  [TypeRep]
-> ([TypeRep] -> [TypeRep])
-> GiteaRequest req contentType res accept
-> GiteaRequest req contentType res accept
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over ASetter
  (GiteaRequest req contentType res accept)
  (GiteaRequest req contentType res accept)
  [TypeRep]
  [TypeRep]
forall req contentType res accept (f :: * -> *).
Functor f =>
([TypeRep] -> f [TypeRep])
-> GiteaRequest req contentType res accept
-> f (GiteaRequest req contentType res accept)
rAuthTypesL ((TypeRep -> Bool) -> [TypeRep] -> [TypeRep]
forall a. (a -> Bool) -> [a] -> [a]
P.filter (TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
/= AuthBasicBasicAuth -> TypeRep
forall a. Typeable a => a -> TypeRep
P.typeOf AuthBasicBasicAuth
a))
      else GiteaRequest req contentType res accept
req
    where cred :: ByteString
cred = ByteString -> ByteString -> ByteString
BC.append ByteString
"Basic " (ByteString -> ByteString
B64.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BC.concat [ ByteString
user, ByteString
":", ByteString
pw ])

-- ** AuthApiKeySudoHeader
data AuthApiKeySudoHeader =
  AuthApiKeySudoHeader Text -- ^ secret
  deriving (AuthApiKeySudoHeader -> AuthApiKeySudoHeader -> Bool
(AuthApiKeySudoHeader -> AuthApiKeySudoHeader -> Bool)
-> (AuthApiKeySudoHeader -> AuthApiKeySudoHeader -> Bool)
-> Eq AuthApiKeySudoHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthApiKeySudoHeader -> AuthApiKeySudoHeader -> Bool
== :: AuthApiKeySudoHeader -> AuthApiKeySudoHeader -> Bool
$c/= :: AuthApiKeySudoHeader -> AuthApiKeySudoHeader -> Bool
/= :: AuthApiKeySudoHeader -> AuthApiKeySudoHeader -> Bool
P.Eq, Int -> AuthApiKeySudoHeader -> ShowS
[AuthApiKeySudoHeader] -> ShowS
AuthApiKeySudoHeader -> [Char]
(Int -> AuthApiKeySudoHeader -> ShowS)
-> (AuthApiKeySudoHeader -> [Char])
-> ([AuthApiKeySudoHeader] -> ShowS)
-> Show AuthApiKeySudoHeader
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthApiKeySudoHeader -> ShowS
showsPrec :: Int -> AuthApiKeySudoHeader -> ShowS
$cshow :: AuthApiKeySudoHeader -> [Char]
show :: AuthApiKeySudoHeader -> [Char]
$cshowList :: [AuthApiKeySudoHeader] -> ShowS
showList :: [AuthApiKeySudoHeader] -> ShowS
P.Show, P.Typeable)

instance AuthMethod AuthApiKeySudoHeader where
  applyAuthMethod :: forall req contentType res accept.
GiteaConfig
-> AuthApiKeySudoHeader
-> GiteaRequest req contentType res accept
-> IO (GiteaRequest req contentType res accept)
applyAuthMethod GiteaConfig
_ a :: AuthApiKeySudoHeader
a@(AuthApiKeySudoHeader Text
secret) GiteaRequest req contentType res accept
req =
    GiteaRequest req contentType res accept
-> IO (GiteaRequest req contentType res accept)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
P.pure (GiteaRequest req contentType res accept
 -> IO (GiteaRequest req contentType res accept))
-> GiteaRequest req contentType res accept
-> IO (GiteaRequest req contentType res accept)
forall a b. (a -> b) -> a -> b
$
    if (AuthApiKeySudoHeader -> TypeRep
forall a. Typeable a => a -> TypeRep
P.typeOf AuthApiKeySudoHeader
a TypeRep -> [TypeRep] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`P.elem` GiteaRequest req contentType res accept -> [TypeRep]
forall req contentType res accept.
GiteaRequest req contentType res accept -> [TypeRep]
rAuthTypes GiteaRequest req contentType res accept
req)
      then GiteaRequest req contentType res accept
req GiteaRequest req contentType res accept
-> [Header] -> GiteaRequest req contentType res accept
forall req contentType res accept.
GiteaRequest req contentType res accept
-> [Header] -> GiteaRequest req contentType res accept
`setHeader` (HeaderName, Text) -> [Header]
forall a. ToHttpApiData a => (HeaderName, a) -> [Header]
toHeader (HeaderName
"Sudo", Text
secret)
           GiteaRequest req contentType res accept
-> (GiteaRequest req contentType res accept
    -> GiteaRequest req contentType res accept)
-> GiteaRequest req contentType res accept
forall a b. a -> (a -> b) -> b
& ASetter
  (GiteaRequest req contentType res accept)
  (GiteaRequest req contentType res accept)
  [TypeRep]
  [TypeRep]
-> ([TypeRep] -> [TypeRep])
-> GiteaRequest req contentType res accept
-> GiteaRequest req contentType res accept
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over ASetter
  (GiteaRequest req contentType res accept)
  (GiteaRequest req contentType res accept)
  [TypeRep]
  [TypeRep]
forall req contentType res accept (f :: * -> *).
Functor f =>
([TypeRep] -> f [TypeRep])
-> GiteaRequest req contentType res accept
-> f (GiteaRequest req contentType res accept)
rAuthTypesL ((TypeRep -> Bool) -> [TypeRep] -> [TypeRep]
forall a. (a -> Bool) -> [a] -> [a]
P.filter (TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
/= AuthApiKeySudoHeader -> TypeRep
forall a. Typeable a => a -> TypeRep
P.typeOf AuthApiKeySudoHeader
a))
      else GiteaRequest req contentType res accept
req

-- ** AuthApiKeySudoParam
data AuthApiKeySudoParam =
  AuthApiKeySudoParam Text -- ^ secret
  deriving (AuthApiKeySudoParam -> AuthApiKeySudoParam -> Bool
(AuthApiKeySudoParam -> AuthApiKeySudoParam -> Bool)
-> (AuthApiKeySudoParam -> AuthApiKeySudoParam -> Bool)
-> Eq AuthApiKeySudoParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthApiKeySudoParam -> AuthApiKeySudoParam -> Bool
== :: AuthApiKeySudoParam -> AuthApiKeySudoParam -> Bool
$c/= :: AuthApiKeySudoParam -> AuthApiKeySudoParam -> Bool
/= :: AuthApiKeySudoParam -> AuthApiKeySudoParam -> Bool
P.Eq, Int -> AuthApiKeySudoParam -> ShowS
[AuthApiKeySudoParam] -> ShowS
AuthApiKeySudoParam -> [Char]
(Int -> AuthApiKeySudoParam -> ShowS)
-> (AuthApiKeySudoParam -> [Char])
-> ([AuthApiKeySudoParam] -> ShowS)
-> Show AuthApiKeySudoParam
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthApiKeySudoParam -> ShowS
showsPrec :: Int -> AuthApiKeySudoParam -> ShowS
$cshow :: AuthApiKeySudoParam -> [Char]
show :: AuthApiKeySudoParam -> [Char]
$cshowList :: [AuthApiKeySudoParam] -> ShowS
showList :: [AuthApiKeySudoParam] -> ShowS
P.Show, P.Typeable)

instance AuthMethod AuthApiKeySudoParam where
  applyAuthMethod :: forall req contentType res accept.
GiteaConfig
-> AuthApiKeySudoParam
-> GiteaRequest req contentType res accept
-> IO (GiteaRequest req contentType res accept)
applyAuthMethod GiteaConfig
_ a :: AuthApiKeySudoParam
a@(AuthApiKeySudoParam Text
secret) GiteaRequest req contentType res accept
req =
    GiteaRequest req contentType res accept
-> IO (GiteaRequest req contentType res accept)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
P.pure (GiteaRequest req contentType res accept
 -> IO (GiteaRequest req contentType res accept))
-> GiteaRequest req contentType res accept
-> IO (GiteaRequest req contentType res accept)
forall a b. (a -> b) -> a -> b
$
    if (AuthApiKeySudoParam -> TypeRep
forall a. Typeable a => a -> TypeRep
P.typeOf AuthApiKeySudoParam
a TypeRep -> [TypeRep] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`P.elem` GiteaRequest req contentType res accept -> [TypeRep]
forall req contentType res accept.
GiteaRequest req contentType res accept -> [TypeRep]
rAuthTypes GiteaRequest req contentType res accept
req)
      then GiteaRequest req contentType res accept
req GiteaRequest req contentType res accept
-> [QueryItem] -> GiteaRequest req contentType res accept
forall req contentType res accept.
GiteaRequest req contentType res accept
-> [QueryItem] -> GiteaRequest req contentType res accept
`setQuery` (ByteString, Maybe Text) -> [QueryItem]
forall a. ToHttpApiData a => (ByteString, Maybe a) -> [QueryItem]
toQuery (ByteString
"sudo", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
secret)
           GiteaRequest req contentType res accept
-> (GiteaRequest req contentType res accept
    -> GiteaRequest req contentType res accept)
-> GiteaRequest req contentType res accept
forall a b. a -> (a -> b) -> b
& ASetter
  (GiteaRequest req contentType res accept)
  (GiteaRequest req contentType res accept)
  [TypeRep]
  [TypeRep]
-> ([TypeRep] -> [TypeRep])
-> GiteaRequest req contentType res accept
-> GiteaRequest req contentType res accept
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over ASetter
  (GiteaRequest req contentType res accept)
  (GiteaRequest req contentType res accept)
  [TypeRep]
  [TypeRep]
forall req contentType res accept (f :: * -> *).
Functor f =>
([TypeRep] -> f [TypeRep])
-> GiteaRequest req contentType res accept
-> f (GiteaRequest req contentType res accept)
rAuthTypesL ((TypeRep -> Bool) -> [TypeRep] -> [TypeRep]
forall a. (a -> Bool) -> [a] -> [a]
P.filter (TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
/= AuthApiKeySudoParam -> TypeRep
forall a. Typeable a => a -> TypeRep
P.typeOf AuthApiKeySudoParam
a))
      else GiteaRequest req contentType res accept
req

-- ** AuthApiKeyTOTPHeader
data AuthApiKeyTOTPHeader =
  AuthApiKeyTOTPHeader Text -- ^ secret
  deriving (AuthApiKeyTOTPHeader -> AuthApiKeyTOTPHeader -> Bool
(AuthApiKeyTOTPHeader -> AuthApiKeyTOTPHeader -> Bool)
-> (AuthApiKeyTOTPHeader -> AuthApiKeyTOTPHeader -> Bool)
-> Eq AuthApiKeyTOTPHeader
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthApiKeyTOTPHeader -> AuthApiKeyTOTPHeader -> Bool
== :: AuthApiKeyTOTPHeader -> AuthApiKeyTOTPHeader -> Bool
$c/= :: AuthApiKeyTOTPHeader -> AuthApiKeyTOTPHeader -> Bool
/= :: AuthApiKeyTOTPHeader -> AuthApiKeyTOTPHeader -> Bool
P.Eq, Int -> AuthApiKeyTOTPHeader -> ShowS
[AuthApiKeyTOTPHeader] -> ShowS
AuthApiKeyTOTPHeader -> [Char]
(Int -> AuthApiKeyTOTPHeader -> ShowS)
-> (AuthApiKeyTOTPHeader -> [Char])
-> ([AuthApiKeyTOTPHeader] -> ShowS)
-> Show AuthApiKeyTOTPHeader
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthApiKeyTOTPHeader -> ShowS
showsPrec :: Int -> AuthApiKeyTOTPHeader -> ShowS
$cshow :: AuthApiKeyTOTPHeader -> [Char]
show :: AuthApiKeyTOTPHeader -> [Char]
$cshowList :: [AuthApiKeyTOTPHeader] -> ShowS
showList :: [AuthApiKeyTOTPHeader] -> ShowS
P.Show, P.Typeable)

instance AuthMethod AuthApiKeyTOTPHeader where
  applyAuthMethod :: forall req contentType res accept.
GiteaConfig
-> AuthApiKeyTOTPHeader
-> GiteaRequest req contentType res accept
-> IO (GiteaRequest req contentType res accept)
applyAuthMethod GiteaConfig
_ a :: AuthApiKeyTOTPHeader
a@(AuthApiKeyTOTPHeader Text
secret) GiteaRequest req contentType res accept
req =
    GiteaRequest req contentType res accept
-> IO (GiteaRequest req contentType res accept)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
P.pure (GiteaRequest req contentType res accept
 -> IO (GiteaRequest req contentType res accept))
-> GiteaRequest req contentType res accept
-> IO (GiteaRequest req contentType res accept)
forall a b. (a -> b) -> a -> b
$
    if (AuthApiKeyTOTPHeader -> TypeRep
forall a. Typeable a => a -> TypeRep
P.typeOf AuthApiKeyTOTPHeader
a TypeRep -> [TypeRep] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`P.elem` GiteaRequest req contentType res accept -> [TypeRep]
forall req contentType res accept.
GiteaRequest req contentType res accept -> [TypeRep]
rAuthTypes GiteaRequest req contentType res accept
req)
      then GiteaRequest req contentType res accept
req GiteaRequest req contentType res accept
-> [Header] -> GiteaRequest req contentType res accept
forall req contentType res accept.
GiteaRequest req contentType res accept
-> [Header] -> GiteaRequest req contentType res accept
`setHeader` (HeaderName, Text) -> [Header]
forall a. ToHttpApiData a => (HeaderName, a) -> [Header]
toHeader (HeaderName
"X-GITEA-OTP", Text
secret)
           GiteaRequest req contentType res accept
-> (GiteaRequest req contentType res accept
    -> GiteaRequest req contentType res accept)
-> GiteaRequest req contentType res accept
forall a b. a -> (a -> b) -> b
& ASetter
  (GiteaRequest req contentType res accept)
  (GiteaRequest req contentType res accept)
  [TypeRep]
  [TypeRep]
-> ([TypeRep] -> [TypeRep])
-> GiteaRequest req contentType res accept
-> GiteaRequest req contentType res accept
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over ASetter
  (GiteaRequest req contentType res accept)
  (GiteaRequest req contentType res accept)
  [TypeRep]
  [TypeRep]
forall req contentType res accept (f :: * -> *).
Functor f =>
([TypeRep] -> f [TypeRep])
-> GiteaRequest req contentType res accept
-> f (GiteaRequest req contentType res accept)
rAuthTypesL ((TypeRep -> Bool) -> [TypeRep] -> [TypeRep]
forall a. (a -> Bool) -> [a] -> [a]
P.filter (TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
/= AuthApiKeyTOTPHeader -> TypeRep
forall a. Typeable a => a -> TypeRep
P.typeOf AuthApiKeyTOTPHeader
a))
      else GiteaRequest req contentType res accept
req

-- ** AuthApiKeyToken
data AuthApiKeyToken =
  AuthApiKeyToken Text -- ^ secret
  deriving (AuthApiKeyToken -> AuthApiKeyToken -> Bool
(AuthApiKeyToken -> AuthApiKeyToken -> Bool)
-> (AuthApiKeyToken -> AuthApiKeyToken -> Bool)
-> Eq AuthApiKeyToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthApiKeyToken -> AuthApiKeyToken -> Bool
== :: AuthApiKeyToken -> AuthApiKeyToken -> Bool
$c/= :: AuthApiKeyToken -> AuthApiKeyToken -> Bool
/= :: AuthApiKeyToken -> AuthApiKeyToken -> Bool
P.Eq, Int -> AuthApiKeyToken -> ShowS
[AuthApiKeyToken] -> ShowS
AuthApiKeyToken -> [Char]
(Int -> AuthApiKeyToken -> ShowS)
-> (AuthApiKeyToken -> [Char])
-> ([AuthApiKeyToken] -> ShowS)
-> Show AuthApiKeyToken
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthApiKeyToken -> ShowS
showsPrec :: Int -> AuthApiKeyToken -> ShowS
$cshow :: AuthApiKeyToken -> [Char]
show :: AuthApiKeyToken -> [Char]
$cshowList :: [AuthApiKeyToken] -> ShowS
showList :: [AuthApiKeyToken] -> ShowS
P.Show, P.Typeable)

instance AuthMethod AuthApiKeyToken where
  applyAuthMethod :: forall req contentType res accept.
GiteaConfig
-> AuthApiKeyToken
-> GiteaRequest req contentType res accept
-> IO (GiteaRequest req contentType res accept)
applyAuthMethod GiteaConfig
_ a :: AuthApiKeyToken
a@(AuthApiKeyToken Text
secret) GiteaRequest req contentType res accept
req =
    GiteaRequest req contentType res accept
-> IO (GiteaRequest req contentType res accept)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
P.pure (GiteaRequest req contentType res accept
 -> IO (GiteaRequest req contentType res accept))
-> GiteaRequest req contentType res accept
-> IO (GiteaRequest req contentType res accept)
forall a b. (a -> b) -> a -> b
$
    if (AuthApiKeyToken -> TypeRep
forall a. Typeable a => a -> TypeRep
P.typeOf AuthApiKeyToken
a TypeRep -> [TypeRep] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`P.elem` GiteaRequest req contentType res accept -> [TypeRep]
forall req contentType res accept.
GiteaRequest req contentType res accept -> [TypeRep]
rAuthTypes GiteaRequest req contentType res accept
req)
      then GiteaRequest req contentType res accept
req GiteaRequest req contentType res accept
-> [QueryItem] -> GiteaRequest req contentType res accept
forall req contentType res accept.
GiteaRequest req contentType res accept
-> [QueryItem] -> GiteaRequest req contentType res accept
`setQuery` (ByteString, Maybe Text) -> [QueryItem]
forall a. ToHttpApiData a => (ByteString, Maybe a) -> [QueryItem]
toQuery (ByteString
"token", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
secret)
           GiteaRequest req contentType res accept
-> (GiteaRequest req contentType res accept
    -> GiteaRequest req contentType res accept)
-> GiteaRequest req contentType res accept
forall a b. a -> (a -> b) -> b
& ASetter
  (GiteaRequest req contentType res accept)
  (GiteaRequest req contentType res accept)
  [TypeRep]
  [TypeRep]
-> ([TypeRep] -> [TypeRep])
-> GiteaRequest req contentType res accept
-> GiteaRequest req contentType res accept
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
L.over ASetter
  (GiteaRequest req contentType res accept)
  (GiteaRequest req contentType res accept)
  [TypeRep]
  [TypeRep]
forall req contentType res accept (f :: * -> *).
Functor f =>
([TypeRep] -> f [TypeRep])
-> GiteaRequest req contentType res accept
-> f (GiteaRequest req contentType res accept)
rAuthTypesL ((TypeRep -> Bool) -> [TypeRep] -> [TypeRep]
forall a. (a -> Bool) -> [a] -> [a]
P.filter (TypeRep -> TypeRep -> Bool
forall a. Eq a => a -> a -> Bool
/= AuthApiKeyToken -> TypeRep
forall a. Typeable a => a -> TypeRep
P.typeOf AuthApiKeyToken
a))
      else GiteaRequest req contentType res accept
req