From 85467aaf5f5cec1809443224a9a679beffe5a8b6 Mon Sep 17 00:00:00 2001
From: Benjamin Koch <snowball@c3pb.de>
Date: Wed, 16 Dec 2020 03:40:52 +0100
Subject: [PATCH] Refactor qubesMonitorPropertyBlock: extract
pipeBlockWithEvents
---
src/QBar/Blocks/Qubes.hs | 31 ++++++++++++++++++-------------
1 file changed, 18 insertions(+), 13 deletions(-)
diff --git a/src/QBar/Blocks/Qubes.hs b/src/QBar/Blocks/Qubes.hs
index 2ece1ca..a88cd67 100644
--- a/src/QBar/Blocks/Qubes.hs
+++ b/src/QBar/Blocks/Qubes.hs
@@ -43,10 +43,10 @@ diskUsageQubesBlock = runPollBlock $ forever $ do
((unit, factor) : _) -> T.pack (show $ size `div` factor) <> unit
_ -> T.pack (show size) <> " bytes"
-qubesMonitorPropertyBlock :: BL.ByteString -> Block
-qubesMonitorPropertyBlock name = do
+pipeBlockWithEvents :: forall a. Producer a (P.SafeT IO) () -> (Either BlockEvent a -> BarIO (Maybe BlockOutput)) -> Block
+pipeBlockWithEvents prod block = do
(output, input) <- liftIO $ spawn $ newest 1
- forkSafeEffect $ qubesMonitorProperty qubesEvents name >-> P.map Right >-> toOutput output
+ forkSafeEffect $ prod >-> P.map Right >-> toOutput output
toExitBlock $ fromInput input >-> forever (update output)
where
forkSafeEffect :: MonadIO m => Effect (P.SafeT IO) () -> m ()
@@ -57,20 +57,25 @@ qubesMonitorPropertyBlock name = do
toExitBlock = fmap (const ExitBlock)
- decode = decodeUtf8With lenientDecode
-
+ update :: Output (Either (BlockOutput, BlockEvent) a) -> Pipe (Either (BlockOutput, BlockEvent) a) (BlockState, BlockUpdateReason) BarIO ()
update output = await >>= \case
- Right prop -> update' prop
- Left blockOutput -> do
+ Right prop -> update' $ Right prop
+ Left (blockOutput, event) -> do
let state = Just (blockOutput, Nothing)
yield (invalidateBlockState state, EventUpdate)
- prop <- liftIO (qubesGetProperty name)
- update' prop
+ update' $ Left event
where
+ update' :: Either BlockEvent a -> P.Pipe b BlockUpdate BarIO ()
update' prop = do
- let QubesPropertyInfo {propValue, propIsDefault} = prop
- let blockOutput = mkBlockOutput $ normalText $ decode propValue <> (if propIsDefault then " (D)" else "")
+ Just blockOutput <- lift $ block prop
pushBlockUpdate' (handleClick blockOutput) blockOutput
- handleClick blockOutput _ = do
- forkEffect $ yield (Left blockOutput) >-> toOutput output
+ handleClick blockOutput event = do
+ forkEffect $ yield (Left (blockOutput, event)) >-> toOutput output
+
+qubesMonitorPropertyBlock :: BL.ByteString -> Block
+qubesMonitorPropertyBlock name = pipeBlockWithEvents (qubesMonitorProperty qubesEvents name) handle
+ where
+ handle = handle' <=< either (const $ liftIO $ qubesGetProperty name) return
+ handle' QubesPropertyInfo {propValue, propIsDefault} = return $ Just $ mkBlockOutput $ normalText $ decode propValue <> (if propIsDefault then " (D)" else "")
+ decode = decodeUtf8With lenientDecode
--
GitLab