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

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
--------------------------------------------------------------------------------

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")