diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,12 @@ +## Version 0.29.1 (December, 2018) + +_Bug fixes_ + + - Honour command line flags (fixes [issue #370]) + - Expose Cmd and CmdX in Xmobar interface + +[issue #370]: https://github.com/jaor/xmobar/issues/370 + ## Version 0.29 (December, 2018) _New features_ diff --git a/examples/Plugins/HelloWorld.hs b/examples/Plugins/HelloWorld.hs deleted file mode 100644 --- a/examples/Plugins/HelloWorld.hs +++ /dev/null @@ -1,24 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Plugins.HelloWorld --- Copyright : (c) Andrea Rossato --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A. Ortega Ruiz --- Stability : unstable --- Portability : unportable --- --- A plugin example for Xmobar, a text based status bar --- ------------------------------------------------------------------------------ - -module Xmobar.Plugins.HelloWorld where - -import Xmobar.Plugins - -data HelloWorld = HelloWorld - deriving (Read, Show) - -instance Exec HelloWorld where - alias HelloWorld = "helloWorld" - run HelloWorld = return "Hello World!!" diff --git a/examples/Plugins/helloworld.config b/examples/Plugins/helloworld.config deleted file mode 100644 --- a/examples/Plugins/helloworld.config +++ /dev/null @@ -1,12 +0,0 @@ -Config { font = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" - , bgColor = "#000000" - , fgColor = "#BFBFBF" - , position = TopW C 90 - , commands = [ Run Cpu [] 10 - , Run Weather "LIPB" [] 36000 - , Run HelloWorld - ] - , sepChar = "%" - , alignSep = "}{" - , template = "%cpu% } %helloWorld% { %LIPB% | %date%" - } diff --git a/examples/xmobar.hs b/examples/xmobar.hs new file mode 100644 --- /dev/null +++ b/examples/xmobar.hs @@ -0,0 +1,76 @@ +------------------------------------------------------------------------------ +-- | +-- Copyright: (c) 2018 Jose Antonio Ortega Ruiz +-- License: BSD3-style (see LICENSE) +-- +-- Maintainer: jao@gnu.org +-- Stability: unstable +-- Portability: portable +-- Created: Sat Nov 24, 2018 21:03 +-- +-- +-- An example of a Haskell-based xmobar. Compile it with +-- ghc --make -- xmobar.hs +-- with the xmobar library installed or simply call: +-- xmobar /path/to/xmobar.hs +-- and xmobar will compile and launch it for you and +------------------------------------------------------------------------------ + + +import Xmobar + +-- Example user-defined plugin + +data HelloWorld = HelloWorld + deriving (Read, Show) + +instance Exec HelloWorld where + alias HelloWorld = "hw" + run HelloWorld = return "Hello World!!" + +-- Configuration, using predefined monitors as well as our HelloWorld +-- plugin: + +config = defaultConfig { + font = "xft:Sans Mono-9" + , additionalFonts = [] + , borderColor = "black" + , border = TopB + , bgColor = "black" + , fgColor = "grey" + , alpha = 255 + , position = Top + , textOffset = -1 + , iconOffset = -1 + , lowerOnStart = True + , pickBroadest = False + , persistent = False + , hideOnStart = False + , iconRoot = "." + , allDesktops = True + , overrideRedirect = True + , commands = [ Run $ Weather "EGPH" ["-t",": C", + "-L","18","-H","25", + "--normal","green", + "--high","red", + "--low","lightblue"] 36000 + , Run $ Network "eth0" ["-L","0","-H","32", + "--normal","green","--high","red"] 10 + , Run $ Network "eth1" ["-L","0","-H","32", + "--normal","green","--high","red"] 10 + , Run $ Cpu ["-L","3","-H","50", + "--normal","green","--high","red"] 10 + , Run $ Memory ["-t","Mem: %"] 10 + , Run $ Swap [] 10 + , Run $ Com "uname" ["-s","-r"] "" 36000 + , Run $ Date "%a %b %_d %Y %H:%M:%S" "date" 10 + , Run HelloWorld + ] + , sepChar = "%" + , alignSep = "}{" + , template = "%cpu% | %memory% * %swap% | %eth0% - %eth1% }\ + \ %hw% { %date%| %EGPH% | %uname%" +} + +main :: IO () +main = xmobar config diff --git a/readme.md b/readme.md --- a/readme.md +++ b/readme.md @@ -1501,74 +1501,23 @@ `alias` is the name to be used in the output template. Default alias will be the data type constructor. -Implementing a plugin requires importing the plugin API (the `Exec` -class definition), that is exported by `Plugins.hs`. So you just need -to import it in your module with: - - import Plugins - After that your type constructor can be used as an argument for the Runnable type constructor `Run` in the `commands` list of the configuration options. -This requires importing your plugin into `Config.hs` and adding your -type to the type list in the type signature of `Config.runnableTypes`. - -For a very basic example see `examples/Plugins/HelloWorld.hs` or the -other plugins that are distributed with xmobar. - -## Installing/Removing a Plugin - -Installing a plugin should require 3 steps. Here we are going to -install the HelloWorld plugin that comes with xmobar, assuming that -you copied it to `src/Plugins`: - -1. import the plugin module in `Config.hs`, by adding: - - import Plugins.HelloWorld - -2. add the plugin data type to the list of data types in the type - signature of `runnableTypes` in `Config.hs`. For instance, for the - HelloWorld plugin, change `runnableTypes` into: - - runnableTypes :: Command :*: Monitors :*: HelloWorld :*: () - runnableTypes = undefined - -3. Rebuild and reinstall xmobar. Now test it with: - - xmobar Plugins/helloworld.config - -As you may see in the example configuration file, the plugin can be -used by adding, in the `commands` list: - - Run HelloWorld - -and, in the output template, the alias of the plugin: - - %helloWorld% - -That's it. - -To remove a plugin, just remove its type from the type signature of -runnableTypes and remove the imported modules. - -To remove the system monitor plugin: - -1. remove, from `Config.hs`, the line - - import Plugins.Monitors - -2. in `Config.hs` change - - runnableTypes :: Command :*: Monitors :*: () - runnableTypes = undefined +## Using a Plugin - to +To use your new plugin, you need to use a pure Haskell configuration +for xmobar, and load your definitions there. You can see an example +in [examples/xmobar.hs] showing you how to write a Haskell +configuration that uses a new plugin, all in one file. - runnableTypes :: Command :*: () - runnableTypes = undefined +When xmobar runs with the full path to that Haskell file as its +argument (or if you put it in `~/.config/xmobar/xmobar.hs`), and with +the xmobar library installed, the Haskell code will be compiled as +needed, and the new executable spawned for you. -3. rebuild xmobar. +That's it! # Authors and credits diff --git a/src/Xmobar.hs b/src/Xmobar.hs --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -11,7 +11,7 @@ -- Stability : unstable -- Portability : unportable -- --- A status bar for the Xmonad Window Manager +-- Public interface of the xmobar library -- ----------------------------------------------------------------------------- @@ -20,6 +20,7 @@ , defaultConfig , Runnable (..) , Exec (..) + , Command (..) , module Xmobar.Config.Types , module Xmobar.Config.Parse , module Xmobar.Plugins.BufferedPipeReader @@ -42,7 +43,8 @@ ) where import Xmobar.Run.Runnable -import Xmobar.Run.Commands +import Xmobar.Run.Exec +import Xmobar.Run.Command import Xmobar.Config.Types import Xmobar.Config.Parse import Xmobar.Plugins.BufferedPipeReader diff --git a/src/Xmobar/App/EventLoop.hs b/src/Xmobar/App/EventLoop.hs --- a/src/Xmobar/App/EventLoop.hs +++ b/src/Xmobar/App/EventLoop.hs @@ -38,7 +38,7 @@ import Xmobar.System.Signal import Xmobar.Config.Types -import Xmobar.Run.Commands +import Xmobar.Run.Exec import Xmobar.Run.Runnable import Xmobar.X11.Actions import Xmobar.X11.Parsers diff --git a/src/Xmobar/App/Main.hs b/src/Xmobar/App/Main.hs --- a/src/Xmobar/App/Main.hs +++ b/src/Xmobar/App/Main.hs @@ -73,8 +73,8 @@ recompile dir exec force verb executeFile (dir exec) False [] Nothing -xmobar' :: Config -> [String] -> IO () -xmobar' cfg defs = do +xmobar' :: [String] -> Config -> IO () +xmobar' defs cfg = do unless (null defs || not (verbose cfg)) $ putStrLn $ "Fields missing from config defaulted: " ++ intercalate "," defs xmobar cfg @@ -84,14 +84,15 @@ args <- getArgs (flags, rest) <- getOpts args cf <- case rest of - (c:_) -> return (Just c) - _ -> xmobarConfigFile + [c] -> return (Just c) + [] -> xmobarConfigFile + _ -> error $ "Too many arguments: " ++ show rest case cf of Nothing -> case rest of (c:_) -> error $ c ++ ": file not found" _ -> xmobar defaultConfig - Just p -> do d <- doOpts defaultConfig flags - r <- readConfig d p + Just p -> do r <- readConfig defaultConfig p case r of - Left _ -> buildLaunch (verbose d) (forceRecompile flags) p - Right (c, defs) -> xmobar' c defs + Left _ -> + buildLaunch (verboseFlag flags) (recompileFlag flags) p + Right (c, defs) -> doOpts c flags >>= xmobar' defs diff --git a/src/Xmobar/App/Opts.hs b/src/Xmobar/App/Opts.hs --- a/src/Xmobar/App/Opts.hs +++ b/src/Xmobar/App/Opts.hs @@ -161,5 +161,8 @@ putStrLn "Can't parse position option, ignoring" doOpts' conf -forceRecompile :: [Opts] -> Bool -forceRecompile = elem Recompile +recompileFlag :: [Opts] -> Bool +recompileFlag = elem Recompile + +verboseFlag :: [Opts] -> Bool +verboseFlag = elem Verbose diff --git a/src/Xmobar/Plugins/BufferedPipeReader.hs b/src/Xmobar/Plugins/BufferedPipeReader.hs --- a/src/Xmobar/Plugins/BufferedPipeReader.hs +++ b/src/Xmobar/Plugins/BufferedPipeReader.hs @@ -20,7 +20,7 @@ import System.IO import System.IO.Unsafe(unsafePerformIO) -import Xmobar.Run.Commands +import Xmobar.Run.Exec import Xmobar.System.Signal import Xmobar.System.Environment import Xmobar.System.Utils(hGetLineSafe) diff --git a/src/Xmobar/Plugins/CommandReader.hs b/src/Xmobar/Plugins/CommandReader.hs --- a/src/Xmobar/Plugins/CommandReader.hs +++ b/src/Xmobar/Plugins/CommandReader.hs @@ -16,7 +16,7 @@ module Xmobar.Plugins.CommandReader(CommandReader(..)) where import System.IO -import Xmobar.Run.Commands +import Xmobar.Run.Exec import Xmobar.System.Utils (hGetLineSafe) import System.Process(runInteractiveCommand, getProcessExitCode) diff --git a/src/Xmobar/Plugins/Date.hs b/src/Xmobar/Plugins/Date.hs --- a/src/Xmobar/Plugins/Date.hs +++ b/src/Xmobar/Plugins/Date.hs @@ -19,7 +19,7 @@ module Xmobar.Plugins.Date (Date(..)) where -import Xmobar.Run.Commands +import Xmobar.Run.Exec #if ! MIN_VERSION_time(1,5,0) import System.Locale diff --git a/src/Xmobar/Plugins/DateZone.hs b/src/Xmobar/Plugins/DateZone.hs --- a/src/Xmobar/Plugins/DateZone.hs +++ b/src/Xmobar/Plugins/DateZone.hs @@ -22,7 +22,7 @@ module Xmobar.Plugins.DateZone (DateZone(..)) where -import Xmobar.Run.Commands +import Xmobar.Run.Exec #ifdef DATEZONE import Control.Concurrent.STM diff --git a/src/Xmobar/Plugins/EWMH.hs b/src/Xmobar/Plugins/EWMH.hs --- a/src/Xmobar/Plugins/EWMH.hs +++ b/src/Xmobar/Plugins/EWMH.hs @@ -22,7 +22,7 @@ import Control.Monad.Reader import Graphics.X11 hiding (Modifier, Color) import Graphics.X11.Xlib.Extras -import Xmobar.Run.Commands +import Xmobar.Run.Exec #ifdef UTF8 #undef UTF8 import Codec.Binary.UTF8.String as UTF8 diff --git a/src/Xmobar/Plugins/Kbd.hs b/src/Xmobar/Plugins/Kbd.hs --- a/src/Xmobar/Plugins/Kbd.hs +++ b/src/Xmobar/Plugins/Kbd.hs @@ -20,7 +20,7 @@ import Graphics.X11.Xlib import Graphics.X11.Xlib.Extras -import Xmobar.Run.Commands +import Xmobar.Run.Exec import Xmobar.X11.Events (nextEvent') import Xmobar.System.Kbd diff --git a/src/Xmobar/Plugins/Locks.hs b/src/Xmobar/Plugins/Locks.hs --- a/src/Xmobar/Plugins/Locks.hs +++ b/src/Xmobar/Plugins/Locks.hs @@ -19,7 +19,7 @@ import Data.Bits import Control.Monad import Graphics.X11.Xlib.Extras -import Xmobar.Run.Commands +import Xmobar.Run.Exec import Xmobar.System.Kbd import Xmobar.X11.Events (nextEvent') diff --git a/src/Xmobar/Plugins/MBox.hs b/src/Xmobar/Plugins/MBox.hs --- a/src/Xmobar/Plugins/MBox.hs +++ b/src/Xmobar/Plugins/MBox.hs @@ -16,7 +16,7 @@ module Xmobar.Plugins.MBox (MBox(..)) where import Prelude -import Xmobar.Run.Commands +import Xmobar.Run.Exec #ifdef INOTIFY import Xmobar.System.Utils (changeLoop, expandHome) diff --git a/src/Xmobar/Plugins/Mail.hs b/src/Xmobar/Plugins/Mail.hs --- a/src/Xmobar/Plugins/Mail.hs +++ b/src/Xmobar/Plugins/Mail.hs @@ -15,7 +15,7 @@ module Xmobar.Plugins.Mail(Mail(..)) where -import Xmobar.Run.Commands +import Xmobar.Run.Exec #ifdef INOTIFY import Xmobar.System.Utils (expandHome, changeLoop) diff --git a/src/Xmobar/Plugins/MarqueePipeReader.hs b/src/Xmobar/Plugins/MarqueePipeReader.hs --- a/src/Xmobar/Plugins/MarqueePipeReader.hs +++ b/src/Xmobar/Plugins/MarqueePipeReader.hs @@ -16,7 +16,7 @@ import System.IO (openFile, IOMode(ReadWriteMode), Handle) import Xmobar.System.Environment -import Xmobar.Run.Commands(Exec(alias, start), tenthSeconds) +import Xmobar.Run.Exec(Exec(alias, start), tenthSeconds) import Xmobar.System.Utils(hGetLineSafe) import System.Posix.Files (getFileStatus, isNamedPipe) import Control.Concurrent(forkIO, threadDelay) diff --git a/src/Xmobar/Plugins/Monitors.hs b/src/Xmobar/Plugins/Monitors.hs --- a/src/Xmobar/Plugins/Monitors.hs +++ b/src/Xmobar/Plugins/Monitors.hs @@ -17,7 +17,7 @@ module Xmobar.Plugins.Monitors where -import Xmobar.Run.Commands +import Xmobar.Run.Exec import Xmobar.Plugins.Monitors.Common (runM, runMD) #ifdef WEATHER diff --git a/src/Xmobar/Plugins/Monitors/CatInt.hs b/src/Xmobar/Plugins/Monitors/CatInt.hs --- a/src/Xmobar/Plugins/Monitors/CatInt.hs +++ b/src/Xmobar/Plugins/Monitors/CatInt.hs @@ -13,7 +13,6 @@ module Xmobar.Plugins.Monitors.CatInt where import Xmobar.Plugins.Monitors.Common -import Xmobar.Plugins.Monitors.CoreCommon catIntConfig :: IO MConfig catIntConfig = mkMConfig "" ["v"] diff --git a/src/Xmobar/Plugins/Monitors/Common.hs b/src/Xmobar/Plugins/Monitors/Common.hs --- a/src/Xmobar/Plugins/Monitors/Common.hs +++ b/src/Xmobar/Plugins/Monitors/Common.hs @@ -13,533 +13,16 @@ -- ----------------------------------------------------------------------------- -module Xmobar.Plugins.Monitors.Common ( - -- * Monitors - -- $monitor - Monitor - , MConfig (..) - , Opts (..) - , setConfigValue - , getConfigValue - , mkMConfig - , runM - , runMD - , runMB - , runMBD - , io - -- * Parsers - -- $parsers - , runP - , skipRestOfLine - , getNumbers - , getNumbersAsString - , getAllBut - , getAfterString - , skipTillString - , parseTemplate - , parseTemplate' - -- ** String Manipulation - -- $strings - , IconPattern - , parseIconPattern - , padString - , showWithPadding - , showWithColors - , showWithColors' - , showPercentWithColors - , showPercentsWithColors - , showPercentBar - , showVerticalBar - , showIconPattern - , showLogBar - , showLogVBar - , showLogIconPattern - , showWithUnits - , takeDigits - , showDigits - , floatToPercent - , parseFloat - , parseInt - , stringParser - ) where - - -import Control.Applicative ((<$>)) -import Control.Monad.Reader -import qualified Data.ByteString.Lazy.Char8 as B -import Data.IORef -import qualified Data.Map as Map -import Data.List -import Data.Char -import Numeric -import Text.ParserCombinators.Parsec -import System.Console.GetOpt -import Control.Exception (SomeException,handle) - -import Xmobar.Run.Commands - --- $monitor - -type Monitor a = ReaderT MConfig IO a - -data MConfig = - MC { normalColor :: IORef (Maybe String) - , low :: IORef Int - , lowColor :: IORef (Maybe String) - , high :: IORef Int - , highColor :: IORef (Maybe String) - , template :: IORef String - , export :: IORef [String] - , ppad :: IORef Int - , decDigits :: IORef Int - , minWidth :: IORef Int - , maxWidth :: IORef Int - , maxWidthEllipsis :: IORef String - , padChars :: IORef String - , padRight :: IORef Bool - , barBack :: IORef String - , barFore :: IORef String - , barWidth :: IORef Int - , useSuffix :: IORef Bool - , naString :: IORef String - , maxTotalWidth :: IORef Int - , maxTotalWidthEllipsis :: IORef String - } - --- | from 'http:\/\/www.haskell.org\/hawiki\/MonadState' -type Selector a = MConfig -> IORef a - -sel :: Selector a -> Monitor a -sel s = - do hs <- ask - liftIO $ readIORef (s hs) - -mods :: Selector a -> (a -> a) -> Monitor () -mods s m = - do v <- ask - io $ modifyIORef (s v) m - -setConfigValue :: a -> Selector a -> Monitor () -setConfigValue v s = - mods s (const v) - -getConfigValue :: Selector a -> Monitor a -getConfigValue = sel - -mkMConfig :: String - -> [String] - -> IO MConfig -mkMConfig tmpl exprts = - do lc <- newIORef Nothing - l <- newIORef 33 - nc <- newIORef Nothing - h <- newIORef 66 - hc <- newIORef Nothing - t <- newIORef tmpl - e <- newIORef exprts - p <- newIORef 0 - d <- newIORef 0 - mn <- newIORef 0 - mx <- newIORef 0 - mel <- newIORef "" - pc <- newIORef " " - pr <- newIORef False - bb <- newIORef ":" - bf <- newIORef "#" - bw <- newIORef 10 - up <- newIORef False - na <- newIORef "N/A" - mt <- newIORef 0 - mtel <- newIORef "" - return $ MC nc l lc h hc t e p d mn mx mel pc pr bb bf bw up na mt mtel - -data Opts = HighColor String - | NormalColor String - | LowColor String - | Low String - | High String - | Template String - | PercentPad String - | DecDigits String - | MinWidth String - | MaxWidth String - | Width String - | WidthEllipsis String - | PadChars String - | PadAlign String - | BarBack String - | BarFore String - | BarWidth String - | UseSuffix String - | NAString String - | MaxTotalWidth String - | MaxTotalWidthEllipsis String - -options :: [OptDescr Opts] -options = - [ - Option "H" ["High"] (ReqArg High "number") "The high threshold" - , Option "L" ["Low"] (ReqArg Low "number") "The low threshold" - , Option "h" ["high"] (ReqArg HighColor "color number") "Color for the high threshold: ex \"#FF0000\"" - , Option "n" ["normal"] (ReqArg NormalColor "color number") "Color for the normal threshold: ex \"#00FF00\"" - , Option "l" ["low"] (ReqArg LowColor "color number") "Color for the low threshold: ex \"#0000FF\"" - , Option "t" ["template"] (ReqArg Template "output template") "Output template." - , Option "S" ["suffix"] (ReqArg UseSuffix "True/False") "Use % to display percents or other suffixes." - , Option "d" ["ddigits"] (ReqArg DecDigits "decimal digits") "Number of decimal digits to display." - , Option "p" ["ppad"] (ReqArg PercentPad "percent padding") "Minimum percentage width." - , Option "m" ["minwidth"] (ReqArg MinWidth "minimum width") "Minimum field width" - , Option "M" ["maxwidth"] (ReqArg MaxWidth "maximum width") "Maximum field width" - , Option "w" ["width"] (ReqArg Width "fixed width") "Fixed field width" - , Option "e" ["maxwidthellipsis"] (ReqArg WidthEllipsis "Maximum width ellipsis") "Ellipsis to be added to the field when it has reached its max width." - , Option "c" ["padchars"] (ReqArg PadChars "padding chars") "Characters to use for padding" - , Option "a" ["align"] (ReqArg PadAlign "padding alignment") "'l' for left padding, 'r' for right" - , Option "b" ["bback"] (ReqArg BarBack "bar background") "Characters used to draw bar backgrounds" - , Option "f" ["bfore"] (ReqArg BarFore "bar foreground") "Characters used to draw bar foregrounds" - , Option "W" ["bwidth"] (ReqArg BarWidth "bar width") "Bar width" - , Option "x" ["nastring"] (ReqArg NAString "N/A string") "String used when the monitor is not available" - , Option "T" ["maxtwidth"] (ReqArg MaxTotalWidth "Maximum total width") "Maximum total width" - , Option "E" ["maxtwidthellipsis"] (ReqArg MaxTotalWidthEllipsis "Maximum total width ellipsis") "Ellipsis to be added to the total text when it has reached its max width." - ] - -doArgs :: [String] -> ([String] -> Monitor String) -> ([String] -> Monitor Bool) -> Monitor String -doArgs args action detect = - case getOpt Permute options args of - (o, n, []) -> do doConfigOptions o - ready <- detect n - if ready - then action n - else return "" - (_, _, errs) -> return (concat errs) - -doConfigOptions :: [Opts] -> Monitor () -doConfigOptions [] = io $ return () -doConfigOptions (o:oo) = - do let next = doConfigOptions oo - nz s = let x = read s in max 0 x - bool = (`elem` ["True", "true", "Yes", "yes", "On", "on"]) - (case o of - High h -> setConfigValue (read h) high - Low l -> setConfigValue (read l) low - HighColor c -> setConfigValue (Just c) highColor - NormalColor c -> setConfigValue (Just c) normalColor - LowColor c -> setConfigValue (Just c) lowColor - Template t -> setConfigValue t template - PercentPad p -> setConfigValue (nz p) ppad - DecDigits d -> setConfigValue (nz d) decDigits - MinWidth w -> setConfigValue (nz w) minWidth - MaxWidth w -> setConfigValue (nz w) maxWidth - Width w -> setConfigValue (nz w) minWidth >> - setConfigValue (nz w) maxWidth - WidthEllipsis e -> setConfigValue e maxWidthEllipsis - PadChars s -> setConfigValue s padChars - PadAlign a -> setConfigValue ("r" `isPrefixOf` a) padRight - BarBack s -> setConfigValue s barBack - BarFore s -> setConfigValue s barFore - BarWidth w -> setConfigValue (nz w) barWidth - UseSuffix u -> setConfigValue (bool u) useSuffix - NAString s -> setConfigValue s naString - MaxTotalWidth w -> setConfigValue (nz w) maxTotalWidth - MaxTotalWidthEllipsis e -> setConfigValue e maxTotalWidthEllipsis) >> next - -runM :: [String] -> IO MConfig -> ([String] -> Monitor String) -> Int - -> (String -> IO ()) -> IO () -runM args conf action r = runMB args conf action (tenthSeconds r) - -runMD :: [String] -> IO MConfig -> ([String] -> Monitor String) -> Int - -> ([String] -> Monitor Bool) -> (String -> IO ()) -> IO () -runMD args conf action r = runMBD args conf action (tenthSeconds r) - -runMB :: [String] -> IO MConfig -> ([String] -> Monitor String) -> IO () - -> (String -> IO ()) -> IO () -runMB args conf action wait = runMBD args conf action wait (\_ -> return True) - -runMBD :: [String] -> IO MConfig -> ([String] -> Monitor String) -> IO () - -> ([String] -> Monitor Bool) -> (String -> IO ()) -> IO () -runMBD args conf action wait detect cb = handle (cb . showException) loop - where ac = doArgs args action detect - loop = conf >>= runReaderT ac >>= cb >> wait >> loop - -showException :: SomeException -> String -showException = ("error: "++) . show . flip asTypeOf undefined - -io :: IO a -> Monitor a -io = liftIO - --- $parsers - -runP :: Parser [a] -> String -> IO [a] -runP p i = - case parse p "" i of - Left _ -> return [] - Right x -> return x - -getAllBut :: String -> Parser String -getAllBut s = - manyTill (noneOf s) (char $ head s) - -getNumbers :: Parser Float -getNumbers = skipMany space >> many1 digit >>= \n -> return $ read n - -getNumbersAsString :: Parser String -getNumbersAsString = skipMany space >> many1 digit >>= \n -> return n - -skipRestOfLine :: Parser Char -skipRestOfLine = - do many $ noneOf "\n\r" - newline - -getAfterString :: String -> Parser String -getAfterString s = - do { try $ manyTill skipRestOfLine $ string s - ; manyTill anyChar newline - } <|> return "" - -skipTillString :: String -> Parser String -skipTillString s = - manyTill skipRestOfLine $ string s - --- | Parses the output template string -templateStringParser :: Parser (String,String,String) -templateStringParser = - do { s <- nonPlaceHolder - ; com <- templateCommandParser - ; ss <- nonPlaceHolder - ; return (s, com, ss) - } - where - nonPlaceHolder = fmap concat . many $ - many1 (noneOf "<") <|> colorSpec <|> iconSpec - --- | Recognizes color specification and returns it unchanged -colorSpec :: Parser String -colorSpec = try (string "") <|> try ( - do string " char ',' <|> char '#') - char '>' - return $ "") - --- | Recognizes icon specification and returns it unchanged -iconSpec :: Parser String -iconSpec = try (do string "") (try (string "/>")) - return $ "") - --- | Parses the command part of the template string -templateCommandParser :: Parser String -templateCommandParser = - do { char '<' - ; com <- many $ noneOf ">" - ; char '>' - ; return com - } - --- | Combines the template parsers -templateParser :: Parser [(String,String,String)] -templateParser = many templateStringParser --"%") - -trimTo :: Int -> String -> String -> (Int, String) -trimTo n p "" = (n, p) -trimTo n p ('<':cs) = trimTo n p' s - where p' = p ++ "<" ++ takeWhile (/= '>') cs ++ ">" - s = drop 1 (dropWhile (/= '>') cs) -trimTo 0 p s = trimTo 0 p (dropWhile (/= '<') s) -trimTo n p s = let p' = takeWhile (/= '<') s - s' = dropWhile (/= '<') s - in - if length p' <= n - then trimTo (n - length p') (p ++ p') s' - else trimTo 0 (p ++ take n p') s' - --- | Takes a list of strings that represent the values of the exported --- keys. The strings are joined with the exported keys to form a map --- to be combined with 'combine' to the parsed template. Returns the --- final output of the monitor, trimmed to MaxTotalWidth if that --- configuration value is positive. -parseTemplate :: [String] -> Monitor String -parseTemplate l = - do t <- getConfigValue template - e <- getConfigValue export - w <- getConfigValue maxTotalWidth - ell <- getConfigValue maxTotalWidthEllipsis - let m = Map.fromList . zip e $ l - s <- parseTemplate' t m - let (n, s') = if w > 0 && length s > w - then trimTo (w - length ell) "" s - else (1, s) - return $ if n > 0 then s' else s' ++ ell - --- | Parses the template given to it with a map of export values and combines --- them -parseTemplate' :: String -> Map.Map String String -> Monitor String -parseTemplate' t m = - do s <- io $ runP templateParser t - combine m s - --- | Given a finite "Map" and a parsed template t produces the --- | resulting output string as the output of the monitor. -combine :: Map.Map String String -> [(String, String, String)] -> Monitor String -combine _ [] = return [] -combine m ((s,ts,ss):xs) = - do next <- combine m xs - str <- case Map.lookup ts m of - Nothing -> return $ "<" ++ ts ++ ">" - Just r -> let f "" = r; f n = n; in f <$> parseTemplate' r m - return $ s ++ str ++ ss ++ next - --- $strings - -type IconPattern = Int -> String - -parseIconPattern :: String -> IconPattern -parseIconPattern path = - let spl = splitOnPercent path - in \i -> intercalate (show i) spl - where splitOnPercent [] = [[]] - splitOnPercent ('%':'%':xs) = [] : splitOnPercent xs - splitOnPercent (x:xs) = - let rest = splitOnPercent xs - in (x : head rest) : tail rest - -type Pos = (Int, Int) - -takeDigits :: Int -> Float -> Float -takeDigits d n = - fromIntegral (round (n * fact) :: Int) / fact - where fact = 10 ^ d - -showDigits :: (RealFloat a) => Int -> a -> String -showDigits d n = showFFloat (Just d) n "" - -showWithUnits :: Int -> Int -> Float -> String -showWithUnits d n x - | x < 0 = '-' : showWithUnits d n (-x) - | n > 3 || x < 10^(d + 1) = show (round x :: Int) ++ units n - | x <= 1024 = showDigits d (x/1024) ++ units (n+1) - | otherwise = showWithUnits d (n+1) (x/1024) - where units = (!!) ["B", "K", "M", "G", "T"] - -padString :: Int -> Int -> String -> Bool -> String -> String -> String -padString mnw mxw pad pr ellipsis s = - let len = length s - rmin = if mnw <= 0 then 1 else mnw - rmax = if mxw <= 0 then max len rmin else mxw - (rmn, rmx) = if rmin <= rmax then (rmin, rmax) else (rmax, rmin) - rlen = min (max rmn len) rmx - in if rlen < len then - take rlen s ++ ellipsis - else let ps = take (rlen - len) (cycle pad) - in if pr then s ++ ps else ps ++ s - -parseFloat :: String -> Float -parseFloat s = case readFloat s of - (v, _):_ -> v - _ -> 0 - -parseInt :: String -> Int -parseInt s = case readDec s of - (v, _):_ -> v - _ -> 0 - -floatToPercent :: Float -> Monitor String -floatToPercent n = - do pad <- getConfigValue ppad - pc <- getConfigValue padChars - pr <- getConfigValue padRight - up <- getConfigValue useSuffix - let p = showDigits 0 (n * 100) - ps = if up then "%" else "" - return $ padString pad pad pc pr "" p ++ ps - -stringParser :: Pos -> B.ByteString -> String -stringParser (x,y) = - B.unpack . li x . B.words . li y . B.lines - where li i l | length l > i = l !! i - | otherwise = B.empty - -setColor :: String -> Selector (Maybe String) -> Monitor String -setColor str s = - do a <- getConfigValue s - case a of - Nothing -> return str - Just c -> return $ - "" ++ str ++ "" - -showWithPadding :: String -> Monitor String -showWithPadding s = - do mn <- getConfigValue minWidth - mx <- getConfigValue maxWidth - p <- getConfigValue padChars - pr <- getConfigValue padRight - ellipsis <- getConfigValue maxWidthEllipsis - return $ padString mn mx p pr ellipsis s - -colorizeString :: (Num a, Ord a) => a -> String -> Monitor String -colorizeString x s = do - h <- getConfigValue high - l <- getConfigValue low - let col = setColor s - [ll,hh] = map fromIntegral $ sort [l, h] -- consider high < low - head $ [col highColor | x > hh ] ++ - [col normalColor | x > ll ] ++ - [col lowColor | True] - -showWithColors :: (Num a, Ord a) => (a -> String) -> a -> Monitor String -showWithColors f x = showWithPadding (f x) >>= colorizeString x - -showWithColors' :: (Num a, Ord a) => String -> a -> Monitor String -showWithColors' str = showWithColors (const str) - -showPercentsWithColors :: [Float] -> Monitor [String] -showPercentsWithColors fs = - do fstrs <- mapM floatToPercent fs - zipWithM (showWithColors . const) fstrs (map (*100) fs) - -showPercentWithColors :: Float -> Monitor String -showPercentWithColors f = fmap head $ showPercentsWithColors [f] - -showPercentBar :: Float -> Float -> Monitor String -showPercentBar v x = do - bb <- getConfigValue barBack - bf <- getConfigValue barFore - bw <- getConfigValue barWidth - let len = min bw $ round (fromIntegral bw * x) - s <- colorizeString v (take len $ cycle bf) - return $ s ++ take (bw - len) (cycle bb) - -showIconPattern :: Maybe IconPattern -> Float -> Monitor String -showIconPattern Nothing _ = return "" -showIconPattern (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 - convert val - | t <= 9600 = ' ' - | t > 9608 = chr 9608 - | otherwise = chr t - where t = 9600 + (round val `div` 12) - -logScaling :: Float -> Float -> Monitor Float -logScaling f v = do - h <- fromIntegral `fmap` getConfigValue high - l <- fromIntegral `fmap` getConfigValue low - bw <- fromIntegral `fmap` getConfigValue barWidth - let [ll, hh] = sort [l, h] - scaled x | x == 0.0 = 0 - | x <= ll = 1 / bw - | otherwise = f + logBase 2 (x / hh) / bw - return $ scaled v - -showLogBar :: Float -> Float -> Monitor String -showLogBar f v = logScaling f v >>= showPercentBar v - -showLogVBar :: Float -> Float -> Monitor String -showLogVBar f v = logScaling f v >>= showVerticalBar v +module Xmobar.Plugins.Monitors.Common + ( module Xmobar.Plugins.Monitors.Common.Types + , module Xmobar.Plugins.Monitors.Common.Run + , module Xmobar.Plugins.Monitors.Common.Output + , module Xmobar.Plugins.Monitors.Common.Parsers + , module Xmobar.Plugins.Monitors.Common.Files + ) where -showLogIconPattern :: Maybe IconPattern -> Float -> Float -> Monitor String -showLogIconPattern str f v = logScaling f v >>= showIconPattern str +import Xmobar.Plugins.Monitors.Common.Types +import Xmobar.Plugins.Monitors.Common.Run +import Xmobar.Plugins.Monitors.Common.Output +import Xmobar.Plugins.Monitors.Common.Parsers +import Xmobar.Plugins.Monitors.Common.Files diff --git a/src/Xmobar/Plugins/Monitors/Common/Files.hs b/src/Xmobar/Plugins/Monitors/Common/Files.hs new file mode 100644 --- /dev/null +++ b/src/Xmobar/Plugins/Monitors/Common/Files.hs @@ -0,0 +1,141 @@ +{-# LANGUAGE CPP, PatternGuards #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.Monitors.Files +-- Copyright : (c) Juraj Hercek +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Juraj Hercek +-- Stability : unstable +-- Portability : unportable +-- +-- Specialized helpers to access files and their contents +-- +----------------------------------------------------------------------------- + +module Xmobar.Plugins.Monitors.Common.Files (checkedDataRetrieval) where + +#if __GLASGOW_HASKELL__ < 800 +import Control.Applicative +#endif + +import Data.Char hiding (Space) +import Data.Function +import Data.List +import Data.Maybe +import System.Directory + +import Xmobar.Plugins.Monitors.Common.Types +import Xmobar.Plugins.Monitors.Common.Parsers +import Xmobar.Plugins.Monitors.Common.Output + +checkedDataRetrieval :: (Ord a, Num a) + => String -> [[String]] -> Maybe (String, String -> Int) + -> (Double -> a) -> (a -> String) -> Monitor String +checkedDataRetrieval msg paths lbl trans fmt = + fmap (fromMaybe msg . listToMaybe . catMaybes) $ + mapM (\p -> retrieveData p lbl trans fmt) paths + +retrieveData :: (Ord a, Num a) + => [String] -> Maybe (String, String -> Int) + -> (Double -> a) -> (a -> String) -> Monitor (Maybe String) +retrieveData path lbl trans fmt = do + pairs <- map snd . sortBy (compare `on` fst) <$> + (mapM readFiles =<< findFilesAndLabel path lbl) + if null pairs + then return Nothing + else Just <$> ( parseTemplate + =<< mapM (showWithColors fmt . trans . read) pairs + ) + +-- | Represents the different types of path components +data Comp = Fix String + | Var [String] + deriving Show + +-- | Used to represent parts of file names separated by slashes and spaces +data CompOrSep = Slash + | Space + | Comp String + deriving (Eq, Show) + +-- | Function to turn a list of of strings into a list of path components +pathComponents :: [String] -> [Comp] +pathComponents = joinComps . drop 2 . intercalate [Space] . map splitParts + where + splitParts p | (l, _:r) <- break (== '/') p = Comp l : Slash : splitParts r + | otherwise = [Comp p] + + joinComps = uncurry joinComps' . partition isComp + + isComp (Comp _) = True + isComp _ = False + + fromComp (Comp s) = s + fromComp _ = error "fromComp applied to value other than (Comp _)" + + joinComps' cs [] = [Fix $ fromComp $ head cs] -- cs should have only one element here, + -- but this keeps the pattern matching + -- exhaustive + joinComps' cs (p:ps) = let (ss, ps') = span (== p) ps + ct = if null ps' || (p == Space) then length ss + 1 + else length ss + (ls, rs) = splitAt (ct+1) cs + c = case p of + Space -> Var $ map fromComp ls + Slash -> Fix $ intercalate "/" $ map fromComp ls + _ -> error "Should not happen" + in if null ps' then [c] + else c:joinComps' rs (drop ct ps) + +-- | Function to find all files matching the given path and possible label file. +-- The path must be absolute (start with a leading slash). +findFilesAndLabel :: [String] -> Maybe (String, String -> Int) + -> Monitor [(String, Either Int (String, String -> Int))] +findFilesAndLabel path lbl = catMaybes + <$> ( mapM addLabel . zip [0..] . sort + =<< recFindFiles (pathComponents path) "/" + ) + where + addLabel (i, f) = maybe (return $ Just (f, Left i)) + (uncurry (justIfExists f)) + lbl + + justIfExists f s t = let f' = take (length f - length s) f ++ s + in ifthen (Just (f, Right (f', t))) Nothing <$> io (doesFileExist f') + + recFindFiles [] d = ifthen [d] [] + <$> io (if null d then return False else doesFileExist d) + recFindFiles ps d = ifthen (recFindFiles' ps d) (return []) + =<< io (if null d then return True else doesDirectoryExist d) + + recFindFiles' [] _ = error "Should not happen" + recFindFiles' (Fix p:ps) d = recFindFiles ps (d ++ "/" ++ p) + recFindFiles' (Var p:ps) d = concat + <$> ((mapM (recFindFiles ps + . (\f -> d ++ "/" ++ f)) + . filter (matchesVar p)) + =<< io (getDirectoryContents d) + ) + + matchesVar [] _ = False + matchesVar [v] f = v == f + matchesVar (v:vs) f = let f' = drop (length v) f + f'' = dropWhile isDigit f' + in and [ v `isPrefixOf` f + , not (null f') + , isDigit (head f') + , matchesVar vs f'' + ] + +-- | Function to read the contents of the given file(s) +readFiles :: (String, Either Int (String, String -> Int)) + -> Monitor (Int, String) +readFiles (fval, flbl) = (,) <$> either return (\(f, ex) -> fmap ex + $ io $ readFile f) flbl + <*> io (readFile fval) + +-- | Function that captures if-then-else +ifthen :: a -> a -> Bool -> a +ifthen thn els cnd = if cnd then thn else els diff --git a/src/Xmobar/Plugins/Monitors/Common/Output.hs b/src/Xmobar/Plugins/Monitors/Common/Output.hs new file mode 100644 --- /dev/null +++ b/src/Xmobar/Plugins/Monitors/Common/Output.hs @@ -0,0 +1,203 @@ +------------------------------------------------------------------------------ +-- | +-- Module: Xmobar.Plugins.Monitors.Strings +-- Copyright: (c) 2018 Jose Antonio Ortega Ruiz +-- License: BSD3-style (see LICENSE) +-- +-- Maintainer: jao@gnu.org +-- Stability: unstable +-- Portability: portable +-- Created: Sun Dec 02, 2018 04:25 +-- +-- +-- Utilities for formatting monitor outputs +-- +------------------------------------------------------------------------------ + + +module Xmobar.Plugins.Monitors.Common.Output ( IconPattern + , parseIconPattern + , padString + , showWithPadding + , showWithColors + , showWithColors' + , showPercentWithColors + , showPercentsWithColors + , showPercentBar + , showVerticalBar + , showIconPattern + , showLogBar + , showLogVBar + , showLogIconPattern + , showWithUnits + , takeDigits + , showDigits + , floatToPercent + , parseFloat + , parseInt + , stringParser + ) where + +import Data.Char +import Data.List (intercalate, sort) +import qualified Data.ByteString.Lazy.Char8 as B +import Numeric +import Control.Monad (zipWithM) + +import Xmobar.Plugins.Monitors.Common.Types + +type IconPattern = Int -> String + +parseIconPattern :: String -> IconPattern +parseIconPattern path = + let spl = splitOnPercent path + in \i -> intercalate (show i) spl + where splitOnPercent [] = [[]] + splitOnPercent ('%':'%':xs) = [] : splitOnPercent xs + splitOnPercent (x:xs) = + let rest = splitOnPercent xs + in (x : head rest) : tail rest + +type Pos = (Int, Int) + +takeDigits :: Int -> Float -> Float +takeDigits d n = + fromIntegral (round (n * fact) :: Int) / fact + where fact = 10 ^ d + +showDigits :: (RealFloat a) => Int -> a -> String +showDigits d n = showFFloat (Just d) n "" + +showWithUnits :: Int -> Int -> Float -> String +showWithUnits d n x + | x < 0 = '-' : showWithUnits d n (-x) + | n > 3 || x < 10^(d + 1) = show (round x :: Int) ++ units n + | x <= 1024 = showDigits d (x/1024) ++ units (n+1) + | otherwise = showWithUnits d (n+1) (x/1024) + where units = (!!) ["B", "K", "M", "G", "T"] + +padString :: Int -> Int -> String -> Bool -> String -> String -> String +padString mnw mxw pad pr ellipsis s = + let len = length s + rmin = if mnw <= 0 then 1 else mnw + rmax = if mxw <= 0 then max len rmin else mxw + (rmn, rmx) = if rmin <= rmax then (rmin, rmax) else (rmax, rmin) + rlen = min (max rmn len) rmx + in if rlen < len then + take rlen s ++ ellipsis + else let ps = take (rlen - len) (cycle pad) + in if pr then s ++ ps else ps ++ s + +parseFloat :: String -> Float +parseFloat s = case readFloat s of + (v, _):_ -> v + _ -> 0 + +parseInt :: String -> Int +parseInt s = case readDec s of + (v, _):_ -> v + _ -> 0 + +floatToPercent :: Float -> Monitor String +floatToPercent n = + do pad <- getConfigValue ppad + pc <- getConfigValue padChars + pr <- getConfigValue padRight + up <- getConfigValue useSuffix + let p = showDigits 0 (n * 100) + ps = if up then "%" else "" + return $ padString pad pad pc pr "" p ++ ps + +stringParser :: Pos -> B.ByteString -> String +stringParser (x,y) = + B.unpack . li x . B.words . li y . B.lines + where li i l | length l > i = l !! i + | otherwise = B.empty + +setColor :: String -> Selector (Maybe String) -> Monitor String +setColor str s = + do a <- getConfigValue s + case a of + Nothing -> return str + Just c -> return $ + "" ++ str ++ "" + +showWithPadding :: String -> Monitor String +showWithPadding s = + do mn <- getConfigValue minWidth + mx <- getConfigValue maxWidth + p <- getConfigValue padChars + pr <- getConfigValue padRight + ellipsis <- getConfigValue maxWidthEllipsis + return $ padString mn mx p pr ellipsis s + +colorizeString :: (Num a, Ord a) => a -> String -> Monitor String +colorizeString x s = do + h <- getConfigValue high + l <- getConfigValue low + let col = setColor s + [ll,hh] = map fromIntegral $ sort [l, h] -- consider high < low + head $ [col highColor | x > hh ] ++ + [col normalColor | x > ll ] ++ + [col lowColor | True] + +showWithColors :: (Num a, Ord a) => (a -> String) -> a -> Monitor String +showWithColors f x = showWithPadding (f x) >>= colorizeString x + +showWithColors' :: (Num a, Ord a) => String -> a -> Monitor String +showWithColors' str = showWithColors (const str) + +showPercentsWithColors :: [Float] -> Monitor [String] +showPercentsWithColors fs = + do fstrs <- mapM floatToPercent fs + zipWithM (showWithColors . const) fstrs (map (*100) fs) + +showPercentWithColors :: Float -> Monitor String +showPercentWithColors f = fmap head $ showPercentsWithColors [f] + +showPercentBar :: Float -> Float -> Monitor String +showPercentBar v x = do + bb <- getConfigValue barBack + bf <- getConfigValue barFore + bw <- getConfigValue barWidth + let len = min bw $ round (fromIntegral bw * x) + s <- colorizeString v (take len $ cycle bf) + return $ s ++ take (bw - len) (cycle bb) + +showIconPattern :: Maybe IconPattern -> Float -> Monitor String +showIconPattern Nothing _ = return "" +showIconPattern (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 + convert val + | t <= 9600 = ' ' + | t > 9608 = chr 9608 + | otherwise = chr t + where t = 9600 + (round val `div` 12) + +logScaling :: Float -> Float -> Monitor Float +logScaling f v = do + h <- fromIntegral `fmap` getConfigValue high + l <- fromIntegral `fmap` getConfigValue low + bw <- fromIntegral `fmap` getConfigValue barWidth + let [ll, hh] = sort [l, h] + scaled x | x == 0.0 = 0 + | x <= ll = 1 / bw + | otherwise = f + logBase 2 (x / hh) / bw + return $ scaled v + +showLogBar :: Float -> Float -> Monitor String +showLogBar f v = logScaling f v >>= showPercentBar v + +showLogVBar :: Float -> Float -> Monitor String +showLogVBar f v = logScaling f v >>= showVerticalBar v + +showLogIconPattern :: Maybe IconPattern -> Float -> Float -> Monitor String +showLogIconPattern str f v = logScaling f v >>= showIconPattern str diff --git a/src/Xmobar/Plugins/Monitors/Common/Parsers.hs b/src/Xmobar/Plugins/Monitors/Common/Parsers.hs new file mode 100644 --- /dev/null +++ b/src/Xmobar/Plugins/Monitors/Common/Parsers.hs @@ -0,0 +1,152 @@ +------------------------------------------------------------------------------ +-- | +-- Module: Xmobar.Plugins.Monitors.Parsers +-- Copyright: (c) 2018 Jose Antonio Ortega Ruiz +-- License: BSD3-style (see LICENSE) +-- +-- Maintainer: jao@gnu.org +-- Stability: unstable +-- Portability: portable +-- Created: Sun Dec 02, 2018 04:49 +-- +-- +-- Parsing template strings +-- +------------------------------------------------------------------------------ + + +module Xmobar.Plugins.Monitors.Common.Parsers ( runP + , skipRestOfLine + , getNumbers + , getNumbersAsString + , getAllBut + , getAfterString + , skipTillString + , parseTemplate + , parseTemplate' + ) where + +import Xmobar.Plugins.Monitors.Common.Types + +import Control.Applicative ((<$>)) +import qualified Data.Map as Map +import Text.ParserCombinators.Parsec + +runP :: Parser [a] -> String -> IO [a] +runP p i = + case parse p "" i of + Left _ -> return [] + Right x -> return x + +getAllBut :: String -> Parser String +getAllBut s = + manyTill (noneOf s) (char $ head s) + +getNumbers :: Parser Float +getNumbers = skipMany space >> many1 digit >>= \n -> return $ read n + +getNumbersAsString :: Parser String +getNumbersAsString = skipMany space >> many1 digit >>= \n -> return n + +skipRestOfLine :: Parser Char +skipRestOfLine = + do many $ noneOf "\n\r" + newline + +getAfterString :: String -> Parser String +getAfterString s = + do { try $ manyTill skipRestOfLine $ string s + ; manyTill anyChar newline + } <|> return "" + +skipTillString :: String -> Parser String +skipTillString s = + manyTill skipRestOfLine $ string s + +-- | Parses the output template string +templateStringParser :: Parser (String,String,String) +templateStringParser = + do { s <- nonPlaceHolder + ; com <- templateCommandParser + ; ss <- nonPlaceHolder + ; return (s, com, ss) + } + where + nonPlaceHolder = fmap concat . many $ + many1 (noneOf "<") <|> colorSpec <|> iconSpec + +-- | Recognizes color specification and returns it unchanged +colorSpec :: Parser String +colorSpec = try (string "") <|> try ( + do string " char ',' <|> char '#') + char '>' + return $ "") + +-- | Recognizes icon specification and returns it unchanged +iconSpec :: Parser String +iconSpec = try (do string "") (try (string "/>")) + return $ "") + +-- | Parses the command part of the template string +templateCommandParser :: Parser String +templateCommandParser = + do { char '<' + ; com <- many $ noneOf ">" + ; char '>' + ; return com + } + +-- | Combines the template parsers +templateParser :: Parser [(String,String,String)] +templateParser = many templateStringParser --"%") + +trimTo :: Int -> String -> String -> (Int, String) +trimTo n p "" = (n, p) +trimTo n p ('<':cs) = trimTo n p' s + where p' = p ++ "<" ++ takeWhile (/= '>') cs ++ ">" + s = drop 1 (dropWhile (/= '>') cs) +trimTo 0 p s = trimTo 0 p (dropWhile (/= '<') s) +trimTo n p s = let p' = takeWhile (/= '<') s + s' = dropWhile (/= '<') s + in + if length p' <= n + then trimTo (n - length p') (p ++ p') s' + else trimTo 0 (p ++ take n p') s' + +-- | Takes a list of strings that represent the values of the exported +-- keys. The strings are joined with the exported keys to form a map +-- to be combined with 'combine' to the parsed template. Returns the +-- final output of the monitor, trimmed to MaxTotalWidth if that +-- configuration value is positive. +parseTemplate :: [String] -> Monitor String +parseTemplate l = + do t <- getConfigValue template + e <- getConfigValue export + w <- getConfigValue maxTotalWidth + ell <- getConfigValue maxTotalWidthEllipsis + let m = Map.fromList . zip e $ l + s <- parseTemplate' t m + let (n, s') = if w > 0 && length s > w + then trimTo (w - length ell) "" s + else (1, s) + return $ if n > 0 then s' else s' ++ ell + +-- | Parses the template given to it with a map of export values and combines +-- them +parseTemplate' :: String -> Map.Map String String -> Monitor String +parseTemplate' t m = + do s <- io $ runP templateParser t + combine m s + +-- | Given a finite "Map" and a parsed template t produces the +-- | resulting output string as the output of the monitor. +combine :: Map.Map String String -> [(String, String, String)] -> Monitor String +combine _ [] = return [] +combine m ((s,ts,ss):xs) = + do next <- combine m xs + str <- case Map.lookup ts m of + Nothing -> return $ "<" ++ ts ++ ">" + Just r -> let f "" = r; f n = n; in f <$> parseTemplate' r m + return $ s ++ str ++ ss ++ next diff --git a/src/Xmobar/Plugins/Monitors/Common/Run.hs b/src/Xmobar/Plugins/Monitors/Common/Run.hs new file mode 100644 --- /dev/null +++ b/src/Xmobar/Plugins/Monitors/Common/Run.hs @@ -0,0 +1,120 @@ +------------------------------------------------------------------------------ +-- | +-- Module: Xmobar.Plugins.Monitors.Run +-- Copyright: (c) 2018 Jose Antonio Ortega Ruiz +-- License: BSD3-style (see LICENSE) +-- +-- Maintainer: jao@gnu.org +-- Stability: unstable +-- Portability: portable +-- Created: Sun Dec 02, 2018 04:17 +-- +-- +-- Running a monitor +-- +------------------------------------------------------------------------------ + + +module Xmobar.Plugins.Monitors.Common.Run ( runM + , runMD + , runMB + , runMBD + ) where + +import Control.Exception (SomeException,handle) +import Data.List +import Control.Monad.Reader +import System.Console.GetOpt + +import Xmobar.Plugins.Monitors.Common.Types +import Xmobar.Run.Exec (tenthSeconds) + +options :: [OptDescr Opts] +options = + [ + Option "H" ["High"] (ReqArg High "number") "The high threshold" + , Option "L" ["Low"] (ReqArg Low "number") "The low threshold" + , Option "h" ["high"] (ReqArg HighColor "color number") "Color for the high threshold: ex \"#FF0000\"" + , Option "n" ["normal"] (ReqArg NormalColor "color number") "Color for the normal threshold: ex \"#00FF00\"" + , Option "l" ["low"] (ReqArg LowColor "color number") "Color for the low threshold: ex \"#0000FF\"" + , Option "t" ["template"] (ReqArg Template "output template") "Output template." + , Option "S" ["suffix"] (ReqArg UseSuffix "True/False") "Use % to display percents or other suffixes." + , Option "d" ["ddigits"] (ReqArg DecDigits "decimal digits") "Number of decimal digits to display." + , Option "p" ["ppad"] (ReqArg PercentPad "percent padding") "Minimum percentage width." + , Option "m" ["minwidth"] (ReqArg MinWidth "minimum width") "Minimum field width" + , Option "M" ["maxwidth"] (ReqArg MaxWidth "maximum width") "Maximum field width" + , Option "w" ["width"] (ReqArg Width "fixed width") "Fixed field width" + , Option "e" ["maxwidthellipsis"] (ReqArg WidthEllipsis "Maximum width ellipsis") "Ellipsis to be added to the field when it has reached its max width." + , Option "c" ["padchars"] (ReqArg PadChars "padding chars") "Characters to use for padding" + , Option "a" ["align"] (ReqArg PadAlign "padding alignment") "'l' for left padding, 'r' for right" + , Option "b" ["bback"] (ReqArg BarBack "bar background") "Characters used to draw bar backgrounds" + , Option "f" ["bfore"] (ReqArg BarFore "bar foreground") "Characters used to draw bar foregrounds" + , Option "W" ["bwidth"] (ReqArg BarWidth "bar width") "Bar width" + , Option "x" ["nastring"] (ReqArg NAString "N/A string") "String used when the monitor is not available" + , Option "T" ["maxtwidth"] (ReqArg MaxTotalWidth "Maximum total width") "Maximum total width" + , Option "E" ["maxtwidthellipsis"] (ReqArg MaxTotalWidthEllipsis "Maximum total width ellipsis") "Ellipsis to be added to the total text when it has reached its max width." + ] + +doArgs :: [String] + -> ([String] -> Monitor String) + -> ([String] -> Monitor Bool) + -> Monitor String +doArgs args action detect = + case getOpt Permute options args of + (o, n, []) -> do doConfigOptions o + ready <- detect n + if ready + then action n + else return "" + (_, _, errs) -> return (concat errs) + +doConfigOptions :: [Opts] -> Monitor () +doConfigOptions [] = io $ return () +doConfigOptions (o:oo) = + do let next = doConfigOptions oo + nz s = let x = read s in max 0 x + bool = (`elem` ["True", "true", "Yes", "yes", "On", "on"]) + (case o of + High h -> setConfigValue (read h) high + Low l -> setConfigValue (read l) low + HighColor c -> setConfigValue (Just c) highColor + NormalColor c -> setConfigValue (Just c) normalColor + LowColor c -> setConfigValue (Just c) lowColor + Template t -> setConfigValue t template + PercentPad p -> setConfigValue (nz p) ppad + DecDigits d -> setConfigValue (nz d) decDigits + MinWidth w -> setConfigValue (nz w) minWidth + MaxWidth w -> setConfigValue (nz w) maxWidth + Width w -> setConfigValue (nz w) minWidth >> + setConfigValue (nz w) maxWidth + WidthEllipsis e -> setConfigValue e maxWidthEllipsis + PadChars s -> setConfigValue s padChars + PadAlign a -> setConfigValue ("r" `isPrefixOf` a) padRight + BarBack s -> setConfigValue s barBack + BarFore s -> setConfigValue s barFore + BarWidth w -> setConfigValue (nz w) barWidth + UseSuffix u -> setConfigValue (bool u) useSuffix + NAString s -> setConfigValue s naString + MaxTotalWidth w -> setConfigValue (nz w) maxTotalWidth + MaxTotalWidthEllipsis e -> setConfigValue e maxTotalWidthEllipsis) >> next + +runM :: [String] -> IO MConfig -> ([String] -> Monitor String) -> Int + -> (String -> IO ()) -> IO () +runM args conf action r = runMB args conf action (tenthSeconds r) + +runMD :: [String] -> IO MConfig -> ([String] -> Monitor String) -> Int + -> ([String] -> Monitor Bool) -> (String -> IO ()) -> IO () +runMD args conf action r = runMBD args conf action (tenthSeconds r) + +runMB :: [String] -> IO MConfig -> ([String] -> Monitor String) -> IO () + -> (String -> IO ()) -> IO () +runMB args conf action wait = runMBD args conf action wait (\_ -> return True) + +runMBD :: [String] -> IO MConfig -> ([String] -> Monitor String) -> IO () + -> ([String] -> Monitor Bool) -> (String -> IO ()) -> IO () +runMBD args conf action wait detect cb = handle (cb . showException) loop + where ac = doArgs args action detect + loop = conf >>= runReaderT ac >>= cb >> wait >> loop + +showException :: SomeException -> String +showException = ("error: "++) . show . flip asTypeOf undefined diff --git a/src/Xmobar/Plugins/Monitors/Common/Types.hs b/src/Xmobar/Plugins/Monitors/Common/Types.hs new file mode 100644 --- /dev/null +++ b/src/Xmobar/Plugins/Monitors/Common/Types.hs @@ -0,0 +1,127 @@ +------------------------------------------------------------------------------ +-- | +-- Module: Xmobar.Plugins.Monitors.Types +-- Copyright: (c) 2018 Jose Antonio Ortega Ruiz +-- License: BSD3-style (see LICENSE) +-- +-- Maintainer: jao@gnu.org +-- Stability: unstable +-- Portability: portable +-- Created: Sun Dec 02, 2018 04:31 +-- +-- +-- Type definitions and constructors for Monitors +-- +------------------------------------------------------------------------------ + + +module Xmobar.Plugins.Monitors.Common.Types ( Monitor + , MConfig (..) + , Opts (..) + , Selector + , setConfigValue + , getConfigValue + , mkMConfig + , io + ) where + +import Data.IORef +import Control.Monad.Reader + +type Monitor a = ReaderT MConfig IO a + +io :: IO a -> Monitor a +io = liftIO + +data MConfig = + MC { normalColor :: IORef (Maybe String) + , low :: IORef Int + , lowColor :: IORef (Maybe String) + , high :: IORef Int + , highColor :: IORef (Maybe String) + , template :: IORef String + , export :: IORef [String] + , ppad :: IORef Int + , decDigits :: IORef Int + , minWidth :: IORef Int + , maxWidth :: IORef Int + , maxWidthEllipsis :: IORef String + , padChars :: IORef String + , padRight :: IORef Bool + , barBack :: IORef String + , barFore :: IORef String + , barWidth :: IORef Int + , useSuffix :: IORef Bool + , naString :: IORef String + , maxTotalWidth :: IORef Int + , maxTotalWidthEllipsis :: IORef String + } + +-- | from 'http:\/\/www.haskell.org\/hawiki\/MonadState' +type Selector a = MConfig -> IORef a + +sel :: Selector a -> Monitor a +sel s = + do hs <- ask + liftIO $ readIORef (s hs) + +mods :: Selector a -> (a -> a) -> Monitor () +mods s m = + do v <- ask + io $ modifyIORef (s v) m + +setConfigValue :: a -> Selector a -> Monitor () +setConfigValue v s = + mods s (const v) + +getConfigValue :: Selector a -> Monitor a +getConfigValue = sel + +mkMConfig :: String + -> [String] + -> IO MConfig +mkMConfig tmpl exprts = + do lc <- newIORef Nothing + l <- newIORef 33 + nc <- newIORef Nothing + h <- newIORef 66 + hc <- newIORef Nothing + t <- newIORef tmpl + e <- newIORef exprts + p <- newIORef 0 + d <- newIORef 0 + mn <- newIORef 0 + mx <- newIORef 0 + mel <- newIORef "" + pc <- newIORef " " + pr <- newIORef False + bb <- newIORef ":" + bf <- newIORef "#" + bw <- newIORef 10 + up <- newIORef False + na <- newIORef "N/A" + mt <- newIORef 0 + mtel <- newIORef "" + return $ MC nc l lc h hc t e p d mn mx mel pc pr bb bf bw up na mt mtel + +data Opts = HighColor String + | NormalColor String + | LowColor String + | Low String + | High String + | Template String + | PercentPad String + | DecDigits String + | MinWidth String + | MaxWidth String + | Width String + | WidthEllipsis String + | PadChars String + | PadAlign String + | BarBack String + | BarFore String + | BarWidth String + | UseSuffix String + | NAString String + | MaxTotalWidth String + | MaxTotalWidthEllipsis String diff --git a/src/Xmobar/Plugins/Monitors/CoreCommon.hs b/src/Xmobar/Plugins/Monitors/CoreCommon.hs deleted file mode 100644 --- a/src/Xmobar/Plugins/Monitors/CoreCommon.hs +++ /dev/null @@ -1,138 +0,0 @@ -{-# LANGUAGE CPP, PatternGuards #-} - ------------------------------------------------------------------------------ --- | --- Module : Plugins.Monitors.CoreCommon --- Copyright : (c) Juraj Hercek --- License : BSD-style (see LICENSE) --- --- Maintainer : Juraj Hercek --- Stability : unstable --- Portability : unportable --- --- The common part for cpu core monitors (e.g. cpufreq, coretemp) --- ------------------------------------------------------------------------------ - -module Xmobar.Plugins.Monitors.CoreCommon where - -#if __GLASGOW_HASKELL__ < 800 -import Control.Applicative -#endif - -import Data.Char hiding (Space) -import Data.Function -import Data.List -import Data.Maybe -import Xmobar.Plugins.Monitors.Common -import System.Directory - -checkedDataRetrieval :: (Ord a, Num a) - => String -> [[String]] -> Maybe (String, String -> Int) - -> (Double -> a) -> (a -> String) -> Monitor String -checkedDataRetrieval msg paths lbl trans fmt = - fmap (fromMaybe msg . listToMaybe . catMaybes) $ - mapM (\p -> retrieveData p lbl trans fmt) paths - -retrieveData :: (Ord a, Num a) - => [String] -> Maybe (String, String -> Int) - -> (Double -> a) -> (a -> String) -> Monitor (Maybe String) -retrieveData path lbl trans fmt = do - pairs <- map snd . sortBy (compare `on` fst) <$> - (mapM readFiles =<< findFilesAndLabel path lbl) - if null pairs - then return Nothing - else Just <$> ( parseTemplate - =<< mapM (showWithColors fmt . trans . read) pairs - ) - --- | Represents the different types of path components -data Comp = Fix String - | Var [String] - deriving Show - --- | Used to represent parts of file names separated by slashes and spaces -data CompOrSep = Slash - | Space - | Comp String - deriving (Eq, Show) - --- | Function to turn a list of of strings into a list of path components -pathComponents :: [String] -> [Comp] -pathComponents = joinComps . drop 2 . intercalate [Space] . map splitParts - where - splitParts p | (l, _:r) <- break (== '/') p = Comp l : Slash : splitParts r - | otherwise = [Comp p] - - joinComps = uncurry joinComps' . partition isComp - - isComp (Comp _) = True - isComp _ = False - - fromComp (Comp s) = s - fromComp _ = error "fromComp applied to value other than (Comp _)" - - joinComps' cs [] = [Fix $ fromComp $ head cs] -- cs should have only one element here, - -- but this keeps the pattern matching - -- exhaustive - joinComps' cs (p:ps) = let (ss, ps') = span (== p) ps - ct = if null ps' || (p == Space) then length ss + 1 - else length ss - (ls, rs) = splitAt (ct+1) cs - c = case p of - Space -> Var $ map fromComp ls - Slash -> Fix $ intercalate "/" $ map fromComp ls - _ -> error "Should not happen" - in if null ps' then [c] - else c:joinComps' rs (drop ct ps) - --- | Function to find all files matching the given path and possible label file. --- The path must be absolute (start with a leading slash). -findFilesAndLabel :: [String] -> Maybe (String, String -> Int) - -> Monitor [(String, Either Int (String, String -> Int))] -findFilesAndLabel path lbl = catMaybes - <$> ( mapM addLabel . zip [0..] . sort - =<< recFindFiles (pathComponents path) "/" - ) - where - addLabel (i, f) = maybe (return $ Just (f, Left i)) - (uncurry (justIfExists f)) - lbl - - justIfExists f s t = let f' = take (length f - length s) f ++ s - in ifthen (Just (f, Right (f', t))) Nothing <$> io (doesFileExist f') - - recFindFiles [] d = ifthen [d] [] - <$> io (if null d then return False else doesFileExist d) - recFindFiles ps d = ifthen (recFindFiles' ps d) (return []) - =<< io (if null d then return True else doesDirectoryExist d) - - recFindFiles' [] _ = error "Should not happen" - recFindFiles' (Fix p:ps) d = recFindFiles ps (d ++ "/" ++ p) - recFindFiles' (Var p:ps) d = concat - <$> ((mapM (recFindFiles ps - . (\f -> d ++ "/" ++ f)) - . filter (matchesVar p)) - =<< io (getDirectoryContents d) - ) - - matchesVar [] _ = False - matchesVar [v] f = v == f - matchesVar (v:vs) f = let f' = drop (length v) f - f'' = dropWhile isDigit f' - in and [ v `isPrefixOf` f - , not (null f') - , isDigit (head f') - , matchesVar vs f'' - ] - --- | Function to read the contents of the given file(s) -readFiles :: (String, Either Int (String, String -> Int)) - -> Monitor (Int, String) -readFiles (fval, flbl) = (,) <$> either return (\(f, ex) -> fmap ex - $ io $ readFile f) flbl - <*> io (readFile fval) - --- | Function that captures if-then-else -ifthen :: a -> a -> Bool -> a -ifthen thn els cnd = if cnd then thn else els diff --git a/src/Xmobar/Plugins/Monitors/CoreTemp.hs b/src/Xmobar/Plugins/Monitors/CoreTemp.hs --- a/src/Xmobar/Plugins/Monitors/CoreTemp.hs +++ b/src/Xmobar/Plugins/Monitors/CoreTemp.hs @@ -15,8 +15,6 @@ module Xmobar.Plugins.Monitors.CoreTemp where import Xmobar.Plugins.Monitors.Common -import Xmobar.Plugins.Monitors.CoreCommon - import Data.Char (isDigit) diff --git a/src/Xmobar/Plugins/Monitors/CpuFreq.hs b/src/Xmobar/Plugins/Monitors/CpuFreq.hs --- a/src/Xmobar/Plugins/Monitors/CpuFreq.hs +++ b/src/Xmobar/Plugins/Monitors/CpuFreq.hs @@ -15,7 +15,6 @@ module Xmobar.Plugins.Monitors.CpuFreq where import Xmobar.Plugins.Monitors.Common -import Xmobar.Plugins.Monitors.CoreCommon -- | -- Cpu frequency default configuration. Default template contains only diff --git a/src/Xmobar/Plugins/PipeReader.hs b/src/Xmobar/Plugins/PipeReader.hs --- a/src/Xmobar/Plugins/PipeReader.hs +++ b/src/Xmobar/Plugins/PipeReader.hs @@ -15,7 +15,7 @@ module Xmobar.Plugins.PipeReader(PipeReader(..)) where import System.IO -import Xmobar.Run.Commands(Exec(..)) +import Xmobar.Run.Exec(Exec(..)) import Xmobar.System.Utils(hGetLineSafe) import Xmobar.System.Environment(expandEnv) import System.Posix.Files diff --git a/src/Xmobar/Plugins/StdinReader.hs b/src/Xmobar/Plugins/StdinReader.hs --- a/src/Xmobar/Plugins/StdinReader.hs +++ b/src/Xmobar/Plugins/StdinReader.hs @@ -23,7 +23,7 @@ import System.Exit import System.IO import Control.Exception (SomeException(..), handle) -import Xmobar.Run.Commands +import Xmobar.Run.Exec import Xmobar.X11.Actions (stripActions) import Xmobar.System.Utils (hGetLineSafe) diff --git a/src/Xmobar/Plugins/XMonadLog.hs b/src/Xmobar/Plugins/XMonadLog.hs --- a/src/Xmobar/Plugins/XMonadLog.hs +++ b/src/Xmobar/Plugins/XMonadLog.hs @@ -20,7 +20,7 @@ import Control.Monad import Graphics.X11 import Graphics.X11.Xlib.Extras -import Xmobar.Run.Commands +import Xmobar.Run.Exec #ifdef UTF8 #undef UTF8 import Codec.Binary.UTF8.String as UTF8 diff --git a/src/Xmobar/Run/Command.hs b/src/Xmobar/Run/Command.hs new file mode 100644 --- /dev/null +++ b/src/Xmobar/Run/Command.hs @@ -0,0 +1,55 @@ +------------------------------------------------------------------------------ +-- | +-- Module: Xmobar.Plugins.Command +-- Copyright: (c) 2018 Jose Antonio Ortega Ruiz +-- License: BSD3-style (see LICENSE) +-- +-- Maintainer: jao@gnu.org +-- Stability: unstable +-- Portability: portable +-- Created: Sun Dec 02, 2018 05:29 +-- +-- +-- The basic Command plugin +-- +------------------------------------------------------------------------------ + + +module Xmobar.Run.Command where + +import Control.Exception (handle, SomeException(..)) +import System.Process +import System.Exit +import System.IO (hClose) +import Xmobar.System.Utils (hGetLineSafe) + +import Xmobar.Run.Exec + +data Command = Com Program Args Alias Rate + | ComX Program Args String Alias Rate + deriving (Show,Read,Eq) + +type Args = [String] +type Program = String +type Alias = String +type Rate = Int + +instance Exec Command where + alias (ComX p _ _ a _) = + if p /= "" then (if a == "" then p else a) else "" + alias (Com p a al r) = alias (ComX p a "" al r) + start (Com p as al r) cb = + start (ComX p as ("Could not execute command " ++ p) al r) cb + start (ComX prog args msg _ r) cb = if r > 0 then go else exec + where go = exec >> tenthSeconds r >> go + exec = do + (i,o,e,p) <- runInteractiveProcess prog args Nothing Nothing + exit <- waitForProcess p + let closeHandles = hClose o >> hClose i >> hClose e + getL = handle (\(SomeException _) -> return "") + (hGetLineSafe o) + case exit of + ExitSuccess -> do str <- getL + closeHandles + cb str + _ -> closeHandles >> cb msg diff --git a/src/Xmobar/Run/Commands.hs b/src/Xmobar/Run/Commands.hs deleted file mode 100644 --- a/src/Xmobar/Run/Commands.hs +++ /dev/null @@ -1,82 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Xmobar.Commands --- Copyright : (c) Andrea Rossato --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A. Ortega Ruiz --- Stability : unstable --- Portability : unportable --- --- The 'Exec' class and the 'Command' data type. --- --- The 'Exec' class rappresents the executable types, whose constructors may --- appear in the 'Config.commands' field of the 'Config.Config' data type. --- --- The 'Command' data type is for OS commands to be run by xmobar --- ------------------------------------------------------------------------------ - -module Xmobar.Run.Commands (Command (..), Exec (..), tenthSeconds) where - -import Prelude -import Control.Exception (handle, SomeException(..)) -import Data.Char -import System.Process -import System.Exit -import System.IO (hClose) -import Control.Concurrent - -import Xmobar.System.Signal -import Xmobar.System.Utils (hGetLineSafe) - --- | Work around to the Int max bound: since threadDelay takes an Int, it --- is not possible to set a thread delay grater than about 45 minutes. --- With a little recursion we solve the problem. -tenthSeconds :: Int -> IO () -tenthSeconds s | s >= x = do threadDelay (x * 100000) - tenthSeconds (s - x) - | otherwise = threadDelay (s * 100000) - where x = (maxBound :: Int) `div` 100000 - -class Show e => Exec e where - alias :: e -> String - alias e = takeWhile (not . isSpace) $ show e - rate :: e -> Int - rate _ = 10 - run :: e -> IO String - run _ = return "" - start :: e -> (String -> IO ()) -> IO () - start e cb = go - where go = run e >>= cb >> tenthSeconds (rate e) >> go - trigger :: e -> (Maybe SignalType -> IO ()) -> IO () - trigger _ sh = sh Nothing - -data Command = Com Program Args Alias Rate - | ComX Program Args String Alias Rate - deriving (Show,Read,Eq) - -type Args = [String] -type Program = String -type Alias = String -type Rate = Int - -instance Exec Command where - alias (ComX p _ _ a _) = - if p /= "" then (if a == "" then p else a) else "" - alias (Com p a al r) = alias (ComX p a "" al r) - start (Com p as al r) cb = - start (ComX p as ("Could not execute command " ++ p) al r) cb - start (ComX prog args msg _ r) cb = if r > 0 then go else exec - where go = exec >> tenthSeconds r >> go - exec = do - (i,o,e,p) <- runInteractiveProcess prog args Nothing Nothing - exit <- waitForProcess p - let closeHandles = hClose o >> hClose i >> hClose e - getL = handle (\(SomeException _) -> return "") - (hGetLineSafe o) - case exit of - ExitSuccess -> do str <- getL - closeHandles - cb str - _ -> closeHandles >> cb msg diff --git a/src/Xmobar/Run/Exec.hs b/src/Xmobar/Run/Exec.hs new file mode 100644 --- /dev/null +++ b/src/Xmobar/Run/Exec.hs @@ -0,0 +1,48 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Xmobar.Exec +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Jose A. Ortega Ruiz +-- Stability : unstable +-- Portability : unportable +-- +-- The 'Exec' class and the 'Command' data type. +-- +-- The 'Exec' class rappresents the executable types, whose constructors may +-- appear in the 'Config.commands' field of the 'Config.Config' data type. +-- +-- The 'Command' data type is for OS commands to be run by xmobar +-- +----------------------------------------------------------------------------- + +module Xmobar.Run.Exec (Exec (..), tenthSeconds) where + +import Prelude +import Data.Char +import Control.Concurrent + +import Xmobar.System.Signal + +-- | Work around to the Int max bound: since threadDelay takes an Int, it +-- is not possible to set a thread delay grater than about 45 minutes. +-- With a little recursion we solve the problem. +tenthSeconds :: Int -> IO () +tenthSeconds s | s >= x = do threadDelay (x * 100000) + tenthSeconds (s - x) + | otherwise = threadDelay (s * 100000) + where x = (maxBound :: Int) `div` 100000 + +class Show e => Exec e where + alias :: e -> String + alias e = takeWhile (not . isSpace) $ show e + rate :: e -> Int + rate _ = 10 + run :: e -> IO String + run _ = return "" + start :: e -> (String -> IO ()) -> IO () + start e cb = go + where go = run e >>= cb >> tenthSeconds (rate e) >> go + trigger :: e -> (Maybe SignalType -> IO ()) -> IO () + trigger _ sh = sh Nothing diff --git a/src/Xmobar/Run/Runnable.hs b/src/Xmobar/Run/Runnable.hs --- a/src/Xmobar/Run/Runnable.hs +++ b/src/Xmobar/Run/Runnable.hs @@ -24,7 +24,7 @@ import Control.Monad import Text.Read import Xmobar.Run.Types (runnableTypes) -import Xmobar.Run.Commands +import Xmobar.Run.Exec data Runnable = forall r . (Exec r, Read r, Show r) => Run r diff --git a/src/Xmobar/Run/Runnable.hs-boot b/src/Xmobar/Run/Runnable.hs-boot --- a/src/Xmobar/Run/Runnable.hs-boot +++ b/src/Xmobar/Run/Runnable.hs-boot @@ -1,6 +1,6 @@ {-# LANGUAGE ExistentialQuantification #-} module Xmobar.Run.Runnable where -import Xmobar.Run.Commands +import Xmobar.Run.Exec data Runnable = forall r . (Exec r,Read r,Show r) => Run r diff --git a/src/Xmobar/Run/Template.hs b/src/Xmobar/Run/Template.hs --- a/src/Xmobar/Run/Template.hs +++ b/src/Xmobar/Run/Template.hs @@ -20,7 +20,8 @@ import qualified Data.Map as Map import Text.ParserCombinators.Parsec -import Xmobar.Run.Commands +import Xmobar.Run.Exec +import Xmobar.Run.Command import Xmobar.Run.Runnable defaultAlign :: String diff --git a/src/Xmobar/Run/Types.hs b/src/Xmobar/Run/Types.hs --- a/src/Xmobar/Run/Types.hs +++ b/src/Xmobar/Run/Types.hs @@ -18,8 +18,6 @@ module Xmobar.Run.Types(runnableTypes) where -import Xmobar.Run.Commands - import {-# SOURCE #-} Xmobar.Run.Runnable() import Xmobar.Plugins.Monitors import Xmobar.Plugins.Date @@ -41,6 +39,8 @@ #ifdef DATEZONE import Xmobar.Plugins.DateZone #endif + +import Xmobar.Run.Command -- | An alias for tuple types that is more convenient for long lists. type a :*: b = (a, b) diff --git a/xmobar.cabal b/xmobar.cabal --- a/xmobar.cabal +++ b/xmobar.cabal @@ -1,5 +1,5 @@ name: xmobar -version: 0.29 +version: 0.29.1 homepage: http://xmobar.org synopsis: A Minimalistic Text Based Status Bar description: Xmobar is a minimalistic text based status bar. @@ -18,9 +18,9 @@ extra-source-files: readme.md, changelog.md, examples/padding-icon.sh, - examples/xmobar.config, examples/xmonadpropwrite.hs - examples/Plugins/helloworld.config, - examples/Plugins/HelloWorld.hs + examples/xmobar.config, + examples/xmobar.hs, + examples/xmonadpropwrite.hs source-repository head type: git @@ -101,7 +101,8 @@ Xmobar.Config.Parse, Xmobar.Run.Types, Xmobar.Run.Template, - Xmobar.Run.Commands, + Xmobar.Run.Exec, + Xmobar.Run.Command, Xmobar.Run.Runnable Xmobar.App.EventLoop, Xmobar.App.Config, @@ -136,7 +137,11 @@ Xmobar.Plugins.Monitors, Xmobar.Plugins.Monitors.Batt, Xmobar.Plugins.Monitors.Common, - Xmobar.Plugins.Monitors.CoreCommon, + Xmobar.Plugins.Monitors.Common.Types, + Xmobar.Plugins.Monitors.Common.Run, + Xmobar.Plugins.Monitors.Common.Output, + Xmobar.Plugins.Monitors.Common.Parsers, + Xmobar.Plugins.Monitors.Common.Files, Xmobar.Plugins.Monitors.CoreTemp, Xmobar.Plugins.Monitors.CpuFreq, Xmobar.Plugins.Monitors.Cpu, @@ -311,9 +316,13 @@ other-modules: Xmobar.Plugins.Monitors.CommonSpec Xmobar.Plugins.Monitors.Common + Xmobar.Plugins.Monitors.Common.Parsers + Xmobar.Plugins.Monitors.Common.Run + Xmobar.Plugins.Monitors.Common.Types + Xmobar.Plugins.Monitors.Common.Output + Xmobar.Plugins.Monitors.Common.Files + Xmobar.Run.Exec Xmobar.System.Signal - Xmobar.System.Utils - Xmobar.Run.Commands if flag(with_alsa) || flag(all_extensions) build-depends: alsa-mixer > 0.2.0.2,