1
1
mirror of https://github.com/urbit/shrub.git synced 2024-12-24 20:47:27 +03:00

king: Support running multiple ships at the same time.

This commit is contained in:
Benjamin Summers 2020-04-30 14:51:28 -07:00
parent 43118dbae3
commit 5bc5819a62
2 changed files with 8 additions and 5 deletions
pkg/hs/urbit-king/lib/Urbit

View File

@ -562,10 +562,13 @@ main = do
CLI.CmdCon pier -> runAppLogFile $ connTerm pier CLI.CmdCon pier -> runAppLogFile $ connTerm pier
runShips :: [(CLI.Run, CLI.Opts, Bool)] -> IO () runShips :: [(CLI.Run, CLI.Opts, Bool)] -> IO ()
runShips [] = pure () runShips = \case
runShips [(r,o,b)] = runShip r o b [] -> pure ()
runShips ships = [(r, o, d)] -> runShip r o d
error ("TODO: Support multiple ships: " <> ppShow ships) ships -> do
threads <- for ships $ \(r, o, _) -> asyncBound (runShip r o True)
atomically $ asum (void . waitCatchSTM <$> threads)
for_ threads cancel
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------

View File

@ -253,7 +253,7 @@ pier (serf, log, ss) mStart = do
atomically ded >>= \case atomically ded >>= \case
Left (txt, exn) -> logError $ displayShow ("Somthing died", txt, exn) Left (txt, exn) -> logError $ displayShow ("Somthing died", txt, exn)
Right tag -> logError $ displayShow ("something simply exited", tag) Right tag -> logError $ displayShow ("Something simply exited", tag)
atomically $ (Term.spin muxed) (Just "shutdown") atomically $ (Term.spin muxed) (Just "shutdown")