Execute.hs

-- | Execute the steps.
execute :: [SomeStep] -> RIO MainEnv ()
execute steps = do
  resources <- newIORef mempty
  mapRIO
    (\MainEnv {logger} -> ExecuteEnv {logger = logger . ExecuteLog, resources})
    (mapM_ executeSomeStep steps)

Main.hs

planAndRun :: Idiom a -> Global -> RIO MainEnv ()
planAndRun idiom Global{} = do
  steps <- plan (resourcesGraph (idiomResources idiom))
  mapM_ (log . PlanStep) steps
  log RunningExecution
  execute steps
  log ExecutionSuccess
  

RIO.GenericLog.hs

{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}

-- | Logging of arbitrary data structures.

module RIO.GenericLog
  ( HasGenericLog(..)
  , log
  , mapRIO
  ) where

import RIO (runRIO, liftIO, ask, RIO)
import Prelude hiding (log)

class HasGenericLog e t | e -> t where
  genericLog :: e -> t -> IO ()

-- | Log a value generically.
log :: HasGenericLog env t => t -> RIO env ()
log t = do
  env <- ask
  liftIO (genericLog env t)

-- | Lift one RIO env to another.
mapRIO :: (outer -> inner) -> RIO inner a -> RIO outer a
mapRIO f m = do
  outer <- ask
  runRIO (f outer) m

Types.hs

--------------------------------------------------------------------------------
-- Execution

data ExecuteLog
  = CreatingResource SomeResource
  | ResourceAlreadyFound SomeResource
  | ProcessFailed (ProcessConfig () () ())
  | RanAptUpdate
  deriving (Show)

type Execute a = RIO ExecuteEnv a

data ExecuteEnv =
  ExecuteEnv
    { resources :: !(IORef (Map Integer Dynamic))
    , logger :: !(ExecuteLog -> IO ())
    }
instance HasGenericLog ExecuteEnv ExecuteLog where
   genericLog = logger

--------------------------------------------------------------------------------
-- Main entry point types

data MainEnv =
  MainEnv
    { logger :: !(MainLog -> IO ())
    }
instance HasGenericLog MainEnv MainLog where
   genericLog = logger

data MainLog
  = PlanStep SomeStep
  | RunningExecution
  | ExecuteLog !ExecuteLog
  | ExecutionSuccess
  deriving (Show)