Status.hs

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- | The zuul status data type
module Zuul.Status
  ( -- * Status data types
    JobStatus (..),
    Change (..),
    Changes (..),
    ChangeQueue (..),
    Pipeline (..),
    Status (..),

    -- * Convenient functions
    pipelineChanges,
    liveChanges,
    changeJobUuid,
  )
where

import Control.Monad (guard)
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Maybe (fromJust, isJust)
import Data.Text (Text)
import GHC.Generics (Generic)
import Zuul.Aeson (zuulParseJSON, zuulToJSON)

data JobStatus = JobStatus
  { jobName :: Text,
    jobUuid :: Maybe Text,
    jobResult :: Maybe Text
  }
  deriving (Show, Eq, Ord, Generic)

instance FromJSON JobStatus where
  parseJSON = zuulParseJSON "job"

instance ToJSON JobStatus where
  toJSON = zuulToJSON "job"

data Change = Change
  { changeId :: Maybe Text,
    changeRef :: Text,
    changeProject :: Text,
    changeLive :: Bool,
    changeActive :: Bool,
    changeJobs :: [JobStatus]
  }
  deriving (Show, Eq, Ord, Generic)

instance FromJSON Change where
  parseJSON = zuulParseJSON "change"

instance ToJSON Change where
  toJSON = zuulToJSON "change"

newtype Changes = Changes [Change]
  deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON)

data ChangeQueue = ChangeQueue
  { changeQueueName :: Text,
    changeQueueHeads :: [Changes]
  }
  deriving (Show, Eq, Ord, Generic)

instance FromJSON ChangeQueue where
  parseJSON = zuulParseJSON "changeQueue"

instance ToJSON ChangeQueue where
  toJSON = zuulToJSON "changeQueue"

data Pipeline = Pipeline
  { pipelineName :: Text,
    pipelineChangeQueues :: [ChangeQueue]
  }
  deriving (Show, Eq, Ord, Generic)

instance FromJSON Pipeline where
  parseJSON = zuulParseJSON "pipeline"

instance ToJSON Pipeline where
  toJSON = zuulToJSON "pipeline"

data Status = Status
  { statusZuulVersion :: Text,
    statusPipelines :: [Pipeline]
  }
  deriving (Show, Eq, Ord, Generic)

instance FromJSON Status where
  parseJSON = zuulParseJSON "status"

instance ToJSON Status where
  toJSON = zuulToJSON "status"

-- | Get the change from a pipeline
pipelineChanges ::
  -- | The pipeline name
  Text ->
  -- | An optional queue name
  Maybe Text ->
  -- | The status record
  Status ->
  -- | Returns an optional list of changes
  Maybe [Change]
pipelineChanges name queueName status =
  case filter (\c -> pipelineName c == name) (statusPipelines status) of
    [pipeline] -> Just $ processPipeline pipeline
    _ -> Nothing
  where
    processPipeline :: Pipeline -> [Change]
    processPipeline pipeline = concatMap processQueue (pipelineChangeQueues pipeline)
    processQueue :: ChangeQueue -> [Change]
    processQueue queue = case queueName of
      Just queueName' ->
        if changeQueueName queue == queueName'
          then concatMap processChanges (changeQueueHeads queue)
          else []
      Nothing -> concatMap processChanges (changeQueueHeads queue)
    processChanges :: Changes -> [Change]
    processChanges (Changes changes) = changes

-- | Filter the change that are live and active
liveChanges :: [Change] -> [Change]
liveChanges = filter (\c -> changeLive c && changeActive c)

-- | Extract the job uuids from a list of change
changeJobUuid :: [Change] -> [Text]
changeJobUuid = concatMap go
  where
    go :: Change -> [Text]
    go Change {..} = getUuids changeJobs
    getUuids :: [JobStatus] -> [Text]
    getUuids jobs = do
      job <- jobs
      guard $ isJust (jobUuid job)
      return $ fromJust $ jobUuid job