-----------------------------------------------------------------------------
-- |
-- License     :  BSD-3-Clause
-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>
--
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)
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)
    }
  deriving (Int -> Issue -> ShowS
[Issue] -> ShowS
Issue -> String
(Int -> Issue -> ShowS)
-> (Issue -> String) -> ([Issue] -> ShowS) -> Show Issue
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
DataType
Constr
Typeable Issue
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Issue -> c Issue)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Issue)
-> (Issue -> Constr)
-> (Issue -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Issue -> Issue)
-> (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 u. (forall d. Data d => d -> u) -> Issue -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Issue -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Issue -> m Issue)
-> Data Issue
Issue -> DataType
Issue -> Constr
(forall b. Data b => b -> b) -> Issue -> Issue
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Issue -> c Issue
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cIssue :: Constr
$tIssue :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Issue -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Issue -> u
gmapQ :: (forall d. Data d => d -> u) -> Issue -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Issue -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable Issue
Data, Typeable, Issue -> Issue -> Bool
(Issue -> Issue -> Bool) -> (Issue -> Issue -> Bool) -> Eq Issue
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
Eq Issue
-> (Issue -> Issue -> Ordering)
-> (Issue -> Issue -> Bool)
-> (Issue -> Issue -> Bool)
-> (Issue -> Issue -> Bool)
-> (Issue -> Issue -> Bool)
-> (Issue -> Issue -> Issue)
-> (Issue -> Issue -> Issue)
-> Ord 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
$cp1Ord :: Eq Issue
Ord, (forall x. Issue -> Rep Issue x)
-> (forall x. Rep Issue x -> Issue) -> Generic Issue
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 = Issue -> ()
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
(Int -> NewIssue -> ShowS)
-> (NewIssue -> String) -> ([NewIssue] -> ShowS) -> Show NewIssue
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
DataType
Constr
Typeable NewIssue
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> NewIssue -> c NewIssue)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c NewIssue)
-> (NewIssue -> Constr)
-> (NewIssue -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> NewIssue -> NewIssue)
-> (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 u. (forall d. Data d => d -> u) -> NewIssue -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> NewIssue -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> NewIssue -> m NewIssue)
-> Data NewIssue
NewIssue -> DataType
NewIssue -> Constr
(forall b. Data b => b -> b) -> NewIssue -> NewIssue
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NewIssue -> c NewIssue
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cNewIssue :: Constr
$tNewIssue :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> NewIssue -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NewIssue -> u
gmapQ :: (forall d. Data d => d -> u) -> NewIssue -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> NewIssue -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable NewIssue
Data, Typeable, NewIssue -> NewIssue -> Bool
(NewIssue -> NewIssue -> Bool)
-> (NewIssue -> NewIssue -> Bool) -> Eq NewIssue
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
Eq NewIssue
-> (NewIssue -> NewIssue -> Ordering)
-> (NewIssue -> NewIssue -> Bool)
-> (NewIssue -> NewIssue -> Bool)
-> (NewIssue -> NewIssue -> Bool)
-> (NewIssue -> NewIssue -> Bool)
-> (NewIssue -> NewIssue -> NewIssue)
-> (NewIssue -> NewIssue -> NewIssue)
-> Ord 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
$cp1Ord :: Eq NewIssue
Ord, (forall x. NewIssue -> Rep NewIssue x)
-> (forall x. Rep NewIssue x -> NewIssue) -> Generic NewIssue
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 = NewIssue -> ()
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
(Int -> EditIssue -> ShowS)
-> (EditIssue -> String)
-> ([EditIssue] -> ShowS)
-> Show EditIssue
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
DataType
Constr
Typeable EditIssue
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> EditIssue -> c EditIssue)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c EditIssue)
-> (EditIssue -> Constr)
-> (EditIssue -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> EditIssue -> EditIssue)
-> (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 u. (forall d. Data d => d -> u) -> EditIssue -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> EditIssue -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EditIssue -> m EditIssue)
-> Data EditIssue
EditIssue -> DataType
EditIssue -> Constr
(forall b. Data b => b -> b) -> EditIssue -> EditIssue
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EditIssue -> c EditIssue
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cEditIssue :: Constr
$tEditIssue :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> EditIssue -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EditIssue -> u
gmapQ :: (forall d. Data d => d -> u) -> EditIssue -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EditIssue -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable EditIssue
Data, Typeable, EditIssue -> EditIssue -> Bool
(EditIssue -> EditIssue -> Bool)
-> (EditIssue -> EditIssue -> Bool) -> Eq EditIssue
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
Eq EditIssue
-> (EditIssue -> EditIssue -> Ordering)
-> (EditIssue -> EditIssue -> Bool)
-> (EditIssue -> EditIssue -> Bool)
-> (EditIssue -> EditIssue -> Bool)
-> (EditIssue -> EditIssue -> Bool)
-> (EditIssue -> EditIssue -> EditIssue)
-> (EditIssue -> EditIssue -> EditIssue)
-> Ord 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
$cp1Ord :: Eq EditIssue
Ord, (forall x. EditIssue -> Rep EditIssue x)
-> (forall x. Rep EditIssue x -> EditIssue) -> Generic EditIssue
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 = EditIssue -> ()
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
(Int -> IssueComment -> ShowS)
-> (IssueComment -> String)
-> ([IssueComment] -> ShowS)
-> Show IssueComment
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
DataType
Constr
Typeable IssueComment
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> IssueComment -> c IssueComment)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c IssueComment)
-> (IssueComment -> Constr)
-> (IssueComment -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> IssueComment -> IssueComment)
-> (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 u. (forall d. Data d => d -> u) -> IssueComment -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> IssueComment -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IssueComment -> m IssueComment)
-> Data IssueComment
IssueComment -> DataType
IssueComment -> Constr
(forall b. Data b => b -> b) -> IssueComment -> IssueComment
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IssueComment -> c IssueComment
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cIssueComment :: Constr
$tIssueComment :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> IssueComment -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IssueComment -> u
gmapQ :: (forall d. Data d => d -> u) -> IssueComment -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IssueComment -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable IssueComment
Data, Typeable, IssueComment -> IssueComment -> Bool
(IssueComment -> IssueComment -> Bool)
-> (IssueComment -> IssueComment -> Bool) -> Eq IssueComment
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
Eq IssueComment
-> (IssueComment -> IssueComment -> Ordering)
-> (IssueComment -> IssueComment -> Bool)
-> (IssueComment -> IssueComment -> Bool)
-> (IssueComment -> IssueComment -> Bool)
-> (IssueComment -> IssueComment -> Bool)
-> (IssueComment -> IssueComment -> IssueComment)
-> (IssueComment -> IssueComment -> IssueComment)
-> Ord 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
$cp1Ord :: Eq IssueComment
Ord, (forall x. IssueComment -> Rep IssueComment x)
-> (forall x. Rep IssueComment x -> IssueComment)
-> Generic IssueComment
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 = IssueComment -> ()
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
(Int -> EventType -> ShowS)
-> (EventType -> String)
-> ([EventType] -> ShowS)
-> Show EventType
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
DataType
Constr
Typeable EventType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> EventType -> c EventType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c EventType)
-> (EventType -> Constr)
-> (EventType -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> EventType -> EventType)
-> (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 u. (forall d. Data d => d -> u) -> EventType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> EventType -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> EventType -> m EventType)
-> Data EventType
EventType -> DataType
EventType -> Constr
(forall b. Data b => b -> b) -> EventType -> EventType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EventType -> c EventType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cConvertedNoteToIssue :: Constr
$cRemovedFromProject :: Constr
$cMovedColumnsInProject :: Constr
$cAddedToProject :: Constr
$cUnmarkedAsDuplicate :: Constr
$cMarkedAsDuplicate :: Constr
$cReviewRequestRemoved :: Constr
$cReviewDismissed :: Constr
$cReviewRequested :: Constr
$cHeadRefRestored :: Constr
$cHeadRefDeleted :: Constr
$cUnlocked :: Constr
$cLocked :: Constr
$cRenamed :: Constr
$cDemilestoned :: Constr
$cMilestoned :: Constr
$cUnlabeled :: Constr
$cLabeled :: Constr
$cActorUnassigned :: Constr
$cReopened :: Constr
$cClosed :: Constr
$cAssigned :: Constr
$cMerged :: Constr
$cReferenced :: Constr
$cUnsubscribed :: Constr
$cSubscribed :: Constr
$cMentioned :: Constr
$tEventType :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> EventType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EventType -> u
gmapQ :: (forall d. Data d => d -> u) -> EventType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EventType -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable EventType
Data, Int -> EventType
EventType -> Int
EventType -> [EventType]
EventType -> EventType
EventType -> EventType -> [EventType]
EventType -> EventType -> EventType -> [EventType]
(EventType -> EventType)
-> (EventType -> EventType)
-> (Int -> EventType)
-> (EventType -> Int)
-> (EventType -> [EventType])
-> (EventType -> EventType -> [EventType])
-> (EventType -> EventType -> [EventType])
-> (EventType -> EventType -> EventType -> [EventType])
-> Enum 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
EventType -> EventType -> Bounded EventType
forall a. a -> a -> Bounded a
maxBound :: EventType
$cmaxBound :: EventType
minBound :: EventType
$cminBound :: EventType
Bounded, Typeable, EventType -> EventType -> Bool
(EventType -> EventType -> Bool)
-> (EventType -> EventType -> Bool) -> Eq EventType
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
Eq EventType
-> (EventType -> EventType -> Ordering)
-> (EventType -> EventType -> Bool)
-> (EventType -> EventType -> Bool)
-> (EventType -> EventType -> Bool)
-> (EventType -> EventType -> Bool)
-> (EventType -> EventType -> EventType)
-> (EventType -> EventType -> EventType)
-> Ord 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
$cp1Ord :: Eq EventType
Ord, (forall x. EventType -> Rep EventType x)
-> (forall x. Rep EventType x -> EventType) -> Generic EventType
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 = EventType -> ()
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
(Int -> IssueEvent -> ShowS)
-> (IssueEvent -> String)
-> ([IssueEvent] -> ShowS)
-> Show IssueEvent
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
DataType
Constr
Typeable IssueEvent
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> IssueEvent -> c IssueEvent)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c IssueEvent)
-> (IssueEvent -> Constr)
-> (IssueEvent -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> IssueEvent -> IssueEvent)
-> (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 u. (forall d. Data d => d -> u) -> IssueEvent -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> IssueEvent -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> IssueEvent -> m IssueEvent)
-> Data IssueEvent
IssueEvent -> DataType
IssueEvent -> Constr
(forall b. Data b => b -> b) -> IssueEvent -> IssueEvent
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> IssueEvent -> c IssueEvent
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cIssueEvent :: Constr
$tIssueEvent :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> IssueEvent -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> IssueEvent -> u
gmapQ :: (forall d. Data d => d -> u) -> IssueEvent -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> IssueEvent -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable IssueEvent
Data, Typeable, IssueEvent -> IssueEvent -> Bool
(IssueEvent -> IssueEvent -> Bool)
-> (IssueEvent -> IssueEvent -> Bool) -> Eq IssueEvent
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
Eq IssueEvent
-> (IssueEvent -> IssueEvent -> Ordering)
-> (IssueEvent -> IssueEvent -> Bool)
-> (IssueEvent -> IssueEvent -> Bool)
-> (IssueEvent -> IssueEvent -> Bool)
-> (IssueEvent -> IssueEvent -> Bool)
-> (IssueEvent -> IssueEvent -> IssueEvent)
-> (IssueEvent -> IssueEvent -> IssueEvent)
-> Ord 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
$cp1Ord :: Eq IssueEvent
Ord, (forall x. IssueEvent -> Rep IssueEvent x)
-> (forall x. Rep IssueEvent x -> IssueEvent) -> Generic IssueEvent
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 = IssueEvent -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary IssueEvent

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

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

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

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

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 ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (Pair -> Bool) -> [Pair] -> [Pair]
forall a. (a -> Bool) -> [a] -> [a]
filter Pair -> Bool
forall a. (a, Value) -> Bool
notNull
        [ Key
"title"     Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
t
        , Key
"body"      Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
b
        , Key
"assignees" Key -> Vector (Name User) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Vector (Name User)
a
        , Key
"milestone" Key -> Maybe (Id Milestone) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Id Milestone)
m
        , Key
"labels"    Key -> Maybe (Vector (Name IssueLabel)) -> Pair
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 ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ (Pair -> Bool) -> [Pair] -> [Pair]
forall a. (a -> Bool) -> [a] -> [a]
filter Pair -> Bool
forall a. (a, Value) -> Bool
notNull
        [ Key
"title"     Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
t
        , Key
"body"      Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
b
        , Key
"assignees" Key -> Maybe (Vector (Name User)) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Vector (Name User))
a
        , Key
"state"     Key -> Maybe IssueState -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe IssueState
s
        , Key
"milestone" Key -> Maybe (Id Milestone) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe (Id Milestone)
m
        , Key
"labels"    Key -> Maybe (Vector (Name IssueLabel)) -> Pair
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