summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/Plugins/Monitors/Common
diff options
context:
space:
mode:
authorSibi Prabakaran <sibi@psibi.in>2020-06-14 09:46:47 +0530
committerjao <jao@gnu.org>2020-06-23 16:38:20 +0100
commitb4f0f35ef118064bc7829b6224a896b448a37bc4 (patch)
treeccee394fdd32d6bb4d65bf21648cab3b00274883 /src/Xmobar/Plugins/Monitors/Common
parent2b13b5cf6595d81280c95eb9cf507a9817e3f641 (diff)
downloadxmobar-b4f0f35ef118064bc7829b6224a896b448a37bc4.tar.gz
xmobar-b4f0f35ef118064bc7829b6224a896b448a37bc4.tar.bz2
Optimize CPU monitor
Diffstat (limited to 'src/Xmobar/Plugins/Monitors/Common')
-rw-r--r--src/Xmobar/Plugins/Monitors/Common/Output.hs83
-rw-r--r--src/Xmobar/Plugins/Monitors/Common/Parsers.hs39
-rw-r--r--src/Xmobar/Plugins/Monitors/Common/Run.hs21
-rw-r--r--src/Xmobar/Plugins/Monitors/Common/Types.hs76
4 files changed, 218 insertions, 1 deletions
diff --git a/src/Xmobar/Plugins/Monitors/Common/Output.hs b/src/Xmobar/Plugins/Monitors/Common/Output.hs
index 7a14a74..0ac6e95 100644
--- a/src/Xmobar/Plugins/Monitors/Common/Output.hs
+++ b/src/Xmobar/Plugins/Monitors/Common/Output.hs
@@ -1,3 +1,5 @@
+{-#LANGUAGE RecordWildCards#-}
+
------------------------------------------------------------------------------
-- |
-- Module: Xmobar.Plugins.Monitors.Strings
@@ -37,6 +39,10 @@ module Xmobar.Plugins.Monitors.Common.Output ( IconPattern
, parseFloat
, parseInt
, stringParser
+ , pShowPercentsWithColors
+ , pShowPercentBar
+ , pShowVerticalBar
+ , pShowIconPattern
) where
import Data.Char
@@ -44,11 +50,77 @@ import Data.List (intercalate, sort)
import qualified Data.ByteString.Lazy.Char8 as B
import Numeric
import Control.Monad (zipWithM)
-
+import Control.Monad.IO.Class (MonadIO(..))
import Xmobar.Plugins.Monitors.Common.Types
type IconPattern = Int -> String
+pShowVerticalBar :: (MonadIO m) => PureConfig -> Float -> Float -> m String
+pShowVerticalBar p v x = pColorizeString p v [convert $ 100 * x]
+ where convert :: Float -> Char
+ convert val
+ | t <= 9600 = ' '
+ | t > 9608 = chr 9608
+ | otherwise = chr t
+ where t = 9600 + (round val `div` 12)
+
+pShowPercentsWithColors :: (MonadIO m) => PureConfig -> [Float] -> m [String]
+pShowPercentsWithColors p fs =
+ do let fstrs = map (pFloatToPercent p) fs
+ temp = map (*100) fs
+ zipWithM (pShowWithColors p . const) fstrs temp
+
+pShowPercentWithColors :: (MonadIO m) => PureConfig -> Float -> m String
+pShowPercentWithColors p f = fmap head $ pShowPercentsWithColors p [f]
+
+pShowPercentBar :: (MonadIO m) => PureConfig -> Float -> Float -> m String
+pShowPercentBar p@PureConfig{..} v x = do
+ let bb = pBarBack
+ bf = pBarFore
+ bw = pBarWidth
+ let len = min bw $ round (fromIntegral bw * x)
+ s <- pColorizeString p v (take len $ cycle bf)
+ return $ s ++ take (bw - len) (cycle bb)
+
+pShowWithColors :: (Num a, Ord a, MonadIO m) => PureConfig -> (a -> String) -> a -> m String
+pShowWithColors p f x = do
+ let str = pShowWithPadding p (f x)
+ pColorizeString p x str
+
+pColorizeString :: (Num a, Ord a, MonadIO m) => PureConfig -> a -> String -> m String
+pColorizeString p x s = do
+ let h = pHigh p
+ l = pLow p
+ let col = pSetColor p s
+ [ll,hh] = map fromIntegral $ sort [l, h] -- consider high < low
+ pure $ head $ [col pHighColor | x > hh ] ++
+ [col pNormalColor | x > ll ] ++
+ [col pLowColor | True]
+
+pSetColor :: PureConfig -> String -> PSelector (Maybe String) -> String
+pSetColor config str s =
+ do let a = getPConfigValue config s
+ case a of
+ Nothing -> str
+ Just c -> "<fc=" ++ c ++ ">" ++ str ++ "</fc>"
+
+pShowWithPadding :: PureConfig -> String -> String
+pShowWithPadding PureConfig{..} s = let mn = pMinWidth
+ mx = pMaxWidth
+ p = pPadChars
+ pr = pPadRight
+ ellipsis = pMaxWidthEllipsis
+ in padString mn mx p pr ellipsis s
+
+pFloatToPercent :: PureConfig -> Float -> String
+pFloatToPercent PureConfig{..} n = let pad = pPpad
+ pc = pPadChars
+ pr = pPadRight
+ up = pUseSuffix
+ p = showDigits 0 (n * 100)
+ ps = if up then "%" else ""
+ in padString pad pad pc pr "" p ++ ps
+
parseIconPattern :: String -> IconPattern
parseIconPattern path =
let spl = splitOnPercent path
@@ -174,6 +246,15 @@ showIconPattern (Just str) x = return $ str $ convert $ 100 * x
| otherwise = t
where t = round val `div` 12
+pShowIconPattern :: Maybe IconPattern -> Float -> IO String
+pShowIconPattern Nothing _ = return ""
+pShowIconPattern (Just str) x = return $ str $ convert $ 100 * x
+ where convert val
+ | t <= 0 = 0
+ | t > 8 = 8
+ | otherwise = t
+ where t = round val `div` 12
+
showVerticalBar :: Float -> Float -> Monitor String
showVerticalBar v x = colorizeString v [convert $ 100 * x]
where convert :: Float -> Char
diff --git a/src/Xmobar/Plugins/Monitors/Common/Parsers.hs b/src/Xmobar/Plugins/Monitors/Common/Parsers.hs
index 7a813e5..d814349 100644
--- a/src/Xmobar/Plugins/Monitors/Common/Parsers.hs
+++ b/src/Xmobar/Plugins/Monitors/Common/Parsers.hs
@@ -1,3 +1,6 @@
+{-#LANGUAGE RecordWildCards#-}
+{-#LANGUAGE ScopedTypeVariables#-}
+
------------------------------------------------------------------------------
-- |
-- Module: Xmobar.Plugins.Monitors.Parsers
@@ -25,6 +28,10 @@ module Xmobar.Plugins.Monitors.Common.Parsers ( runP
, parseTemplate
, parseTemplate'
, parseOptsWith
+ , templateParser
+ , runExportParser
+ , runTemplateParser
+ , pureParseTemplate
) where
import Xmobar.Plugins.Monitors.Common.Types
@@ -34,6 +41,38 @@ import qualified Data.Map as Map
import System.Console.GetOpt (ArgOrder(Permute), OptDescr, getOpt)
import Text.ParserCombinators.Parsec
+runTemplateParser :: PureConfig -> IO [(String, String, String)]
+runTemplateParser PureConfig{..} = runP templateParser pTemplate
+
+runExportParser :: [String] -> IO [(String, [(String, String,String)])]
+runExportParser [] = pure []
+runExportParser (x:xs) = do
+ s <- runP templateParser x
+ rem <- runExportParser xs
+ pure $ (x,s):rem
+
+pureParseTemplate :: PureConfig -> TemplateInput -> IO String
+pureParseTemplate PureConfig{..} TemplateInput{..} =
+ do let t = pTemplate
+ e = pExport
+ w = pMaxTotalWidth
+ let m = let expSnds :: [([(String, String, String)], String)] = zip (map snd temAllTemplate) temMonitorValues
+ in Map.fromList . zip (map fst temAllTemplate) $ expSnds
+ s <- minCombine m temInputTemplate
+ let (n, s') = if w > 0 && length s > w
+ then trimTo (w - length pMaxTotalWidthEllipsis) "" s
+ else (1, s)
+ return $ if n > 0 then s' else s' ++ pMaxTotalWidthEllipsis
+
+minCombine :: Map.Map String ([(String, String, String)], String) -> [(String, String, String)] -> IO String
+minCombine _ [] = return []
+minCombine m ((s,ts,ss):xs) =
+ do next <- minCombine m xs
+ str <- case Map.lookup ts m of
+ Nothing -> return $ "<" ++ ts ++ ">"
+ Just (s,r) -> let f "" = r; f n = n; in f <$> minCombine m s
+ pure $ s ++ str ++ ss ++ next
+
runP :: Parser [a] -> String -> IO [a]
runP p i =
case parse p "" i of
diff --git a/src/Xmobar/Plugins/Monitors/Common/Run.hs b/src/Xmobar/Plugins/Monitors/Common/Run.hs
index 760eab1..9b0c1b7 100644
--- a/src/Xmobar/Plugins/Monitors/Common/Run.hs
+++ b/src/Xmobar/Plugins/Monitors/Common/Run.hs
@@ -23,6 +23,8 @@ module Xmobar.Plugins.Monitors.Common.Run ( runM
, runMLD
, getArgvs
, doArgs
+ , computePureConfig
+ , commonOptions
) where
import Control.Exception (SomeException,handle)
@@ -33,6 +35,8 @@ import System.Console.GetOpt
import Xmobar.Plugins.Monitors.Common.Types
import Xmobar.Run.Exec (doEveryTenthSeconds)
+commonOptions = options
+
options :: [OptDescr Opts]
options =
[
@@ -66,6 +70,8 @@ getArgvs args =
(_, n, [] ) -> n
(_, _, errs) -> errs
+
+
doArgs :: [String]
-> ([String] -> Monitor String)
-> ([String] -> Monitor Bool)
@@ -140,3 +146,18 @@ runMLD args conf action looper detect cb = handle (cb . showException) loop
showException :: SomeException -> String
showException = ("error: "++) . show . flip asTypeOf undefined
+
+computePureConfig :: [String] -> IO MConfig -> IO PureConfig
+computePureConfig args mconfig = do
+ newConfig <- getMConfig args mconfig
+ getPureConfig newConfig
+
+getMConfig :: [String] -> IO MConfig -> IO MConfig
+getMConfig args mconfig = do
+ config <- mconfig
+ runReaderT (updateOptions args >> ask) config
+
+updateOptions :: [String] -> Monitor ()
+updateOptions args= case getOpt Permute options args of
+ (o, _, []) -> doConfigOptions o
+ _ -> return ()
diff --git a/src/Xmobar/Plugins/Monitors/Common/Types.hs b/src/Xmobar/Plugins/Monitors/Common/Types.hs
index fc71da3..e8e9bfd 100644
--- a/src/Xmobar/Plugins/Monitors/Common/Types.hs
+++ b/src/Xmobar/Plugins/Monitors/Common/Types.hs
@@ -1,3 +1,5 @@
+{-#LANGUAGE RecordWildCards#-}
+
------------------------------------------------------------------------------
-- |
-- Module: Xmobar.Plugins.Monitors.Types
@@ -23,6 +25,12 @@ module Xmobar.Plugins.Monitors.Common.Types ( Monitor
, getConfigValue
, mkMConfig
, io
+ , PureConfig (..)
+ , getPConfigValue
+ , getConfigValue
+ , getPureConfig
+ , PSelector
+ , TemplateInput(..)
) where
import Control.Monad.Reader (ReaderT, ask, liftIO)
@@ -34,6 +42,12 @@ type Monitor a = ReaderT MConfig IO a
io :: IO a -> Monitor a
io = liftIO
+data TemplateInput = TemplateInput {
+ temMonitorValues :: [String],
+ temInputTemplate :: [(String, String, String)],
+ temAllTemplate :: [(String, [(String, String, String)])]
+ }
+
data MConfig =
MC { normalColor :: IORef (Maybe String)
, low :: IORef Int
@@ -58,14 +72,73 @@ data MConfig =
, maxTotalWidthEllipsis :: IORef String
}
+data PureConfig =
+ PureConfig
+ { pNormalColor :: (Maybe String)
+ , pLow :: Int
+ , pLowColor :: (Maybe String)
+ , pHigh :: Int
+ , pHighColor :: (Maybe String)
+ , pTemplate :: String
+ , pExport :: [String]
+ , pPpad :: Int
+ , pDecDigits :: Int
+ , pMinWidth :: Int
+ , pMaxWidth :: Int
+ , pMaxWidthEllipsis :: String
+ , pPadChars :: String
+ , pPadRight :: Bool
+ , pBarBack :: String
+ , pBarFore :: String
+ , pBarWidth :: Int
+ , pUseSuffix :: Bool
+ , pNaString :: String
+ , pMaxTotalWidth :: Int
+ , pMaxTotalWidthEllipsis :: String
+ }
+ deriving (Eq, Ord)
+
+getPureConfig :: MConfig -> IO PureConfig
+getPureConfig MC{..} = do
+ pNormalColor <- readIORef normalColor
+ pLow <- readIORef low
+ pLowColor <- readIORef lowColor
+ pHigh <- readIORef high
+ pHighColor <- readIORef highColor
+ pTemplate <- readIORef template
+ pExport <- readIORef export
+ pPpad <- readIORef ppad
+ pDecDigits <- readIORef decDigits
+ pMinWidth <- readIORef minWidth
+ pMaxWidth <- readIORef maxWidth
+ pMaxWidthEllipsis <- readIORef maxWidthEllipsis
+ pPadChars <- readIORef padChars
+ pPadRight <- readIORef padRight
+ pBarBack <- readIORef barBack
+ pBarFore <- readIORef barFore
+ pBarWidth <- readIORef barWidth
+ pUseSuffix <- readIORef useSuffix
+ pNaString <- readIORef naString
+ pMaxTotalWidth <- readIORef maxTotalWidth
+ pMaxTotalWidthEllipsis <- readIORef maxTotalWidthEllipsis
+ pure $ PureConfig {..}
+
-- | from 'http:\/\/www.haskell.org\/hawiki\/MonadState'
type Selector a = MConfig -> IORef a
+type PSelector a = PureConfig -> a
+
+psel :: PureConfig -> PSelector a -> a
+psel value accessor = accessor value
sel :: Selector a -> Monitor a
sel s =
do hs <- ask
liftIO $ readIORef (s hs)
+pmods :: PureConfig -> PSelector a -> (a -> a) -> a
+pmods config value f = let val = value config
+ in f val
+
mods :: Selector a -> (a -> a) -> Monitor ()
mods s m =
do v <- ask
@@ -78,6 +151,9 @@ setConfigValue v s =
getConfigValue :: Selector a -> Monitor a
getConfigValue = sel
+getPConfigValue :: PureConfig -> PSelector a -> a
+getPConfigValue = psel
+
mkMConfig :: String
-> [String]
-> IO MConfig