0434f9c · vty · git.iko.soy

git.iko.soy/vty

on master help sign in

Use killThread and an MVar to assure input processing is stopped when shutdown returns. #77

0434f9cCorey O'Connor11 years ago

CHANGELOG+5

compare with master

unifiedsplit

@@ -4,6 +4,11 @@

4 attribute would extend to the next start of content. This was odd to reason about and was the

5 cause of https://github.com/coreyoconnor/vty/issues/76

6 IIRC Yi requires the old behavior to display the selection region correctly.

7+ - shutdown of the input thread is now performed using killThread and synchronization on an MVar.

8+ For correct handling of the terminal read vmin and vtime the read must be a blocking read on an

9+ OS thread. This places a threadWaitRead, which will be interrupted by the killThread, prior to

10+ the uninterruptable read. An alternative would be to re-import the read foreign call as

11+ interruptable.

85.2.11

135.2.11

9 - deepseq bounds increased for tests.

14 - deepseq bounds increased for tests.

src/Graphics/Vty/Input/Loop.hs+22−14

@@ -19,6 +19,8 @@ import Graphics.Vty.Input.Events

20import Control.Applicative

21import Control.Concurrent

22+import Control.Concurrent.MVar

23+import Control.Exception (mask, try, SomeException)

22import Control.Lens

24import Control.Lens

23import Control.Monad (when, mzero, forM_)

25import Control.Monad (when, mzero, forM_)

24import Control.Monad.IO.Class (liftIO)

26import Control.Monad.IO.Class (liftIO)

@@ -65,7 +67,6 @@ data InputState = InputState

65 { _unprocessedBytes :: String

67 { _unprocessedBytes :: String

66 , _appliedConfig :: Config

68 , _appliedConfig :: Config

67 , _inputBuffer :: InputBuffer

69 , _inputBuffer :: InputBuffer

68− , _stopRequestRef :: IORef Bool

69 , _classifier :: String -> KClass

70 , _classifier :: String -> KClass

70 }

71 }

@@ -88,7 +89,7 @@ loopInputProcessor = do

88 validEvents <- many parseEvent

89 validEvents <- many parseEvent

89 forM_ validEvents emit

90 forM_ validEvents emit

90 dropInvalid

91 dropInvalid

91− stopIfRequested <|> loopInputProcessor

92+ loopInputProcessor

93addBytesToProcess :: String -> InputM ()

94addBytesToProcess :: String -> InputM ()

94addBytesToProcess block = unprocessedBytes <>= block

95addBytesToProcess block = unprocessedBytes <>= block

@@ -115,6 +116,11 @@ readFromDevice = do

115 bufferPtr <- use $ inputBuffer.ptr

116 bufferPtr <- use $ inputBuffer.ptr

116 maxBytes <- use $ inputBuffer.size

117 maxBytes <- use $ inputBuffer.size

117 stringRep <- liftIO $ do

118 stringRep <- liftIO $ do

119+ -- The killThread used in shutdownInput will not interrupt the foreign call fdReadBuf uses

120+ -- this provides a location to be interrupted prior to the foreign call. If there is input

121+ -- on the FD then the fdReadBuf will return in a finite amount of time due to the vtime

122+ -- terminal setting.

123+ threadWaitRead fd

118 bytesRead <- fdReadBuf fd bufferPtr (fromIntegral maxBytes)

124 bytesRead <- fdReadBuf fd bufferPtr (fromIntegral maxBytes)

119 if bytesRead > 0

125 if bytesRead > 0

120 then fmap (map $ chr . fromIntegral) $ peekArray (fromIntegral bytesRead) bufferPtr

126 then fmap (map $ chr . fromIntegral) $ peekArray (fromIntegral bytesRead) bufferPtr

@@ -147,18 +153,12 @@ dropInvalid = do

147 logMsg "dropping input bytes"

153 logMsg "dropping input bytes"

148 unprocessedBytes .= []

154 unprocessedBytes .= []

149

155

150−stopIfRequested :: InputM ()

151−stopIfRequested = do

152− True <- (liftIO . readIORef) =<< use stopRequestRef

153− return ()

154−

155−runInputProcessorLoop :: ClassifyMap -> Input -> IORef Bool -> IO ()

156+runInputProcessorLoop :: ClassifyMap -> Input -> IO ()

156−runInputProcessorLoop classifyTable input stopFlag = do

157+runInputProcessorLoop classifyTable input = do

157 let bufferSize = 1024

158 let bufferSize = 1024

158 allocaArray bufferSize $ \(bufferPtr :: Ptr Word8) -> do

159 allocaArray bufferSize $ \(bufferPtr :: Ptr Word8) -> do

159 s0 <- InputState [] <$> readIORef (_configRef input)

160 s0 <- InputState [] <$> readIORef (_configRef input)

160 <*> pure (InputBuffer bufferPtr bufferSize)

161 <*> pure (InputBuffer bufferPtr bufferSize)

161− <*> pure stopFlag

162 <*> pure (classify classifyTable)

163 runReaderT (evalStateT loopInputProcessor s0) input

164

@@ -192,15 +192,23 @@ initInput config classifyTable = do

192 let Just fd = inputFd config

193 setFdOption fd NonBlockingRead False

194 applyConfig fd config

195− stopFlag <- newIORef False

195+ stopSync <- newEmptyMVar

196 input <- Input <$> newChan

197− <*> pure (writeIORef stopFlag True)

197+ <*> pure (return ())

198 <*> newIORef config

199 <*> maybe (return Nothing)

200 (\f -> Just <$> openFile f AppendMode)

201 (debugLog config)

202 logInitialInputState input classifyTable

203− _ <- forkOS $ runInputProcessorLoop classifyTable input stopFlag

203+ inputThread <- forkOSFinally (runInputProcessorLoop classifyTable input)

204+ (\_ -> putMVar stopSync ())

205+ let killAndWait = do

206+ killThread inputThread

207+ takeMVar stopSync

204− return input

208+ return $ input { shutdownInput = killAndWait }

205

209

206foreign import ccall "vty_set_term_timing" setTermTiming :: Fd -> Int -> Int -> IO ()

210foreign import ccall "vty_set_term_timing" setTermTiming :: Fd -> Int -> Int -> IO ()

211+

212+forkOSFinally :: IO a -> (Either SomeException a -> IO ()) -> IO ThreadId

213+forkOSFinally action and_then =

214+ mask $ \restore -> forkOS $ try (restore action) >>= and_then