diff --git a/src/QBar/Core.hs b/src/QBar/Core.hs index 7e6687e2d5b3f5c4f81c31af7d0cf84e759113a8..83cff690a605493f10fa557c8d5bcb9f0bee4614 100644 --- a/src/QBar/Core.hs +++ b/src/QBar/Core.hs @@ -88,6 +88,9 @@ data BarUpdateChannel = BarUpdateChannel (IO ()) type BarUpdateEvent = Event.Event +runBarIO :: Bar -> BarIO r -> IO r +runBarIO bar action = runReaderT action bar + createBlock :: BlockText -> BlockOutput createBlock text = BlockOutput { _fullText = text @@ -151,7 +154,7 @@ sharedInterval seconds = do -- Updates all client blocks -- If send returns 'False' the clients mailbox has been closed, so it is removed bar <- ask - liftIO $ modifyMVar_ clientsMVar $ fmap catMaybes . mapConcurrently (\r -> runReaderT (runAndFilterClient r) bar) + liftIO $ modifyMVar_ clientsMVar $ fmap catMaybes . mapConcurrently (\r -> runBarIO bar $ runAndFilterClient r) -- Then update the bar updateBar diff --git a/src/QBar/Server.hs b/src/QBar/Server.hs index 88a1e7e4f13b0cb20edffbf88aa36608e464af47..3e554ea421da926a6624b9dde0f4865ca0aa6cd7 100644 --- a/src/QBar/Server.hs +++ b/src/QBar/Server.hs @@ -9,7 +9,7 @@ import QBar.BlockText import QBar.Themes import Control.Monad (forever, when, unless) -import Control.Monad.Reader (runReaderT, ask) +import Control.Monad.Reader (ask) import Control.Monad.STM (atomically) import Control.Concurrent (threadDelay, forkFinally) import Control.Concurrent.Async @@ -154,7 +154,7 @@ handleStdin options actionListIORef = do clickActionList <- readIORef actionListIORef let maybeClickAction = getClickAction clickActionList click case maybeClickAction of - Just clickAction' -> async (runReaderT (clickAction' click) bar) >>= link + Just clickAction' -> async (runBarIO bar (clickAction' click)) >>= link Nothing -> return () Nothing -> return () @@ -214,13 +214,13 @@ runBarConfiguration defaultBarConfig options = do -- Fork stdin handler - void $ forkFinally (runReaderT (handleStdin options actionList) bar) (\result -> hPutStrLn stderr $ "handleStdin failed: " <> show result) + void $ forkFinally (runBarIO bar (handleStdin options actionList)) (\result -> hPutStrLn stderr $ "handleStdin failed: " <> show result) - runReaderT loadBlocks bar + runBarIO bar loadBlocks -- Install signal handler for SIGCONT - runReaderT installSignalHandlers bar + runBarIO bar installSignalHandlers -- Create control socket commandChan <- createCommandChan @@ -236,7 +236,7 @@ runBarConfiguration defaultBarConfig options = do updateBar' bar link socketUpdateAsync - runReaderT (renderLoop options handle barUpdateEvent initialOutput newBlockChan) bar + runBarIO bar (renderLoop options handle barUpdateEvent initialOutput newBlockChan) where loadBlocks :: BarIO () loadBlocks = do