From c6a549a3526a215685d0b7c835e28a2a9e79aa36 Mon Sep 17 00:00:00 2001
From: Jens Nolte <jens@nightmarestudio.de>
Date: Wed, 18 Dec 2019 21:13:07 +0100
Subject: [PATCH] Add runBarIO
---
src/QBar/Core.hs | 5 ++++-
src/QBar/Server.hs | 12 ++++++------
2 files changed, 10 insertions(+), 7 deletions(-)
diff --git a/src/QBar/Core.hs b/src/QBar/Core.hs
index 7e6687e..83cff69 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 88a1e7e..3e554ea 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
--
GitLab