Make king shutdown cleanly on a new line.

This makes canceling the persistance thread not rethrow an exception
which kills the process, and makes the terminal driver write one
final newline before giving control back to the terminal so the
bash prompt writes to its own line.
This commit is contained in:
Elliot Glaysher 2019-09-17 13:37:41 -07:00
parent 721945d1ba
commit 7c6a3c2300
2 changed files with 15 additions and 16 deletions

View File

@ -7,18 +7,18 @@ module Vere.Pier
import UrbitPrelude
import Arvo
import Vere.Pier.Types
import System.Random
import Vere.Pier.Types
import System.Directory (createDirectoryIfMissing)
import System.Posix.Files (ownerModes, setFileMode)
import Vere.Ames (ames)
import Vere.Behn (behn)
import Vere.Clay (clay)
import Vere.Http.Client (client)
import Vere.Http.Server (serv)
import Vere.Log (EventLog)
import Vere.Serf (Serf, sStderr, SerfState(..), doJob)
import Vere.Clay (clay)
import Vere.Serf (Serf, SerfState(..), doJob, sStderr)
import Vere.Term
import qualified System.Entropy as Ent
@ -329,16 +329,14 @@ instance Exception PersistExn where
, "\tExpected " <> show expected <> " but got " <> show got
]
runPersist :: EventLog
runPersist :: e. HasLogFunc e
=> EventLog
-> TQueue (Job, FX)
-> (FX -> STM ())
-> RAcquire e (Async ())
runPersist log inpQ out =
mkRAcquire runThread cancelWait
mkRAcquire runThread cancel
where
cancelWait :: Async () -> RIO e ()
cancelWait tid = cancel tid >> wait tid
runThread :: RIO e (Async ())
runThread = asyncBound $ forever $ do
writs <- atomically getBatchFromQueue

View File

@ -55,7 +55,8 @@ data TerminalSystem e = TerminalSystem
data Private = Private
{ pReaderThread :: Async ()
, pWriterThread :: Async ()
, pPreviousConfiguration :: TerminalAttributes
, pTerminal :: Terminal
, pPreviousConfiguration :: TerminalAttributes
}
-- Utils -----------------------------------------------------------------------
@ -101,11 +102,11 @@ initializeLocalTerminal = do
start = do
-- Initialize the writing side of the terminal
--
t <- io $ setupTermFromEnv
pTerminal <- io $ setupTermFromEnv
-- TODO: We still need to actually get the size from the terminal somehow.
tsWriteQueue <- newTQueueIO
pWriterThread <- asyncBound (writeTerminal t tsWriteQueue)
pWriterThread <- asyncBound (writeTerminal pTerminal tsWriteQueue)
pPreviousConfiguration <- io $ getTerminalAttributes stdInput
@ -134,8 +135,11 @@ initializeLocalTerminal = do
-- can't kill. If we were to cancel here, the internal `waitCatch` would
-- block until the next piece of keyboard input. Since this only happens
-- at shutdown, just leak the file descriptor.
cancel pWriterThread
-- inject one final newline, as we're usually on the prompt.
io $ runTermOutput pTerminal $ termText "\r\n"
-- take the terminal out of raw mode
io $ setTerminalAttributes stdInput pPreviousConfiguration Immediately
@ -356,15 +360,12 @@ term TerminalSystem{..} shutdownSTM pierPath king enqueueEv =
runTerm :: RAcquire e (EffCb e TermEf)
runTerm = do
tim <- mkRAcquire start stop
tim <- mkRAcquire start cancel
pure handleEffect
start :: RIO e (Async ())
start = async readBelt
stop :: Async () -> RIO e ()
stop rb = cancel rb
readBelt :: RIO e ()
readBelt = forever $ do
b <- atomically $ readTQueue tsReadQueue