Skip to content
Snippets Groups Projects
Commit 8a00c483 authored by Jens Nolte's avatar Jens Nolte
Browse files

Implement automatic blockName generation

parent 7bd7d908
No related branches found
No related tags found
No related merge requests found
...@@ -5,6 +5,7 @@ module QBar.Core where ...@@ -5,6 +5,7 @@ module QBar.Core where
import QBar.BlockOutput import QBar.BlockOutput
import QBar.Time import QBar.Time
import QBar.Util
import Control.Concurrent.Async import Control.Concurrent.Async
import Control.Concurrent.Event as Event import Control.Concurrent.Event as Event
...@@ -17,6 +18,7 @@ import Control.Monad.Writer (WriterT) ...@@ -17,6 +18,7 @@ import Control.Monad.Writer (WriterT)
import Data.Aeson.TH import Data.Aeson.TH
import Data.Either (isRight) import Data.Either (isRight)
import Data.Int (Int64) import Data.Int (Int64)
import Data.Maybe (fromMaybe)
import qualified Data.Text.Lazy as T import qualified Data.Text.Lazy as T
import Pipes import Pipes
import Pipes.Concurrent import Pipes.Concurrent
...@@ -242,14 +244,25 @@ newCache'' = do ...@@ -242,14 +244,25 @@ newCache'' = do
-- |Creates a cache from a push block. -- |Creates a cache from a push block.
cachePushBlock :: PushBlock -> BlockCache cachePushBlock :: PushBlock -> BlockCache
cachePushBlock pushBlock = newCache $ () <$ (pushBlock >-> updateBarP) cachePushBlock pushBlock = newCache $ () <$ (pushBlock >-> updateBarP >-> fixBlockName >-> PP.map (\a -> [a]))
where where
updateBarP :: Pipe BlockUpdate [BlockState] BarIO PushMode updateBarP :: Pipe BlockUpdate BlockState BarIO r
updateBarP = forever $ do updateBarP = forever $ do
(state, reason) <- await (state, reason) <- await
yield [state] yield state
updateBar reason updateBar reason
-- |Sets 'blockName' to a random (but static) identifier if an event handler is set but the 'blockName' is not set.
fixBlockName :: Pipe BlockState BlockState BarIO r
fixBlockName = do
defaultBlockName <- randomIdentifier
forever $ do
state <- await
yield $ if hasEventHandler state
then (_Just . _1 . blockName) %~ (Just . fromMaybe defaultBlockName) $ state
else state
modify :: (BlockOutput -> BlockOutput) -> Pipe BlockUpdate BlockUpdate BarIO r modify :: (BlockOutput -> BlockOutput) -> Pipe BlockUpdate BlockUpdate BarIO r
modify x = PP.map (over (_1 . _Just . _1) x) modify x = PP.map (over (_1 . _Just . _1) x)
......
...@@ -6,16 +6,13 @@ import QBar.Core ...@@ -6,16 +6,13 @@ import QBar.Core
import Pipes import Pipes
import Control.Lens
defaultBarConfig :: BarIO () defaultBarConfig :: BarIO ()
defaultBarConfig = do defaultBarConfig = do
let battery = batteryBlock >-> modify (blockName ?~ "battery") let cpuUsage = cpuUsageBlock 1 >-> modify (addIcon "💻\xFE0E")
let cpuUsage = cpuUsageBlock 1 >-> modify ((blockName ?~ "cpuUsage") . addIcon "💻\xFE0E")
-- TODO: commented-out blocks should be added as soon as they are implemented in qbar -- TODO: commented-out blocks should be added as soon as they are implemented in qbar
addBlock dateBlock addBlock dateBlock
addBlock battery addBlock batteryBlock
--addBlock volumeBlock --addBlock volumeBlock
addBlock cpuUsage addBlock cpuUsage
--addBlock ramUsageBlock --addBlock ramUsageBlock
...@@ -30,11 +27,10 @@ legacyBarConfig = do ...@@ -30,11 +27,10 @@ legacyBarConfig = do
let ram = (scriptBlock $ blockLocation "memory") >-> modify (addIcon "🐏\xFE0E") >-> autoPadding let ram = (scriptBlock $ blockLocation "memory") >-> modify (addIcon "🐏\xFE0E") >-> autoPadding
let temperature = (scriptBlock $ blockLocation "temperature") >-> autoPadding let temperature = (scriptBlock $ blockLocation "temperature") >-> autoPadding
let volumeBlock = persistentScriptBlock $ blockLocation "volume-pulseaudio -S -F3" let volumeBlock = persistentScriptBlock $ blockLocation "volume-pulseaudio -S -F3"
let battery = batteryBlock >-> modify (blockName ?~ "battery") let cpuUsage = cpuUsageBlock 1 >-> modify (addIcon "💻\xFE0E")
let cpuUsage = cpuUsageBlock 1 >-> modify ((blockName ?~ "cpuUsage") . addIcon "💻\xFE0E")
addBlock dateBlock addBlock dateBlock
addBlock battery addBlock batteryBlock
addBlock volumeBlock addBlock volumeBlock
addBlock temperature addBlock temperature
addBlock ram addBlock ram
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment