Skip to content

Commit 9c29c75

Browse files
committed
cosmetic refactoring of StarterProcess variants of ToChildStart
Moved helper functions to where clauses. See the discussion on PR #77.
1 parent 7e4060b commit 9c29c75

File tree

1 file changed

+59
-56
lines changed

1 file changed

+59
-56
lines changed

Diff for: src/Control/Distributed/Process/Platform/Supervisor.hs

+59-56
Original file line numberDiff line numberDiff line change
@@ -663,67 +663,70 @@ instance ToChildStart (Closure (Process ())) where
663663
instance ToChildStart (Closure (SupervisorPid -> Process (ProcessId, Message))) where
664664
toChildStart = return . CreateHandle
665665

666+
667+
-- StarterProcess variants of ChildStart
668+
669+
expectTriple :: Process (ProcessId, ChildKey, SendPort ProcessId)
670+
expectTriple = expect
671+
666672
instance ToChildStart (Process ()) where
667673
toChildStart proc = do
668-
starterPid <- spawnLocal $ do
669-
-- note [linking]: the first time we see the supervisor's pid,
670-
-- we must link to it, but only once, otherwise we simply waste
671-
-- time and resources creating duplicate links
672-
(supervisor, _, sendPidPort) <- expectTriple
673-
link supervisor
674-
spawnIt proc supervisor sendPidPort
675-
tcsProcLoop proc
676-
return (StarterProcess starterPid)
677-
678-
tcsProcLoop :: Process () -> Process ()
679-
tcsProcLoop p = forever' $ do
680-
(supervisor, _, sendPidPort) <- expectTriple
681-
spawnIt p supervisor sendPidPort
682-
683-
spawnIt :: Process ()
684-
-> ProcessId
685-
-> SendPort ProcessId
686-
-> Process ()
687-
spawnIt proc' supervisor sendPidPort = do
688-
supervisedPid <- spawnLocal $ do
689-
link supervisor
690-
self <- getSelfPid
691-
(proc' `catches` [ Handler $ filterInitFailures supervisor self
692-
, Handler $ logFailure supervisor self ])
693-
`catchesExit` [(\_ m -> handleMessageIf m (== ExitShutdown)
694-
(\_ -> return ()))]
695-
sendChan sendPidPort supervisedPid
674+
starterPid <- spawnLocal $ do
675+
-- note [linking]: the first time we see the supervisor's pid,
676+
-- we must link to it, but only once, otherwise we simply waste
677+
-- time and resources creating duplicate links
678+
(supervisor, _, sendPidPort) <- expectTriple
679+
link supervisor
680+
spawnIt proc supervisor sendPidPort
681+
tcsProcLoop proc
682+
return (StarterProcess starterPid)
683+
where
684+
tcsProcLoop :: Process () -> Process ()
685+
tcsProcLoop p = forever' $ do
686+
(supervisor, _, sendPidPort) <- expectTriple
687+
spawnIt p supervisor sendPidPort
688+
689+
spawnIt :: Process ()
690+
-> ProcessId
691+
-> SendPort ProcessId
692+
-> Process ()
693+
spawnIt proc' supervisor sendPidPort = do
694+
supervisedPid <- spawnLocal $ do
695+
link supervisor
696+
self <- getSelfPid
697+
(proc' `catches` [ Handler $ filterInitFailures supervisor self
698+
, Handler $ logFailure supervisor self ])
699+
`catchesExit` [\_ m -> handleMessageIf m (== ExitShutdown)
700+
(\_ -> return ())]
701+
sendChan sendPidPort supervisedPid
696702

697703
instance (Resolvable a) => ToChildStart (SupervisorPid -> Process a) where
698704
toChildStart proc = do
699-
starterPid <- spawnLocal $ do
700-
-- see note [linking] in the previous instance (above)
701-
(supervisor, _, sendPidPort) <- expectTriple
702-
link supervisor
703-
injectIt proc supervisor sendPidPort >> injectorLoop proc
704-
return $ StarterProcess starterPid
705-
706-
injectorLoop :: Resolvable a
707-
=> (SupervisorPid -> Process a)
708-
-> Process ()
709-
injectorLoop p = forever' $ do
710-
(supervisor, _, sendPidPort) <- expectTriple
711-
injectIt p supervisor sendPidPort
712-
713-
injectIt :: Resolvable a
714-
=> (SupervisorPid -> Process a)
715-
-> ProcessId
716-
-> SendPort ProcessId
717-
-> Process ()
718-
injectIt proc' supervisor sendPidPort = do
719-
addr <- proc' supervisor
720-
mPid <- resolve addr
721-
case mPid of
722-
Nothing -> die "UnresolvableAddress"
723-
Just p -> sendChan sendPidPort p
724-
725-
expectTriple :: Process (ProcessId, ChildKey, SendPort ProcessId)
726-
expectTriple = expect
705+
starterPid <- spawnLocal $ do
706+
-- see note [linking] in the previous instance (above)
707+
(supervisor, _, sendPidPort) <- expectTriple
708+
link supervisor
709+
injectIt proc supervisor sendPidPort >> injectorLoop proc
710+
return $ StarterProcess starterPid
711+
where
712+
injectorLoop :: Resolvable a
713+
=> (SupervisorPid -> Process a)
714+
-> Process ()
715+
injectorLoop p = forever' $ do
716+
(supervisor, _, sendPidPort) <- expectTriple
717+
injectIt p supervisor sendPidPort
718+
719+
injectIt :: Resolvable a
720+
=> (SupervisorPid -> Process a)
721+
-> ProcessId
722+
-> SendPort ProcessId
723+
-> Process ()
724+
injectIt proc' supervisor sendPidPort = do
725+
addr <- proc' supervisor
726+
mPid <- resolve addr
727+
case mPid of
728+
Nothing -> die "UnresolvableAddress"
729+
Just p -> sendChan sendPidPort p
727730

728731
-- internal APIs
729732

0 commit comments

Comments
 (0)