From dd5500053860bc7b288a832e3844166e29e78310 Mon Sep 17 00:00:00 2001 From: Jan Beinke <git@janbeinke.com> Date: Mon, 3 Feb 2020 02:30:36 +0100 Subject: [PATCH] Add a liftBarIO function and make MonadBarIO more generic --- src/QBar/Core.hs | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/src/QBar/Core.hs b/src/QBar/Core.hs index 4d6455e..59104f9 100644 --- a/src/QBar/Core.hs +++ b/src/QBar/Core.hs @@ -87,13 +87,15 @@ newtype BarUpdateChannel = BarUpdateChannel (IO ()) type BarUpdateEvent = Event.Event -class MonadBarIO m where - askBar :: m Bar +class (Monad m) => MonadBarIO m where + liftBarIO :: BarIO a -> m a instance MonadBarIO BarIO where - askBar = lift ask -instance MonadBarIO (Proxy a' a b' b BarIO) where - askBar = lift askBar + liftBarIO = id +instance (MonadBarIO m) => MonadBarIO (Proxy a' a b' b m) where + liftBarIO = lift . liftBarIO +askBar :: MonadBarIO m => m Bar +askBar = liftBarIO $ lift ask mkBlockState :: BlockOutput -> BlockState mkBlockState blockOutput = Just (blockOutput, Nothing) -- GitLab