Fix sharing stdout Chan with multiple threads

This commit is contained in:
Daniel Gröber 2015-09-16 05:09:35 +02:00
parent 7e565df923
commit 413bac085d

View File

@ -78,14 +78,17 @@ withGhcModEnv' withCradle dir opts f =
runGmOutT :: IOish m => Options -> GmOutT m a -> m a runGmOutT :: IOish m => Options -> GmOutT m a -> m a
runGmOutT opts ma = do runGmOutT opts ma = do
gmo <- GhcModOut (optOutput opts) <$> liftIO newChan gmo@GhcModOut{..} <- GhcModOut (optOutput opts) <$> liftIO newChan
runGmOutT' gmo ma let action = runGmOutT' gmo ma
case ooptLinePrefix $ optOutput opts of
Nothing -> action
Just pfxs ->
gbracket_ (liftIO $ forkIO $ stdoutGateway pfxs gmoChan)
(const $ liftIO $ flushStdoutGateway gmoChan)
action
runGmOutT' :: IOish m => GhcModOut -> GmOutT m a -> m a runGmOutT' :: IOish m => GhcModOut -> GmOutT m a -> m a
runGmOutT' gmo@(gmoChan -> chan) ma = do runGmOutT' gmo ma = flip runReaderT gmo $ unGmOutT ma
gbracket_ (liftIO $ forkIO $ stdoutGateway chan)
(const $ liftIO $ flushStdoutGateway chan)
(flip runReaderT gmo $ unGmOutT ma)
-- | Run a @GhcModT m@ computation. -- | Run a @GhcModT m@ computation.
runGhcModT :: (IOish m, GmOut m) runGhcModT :: (IOish m, GmOut m)