{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}

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

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

import Control.Monad (guard)
import Data.Aeson (FromJSON, Options (fieldLabelModifier), defaultOptions, genericParseJSON, parseJSON)
import Data.Char (isUpper, toLower)
import Data.Maybe (fromJust, fromMaybe, isJust)
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics (Generic)
import Prelude hiding (id)

zuulParseJSON :: String -> Options
zuulParseJSON :: String -> Options
zuulParseJSON prefix :: String
prefix = Options
defaultOptions {fieldLabelModifier :: String -> String
fieldLabelModifier = String -> String
recordToJson}
  where
    recordToJson :: String -> String
recordToJson = String -> String
updateCase (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
prefix)
    updateCase :: String -> String
updateCase [] = []
    updateCase (x :: Char
x : xs :: String
xs) = Char -> Char
toLower Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
updateCase' String
xs
    updateCase' :: String -> String
updateCase' [] = []
    updateCase' (x :: Char
x : xs :: String
xs)
      | Char -> Bool
isUpper Char
x = '_' Char -> String -> String
forall a. a -> [a] -> [a]
: Char -> Char
toLower Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
updateCase' String
xs
      | Bool
otherwise = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
updateCase' String
xs

data Job
  = Job
      { Job -> Text
jobName :: Text,
        Job -> Maybe Text
jobUuid :: Maybe Text,
        Job -> Maybe Text
jobResult :: Maybe Text
      }
  deriving (Int -> Job -> String -> String
[Job] -> String -> String
Job -> String
(Int -> Job -> String -> String)
-> (Job -> String) -> ([Job] -> String -> String) -> Show Job
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Job] -> String -> String
$cshowList :: [Job] -> String -> String
show :: Job -> String
$cshow :: Job -> String
showsPrec :: Int -> Job -> String -> String
$cshowsPrec :: Int -> Job -> String -> String
Show, (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)

instance FromJSON Job where
  parseJSON :: Value -> Parser Job
parseJSON = Options -> Value -> Parser Job
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser Job) -> Options -> Value -> Parser Job
forall a b. (a -> b) -> a -> b
$ String -> Options
zuulParseJSON "job"

data Change
  = Change
      { Change -> Maybe Text
changeId :: Maybe Text,
        Change -> Text
changeRef :: Text,
        Change -> Text
changeProject :: Text,
        Change -> Bool
changeLive :: Bool,
        Change -> Bool
changeActive :: Bool,
        Change -> [Job]
changeJobs :: [Job]
      }
  deriving (Int -> Change -> String -> String
[Change] -> String -> String
Change -> String
(Int -> Change -> String -> String)
-> (Change -> String)
-> ([Change] -> String -> String)
-> Show Change
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Change] -> String -> String
$cshowList :: [Change] -> String -> String
show :: Change -> String
$cshow :: Change -> String
showsPrec :: Int -> Change -> String -> String
$cshowsPrec :: Int -> Change -> String -> String
Show, (forall x. Change -> Rep Change x)
-> (forall x. Rep Change x -> Change) -> Generic Change
forall x. Rep Change x -> Change
forall x. Change -> Rep Change x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Change x -> Change
$cfrom :: forall x. Change -> Rep Change x
Generic)

instance FromJSON Change where
  parseJSON :: Value -> Parser Change
parseJSON = Options -> Value -> Parser Change
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser Change)
-> Options -> Value -> Parser Change
forall a b. (a -> b) -> a -> b
$ String -> Options
zuulParseJSON "change"

newtype Changes = Changes [Change]
  deriving (Int -> Changes -> String -> String
[Changes] -> String -> String
Changes -> String
(Int -> Changes -> String -> String)
-> (Changes -> String)
-> ([Changes] -> String -> String)
-> Show Changes
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Changes] -> String -> String
$cshowList :: [Changes] -> String -> String
show :: Changes -> String
$cshow :: Changes -> String
showsPrec :: Int -> Changes -> String -> String
$cshowsPrec :: Int -> Changes -> String -> String
Show, (forall x. Changes -> Rep Changes x)
-> (forall x. Rep Changes x -> Changes) -> Generic Changes
forall x. Rep Changes x -> Changes
forall x. Changes -> Rep Changes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Changes x -> Changes
$cfrom :: forall x. Changes -> Rep Changes x
Generic, Value -> Parser [Changes]
Value -> Parser Changes
(Value -> Parser Changes)
-> (Value -> Parser [Changes]) -> FromJSON Changes
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Changes]
$cparseJSONList :: Value -> Parser [Changes]
parseJSON :: Value -> Parser Changes
$cparseJSON :: Value -> Parser Changes
FromJSON)

data ChangeQueue
  = ChangeQueue
      { ChangeQueue -> Text
changeQueueName :: Text,
        ChangeQueue -> [Changes]
changeQueueHeads :: [Changes]
      }
  deriving (Int -> ChangeQueue -> String -> String
[ChangeQueue] -> String -> String
ChangeQueue -> String
(Int -> ChangeQueue -> String -> String)
-> (ChangeQueue -> String)
-> ([ChangeQueue] -> String -> String)
-> Show ChangeQueue
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ChangeQueue] -> String -> String
$cshowList :: [ChangeQueue] -> String -> String
show :: ChangeQueue -> String
$cshow :: ChangeQueue -> String
showsPrec :: Int -> ChangeQueue -> String -> String
$cshowsPrec :: Int -> ChangeQueue -> String -> String
Show, (forall x. ChangeQueue -> Rep ChangeQueue x)
-> (forall x. Rep ChangeQueue x -> ChangeQueue)
-> Generic ChangeQueue
forall x. Rep ChangeQueue x -> ChangeQueue
forall x. ChangeQueue -> Rep ChangeQueue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChangeQueue x -> ChangeQueue
$cfrom :: forall x. ChangeQueue -> Rep ChangeQueue x
Generic)

instance FromJSON ChangeQueue where
  parseJSON :: Value -> Parser ChangeQueue
parseJSON = Options -> Value -> Parser ChangeQueue
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser ChangeQueue)
-> Options -> Value -> Parser ChangeQueue
forall a b. (a -> b) -> a -> b
$ String -> Options
zuulParseJSON "changeQueue"

data Pipeline
  = Pipeline
      { Pipeline -> Text
pipelineName :: Text,
        Pipeline -> [ChangeQueue]
pipelineChangeQueues :: [ChangeQueue]
      }
  deriving (Int -> Pipeline -> String -> String
[Pipeline] -> String -> String
Pipeline -> String
(Int -> Pipeline -> String -> String)
-> (Pipeline -> String)
-> ([Pipeline] -> String -> String)
-> Show Pipeline
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Pipeline] -> String -> String
$cshowList :: [Pipeline] -> String -> String
show :: Pipeline -> String
$cshow :: Pipeline -> String
showsPrec :: Int -> Pipeline -> String -> String
$cshowsPrec :: Int -> Pipeline -> String -> String
Show, (forall x. Pipeline -> Rep Pipeline x)
-> (forall x. Rep Pipeline x -> Pipeline) -> Generic Pipeline
forall x. Rep Pipeline x -> Pipeline
forall x. Pipeline -> Rep Pipeline x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Pipeline x -> Pipeline
$cfrom :: forall x. Pipeline -> Rep Pipeline x
Generic)

instance FromJSON Pipeline where
  parseJSON :: Value -> Parser Pipeline
parseJSON = Options -> Value -> Parser Pipeline
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser Pipeline)
-> Options -> Value -> Parser Pipeline
forall a b. (a -> b) -> a -> b
$ String -> Options
zuulParseJSON "pipeline"

data Status
  = Status
      { Status -> Text
statusZuulVersion :: Text,
        Status -> [Pipeline]
statusPipelines :: [Pipeline]
      }
  deriving (Int -> Status -> String -> String
[Status] -> String -> String
Status -> String
(Int -> Status -> String -> String)
-> (Status -> String)
-> ([Status] -> String -> String)
-> Show Status
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Status] -> String -> String
$cshowList :: [Status] -> String -> String
show :: Status -> String
$cshow :: Status -> String
showsPrec :: Int -> Status -> String -> String
$cshowsPrec :: Int -> Status -> String -> String
Show, (forall x. Status -> Rep Status x)
-> (forall x. Rep Status x -> Status) -> Generic Status
forall x. Rep Status x -> Status
forall x. Status -> Rep Status x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Status x -> Status
$cfrom :: forall x. Status -> Rep Status x
Generic)

instance FromJSON Status where
  parseJSON :: Value -> Parser Status
parseJSON = Options -> Value -> Parser Status
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser Status)
-> Options -> Value -> Parser Status
forall a b. (a -> b) -> a -> b
$ String -> Options
zuulParseJSON "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 :: Text -> Maybe Text -> Status -> Maybe [Change]
pipelineChanges name :: Text
name queueName :: Maybe Text
queueName status :: Status
status =
  case (Pipeline -> Bool) -> [Pipeline] -> [Pipeline]
forall a. (a -> Bool) -> [a] -> [a]
filter (\c :: Pipeline
c -> Pipeline -> Text
pipelineName Pipeline
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name) (Status -> [Pipeline]
statusPipelines Status
status) of
    [pipeline :: Pipeline
pipeline] -> [Change] -> Maybe [Change]
forall a. a -> Maybe a
Just ([Change] -> Maybe [Change]) -> [Change] -> Maybe [Change]
forall a b. (a -> b) -> a -> b
$ Pipeline -> [Change]
processPipeline Pipeline
pipeline
    _ -> Maybe [Change]
forall a. Maybe a
Nothing
  where
    processPipeline :: Pipeline -> [Change]
    processPipeline :: Pipeline -> [Change]
processPipeline pipeline :: Pipeline
pipeline = (ChangeQueue -> [Change]) -> [ChangeQueue] -> [Change]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ChangeQueue -> [Change]
processQueue (Pipeline -> [ChangeQueue]
pipelineChangeQueues Pipeline
pipeline)
    processQueue :: ChangeQueue -> [Change]
    processQueue :: ChangeQueue -> [Change]
processQueue queue :: ChangeQueue
queue = case Maybe Text
queueName of
      Just queueName' :: Text
queueName' ->
        if ChangeQueue -> Text
changeQueueName ChangeQueue
queue Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
queueName'
          then (Changes -> [Change]) -> [Changes] -> [Change]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Changes -> [Change]
processChanges (ChangeQueue -> [Changes]
changeQueueHeads ChangeQueue
queue)
          else []
      Nothing -> (Changes -> [Change]) -> [Changes] -> [Change]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Changes -> [Change]
processChanges (ChangeQueue -> [Changes]
changeQueueHeads ChangeQueue
queue)
    processChanges :: Changes -> [Change]
    processChanges :: Changes -> [Change]
processChanges (Changes changes :: [Change]
changes) = [Change]
changes

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

-- | Extract the job uuids from a list of change
changeJobUuid :: [Change] -> [Text]
changeJobUuid :: [Change] -> [Text]
changeJobUuid = (Change -> [Text]) -> [Change] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Change -> [Text]
go
  where
    go :: Change -> [Text]
    go :: Change -> [Text]
go Change {..} = [Job] -> [Text]
getUuids [Job]
changeJobs
    getUuids :: [Job] -> [Text]
    getUuids :: [Job] -> [Text]
getUuids jobs :: [Job]
jobs = do
      Job
job <- [Job]
jobs
      Bool -> [()]
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> [()]) -> Bool -> [()]
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Bool
forall a. Maybe a -> Bool
isJust (Job -> Maybe Text
jobUuid Job
job)
      Text -> [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Job -> Maybe Text
jobUuid Job
job