From eb829644da4887d932e2c6e1f4d7f3c13d9502d3 Mon Sep 17 00:00:00 2001
From: Benjamin Koch <snowball@c3pb.de>
Date: Wed, 16 Dec 2020 03:05:32 +0100
Subject: [PATCH] Add animation on mouse click for qubesProperty block
---
src/QBar/Blocks/Qubes.hs | 21 ++++++++++++++++-----
1 file changed, 16 insertions(+), 5 deletions(-)
diff --git a/src/QBar/Blocks/Qubes.hs b/src/QBar/Blocks/Qubes.hs
index bb9220a..2ece1ca 100644
--- a/src/QBar/Blocks/Qubes.hs
+++ b/src/QBar/Blocks/Qubes.hs
@@ -11,6 +11,7 @@ import Data.Text.Lazy.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import Pipes as P
import Pipes.Concurrent as P
+import qualified Pipes.Prelude as P
import qualified Pipes.Safe as P
diskIcon :: T.Text
@@ -45,7 +46,7 @@ diskUsageQubesBlock = runPollBlock $ forever $ do
qubesMonitorPropertyBlock :: BL.ByteString -> Block
qubesMonitorPropertyBlock name = do
(output, input) <- liftIO $ spawn $ newest 1
- forkSafeEffect $ qubesMonitorProperty qubesEvents name >-> toOutput output
+ forkSafeEffect $ qubesMonitorProperty qubesEvents name >-> P.map Right >-> toOutput output
toExitBlock $ fromInput input >-> forever (update output)
where
forkSafeEffect :: MonadIO m => Effect (P.SafeT IO) () -> m ()
@@ -58,8 +59,18 @@ qubesMonitorPropertyBlock name = do
decode = decodeUtf8With lenientDecode
- update output = do
- QubesPropertyInfo {propValue, propIsDefault} <- await
- trace ("update: " <> show propValue) $ pushBlockUpdate' handleClick $ mkBlockOutput $ normalText $ decode propValue <> (if propIsDefault then " (D)" else "")
+ update output = await >>= \case
+ Right prop -> update' prop
+ Left blockOutput -> do
+ let state = Just (blockOutput, Nothing)
+ yield (invalidateBlockState state, EventUpdate)
+ prop <- liftIO (qubesGetProperty name)
+ update' prop
where
- handleClick _ = forkEffect $ (liftIO (qubesGetProperty name) >>= yield) >-> toOutput output
+ update' prop = do
+ let QubesPropertyInfo {propValue, propIsDefault} = prop
+ let blockOutput = mkBlockOutput $ normalText $ decode propValue <> (if propIsDefault then " (D)" else "")
+ pushBlockUpdate' (handleClick blockOutput) blockOutput
+
+ handleClick blockOutput _ = do
+ forkEffect $ yield (Left blockOutput) >-> toOutput output
--
GitLab