{-# LANGUAGE DeriveAnyClass #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Hercules.Agent.WorkerProtocol.Event where

import Data.Binary (Binary)
import Data.UUID (UUID)
import Data.Vector (Vector)
import Hercules.API.Agent.Evaluate.EvaluateEvent.OnPushHandlerEvent (OnPushHandlerEvent)
import Hercules.API.Agent.Evaluate.EvaluateEvent.OnScheduleHandlerEvent (OnScheduleHandlerEvent)
import Hercules.API.Logs.LogEntry (LogEntry)
import Hercules.Agent.WorkerProtocol.Event.Attribute (Attribute)
import Hercules.Agent.WorkerProtocol.Event.AttributeError (AttributeError)
import Hercules.Agent.WorkerProtocol.Event.AttributeIFD (AttributeIFD)
import Hercules.Agent.WorkerProtocol.Event.BuildResult (BuildResult)
import Hercules.Agent.WorkerProtocol.ViaJSON (ViaJSON)
import Protolude

data Event
  = Attribute Attribute
  | AttributeError AttributeError
  | AttributeIFD AttributeIFD
  | EvaluationDone
  | Error Text
  | Build ByteString Text (Maybe UUID) Bool
  | BuildResult BuildResult
  | EffectResult Int
  | JobConfig
  | OnPushHandler (ViaJSON OnPushHandlerEvent)
  | OnScheduleHandler (ViaJSON OnScheduleHandlerEvent)
  | Exception Text
  | LogItems (ViaJSON (Vector LogEntry))
  deriving ((forall x. Event -> Rep Event x)
-> (forall x. Rep Event x -> Event) -> Generic Event
forall x. Rep Event x -> Event
forall x. Event -> Rep Event x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Event -> Rep Event x
from :: forall x. Event -> Rep Event x
$cto :: forall x. Rep Event x -> Event
to :: forall x. Rep Event x -> Event
Generic, Get Event
[Event] -> Put
Event -> Put
(Event -> Put) -> Get Event -> ([Event] -> Put) -> Binary Event
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
$cput :: Event -> Put
put :: Event -> Put
$cget :: Get Event
get :: Get Event
$cputList :: [Event] -> Put
putList :: [Event] -> Put
Binary, Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Event -> ShowS
showsPrec :: Int -> Event -> ShowS
$cshow :: Event -> String
show :: Event -> String
$cshowList :: [Event] -> ShowS
showList :: [Event] -> ShowS
Show, Event -> Event -> Bool
(Event -> Event -> Bool) -> (Event -> Event -> Bool) -> Eq Event
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Event -> Event -> Bool
== :: Event -> Event -> Bool
$c/= :: Event -> Event -> Bool
/= :: Event -> Event -> Bool
Eq)