{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE StrictData        #-}
module GitHub.Types.Base.Reactions 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 (..))

------------------------------------------------------------------------------
-- Reactions

data Reactions = Reactions
    { Reactions -> Int
reactionsConfused   :: Int
    , Reactions -> Int
reactionsEyes       :: Int
    , Reactions -> Int
reactionsHeart      :: Int
    , Reactions -> Int
reactionsHooray     :: Int
    , Reactions -> Int
reactionsLaugh      :: Int
    , Reactions -> Int
reactionsMinus1     :: Int
    , Reactions -> Int
reactionsPlus1      :: Int
    , Reactions -> Int
reactionsRocket     :: Int
    , Reactions -> Int
reactionsTotalCount :: Int
    , Reactions -> Text
reactionsUrl        :: Text
    } deriving (Reactions -> Reactions -> Bool
(Reactions -> Reactions -> Bool)
-> (Reactions -> Reactions -> Bool) -> Eq Reactions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Reactions -> Reactions -> Bool
$c/= :: Reactions -> Reactions -> Bool
== :: Reactions -> Reactions -> Bool
$c== :: Reactions -> Reactions -> Bool
Eq, Int -> Reactions -> ShowS
[Reactions] -> ShowS
Reactions -> String
(Int -> Reactions -> ShowS)
-> (Reactions -> String)
-> ([Reactions] -> ShowS)
-> Show Reactions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Reactions] -> ShowS
$cshowList :: [Reactions] -> ShowS
show :: Reactions -> String
$cshow :: Reactions -> String
showsPrec :: Int -> Reactions -> ShowS
$cshowsPrec :: Int -> Reactions -> ShowS
Show, ReadPrec [Reactions]
ReadPrec Reactions
Int -> ReadS Reactions
ReadS [Reactions]
(Int -> ReadS Reactions)
-> ReadS [Reactions]
-> ReadPrec Reactions
-> ReadPrec [Reactions]
-> Read Reactions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Reactions]
$creadListPrec :: ReadPrec [Reactions]
readPrec :: ReadPrec Reactions
$creadPrec :: ReadPrec Reactions
readList :: ReadS [Reactions]
$creadList :: ReadS [Reactions]
readsPrec :: Int -> ReadS Reactions
$creadsPrec :: Int -> ReadS Reactions
Read)


instance FromJSON Reactions where
    parseJSON :: Value -> Parser Reactions
parseJSON (Object Object
x) = Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Text
-> Reactions
Reactions
        (Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> Int
 -> Text
 -> Reactions)
-> Parser Int
-> Parser
     (Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Int
      -> Text
      -> Reactions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
x Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"confused"
        Parser
  (Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Int
   -> Text
   -> Reactions)
-> Parser Int
-> Parser
     (Int
      -> Int -> Int -> Int -> Int -> Int -> Int -> Text -> Reactions)
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
"eyes"
        Parser
  (Int
   -> Int -> Int -> Int -> Int -> Int -> Int -> Text -> Reactions)
-> Parser Int
-> Parser
     (Int -> Int -> Int -> Int -> Int -> Int -> Text -> Reactions)
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
"heart"
        Parser
  (Int -> Int -> Int -> Int -> Int -> Int -> Text -> Reactions)
-> Parser Int
-> Parser (Int -> Int -> Int -> Int -> Int -> Text -> Reactions)
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
"hooray"
        Parser (Int -> Int -> Int -> Int -> Int -> Text -> Reactions)
-> Parser Int
-> Parser (Int -> Int -> Int -> Int -> Text -> Reactions)
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
"laugh"
        Parser (Int -> Int -> Int -> Int -> Text -> Reactions)
-> Parser Int -> Parser (Int -> Int -> Int -> Text -> Reactions)
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
"-1"
        Parser (Int -> Int -> Int -> Text -> Reactions)
-> Parser Int -> Parser (Int -> Int -> Text -> Reactions)
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
"+1"
        Parser (Int -> Int -> Text -> Reactions)
-> Parser Int -> Parser (Int -> Text -> Reactions)
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
"rocket"
        Parser (Int -> Text -> Reactions)
-> Parser Int -> Parser (Text -> Reactions)
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
"total_count"
        Parser (Text -> Reactions) -> Parser Text -> Parser Reactions
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 Reactions
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Reactions"


instance ToJSON Reactions where
    toJSON :: Reactions -> Value
toJSON Reactions{Int
Text
reactionsUrl :: Text
reactionsTotalCount :: Int
reactionsRocket :: Int
reactionsPlus1 :: Int
reactionsMinus1 :: Int
reactionsLaugh :: Int
reactionsHooray :: Int
reactionsHeart :: Int
reactionsEyes :: Int
reactionsConfused :: Int
reactionsUrl :: Reactions -> Text
reactionsTotalCount :: Reactions -> Int
reactionsRocket :: Reactions -> Int
reactionsPlus1 :: Reactions -> Int
reactionsMinus1 :: Reactions -> Int
reactionsLaugh :: Reactions -> Int
reactionsHooray :: Reactions -> Int
reactionsHeart :: Reactions -> Int
reactionsEyes :: Reactions -> Int
reactionsConfused :: Reactions -> Int
..} = [Pair] -> Value
object
        [ Key
"confused"    Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
reactionsConfused
        , Key
"eyes"        Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
reactionsEyes
        , Key
"heart"       Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
reactionsHeart
        , Key
"hooray"      Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
reactionsHooray
        , Key
"laugh"       Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
reactionsLaugh
        , Key
"-1"          Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
reactionsMinus1
        , Key
"+1"          Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
reactionsPlus1
        , Key
"rocket"      Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
reactionsRocket
        , Key
"total_count" Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
reactionsTotalCount
        , Key
"url"         Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
reactionsUrl
        ]


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