module GitHub.Data.Invitation where

import GitHub.Data.Definitions
import GitHub.Data.Id          (Id)
import GitHub.Data.Name        (Name)
import GitHub.Data.Repos       (Repo)
import GitHub.Data.URL         (URL)
import GitHub.Internal.Prelude
import Prelude ()

import qualified Data.Text as T

data Invitation = Invitation
    { Invitation -> Id Invitation
invitationId        :: !(Id Invitation)
    -- TODO: technically either one should be, maybe both. use `these` ?
    , Invitation -> Maybe (Name User)
invitationLogin     :: !(Maybe (Name User))
    , Invitation -> Maybe Text
invitationEmail     :: !(Maybe Text)
    , Invitation -> InvitationRole
invitationRole      :: !InvitationRole
    , Invitation -> UTCTime
invitationCreatedAt :: !UTCTime
    , Invitation -> SimpleUser
inviter             :: !SimpleUser
    }
  deriving (Int -> Invitation -> ShowS
[Invitation] -> ShowS
Invitation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Invitation] -> ShowS
$cshowList :: [Invitation] -> ShowS
show :: Invitation -> String
$cshow :: Invitation -> String
showsPrec :: Int -> Invitation -> ShowS
$cshowsPrec :: Int -> Invitation -> ShowS
Show, Typeable Invitation
Invitation -> DataType
Invitation -> Constr
(forall b. Data b => b -> b) -> Invitation -> Invitation
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) -> Invitation -> u
forall u. (forall d. Data d => d -> u) -> Invitation -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Invitation -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Invitation -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Invitation -> m Invitation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Invitation -> m Invitation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Invitation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Invitation -> c Invitation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Invitation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Invitation)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Invitation -> m Invitation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Invitation -> m Invitation
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Invitation -> m Invitation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Invitation -> m Invitation
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Invitation -> m Invitation
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Invitation -> m Invitation
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Invitation -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Invitation -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Invitation -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Invitation -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Invitation -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Invitation -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Invitation -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Invitation -> r
gmapT :: (forall b. Data b => b -> b) -> Invitation -> Invitation
$cgmapT :: (forall b. Data b => b -> b) -> Invitation -> Invitation
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Invitation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Invitation)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Invitation)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Invitation)
dataTypeOf :: Invitation -> DataType
$cdataTypeOf :: Invitation -> DataType
toConstr :: Invitation -> Constr
$ctoConstr :: Invitation -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Invitation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Invitation
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Invitation -> c Invitation
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Invitation -> c Invitation
Data, Typeable, Invitation -> Invitation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Invitation -> Invitation -> Bool
$c/= :: Invitation -> Invitation -> Bool
== :: Invitation -> Invitation -> Bool
$c== :: Invitation -> Invitation -> Bool
Eq, Eq Invitation
Invitation -> Invitation -> Bool
Invitation -> Invitation -> Ordering
Invitation -> Invitation -> Invitation
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 :: Invitation -> Invitation -> Invitation
$cmin :: Invitation -> Invitation -> Invitation
max :: Invitation -> Invitation -> Invitation
$cmax :: Invitation -> Invitation -> Invitation
>= :: Invitation -> Invitation -> Bool
$c>= :: Invitation -> Invitation -> Bool
> :: Invitation -> Invitation -> Bool
$c> :: Invitation -> Invitation -> Bool
<= :: Invitation -> Invitation -> Bool
$c<= :: Invitation -> Invitation -> Bool
< :: Invitation -> Invitation -> Bool
$c< :: Invitation -> Invitation -> Bool
compare :: Invitation -> Invitation -> Ordering
$ccompare :: Invitation -> Invitation -> Ordering
Ord, forall x. Rep Invitation x -> Invitation
forall x. Invitation -> Rep Invitation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Invitation x -> Invitation
$cfrom :: forall x. Invitation -> Rep Invitation x
Generic)

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

instance FromJSON Invitation where
    parseJSON :: Value -> Parser Invitation
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Invitation" forall a b. (a -> b) -> a -> b
$ \Object
o -> Id Invitation
-> Maybe (Name User)
-> Maybe Text
-> InvitationRole
-> UTCTime
-> SimpleUser
-> Invitation
Invitation
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"login"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"email"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"role"
        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
"inviter"


data InvitationRole
    = InvitationRoleDirectMember
    | InvitationRoleAdmin
    | InvitationRoleBillingManager
    | InvitationRoleHiringManager
    | InvitationRoleReinstate
  deriving
    (InvitationRole -> InvitationRole -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvitationRole -> InvitationRole -> Bool
$c/= :: InvitationRole -> InvitationRole -> Bool
== :: InvitationRole -> InvitationRole -> Bool
$c== :: InvitationRole -> InvitationRole -> Bool
Eq, Eq InvitationRole
InvitationRole -> InvitationRole -> Bool
InvitationRole -> InvitationRole -> Ordering
InvitationRole -> InvitationRole -> InvitationRole
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 :: InvitationRole -> InvitationRole -> InvitationRole
$cmin :: InvitationRole -> InvitationRole -> InvitationRole
max :: InvitationRole -> InvitationRole -> InvitationRole
$cmax :: InvitationRole -> InvitationRole -> InvitationRole
>= :: InvitationRole -> InvitationRole -> Bool
$c>= :: InvitationRole -> InvitationRole -> Bool
> :: InvitationRole -> InvitationRole -> Bool
$c> :: InvitationRole -> InvitationRole -> Bool
<= :: InvitationRole -> InvitationRole -> Bool
$c<= :: InvitationRole -> InvitationRole -> Bool
< :: InvitationRole -> InvitationRole -> Bool
$c< :: InvitationRole -> InvitationRole -> Bool
compare :: InvitationRole -> InvitationRole -> Ordering
$ccompare :: InvitationRole -> InvitationRole -> Ordering
Ord, Int -> InvitationRole -> ShowS
[InvitationRole] -> ShowS
InvitationRole -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvitationRole] -> ShowS
$cshowList :: [InvitationRole] -> ShowS
show :: InvitationRole -> String
$cshow :: InvitationRole -> String
showsPrec :: Int -> InvitationRole -> ShowS
$cshowsPrec :: Int -> InvitationRole -> ShowS
Show, Int -> InvitationRole
InvitationRole -> Int
InvitationRole -> [InvitationRole]
InvitationRole -> InvitationRole
InvitationRole -> InvitationRole -> [InvitationRole]
InvitationRole
-> InvitationRole -> InvitationRole -> [InvitationRole]
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 :: InvitationRole
-> InvitationRole -> InvitationRole -> [InvitationRole]
$cenumFromThenTo :: InvitationRole
-> InvitationRole -> InvitationRole -> [InvitationRole]
enumFromTo :: InvitationRole -> InvitationRole -> [InvitationRole]
$cenumFromTo :: InvitationRole -> InvitationRole -> [InvitationRole]
enumFromThen :: InvitationRole -> InvitationRole -> [InvitationRole]
$cenumFromThen :: InvitationRole -> InvitationRole -> [InvitationRole]
enumFrom :: InvitationRole -> [InvitationRole]
$cenumFrom :: InvitationRole -> [InvitationRole]
fromEnum :: InvitationRole -> Int
$cfromEnum :: InvitationRole -> Int
toEnum :: Int -> InvitationRole
$ctoEnum :: Int -> InvitationRole
pred :: InvitationRole -> InvitationRole
$cpred :: InvitationRole -> InvitationRole
succ :: InvitationRole -> InvitationRole
$csucc :: InvitationRole -> InvitationRole
Enum, InvitationRole
forall a. a -> a -> Bounded a
maxBound :: InvitationRole
$cmaxBound :: InvitationRole
minBound :: InvitationRole
$cminBound :: InvitationRole
Bounded, forall x. Rep InvitationRole x -> InvitationRole
forall x. InvitationRole -> Rep InvitationRole x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InvitationRole x -> InvitationRole
$cfrom :: forall x. InvitationRole -> Rep InvitationRole x
Generic, Typeable, Typeable InvitationRole
InvitationRole -> DataType
InvitationRole -> Constr
(forall b. Data b => b -> b) -> InvitationRole -> InvitationRole
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) -> InvitationRole -> u
forall u. (forall d. Data d => d -> u) -> InvitationRole -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InvitationRole -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InvitationRole -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InvitationRole -> m InvitationRole
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InvitationRole -> m InvitationRole
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InvitationRole
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InvitationRole -> c InvitationRole
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InvitationRole)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InvitationRole)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InvitationRole -> m InvitationRole
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InvitationRole -> m InvitationRole
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InvitationRole -> m InvitationRole
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> InvitationRole -> m InvitationRole
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InvitationRole -> m InvitationRole
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> InvitationRole -> m InvitationRole
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> InvitationRole -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> InvitationRole -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> InvitationRole -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> InvitationRole -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InvitationRole -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> InvitationRole -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InvitationRole -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> InvitationRole -> r
gmapT :: (forall b. Data b => b -> b) -> InvitationRole -> InvitationRole
$cgmapT :: (forall b. Data b => b -> b) -> InvitationRole -> InvitationRole
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InvitationRole)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c InvitationRole)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InvitationRole)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c InvitationRole)
dataTypeOf :: InvitationRole -> DataType
$cdataTypeOf :: InvitationRole -> DataType
toConstr :: InvitationRole -> Constr
$ctoConstr :: InvitationRole -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InvitationRole
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c InvitationRole
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InvitationRole -> c InvitationRole
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> InvitationRole -> c InvitationRole
Data)

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

instance FromJSON InvitationRole where
    parseJSON :: Value -> Parser InvitationRole
parseJSON = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"InvitationRole" forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text -> Text
T.toLower Text
t of
        Text
"direct_member"   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure InvitationRole
InvitationRoleDirectMember
        Text
"admin"           -> forall (f :: * -> *) a. Applicative f => a -> f a
pure InvitationRole
InvitationRoleAdmin
        Text
"billing_manager" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure InvitationRole
InvitationRoleBillingManager
        Text
"hiring_manager"  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure InvitationRole
InvitationRoleHiringManager
        Text
"reinstate"       -> forall (f :: * -> *) a. Applicative f => a -> f a
pure InvitationRole
InvitationRoleReinstate
        Text
_                 -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown InvitationRole: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t

data RepoInvitation = RepoInvitation
    { RepoInvitation -> Id RepoInvitation
repoInvitationId         :: !(Id RepoInvitation)
    , RepoInvitation -> SimpleUser
repoInvitationInvitee    :: !SimpleUser
    , RepoInvitation -> SimpleUser
repoInvitationInviter    :: !SimpleUser
    , RepoInvitation -> Repo
repoInvitationRepo       :: !Repo
    , RepoInvitation -> URL
repoInvitationUrl        :: !URL
    , RepoInvitation -> UTCTime
repoInvitationCreatedAt  :: !UTCTime
    , RepoInvitation -> Text
repoInvitationPermission :: !Text
    , RepoInvitation -> URL
repoInvitationHtmlUrl    :: !URL
    }
  deriving (Int -> RepoInvitation -> ShowS
[RepoInvitation] -> ShowS
RepoInvitation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepoInvitation] -> ShowS
$cshowList :: [RepoInvitation] -> ShowS
show :: RepoInvitation -> String
$cshow :: RepoInvitation -> String
showsPrec :: Int -> RepoInvitation -> ShowS
$cshowsPrec :: Int -> RepoInvitation -> ShowS
Show, Typeable RepoInvitation
RepoInvitation -> DataType
RepoInvitation -> Constr
(forall b. Data b => b -> b) -> RepoInvitation -> RepoInvitation
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) -> RepoInvitation -> u
forall u. (forall d. Data d => d -> u) -> RepoInvitation -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RepoInvitation -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RepoInvitation -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RepoInvitation -> m RepoInvitation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RepoInvitation -> m RepoInvitation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RepoInvitation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RepoInvitation -> c RepoInvitation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RepoInvitation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RepoInvitation)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RepoInvitation -> m RepoInvitation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RepoInvitation -> m RepoInvitation
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RepoInvitation -> m RepoInvitation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RepoInvitation -> m RepoInvitation
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RepoInvitation -> m RepoInvitation
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RepoInvitation -> m RepoInvitation
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RepoInvitation -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> RepoInvitation -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> RepoInvitation -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RepoInvitation -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RepoInvitation -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RepoInvitation -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RepoInvitation -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RepoInvitation -> r
gmapT :: (forall b. Data b => b -> b) -> RepoInvitation -> RepoInvitation
$cgmapT :: (forall b. Data b => b -> b) -> RepoInvitation -> RepoInvitation
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RepoInvitation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RepoInvitation)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RepoInvitation)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RepoInvitation)
dataTypeOf :: RepoInvitation -> DataType
$cdataTypeOf :: RepoInvitation -> DataType
toConstr :: RepoInvitation -> Constr
$ctoConstr :: RepoInvitation -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RepoInvitation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RepoInvitation
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RepoInvitation -> c RepoInvitation
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RepoInvitation -> c RepoInvitation
Data, Typeable, RepoInvitation -> RepoInvitation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RepoInvitation -> RepoInvitation -> Bool
$c/= :: RepoInvitation -> RepoInvitation -> Bool
== :: RepoInvitation -> RepoInvitation -> Bool
$c== :: RepoInvitation -> RepoInvitation -> Bool
Eq, Eq RepoInvitation
RepoInvitation -> RepoInvitation -> Bool
RepoInvitation -> RepoInvitation -> Ordering
RepoInvitation -> RepoInvitation -> RepoInvitation
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 :: RepoInvitation -> RepoInvitation -> RepoInvitation
$cmin :: RepoInvitation -> RepoInvitation -> RepoInvitation
max :: RepoInvitation -> RepoInvitation -> RepoInvitation
$cmax :: RepoInvitation -> RepoInvitation -> RepoInvitation
>= :: RepoInvitation -> RepoInvitation -> Bool
$c>= :: RepoInvitation -> RepoInvitation -> Bool
> :: RepoInvitation -> RepoInvitation -> Bool
$c> :: RepoInvitation -> RepoInvitation -> Bool
<= :: RepoInvitation -> RepoInvitation -> Bool
$c<= :: RepoInvitation -> RepoInvitation -> Bool
< :: RepoInvitation -> RepoInvitation -> Bool
$c< :: RepoInvitation -> RepoInvitation -> Bool
compare :: RepoInvitation -> RepoInvitation -> Ordering
$ccompare :: RepoInvitation -> RepoInvitation -> Ordering
Ord, forall x. Rep RepoInvitation x -> RepoInvitation
forall x. RepoInvitation -> Rep RepoInvitation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RepoInvitation x -> RepoInvitation
$cfrom :: forall x. RepoInvitation -> Rep RepoInvitation x
Generic)

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

instance FromJSON RepoInvitation where
    parseJSON :: Value -> Parser RepoInvitation
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RepoInvitation" forall a b. (a -> b) -> a -> b
$ \Object
o -> Id RepoInvitation
-> SimpleUser
-> SimpleUser
-> Repo
-> URL
-> UTCTime
-> Text
-> URL
-> RepoInvitation
RepoInvitation
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"invitee"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"inviter"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"repository"
        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
"permissions"
        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"