module GitHub.Data.Issues where

import GitHub.Data.Definitions
import GitHub.Data.Id           (Id)
import GitHub.Data.Milestone    (Milestone)
import GitHub.Data.Name         (Name)
import GitHub.Data.Options      (IssueState, IssueStateReason)
import GitHub.Data.PullRequests
import GitHub.Data.URL          (URL)
import GitHub.Internal.Prelude
import Prelude                  ()

import qualified Data.Text as T

data Issue = Issue
    { Issue -> Maybe UTCTime
issueClosedAt    :: !(Maybe UTCTime)
    , Issue -> UTCTime
issueUpdatedAt   :: !UTCTime
    , Issue -> URL
issueEventsUrl   :: !URL
    , Issue -> Maybe URL
issueHtmlUrl     :: !(Maybe URL)
    , Issue -> Maybe SimpleUser
issueClosedBy    :: !(Maybe SimpleUser)
    , Issue -> Vector IssueLabel
issueLabels      :: !(Vector IssueLabel)
    , Issue -> IssueNumber
issueNumber      :: !IssueNumber
    , Issue -> Vector SimpleUser
issueAssignees   :: !(Vector SimpleUser)
    , Issue -> SimpleUser
issueUser        :: !SimpleUser
    , Issue -> Text
issueTitle       :: !Text
    , Issue -> Maybe PullRequestReference
issuePullRequest :: !(Maybe PullRequestReference)
    , Issue -> URL
issueUrl         :: !URL
    , Issue -> UTCTime
issueCreatedAt   :: !UTCTime
    , Issue -> Maybe Text
issueBody        :: !(Maybe Text)
    , Issue -> IssueState
issueState       :: !IssueState
    , Issue -> Id Issue
issueId          :: !(Id Issue)
    , Issue -> Int
issueComments    :: !Int
    , Issue -> Maybe Milestone
issueMilestone   :: !(Maybe Milestone)
    , Issue -> Maybe IssueStateReason
issueStateReason :: !(Maybe IssueStateReason)
    }
  deriving (Int -> Issue -> ShowS
[Issue] -> ShowS
Issue -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Issue] -> ShowS
$cshowList :: [Issue] -> ShowS
show :: Issue -> String
$cshow :: Issue -> String
showsPrec :: Int -> Issue -> ShowS
$cshowsPrec :: Int -> Issue -> ShowS
Show, Typeable Issue
Issue -> DataType
Issue -> Constr
(forall b. Data b => b -> b) -> Issue -> Issue
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Issue -> u
forall u. (forall d. Data d => d -> u) -> Issue -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Issue -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Issue -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Issue -> m Issue
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Issue -> m Issue
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Issue
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Issue -> c Issue
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Issue)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Issue)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Issue -> m Issue
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Issue -> m Issue
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Issue -> m Issue
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Issue -> m Issue
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Issue -> m Issue
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Issue -> m Issue
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Issue -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Issue -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Issue -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Issue -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Issue -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Issue -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Issue -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Issue -> r
gmapT :: (forall b. Data b => b -> b) -> Issue -> Issue
$cgmapT :: (forall b. Data b => b -> b) -> Issue -> Issue
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Issue)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Issue)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Issue)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Issue)
dataTypeOf :: Issue -> DataType
$cdataTypeOf :: Issue -> DataType
toConstr :: Issue -> Constr
$ctoConstr :: Issue -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Issue
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Issue
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Issue -> c Issue
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Issue -> c Issue
Data, Typeable, Issue -> Issue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Issue -> Issue -> Bool
$c/= :: Issue -> Issue -> Bool
== :: Issue -> Issue -> Bool
$c== :: Issue -> Issue -> Bool
Eq, Eq Issue
Issue -> Issue -> Bool
Issue -> Issue -> Ordering
Issue -> Issue -> Issue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Issue -> Issue -> Issue
$cmin :: Issue -> Issue -> Issue
max :: Issue -> Issue -> Issue
$cmax :: Issue -> Issue -> Issue
>= :: Issue -> Issue -> Bool
$c>= :: Issue -> Issue -> Bool
> :: Issue -> Issue -> Bool
$c> :: Issue -> Issue -> Bool
<= :: Issue -> Issue -> Bool
$c<= :: Issue -> Issue -> Bool
< :: Issue -> Issue -> Bool
$c< :: Issue -> Issue -> Bool
compare :: Issue -> Issue -> Ordering
$ccompare :: Issue -> Issue -> Ordering
Ord, forall x. Rep Issue x -> Issue
forall x. Issue -> Rep Issue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Issue x -> Issue
$cfrom :: forall x. Issue -> Rep Issue x
Generic)

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

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

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

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

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

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

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

-- | See <https://developer.github.com/v3/issues/events/#events-1>
data EventType
    = Mentioned             -- ^ The actor was @mentioned in an issue body.
    | Subscribed            -- ^ The actor subscribed to receive notifications for an issue.
    | Unsubscribed          -- ^ The issue was unsubscribed from by the actor.
    | Referenced            -- ^ The issue was referenced from a commit message. The commit_id attribute is the commit SHA1 of where that happened.
    | Merged                -- ^ The issue was merged by the actor. The commit_id attribute is the SHA1 of the HEAD commit that was merged.
    | Assigned              -- ^ The issue was assigned to the actor.
    | Closed                -- ^ The issue was closed by the actor. When the commit_id is present, it identifies the commit that closed the issue using “closes / fixes #NN” syntax.
    | Reopened              -- ^ The issue was reopened by the actor.
    | ActorUnassigned       -- ^ The issue was unassigned to the actor
    | Labeled               -- ^ A label was added to the issue.
    | Unlabeled             -- ^ A label was removed from the issue.
    | Milestoned            -- ^ The issue was added to a milestone.
    | Demilestoned          -- ^ The issue was removed from a milestone.
    | Renamed               -- ^ The issue title was changed.
    | Locked                -- ^ The issue was locked by the actor.
    | Unlocked              -- ^ The issue was unlocked by the actor.
    | HeadRefDeleted        -- ^ The pull request’s branch was deleted.
    | HeadRefRestored       -- ^ The pull request’s branch was restored.
    | ReviewRequested       -- ^ The actor requested review from the subject on this pull request.
    | ReviewDismissed       -- ^ The actor dismissed a review from the pull request.
    | ReviewRequestRemoved  -- ^ The actor removed the review request for the subject on this pull request.
    | MarkedAsDuplicate     -- ^ A user with write permissions marked an issue as a duplicate of another issue or a pull request as a duplicate of another pull request.
    | UnmarkedAsDuplicate   -- ^ An issue that a user had previously marked as a duplicate of another issue is no longer considered a duplicate, or a pull request that a user had previously marked as a duplicate of another pull request is no longer considered a duplicate.
    | AddedToProject        -- ^ The issue was added to a project board.
    | MovedColumnsInProject -- ^ The issue was moved between columns in a project board.
    | RemovedFromProject    -- ^ The issue was removed from a project board.
    | ConvertedNoteToIssue  -- ^ The issue was created by converting a note in a project board to an issue.
  deriving (Int -> EventType -> ShowS
[EventType] -> ShowS
EventType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EventType] -> ShowS
$cshowList :: [EventType] -> ShowS
show :: EventType -> String
$cshow :: EventType -> String
showsPrec :: Int -> EventType -> ShowS
$cshowsPrec :: Int -> EventType -> ShowS
Show, Typeable EventType
EventType -> DataType
EventType -> Constr
(forall b. Data b => b -> b) -> EventType -> EventType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> EventType -> u
forall u. (forall d. Data d => d -> u) -> EventType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EventType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EventType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EventType -> m EventType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EventType -> m EventType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EventType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EventType -> c EventType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EventType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EventType)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EventType -> m EventType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EventType -> m EventType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EventType -> m EventType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EventType -> m EventType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EventType -> m EventType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EventType -> m EventType
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EventType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EventType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> EventType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EventType -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EventType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EventType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EventType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EventType -> r
gmapT :: (forall b. Data b => b -> b) -> EventType -> EventType
$cgmapT :: (forall b. Data b => b -> b) -> EventType -> EventType
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EventType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EventType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EventType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EventType)
dataTypeOf :: EventType -> DataType
$cdataTypeOf :: EventType -> DataType
toConstr :: EventType -> Constr
$ctoConstr :: EventType -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EventType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EventType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EventType -> c EventType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EventType -> c EventType
Data, Int -> EventType
EventType -> Int
EventType -> [EventType]
EventType -> EventType
EventType -> EventType -> [EventType]
EventType -> EventType -> EventType -> [EventType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: EventType -> EventType -> EventType -> [EventType]
$cenumFromThenTo :: EventType -> EventType -> EventType -> [EventType]
enumFromTo :: EventType -> EventType -> [EventType]
$cenumFromTo :: EventType -> EventType -> [EventType]
enumFromThen :: EventType -> EventType -> [EventType]
$cenumFromThen :: EventType -> EventType -> [EventType]
enumFrom :: EventType -> [EventType]
$cenumFrom :: EventType -> [EventType]
fromEnum :: EventType -> Int
$cfromEnum :: EventType -> Int
toEnum :: Int -> EventType
$ctoEnum :: Int -> EventType
pred :: EventType -> EventType
$cpred :: EventType -> EventType
succ :: EventType -> EventType
$csucc :: EventType -> EventType
Enum, EventType
forall a. a -> a -> Bounded a
maxBound :: EventType
$cmaxBound :: EventType
minBound :: EventType
$cminBound :: EventType
Bounded, Typeable, EventType -> EventType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EventType -> EventType -> Bool
$c/= :: EventType -> EventType -> Bool
== :: EventType -> EventType -> Bool
$c== :: EventType -> EventType -> Bool
Eq, Eq EventType
EventType -> EventType -> Bool
EventType -> EventType -> Ordering
EventType -> EventType -> EventType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EventType -> EventType -> EventType
$cmin :: EventType -> EventType -> EventType
max :: EventType -> EventType -> EventType
$cmax :: EventType -> EventType -> EventType
>= :: EventType -> EventType -> Bool
$c>= :: EventType -> EventType -> Bool
> :: EventType -> EventType -> Bool
$c> :: EventType -> EventType -> Bool
<= :: EventType -> EventType -> Bool
$c<= :: EventType -> EventType -> Bool
< :: EventType -> EventType -> Bool
$c< :: EventType -> EventType -> Bool
compare :: EventType -> EventType -> Ordering
$ccompare :: EventType -> EventType -> Ordering
Ord, forall x. Rep EventType x -> EventType
forall x. EventType -> Rep EventType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EventType x -> EventType
$cfrom :: forall x. EventType -> Rep EventType x
Generic)

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

-- | Issue event
data IssueEvent = IssueEvent
    { IssueEvent -> SimpleUser
issueEventActor     :: !SimpleUser
    , IssueEvent -> EventType
issueEventType      :: !EventType
    , IssueEvent -> Maybe Text
issueEventCommitId  :: !(Maybe Text)
    , IssueEvent -> URL
issueEventUrl       :: !URL
    , IssueEvent -> UTCTime
issueEventCreatedAt :: !UTCTime
    , IssueEvent -> Int
issueEventId        :: !Int
    , IssueEvent -> Maybe Issue
issueEventIssue     :: !(Maybe Issue)
    , IssueEvent -> Maybe IssueLabel
issueEventLabel     :: !(Maybe IssueLabel)
    }
  deriving (Int -> IssueEvent -> ShowS
[IssueEvent] -> ShowS
IssueEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IssueEvent] -> ShowS
$cshowList :: [IssueEvent] -> ShowS
show :: IssueEvent -> String
$cshow :: IssueEvent -> String
showsPrec :: Int -> IssueEvent -> ShowS
$cshowsPrec :: Int -> IssueEvent -> ShowS
Show, Typeable IssueEvent
IssueEvent -> DataType
IssueEvent -> Constr
(forall b. Data b => b -> b) -> IssueEvent -> IssueEvent
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> IssueEvent -> u
forall u. (forall d. Data d => d -> u) -> IssueEvent -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IssueEvent -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IssueEvent -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IssueEvent -> m IssueEvent
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IssueEvent -> m IssueEvent
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IssueEvent
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IssueEvent -> c IssueEvent
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IssueEvent)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IssueEvent)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IssueEvent -> m IssueEvent
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IssueEvent -> m IssueEvent
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IssueEvent -> m IssueEvent
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> IssueEvent -> m IssueEvent
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IssueEvent -> m IssueEvent
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> IssueEvent -> m IssueEvent
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IssueEvent -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IssueEvent -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> IssueEvent -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IssueEvent -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IssueEvent -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> IssueEvent -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IssueEvent -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> IssueEvent -> r
gmapT :: (forall b. Data b => b -> b) -> IssueEvent -> IssueEvent
$cgmapT :: (forall b. Data b => b -> b) -> IssueEvent -> IssueEvent
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IssueEvent)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c IssueEvent)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IssueEvent)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c IssueEvent)
dataTypeOf :: IssueEvent -> DataType
$cdataTypeOf :: IssueEvent -> DataType
toConstr :: IssueEvent -> Constr
$ctoConstr :: IssueEvent -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IssueEvent
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c IssueEvent
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IssueEvent -> c IssueEvent
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IssueEvent -> c IssueEvent
Data, Typeable, IssueEvent -> IssueEvent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IssueEvent -> IssueEvent -> Bool
$c/= :: IssueEvent -> IssueEvent -> Bool
== :: IssueEvent -> IssueEvent -> Bool
$c== :: IssueEvent -> IssueEvent -> Bool
Eq, Eq IssueEvent
IssueEvent -> IssueEvent -> Bool
IssueEvent -> IssueEvent -> Ordering
IssueEvent -> IssueEvent -> IssueEvent
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IssueEvent -> IssueEvent -> IssueEvent
$cmin :: IssueEvent -> IssueEvent -> IssueEvent
max :: IssueEvent -> IssueEvent -> IssueEvent
$cmax :: IssueEvent -> IssueEvent -> IssueEvent
>= :: IssueEvent -> IssueEvent -> Bool
$c>= :: IssueEvent -> IssueEvent -> Bool
> :: IssueEvent -> IssueEvent -> Bool
$c> :: IssueEvent -> IssueEvent -> Bool
<= :: IssueEvent -> IssueEvent -> Bool
$c<= :: IssueEvent -> IssueEvent -> Bool
< :: IssueEvent -> IssueEvent -> Bool
$c< :: IssueEvent -> IssueEvent -> Bool
compare :: IssueEvent -> IssueEvent -> Ordering
$ccompare :: IssueEvent -> IssueEvent -> Ordering
Ord, forall x. Rep IssueEvent x -> IssueEvent
forall x. IssueEvent -> Rep IssueEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IssueEvent x -> IssueEvent
$cfrom :: forall x. IssueEvent -> Rep IssueEvent x
Generic)

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

instance FromJSON IssueEvent where
    parseJSON :: Value -> Parser IssueEvent
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Event" forall a b. (a -> b) -> a -> b
$ \Object
o -> SimpleUser
-> EventType
-> Maybe Text
-> URL
-> UTCTime
-> Int
-> Maybe Issue
-> Maybe IssueLabel
-> IssueEvent
IssueEvent
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"actor"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"commit_id"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"issue"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"label"

instance FromJSON EventType where
    parseJSON :: Value -> Parser EventType
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"EventType" forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text -> Text
T.toLower Text
t of
        Text
"closed"                   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
Closed
        Text
"reopened"                 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
Reopened
        Text
"subscribed"               -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
Subscribed
        Text
"merged"                   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
Merged
        Text
"referenced"               -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
Referenced
        Text
"mentioned"                -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
Mentioned
        Text
"assigned"                 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
Assigned
        Text
"unassigned"               -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
ActorUnassigned
        Text
"labeled"                  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
Labeled
        Text
"unlabeled"                -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
Unlabeled
        Text
"milestoned"               -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
Milestoned
        Text
"demilestoned"             -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
Demilestoned
        Text
"renamed"                  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
Renamed
        Text
"locked"                   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
Locked
        Text
"unlocked"                 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
Unlocked
        Text
"head_ref_deleted"         -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
HeadRefDeleted
        Text
"head_ref_restored"        -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
HeadRefRestored
        Text
"review_requested"         -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
ReviewRequested
        Text
"review_dismissed"         -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
ReviewDismissed
        Text
"review_request_removed"   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
ReviewRequestRemoved
        Text
"marked_as_duplicate"      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
MarkedAsDuplicate
        Text
"unmarked_as_duplicate"    -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
UnmarkedAsDuplicate
        Text
"added_to_project"         -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
AddedToProject
        Text
"moved_columns_in_project" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
MovedColumnsInProject
        Text
"removed_from_project"     -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
RemovedFromProject
        Text
"converted_note_to_issue"  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
ConvertedNoteToIssue
        Text
"unsubscribed"             -> forall (f :: * -> *) a. Applicative f => a -> f a
pure EventType
Unsubscribed -- not in api docs list
        Text
_                          -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown EventType: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t

instance FromJSON IssueComment where
    parseJSON :: Value -> Parser IssueComment
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"IssueComment" forall a b. (a -> b) -> a -> b
$ \Object
o -> UTCTime
-> SimpleUser
-> URL
-> URL
-> UTCTime
-> Text
-> Int
-> IssueComment
IssueComment
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"html_url"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"body"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"

instance FromJSON Issue where
    parseJSON :: Value -> Parser Issue
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Issue" forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe UTCTime
-> UTCTime
-> URL
-> Maybe URL
-> Maybe SimpleUser
-> Vector IssueLabel
-> IssueNumber
-> Vector SimpleUser
-> SimpleUser
-> Text
-> Maybe PullRequestReference
-> URL
-> UTCTime
-> Maybe Text
-> IssueState
-> Id Issue
-> Int
-> Maybe Milestone
-> Maybe IssueStateReason
-> Issue
Issue
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"closed_at"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"updated_at"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"events_url"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"html_url"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"closed_by"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"labels"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"number"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"assignees"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"title"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"pull_request"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"created_at"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"body"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"state"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"comments"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"milestone"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"state_reason"

instance ToJSON NewIssue where
    toJSON :: NewIssue -> Value
toJSON (NewIssue Text
t Maybe Text
b Vector (Name User)
a Maybe (Id Milestone)
m Maybe (Vector (Name IssueLabel))
ls) = [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall {a}. (a, Value) -> Bool
notNull
        [ Key
"title"     forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
t
        , Key
"body"      forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
b
        , Key
"assignees" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Vector (Name User)
a
        , Key
"milestone" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Id Milestone)
m
        , Key
"labels"    forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Vector (Name IssueLabel))
ls
        ]
      where
        notNull :: (a, Value) -> Bool
notNull (a
_, Value
Null) = Bool
False
        notNull (a
_, Value
_)    = Bool
True

instance ToJSON EditIssue where
    toJSON :: EditIssue -> Value
toJSON (EditIssue Maybe Text
t Maybe Text
b Maybe (Vector (Name User))
a Maybe IssueState
s Maybe (Id Milestone)
m Maybe (Vector (Name IssueLabel))
ls) = [Pair] -> Value
object forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall {a}. (a, Value) -> Bool
notNull
        [ Key
"title"     forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
t
        , Key
"body"      forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
b
        , Key
"assignees" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Vector (Name User))
a
        , Key
"state"     forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe IssueState
s
        , Key
"milestone" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Id Milestone)
m
        , Key
"labels"    forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Vector (Name IssueLabel))
ls
        ]
      where
        notNull :: (a, Value) -> Bool
notNull (a
_, Value
Null) = Bool
False
        notNull (a
_, Value
_)    = Bool
True