module Hix.Managed.Data.StageResult where

import Hix.Managed.Data.MutableId (MutableId)
import Hix.Managed.Data.Mutation (FailedMutation)
import Hix.Managed.Data.MutationState (MutationState)

data StageFailure =
  FailedPrecondition (NonEmpty Text)
  |
  FailedMutations Text (NonEmpty FailedMutation)
  deriving stock (StageFailure -> StageFailure -> Bool
(StageFailure -> StageFailure -> Bool)
-> (StageFailure -> StageFailure -> Bool) -> Eq StageFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StageFailure -> StageFailure -> Bool
== :: StageFailure -> StageFailure -> Bool
$c/= :: StageFailure -> StageFailure -> Bool
/= :: StageFailure -> StageFailure -> Bool
Eq, Int -> StageFailure -> ShowS
[StageFailure] -> ShowS
StageFailure -> String
(Int -> StageFailure -> ShowS)
-> (StageFailure -> String)
-> ([StageFailure] -> ShowS)
-> Show StageFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StageFailure -> ShowS
showsPrec :: Int -> StageFailure -> ShowS
$cshow :: StageFailure -> String
show :: StageFailure -> String
$cshowList :: [StageFailure] -> ShowS
showList :: [StageFailure] -> ShowS
Show, (forall x. StageFailure -> Rep StageFailure x)
-> (forall x. Rep StageFailure x -> StageFailure)
-> Generic StageFailure
forall x. Rep StageFailure x -> StageFailure
forall x. StageFailure -> Rep StageFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StageFailure -> Rep StageFailure x
from :: forall x. StageFailure -> Rep StageFailure x
$cto :: forall x. Rep StageFailure x -> StageFailure
to :: forall x. Rep StageFailure x -> StageFailure
Generic)

data StageSummary =
  StageFailure StageFailure
  |
  StageSuccess Text
  |
  StageNoAction (Maybe Text)
  |
  StageReport Text (NonEmpty MutableId)
  deriving stock (StageSummary -> StageSummary -> Bool
(StageSummary -> StageSummary -> Bool)
-> (StageSummary -> StageSummary -> Bool) -> Eq StageSummary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StageSummary -> StageSummary -> Bool
== :: StageSummary -> StageSummary -> Bool
$c/= :: StageSummary -> StageSummary -> Bool
/= :: StageSummary -> StageSummary -> Bool
Eq, Int -> StageSummary -> ShowS
[StageSummary] -> ShowS
StageSummary -> String
(Int -> StageSummary -> ShowS)
-> (StageSummary -> String)
-> ([StageSummary] -> ShowS)
-> Show StageSummary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StageSummary -> ShowS
showsPrec :: Int -> StageSummary -> ShowS
$cshow :: StageSummary -> String
show :: StageSummary -> String
$cshowList :: [StageSummary] -> ShowS
showList :: [StageSummary] -> ShowS
Show, (forall x. StageSummary -> Rep StageSummary x)
-> (forall x. Rep StageSummary x -> StageSummary)
-> Generic StageSummary
forall x. Rep StageSummary x -> StageSummary
forall x. StageSummary -> Rep StageSummary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StageSummary -> Rep StageSummary x
from :: forall x. StageSummary -> Rep StageSummary x
$cto :: forall x. Rep StageSummary x -> StageSummary
to :: forall x. Rep StageSummary x -> StageSummary
Generic)

data StageResult =
  StageResult {
    StageResult -> StageSummary
summary :: StageSummary,
    StageResult -> Maybe MutationState
state :: Maybe MutationState
  }
  deriving stock (StageResult -> StageResult -> Bool
(StageResult -> StageResult -> Bool)
-> (StageResult -> StageResult -> Bool) -> Eq StageResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StageResult -> StageResult -> Bool
== :: StageResult -> StageResult -> Bool
$c/= :: StageResult -> StageResult -> Bool
/= :: StageResult -> StageResult -> Bool
Eq, Int -> StageResult -> ShowS
[StageResult] -> ShowS
StageResult -> String
(Int -> StageResult -> ShowS)
-> (StageResult -> String)
-> ([StageResult] -> ShowS)
-> Show StageResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StageResult -> ShowS
showsPrec :: Int -> StageResult -> ShowS
$cshow :: StageResult -> String
show :: StageResult -> String
$cshowList :: [StageResult] -> ShowS
showList :: [StageResult] -> ShowS
Show, (forall x. StageResult -> Rep StageResult x)
-> (forall x. Rep StageResult x -> StageResult)
-> Generic StageResult
forall x. Rep StageResult x -> StageResult
forall x. StageResult -> Rep StageResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StageResult -> Rep StageResult x
from :: forall x. StageResult -> Rep StageResult x
$cto :: forall x. Rep StageResult x -> StageResult
to :: forall x. Rep StageResult x -> StageResult
Generic)

stageFailures :: StageSummary -> [FailedMutation]
stageFailures :: StageSummary -> [FailedMutation]
stageFailures = \case
  StageFailure (FailedMutations Text
_ NonEmpty FailedMutation
mutations) -> NonEmpty FailedMutation -> [FailedMutation]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty FailedMutation
mutations
  StageSummary
_ -> []