module Hix.Managed.Flow (
  Flow,
  liftM,
  runStage,
  execStage,
  evalStage,
  runStage_,
  execStatelessStage,
  evalStageState,
  runFlow,
  execFlow,
  evalFlow,
  stageError,
) where

import Control.Lens ((%=))
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State.Strict (StateT, get, gets, runStateT)
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Text as Text
import Exon (exon)

import Hix.Data.Error (Error (Fatal))
import Hix.Data.Monad (M)
import qualified Hix.Log as Log
import qualified Hix.Managed.Data.EnvContext
import Hix.Managed.Data.EnvContext (EnvContext (EnvContext))
import qualified Hix.Managed.Data.EnvRequest
import Hix.Managed.Data.EnvRequest (EnvRequest (EnvRequest))
import qualified Hix.Managed.Data.EnvResult
import Hix.Managed.Data.EnvResult (EnvResult (EnvResult))
import Hix.Managed.Data.EnvState (EnvState)
import Hix.Managed.Data.Initial (Initial (Initial))
import Hix.Managed.Data.StageContext (StageContext)
import Hix.Managed.Data.StageResult (StageFailure (FailedPrecondition), StageResult (..), StageSummary (StageFailure))
import Hix.Managed.Data.StageState (BuildStatus (Failure, Success))
import Hix.Managed.StageContext (stageContext)
import Hix.Managed.UpdateState (envStateWithMutations)
import Hix.Monad (throwM)

data FlowState =
  FlowState {
    FlowState -> EnvRequest
env :: EnvRequest,
    FlowState -> EnvState
current :: EnvState,
    FlowState -> [StageSummary]
summaries :: [StageSummary]
  }
  deriving stock ((forall x. FlowState -> Rep FlowState x)
-> (forall x. Rep FlowState x -> FlowState) -> Generic FlowState
forall x. Rep FlowState x -> FlowState
forall x. FlowState -> Rep FlowState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FlowState -> Rep FlowState x
from :: forall x. FlowState -> Rep FlowState x
$cto :: forall x. Rep FlowState x -> FlowState
to :: forall x. Rep FlowState x -> FlowState
Generic)

type FlowM = StateT FlowState M

newtype Flow x =
  Flow (FlowM x)
  deriving newtype ((forall a b. (a -> b) -> Flow a -> Flow b)
-> (forall a b. a -> Flow b -> Flow a) -> Functor Flow
forall a b. a -> Flow b -> Flow a
forall a b. (a -> b) -> Flow a -> Flow b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Flow a -> Flow b
fmap :: forall a b. (a -> b) -> Flow a -> Flow b
$c<$ :: forall a b. a -> Flow b -> Flow a
<$ :: forall a b. a -> Flow b -> Flow a
Functor, Functor Flow
Functor Flow =>
(forall a. a -> Flow a)
-> (forall a b. Flow (a -> b) -> Flow a -> Flow b)
-> (forall a b c. (a -> b -> c) -> Flow a -> Flow b -> Flow c)
-> (forall a b. Flow a -> Flow b -> Flow b)
-> (forall a b. Flow a -> Flow b -> Flow a)
-> Applicative Flow
forall a. a -> Flow a
forall a b. Flow a -> Flow b -> Flow a
forall a b. Flow a -> Flow b -> Flow b
forall a b. Flow (a -> b) -> Flow a -> Flow b
forall a b c. (a -> b -> c) -> Flow a -> Flow b -> Flow c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Flow a
pure :: forall a. a -> Flow a
$c<*> :: forall a b. Flow (a -> b) -> Flow a -> Flow b
<*> :: forall a b. Flow (a -> b) -> Flow a -> Flow b
$cliftA2 :: forall a b c. (a -> b -> c) -> Flow a -> Flow b -> Flow c
liftA2 :: forall a b c. (a -> b -> c) -> Flow a -> Flow b -> Flow c
$c*> :: forall a b. Flow a -> Flow b -> Flow b
*> :: forall a b. Flow a -> Flow b -> Flow b
$c<* :: forall a b. Flow a -> Flow b -> Flow a
<* :: forall a b. Flow a -> Flow b -> Flow a
Applicative, Applicative Flow
Applicative Flow =>
(forall a b. Flow a -> (a -> Flow b) -> Flow b)
-> (forall a b. Flow a -> Flow b -> Flow b)
-> (forall a. a -> Flow a)
-> Monad Flow
forall a. a -> Flow a
forall a b. Flow a -> Flow b -> Flow b
forall a b. Flow a -> (a -> Flow b) -> Flow b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Flow a -> (a -> Flow b) -> Flow b
>>= :: forall a b. Flow a -> (a -> Flow b) -> Flow b
$c>> :: forall a b. Flow a -> Flow b -> Flow b
>> :: forall a b. Flow a -> Flow b -> Flow b
$creturn :: forall a. a -> Flow a
return :: forall a. a -> Flow a
Monad)

liftM :: M a -> Flow a
liftM :: forall a. M a -> Flow a
liftM = FlowM a -> Flow a
forall x. FlowM x -> Flow x
Flow (FlowM a -> Flow a) -> (M a -> FlowM a) -> M a -> Flow a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M a -> FlowM a
forall (m :: * -> *) a. Monad m => m a -> StateT FlowState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

addResult ::
  StageResult ->
  Flow BuildStatus
addResult :: StageResult -> Flow BuildStatus
addResult StageResult {Maybe MutationState
state :: Maybe MutationState
state :: StageResult -> Maybe MutationState
state, StageSummary
summary :: StageSummary
summary :: StageResult -> StageSummary
summary} =
  FlowM BuildStatus -> Flow BuildStatus
forall x. FlowM x -> Flow x
Flow do
    #summaries %= (summary :)
    #current %= maybe id envStateWithMutations state
    pure status
  where
    status :: BuildStatus
status = case StageSummary
summary of
      StageFailure StageFailure
_ -> BuildStatus
Failure
      StageSummary
_ -> BuildStatus
Success

newContext :: Flow StageContext
newContext :: Flow StageContext
newContext = do
  FlowState {EnvRequest
env :: FlowState -> EnvRequest
env :: EnvRequest
env, EnvState
current :: FlowState -> EnvState
current :: EnvState
current} <- FlowM FlowState -> Flow FlowState
forall x. FlowM x -> Flow x
Flow FlowM FlowState
forall (m :: * -> *) s. Monad m => StateT s m s
get
  StageContext -> Flow StageContext
forall a. a -> Flow a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EnvRequest -> EnvState -> StageContext
stageContext EnvRequest
env EnvState
current)

runStage ::
  ∀ o .
  Text ->
  (StageContext -> M (StageResult, o)) ->
  Flow (BuildStatus, o)
runStage :: forall o.
Text
-> (StageContext -> M (StageResult, o)) -> Flow (BuildStatus, o)
runStage Text
description StageContext -> M (StageResult, o)
stage = do
  Bool -> Flow () -> Flow ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
Text.null Text
description) do
    EnvRequest {context :: EnvRequest -> EnvContext
context = EnvContext {EnvName
env :: EnvName
env :: EnvContext -> EnvName
env}} <- FlowM EnvRequest -> Flow EnvRequest
forall x. FlowM x -> Flow x
Flow ((FlowState -> EnvRequest) -> FlowM EnvRequest
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (.env))
    M () -> Flow ()
forall a. M a -> Flow a
liftM (Text -> M ()
Log.debug [exon|Executing stage '#{description}' for '##{env}'|])
  StageContext
context <- Flow StageContext
newContext
  (StageResult
result, o
o) <- M (StageResult, o) -> Flow (StageResult, o)
forall a. M a -> Flow a
liftM (StageContext -> M (StageResult, o)
stage StageContext
context)
  BuildStatus
status <- StageResult -> Flow BuildStatus
addResult StageResult
result
  pure (BuildStatus
status, o
o)

execStage ::
  Text ->
  (StageContext -> M StageResult) ->
  Flow BuildStatus
execStage :: Text -> (StageContext -> M StageResult) -> Flow BuildStatus
execStage Text
description StageContext -> M StageResult
stage =
  (BuildStatus, ()) -> BuildStatus
forall a b. (a, b) -> a
fst ((BuildStatus, ()) -> BuildStatus)
-> Flow (BuildStatus, ()) -> Flow BuildStatus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> (StageContext -> M (StageResult, ())) -> Flow (BuildStatus, ())
forall o.
Text
-> (StageContext -> M (StageResult, o)) -> Flow (BuildStatus, o)
runStage Text
description ((StageResult -> (StageResult, ()))
-> M StageResult -> M (StageResult, ())
forall a b. (a -> b) -> M a -> M b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (, ()) (M StageResult -> M (StageResult, ()))
-> (StageContext -> M StageResult)
-> StageContext
-> M (StageResult, ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StageContext -> M StageResult
stage)

evalStage ::
  Text ->
  (StageContext -> M (StageResult, o)) ->
  Flow o
evalStage :: forall o. Text -> (StageContext -> M (StageResult, o)) -> Flow o
evalStage Text
description StageContext -> M (StageResult, o)
stage =
  (BuildStatus, o) -> o
forall a b. (a, b) -> b
snd ((BuildStatus, o) -> o) -> Flow (BuildStatus, o) -> Flow o
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> (StageContext -> M (StageResult, o)) -> Flow (BuildStatus, o)
forall o.
Text
-> (StageContext -> M (StageResult, o)) -> Flow (BuildStatus, o)
runStage Text
description StageContext -> M (StageResult, o)
stage

runStage_ ::
  Text ->
  (StageContext -> M StageResult) ->
  Flow ()
runStage_ :: Text -> (StageContext -> M StageResult) -> Flow ()
runStage_ Text
description StageContext -> M StageResult
stage =
  Flow BuildStatus -> Flow ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Text -> (StageContext -> M StageResult) -> Flow BuildStatus
execStage Text
description StageContext -> M StageResult
stage)

execStatelessStage ::
  Text ->
  (StageContext -> M StageSummary) ->
  Flow BuildStatus
execStatelessStage :: Text -> (StageContext -> M StageSummary) -> Flow BuildStatus
execStatelessStage Text
description StageContext -> M StageSummary
f = do
  Text -> (StageContext -> M StageResult) -> Flow BuildStatus
execStage Text
description \ StageContext
context -> do
    StageSummary
summary <- StageContext -> M StageSummary
f StageContext
context
    pure StageResult {state :: Maybe MutationState
state = Maybe MutationState
forall a. Maybe a
Nothing, StageSummary
summary :: StageSummary
summary :: StageSummary
summary}

stageError :: Text -> Flow ()
stageError :: Text -> Flow ()
stageError Text
msg =
  Flow BuildStatus -> Flow ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Text -> (StageContext -> M StageSummary) -> Flow BuildStatus
execStatelessStage Text
"" (M StageSummary -> StageContext -> M StageSummary
forall a b. a -> b -> a
const (StageSummary -> M StageSummary
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StageFailure -> StageSummary
StageFailure (NonEmpty Text -> StageFailure
FailedPrecondition [Text
Item (NonEmpty Text)
msg])))))

evalStageState :: (EnvState -> StageContext -> a) -> Flow a
evalStageState :: forall a. (EnvState -> StageContext -> a) -> Flow a
evalStageState EnvState -> StageContext -> a
f = do
  StageContext
context <- Flow StageContext
newContext
  EnvState
state <- FlowM EnvState -> Flow EnvState
forall x. FlowM x -> Flow x
Flow ((FlowState -> EnvState) -> FlowM EnvState
forall (m :: * -> *) s a. Monad m => (s -> a) -> StateT s m a
gets (.current))
  pure (EnvState -> StageContext -> a
f EnvState
state StageContext
context)

runFlow :: EnvRequest -> Flow o -> M (o, EnvResult)
runFlow :: forall o. EnvRequest -> Flow o -> M (o, EnvResult)
runFlow request :: EnvRequest
request@EnvRequest {EnvContext
context :: EnvRequest -> EnvContext
context :: EnvContext
context, state :: EnvRequest -> Initial EnvState
state = (Initial EnvState
initState)} (Flow FlowM o
m) =
  FlowM o -> FlowState -> M (o, FlowState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT FlowM o
m FlowState {env :: EnvRequest
env = EnvRequest
request, current :: EnvState
current = EnvState
initState, summaries :: [StageSummary]
summaries = []} M (o, FlowState)
-> ((o, FlowState) -> M (o, EnvResult)) -> M (o, EnvResult)
forall a b. M a -> (a -> M b) -> M b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FlowState -> M EnvResult) -> (o, FlowState) -> M (o, EnvResult)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (o, a) -> f (o, b)
traverse \case
    FlowState {summaries :: FlowState -> [StageSummary]
summaries = StageSummary
h : [StageSummary]
t, current :: FlowState -> EnvState
current = EnvState
finalState} ->
      EnvResult -> M EnvResult
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EnvResult {env :: EnvName
env = EnvContext
context.env, state :: Maybe EnvState
state = EnvState -> Maybe EnvState
forall a. a -> Maybe a
Just EnvState
finalState, summaries :: NonEmpty StageSummary
summaries = NonEmpty StageSummary -> NonEmpty StageSummary
forall a. NonEmpty a -> NonEmpty a
NonEmpty.reverse (StageSummary
h StageSummary -> [StageSummary] -> NonEmpty StageSummary
forall a. a -> [a] -> NonEmpty a
:| [StageSummary]
t)}
    FlowState {summaries :: FlowState -> [StageSummary]
summaries = []} ->
      Error -> M EnvResult
forall a. Error -> M a
throwM (Text -> Error
Fatal Text
"Executed flow with no stages")

execFlow :: EnvRequest -> Flow () -> M EnvResult
execFlow :: EnvRequest -> Flow () -> M EnvResult
execFlow EnvRequest
env Flow ()
m =
  ((), EnvResult) -> EnvResult
forall a b. (a, b) -> b
snd (((), EnvResult) -> EnvResult) -> M ((), EnvResult) -> M EnvResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnvRequest -> Flow () -> M ((), EnvResult)
forall o. EnvRequest -> Flow o -> M (o, EnvResult)
runFlow EnvRequest
env Flow ()
m

evalFlow :: EnvRequest -> Flow o -> M o
evalFlow :: forall o. EnvRequest -> Flow o -> M o
evalFlow EnvRequest
env Flow o
m =
  (o, EnvResult) -> o
forall a b. (a, b) -> a
fst ((o, EnvResult) -> o) -> M (o, EnvResult) -> M o
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnvRequest -> Flow o -> M (o, EnvResult)
forall o. EnvRequest -> Flow o -> M (o, EnvResult)
runFlow EnvRequest
env Flow o
m