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

------------------------------------------------------------------------------
-- Workflow

data Workflow = Workflow
    { Workflow -> Text
workflowBadgeUrl  :: Text
    , Workflow -> Text
workflowCreatedAt :: Text
    , Workflow -> Text
workflowHtmlUrl   :: Text
    , Workflow -> Int
workflowId        :: Int
    , Workflow -> Text
workflowName      :: Text
    , Workflow -> Text
workflowNodeId    :: Text
    , Workflow -> Text
workflowPath      :: Text
    , Workflow -> Text
workflowState     :: Text
    , Workflow -> Text
workflowUpdatedAt :: Text
    , Workflow -> Text
workflowUrl       :: Text
    } deriving (Workflow -> Workflow -> Bool
(Workflow -> Workflow -> Bool)
-> (Workflow -> Workflow -> Bool) -> Eq Workflow
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Workflow -> Workflow -> Bool
$c/= :: Workflow -> Workflow -> Bool
== :: Workflow -> Workflow -> Bool
$c== :: Workflow -> Workflow -> Bool
Eq, Int -> Workflow -> ShowS
[Workflow] -> ShowS
Workflow -> String
(Int -> Workflow -> ShowS)
-> (Workflow -> String) -> ([Workflow] -> ShowS) -> Show Workflow
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Workflow] -> ShowS
$cshowList :: [Workflow] -> ShowS
show :: Workflow -> String
$cshow :: Workflow -> String
showsPrec :: Int -> Workflow -> ShowS
$cshowsPrec :: Int -> Workflow -> ShowS
Show, ReadPrec [Workflow]
ReadPrec Workflow
Int -> ReadS Workflow
ReadS [Workflow]
(Int -> ReadS Workflow)
-> ReadS [Workflow]
-> ReadPrec Workflow
-> ReadPrec [Workflow]
-> Read Workflow
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Workflow]
$creadListPrec :: ReadPrec [Workflow]
readPrec :: ReadPrec Workflow
$creadPrec :: ReadPrec Workflow
readList :: ReadS [Workflow]
$creadList :: ReadS [Workflow]
readsPrec :: Int -> ReadS Workflow
$creadsPrec :: Int -> ReadS Workflow
Read)


instance FromJSON Workflow where
    parseJSON :: Value -> Parser Workflow
parseJSON (Object Object
x) = Text
-> Text
-> Text
-> Int
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Workflow
Workflow
        (Text
 -> Text
 -> Text
 -> Int
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Workflow)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Workflow)
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
"badge_url"
        Parser
  (Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Workflow)
-> Parser Text
-> Parser
     (Text
      -> Int -> Text -> Text -> Text -> Text -> Text -> Text -> Workflow)
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
"created_at"
        Parser
  (Text
   -> Int -> Text -> Text -> Text -> Text -> Text -> Text -> Workflow)
-> Parser Text
-> Parser
     (Int -> Text -> Text -> Text -> Text -> Text -> Text -> Workflow)
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
"html_url"
        Parser
  (Int -> Text -> Text -> Text -> Text -> Text -> Text -> Workflow)
-> Parser Int
-> Parser
     (Text -> Text -> Text -> Text -> Text -> Text -> Workflow)
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 -> Workflow)
-> Parser Text
-> Parser (Text -> Text -> Text -> Text -> Text -> Workflow)
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
"name"
        Parser (Text -> Text -> Text -> Text -> Text -> Workflow)
-> Parser Text -> Parser (Text -> Text -> Text -> Text -> Workflow)
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 -> Text -> Workflow)
-> Parser Text -> Parser (Text -> Text -> Text -> Workflow)
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
"path"
        Parser (Text -> Text -> Text -> Workflow)
-> Parser Text -> Parser (Text -> Text -> Workflow)
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
"state"
        Parser (Text -> Text -> Workflow)
-> Parser Text -> Parser (Text -> Workflow)
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
"updated_at"
        Parser (Text -> Workflow) -> Parser Text -> Parser Workflow
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 Workflow
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Workflow"


instance ToJSON Workflow where
    toJSON :: Workflow -> Value
toJSON Workflow{Int
Text
workflowUrl :: Text
workflowUpdatedAt :: Text
workflowState :: Text
workflowPath :: Text
workflowNodeId :: Text
workflowName :: Text
workflowId :: Int
workflowHtmlUrl :: Text
workflowCreatedAt :: Text
workflowBadgeUrl :: Text
workflowUrl :: Workflow -> Text
workflowUpdatedAt :: Workflow -> Text
workflowState :: Workflow -> Text
workflowPath :: Workflow -> Text
workflowNodeId :: Workflow -> Text
workflowName :: Workflow -> Text
workflowId :: Workflow -> Int
workflowHtmlUrl :: Workflow -> Text
workflowCreatedAt :: Workflow -> Text
workflowBadgeUrl :: Workflow -> Text
..} = [Pair] -> Value
object
        [ Key
"badge_url"  Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowBadgeUrl
        , Key
"created_at" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowCreatedAt
        , Key
"html_url"   Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowHtmlUrl
        , Key
"id"         Key -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
workflowId
        , Key
"name"       Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowName
        , Key
"node_id"    Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowNodeId
        , Key
"path"       Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowPath
        , Key
"state"      Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowState
        , Key
"updated_at" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowUpdatedAt
        , Key
"url"        Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
workflowUrl
        ]


instance Arbitrary Workflow where
    arbitrary :: Gen Workflow
arbitrary = Text
-> Text
-> Text
-> Int
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Workflow
Workflow
        (Text
 -> Text
 -> Text
 -> Int
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Workflow)
-> Gen Text
-> Gen
     (Text
      -> Text
      -> Int
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Text
      -> Workflow)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Text
   -> Text
   -> Int
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Text
   -> Workflow)
-> Gen Text
-> Gen
     (Text
      -> Int -> Text -> Text -> Text -> Text -> Text -> Text -> Workflow)
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 -> Workflow)
-> Gen Text
-> Gen
     (Int -> Text -> Text -> Text -> Text -> Text -> Text -> Workflow)
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 -> Workflow)
-> Gen Int
-> Gen (Text -> Text -> Text -> Text -> Text -> Text -> Workflow)
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 -> Workflow)
-> Gen Text
-> Gen (Text -> Text -> Text -> Text -> Text -> Workflow)
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 -> Workflow)
-> Gen Text -> Gen (Text -> Text -> Text -> Text -> Workflow)
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 -> Workflow)
-> Gen Text -> Gen (Text -> Text -> Text -> Workflow)
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 -> Workflow)
-> Gen Text -> Gen (Text -> Text -> Workflow)
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 -> Workflow)
-> Gen Text -> Gen (Text -> Workflow)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Text -> Workflow) -> Gen Text -> Gen Workflow
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary