{-# LANGUAGE DeriveAnyClass #-}

module Hercules.API.Projects.Job where

import Hercules.API.Accounts.Account (Account)
import Hercules.API.Evaluation.Evaluation
  ( Evaluation,
  )
import Hercules.API.Prelude
import Hercules.API.Projects.Project (Project)
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,
    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. 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, 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, Job -> ()
(Job -> ()) -> NFData Job
forall a. (a -> ()) -> NFData a
rnf :: Job -> ()
$crnf :: Job -> ()
NFData, [Job] -> Encoding
[Job] -> Value
Job -> Encoding
Job -> Value
(Job -> Value)
-> (Job -> Encoding)
-> ([Job] -> Value)
-> ([Job] -> Encoding)
-> ToJSON Job
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
(Value -> Parser Job) -> (Value -> Parser [Job]) -> FromJSON 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
(Proxy Job -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Job
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 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. GitCommitSource -> Rep GitCommitSource x)
-> (forall x. Rep GitCommitSource x -> GitCommitSource)
-> Generic GitCommitSource
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
(Int -> GitCommitSource -> ShowS)
-> (GitCommitSource -> String)
-> ([GitCommitSource] -> ShowS)
-> Show GitCommitSource
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
(GitCommitSource -> GitCommitSource -> Bool)
-> (GitCommitSource -> GitCommitSource -> Bool)
-> Eq GitCommitSource
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 -> ()
(GitCommitSource -> ()) -> NFData GitCommitSource
forall a. (a -> ()) -> NFData a
rnf :: GitCommitSource -> ()
$crnf :: GitCommitSource -> ()
NFData, [GitCommitSource] -> Encoding
[GitCommitSource] -> Value
GitCommitSource -> Encoding
GitCommitSource -> Value
(GitCommitSource -> Value)
-> (GitCommitSource -> Encoding)
-> ([GitCommitSource] -> Value)
-> ([GitCommitSource] -> Encoding)
-> ToJSON GitCommitSource
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
(Value -> Parser GitCommitSource)
-> (Value -> Parser [GitCommitSource]) -> FromJSON 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
(Proxy GitCommitSource -> Declare (Definitions Schema) NamedSchema)
-> ToSchema GitCommitSource
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 JobPhase
  = Queued
  | Evaluating
  | Building
  | Effects
  | Done
  deriving ((forall x. JobPhase -> Rep JobPhase x)
-> (forall x. Rep JobPhase x -> JobPhase) -> Generic JobPhase
forall x. Rep JobPhase x -> JobPhase
forall x. JobPhase -> Rep JobPhase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep JobPhase x -> JobPhase
$cfrom :: forall x. JobPhase -> Rep JobPhase x
Generic, Int -> JobPhase -> ShowS
[JobPhase] -> ShowS
JobPhase -> String
(Int -> JobPhase -> ShowS)
-> (JobPhase -> String) -> ([JobPhase] -> ShowS) -> Show JobPhase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [JobPhase] -> ShowS
$cshowList :: [JobPhase] -> ShowS
show :: JobPhase -> String
$cshow :: JobPhase -> String
showsPrec :: Int -> JobPhase -> ShowS
$cshowsPrec :: Int -> JobPhase -> ShowS
Show, JobPhase -> JobPhase -> Bool
(JobPhase -> JobPhase -> Bool)
-> (JobPhase -> JobPhase -> Bool) -> Eq JobPhase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: JobPhase -> JobPhase -> Bool
$c/= :: JobPhase -> JobPhase -> Bool
== :: JobPhase -> JobPhase -> Bool
$c== :: JobPhase -> JobPhase -> Bool
Eq, JobPhase -> ()
(JobPhase -> ()) -> NFData JobPhase
forall a. (a -> ()) -> NFData a
rnf :: JobPhase -> ()
$crnf :: JobPhase -> ()
NFData, [JobPhase] -> Encoding
[JobPhase] -> Value
JobPhase -> Encoding
JobPhase -> Value
(JobPhase -> Value)
-> (JobPhase -> Encoding)
-> ([JobPhase] -> Value)
-> ([JobPhase] -> Encoding)
-> ToJSON JobPhase
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [JobPhase] -> Encoding
$ctoEncodingList :: [JobPhase] -> Encoding
toJSONList :: [JobPhase] -> Value
$ctoJSONList :: [JobPhase] -> Value
toEncoding :: JobPhase -> Encoding
$ctoEncoding :: JobPhase -> Encoding
toJSON :: JobPhase -> Value
$ctoJSON :: JobPhase -> Value
ToJSON, Value -> Parser [JobPhase]
Value -> Parser JobPhase
(Value -> Parser JobPhase)
-> (Value -> Parser [JobPhase]) -> FromJSON JobPhase
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [JobPhase]
$cparseJSONList :: Value -> Parser [JobPhase]
parseJSON :: Value -> Parser JobPhase
$cparseJSON :: Value -> Parser JobPhase
FromJSON, Proxy JobPhase -> Declare (Definitions Schema) NamedSchema
(Proxy JobPhase -> Declare (Definitions Schema) NamedSchema)
-> ToSchema JobPhase
forall a.
(Proxy a -> Declare (Definitions Schema) NamedSchema) -> ToSchema a
declareNamedSchema :: Proxy JobPhase -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy JobPhase -> Declare (Definitions Schema) NamedSchema
ToSchema)

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

-- | Whichever is "worse": 'Failure' wins out, otherwise 'Pending' wins out, otherwise all are 'Success'.
instance Semigroup JobStatus where
  JobStatus
Failure <> :: JobStatus -> JobStatus -> JobStatus
<> JobStatus
_ = JobStatus
Failure
  JobStatus
_ <> JobStatus
Failure = JobStatus
Failure
  JobStatus
Pending <> JobStatus
_ = JobStatus
Pending
  JobStatus
_ <> JobStatus
Pending = JobStatus
Pending
  JobStatus
Success <> JobStatus
Success = JobStatus
Success

-- | @mappend@: Whichever is "worse": 'Failure' wins out, otherwise 'Pending' wins out, otherwise all are 'Success'.
--
-- @mempty@: 'Success'
instance Monoid JobStatus where
  mappend :: JobStatus -> JobStatus -> JobStatus
mappend = JobStatus -> JobStatus -> JobStatus
forall a. Semigroup a => a -> a -> a
(<>)

  mempty :: JobStatus
mempty = JobStatus
Success

data ProjectAndJobs = ProjectAndJobs
  { ProjectAndJobs -> Project
project :: Project,
    ProjectAndJobs -> [Job]
jobs :: [Job]
  }
  deriving ((forall x. ProjectAndJobs -> Rep ProjectAndJobs x)
-> (forall x. Rep ProjectAndJobs x -> ProjectAndJobs)
-> Generic ProjectAndJobs
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
(Int -> ProjectAndJobs -> ShowS)
-> (ProjectAndJobs -> String)
-> ([ProjectAndJobs] -> ShowS)
-> Show ProjectAndJobs
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
(ProjectAndJobs -> ProjectAndJobs -> Bool)
-> (ProjectAndJobs -> ProjectAndJobs -> Bool) -> Eq ProjectAndJobs
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 -> ()
(ProjectAndJobs -> ()) -> NFData ProjectAndJobs
forall a. (a -> ()) -> NFData a
rnf :: ProjectAndJobs -> ()
$crnf :: ProjectAndJobs -> ()
NFData, [ProjectAndJobs] -> Encoding
[ProjectAndJobs] -> Value
ProjectAndJobs -> Encoding
ProjectAndJobs -> Value
(ProjectAndJobs -> Value)
-> (ProjectAndJobs -> Encoding)
-> ([ProjectAndJobs] -> Value)
-> ([ProjectAndJobs] -> Encoding)
-> ToJSON ProjectAndJobs
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
(Value -> Parser ProjectAndJobs)
-> (Value -> Parser [ProjectAndJobs]) -> FromJSON 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
(Proxy ProjectAndJobs -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ProjectAndJobs
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)