Skip to content

Commit

Permalink
Add withProcess
Browse files Browse the repository at this point in the history
A more general `local` for MonadReader r (Process r).
  • Loading branch information
dpwiz committed Aug 13, 2023
1 parent 639dcb3 commit f301e8c
Showing 1 changed file with 7 additions and 9 deletions.
16 changes: 7 additions & 9 deletions troupe/src/Troupe/Process.hs
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,7 @@ module Troupe.Process
MonadProcess (..),
Process,
runProcess,
withProcess,
self,
ProcessOption (..),
setProcessOption,
Expand Down Expand Up @@ -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 =
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit f301e8c

Please sign in to comment.