module Hix.Managed.Process where

import Data.Generics.Labels ()
import Distribution.Pretty (pretty)
import Exon (exon)

import Hix.Data.EnvName (EnvName)
import Hix.Data.Monad (M)
import qualified Hix.Log as Log
import qualified Hix.Managed.Data.EnvContext
import Hix.Managed.Data.EnvContext (EnvContext)
import qualified Hix.Managed.Data.EnvRequest
import qualified Hix.Managed.Data.EnvResult
import Hix.Managed.Data.EnvResult (EnvResult (EnvResult))
import qualified Hix.Managed.Data.ProcessState
import Hix.Managed.Data.ProcessState (ProcessState, initProcessState)
import qualified Hix.Managed.Data.ProjectContext
import Hix.Managed.Data.ProjectContext (ProjectContext)
import qualified Hix.Managed.Data.ProjectResult
import Hix.Managed.Data.ProjectResult (ProjectResult (ProjectResult))
import Hix.Managed.Data.StageResult (StageSummary (StageNoAction))
import Hix.Managed.EnvRequest (withEnvRequest)
import Hix.Managed.Flow (Flow, execFlow)
import qualified Hix.Managed.Handlers.Build
import Hix.Managed.Handlers.Build (BuildHandlers (BuildHandlers), Builder)
import Hix.Monad (mapAccumM)

processEnv ::
  BuildHandlers ->
  Flow () ->
  Builder ->
  ProcessState ->
  EnvContext ->
  M (ProcessState, EnvResult)
processEnv :: BuildHandlers
-> Flow ()
-> Builder
-> ProcessState
-> EnvContext
-> M (ProcessState, EnvResult)
processEnv BuildHandlers
build Flow ()
process Builder
builder ProcessState
state EnvContext
context = do
  BuildHandlers
-> ProcessState
-> EnvContext
-> Builder
-> (EnvRequest -> M EnvResult)
-> M (ProcessState, EnvResult)
withEnvRequest BuildHandlers
build ProcessState
state EnvContext
context Builder
builder \ EnvRequest
request -> do
    Text -> M ()
Log.debug [exon|Processing env '##{context.env :: EnvName}' with initial state:|]
    Doc -> M ()
Log.debugP (Initial EnvState -> Doc
forall a. Pretty a => a -> Doc
pretty EnvRequest
request.state)
    EnvRequest -> Flow () -> M EnvResult
execFlow EnvRequest
request Flow ()
process

skipResult :: StageSummary
skipResult :: StageSummary
skipResult =
  Maybe Text -> StageSummary
StageNoAction (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"This environment has no manageable dependencies.")

processOrSkip ::
  (ProcessState -> EnvContext -> M (ProcessState, EnvResult)) ->
  ProcessState ->
  Either EnvName EnvContext ->
  M (ProcessState, EnvResult)
processOrSkip :: (ProcessState -> EnvContext -> M (ProcessState, EnvResult))
-> ProcessState
-> Either EnvName EnvContext
-> M (ProcessState, EnvResult)
processOrSkip ProcessState -> EnvContext -> M (ProcessState, EnvResult)
process ProcessState
state = \case
  Right EnvContext
context -> ProcessState -> EnvContext -> M (ProcessState, EnvResult)
process ProcessState
state EnvContext
context
  Left EnvName
env -> (ProcessState, EnvResult) -> M (ProcessState, EnvResult)
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProcessState
state, EnvResult {EnvName
env :: EnvName
env :: EnvName
env, state :: Maybe EnvState
state = Maybe EnvState
forall a. Maybe a
Nothing, summaries :: NonEmpty StageSummary
summaries = [Item (NonEmpty StageSummary)
StageSummary
skipResult]})

foldEnvs ::
  ProjectContext ->
  (ProcessState -> EnvContext -> M (ProcessState, EnvResult)) ->
  M ProjectResult
foldEnvs :: ProjectContext
-> (ProcessState -> EnvContext -> M (ProcessState, EnvResult))
-> M ProjectResult
foldEnvs ProjectContext
project ProcessState -> EnvContext -> M (ProcessState, EnvResult)
process = do
  (ProcessState
final, NonEmpty EnvResult
envs) <- (ProcessState
 -> Either EnvName EnvContext -> M (ProcessState, EnvResult))
-> ProcessState
-> NonEmpty (Either EnvName EnvContext)
-> M (ProcessState, NonEmpty EnvResult)
forall (t :: * -> *) (m :: * -> *) s a b.
(Traversable t, Monad m) =>
(s -> a -> m (s, b)) -> s -> t a -> m (s, t b)
mapAccumM ((ProcessState -> EnvContext -> M (ProcessState, EnvResult))
-> ProcessState
-> Either EnvName EnvContext
-> M (ProcessState, EnvResult)
processOrSkip ProcessState -> EnvContext -> M (ProcessState, EnvResult)
process) (ProjectContext -> ProcessState
initProcessState ProjectContext
project) ProjectContext
project.envs
  ProjectResult -> M ProjectResult
forall a. a -> M a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ProjectResult {NonEmpty EnvResult
envs :: NonEmpty EnvResult
envs :: NonEmpty EnvResult
envs, state :: ProjectState
state = ProcessState
final.state}

processProject ::
  BuildHandlers ->
  ProjectContext ->
  Flow () ->
  M ProjectResult
processProject :: BuildHandlers -> ProjectContext -> Flow () -> M ProjectResult
processProject BuildHandlers
build ProjectContext
project Flow ()
process =
  (Builder -> M ProjectResult) -> M ProjectResult
forall a. (Builder -> M a) -> M a
withBuilder \ Builder
builder -> ProjectContext
-> (ProcessState -> EnvContext -> M (ProcessState, EnvResult))
-> M ProjectResult
foldEnvs ProjectContext
project (BuildHandlers
-> Flow ()
-> Builder
-> ProcessState
-> EnvContext
-> M (ProcessState, EnvResult)
processEnv BuildHandlers
build Flow ()
process Builder
builder)
  where
    BuildHandlers {forall a. (Builder -> M a) -> M a
withBuilder :: forall a. (Builder -> M a) -> M a
withBuilder :: BuildHandlers -> forall a. (Builder -> M a) -> M a
withBuilder} = BuildHandlers
build