urbit/shrub
1
1
Fork 0
mirror of https://github.com/urbit/shrub.git synced 2024-12-19 00:13:12 +03:00
Code Issues Packages Projects Releases Wiki Activity

king: Support running multiple ships at the same time.

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
pkg/hs/urbit-king/lib/Urbit/King/Main.hs
View File

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

2
pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs
View File

@ -253,7 +253,7 @@ pier (serf, log, ss) mStart = do
atomically ded >>= \case
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")