{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}

-- | The zuul job data type
module Zuul.Job (Job (..)) where

import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Text (Text)
import GHC.Generics (Generic)
import Zuul.Aeson (zuulParseJSON, zuulToJSON)

data Job = Job
  { Job -> Text
jobName :: Text,
    Job -> Maybe Text
jobDescription :: Maybe Text
  }
  deriving (Int -> Job -> ShowS
[Job] -> ShowS
Job -> String
(Int -> Job -> ShowS)
-> (Job -> String) -> ([Job] -> ShowS) -> Show Job
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Job] -> ShowS
$cshowList :: [Job] -> ShowS
show :: Job -> String
$cshow :: Job -> String
showsPrec :: Int -> Job -> ShowS
$cshowsPrec :: Int -> Job -> ShowS
Show, Job -> Job -> Bool
(Job -> Job -> Bool) -> (Job -> Job -> Bool) -> Eq Job
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Job -> Job -> Bool
$c/= :: Job -> Job -> Bool
== :: Job -> Job -> Bool
$c== :: Job -> Job -> Bool
Eq, Eq Job
Eq Job
-> (Job -> Job -> Ordering)
-> (Job -> Job -> Bool)
-> (Job -> Job -> Bool)
-> (Job -> Job -> Bool)
-> (Job -> Job -> Bool)
-> (Job -> Job -> Job)
-> (Job -> Job -> Job)
-> Ord Job
Job -> Job -> Bool
Job -> Job -> Ordering
Job -> Job -> Job
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 :: Job -> Job -> Job
$cmin :: Job -> Job -> Job
max :: Job -> Job -> Job
$cmax :: Job -> Job -> Job
>= :: Job -> Job -> Bool
$c>= :: Job -> Job -> Bool
> :: Job -> Job -> Bool
$c> :: Job -> Job -> Bool
<= :: Job -> Job -> Bool
$c<= :: Job -> Job -> Bool
< :: Job -> Job -> Bool
$c< :: Job -> Job -> Bool
compare :: Job -> Job -> Ordering
$ccompare :: Job -> Job -> Ordering
$cp1Ord :: Eq Job
Ord, (forall x. Job -> Rep Job x)
-> (forall x. Rep Job x -> Job) -> Generic Job
forall x. Rep Job x -> Job
forall x. Job -> Rep Job x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Job x -> Job
$cfrom :: forall x. Job -> Rep Job x
Generic)

instance ToJSON Job where
  toJSON :: Job -> Value
toJSON = Text -> Job -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Text -> a -> Value
zuulToJSON Text
"job"

instance FromJSON Job where
  parseJSON :: Value -> Parser Job
parseJSON = Text -> Value -> Parser Job
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Text -> Value -> Parser a
zuulParseJSON Text
"job"