From 6922e905a48cdecd7ba01f1f1b8906d75576c326 Mon Sep 17 00:00:00 2001
From: Jan Beinke <git@janbeinke.com>
Date: Fri, 14 Feb 2020 11:32:50 +0100
Subject: [PATCH] Add the class MonadBlock and some basic mtl instances for it

---
 src/QBar/Core.hs | 25 +++++++++++++++++++------
 1 file changed, 19 insertions(+), 6 deletions(-)

diff --git a/src/QBar/Core.hs b/src/QBar/Core.hs
index c08557e..fdbf2e0 100644
--- a/src/QBar/Core.hs
+++ b/src/QBar/Core.hs
@@ -105,14 +105,27 @@ instance (MonadBarIO m, Monoid a) => MonadBarIO (WriterT a m) where
 askBar :: MonadBarIO m => m Bar
 askBar = liftBarIO $ lift ask
 
-mkBlockState :: BlockOutput -> BlockState
-mkBlockState blockOutput = Just (blockOutput, Nothing)
 
-updateBlock :: BlockOutput -> Block ()
-updateBlock blockOutput = yield $ Just (blockOutput, Nothing)
+class (MonadBarIO m) => MonadBlock m where
+  liftBlock :: Block a -> m a
+instance MonadBlock Block where
+  liftBlock = id
+instance (MonadBlock m) => MonadBlock (StateT a m) where
+  liftBlock = lift . liftBlock
+instance (MonadBlock m) => MonadBlock (ReaderT a m) where
+  liftBlock = lift . liftBlock
+instance (MonadBlock m, Monoid a) => MonadBlock (WriterT a m) where
+  liftBlock = lift . liftBlock
+
+updateBlock :: MonadBlock m => BlockOutput -> m ()
+updateBlock blockOutput = liftBlock . yield $ Just (blockOutput, Nothing)
+
+updateBlock' :: MonadBlock m => BlockEventHandler -> BlockOutput -> m ()
+updateBlock' blockEventHandler blockOutput = liftBlock . yield $ Just (blockOutput, Just blockEventHandler)
 
-updateBlock' :: BlockEventHandler -> BlockOutput -> Block ()
-updateBlock' blockEventHandler blockOutput = yield $ Just (blockOutput, Just blockEventHandler)
+
+mkBlockState :: BlockOutput -> BlockState
+mkBlockState blockOutput = Just (blockOutput, Nothing)
 
 updateEventHandler :: BlockEventHandler -> BlockState -> BlockState
 updateEventHandler _ Nothing = Nothing
-- 
GitLab