{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE StrictData        #-}
module GitHub.Types.Base.Organization where

import           Data.Aeson                (FromJSON (..), ToJSON (..), object)
import           Data.Aeson.Types          (Value (..), (.:), (.:?), (.=))
import           Data.Text                 (Text)
import           Data.Text.Arbitrary       ()
import           Test.QuickCheck.Arbitrary (Arbitrary (..))

------------------------------------------------------------------------------
-- Organization

data Organization = Organization
    { Organization -> Text
organizationAvatarUrl        :: Text
    , Organization -> Text
organizationDescription      :: Text
    , Organization -> Maybe Text
organizationEmail            :: Maybe Text
    , Organization -> Text
organizationEventsUrl        :: Text
    , Organization -> Text
organizationHooksUrl         :: Text
    , Organization -> Int
organizationId               :: Int
    , Organization -> Text
organizationIssuesUrl        :: Text
    , Organization -> Text
organizationLogin            :: Text
    , Organization -> Text
organizationMembersUrl       :: Text
    , Organization -> Text
organizationNodeId           :: Text
    , Organization -> Text
organizationPublicMembersUrl :: Text
    , Organization -> Text
organizationReposUrl         :: Text
    , Organization -> Text
organizationUrl              :: Text
    } deriving (Organization -> Organization -> Bool
(Organization -> Organization -> Bool)
-> (Organization -> Organization -> Bool) -> Eq Organization
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Organization -> Organization -> Bool
$c/= :: Organization -> Organization -> Bool
== :: Organization -> Organization -> Bool
$c== :: Organization -> Organization -> Bool
Eq, Int -> Organization -> ShowS
[Organization] -> ShowS
Organization -> String
(Int -> Organization -> ShowS)
-> (Organization -> String)
-> ([Organization] -> ShowS)
-> Show Organization
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Organization] -> ShowS
$cshowList :: [Organization] -> ShowS
show :: Organization -> String
$cshow :: Organization -> String
showsPrec :: Int -> Organization -> ShowS
$cshowsPrec :: Int -> Organization -> ShowS
Show, ReadPrec [Organization]
ReadPrec Organization
Int -> ReadS Organization
ReadS [Organization]
(Int -> ReadS Organization)
-> ReadS [Organization]
-> ReadPrec Organization
-> ReadPrec [Organization]
-> Read Organization
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Organization]
$creadListPrec :: ReadPrec [Organization]
readPrec :: ReadPrec Organization
$creadPrec :: ReadPrec Organization
readList :: ReadS [Organization]
$creadList :: ReadS [Organization]
readsPrec :: Int -> ReadS Organization
$creadsPrec :: Int -> ReadS Organization
Read)


instance FromJSON Organization where
    parseJSON :: Value -> Parser Organization
parseJSON (Object Object
x) = Text
-> Text
-> Maybe Text
-> Text
-> Text
-> Int
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Organization
Organization
        (Text
 -> Text
 -> Maybe Text
 -> Text
 -> Text
 -> Int
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Organization)
-> Parser Text
-> Parser
     (Text
      -> Maybe Text
      -> Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Organization)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"avatar_url"
        Parser
  (Text
   -> Maybe Text
   -> Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Organization)
-> Parser Text
-> Parser
     (Maybe Text
      -> Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Organization)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"description"
        Parser
  (Maybe Text
   -> Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Organization)
-> Parser (Maybe Text)
-> Parser
     (Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Organization)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"email"
        Parser
  (Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Organization)
-> Parser Text
-> Parser
     (Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Organization)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"events_url"
        Parser
  (Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Organization)
-> Parser Text
-> Parser
     (Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Organization)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"hooks_url"
        Parser
  (Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Organization)
-> Parser Int
-> Parser
     (Text
      -> Text -> Text -> Text -> Text -> Text -> Text -> Organization)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
        Parser
  (Text
   -> Text -> Text -> Text -> Text -> Text -> Text -> Organization)
-> Parser Text
-> Parser
     (Text -> Text -> Text -> Text -> Text -> Text -> Organization)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"issues_url"
        Parser
  (Text -> Text -> Text -> Text -> Text -> Text -> Organization)
-> Parser Text
-> Parser (Text -> Text -> Text -> Text -> Text -> Organization)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"login"
        Parser (Text -> Text -> Text -> Text -> Text -> Organization)
-> Parser Text
-> Parser (Text -> Text -> Text -> Text -> Organization)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"members_url"
        Parser (Text -> Text -> Text -> Text -> Organization)
-> Parser Text -> Parser (Text -> Text -> Text -> Organization)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
        Parser (Text -> Text -> Text -> Organization)
-> Parser Text -> Parser (Text -> Text -> Organization)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"public_members_url"
        Parser (Text -> Text -> Organization)
-> Parser Text -> Parser (Text -> Organization)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"repos_url"
        Parser (Text -> Organization) -> Parser Text -> Parser Organization
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"

    parseJSON Value
_ = String -> Parser Organization
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Organization"


instance ToJSON Organization where
    toJSON :: Organization -> Value
toJSON Organization{Int
Maybe Text
Text
organizationUrl :: Text
organizationReposUrl :: Text
organizationPublicMembersUrl :: Text
organizationNodeId :: Text
organizationMembersUrl :: Text
organizationLogin :: Text
organizationIssuesUrl :: Text
organizationId :: Int
organizationHooksUrl :: Text
organizationEventsUrl :: Text
organizationEmail :: Maybe Text
organizationDescription :: Text
organizationAvatarUrl :: Text
organizationUrl :: Organization -> Text
organizationReposUrl :: Organization -> Text
organizationPublicMembersUrl :: Organization -> Text
organizationNodeId :: Organization -> Text
organizationMembersUrl :: Organization -> Text
organizationLogin :: Organization -> Text
organizationIssuesUrl :: Organization -> Text
organizationId :: Organization -> Int
organizationHooksUrl :: Organization -> Text
organizationEventsUrl :: Organization -> Text
organizationEmail :: Organization -> Maybe Text
organizationDescription :: Organization -> Text
organizationAvatarUrl :: Organization -> Text
..} = [Pair] -> Value
object
        [ Key
"avatar_url"         Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
organizationAvatarUrl
        , Key
"description"        Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
organizationDescription
        , Key
"email"              Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
organizationEmail
        , Key
"events_url"         Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
organizationEventsUrl
        , Key
"hooks_url"          Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
organizationHooksUrl
        , Key
"id"                 Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
organizationId
        , Key
"issues_url"         Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
organizationIssuesUrl
        , Key
"login"              Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
organizationLogin
        , Key
"members_url"        Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
organizationMembersUrl
        , Key
"node_id"            Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
organizationNodeId
        , Key
"public_members_url" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
organizationPublicMembersUrl
        , Key
"repos_url"          Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
organizationReposUrl
        , Key
"url"                Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
organizationUrl
        ]


instance Arbitrary Organization where
    arbitrary :: Gen Organization
arbitrary = Text
-> Text
-> Maybe Text
-> Text
-> Text
-> Int
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Organization
Organization
        (Text
 -> Text
 -> Maybe Text
 -> Text
 -> Text
 -> Int
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Organization)
-> Gen Text
-> Gen
     (Text
      -> Maybe Text
      -> Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Organization)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Maybe Text
   -> Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Organization)
-> Gen Text
-> Gen
     (Maybe Text
      -> Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Organization)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Maybe Text
   -> Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Organization)
-> Gen (Maybe Text)
-> Gen
     (Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Organization)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Text)
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Organization)
-> Gen Text
-> Gen
     (Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Organization)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Organization)
-> Gen Text
-> Gen
     (Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Organization)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Organization)
-> Gen Int
-> Gen
     (Text
      -> Text -> Text -> Text -> Text -> Text -> Text -> Organization)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Text -> Text -> Text -> Text -> Text -> Text -> Organization)
-> Gen Text
-> Gen
     (Text -> Text -> Text -> Text -> Text -> Text -> Organization)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Text -> Text -> Text -> Text -> Text -> Text -> Organization)
-> Gen Text
-> Gen (Text -> Text -> Text -> Text -> Text -> Organization)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Text -> Text -> Text -> Text -> Text -> Organization)
-> Gen Text -> Gen (Text -> Text -> Text -> Text -> Organization)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Text -> Text -> Text -> Text -> Organization)
-> Gen Text -> Gen (Text -> Text -> Text -> Organization)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Text -> Text -> Text -> Organization)
-> Gen Text -> Gen (Text -> Text -> Organization)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Text -> Text -> Organization)
-> Gen Text -> Gen (Text -> Organization)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Text -> Organization) -> Gen Text -> Gen Organization
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary