diff options
Diffstat (limited to 'src/Xmobar/Plugins/Monitors/Common')
| -rw-r--r-- | src/Xmobar/Plugins/Monitors/Common/Output.hs | 83 | ||||
| -rw-r--r-- | src/Xmobar/Plugins/Monitors/Common/Parsers.hs | 39 | ||||
| -rw-r--r-- | src/Xmobar/Plugins/Monitors/Common/Run.hs | 21 | ||||
| -rw-r--r-- | src/Xmobar/Plugins/Monitors/Common/Types.hs | 76 |
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 |