{-# LANGUAGE DeriveAnyClass #-}

module Hercules.API.Projects.Job
  ( module Hercules.API.Projects.Job,
    JobStatus (..),
    JobPhase (..),
  )
where

import Hercules.API.Accounts.Account (Account)
import Hercules.API.Evaluation.Evaluation
  ( Evaluation,
  )
import Hercules.API.Inputs.ImmutableInput (ImmutableInput)
import Hercules.API.Prelude
import Hercules.API.Projects.Project (Project)
import Hercules.API.Projects.SimpleJob (JobPhase (..), JobStatus (..))
import Hercules.API.Repos.Repo (Repo)

data Job = Job
  { Job -> Id Job
id :: Id Job,
    Job -> Id Project
projectId :: Id Project,
    Job -> Int64
index :: Int64,
    Job -> Id Repo
repoId :: Id Repo,
    Job -> UTCTime
startTime :: UTCTime,
    Job -> Maybe UTCTime
endTime :: Maybe UTCTime,
    Job -> JobPhase
jobPhase :: JobPhase,
    Job -> Bool
isCancelled :: Bool,
    Job -> JobStatus
jobStatus :: JobStatus,
    Job -> JobStatus
evaluationStatus :: JobStatus,
    Job -> JobStatus
derivationStatus :: JobStatus,
    Job -> JobStatus
effectsStatus :: JobStatus,
    Job -> Id Evaluation
evaluationId :: Id Evaluation,
    Job -> GitCommitSource
source :: GitCommitSource,
    -- | This is only correct when querying a single Job.
    Job -> Map Text ImmutableInput
extraInputs :: Map Text ImmutableInput,
    Job -> JobType
jobType :: JobType,
    Job -> Maybe Text
jobName :: Maybe Text,
    Job -> Maybe (Id Job)
rerunOf :: Maybe (Id Job),
    Job -> Maybe Int
rerunOfIndex :: Maybe Int,
    Job -> Maybe (Id Account)
startedBy :: Maybe (Id Account),
    Job -> Maybe (Id Account)
cancelledBy :: Maybe (Id Account),
    Job -> Bool
mayCancel :: Bool,
    Job -> Bool
mayRerun :: Bool
  }
  deriving (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, Int -> Job -> ShowS
[Job] -> ShowS
Job -> String
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
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, Job -> ()
forall a. (a -> ()) -> NFData a
rnf :: Job -> ()
$crnf :: Job -> ()
NFData, [Job] -> Encoding
[Job] -> Value
Job -> Encoding
Job -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Job] -> Encoding
$ctoEncodingList :: [Job] -> Encoding
toJSONList :: [Job] -> Value
$ctoJSONList :: [Job] -> Value
toEncoding :: Job -> Encoding
$ctoEncoding :: Job -> Encoding
toJSON :: Job -> Value
$ctoJSON :: Job -> Value
ToJSON, Value -> Parser [Job]
Value -> Parser Job
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Job]
$cparseJSONList :: Value -> Parser [Job]
parseJSON :: Value -> Parser Job
$cparseJSON :: Value -> Parser Job
FromJSON, Proxy Job -> Declare (Definitions Schema) NamedSchema
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
declareNamedSchema :: Proxy Job -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy Job -> Declare (Definitions Schema) NamedSchema
ToSchema)

data JobType
  = Config
  | Legacy
  | OnPush
  | OnSchedule
  deriving (forall x. Rep JobType x -> JobType
forall x. JobType -> Rep JobType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JobType x -> JobType
$cfrom :: forall x. JobType -> Rep JobType x
Generic, Int -> JobType -> ShowS
[JobType] -> ShowS
JobType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JobType] -> ShowS
$cshowList :: [JobType] -> ShowS
show :: JobType -> String
$cshow :: JobType -> String
showsPrec :: Int -> JobType -> ShowS
$cshowsPrec :: Int -> JobType -> ShowS
Show, JobType -> JobType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JobType -> JobType -> Bool
$c/= :: JobType -> JobType -> Bool
== :: JobType -> JobType -> Bool
$c== :: JobType -> JobType -> Bool
Eq, JobType -> ()
forall a. (a -> ()) -> NFData a
rnf :: JobType -> ()
$crnf :: JobType -> ()
NFData, [JobType] -> Encoding
[JobType] -> Value
JobType -> Encoding
JobType -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [JobType] -> Encoding
$ctoEncodingList :: [JobType] -> Encoding
toJSONList :: [JobType] -> Value
$ctoJSONList :: [JobType] -> Value
toEncoding :: JobType -> Encoding
$ctoEncoding :: JobType -> Encoding
toJSON :: JobType -> Value
$ctoJSON :: JobType -> Value
ToJSON, Value -> Parser [JobType]
Value -> Parser JobType
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [JobType]
$cparseJSONList :: Value -> Parser [JobType]
parseJSON :: Value -> Parser JobType
$cparseJSON :: Value -> Parser JobType
FromJSON, Proxy JobType -> Declare (Definitions Schema) NamedSchema
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
declareNamedSchema :: Proxy JobType -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy JobType -> Declare (Definitions Schema) NamedSchema
ToSchema)

data GitCommitSource = GitCommitSource
  { GitCommitSource -> Text
revision :: Text,
    GitCommitSource -> Text
ref :: Text,
    GitCommitSource -> Text
message :: Text,
    GitCommitSource -> Text
gitCommitterName :: Text,
    GitCommitSource -> Maybe Account
committer :: Maybe Account,
    GitCommitSource -> Text
link :: Text
  }
  deriving (forall x. Rep GitCommitSource x -> GitCommitSource
forall x. GitCommitSource -> Rep GitCommitSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GitCommitSource x -> GitCommitSource
$cfrom :: forall x. GitCommitSource -> Rep GitCommitSource x
Generic, Int -> GitCommitSource -> ShowS
[GitCommitSource] -> ShowS
GitCommitSource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GitCommitSource] -> ShowS
$cshowList :: [GitCommitSource] -> ShowS
show :: GitCommitSource -> String
$cshow :: GitCommitSource -> String
showsPrec :: Int -> GitCommitSource -> ShowS
$cshowsPrec :: Int -> GitCommitSource -> ShowS
Show, GitCommitSource -> GitCommitSource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GitCommitSource -> GitCommitSource -> Bool
$c/= :: GitCommitSource -> GitCommitSource -> Bool
== :: GitCommitSource -> GitCommitSource -> Bool
$c== :: GitCommitSource -> GitCommitSource -> Bool
Eq, GitCommitSource -> ()
forall a. (a -> ()) -> NFData a
rnf :: GitCommitSource -> ()
$crnf :: GitCommitSource -> ()
NFData, [GitCommitSource] -> Encoding
[GitCommitSource] -> Value
GitCommitSource -> Encoding
GitCommitSource -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [GitCommitSource] -> Encoding
$ctoEncodingList :: [GitCommitSource] -> Encoding
toJSONList :: [GitCommitSource] -> Value
$ctoJSONList :: [GitCommitSource] -> Value
toEncoding :: GitCommitSource -> Encoding
$ctoEncoding :: GitCommitSource -> Encoding
toJSON :: GitCommitSource -> Value
$ctoJSON :: GitCommitSource -> Value
ToJSON, Value -> Parser [GitCommitSource]
Value -> Parser GitCommitSource
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GitCommitSource]
$cparseJSONList :: Value -> Parser [GitCommitSource]
parseJSON :: Value -> Parser GitCommitSource
$cparseJSON :: Value -> Parser GitCommitSource
FromJSON, Proxy GitCommitSource -> Declare (Definitions Schema) NamedSchema
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
declareNamedSchema :: Proxy GitCommitSource -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy GitCommitSource -> Declare (Definitions Schema) NamedSchema
ToSchema)

data ProjectAndJobs = ProjectAndJobs
  { ProjectAndJobs -> Project
project :: Project,
    ProjectAndJobs -> [Job]
jobs :: [Job]
  }
  deriving (forall x. Rep ProjectAndJobs x -> ProjectAndJobs
forall x. ProjectAndJobs -> Rep ProjectAndJobs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProjectAndJobs x -> ProjectAndJobs
$cfrom :: forall x. ProjectAndJobs -> Rep ProjectAndJobs x
Generic, Int -> ProjectAndJobs -> ShowS
[ProjectAndJobs] -> ShowS
ProjectAndJobs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProjectAndJobs] -> ShowS
$cshowList :: [ProjectAndJobs] -> ShowS
show :: ProjectAndJobs -> String
$cshow :: ProjectAndJobs -> String
showsPrec :: Int -> ProjectAndJobs -> ShowS
$cshowsPrec :: Int -> ProjectAndJobs -> ShowS
Show, ProjectAndJobs -> ProjectAndJobs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectAndJobs -> ProjectAndJobs -> Bool
$c/= :: ProjectAndJobs -> ProjectAndJobs -> Bool
== :: ProjectAndJobs -> ProjectAndJobs -> Bool
$c== :: ProjectAndJobs -> ProjectAndJobs -> Bool
Eq, ProjectAndJobs -> ()
forall a. (a -> ()) -> NFData a
rnf :: ProjectAndJobs -> ()
$crnf :: ProjectAndJobs -> ()
NFData, [ProjectAndJobs] -> Encoding
[ProjectAndJobs] -> Value
ProjectAndJobs -> Encoding
ProjectAndJobs -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ProjectAndJobs] -> Encoding
$ctoEncodingList :: [ProjectAndJobs] -> Encoding
toJSONList :: [ProjectAndJobs] -> Value
$ctoJSONList :: [ProjectAndJobs] -> Value
toEncoding :: ProjectAndJobs -> Encoding
$ctoEncoding :: ProjectAndJobs -> Encoding
toJSON :: ProjectAndJobs -> Value
$ctoJSON :: ProjectAndJobs -> Value
ToJSON, Value -> Parser [ProjectAndJobs]
Value -> Parser ProjectAndJobs
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ProjectAndJobs]
$cparseJSONList :: Value -> Parser [ProjectAndJobs]
parseJSON :: Value -> Parser ProjectAndJobs
$cparseJSON :: Value -> Parser ProjectAndJobs
FromJSON, Proxy ProjectAndJobs -> Declare (Definitions Schema) NamedSchema
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
declareNamedSchema :: Proxy ProjectAndJobs -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy ProjectAndJobs -> Declare (Definitions Schema) NamedSchema
ToSchema)