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

-- | The zuul job config data type
module Zuul.JobConfig (JobConfig (..), JobVariables) where

import Data.Aeson (FromJSON (..), ToJSON (..), Value)
import Data.Map.Strict (Map)
import Data.Text (Text)
import GHC.Generics (Generic)
import Zuul.Aeson (zuulParseJSON, zuulToJSON)
import Zuul.Nodeset (Nodeset)
import Zuul.SourceContext (SourceContext)

type JobVariables = Map Text Value

data JobConfig = JobConfig
  { JobConfig -> Text
jcName :: Text,
    JobConfig -> Maybe SourceContext
jcSourceContext :: Maybe SourceContext,
    JobConfig -> Maybe Text
jcDescription :: Maybe Text,
    JobConfig -> Maybe Nodeset
jcNodeset :: Maybe Nodeset,
    JobConfig -> JobVariables
jcVariables :: JobVariables,
    JobConfig -> JobVariables
jcExtraVariables :: JobVariables,
    JobConfig -> JobVariables
jcHostVariables :: JobVariables,
    JobConfig -> JobVariables
jcGroupVariables :: JobVariables
  }
  deriving (Int -> JobConfig -> ShowS
[JobConfig] -> ShowS
JobConfig -> String
(Int -> JobConfig -> ShowS)
-> (JobConfig -> String)
-> ([JobConfig] -> ShowS)
-> Show JobConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JobConfig] -> ShowS
$cshowList :: [JobConfig] -> ShowS
show :: JobConfig -> String
$cshow :: JobConfig -> String
showsPrec :: Int -> JobConfig -> ShowS
$cshowsPrec :: Int -> JobConfig -> ShowS
Show, JobConfig -> JobConfig -> Bool
(JobConfig -> JobConfig -> Bool)
-> (JobConfig -> JobConfig -> Bool) -> Eq JobConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JobConfig -> JobConfig -> Bool
$c/= :: JobConfig -> JobConfig -> Bool
== :: JobConfig -> JobConfig -> Bool
$c== :: JobConfig -> JobConfig -> Bool
Eq, Eq JobConfig
Eq JobConfig
-> (JobConfig -> JobConfig -> Ordering)
-> (JobConfig -> JobConfig -> Bool)
-> (JobConfig -> JobConfig -> Bool)
-> (JobConfig -> JobConfig -> Bool)
-> (JobConfig -> JobConfig -> Bool)
-> (JobConfig -> JobConfig -> JobConfig)
-> (JobConfig -> JobConfig -> JobConfig)
-> Ord JobConfig
JobConfig -> JobConfig -> Bool
JobConfig -> JobConfig -> Ordering
JobConfig -> JobConfig -> JobConfig
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 :: JobConfig -> JobConfig -> JobConfig
$cmin :: JobConfig -> JobConfig -> JobConfig
max :: JobConfig -> JobConfig -> JobConfig
$cmax :: JobConfig -> JobConfig -> JobConfig
>= :: JobConfig -> JobConfig -> Bool
$c>= :: JobConfig -> JobConfig -> Bool
> :: JobConfig -> JobConfig -> Bool
$c> :: JobConfig -> JobConfig -> Bool
<= :: JobConfig -> JobConfig -> Bool
$c<= :: JobConfig -> JobConfig -> Bool
< :: JobConfig -> JobConfig -> Bool
$c< :: JobConfig -> JobConfig -> Bool
compare :: JobConfig -> JobConfig -> Ordering
$ccompare :: JobConfig -> JobConfig -> Ordering
$cp1Ord :: Eq JobConfig
Ord, (forall x. JobConfig -> Rep JobConfig x)
-> (forall x. Rep JobConfig x -> JobConfig) -> Generic JobConfig
forall x. Rep JobConfig x -> JobConfig
forall x. JobConfig -> Rep JobConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JobConfig x -> JobConfig
$cfrom :: forall x. JobConfig -> Rep JobConfig x
Generic)

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

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