From 95d4359f7cd56cccb1ce2b9eef47b7a07a5b8d5b Mon Sep 17 00:00:00 2001
From: Jens Nolte <jens@nightmarestudio.de>
Date: Fri, 31 Jan 2020 18:34:13 +0100
Subject: [PATCH] Update askBar to work from Proxy
---
src/QBar/Core.hs | 14 ++++++++++----
1 file changed, 10 insertions(+), 4 deletions(-)
diff --git a/src/QBar/Core.hs b/src/QBar/Core.hs
index f494e5d..c9ec6d7 100644
--- a/src/QBar/Core.hs
+++ b/src/QBar/Core.hs
@@ -87,6 +87,15 @@ data Bar = Bar {
data BarUpdateChannel = BarUpdateChannel (IO ())
type BarUpdateEvent = Event.Event
+
+class MonadBarIO m where
+ askBar :: m Bar
+instance MonadBarIO BarIO where
+ askBar = lift ask
+instance MonadBarIO (Proxy a' a b' b BarIO) where
+ askBar = lift askBar
+
+
mkBlockState :: BlockOutput -> BlockState
mkBlockState blockOutput = Just (blockOutput, Nothing)
@@ -104,9 +113,6 @@ updateEventHandler eventHandler (Just (blockOutput, _)) = Just (blockOutput, Jus
runBarIO :: Bar -> BarIO r -> IO r
runBarIO bar action = runReaderT (runSafeT action) bar
-askBar :: BarIO Bar
-askBar = lift ask
-
modify :: (BlockOutput -> BlockOutput)
-> Pipe BlockState BlockState BarIO r
modify x = PP.map (over (_Just . _1) x)
@@ -152,7 +158,7 @@ sharedInterval seconds = do
-- Updates all client blocks
-- If send returns 'False' the clients mailbox has been closed, so it is removed
bar <- askBar
- liftIO $ modifyMVar_ clientsMVar $ fmap catMaybes . mapConcurrently (\r -> runBarIO bar $ runAndFilterClient r)
+ liftIO $ modifyMVar_ clientsMVar $ fmap catMaybes . mapConcurrently (runBarIO bar . runAndFilterClient)
-- Then update the bar
updateBar
--
GitLab