diff --git a/src/QBar/BlockOutput.hs b/src/QBar/BlockOutput.hs new file mode 100644 index 0000000000000000000000000000000000000000..d20ac35a3d99d8c9b386e235314c0bec952273f6 --- /dev/null +++ b/src/QBar/BlockOutput.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE TemplateHaskell #-} + +module QBar.BlockOutput where + +import QBar.BlockText + +import Control.Lens +import Data.Aeson.TH +import qualified Data.Text.Lazy as T + +data BlockOutput = BlockOutput + { _fullText :: BlockText + , _shortText :: Maybe BlockText + , _blockName :: Maybe T.Text + , _invalid :: Bool + } +$(deriveJSON defaultOptions ''BlockOutput) +makeLenses ''BlockOutput + + +mkBlockOutput :: BlockText -> BlockOutput +mkBlockOutput text = BlockOutput + { _fullText = text + , _shortText = Nothing + , _blockName = Nothing + , _invalid = False + } + +mkErrorOutput :: T.Text -> BlockOutput +mkErrorOutput = mkBlockOutput . importantText criticalImportant + +emptyBlock :: BlockOutput +emptyBlock = mkBlockOutput mempty + +addIcon :: T.Text -> BlockOutput -> BlockOutput +addIcon icon = over fullText $ (<>) . normalText $ icon <> " " + diff --git a/src/QBar/Blocks/Battery.hs b/src/QBar/Blocks/Battery.hs index 7dcd5ec954897bb175997835b3f3d6d509d3ac4f..7c0ece858ec4cd3c8061c30c500ef183d9091f7a 100644 --- a/src/QBar/Blocks/Battery.hs +++ b/src/QBar/Blocks/Battery.hs @@ -5,6 +5,7 @@ module QBar.Blocks.Battery where import QBar.Core hiding (name) +import QBar.BlockOutput import QBar.BlockText import Pipes @@ -86,7 +87,7 @@ batteryBlock = do updateBatteryBlock :: Bool -> [BatteryState] -> Block () updateBatteryBlock _ [] = yield Nothing -updateBatteryBlock isPlugged bs = updateBlock $ (shortText.~shortText') $ createBlock fullText' +updateBatteryBlock isPlugged bs = updateBlock $ (shortText.~shortText') $ mkBlockOutput fullText' where fullText' :: BlockText fullText' = normalText (batteryIcon <> " ") <> overallPercentage <> optionalEachBattery <> optionalOverallEstimate diff --git a/src/QBar/Blocks/Date.hs b/src/QBar/Blocks/Date.hs index d47cd721c5f49f85587286d0a622bc4952b2f522..bfbff2a045fe871143bff42481772c9d16de0db9 100644 --- a/src/QBar/Blocks/Date.hs +++ b/src/QBar/Blocks/Date.hs @@ -1,8 +1,9 @@ module QBar.Blocks.Date where +import QBar.BlockOutput +import QBar.BlockText import QBar.Core import QBar.Time -import QBar.BlockText import qualified Data.Text.Lazy as T import Data.Time.Format @@ -24,4 +25,4 @@ dateBlockOutput = do let date = T.pack (formatTime defaultTimeLocale "%a %F" zonedTime) let time = T.pack (formatTime defaultTimeLocale "%R" zonedTime) let text = normalText ("📅\xFE0E " <> date <> " ") <> activeText time - return $ blockName ?~ "date" $ createBlock text + return $ blockName ?~ "date" $ mkBlockOutput text diff --git a/src/QBar/ControlSocket.hs b/src/QBar/ControlSocket.hs index e64fc638c4190c0ac41d3ac5d331e63ecc49a69d..1c1b7a6d85e2fa3b4a5cd9bfabbc3589ed58c24e 100644 --- a/src/QBar/ControlSocket.hs +++ b/src/QBar/ControlSocket.hs @@ -7,6 +7,7 @@ import QBar.Cli (MainOptions(..)) import QBar.Core -- TODO: remove dependency? import QBar.Filter +import QBar.BlockOutput import QBar.BlockText import Control.Exception (handle) @@ -17,6 +18,8 @@ import Control.Concurrent.Async import Control.Concurrent.STM.TChan (TChan, writeTChan) import Data.Aeson.TH import Data.ByteString (ByteString) +import System.FilePath ((</>)) +import System.IO import Data.Either (either) import Data.Maybe (maybe) import Data.Text.Lazy (Text, pack) @@ -30,9 +33,6 @@ import Pipes.Aeson.Unchecked (encode) import Pipes.Network.TCP (fromSocket, toSocket) import System.Directory (removeFile, doesFileExist) import System.Environment (getEnv) -import System.FilePath ((</>)) -import System.IO - type CommandChan = TChan Command data Command = SetFilter Filter @@ -128,5 +128,5 @@ handleBlockStream producer = do where handleParsedBlock :: Producer ByteString IO () -> String -> PushBlock handleParsedBlock leftovers update = do - updateBlock $ createBlock . normalText $ TL.pack update + updateBlock $ mkBlockOutput . normalText $ TL.pack update handleBlockStream leftovers diff --git a/src/QBar/Core.hs b/src/QBar/Core.hs index 359daf0df406f7c67e10938cd3024439548aa967..5404966853a7e56d339960897609e92ff924095f 100644 --- a/src/QBar/Core.hs +++ b/src/QBar/Core.hs @@ -3,16 +3,18 @@ module QBar.Core where +import QBar.BlockOutput import QBar.BlockText -import Control.Exception (IOException) -import Control.Monad (forever) -import Control.Monad.Reader (ReaderT, runReaderT, ask) import Control.Concurrent (threadDelay) import Control.Concurrent.Async import Control.Concurrent.Event as Event import Control.Concurrent.MVar import Control.Concurrent.STM.TChan (TChan, writeTChan) +import Control.Exception (IOException) +import Control.Lens +import Control.Monad (forever) +import Control.Monad.Reader (ReaderT, runReaderT, ask) import Data.Aeson.TH import qualified Data.ByteString.Lazy.Char8 as C8 import Data.Int (Int64) @@ -28,7 +30,6 @@ import System.Exit import System.IO import System.Process.Typed (Process, shell, setStdin, setStdout, getStdout, closed, createPipe, readProcessStdout, startProcess, stopProcess) -import Control.Lens data BlockEvent = Click { @@ -37,14 +38,6 @@ data BlockEvent = Click { } deriving Show $(deriveJSON defaultOptions ''BlockEvent) -data BlockOutput = BlockOutput - { _fullText :: BlockText - , _shortText :: Maybe BlockText - , _blockName :: Maybe T.Text - , _invalid :: Bool - } -$(deriveJSON defaultOptions ''BlockOutput) - data PushMode = PushMode data PullMode = PullMode @@ -84,7 +77,6 @@ data Bar = Bar { requestBarUpdate :: IO (), newBlockChan :: TChan CachedBlock } -makeLenses ''BlockOutput instance IsBlock PushBlock where toCachedBlock = cachePushBlock @@ -114,23 +106,6 @@ runBarIO bar action = runReaderT (runSafeT action) bar askBar :: BarIO Bar askBar = lift ask -createBlock :: BlockText -> BlockOutput -createBlock text = BlockOutput - { _fullText = text - , _shortText = Nothing - , _blockName = Nothing - , _invalid = False - } - -createErrorBlock :: T.Text -> BlockOutput -createErrorBlock = createBlock . importantText criticalImportant - -emptyBlock :: BlockOutput -emptyBlock = createBlock mempty - -addIcon :: T.Text -> BlockOutput -> BlockOutput -addIcon icon = over fullText $ (<>) . normalText $ icon <> " " - modify :: (BlockOutput -> BlockOutput) -> Pipe BlockState BlockState BarIO r modify x = PP.map (over (_Just . _1) x) @@ -252,9 +227,9 @@ blockScript path = forever $ updateBlock =<< (lift blockScriptAction) (text:short:_) -> shortText ?~ pangoText short $ createScriptBlock text (text:_) -> createScriptBlock text [] -> createScriptBlock "-" - (ExitFailure nr) -> return $ createErrorBlock $ "[" <> T.pack (show nr) <> "]" + (ExitFailure nr) -> return $ mkErrorOutput $ "[" <> T.pack (show nr) <> "]" createScriptBlock :: T.Text -> BlockOutput - createScriptBlock text = blockName ?~ T.pack path $ createBlock . pangoText $ text + createScriptBlock text = blockName ?~ T.pack path $ mkBlockOutput . pangoText $ text startPersistentBlockScript :: FilePath -> PushBlock -- The outer catchP only catches errors that occur during process creation @@ -262,7 +237,7 @@ startPersistentBlockScript path = catchP startScriptProcess handleError where handleError :: IOException -> PushBlock handleError e = do - updateBlock . createErrorBlock $ "[" <> T.pack (show e) <> "]" + updateBlock . mkErrorOutput $ "[" <> T.pack (show e) <> "]" exitBlock handleErrorWithProcess :: (Process i o e) -> IOException -> PushBlock handleErrorWithProcess process e = do @@ -278,7 +253,7 @@ startPersistentBlockScript path = catchP startScriptProcess handleError blockFromHandle :: Handle -> PushBlock blockFromHandle handle = forever $ do line <- liftIO $ TIO.hGetLine handle - updateBlock $ createBlock . pangoText $ line + updateBlock $ mkBlockOutput . pangoText $ line lift updateBar addBlock :: IsBlock a => a -> BarIO () diff --git a/src/QBar/DefaultConfig.hs b/src/QBar/DefaultConfig.hs index a004be87ba2d443914189ebbb66666f21ba24fca..5c0d61393387e8cefa64fcec035bec1ba8ba27ba 100644 --- a/src/QBar/DefaultConfig.hs +++ b/src/QBar/DefaultConfig.hs @@ -1,6 +1,7 @@ module QBar.DefaultConfig where import QBar.Blocks +import QBar.BlockOutput import QBar.Core import Pipes diff --git a/src/QBar/Filter.hs b/src/QBar/Filter.hs index 699261728a0f23d8e8a1f1fa4366699bcd11e87d..eef1b644658f8ec8f21014017e4fb3f52c1c3dbe 100644 --- a/src/QBar/Filter.hs +++ b/src/QBar/Filter.hs @@ -2,7 +2,7 @@ module QBar.Filter where -import QBar.Core +import QBar.BlockOutput import QBar.BlockText import Control.Monad.State.Lazy (State, evalState, get, put) diff --git a/src/QBar/Server.hs b/src/QBar/Server.hs index ad918d4b806415cb0e6c072b69bcfb7735c2f5e9..f466972da4b9f686b955b537ffb34564a5144456 100644 --- a/src/QBar/Server.hs +++ b/src/QBar/Server.hs @@ -1,6 +1,7 @@ module QBar.Server where import QBar.Blocks +import QBar.BlockOutput import QBar.BlockText import QBar.Core import QBar.Cli @@ -36,7 +37,7 @@ data Handle = Handle { renderIndicator :: CachedBlock -- Using 'cachedBlock' is a hack to actually get the block to update on every bar update (by doing this it will not get a cache later in the pipeline). -renderIndicator = forever $ each $ map (mkBlockState . createBlock . normalText) ["/", "-", "\\", "|"] +renderIndicator = forever $ each $ map (mkBlockState . mkBlockOutput . normalText) ["/", "-", "\\", "|"] runBlock :: CachedBlock -> BarIO (Maybe (BlockState, CachedBlock)) runBlock producer = do @@ -183,7 +184,7 @@ renderInitialBlocks options handle blockFilter = do date <- dateBlockOutput let initialBlocks = [mkBlockState date] -- Attach spinner indicator when verbose flag is set - let initialBlocks' = if indicator options then initialBlocks <> [mkBlockState $ createBlock . normalText $ "*"] else initialBlocks + let initialBlocks' = if indicator options then initialBlocks <> [mkBlockState $ mkBlockOutput . normalText $ "*"] else initialBlocks -- Render initial time block so the bar is not empty after startup renderLine options handle blockFilter initialBlocks' "" diff --git a/src/QBar/Themes.hs b/src/QBar/Themes.hs index 09728fc5da5477028749abeb20b436bc2ec2db15..16cfdc218ea70f442789939afd1a39f4b6dbd722 100644 --- a/src/QBar/Themes.hs +++ b/src/QBar/Themes.hs @@ -1,8 +1,7 @@ module QBar.Themes where - +import QBar.BlockOutput import QBar.BlockText -import QBar.Core import qualified Data.Text.Lazy as T