packages feed

xmobar 0.29 → 0.29.1

raw patch · 41 files changed

+1009/−890 lines, 41 files

Files

changelog.md view
@@ -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_
− examples/Plugins/HelloWorld.hs 
@@ -1,24 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Plugins.HelloWorld--- Copyright   :  (c) Andrea Rossato--- License     :  BSD-style (see LICENSE)------ Maintainer  :  Jose A. Ortega Ruiz <jao@gnu.org>--- 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 "<fc=red>Hello World!!</fc>"
− examples/Plugins/helloworld.config 
@@ -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% | <fc=yellow>%date%</fc>"-       }
+ examples/xmobar.hs view
@@ -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 "<fc=red>Hello World!!</fc>"++-- 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","<station>: <tempC>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: <usedratio>%"] 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% { <fc=#ee9a00>%date%</fc>| %EGPH% | %uname%"+}++main :: IO ()+main = xmobar config
readme.md view
@@ -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
src/Xmobar.hs view
@@ -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
src/Xmobar/App/EventLoop.hs view
@@ -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
src/Xmobar/App/Main.hs view
@@ -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
src/Xmobar/App/Opts.hs view
@@ -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
src/Xmobar/Plugins/BufferedPipeReader.hs view
@@ -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)
src/Xmobar/Plugins/CommandReader.hs view
@@ -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)
src/Xmobar/Plugins/Date.hs view
@@ -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
src/Xmobar/Plugins/DateZone.hs view
@@ -22,7 +22,7 @@  module Xmobar.Plugins.DateZone (DateZone(..)) where -import Xmobar.Run.Commands+import Xmobar.Run.Exec  #ifdef DATEZONE import Control.Concurrent.STM
src/Xmobar/Plugins/EWMH.hs view
@@ -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
src/Xmobar/Plugins/Kbd.hs view
@@ -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
src/Xmobar/Plugins/Locks.hs view
@@ -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')
src/Xmobar/Plugins/MBox.hs view
@@ -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)
src/Xmobar/Plugins/Mail.hs view
@@ -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)
src/Xmobar/Plugins/MarqueePipeReader.hs view
@@ -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)
src/Xmobar/Plugins/Monitors.hs view
@@ -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
src/Xmobar/Plugins/Monitors/CatInt.hs view
@@ -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>" ["v"]
src/Xmobar/Plugins/Monitors/Common.hs view
@@ -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 "<Waiting...>"-      (_, _, 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 "</fc>") <|> try (-            do string "<fc="-               s <- many1 (alphaNum <|> char ',' <|> char '#')-               char '>'-               return $ "<fc=" ++ s ++ ">")---- | Recognizes icon specification and returns it unchanged-iconSpec :: Parser String-iconSpec = try (do string "<icon="-                   i <- manyTill (noneOf ">") (try (string "/>"))-                   return $ "<icon=" ++ i ++ "/>")---- | 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 $-                "<fc=" ++ c ++ ">" ++ str ++ "</fc>"--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
+ src/Xmobar/Plugins/Monitors/Common/Files.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE CPP, PatternGuards #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Plugins.Monitors.Files+-- Copyright   :  (c) Juraj Hercek+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Juraj Hercek <juhe_haskell@hck.sk>+-- 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
+ src/Xmobar/Plugins/Monitors/Common/Output.hs view
@@ -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 $+                "<fc=" ++ c ++ ">" ++ str ++ "</fc>"++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
+ src/Xmobar/Plugins/Monitors/Common/Parsers.hs view
@@ -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 "</fc>") <|> try (+            do string "<fc="+               s <- many1 (alphaNum <|> char ',' <|> char '#')+               char '>'+               return $ "<fc=" ++ s ++ ">")++-- | Recognizes icon specification and returns it unchanged+iconSpec :: Parser String+iconSpec = try (do string "<icon="+                   i <- manyTill (noneOf ">") (try (string "/>"))+                   return $ "<icon=" ++ i ++ "/>")++-- | 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
+ src/Xmobar/Plugins/Monitors/Common/Run.hs view
@@ -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 "<Waiting...>"+      (_, _, 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
+ src/Xmobar/Plugins/Monitors/Common/Types.hs view
@@ -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
− src/Xmobar/Plugins/Monitors/CoreCommon.hs 
@@ -1,138 +0,0 @@-{-# LANGUAGE CPP, PatternGuards #-}---------------------------------------------------------------------------------- |--- Module      :  Plugins.Monitors.CoreCommon--- Copyright   :  (c) Juraj Hercek--- License     :  BSD-style (see LICENSE)------ Maintainer  :  Juraj Hercek <juhe_haskell@hck.sk>--- 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
src/Xmobar/Plugins/Monitors/CoreTemp.hs view
@@ -15,8 +15,6 @@ module Xmobar.Plugins.Monitors.CoreTemp where  import Xmobar.Plugins.Monitors.Common-import Xmobar.Plugins.Monitors.CoreCommon-  import Data.Char (isDigit)
src/Xmobar/Plugins/Monitors/CpuFreq.hs view
@@ -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
src/Xmobar/Plugins/PipeReader.hs view
@@ -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
src/Xmobar/Plugins/StdinReader.hs view
@@ -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)
src/Xmobar/Plugins/XMonadLog.hs view
@@ -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
+ src/Xmobar/Run/Command.hs view
@@ -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
− src/Xmobar/Run/Commands.hs 
@@ -1,82 +0,0 @@--------------------------------------------------------------------------------- |--- Module      :  Xmobar.Commands--- Copyright   :  (c) Andrea Rossato--- License     :  BSD-style (see LICENSE)------ Maintainer  :  Jose A. Ortega Ruiz <jao@gnu.org>--- 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
+ src/Xmobar/Run/Exec.hs view
@@ -0,0 +1,48 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Xmobar.Exec+-- Copyright   :  (c) Andrea Rossato+-- License     :  BSD-style (see LICENSE)+--+-- Maintainer  :  Jose A. Ortega Ruiz <jao@gnu.org>+-- 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
src/Xmobar/Run/Runnable.hs view
@@ -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
src/Xmobar/Run/Runnable.hs-boot view
@@ -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
src/Xmobar/Run/Template.hs view
@@ -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
src/Xmobar/Run/Types.hs view
@@ -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)
xmobar.cabal view
@@ -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,