Add withProcess

A more general `local` for MonadReader r (Process r).

Author: dpwiz

troupe/src/Troupe/Process.hs

@@ -21,6 +21,7 @@ module Troupe.Process
     MonadProcess (..),
     Process,
     runProcess,
+    withProcess,
     self,
     ProcessOption (..),
     setProcessOption,
@@ -154,6 +155,7 @@ data NodeContext r = NodeContext
     nodeContextProcesses :: {-# UNPACK #-} !(Map ProcessId ProcessContext),
     nodeContextR :: r
   }
+  deriving stock (Functor)
 
 newNodeContext :: r -> IO (NodeContext r)
 newNodeContext r =
@@ -198,6 +200,7 @@ data ProcessEnv r = ProcessEnv
   { processEnvNodeContext :: {-# UNPACK #-} !(NodeContext r),
     processEnvProcessContext :: {-# UNPACK #-} !ProcessContext
   }
+  deriving stock (Functor)
 
 -- | @mtl@-style class to bring 'Process' support to transformers.
 class (Monad m) => MonadProcess r m | m -> r where
@@ -275,19 +278,14 @@ instance MonadProcess r (Process r) where
 instance MonadReader r (Process r) where
   ask = Process $ reader (nodeContextR . processEnvNodeContext)
   reader f = Process $ reader (f . nodeContextR . processEnvNodeContext)
-  local f (Process a) = Process $ local mapR a
-    where
-      mapR env =
-        env
-          { processEnvNodeContext =
-              (processEnvNodeContext env)
-                { nodeContextR = f (nodeContextR (processEnvNodeContext env))
-                }
-          }
+  local f (Process a) = Process $ local (fmap f) a
 
 runProcess :: Process r a -> ProcessEnv r -> IO a
 runProcess = runReaderT . unProcess
 
+withProcess :: (r -> r') -> Process r' a -> Process r a
+withProcess f (Process m) = Process $ withReaderT (fmap f) m
+
 -- | Get the 'ProcessId' of the running process.
 self :: (MonadProcess r m) => m ProcessId
 self = processContextId . processEnvProcessContext <$> getProcessEnv