From dd496bf517a65b06eee2d2ed35613d23bb8cf270 Mon Sep 17 00:00:00 2001
From: Jens Nolte <jens@nightmarestudio.de>
Date: Wed, 20 Nov 2019 12:53:54 +0100
Subject: [PATCH] Pass click event data to event handler
---
src/QBar/Core.hs | 9 +++++----
src/QBar/Server.hs | 26 +++++++++++++-------------
2 files changed, 18 insertions(+), 17 deletions(-)
diff --git a/src/QBar/Core.hs b/src/QBar/Core.hs
index 97c3875..6998dd2 100644
--- a/src/QBar/Core.hs
+++ b/src/QBar/Core.hs
@@ -31,13 +31,14 @@ import Data.Colour.RGBSpace
data Block = Block {
values :: HM.HashMap T.Text T.Text,
- clickAction :: Maybe (IO ())
+ clickAction :: Maybe (Click -> IO ())
}
instance Show Block where
show Block{values} = show values
data Click = Click {
- name :: T.Text
+ name :: T.Text,
+ button :: Int
} deriving Show
$(deriveJSON defaultOptions ''Click)
@@ -170,8 +171,8 @@ sharedInterval barUpdateChannel seconds = do
clickAction = Just (updateClickHandler result)
}
where
- updateClickHandler :: Block -> IO ()
- updateClickHandler block = do
+ updateClickHandler :: Block -> Click -> IO ()
+ updateClickHandler block _ = do
-- Give user feedback that the block is updating
let outdatedBlock = setColor updatingColor $ removePango block
void $ atomically $ send output $ outdatedBlock
diff --git a/src/QBar/Server.hs b/src/QBar/Server.hs
index 0e8e76f..6fc85c1 100644
--- a/src/QBar/Server.hs
+++ b/src/QBar/Server.hs
@@ -28,7 +28,7 @@ import System.IO (stdin, stdout, stderr, hFlush, hPutStrLn)
import System.Posix.Signals
data Handle = Handle {
- handleActionList :: IORef [(T.Text, IO ())],
+ handleActionList :: IORef [(T.Text, Click -> IO ())],
handleActiveFilter :: IORef Filter
}
@@ -91,9 +91,9 @@ renderLine MainOptions{verbose} Handle{handleActionList} blockFilter blocks prev
return encodedOutput
where
- clickActionList :: [(T.Text, IO ())]
+ clickActionList :: [(T.Text, Click -> IO ())]
clickActionList = mapMaybe getClickAction blocks
- getClickAction :: Block -> Maybe (T.Text, IO ())
+ getClickAction :: Block -> Maybe (T.Text, Click -> IO ())
getClickAction block = if hasBlockName && hasClickAction then Just (fromJust maybeBlockName, fromJust maybeClickAction) else Nothing
where
maybeBlockName = getBlockName block
@@ -106,7 +106,7 @@ createBarUpdateChannel = do
event <- Event.newSet
return (BarUpdateChannel $ Event.set event, event)
-handleStdin :: MainOptions -> IORef [(T.Text, IO ())] -> IO ()
+handleStdin :: MainOptions -> IORef [(T.Text, Click -> IO ())] -> IO ()
handleStdin options actionListIORef = forever $ do
line <- BSSC8.hGetLine stdin
@@ -116,17 +116,17 @@ handleStdin options actionListIORef = forever $ do
BSSC8.hPutStrLn stderr line
hFlush stderr
- clickActionList <- readIORef actionListIORef
- let maybeParsedClick = decode $ removeComma $ BS.fromStrict line
- let clickAction' = getClickAction clickActionList maybeParsedClick
- async (fromMaybe (return ()) clickAction') >>= link
+ let maybeClick = decode $ removeComma $ BS.fromStrict line
+ case maybeClick of
+ Just click -> do
+ clickActionList <- readIORef actionListIORef
+ let clickAction' = getClickAction clickActionList click
+ async ((fromMaybe discard clickAction') click) >>= link
+ Nothing -> return ()
where
- getClickAction :: [(T.Text, IO ())] -> Maybe Click -> Maybe (IO ())
- getClickAction clickActionList maybeParsedClick = do
- parsedClick <- maybeParsedClick
- let blockName = name parsedClick
- lookup blockName clickActionList
+ getClickAction :: [(T.Text, Click -> IO ())] -> Click -> Maybe (Click -> IO ())
+ getClickAction clickActionList click = lookup (name click) clickActionList
removeComma :: C8.ByteString -> C8.ByteString
removeComma line
| C8.head line == ',' = C8.tail line
--
GitLab