Job.hs

{-# 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
  { id :: Id Job,
    projectId :: Id Project,
    index :: Int64,
    repoId :: Id Repo,
    startTime :: UTCTime,
    endTime :: Maybe UTCTime,
    jobPhase :: JobPhase,
    isCancelled :: Bool,
    jobStatus :: JobStatus,
    evaluationStatus :: JobStatus,
    derivationStatus :: JobStatus,
    effectsStatus :: JobStatus,
    evaluationId :: Id Evaluation,
    source :: GitCommitSource,
    rerunOf :: Maybe (Id Job),
    rerunOfIndex :: Maybe Int,
    startedBy :: Maybe (Id Account),
    cancelledBy :: Maybe (Id Account),
    mayCancel :: Bool,
    mayRerun :: Bool
  }
  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)

data GitCommitSource = GitCommitSource
  { revision :: Text,
    ref :: Text,
    message :: Text,
    gitCommitterName :: Text,
    committer :: Maybe Account,
    link :: Text
  }
  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)

data JobPhase
  = Queued
  | Evaluating
  | Building
  | Effects
  | Done
  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)

data JobStatus
  = Pending
  | Failure
  | Success
  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)

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

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

  mempty = Success

data ProjectAndJobs = ProjectAndJobs
  { project :: Project,
    jobs :: [Job]
  }
  deriving (Generic, Show, Eq, NFData, ToJSON, FromJSON, ToSchema)