xmobar 0.11.1 → 0.12
raw patch · 84 files changed
+4586/−3998 lines, 84 filesdep ~libmpdnew-uploader
Dependency ranges changed: libmpd
Files
- Commands.hs +0/−85
- Config.hs +0/−103
- IWlib.hsc +0/−77
- Main.hs +0/−161
- NEWS +62/−0
- Parsers.hs +0/−179
- Plugins.hs +0/−25
- Plugins/CommandReader.hs +0/−39
- Plugins/Date.hs +0/−37
- Plugins/EWMH.hs +0/−264
- Plugins/HelloWorld.hs +0/−24
- Plugins/MBox.hs +0/−124
- Plugins/Mail.hs +0/−78
- Plugins/Monitors.hs +0/−115
- Plugins/Monitors/Batt.hs +0/−78
- Plugins/Monitors/Common.hs +0/−424
- Plugins/Monitors/CoreCommon.hs +0/−58
- Plugins/Monitors/CoreTemp.hs +0/−41
- Plugins/Monitors/Cpu.hs +0/−53
- Plugins/Monitors/CpuFreq.hs +0/−40
- Plugins/Monitors/Disk.hs +0/−137
- Plugins/Monitors/MPD.hs +0/−92
- Plugins/Monitors/Mem.hs +0/−58
- Plugins/Monitors/MultiCpu.hs +0/−66
- Plugins/Monitors/Net.hs +0/−95
- Plugins/Monitors/Swap.hs +0/−56
- Plugins/Monitors/Thermal.hs +0/−42
- Plugins/Monitors/Top.hs +0/−156
- Plugins/Monitors/Weather.hs +0/−141
- Plugins/Monitors/Wireless.hs +0/−34
- Plugins/PipeReader.hs +0/−28
- Plugins/StdinReader.hs +0/−33
- Plugins/XMonadLog.hs +0/−72
- Plugins/helloworld.config +0/−12
- README +464/−203
- Runnable.hs +0/−59
- Runnable.hs-boot +0/−8
- StatFS.hsc +0/−79
- XUtil.hsc +0/−259
- Xmobar.hs +0/−286
- samples/Plugins/HelloWorld.hs +24/−0
- samples/Plugins/helloworld.config +12/−0
- samples/xmobar.config +18/−0
- scripts/xmonadpropwrite.hs +0/−41
- src/Commands.hs +84/−0
- src/Config.hs +116/−0
- src/IWlib.hsc +75/−0
- src/Main.hs +164/−0
- src/Parsers.hs +183/−0
- src/Plugins.hs +25/−0
- src/Plugins/CommandReader.hs +39/−0
- src/Plugins/Date.hs +37/−0
- src/Plugins/EWMH.hs +264/−0
- src/Plugins/MBox.hs +111/−0
- src/Plugins/Mail.hs +70/−0
- src/Plugins/Monitors.hs +119/−0
- src/Plugins/Monitors/Batt.hs +165/−0
- src/Plugins/Monitors/Common.hs +446/−0
- src/Plugins/Monitors/CoreCommon.hs +59/−0
- src/Plugins/Monitors/CoreTemp.hs +41/−0
- src/Plugins/Monitors/Cpu.hs +53/−0
- src/Plugins/Monitors/CpuFreq.hs +43/−0
- src/Plugins/Monitors/Disk.hs +137/−0
- src/Plugins/Monitors/MPD.hs +115/−0
- src/Plugins/Monitors/Mem.hs +59/−0
- src/Plugins/Monitors/MultiCpu.hs +76/−0
- src/Plugins/Monitors/Net.hs +96/−0
- src/Plugins/Monitors/Swap.hs +55/−0
- src/Plugins/Monitors/Thermal.hs +42/−0
- src/Plugins/Monitors/Top.hs +179/−0
- src/Plugins/Monitors/Uptime.hs +50/−0
- src/Plugins/Monitors/Weather.hs +141/−0
- src/Plugins/Monitors/Wireless.hs +34/−0
- src/Plugins/PipeReader.hs +28/−0
- src/Plugins/StdinReader.hs +33/−0
- src/Plugins/Utils.hs +39/−0
- src/Plugins/XMonadLog.hs +72/−0
- src/Runnable.hs +59/−0
- src/Runnable.hs-boot +8/−0
- src/StatFS.hsc +79/−0
- src/XUtil.hsc +259/−0
- src/Xmobar.hs +306/−0
- xmobar.cabal +45/−18
- xmobar.config-sample +0/−18
− Commands.hs
@@ -1,85 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Xmobar.Commands--- Copyright : (c) Andrea Rossato--- License : BSD-style (see LICENSE)------ Maintainer : Andrea Rossato <andrea.rossato@unibz.it>--- 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 Commands- ( Command (..)- , Exec (..)- , tenthSeconds- ) where--import Prelude hiding (catch)-import Control.Concurrent-import Control.Exception-import Data.Char-import System.Process-import System.Exit-import System.IO (hClose)-import XUtil--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 = do- run e >>= cb- tenthSeconds (rate e) >> go--data Command = Com Program Args Alias Rate- deriving (Show,Read,Eq)--type Args = [String]-type Program = String-type Alias = String-type Rate = Int--instance Exec Command where- alias (Com p _ a _)- | p /= "" = if a == "" then p else a- | otherwise = ""- start (Com prog args _ r) cb = do go- where go = do- (i,o,e,p) <- runInteractiveCommand (prog ++ concat (map (' ':) args))- exit <- waitForProcess p- let closeHandles = do- hClose o- hClose i- hClose e- case exit of- ExitSuccess -> do- str <- catch (hGetLineSafe o) (\(SomeException _) -> return "")- closeHandles- cb str- _ -> do closeHandles- cb $ "Could not execute command " ++ prog- tenthSeconds r >> go---- | Work arount 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 y- tenthSeconds (x - s)- | otherwise = threadDelay (s * 100000)- where y = (maxBound :: Int)- x = y `div` 100000
− Config.hs
@@ -1,103 +0,0 @@-{-# LANGUAGE CPP, TypeOperators #-}---------------------------------------------------------------------------------- |--- Module : Xmobar.Config--- Copyright : (c) Andrea Rossato--- License : BSD-style (see LICENSE)------ Maintainer : Andrea Rossato <andrea.rossato@unitn.it>--- Stability : unstable--- Portability : unportable------ The configuration module of Xmobar, a text based status bar-----------------------------------------------------------------------------------module Config- ( -- * Configuration- -- $config- Config (..)- , XPosition (..), Align (..)- , defaultConfig- , runnableTypes- ) where--import Commands-import {-# SOURCE #-} Runnable-import Plugins.Monitors-import Plugins.Date-import Plugins.PipeReader-import Plugins.CommandReader-import Plugins.StdinReader-import Plugins.XMonadLog-import Plugins.EWMH--#ifdef INOTIFY-import Plugins.Mail-import Plugins.MBox-#endif---- $config--- Configuration data type and default configuration---- | The configuration data type-data Config =- Config { font :: String -- ^ Font- , bgColor :: String -- ^ Backgroud color- , fgColor :: String -- ^ Default font color- , position :: XPosition -- ^ Top Bottom or Static- , lowerOnStart :: Bool -- ^ Lower to the bottom of the- -- window stack on initialization- , commands :: [Runnable] -- ^ For setting the command, the command arguments- -- and refresh rate for the programs to run (optional)- , sepChar :: String -- ^ The character to be used for indicating- -- commands in the output template (default '%')- , alignSep :: String -- ^ Separators for left, center and right text alignment- , template :: String -- ^ The output template- } deriving (Read)--data XPosition = Top- | TopW Align Int- | TopSize Align Int Int- | Bottom- | BottomW Align Int- | BottomSize Align Int Int- | Static {xpos, ypos, width, height :: Int}- | OnScreen Int XPosition- deriving ( Read, Eq )--data Align = L | R | C deriving ( Read, Eq )---- | The default configuration values-defaultConfig :: Config-defaultConfig =- Config { font = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"- , bgColor = "#000000"- , fgColor = "#BFBFBF"- , position = Top- , lowerOnStart = True- , commands = [ Run $ Date "%a %b %_d %Y * %H:%M:%S" "theDate" 10- , Run StdinReader]- , sepChar = "%"- , alignSep = "}{"- , template = "%StdinReader% }{ <fc=#00FF00>%uname%</fc> * <fc=#FF0000>%theDate%</fc>"- }----- | An alias for tuple types that is more convenient for long lists.-type a :*: b = (a, b)-infixr :*:---- | This is the list of types that can be hidden inside--- 'Runnable.Runnable', the existential type that stores all commands--- to be executed by Xmobar. It is used by 'Runnable.readRunnable' in--- the 'Runnable.Runnable' Read instance. To install a plugin just add--- the plugin's type to the list of types (separated by ':*:') appearing in--- this function's type signature.-runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*:-#ifdef INOTIFY- Mail :*: MBox :*:-#endif- ()-runnableTypes = undefined
− IWlib.hsc
@@ -1,77 +0,0 @@--------------------------------------------------------------------------------- |--- Module : IWlib--- Copyright : (c) Jose A Ortega Ruiz--- License : BSD-style (see LICENSE)------ Maintainer : Jose A Ortega Ruiz <jao@gnu.org>--- Stability : unstable--- Portability : unportable------ A partial binding to iwlib-----------------------------------------------------------------------------------{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-}---module IWlib (WirelessInfo(..), getWirelessInfo) where--import Foreign-import Foreign.C.Types-import Foreign.C.String--data WirelessInfo = WirelessInfo { wiEssid :: String, wiQuality :: Int }- deriving Show--#include <iwlib.h>--data WCfg-data WStats-data WRange--foreign import ccall "iwlib.h iw_sockets_open"- c_iw_open :: IO CInt--foreign import ccall "unistd.h close"- c_iw_close :: CInt -> IO ()--foreign import ccall "iwlib.h iw_get_basic_config"- c_iw_basic_config :: CInt -> CString -> Ptr WCfg -> IO CInt--foreign import ccall "iwlib.h iw_get_stats"- c_iw_stats :: CInt -> CString -> Ptr WStats -> Ptr WRange -> CInt -> IO CInt--foreign import ccall "iwlib.h iw_get_range_info"- c_iw_range :: CInt -> CString -> Ptr WRange -> IO CInt--getWirelessInfo :: String -> IO WirelessInfo-getWirelessInfo iface =- allocaBytes (#size struct wireless_config) $ \wc ->- allocaBytes (#size struct iw_statistics) $ \stats ->- allocaBytes (#size struct iw_range) $ \rng ->- withCString iface $ \istr -> do- i <- c_iw_open- bcr <- c_iw_basic_config i istr wc- str <- c_iw_stats i istr stats rng 1- rgr <- c_iw_range i istr rng- c_iw_close i- if (bcr < 0) then return nullInfo else- do hase <- (#peek struct wireless_config, has_essid) wc :: IO CInt- eon <- (#peek struct wireless_config, essid_on) wc :: IO CInt- essid <- if hase /= 0 && eon /= 0 then- do l <- (#peek struct wireless_config, essid_len) wc- let e = (#ptr struct wireless_config, essid) wc- peekCStringLen (e, fromIntegral (l :: CInt))- else return ""- q <- if str >= 0 && rgr >=0 then- do qualv <- xqual $ (#ptr struct iw_statistics, qual) stats- mv <- xqual $ (#ptr struct iw_range, max_qual) rng- let mxv = if mv /= 0 then fromIntegral mv else 1- return $ fromIntegral qualv / mxv- else return (-1)- let qv = round (100 * (q :: Double))- return $ WirelessInfo { wiEssid = essid, wiQuality = min 100 qv }- where nullInfo = WirelessInfo { wiEssid = "", wiQuality = -1 }- xqual p = let qp = (#ptr struct iw_param, value) p in- (#peek struct iw_quality, qual) qp :: IO CChar
− Main.hs
@@ -1,161 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}--------------------------------------------------------------------------------- |--- Module : Xmobar.Main--- Copyright : (c) Andrea Rossato--- License : BSD-style (see LICENSE)------ Maintainer : Andrea Rossato <andrea.rossato@unitn.it>--- Stability : unstable--- Portability : unportable------ The main module of Xmobar, a text based status bar-----------------------------------------------------------------------------------module Main ( -- * Main Stuff- -- $main- main- , readConfig- , readDefaultConfig- ) where--import Xmobar-import Parsers-import Config-import XUtil--import Data.List (intercalate)--import Paths_xmobar (version)-import Data.IORef-import Data.Version (showVersion)-import Graphics.X11.Xlib-import System.Console.GetOpt-import System.Exit-import System.Environment-import System.Posix.Files-import Control.Monad (unless)---- $main---- | The main entry point-main :: IO ()-main = do- d <- openDisplay ""- args <- getArgs- (o,file) <- getOpts args- (c,defaultings) <- case file of- [cfgfile] -> readConfig cfgfile- _ -> readDefaultConfig-- unless (null defaultings) $ putStrLn $ "Fields missing from config defaulted: "- ++ intercalate "," defaultings-- -- listen for ConfigureEvents on the root window, for xrandr support:- rootw <- rootWindow d (defaultScreen d)- selectInput d rootw structureNotifyMask-- civ <- newIORef c- doOpts civ o- conf <- readIORef civ- fs <- initFont d (font conf)- cl <- parseTemplate conf (template conf)- vars <- mapM startCommand cl- (r,w) <- createWin d fs conf- eventLoop (XConf d r w fs conf) vars---- | Reads the configuration files or quits with an error-readConfig :: FilePath -> IO (Config,[String])-readConfig f = do- file <- io $ fileExist f- s <- io $ if file then readFileSafe f else error $ f ++ ": file not found!\n" ++ usage- either (\err -> error $ f ++ ": configuration file contains errors at:\n" ++ show err)- return $ parseConfig s---- | Read default configuration file or load the default config-readDefaultConfig :: IO (Config,[String])-readDefaultConfig = do- home <- io $ getEnv "HOME"- let path = home ++ "/.xmobarrc"- f <- io $ fileExist path- if f then readConfig path else return (defaultConfig,[])--data Opts = Help- | Version- | Font String- | BgColor String- | FgColor String- | T- | B- | AlignSep String- | Commands String- | SepChar String- | Template String- | OnScr String- deriving Show--options :: [OptDescr Opts]-options =- [ Option ['h','?' ] ["help" ] (NoArg Help ) "This help"- , Option ['V' ] ["version" ] (NoArg Version ) "Show version information"- , Option ['f' ] ["font" ] (ReqArg Font "font name") "The font name"- , Option ['B' ] ["bgcolor" ] (ReqArg BgColor "bg color" ) "The background color. Default black"- , Option ['F' ] ["fgcolor" ] (ReqArg FgColor "fg color" ) "The foreground color. Default grey"- , Option ['o' ] ["top" ] (NoArg T ) "Place xmobar at the top of the screen"- , Option ['b' ] ["bottom" ] (NoArg B ) "Place xmobar at the bottom of the screen"- , Option ['a' ] ["alignsep" ] (ReqArg AlignSep "alignsep" ) "Separators for left, center and right text\nalignment. Default: '}{'"- , Option ['s' ] ["sepchar" ] (ReqArg SepChar "char" ) "The character used to separate commands in\nthe output template. Default '%'"- , Option ['t' ] ["template" ] (ReqArg Template "template" ) "The output template"- , Option ['c' ] ["commands" ] (ReqArg Commands "commands" ) "The list of commands to be executed"- , Option ['x' ] ["screen" ] (ReqArg OnScr "screen" ) "On which X screen number to start"- ]--getOpts :: [String] -> IO ([Opts], [String])-getOpts argv =- case getOpt Permute options argv of- (o,n,[]) -> return (o,n)- (_,_,errs) -> error (concat errs ++ usage)--usage :: String-usage = (usageInfo header options) ++ footer- where header = "Usage: xmobar [OPTION...] [FILE]\nOptions:"- footer = "\nMail bug reports and suggestions to " ++ mail--info :: String-info = "xmobar " ++ showVersion version ++ " (C) 2007 - 2009 Andrea Rossato " ++ mail ++ license--mail :: String-mail = "<andrea.rossato@unitn.it>\n"--license :: String-license = "\nThis program is distributed in the hope that it will be useful,\n" ++- "but WITHOUT ANY WARRANTY; without even the implied warranty of\n" ++- "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n" ++- "See the License for more details."--doOpts :: IORef Config -> [Opts] -> IO ()-doOpts _ [] = return ()-doOpts conf (o:oo) =- case o of- Help -> putStr usage >> exitWith ExitSuccess- Version -> putStrLn info >> exitWith ExitSuccess- Font s -> modifyIORef conf (\c -> c { font = s }) >> go- BgColor s -> modifyIORef conf (\c -> c { bgColor = s }) >> go- FgColor s -> modifyIORef conf (\c -> c { fgColor = s }) >> go- T -> modifyIORef conf (\c -> c { position = Top }) >> go- B -> modifyIORef conf (\c -> c { position = Bottom}) >> go- AlignSep s -> modifyIORef conf (\c -> c { alignSep = s }) >> go- SepChar s -> modifyIORef conf (\c -> c { sepChar = s }) >> go- Template s -> modifyIORef conf (\c -> c { template = s }) >> go- OnScr n -> modifyIORef conf (\c -> c { position = OnScreen (read n) $ position c }) >> go- Commands s -> case readCom s of- Right x -> modifyIORef conf (\c -> c { commands = x }) >> go- Left e -> putStr (e ++ usage) >> exitWith (ExitFailure 1)- where readCom str =- case readStr str of- [x] -> Right x- _ -> Left "xmobar: cannot read list of commands specified with the -c option\n"- readStr str =- [x | (x,t) <- reads str, ("","") <- lex t]- go = doOpts conf oo
+ NEWS view
@@ -0,0 +1,62 @@+% xmobar - Release notes+% Jose A. Ortega Ruiz++## Version 0.12 (Dec 24, 2010)++xmobar has a new [maintainer], a new [website], a new [mailing+list] and uses a new [source code repository].++Many thanks to Andrea Rossato, xombar's author and maintainer so far,+for creating xmobar in the first place, and for giving me the chance+to become its maintainer. And a big thanks to Ben Boeckel, Petr Rockai+and Norbert Zeh for their patches.++[website]: http://projects.haskell.org/xmobar/+[mailing list]: http://projects.haskell.org/cgi-bin/mailman/listinfo/xmobar+[source code repository]: https://github.com/jaor/xmobar+[maintainer]: http://hacks-galore.org/jao/++_New features_++ - Window borders: configuration options `border` and `borderColor`+ allow drawing borders around xmobar's window.+ - New monitor, `Uptime`, showing the system uptime.+ - New monitor argument (`-S`) to enable displaying the `%` symbol in+ percentages or other suffixes (e.g., units in Uptime and Network);+ the symbol is now never included by default.+ - New 'run once' commands, by specifying a 0 refresh rate in `Run+ Com` ([issue 26]).+ - MPD monitor: updated to libmpd 1.5. New fields `ppos` (playlist+ position) and `remaining` (remaining time). New configuration+ options to specify MPD's host, user name and password.+ - Battery monitor: new `watts` and `timeleft` fields (Petr Rockai),+ and specific arguments to control coloring and thresholds of the+ former.+ - MultiCPU monitor: new `auto*` fields that automatically detect all+ present CPUs (Ben Boeckel).+ - CpuFreq monitor uses just one decimal digit for GHz values (Petr+ Rockai).+ - Mail plugin expands paths starting with "~/" (Ben Boeckel). Ditto+ MBox.+ - Weather monitor now skips not retrieved fields, instead of+ displaying a long error message.+ - New compilation flag, `all_extensions`.+ - Documentation and website updates.++_Bug fixes_++ - [issue 23]: Wireless monitor is now compatible with iwlib 29.+ - [issue 24]: Swap monitor's used ratio display fixed.+ - [issue 25]: Percentages only include `%` if requested using `-P`.+ - [issue 31]: MPD monitor now respects `-W` argument.+ - Fixes in CPU frequency formatting, string alignment and colour+ boxes in monitors (Norbert Zeh).+ - TopMem and TopProc now use the `-L` and `-H` options correctly for+ memory template fields.+ - MBox skips non-existent mbox paths instead of hanging.++[issue 23]: http://code.google.com/p/xmobar/issues/detail?id=23+[issue 24]: http://code.google.com/p/xmobar/issues/detail?id=24+[issue 25]: http://code.google.com/p/xmobar/issues/detail?id=25+[issue 26]: http://code.google.com/p/xmobar/issues/detail?id=26+[issue 31]: http://code.google.com/p/xmobar/issues/detail?id=31
− Parsers.hs
@@ -1,179 +0,0 @@-{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving #-}--------------------------------------------------------------------------------- |--- Module : Xmobar.Parsers--- Copyright : (c) Andrea Rossato--- License : BSD-style (see LICENSE)------ Maintainer : Andrea Rossato <andrea.rossato@unitn.it>--- Stability : unstable--- Portability : unportable------ Parsers needed for Xmobar, a text based status bar-----------------------------------------------------------------------------------module Parsers- ( parseString- , parseTemplate- , parseConfig- ) where--import Config-import Runnable-import Commands--import qualified Data.Map as Map-import Text.ParserCombinators.Parsec-import Text.ParserCombinators.Parsec.Perm---- | Runs the string parser-parseString :: Config -> String -> IO [(String, String)]-parseString c s =- case parse (stringParser (fgColor c)) "" s of- Left _ -> return [("Could not parse string: " ++ s, fgColor c)]- Right x -> return (concat x)---- | Gets the string and combines the needed parsers-stringParser :: String -> Parser [[(String, String)]]-stringParser c = manyTill (textParser c <|> colorParser) eof---- | Parses a maximal string without color markup.-textParser :: String -> Parser [(String, String)]-textParser c = do s <- many1 $- noneOf "<" <|>- ( try $ notFollowedBy' (char '<')- (string "fc=" <|> string "/fc>" ) )- return [(s, c)]---- | Wrapper for notFollowedBy that returns the result of the first parser.--- Also works around the issue that, at least in Parsec 3.0.0, notFollowedBy--- accepts only parsers with return type Char.-notFollowedBy' :: Parser a -> Parser b -> Parser a-notFollowedBy' p e = do x <- p- notFollowedBy $ try (e >> return '*')- return x---- | Parsers a string wrapped in a color specification.-colorParser :: Parser [(String, String)]-colorParser = do- c <- between (string "<fc=") (string ">") colors- s <- manyTill (textParser c <|> colorParser) (try $ string "</fc>")- return (concat s)---- | Parses a color specification (hex or named)-colors :: Parser String-colors = many1 (alphaNum <|> char ',' <|> char '#')---- | Parses the output template string-templateStringParser :: Config -> Parser (String,String,String)-templateStringParser c = do- s <- allTillSep c- com <- templateCommandParser c- ss <- allTillSep c- return (com, s, ss)---- | Parses the command part of the template string-templateCommandParser :: Config -> Parser String-templateCommandParser c =- let chr = char . head . sepChar- in between (chr c) (chr c) (allTillSep c)---- | Combines the template parsers-templateParser :: Config -> Parser [(String,String,String)]-templateParser = many . templateStringParser---- | Actually runs the template parsers-parseTemplate :: Config -> String -> IO [(Runnable,String,String)]-parseTemplate c s =- do str <- case parse (templateParser c) "" s of- Left _ -> return [("","","")]- Right x -> return x- let cl = map alias (commands c)- m = Map.fromList $ zip cl (commands c)- return $ combine c m str---- | Given a finite "Map" and a parsed template produce the resulting--- output string.-combine :: Config -> Map.Map String Runnable -> [(String, String, String)] -> [(Runnable,String,String)]-combine _ _ [] = []-combine c m ((ts,s,ss):xs) = (com, s, ss) : combine c m xs- where com = Map.findWithDefault dflt ts m- dflt = Run $ Com ts [] [] 10--allTillSep :: Config -> Parser String-allTillSep = many . noneOf . sepChar--stripComments :: String -> String-stripComments = unlines . map (drop 5 . strip False . (replicate 5 ' '++)) . lines- where strip m ('-':'-':xs) = if m then "--" ++ strip m xs else ""- strip m ('\\':xss) = case xss of- '\\':xs -> '\\' : strip m xs- _ -> strip m $ drop 1 xss- strip m ('"':xs) = '"': strip (not m) xs- strip m (x:xs) = x : strip m xs- strip _ [] = []---- | Parse the config, logging a list of fields that were missing and replaced--- by the default definition.-parseConfig :: String -> Either ParseError (Config,[String])-parseConfig = runParser parseConf fields "Config" . stripComments- where- parseConf = do- many space- sepEndSpc ["Config","{"]- x <- perms- eof- s <- getState- return (x,s)-- perms = permute $ Config- <$?> pFont <|?> pBgColor- <|?> pFgColor <|?> pPosition- <|?> pLowerOnStart <|?> pCommands- <|?> pSepChar <|?> pAlignSep- <|?> pTemplate-- fields = [ "font", "bgColor", "fgColor", "sepChar", "alignSep"- , "template", "position", "lowerOnStart", "commands"]- pFont = strField font "font"- pBgColor = strField bgColor "bgColor"- pFgColor = strField fgColor "fgColor"- pSepChar = strField sepChar "sepChar"- pAlignSep = strField alignSep "alignSep"- pTemplate = strField template "template"-- pPosition = field position "position" $ tillFieldEnd >>= read' "position"- pLowerOnStart = field lowerOnStart "lowerOnStart" $ tillFieldEnd >>= read' "lowerOnStart"- pCommands = field commands "commands" $ readCommands-- staticPos = do string "Static"- wrapSkip (string "{")- p <- many (noneOf "}")- wrapSkip (string "}")- string ","- return ("Static {" ++ p ++ "}")- tillFieldEnd = staticPos <|> many (noneOf ",}\n\r")-- commandsEnd = wrapSkip (string "]") >> oneOf "},"- readCommands = manyTill anyChar (try commandsEnd) >>= read' commandsErr . flip (++) "]"-- strField e n = field e n . between (strDel "start" n) (strDel "end" n) . many $ noneOf "\"\n\r"- strDel t n = char '"' <?> strErr t n- strErr t n = "the " ++ t ++ " of the string field " ++ n ++ " - a double quote (\")."-- wrapSkip x = many space >> x >>= \r -> many space >> return r- sepEndSpc = mapM_ (wrapSkip . try . string)- fieldEnd = many $ space <|> oneOf ",}"- field e n c = (,) (e defaultConfig) $- updateState (filter (/= n)) >> sepEndSpc [n,"="] >>- wrapSkip c >>= \r -> fieldEnd >> return r-- read' d s = case reads s of- [(x, _)] -> return x- _ -> fail $ "error reading the " ++ d ++ " field: " ++ s--commandsErr :: String-commandsErr = "commands: this usually means that a command could not be parsed.\n" ++- "The error could be located at the begining of the command which follows the offending one."-
− Plugins.hs
@@ -1,25 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Xmobar.Plugins--- Copyright : (c) Andrea Rossato--- License : BSD-style (see LICENSE)------ Maintainer : Andrea Rossato <andrea.rossato@unitn.it>--- Stability : unstable--- Portability : unportable------ This module exports the API for plugins.------ Have a look at Plugins\/HelloWorld.hs-----------------------------------------------------------------------------------module Plugins- ( Exec (..)- , tenthSeconds- , readFileSafe- , hGetLineSafe- ) where--import Commands-import XUtil
− Plugins/CommandReader.hs
@@ -1,39 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Plugins.CommandReader--- Copyright : (c) John Goerzen--- License : BSD-style (see LICENSE)------ Maintainer : Andrea Rossato <andrea.rossato@unibz.it>--- Stability : unstable--- Portability : unportable------ A plugin for reading from external commands--- note: stderr is lost here-----------------------------------------------------------------------------------module Plugins.CommandReader where--import System.IO-import Plugins-import System.Process(runInteractiveCommand, getProcessExitCode)--data CommandReader = CommandReader String String- deriving (Read, Show)--instance Exec CommandReader where- alias (CommandReader _ a) = a- start (CommandReader p _) cb = do- (hstdin, hstdout, hstderr, ph) <- runInteractiveCommand p- hClose hstdin- hClose hstderr- hSetBinaryMode hstdout False- hSetBuffering hstdout LineBuffering- forever ph (hGetLineSafe hstdout >>= cb)- where forever ph a = - do a- ec <- getProcessExitCode ph- case ec of- Nothing -> forever ph a- Just _ -> cb "EXITED"
− Plugins/Date.hs
@@ -1,37 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Plugins.Date--- Copyright : (c) Andrea Rossato--- License : BSD-style (see LICENSE)------ Maintainer : Andrea Rossato <andrea.rossato@unibz.it>--- Stability : unstable--- Portability : unportable------ A date plugin for Xmobar------ Usage example: in template put------ > Run Date "%a %b %_d %Y <fc=#ee9a00> %H:%M:%S</fc>" "Mydate" 10-----------------------------------------------------------------------------------module Plugins.Date where--import Plugins--import System.Locale-import System.Time--data Date = Date String String Int- deriving (Read, Show)--instance Exec Date where- alias (Date _ a _) = a- run (Date f _ _) = date f- rate (Date _ _ r) = r--date :: String -> IO String-date format = do- t <- toCalendarTime =<< getClockTime- return $ formatCalendarTime defaultTimeLocale format t
− Plugins/EWMH.hs
@@ -1,264 +0,0 @@-{-# OPTIONS_GHC -w #-}-{-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns, GeneralizedNewtypeDeriving #-}---------------------------------------------------------------------------------- |--- Module : Plugins.EWMH--- Copyright : (c) Spencer Janssen--- License : BSD-style (see LICENSE)------ Maintainer : Spencer Janssen <spencerjanssen@gmail.com>--- Stability : unstable--- Portability : unportable------ An experimental plugin to display EWMH pager information-----------------------------------------------------------------------------------module Plugins.EWMH (EWMH(..)) where--import Control.Monad.State-import Control.Monad.Reader-import Graphics.X11 hiding (Modifier, Color)-import Graphics.X11.Xlib.Extras-import Plugins-#ifdef UTF8-#undef UTF8-import Codec.Binary.UTF8.String as UTF8-#define UTF8-#endif-import Foreign.C (CChar, CLong)-import XUtil (nextEvent')--import Data.List (intersperse, intercalate)--import Data.Map (Map)-import qualified Data.Map as Map-import Data.Set (Set)-import qualified Data.Set as Set---data EWMH = EWMH | EWMHFMT Component deriving (Read, Show)--instance Exec EWMH where- alias EWMH = "EWMH"-- start ew cb = allocaXEvent $ \ep -> execM $ do- d <- asks display- r <- asks root-- liftIO xSetErrorHandler-- liftIO $ selectInput d r propertyChangeMask- handlers' <- mapM (\(a, h) -> liftM2 (,) (getAtom a) (return h)) handlers- mapM_ ((=<< asks root) . snd) handlers'-- forever $ do- liftIO . cb . fmtOf ew =<< get- liftIO $ nextEvent' d ep- e <- liftIO $ getEvent ep- case e of- PropertyEvent { ev_atom = a, ev_window = w } -> do- case lookup a handlers' of- Just f -> f w- _ -> return ()- _ -> return ()-- return ()--defaultPP = Sep (Text " : ") [ Workspaces [Color "white" "black" :% Current, Hide :% Empty]- , Layout- , Color "#00ee00" "" :$ Short 120 :$ WindowName]--fmtOf EWMH = flip fmt defaultPP-fmtOf (EWMHFMT f) = flip fmt f--sep :: [a] -> [[a]] -> [a]-sep x xs = intercalate x $ filter (not . null) xs--fmt :: EwmhState -> Component -> String-fmt e (Text s) = s-fmt e (l :+ r) = fmt e l ++ fmt e r-fmt e (m :$ r) = modifier m $ fmt e r-fmt e (Sep c xs) = sep (fmt e c) $ map (fmt e) xs-fmt e WindowName = windowName $ Map.findWithDefault initialClient (activeWindow e) (clients e)-fmt e Layout = layout e-fmt e (Workspaces opts) = sep " "- [foldr ($) n [modifier m | (m :% a) <- opts, a `elem` as]- | (n, as) <- attrs]- where- stats i = [ (Current, i == currentDesktop e)- , (Empty, Set.notMember i nonEmptys && i /= currentDesktop e)- -- TODO for visible , (Visibl- ]- attrs :: [(String, [WsType])]- attrs = [(n, [s | (s, b) <- stats i, b]) | (i, n) <- zip [0 ..] (desktopNames e)]- nonEmptys = Set.unions . map desktops . Map.elems $ clients e--modifier :: Modifier -> (String -> String)-modifier Hide = const ""-modifier (Color fg bg) = \x -> concat ["<fc=", fg, if null bg then "" else "," ++ bg- , ">", x, "</fc>"]-modifier (Short n) = take n-modifier (Wrap l r) = \x -> l ++ x ++ r--data Component = Text String- | Component :+ Component- | Modifier :$ Component- | Sep Component [Component]- | WindowName- | Layout- | Workspaces [WsOpt]- deriving (Read, Show)--infixr 0 :$-infixr 5 :+--data Modifier = Hide- | Color String String- | Short Int- | Wrap String String- deriving (Read, Show)--data WsOpt = Modifier :% WsType- | WSep Component- deriving (Read, Show)-infixr 0 :%--data WsType = Current | Empty | Visible- deriving (Read, Show, Eq)--data EwmhConf = C { root :: Window- , display :: Display }--data EwmhState = S { currentDesktop :: CLong- , activeWindow :: Window- , desktopNames :: [String]- , layout :: String- , clients :: Map Window Client }- deriving Show--data Client = Cl { windowName :: String- , desktops :: Set CLong }- deriving Show--getAtom :: String -> M Atom-getAtom s = do- d <- asks display- liftIO $ internAtom d s False--windowProperty32 :: String -> Window -> M (Maybe [CLong])-windowProperty32 s w = do- (C {display}) <- ask- a <- getAtom s- liftIO $ getWindowProperty32 display a w--windowProperty8 :: String -> Window -> M (Maybe [CChar])-windowProperty8 s w = do- (C {display}) <- ask- a <- getAtom s- liftIO $ getWindowProperty8 display a w--initialState :: EwmhState-initialState = S 0 0 [] [] Map.empty--initialClient :: Client-initialClient = Cl "" Set.empty--handlers, clientHandlers :: [(String, Updater)]-handlers = [ ("_NET_CURRENT_DESKTOP", updateCurrentDesktop)- , ("_NET_DESKTOP_NAMES", updateDesktopNames )- , ("_NET_ACTIVE_WINDOW", updateActiveWindow)- , ("_NET_CLIENT_LIST", updateClientList)- ] ++ clientHandlers--clientHandlers = [ ("_NET_WM_NAME", updateName)- , ("_NET_WM_DESKTOP", updateDesktop) ]--newtype M a = M (ReaderT EwmhConf (StateT EwmhState IO) a)- deriving (Monad, Functor, MonadIO, MonadReader EwmhConf, MonadState EwmhState)--execM :: M a -> IO a-execM (M m) = do- d <- openDisplay ""- r <- rootWindow d (defaultScreen d)- let conf = C r d- evalStateT (runReaderT m (C r d)) initialState--type Updater = Window -> M ()--updateCurrentDesktop, updateDesktopNames, updateActiveWindow :: Updater-updateCurrentDesktop _ = do- (C {root}) <- ask- mwp <- windowProperty32 "_NET_CURRENT_DESKTOP" root- case mwp of- Just [x] -> modify (\s -> s { currentDesktop = x })- _ -> return ()--updateActiveWindow _ = do- (C {root}) <- ask- mwp <- windowProperty32 "_NET_ACTIVE_WINDOW" root- case mwp of- Just [x] -> modify (\s -> s { activeWindow = fromIntegral x })- _ -> return ()--updateDesktopNames _ = do- (C {root}) <- ask- mwp <- windowProperty8 "_NET_DESKTOP_NAMES" root- case mwp of- Just xs -> modify (\s -> s { desktopNames = parse xs })- _ -> return ()- where- dropNull ('\0':xs) = xs- dropNull xs = xs-- split [] = []- split xs = case span (/= '\0') xs of- (x, ys) -> x : split (dropNull ys)- parse = split . decodeCChar--updateClientList _ = do- (C {root}) <- ask- mwp <- windowProperty32 "_NET_CLIENT_LIST" root- case mwp of- Just xs -> do- cl <- gets clients- let cl' = Map.fromList $ map (flip (,) initialClient . fromIntegral) xs- dels = Map.difference cl cl'- new = Map.difference cl' cl- modify (\s -> s { clients = Map.union (Map.intersection cl cl') cl'})- mapM_ unmanage (map fst $ Map.toList dels)- mapM_ listen (map fst $ Map.toList cl')- mapM_ update (map fst $ Map.toList new)- _ -> return ()- where- unmanage w = asks display >>= \d -> liftIO $ selectInput d w 0- listen w = asks display >>= \d -> liftIO $ selectInput d w propertyChangeMask- update w = mapM_ (($ w) . snd) clientHandlers--modifyClient :: Window -> (Client -> Client) -> M ()-modifyClient w f = modify (\s -> s { clients = Map.alter f' w $ clients s })- where- f' Nothing = Just $ f initialClient- f' (Just x) = Just $ f x--updateName w = do- mwp <- windowProperty8 "_NET_WM_NAME" w- case mwp of- Just xs -> modifyClient w (\c -> c { windowName = decodeCChar xs })- _ -> return ()--updateDesktop w = do- mwp <- windowProperty32 "_NET_WM_DESKTOP" w- case mwp of- Just x -> modifyClient w (\c -> c { desktops = Set.fromList x })- _ -> return ()--decodeCChar :: [CChar] -> String-#ifdef UTF8-#undef UTF8-decodeCChar = UTF8.decode . map fromIntegral-#define UTF8-#else-decodeCChar = map (toEnum . fromIntegral)-#endif
− Plugins/HelloWorld.hs
@@ -1,24 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Plugins.HelloWorld--- Copyright : (c) Andrea Rossato--- License : BSD-style (see LICENSE)--- --- Maintainer : Andrea Rossato <andrea.rossato@unibz.it>--- Stability : unstable--- Portability : unportable------ A plugin example for Xmobar, a text based status bar -----------------------------------------------------------------------------------module Plugins.HelloWorld where--import Plugins--data HelloWorld = HelloWorld- deriving (Read, Show)--instance Exec HelloWorld where- alias HelloWorld = "helloWorld"- run HelloWorld = return "<fc=red>Hello World!!</fc>"
− Plugins/MBox.hs
@@ -1,124 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Plugins.MBox--- Copyright : (c) Jose A Ortega Ruiz--- License : BSD-style (see LICENSE)------ Maintainer : Jose A Ortega Ruiz <jao@gnu.org>--- Stability : unstable--- Portability : unportable------ A plugin for checking mail in mbox files.-----------------------------------------------------------------------------------module Plugins.MBox (MBox(..)) where--import Prelude hiding (catch)-import Plugins--import Control.Monad-import Control.Concurrent.STM-import Control.Exception (SomeException, handle, evaluate)--import System.Directory-import System.FilePath-import System.Console.GetOpt-import System.INotify---import qualified Data.ByteString.Lazy.Char8 as B--data Options = Options- { oAll :: Bool- , oUniq :: Bool- , oDir :: FilePath- , oPrefix :: String- , oSuffix :: String- }--defaults :: Options-defaults = Options {- oAll = False, oUniq = False, oDir = "", oPrefix = "", oSuffix = ""- }--options :: [OptDescr (Options -> Options)]-options =- [ Option "a" ["all"] (NoArg (\o -> o { oAll = True })) ""- , Option "u" [] (NoArg (\o -> o { oUniq = True })) ""- , Option "d" ["dir"] (ReqArg (\x o -> o { oDir = x }) "") ""- , Option "p" ["prefix"] (ReqArg (\x o -> o { oPrefix = x }) "") ""- , Option "s" ["suffix"] (ReqArg (\x o -> o { oSuffix = x }) "") ""- ]--parseOptions :: [String] -> IO Options-parseOptions args =- case getOpt Permute options args of- (o, _, []) -> return $ foldr id defaults o- (_, _, errs) -> ioError . userError $ concat errs---- | A list of display names, paths to mbox files and display colours,--- followed by a list of options.-data MBox = MBox [(String, FilePath, String)] [String] String- deriving (Read, Show)--instance Exec MBox where- alias (MBox _ _ a) = a- start (MBox ms args _) cb = do- vs <- mapM (const $ newTVarIO ("", 0 :: Int)) ms-- opts <- parseOptions args -- $ words args- let dir = oDir opts- allb = oAll opts- pref = oPrefix opts- suff = oSuffix opts- uniq = oUniq opts-- dirExists <- doesDirectoryExist dir- let ts = map (\(t, _, _) -> t) ms- sec = \(_, f, _) -> f- md = if dirExists then (dir </>) . sec else sec- fs = map md ms- cs = map (\(_, _, c) -> c) ms- ev = [CloseWrite]-- i <- initINotify- zipWithM_ (\f v -> addWatch i ev f (handleNotification v)) fs vs-- forM_ (zip fs vs) $ \(f, v) -> do- exists <- doesFileExist f- n <- if exists then countMails f else return 0- atomically $ writeTVar v (f, n)-- changeLoop (mapM (fmap snd . readTVar) vs) $ \ns ->- let s = unwords [ showC uniq m n c | (m, n, c) <- zip3 ts ns cs- , allb || n /= 0 ]- in cb (if length s == 0 then "" else pref ++ s ++ suff)--showC :: Bool -> String -> Int -> String -> String-showC u m n c =- if c == "" then msg else "<fc=" ++ c ++ ">" ++ msg ++ "</fc>"- where msg = m ++ if not u || n > 1 then show n else ""--countMails :: FilePath -> IO Int-countMails f =- handle ((\_ -> evaluate 0) :: SomeException -> IO Int)- (do txt <- B.readFile f- evaluate $! length . filter (B.isPrefixOf from) . B.lines $ txt)- where from = B.pack "From "--handleNotification :: TVar (FilePath, Int) -> Event -> IO ()-handleNotification v _ = do- (p, _) <- atomically $ readTVar v- n <- countMails p- atomically $ writeTVar v (p, n)--changeLoop :: Eq a => STM a -> (a -> IO ()) -> IO ()-changeLoop s f = atomically s >>= go- where- go old = do- f old- go =<< atomically (do- new <- s- guard (new /= old)- return new)
− Plugins/Mail.hs
@@ -1,78 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Plugins.Mail--- Copyright : (c) Spencer Janssen--- License : BSD-style (see LICENSE)------ Maintainer : Spencer Janssen <sjanssen@cse.unl.edu>--- Stability : unstable--- Portability : unportable------ A plugin for checking mail.-----------------------------------------------------------------------------------module Plugins.Mail where--import Prelude hiding (catch)-import Plugins--import Control.Monad-import Control.Concurrent.STM--import System.Directory-import System.FilePath-import System.INotify--import Data.List (isPrefixOf)-import Data.Set (Set)-import qualified Data.Set as S---- | A list of mail box names and paths to maildirs.-data Mail = Mail [(String, FilePath)]- deriving (Read, Show)--instance Exec Mail where- start (Mail ms) cb = do- vs <- mapM (const $ newTVarIO S.empty) ms-- let ts = map fst ms- ds = map ((</> "new") . snd) ms- ev = [Move, MoveIn, MoveOut, Create, Delete]-- i <- initINotify- zipWithM_ (\d v -> addWatch i ev d (handle v)) ds vs-- forM (zip ds vs) $ \(d, v) -> do- s <- fmap (S.fromList . filter (not . isPrefixOf "."))- $ getDirectoryContents d- atomically $ modifyTVar v (S.union s)-- changeLoop (mapM (fmap S.size . readTVar) vs) $ \ns -> do- cb . unwords $ [m ++ ":" ++ show n- | (m, n) <- zip ts ns- , n /= 0 ]--modifyTVar :: TVar a -> (a -> a) -> STM ()-modifyTVar v f = readTVar v >>= writeTVar v . f--handle :: TVar (Set String) -> Event -> IO ()-handle v e = atomically $ modifyTVar v $ case e of- Created {} -> create- MovedIn {} -> create- Deleted {} -> delete- MovedOut {} -> delete- _ -> id- where- delete = S.delete (filePath e)- create = S.insert (filePath e)--changeLoop :: Eq a => STM a -> (a -> IO ()) -> IO ()-changeLoop s f = atomically s >>= go- where- go old = do- f old- go =<< atomically (do- new <- s- guard (new /= old)- return new)
− Plugins/Monitors.hs
@@ -1,115 +0,0 @@-{-# LANGUAGE CPP #-}---------------------------------------------------------------------------------- |--- Module : Xmobar.Plugins.Monitors--- Copyright : (c) Andrea Rossato--- License : BSD-style (see LICENSE)------ Maintainer : Andrea Rossato <andrea.rossato@unibz.it>--- Stability : unstable--- Portability : unportable------ The system monitor plugin for Xmobar.-----------------------------------------------------------------------------------module Plugins.Monitors where--import Plugins--import Plugins.Monitors.Common ( runM )-import Plugins.Monitors.Weather-import Plugins.Monitors.Net-import Plugins.Monitors.Mem-import Plugins.Monitors.Swap-import Plugins.Monitors.Cpu-import Plugins.Monitors.MultiCpu-import Plugins.Monitors.Batt-import Plugins.Monitors.Thermal-import Plugins.Monitors.CpuFreq-import Plugins.Monitors.CoreTemp-import Plugins.Monitors.Disk-import Plugins.Monitors.Top-#ifdef IWLIB-import Plugins.Monitors.Wireless-#endif-#ifdef LIBMPD-import Plugins.Monitors.MPD-#endif--data Monitors = Weather Station Args Rate- | Network Interface Args Rate- | Memory Args Rate- | Swap Args Rate- | Cpu Args Rate- | MultiCpu Args Rate- | Battery Args Rate- | BatteryP [String] Args Rate- | DiskU DiskSpec Args Rate- | DiskIO DiskSpec Args Rate- | Thermal Zone Args Rate- | CpuFreq Args Rate- | CoreTemp Args Rate- | TopProc Args Rate- | TopMem Args Rate-#ifdef IWLIB- | Wireless Interface Args Rate-#endif-#ifdef LIBMPD- | MPD Args Rate-#endif- deriving (Show,Read,Eq)--type Args = [String]-type Program = String-type Alias = String-type Station = String-type Zone = String-type Interface = String-type Rate = Int-type DiskSpec = [(String, String)]--instance Exec Monitors where- alias (Weather s _ _) = s- alias (Network i _ _) = i- alias (Thermal z _ _) = z- alias (Memory _ _) = "memory"- alias (Swap _ _) = "swap"- alias (Cpu _ _) = "cpu"- alias (MultiCpu _ _) = "multicpu"- alias (Battery _ _) = "battery"- alias (BatteryP _ _ _)= "battery"- alias (CpuFreq _ _) = "cpufreq"- alias (TopProc _ _) = "top"- alias (TopMem _ _) = "topmem"- alias (CoreTemp _ _) = "coretemp"- alias (DiskU _ _ _) = "disku"- alias (DiskIO _ _ _) = "diskio"-#ifdef IWLIB- alias (Wireless i _ _) = i ++ "wi"-#endif-#ifdef LIBMPD- alias (MPD _ _) = "mpd"-#endif- start (Weather s a r) = runM (a ++ [s]) weatherConfig runWeather r- start (Network i a r) = runM (a ++ [i]) netConfig runNet r- start (Thermal z a r) = runM (a ++ [z]) thermalConfig runThermal r- start (Memory a r) = runM a memConfig runMem r- start (Swap a r) = runM a swapConfig runSwap r- start (Cpu a r) = runM a cpuConfig runCpu r- start (MultiCpu a r) = runM a multiCpuConfig runMultiCpu r- start (Battery a r) = runM a battConfig runBatt r- start (BatteryP s a r) = runM a battConfig (runBatt' s) r- start (CpuFreq a r) = runM a cpuFreqConfig runCpuFreq r- start (CoreTemp a r) = runM a coreTempConfig runCoreTemp r- start (DiskU s a r) = runM a diskUConfig (runDiskU s) r- start (DiskIO s a r) = runM a diskIOConfig (runDiskIO s) r- start (TopMem a r) = runM a topMemConfig runTopMem r- start (TopProc a r) = startTop a r-#ifdef IWLIB- start (Wireless i a r) = runM (a ++ [i]) wirelessConfig runWireless r-#endif-#ifdef LIBMPD- start (MPD a r) = runM a mpdConfig runMPD r-#endif
− Plugins/Monitors/Batt.hs
@@ -1,78 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Plugins.Monitors.Batt--- Copyright : (c) Andrea Rossato--- License : BSD-style (see LICENSE)------ Maintainer : Andrea Rossato <andrea.rossato@unibz.it>--- Stability : unstable--- Portability : unportable------ A battery monitor for Xmobar-----------------------------------------------------------------------------------module Plugins.Monitors.Batt where--import qualified Data.ByteString.Lazy.Char8 as B-import Plugins.Monitors.Common-import System.Posix.Files (fileExist)--data Batt = Batt Float String- | NA--battConfig :: IO MConfig-battConfig = mkMConfig- "Batt: <left>" -- template- ["leftbar", "left", "status"] -- available replacements--type File = (String, String)--file2batfile :: String -> (File, File)-file2batfile s = ( (s' ++ "/charge_full", s' ++ "/energy_full")- , (s' ++ "/charge_now" , s' ++ "/energy_now" )- )- where s' = "/sys/class/power_supply/" ++ s--readFileBatt :: (File, File) -> IO (String, String, String)-readFileBatt (f,n) =- do a <- rf f- b <- rf n- ac <- fileExist "/sys/class/power_supply/AC0/online"- c <- if not ac- then return []- else do s <- B.unpack `fmap` catRead "/sys/class/power_supply/AC0/online"- return $ if s == "1\n" then "<fc=green>On</fc>" else"<fc=red>Off</fc>"- return (a,b,c)- where rf file = do- fe <- fileExist (fst file)- if fe- then B.unpack `fmap` catRead (fst file)- else do fe' <- fileExist (snd file)- if fe'- then B.unpack `fmap` catRead (snd file)- else return []--parseBATT :: [(File,File)] -> IO Batt-parseBATT bfs =- do [(a0,b0,c0),(a1,b1,_),(a2,b2,_)] <- mapM readFileBatt (take 3 $ bfs ++ repeat (("",""),("","")))- let read' s = if s == [] then 0 else read s- left = (read' b0 + read' b1 + read' b2) / (read' a0 + read' a1 + read' a2) --present / full- return $ if isNaN left then NA else Batt left c0--formatBatt :: Float -> Monitor [String]-formatBatt x = do- p <- showPercentsWithColors [x]- b <- showPercentBar (100 * x) x- return (b:p)--runBatt :: [String] -> Monitor String-runBatt = runBatt' ["BAT0","BAT1","BAT2"]--runBatt' :: [String] -> [String] -> Monitor String-runBatt' bfs _ = do- c <- io $ parseBATT (map file2batfile bfs)- case c of- Batt x s -> do l <- formatBatt x- parseTemplate (l ++ [s])- NA -> return "N/A"
− Plugins/Monitors/Common.hs
@@ -1,424 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Plugins.Monitors.Common--- Copyright : (c) Andrea Rossato--- License : BSD-style (see LICENSE)------ Maintainer : Andrea Rossato <andrea.rossato@unibz.it>--- Stability : unstable--- Portability : unportable------ Utilities for creating monitors for Xmobar-----------------------------------------------------------------------------------module Plugins.Monitors.Common (- -- * Monitors- -- $monitor- Monitor- , MConfig (..)- , Opts (..)- , setConfigValue- , getConfigValue- , mkMConfig- , runM- , io- -- * Parsers- -- $parsers- , runP- , skipRestOfLine- , getNumbers- , getNumbersAsString- , getAllBut- , getAfterString- , skipTillString- , parseTemplate- -- ** String Manipulation- -- $strings- , padString- , showWithPadding- , showWithColors- , showWithColors'- , showPercentsWithColors- , showPercentBar- , showLogBar- , showWithUnits- , takeDigits- , showDigits- , floatToPercent- , stringParser- -- * Threaded Actions- -- $thread- , doActionTwiceWithDelay- , catRead- ) where---import Control.Concurrent-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 Numeric-import Text.ParserCombinators.Parsec-import System.Console.GetOpt-import Control.Exception (SomeException,handle)-import System.Process (readProcess)--import Plugins--- $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- , minWidth :: IORef Int- , maxWidth :: IORef Int- , padChars :: IORef [Char]- , padRight :: IORef Bool- , barBack :: IORef String- , barFore :: IORef String- , barWidth :: IORef Int- }---- | 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 (\_ -> v)--getConfigValue :: Selector a -> Monitor a-getConfigValue s =- sel s--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- mn <- newIORef 0- mx <- newIORef 0- pc <- newIORef " "- pr <- newIORef False- bb <- newIORef ":"- bf <- newIORef "#"- bw <- newIORef 10- return $ MC nc l lc h hc t e p mn mx pc pr bb bf bw--data Opts = HighColor String- | NormalColor String- | LowColor String- | Low String- | High String- | Template String- | PercentPad String- | MinWidth String- | MaxWidth String- | Width String- | PadChars String- | PadAlign String- | BarBack String- | BarFore String- | BarWidth 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 ['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 ['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"- ]--doArgs :: [String]- -> ([String] -> Monitor String)- -> Monitor String-doArgs args action =- do case (getOpt Permute options args) of- (o, n, [] ) -> do doConfigOptions o- action n- (_, _, 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- case o of- High h -> setConfigValue (read h) high >> next- Low l -> setConfigValue (read l) low >> next- HighColor hc -> setConfigValue (Just hc) highColor >> next- NormalColor nc -> setConfigValue (Just nc) normalColor >> next- LowColor lc -> setConfigValue (Just lc) lowColor >> next- Template t -> setConfigValue t template >> next- PercentPad p -> setConfigValue (nz p) ppad >> next- MinWidth mn -> setConfigValue (nz mn) minWidth >> next- MaxWidth mx -> setConfigValue (nz mx) maxWidth >> next- Width w -> setConfigValue (nz w) minWidth >>- setConfigValue (nz w) maxWidth >> next- PadChars pc -> setConfigValue pc padChars >> next- PadAlign pa -> setConfigValue (isPrefixOf "r" pa) padRight >> next- BarBack bb -> setConfigValue bb barBack >> next- BarFore bf -> setConfigValue bf barFore >> next- BarWidth bw -> setConfigValue (nz bw) barWidth >> next--runM :: [String] -> IO MConfig -> ([String] -> Monitor String) -> Int -> (String -> IO ()) -> IO ()-runM args conf action r cb = do go- where go = do- c <- conf- let ac = doArgs args action- he = return . (++) "error: " . show . flip asTypeOf (undefined::SomeException)- s <- handle he $ runReaderT ac c- cb s- tenthSeconds r- go--io :: IO a -> Monitor a-io = liftIO------ $parsers--runP :: Parser [a] -> String -> IO [a]-runP p i =- do 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- ; v <- manyTill anyChar $ newline- ; return v- } <|> return ("<" ++ s ++ " not found!>")--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 = liftM concat . many $- (many1 $ noneOf "<") <|> colorSpec---- | 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 ++ ">")---- | 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 --"%")---- | 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.-parseTemplate :: [String] -> Monitor String-parseTemplate l =- do t <- getConfigValue template- s <- io $ runP templateParser t- e <- getConfigValue export- let m = Map.fromList . zip e $ l- return $ combine m s---- | Given a finite "Map" and a parsed templatet produces the--- | resulting output string.-combine :: Map.Map String String -> [(String, String, String)] -> String-combine _ [] = []-combine m ((s,ts,ss):xs) =- s ++ str ++ ss ++ combine m xs- where str = Map.findWithDefault err ts m- err = "<" ++ ts ++ " not found!>"---- $strings--type Pos = (Int, Int)--takeDigits :: Int -> Float -> Float-takeDigits d n =- fromIntegral ((round (n * fact)) :: Int) / fact- where fact = 10 ^ d--showDigits :: Int -> Float -> 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-padString mnw mxw pad pr 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- else let ps = take (rlen - len) (cycle pad)- in if pr then s ++ ps else ps ++ s--floatToPercent :: Float -> Monitor String-floatToPercent n =- do pad <- getConfigValue ppad- pc <- getConfigValue padChars- pr <- getConfigValue padRight- let p = showDigits 0 (n * 100)- return $ padString pad pad pc pr p ++ "%"--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- return $ padString mn mx p pr 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 v = showWithColors (const str) v--showPercentsWithColors :: [Float] -> Monitor [String]-showPercentsWithColors fs =- do fstrs <- mapM floatToPercent fs- zipWithM (showWithColors . const) fstrs (map (*100) fs)--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)--showLogBar :: Float -> Float -> Monitor String-showLogBar f v = do- h <- fromIntegral `fmap` getConfigValue high- bw <- fromIntegral `fmap` getConfigValue barWidth- showPercentBar v $ f + (logBase 10 (v / h)) / bw---- $threads--doActionTwiceWithDelay :: Int -> IO [a] -> IO ([a], [a])-doActionTwiceWithDelay delay action =- do v1 <- newMVar []- forkIO $! getData action v1 0- v2 <- newMVar []- forkIO $! getData action v2 delay- threadDelay (delay `div` 3 * 4)- a <- readMVar v1- b <- readMVar v2- return (a,b)--getData :: IO a -> MVar a -> Int -> IO ()-getData action var d =- do threadDelay d- s <- action- modifyMVar_ var (\_ -> return $! s)--catRead :: FilePath -> IO B.ByteString-catRead file = B.pack `fmap` readProcess "/bin/cat" [file] ""
− Plugins/Monitors/CoreCommon.hs
@@ -1,58 +0,0 @@--------------------------------------------------------------------------------- |--- 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 Plugins.Monitors.CoreCommon where--import Plugins.Monitors.Common-import System.Posix.Files (fileExist)-import System.IO (withFile, IOMode(ReadMode), hGetLine)-import System.Directory-import Data.Char (isDigit)-import Data.List (isPrefixOf)---- |--- Function checks the existence of first file specified by pattern and if the--- file doesn't exists failure message is shown, otherwise the data retrieval--- is performed.-checkedDataRetrieval :: (Num a, Ord a, Show a) =>- String -> String -> String -> String -> (Double -> a)- -> Monitor String-checkedDataRetrieval failureMessage dir file pattern trans = do- exists <- io $ fileExist $ concat [dir, "/", pattern, "0/", file]- case exists of- False -> return failureMessage- True -> retrieveData dir file pattern trans---- |--- Function retrieves data from files in directory dir specified by--- pattern. String values are converted to double and 'trans' applied--- to each one. Final array is processed by template parser function--- and returned as monitor string.-retrieveData :: (Num a, Ord a, Show a) =>- String -> String -> String -> (Double -> a) -> Monitor String-retrieveData dir file pattern trans = do- count <- io $ dirCount dir pattern- contents <- io $ mapM getGuts $ files count- values <- mapM (showWithColors show) $ map conversion contents- parseTemplate values- where- getGuts f = withFile f ReadMode hGetLine- dirCount path str = getDirectoryContents path- >>= return . length- . filter (\s -> str `isPrefixOf` s- && isDigit (last s))- files count = map (\i -> concat [dir, "/", pattern, show i, "/", file])- [0 .. count - 1]- conversion = trans . (read :: String -> Double)-
− Plugins/Monitors/CoreTemp.hs
@@ -1,41 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Plugins.Monitors.CoreTemp--- Copyright : (c) Juraj Hercek--- License : BSD-style (see LICENSE)------ Maintainer : Juraj Hercek <juhe_haskell@hck.sk>--- Stability : unstable--- Portability : unportable------ A core temperature monitor for Xmobar-----------------------------------------------------------------------------------module Plugins.Monitors.CoreTemp where--import Plugins.Monitors.Common-import Plugins.Monitors.CoreCommon---- |--- Core temperature default configuration. Default template contains only one--- core temperature, user should specify custom template in order to get more--- core frequencies.-coreTempConfig :: IO MConfig-coreTempConfig = mkMConfig- "Temp: <core0>C" -- template- (zipWith (++) (repeat "core") (map show [0 :: Int ..])) -- available- -- replacements---- |--- Function retrieves monitor string holding the core temperature--- (or temperatures)-runCoreTemp :: [String] -> Monitor String-runCoreTemp _ = do- let dir = "/sys/bus/platform/devices"- file = "temp1_input"- pattern = "coretemp."- divisor = 1e3 :: Double- failureMessage = "CoreTemp: N/A"- checkedDataRetrieval failureMessage dir file pattern (/divisor)-
− Plugins/Monitors/Cpu.hs
@@ -1,53 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Plugins.Monitors.Cpu--- Copyright : (c) Andrea Rossato--- License : BSD-style (see LICENSE)------ Maintainer : Andrea Rossato <andrea.rossato@unibz.it>--- Stability : unstable--- Portability : unportable------ A cpu monitor for Xmobar-----------------------------------------------------------------------------------module Plugins.Monitors.Cpu where--import Plugins.Monitors.Common-import qualified Data.ByteString.Lazy.Char8 as B--cpuConfig :: IO MConfig-cpuConfig = mkMConfig- "Cpu: <total>" -- template- ["bar","total","user","nice","system","idle"] -- available replacements--cpuData :: IO [Float]-cpuData = do s <- B.readFile "/proc/stat"- return $ cpuParser s--cpuParser :: B.ByteString -> [Float]-cpuParser =- map read . map B.unpack . tail . B.words . flip (!!) 0 . B.lines--parseCPU :: IO [Float]-parseCPU =- do (a,b) <- doActionTwiceWithDelay 750000 cpuData- let dif = zipWith (-) b a- tot = foldr (+) 0 dif- percent = map (/ tot) dif- return percent--formatCpu :: [Float] -> Monitor [String]-formatCpu [] = return [""]-formatCpu xs = do- let t = foldr (+) 0 $ take 3 xs- b <- showPercentBar (100 * t) t- ps <- showPercentsWithColors (t:xs)- return (b:ps)--runCpu :: [String] -> Monitor String-runCpu _ =- do c <- io $ parseCPU- l <- formatCpu c- parseTemplate l
− Plugins/Monitors/CpuFreq.hs
@@ -1,40 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Plugins.Monitors.CpuFreq--- Copyright : (c) Juraj Hercek--- License : BSD-style (see LICENSE)------ Maintainer : Juraj Hercek <juhe_haskell@hck.sk>--- Stability : unstable--- Portability : unportable------ A cpu frequency monitor for Xmobar-----------------------------------------------------------------------------------module Plugins.Monitors.CpuFreq where--import Plugins.Monitors.Common-import Plugins.Monitors.CoreCommon---- |--- Cpu frequency default configuration. Default template contains only one--- core frequency, user should specify custom template in order to get more--- cpu frequencies.-cpuFreqConfig :: IO MConfig-cpuFreqConfig = mkMConfig- "Freq: <cpu0>GHz" -- template- (zipWith (++) (repeat "cpu") (map show [0 :: Int ..])) -- available- -- replacements---- |--- Function retrieves monitor string holding the cpu frequency (or frequencies)-runCpuFreq :: [String] -> Monitor String-runCpuFreq _ = do- let dir = "/sys/devices/system/cpu"- file = "cpufreq/scaling_cur_freq"- pattern = "cpu"- divisor = 1e6 :: Double- failureMessage = "CpuFreq: N/A"- checkedDataRetrieval failureMessage dir file pattern (/divisor)-
− Plugins/Monitors/Disk.hs
@@ -1,137 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Plugins.Monitors.Disk--- Copyright : (c) Jose A Ortega Ruiz--- License : BSD-style (see LICENSE)------ Maintainer : Jose A Ortega Ruiz <jao@gnu.org>--- Stability : unstable--- Portability : unportable------ Disk usage and throughput monitors for Xmobar-----------------------------------------------------------------------------------module Plugins.Monitors.Disk ( diskUConfig, runDiskU- , diskIOConfig, runDiskIO- ) where--import Plugins.Monitors.Common-import StatFS--import Control.Monad (zipWithM)-import qualified Data.ByteString.Lazy.Char8 as B-import Data.List (isPrefixOf, find, intercalate)--diskIOConfig :: IO MConfig-diskIOConfig = mkMConfig "" ["total", "read", "write",- "totalbar", "readbar", "writebar"]--diskUConfig :: IO MConfig-diskUConfig = mkMConfig ""- ["size", "free", "used", "freep", "usedp", "freebar", "usedbar"]--type DevName = String-type Path = String--mountedDevices :: [String] -> IO [(DevName, Path)]-mountedDevices req = do- s <- B.readFile "/etc/mtab"- return (parse s)- where- parse = map undev . filter isDev . map (firstTwo . B.words) . B.lines- firstTwo (a:b:_) = (B.unpack a, B.unpack b)- firstTwo _ = ("", "")- isDev (d, p) = "/dev/" `isPrefixOf` d &&- (p `elem` req || drop 5 d `elem` req)- undev (d, f) = (drop 5 d, f)--diskData :: IO [(DevName, [Float])]-diskData = do- s <- B.readFile "/proc/diskstats"- let extract ws = (head ws, map read (tail ws))- return $ map (extract . map B.unpack . drop 2 . B.words) (B.lines s)--mountedData :: [DevName] -> IO [(DevName, [Float])]-mountedData devs = do- (dt, dt') <- doActionTwiceWithDelay 750000 diskData- return $ map (parseDev (zipWith diff dt' dt)) devs- where diff (dev, xs) (_, ys) = (dev, zipWith (-) xs ys)--parseDev :: [(DevName, [Float])] -> DevName -> (DevName, [Float])-parseDev dat dev =- case find ((==dev) . fst) dat of- Nothing -> (dev, [0, 0, 0])- Just (_, xs) ->- let rSp = speed (xs !! 2) (xs !! 3)- wSp = speed (xs !! 6) (xs !! 7)- sp = speed (xs !! 2 + xs !! 6) (xs !! 3 + xs !! 7)- speed x t = if t == 0 then 0 else 500 * x / t- dat' = if length xs > 6 then [sp, rSp, wSp] else [0, 0, 0]- in (dev, dat')--fsStats :: String -> IO [Integer]-fsStats path = do- stats <- getFileSystemStats path- case stats of- Nothing -> return [-1, -1, -1]- Just f -> let tot = fsStatByteCount f- free = fsStatBytesAvailable f- used = fsStatBytesUsed f- in return [tot, free, used]--speedToStr :: Float -> String-speedToStr = showWithUnits 2 1--sizeToStr :: Integer -> String-sizeToStr = showWithUnits 3 0 . fromIntegral--findTempl :: DevName -> Path -> [(String, String)] -> String-findTempl dev path disks =- case find devOrPath disks of- Just (_, t) -> t- Nothing -> ""- where devOrPath (d, _) = d == dev || d == path--devTemplates :: [(String, String)]- -> [(DevName, Path)]- -> [(DevName, [Float])]- -> [(String, [Float])]-devTemplates disks mounted dat =- map (\(d, p) -> (findTempl d p disks, findData d)) mounted- where findData dev = case find ((==dev) . fst) dat of- Nothing -> [0, 0, 0]- Just (_, xs) -> xs--runDiskIO' :: (String, [Float]) -> Monitor String-runDiskIO' (tmp, xs) = do- s <- mapM (showWithColors speedToStr) xs- b <- mapM (showLogBar 0.8) xs- setConfigValue tmp template- parseTemplate $ s ++ b--runDiskIO :: [(String, String)] -> [String] -> Monitor String-runDiskIO disks _ = do- mounted <- io $ mountedDevices (map fst disks)- dat <- io $ mountedData (map fst mounted)- strs <- mapM runDiskIO' $ devTemplates disks mounted dat- return $ intercalate " " strs--runDiskU' :: String -> String -> Monitor String-runDiskU' tmp path = do- setConfigValue tmp template- fstats <- io $ fsStats path- let strs = map sizeToStr fstats- freep = (fstats !! 1) * 100 `div` head fstats- fr = fromIntegral freep / 100- s <- zipWithM showWithColors' strs [100, freep, 100 - freep]- sp <- showPercentsWithColors [fr, 1 - fr]- fb <- showPercentBar (fromIntegral freep) fr- ub <- showPercentBar (fromIntegral $ 100 - freep) (1 - fr)- parseTemplate $ s ++ sp ++ [fb, ub]--runDiskU :: [(String, String)] -> [String] -> Monitor String-runDiskU disks _ = do- devs <- io $ mountedDevices (map fst disks)- strs <- mapM (\(d, p) -> runDiskU' (findTempl d p disks) p) devs- return $ intercalate " " strs
− Plugins/Monitors/MPD.hs
@@ -1,92 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Plugins.Monitors.MPD--- Copyright : (c) Jose A Ortega Ruiz--- License : BSD-style (see LICENSE)------ Maintainer : Jose A Ortega Ruiz <jao@gnu.org>--- Stability : unstable--- Portability : unportable------ MPD status and song-----------------------------------------------------------------------------------module Plugins.Monitors.MPD ( mpdConfig, runMPD ) where--import Plugins.Monitors.Common-import System.Console.GetOpt-import qualified Network.MPD as M--mpdConfig :: IO MConfig-mpdConfig = mkMConfig "MPD: <state>"- [ "bar", "state", "statei", "volume", "length"- , "lapsed", "plength"- , "name", "artist", "composer", "performer"- , "album", "title", "track", "trackno", "file", "genre"- ]--data MOpts = MOpts {mPlaying :: String, mStopped :: String, mPaused :: String}--defaultOpts :: MOpts-defaultOpts = MOpts { mPlaying = ">>", mStopped = "><", mPaused = "||" }--options :: [OptDescr (MOpts -> MOpts)]-options =- [ Option "P" ["playing"] (ReqArg (\x o -> o { mPlaying = x }) "") ""- , Option "S" ["stopped"] (ReqArg (\x o -> o { mStopped = x }) "") ""- , Option "Z" ["paused"] (ReqArg (\x o -> o { mPaused = x }) "") ""- ]--runMPD :: [String] -> Monitor String-runMPD args = do- status <- io $ M.withMPD M.status- song <- io $ M.withMPD M.currentSong- opts <- io $ mopts args- let (b, s) = parseMPD status song opts- bs <- showPercentBar (100 * b) b- parseTemplate (bs:s)--mopts :: [String] -> IO MOpts-mopts argv =- case getOpt Permute options argv of- (o, _, []) -> return $ foldr id defaultOpts o- (_, _, errs) -> ioError . userError $ concat errs--parseMPD :: M.Response M.Status -> M.Response (Maybe M.Song) -> MOpts- -> (Float, [String])-parseMPD (Left e) _ _ = (0, show e:repeat "")-parseMPD (Right st) song opts = (b, [ss, si, vol, len, lap, plen] ++ sf)- where s = M.stState st- ss = show s- si = stateGlyph s opts- vol = int2Str $ M.stVolume st- (lap, len) = (showTime p, showTime t)- (p, t) = M.stTime st- b = if t > 0 then fromIntegral p / fromIntegral t else 0- plen = int2Str $ M.stPlaylistLength st- sf = parseSong song--stateGlyph :: M.State -> MOpts -> String-stateGlyph s o =- case s of- M.Playing -> mPlaying o- M.Paused -> mPaused o- M.Stopped -> mStopped o--parseSong :: M.Response (Maybe M.Song) -> [String]-parseSong (Left _) = repeat ""-parseSong (Right Nothing) = repeat ""-parseSong (Right (Just s)) =- [ M.sgName s, M.sgArtist s, M.sgComposer s, M.sgPerformer s- , M.sgAlbum s, M.sgTitle s, track, trackno, M.sgFilePath s, M.sgGenre s]- where (track, trackno) = (int2Str t, int2Str tn)- (t, tn) = M.sgTrack s--showTime :: Integer -> String-showTime t = int2Str minutes ++ ":" ++ int2Str seconds- where minutes = t `div` 60- seconds = t `mod` 60--int2Str :: (Num a, Ord a) => a -> String-int2Str x = if x < 10 then '0':sx else sx where sx = show x
− Plugins/Monitors/Mem.hs
@@ -1,58 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Plugins.Monitors.Mem--- Copyright : (c) Andrea Rossato--- License : BSD-style (see LICENSE)------ Maintainer : Andrea Rossato <andrea.rossato@unibz.it>--- Stability : unstable--- Portability : unportable------ A memory monitor for Xmobar-----------------------------------------------------------------------------------module Plugins.Monitors.Mem (memConfig, runMem, totalMem, usedMem) where--import Plugins.Monitors.Common--memConfig :: IO MConfig-memConfig = mkMConfig- "Mem: <usedratio>% (<cache>M)" -- template- ["usedbar", "freebar", "usedratio", "total", -- available replacements- "free", "buffer", "cache", "rest", "used"]--fileMEM :: IO String-fileMEM = readFile "/proc/meminfo"--parseMEM :: IO [Float]-parseMEM =- do file <- fileMEM- let content = map words $ take 4 $ lines file- [total, free, buffer, cache] = map (\line -> (read $ line !! 1 :: Float) / 1024) content- rest = free + buffer + cache- used = total - rest- usedratio = used / total- return [usedratio, total, free, buffer, cache, rest, used]--totalMem :: IO Float-totalMem = fmap ((*1024) . (!!1)) parseMEM--usedMem :: IO Float-usedMem = fmap ((*1024) . (!!6)) parseMEM--formatMem :: [Float] -> Monitor [String]-formatMem (r:xs) =- do let f = showDigits 0- rr = 100 * r- ub <- showPercentBar rr r- fb <- showPercentBar (100 - rr) (1 - r)- s <- mapM (showWithColors f) (rr:xs)- return (ub:fb:s)-formatMem _ = return $ replicate 9 "N/A"--runMem :: [String] -> Monitor String-runMem _ =- do m <- io parseMEM- l <- formatMem m- parseTemplate l
− Plugins/Monitors/MultiCpu.hs
@@ -1,66 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Plugins.Monitors.MultiCpu--- Copyright : (c) Jose A Ortega Ruiz--- License : BSD-style (see LICENSE)------ Maintainer : Jose A Ortega <jao@gnu.org>--- Stability : unstable--- Portability : unportable------ A multi-cpu monitor for Xmobar-----------------------------------------------------------------------------------module Plugins.Monitors.MultiCpu(multiCpuConfig, runMultiCpu) where--import Plugins.Monitors.Common-import qualified Data.ByteString.Lazy.Char8 as B-import Data.List (isPrefixOf)--multiCpuConfig :: IO MConfig-multiCpuConfig =- mkMConfig "Cpu: <total>"- [ k ++ n | n <- "" : map show [0 :: Int ..]- , k <- ["bar","total","user","nice","system","idle"]]---cpuData :: IO [[Float]]-cpuData = do s <- B.readFile "/proc/stat"- return $ cpuParser s--cpuParser :: B.ByteString -> [[Float]]-cpuParser = map parseList . cpuLists- where cpuLists = takeWhile isCpu . map B.words . B.lines- isCpu (w:_) = "cpu" `isPrefixOf` B.unpack w- isCpu _ = False- parseList = map (read . B.unpack) . tail--parseCpuData :: IO [[Float]]-parseCpuData =- do (as, bs) <- doActionTwiceWithDelay 950000 cpuData- let p0 = zipWith percent bs as- return p0--percent :: [Float] -> [Float] -> [Float]-percent b a = if tot > 0 then map (/ tot) $ take 4 dif else [0, 0, 0, 0]- where dif = zipWith (-) b a- tot = foldr (+) 0 dif--formatMultiCpus :: [[Float]] -> Monitor [String]-formatMultiCpus [] = showPercentsWithColors $ replicate 15 0.0-formatMultiCpus xs = fmap concat $ mapM formatCpu xs--formatCpu :: [Float] -> Monitor [String]-formatCpu xs- | length xs < 4 = showPercentsWithColors $ replicate 6 0.0- | otherwise = let t = foldr (+) 0 $ take 3 xs- in do b <- showPercentBar (100 * t) t- ps <- showPercentsWithColors (t:xs)- return (b:ps)--runMultiCpu :: [String] -> Monitor String-runMultiCpu _ =- do c <- io parseCpuData- l <- formatMultiCpus c- parseTemplate l
− Plugins/Monitors/Net.hs
@@ -1,95 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Plugins.Monitors.Net--- Copyright : (c) Andrea Rossato--- License : BSD-style (see LICENSE)------ Maintainer : Andrea Rossato <andrea.rossato@unibz.it>--- Stability : unstable--- Portability : unportable------ A net device monitor for Xmobar-----------------------------------------------------------------------------------module Plugins.Monitors.Net where--import Plugins.Monitors.Common-import qualified Data.ByteString.Lazy.Char8 as B--data NetDev = NA- | ND { netDev :: String- , netRx :: Float- , netTx :: Float- } deriving (Eq,Show,Read)--interval :: Int-interval = 500000--netConfig :: IO MConfig-netConfig = mkMConfig- "<dev>: <rx>|<tx>" -- template- ["dev", "rx", "tx", "rxbar", "txbar"] -- available replacements---- Given a list of indexes, take the indexed elements from a list.-getNElements :: [Int] -> [a] -> [a]-getNElements ns as = map (as!!) ns---- Split into words, with word boundaries indicated by the given predicate.--- Drops delimiters. Duplicates 'Data.List.Split.wordsBy'.------ > map (wordsBy (`elem` " :")) ["lo:31174097 31174097", "eth0: 43598 88888"]------ will become @[["lo","31174097","31174097"], ["eth0","43598","88888"]]@-wordsBy :: (a -> Bool) -> [a] -> [[a]]-wordsBy f s = case dropWhile f s of- [] -> []- s' -> w : wordsBy f s'' where (w, s'') = break f s'--readNetDev :: [String] -> NetDev-readNetDev [] = NA-readNetDev xs =- ND (xs !! 0) (r (xs !! 1)) (r (xs !! 2))- where r s | s == "" = 0- | otherwise = read s / 1024--fileNET :: IO [NetDev]-fileNET =- do f <- B.readFile "/proc/net/dev"- return $ netParser f--netParser :: B.ByteString -> [NetDev]-netParser =- map (readNetDev . getNElements [0,1,9] . wordsBy (`elem` " :") . B.unpack) . drop 2 . B.lines--formatNet :: Float -> Monitor (String, String)-formatNet d = do- b <- showLogBar 0.8 d- x <- showWithColors f d- return (x, b)- where f s = showDigits 1 s ++ "Kb"--printNet :: NetDev -> Monitor String-printNet nd =- case nd of- ND d r t -> do (rx, rb) <- formatNet r- (tx, tb) <- formatNet t- parseTemplate [d,rx,tx,rb,tb]- NA -> return "N/A"--parseNET :: String -> IO [NetDev]-parseNET nd =- do (a,b) <- doActionTwiceWithDelay interval fileNET- let netRate f da db = takeDigits 2 $ (f db - f da) * fromIntegral (1000000 `div` interval)- diffRate (da,db) = ND (netDev da)- (netRate netRx da db)- (netRate netTx da db)- return $ filter (\d -> netDev d == nd) $ map diffRate $ zip a b--runNet :: [String] -> Monitor String-runNet nd =- do pn <- io $ parseNET $ head nd- n <- case pn of- [x] -> return x- _ -> return NA- printNet n
− Plugins/Monitors/Swap.hs
@@ -1,56 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Plugins.Monitors.Swap--- Copyright : (c) Andrea Rossato--- License : BSD-style (see LICENSE)------ Maintainer : Andrea Rossato <andrea.rossato@unibz.it>--- Stability : unstable--- Portability : unportable------ A swap usage monitor for Xmobar-----------------------------------------------------------------------------------module Plugins.Monitors.Swap where--import Plugins.Monitors.Common--import qualified Data.ByteString.Lazy.Char8 as B--swapConfig :: IO MConfig-swapConfig = mkMConfig- "Swap: <usedratio>" -- template- ["total", "used", "free", "usedratio"] -- available replacements--fileMEM :: IO B.ByteString-fileMEM = B.readFile "/proc/meminfo"--parseMEM :: IO [Float]-parseMEM =- do file <- fileMEM- let li i l- | l /= [] = (head l) !! i- | otherwise = B.empty- fs s l- | l == [] = False- | otherwise = head l == B.pack s- get_data s = flip (/) 1024 . read . B.unpack . li 1 . filter (fs s)- st = map B.words . B.lines $ file- tot = get_data "SwapTotal:" st- free = get_data "SwapFree:" st- return [tot, (tot - free), free, (tot - free) / tot]--formatSwap :: [Float] -> Monitor [String]-formatSwap x =- do let f1 n = showDigits 2 n- (hd, tl) = splitAt 3 x- firsts <- mapM (showWithColors f1) hd- lasts <- showPercentsWithColors (map (/100) tl)- return $ firsts ++ lasts--runSwap :: [String] -> Monitor String-runSwap _ =- do m <- io $ parseMEM- l <- formatSwap m- parseTemplate l
− Plugins/Monitors/Thermal.hs
@@ -1,42 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Plugins.Monitors.Thermal--- Copyright : (c) Juraj Hercek--- License : BSD-style (see LICENSE)------ Maintainer : Juraj Hercek <juhe_haskell@hck.sk>--- Stability : unstable--- Portability : unportable------ A thermal monitor for Xmobar-----------------------------------------------------------------------------------module Plugins.Monitors.Thermal where--import qualified Data.ByteString.Lazy.Char8 as B-import Plugins.Monitors.Common-import System.Posix.Files (fileExist)---- | Default thermal configuration.-thermalConfig :: IO MConfig-thermalConfig = mkMConfig- "Thm: <temp>C" -- template- ["temp"] -- available replacements---- | Retrieves thermal information. Argument is name of thermal directory in--- \/proc\/acpi\/thermal_zone. Returns the monitor string parsed according to--- template (either default or user specified).-runThermal :: [String] -> Monitor String-runThermal args = do- let zone = head args- file = "/proc/acpi/thermal_zone/" ++ zone ++ "/temperature"- exists <- io $ fileExist file- case exists of- False -> return $ "Thermal (" ++ zone ++ "): N/A"- True -> do number <- io $ B.readFile file- >>= return . (read :: String -> Int)- . stringParser (1, 0)- thermal <- showWithColors show number- parseTemplate [ thermal ]-
− Plugins/Monitors/Top.hs
@@ -1,156 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Plugins.Monitors.Top--- Copyright : (c) Jose A Ortega Ruiz--- License : BSD-style (see LICENSE)------ Maintainer : Jose A Ortega Ruiz <jao@gnu.org>--- Stability : unstable--- Portability : unportable------ Process activity and memory consumption monitors-----------------------------------------------------------------------------------{-# LANGUAGE ForeignFunctionInterface #-}--module Plugins.Monitors.Top (startTop, topMemConfig, runTopMem) where--import Plugins.Monitors.Common-import Plugins.Monitors.Mem (usedMem)--import Control.Exception (SomeException, handle)-import System.Directory-import System.FilePath-import System.IO-import System.Posix.Unistd (getSysVar, SysVar(ClockTick))-import Foreign.C.Types-import Data.List (sortBy)-import Data.Ord (comparing)-import Data.IORef-import Data.Time.Clock--import Data.IntMap (IntMap)-import qualified Data.IntMap as M--intStrs :: [String]-intStrs = map show [(1::Int) ..]--topMemConfig :: IO MConfig-topMemConfig = mkMConfig "<both1>"- [ k ++ n | n <- intStrs , k <- ["name", "mem", "both"]]--topConfig :: IO MConfig-topConfig = mkMConfig "<both1>"- ("no" : [ k ++ n | n <- intStrs- , k <- [ "name", "cpu", "both"- , "mname", "mem", "mboth"]])--foreign import ccall "unistd.h getpagesize"- c_getpagesize :: CInt--pageSize :: Float-pageSize = fromIntegral c_getpagesize / 1024--showInfo :: String -> String -> Float -> Monitor [String]-showInfo nm sms mms = do- mnw <- getConfigValue maxWidth- mxw <- getConfigValue minWidth- let lsms = length sms- nmw = mnw - lsms - 1- nmx = mxw - lsms - 1- rnm = if nmw > 0 then padString nmw nmx " " True nm else nm- mstr <- showWithColors' sms mms- both <- showWithColors' (rnm ++ " " ++ sms) mms- return [nm, mstr, both]--processes :: IO [FilePath]-processes = fmap (filter isPid) (getDirectoryContents "/proc")- where isPid = all (`elem` ['0'..'9'])--getProcessData :: FilePath -> IO [String]-getProcessData pidf =- handle (const (return []) :: SomeException -> IO [String])- (withFile ("/proc" </> pidf </> "stat") ReadMode readWords)- where readWords = fmap words . hGetLine--handleProcesses :: ([String] -> a) -> IO [a]-handleProcesses f =- fmap (foldr (\p ps -> if p == [] then ps else f p : ps) [])- (processes >>= mapM getProcessData)--processName :: [String] -> String-processName = drop 1 . init . (!!1)--sortTop :: [(a, Float)] -> [(a, Float)]-sortTop = sortBy (flip (comparing snd))--type Meminfo = (String, Float)--meminfo :: [String] -> Meminfo-meminfo fs = (processName fs, pageSize * read (fs!!23))--meminfos :: IO [Meminfo]-meminfos = handleProcesses meminfo--showMeminfo :: Float -> Meminfo -> Monitor [String]-showMeminfo scale (nm, rss) =- showInfo nm (showWithUnits 2 1 rss) (rss / (1024 * scale))--runTopMem :: [String] -> Monitor String-runTopMem _ = do- ps <- io meminfos- pstr <- mapM (showMeminfo 1) $ sortTop ps- parseTemplate $ concat pstr--type Pid = Int-type TimeInfo = (String, Float)-type TimeEntry = (Pid, TimeInfo)-type Times = IntMap TimeInfo-type TimesRef = IORef (Times, UTCTime)--timeMemEntry :: [String] -> (TimeEntry, Meminfo)-timeMemEntry fs = ((p, (n, t)), (n, r))- where p = read (head fs)- n = processName fs- t = read (fs!!13) + read (fs!!14)- (_, r) = meminfo fs--timeMemEntries :: IO [(TimeEntry, Meminfo)]-timeMemEntries = handleProcesses timeMemEntry--timeMemInfos :: IO (Times, [Meminfo], Int)-timeMemInfos =- fmap (\x -> (M.fromList . map fst $ x, map snd x, length x)) timeMemEntries--combineTimeInfos :: Times -> Times -> Times-combineTimeInfos t0 t1 = M.intersectionWith timeDiff t1 t0- where timeDiff (n, x1) (_, x0) = (n, x1 - x0)--topProcesses :: TimesRef -> Float -> IO (Int, [TimeInfo], [Meminfo])-topProcesses tref scale = do- (t1, mis, len) <- timeMemInfos- c1 <- getCurrentTime- atomicModifyIORef tref $ \(t0, c0) ->- let scx = (fromRational . toRational $ diffUTCTime c1 c0) * scale / 100- ts = M.elems $ combineTimeInfos t0 t1- nts = map (\(nm, t) -> (nm, t / scx)) ts- in ((t1, c1), (len, sortTop nts, sortTop mis))--showTimeInfo :: TimeInfo -> Monitor [String]-showTimeInfo (n, t) = showInfo n (showDigits 1 t) t--runTop :: TimesRef -> Float -> Float -> [String] -> Monitor String-runTop tref scale mscale _ = do- (no, ps, ms) <- io $ topProcesses tref scale- pstr <- mapM showTimeInfo ps- mstr <- mapM (showMeminfo mscale) ms- parseTemplate $! show no : concat (zipWith (++) pstr mstr)--startTop :: [String] -> Int -> (String -> IO ()) -> IO ()-startTop a r cb = do- cr <- getSysVar ClockTick- m <- usedMem- c <- getCurrentTime- tref <- newIORef (M.empty, c)- runM a topConfig (runTop tref (fromIntegral cr) m) r cb
− Plugins/Monitors/Weather.hs
@@ -1,141 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Plugins.Monitors.Weather--- Copyright : (c) Andrea Rossato--- License : BSD-style (see LICENSE)--- --- Maintainer : Andrea Rossato <andrea.rossato@unibz.it>--- Stability : unstable--- Portability : unportable------ A weather monitor for Xmobar-----------------------------------------------------------------------------------module Plugins.Monitors.Weather where--import Plugins.Monitors.Common--import Control.Monad (when)-import System.Process-import System.Exit-import System.IO--import Text.ParserCombinators.Parsec---weatherConfig :: IO MConfig-weatherConfig = mkMConfig- "<station>: <tempC>C, rh <rh>% (<hour>)" -- template- ["station" -- available replacements- , "stationState"- , "year"- , "month"- , "day"- , "hour"- , "wind"- , "visibility"- , "skyCondition"- , "tempC"- , "tempF"- , "dewPoint"- , "rh"- , "pressure"- ]--data WeatherInfo =- WI { stationPlace :: String- , stationState :: String- , year :: String- , month :: String- , day :: String- , hour :: String- , wind :: String- , visibility :: String- , skyCondition :: String- , tempC :: Int- , tempF :: Int- , dewPoint :: String- , humidity :: Int- , pressure :: Int- } deriving (Show)--pTime :: Parser (String, String, String, String)-pTime = do y <- getNumbersAsString- char '.'- m <- getNumbersAsString- char '.'- d <- getNumbersAsString- char ' '- (h:hh:mi:mimi) <- getNumbersAsString- char ' '- return (y, m, d ,([h]++[hh]++":"++[mi]++mimi))--pTemp :: Parser (Int, Int)-pTemp = do let num = digit <|> char '-' <|> char '.'- f <- manyTill num $ char ' '- manyTill anyChar $ char '('- c <- manyTill num $ char ' '- skipRestOfLine- return $ (floor (read c :: Double), floor (read f :: Double))--pRh :: Parser Int-pRh = do s <- manyTill digit $ (char '%' <|> char '.')- return $ read s--pPressure :: Parser Int-pPressure = do manyTill anyChar $ char '('- s <- manyTill digit $ char ' '- skipRestOfLine- return $ read s--parseData :: Parser [WeatherInfo]-parseData = - do st <- getAllBut "," - space- ss <- getAllBut "("- skipRestOfLine >> getAllBut "/"- (y,m,d,h) <- pTime- w <- getAfterString "Wind: "- v <- getAfterString "Visibility: "- sk <- getAfterString "Sky conditions: "- skipTillString "Temperature: "- (tC,tF) <- pTemp- dp <- getAfterString "Dew Point: "- skipTillString "Relative Humidity: "- rh <- pRh- skipTillString "Pressure (altimeter): "- p <- pPressure- manyTill skipRestOfLine eof- return $ [WI st ss y m d h w v sk tC tF dp rh p]--defUrl :: String-defUrl = "http://weather.noaa.gov/pub/data/observations/metar/decoded/"--getData :: String -> IO String-getData url=- do (i,o,e,p) <- runInteractiveCommand ("curl " ++ defUrl ++ url ++ ".TXT")- exit <- waitForProcess p- let closeHandles = do hClose o- hClose i- hClose e- case exit of- ExitSuccess -> do str <- hGetContents o- when (str == str) $ return ()- closeHandles- return str- _ -> do closeHandles- return "Could not retrieve data"--formatWeather :: [WeatherInfo] -> Monitor String-formatWeather [(WI st ss y m d h w v sk tC tF dp r p)] =- do cel <- showWithColors show tC- far <- showWithColors show tF- parseTemplate [st, ss, y, m, d, h, w, v, sk, cel, far, dp, show r , show p ]-formatWeather _ = return "N/A"--runWeather :: [String] -> Monitor String-runWeather str =- do d <- io $ getData $ head str- i <- io $ runP parseData d- formatWeather i
− Plugins/Monitors/Wireless.hs
@@ -1,34 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Plugins.Monitors.Wireless--- Copyright : (c) Jose Antonio Ortega Ruiz--- License : BSD-style (see LICENSE)------ Maintainer : Jose Antonio Ortega Ruiz--- Stability : unstable--- Portability : unportable------ A monitor reporting ESSID and link quality for wireless interfaces-----------------------------------------------------------------------------------module Plugins.Monitors.Wireless (wirelessConfig, runWireless) where--import Plugins.Monitors.Common-import IWlib--wirelessConfig :: IO MConfig-wirelessConfig =- mkMConfig "<essid> <quality>" ["essid", "quality", "qualitybar"]--runWireless :: [String] -> Monitor String-runWireless (iface:_) = do- wi <- io $ getWirelessInfo iface- let essid = wiEssid wi- qlty = wiQuality wi- fqlty = fromIntegral qlty- e = if essid == "" then "N/A" else essid- q <- if qlty >= 0 then showWithColors show qlty else showWithPadding ""- qb <- showPercentBar fqlty (fqlty / 100)- parseTemplate [e, q, qb]-runWireless _ = return ""
− Plugins/PipeReader.hs
@@ -1,28 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Plugins.PipeReader--- Copyright : (c) Andrea Rossato--- License : BSD-style (see LICENSE)------ Maintainer : Andrea Rossato <andrea.rossato@unibz.it>--- Stability : unstable--- Portability : unportable------ A plugin for reading from named pipes-----------------------------------------------------------------------------------module Plugins.PipeReader where--import System.IO-import Plugins--data PipeReader = PipeReader String String- deriving (Read, Show)--instance Exec PipeReader where- alias (PipeReader _ a) = a- start (PipeReader p _) cb = do- h <- openFile p ReadWriteMode- forever (hGetLineSafe h >>= cb)- where forever a = a >> forever a
− Plugins/StdinReader.hs
@@ -1,33 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Plugins.StdinReader--- Copyright : (c) Andrea Rossato--- License : BSD-style (see LICENSE)------ Maintainer : Andrea Rossato <andrea.rossato@unibz.it>--- Stability : unstable--- Portability : unportable------ A plugin for reading from stdin-----------------------------------------------------------------------------------module Plugins.StdinReader where--import Prelude hiding (catch)-import System.Posix.Process-import System.Exit-import System.IO-import Control.Exception (SomeException(..),catch)-import Plugins--data StdinReader = StdinReader- deriving (Read, Show)--instance Exec StdinReader where- start StdinReader cb = do- cb =<< catch (hGetLineSafe stdin) (\(SomeException e) -> do hPrint stderr e; return "")- eof <- hIsEOF stdin- if eof- then exitImmediately ExitSuccess- else start StdinReader cb
− Plugins/XMonadLog.hs
@@ -1,72 +0,0 @@-{-# LANGUAGE CPP #-}---------------------------------------------------------------------------------- |--- Module : Plugins.StdinReader--- Copyright : (c) Spencer Janssen--- License : BSD-style (see LICENSE)------ Maintainer : Spencer Janssen <spencerjanssen@gmail.com>--- Stability : unstable--- Portability : unportable------ A plugin to display information from _XMONAD_LOG, specified at--- http://code.haskell.org/XMonadContrib/XMonad/Hooks/DynamicLog.hs-----------------------------------------------------------------------------------module Plugins.XMonadLog (XMonadLog(..)) where--import Control.Monad-import Graphics.X11-import Graphics.X11.Xlib.Extras-import Plugins-#ifdef UTF8-#undef UTF8-import Codec.Binary.UTF8.String as UTF8-#define UTF8-#endif-import Foreign.C (CChar)-import XUtil (nextEvent')---data XMonadLog = XMonadLog | XPropertyLog String- deriving (Read, Show)--instance Exec XMonadLog where- alias XMonadLog = "XMonadLog"- alias (XPropertyLog atom) = atom-- start x cb = do- let atom = case x of- XMonadLog -> "_XMONAD_LOG"- XPropertyLog a -> a- d <- openDisplay ""- xlog <- internAtom d atom False-- root <- rootWindow d (defaultScreen d)- selectInput d root propertyChangeMask-- let update = do- mwp <- getWindowProperty8 d xlog root- maybe (return ()) (cb . decodeCChar) mwp-- update-- allocaXEvent $ \ep -> forever $ do- nextEvent' d ep- e <- getEvent ep- case e of- PropertyEvent { ev_atom = a } | a == xlog -> update- _ -> return ()-- return ()--decodeCChar :: [CChar] -> String-#ifdef UTF8-#undef UTF8-decodeCChar = UTF8.decode . map fromIntegral-#define UTF8-#else-decodeCChar = map (toEnum . fromIntegral)-#endif
− 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>"- }
README view
@@ -1,61 +1,70 @@ % xmobar - A Minimalistic Text Based Status Bar-% Andrea Rossato+% Andrea Rossato, Jose A. Ortega Ruiz About ===== -[xmobar] is a minimalistic, text based, status bar. It was designed to-work with the [xmonad] Window Manager.--It was inspired by the [Ion3] status bar, and supports similar features,-like dynamic color management, output templates, and extensibility-through plugins.--[This is a screen shot] of my desktop with [xmonad] and [xmobar].--[xmobar] supports XFT and UTF-8 locales.--See `xmobar.config-sample`, distributed with the source code, for a-sample configuration.+xmobar is a minimalistic, text based, status bar. It was originally+designed and implemented by Andrea Rossato to work with [xmonad],+but it's actually usable with any window-manager. -Download-========+xmobar was inspired by the [Ion3] status bar, and supports similar+features, like dynamic color management, output templates, and+extensibility through plugins. -You can get the [xmobar] source code from [Hackage].+This page documents xmobar 0.12 (see [release notes]). -To get the darcs source run:+[This is a screen shot] of Andrea's desktop with [xmonad] and xmobar.+[This] is xmobar running under [sawfish], with antialiased fonts. And+[this one] is my desktop with [xmonad] and two instances of xmobar. - darcs get http://code.haskell.org/xmobar/+[release notes]: http://projects.haskell.org/xmobar/releases.html+[xmonad]: http://xmonad.org+[Ion3]: http://tuomov.iki.fi/software/+[This is a screen shot]: http://haskell.org/sitewiki/images/a/ae/Arossato-config.png+[This]: http://projects.haskell.org/xmobar/xmobar-sawfish.png+[this one]: http://projects.haskell.org/xmobar/xmobar-xmonad.png -The latest binary can be found here:+Installation+============ -<http://code.haskell.org/~arossato/xmobar/xmobar-0.9.2.bin>+## Using cabal-install -A recent screen shot can be found here:+Xmobar is available from [Hackage], and you can install it using+`cabal-install`: -<http://code.haskell.org/~arossato/xmobar/xmobar-0.9.png>+ cabal install xmobar -Version 0.9 requires Cabal-1.2.x, but should work both with ghc-6.6.1-and ghc-6.8.1.+See below for a list of optional compilation flags that will enable+some optional plugins. For instance, to install xmobar with all the+bells and whistles, use: -Bug Reports-===========+ cabal install xmobar --flags="all_extensions" -To submit bug reports you can use the Google code bug tracking system-available at the following address:+## From source -<http://code.google.com/p/xmobar/issues>+If you don't have `cabal-install` installed, you can get xmobar's+source code in a variety of ways: + - From [Hackage]. Just download [xmobar-0.12.tar.gz] from xmobar's+ hackage page.+ - From [Github]. You can also obtain a tarball in [Github's+ downloads page]. You'll find there links to each tagged release.+ - From the bleeding edge repo. If you prefer to live dangerously,+ just get the latest and greatest (and buggiest, i guess) using+ git:+ git clone git://github.com/jaor/xmobar -Installation-============+[xmobar-0.12.tar.gz]: http://hackage.haskell.org/packages/archive/xmobar/0.12/xmobar-0.12.tar.gz+[Github's downloads page]: https://github.com/jaor/xmobar/downloads -To install simply run:+To install simply run (if needed): - tar xvfz xmobar-0.9- cd xmobar-0.9+ tar xvfz xmobar-0.12+ cd xmobar-0.12 -Then run the configure script:+If you have cabal installed, you can now use it from within xmobar's+source tree. Otherwise, run the configure script: runhaskell Setup.lhs configure @@ -65,52 +74,77 @@ # To enable both XFT and UTF-8 support run: runhaskell Setup.lhs configure --flags="with_xft" + # To enable all extensions+ runhaskell Setup.lhs configure --flags="all_extensions"+ Now you can build the source: runhaskell Setup.lhs build runhaskell Setup.lhs install # possibly to be run as root -You can now run [xmobar] with: - xmobar /path/to/config &+## Optional features -or+You can configure xmobar to include some optional plugins and+features, which are not compiled by default. To that end, you need to+add one or more flags to either the cabal install command or the+configure setup step, as shown in the examples above. - xmobar &+Extensions need additional libraries (listed below) that will be+automatically downloaded and installed if you're using cabal install.+Otherwise, you'll need to install them yourself. -if you have the default configuration file saved as `~/.xmobarrc`+`with_utf8`+: UTF-8 support. Requires the [utf8-string] package. -Utf-8 and Xft Support-=====================+`with_xft`+: Antialiased fonts. Requires the [X11-xft] package. This option+ automatically enables UTF-8. -[xmobar] can be compiled with UTF-8 and XFT support. If you want UTF-8-support only, you just need to run the configuration script with the-`"with_utf"` flag:+ To use XFT fonts you need to use the `xft:` prefix in the `font`+ configuration option. For instance: - runhaskell Setup.lhs configure --flags="with_utf8"+ font = "xft:Times New Roman-10:italic" -This requires the presence of [utf8-string] package.+`with_mpd`+: Enables support for the [MPD] daemon. Requires the [libmpd] package. -XFT support, which will also enable UTF-8 support, requires the-[X11-xft] package too and is enabled by running the configuration-script with the `"with_xft"` flag:+`with_inotify`+: Support for inotify in modern linux kernels. This option is needed+ for the MBox and Mail plugins to work. Requires the [hinotify]+ package. - runhaskell Setup.lhs configure --flags="with_xft"+`with_iwlib`+: Support for wireless cards. Enables the Wireless plugin. No Haskell+ library is required, but you will need the [iwlib] C library and+ headers in your system (e.g., install `libiw-dev` in Debian-based+ systems). -Then build [xmobar] as usual.+`all_extensions`+: Enables all the extensions above. -To use XFT fonts you need to use the `xft:` prefix in the `font`-configuration option. For instance:+Running xmobar+============== - font = "xft:Times New Roman-10:italic"+You can now run xmobar with: + xmobar /path/to/config &++or++ xmobar &++if you have the default configuration file saved as `~/.xmobarrc`+ Configuration ============= ## Quick Start -See `xmobar.config-sample` for an example.+See [samples/xmobar.config] for an example. +[samples/xmobar.config]: http://github.com/jaor/xmobar/raw/master/samples/xmobar.config+ For the output template: - `%command%` will execute command and print the output. The output@@ -157,6 +191,20 @@ : position = Top +`border`+: TopB, TopBM, BottomB, BottomBM, FullB, FullBM or NoBorder (default).++: TopB, BottomB, FullB take no arguments, and request drawing a+ border at the top, bottom or around xmobar's window,+ respectively.++: TopBM, BottomBM, FullBM take an integer argument, which is the+ margin, in pixels, between the border of the window and the+ drawn border.++`borderColor`+: Border color.+ `commands` : For setting the options of the programs to run (optional). @@ -175,7 +223,7 @@ ## Running xmobar with i3status -[xmobar] can be used to display information gathered by [i3status], a+xmobar can be used to display information gathered by [i3status], a small program that gathers information and formats it suitable for being displayed by the dzen2 status bar, wmii's status bar or xmobar's StdinReader.@@ -196,7 +244,7 @@ ## Command Line Options -[xmobar] can be either configured with a configuration file or with+xmobar can be either configured with a configuration file or with command line options. In the second case, the command line options will overwrite the corresponding options set in the configuration file.@@ -223,19 +271,19 @@ the output template. Default '%' -t template --template=template The output template -c commands --commands=commands The list of commands to be executed- -x screen --screen=screen On which X screen number to start- Mail bug reports and suggestions to <andrea.rossato@unibz.it>+ -x screen --screen=screen On which X screen number to start+ Mail bug reports and suggestions to <xmobar@projects.haskell.org> ## The Output Template -The output template must contain at least one command. [xmobar] will+The output template must contain at least one command. xmobar will parse the template and will search for the command to be executed in the `commands` configuration option. First an `alias` will be searched (plugins such as Weather or Network have default aliases, see below). After that, the command name will be tried. If a command is found, the arguments specified in the `commands` list will be used. -If no command is found in the `commands` list, [xmobar] will ask the+If no command is found in the `commands` list, xmobar will ask the operating system to execute a program with the name found in the template. If the execution is not successful an error will be reported.@@ -243,9 +291,9 @@ ## The `commands` Configuration Option The `commands` configuration option is a list of commands information-and arguments to be used by [xmobar] when parsing the output template.+and arguments to be used by xmobar when parsing the output template. Each member of the list consists in a command prefixed by the `Run`-keyword. Each command has arguments to control the way [xmobar] is going+keyword. Each command has arguments to control the way xmobar is going to execute it. The option consists in a list of commands separated by a comma and@@ -259,13 +307,15 @@ swap monitor plugin, with default options, every second. The only internal available command is `Com` (see below Executing-External Commands). All other commands are provided by plugins.-[xmobar] comes with some plugins, providing a set of system monitors,-a standard input reader, an Unix named pipe reader, and a configurable+External Commands). All other commands are provided by plugins. xmobar+comes with some plugins, providing a set of system monitors, a+standard input reader, an Unix named pipe reader, and a configurable date plugin. These plugins install the following internal commands:-`Weather`, `Network`, `Memory`, `Swap`, `Cpu`, `MultiCpu`, `Battery`,-`Thermal`, `CpuFreq`, `CoreTemp`, `Date`, `StdinReader`,-`CommandReader`, and `PipeReader`.+`Weather`, `Network`, `Wireless` (optional), `Memory`, `Swap`, `Cpu`,+`MultiCpu`, `Battery`, `TopProc`, `TopMem`, `DiskU`, `DiskIO`,+`Thermal`, `CpuFreq`, `CoreTemp`, `MPD` (optional), `Mail` (optional),+`MBox` (optional), `Date`, `Uptime`, `StdinReader`, `CommandReader`,+and `PipeReader`. To remove them see below Installing/Removing a Plugin @@ -280,10 +330,21 @@ Each monitor has an `alias` to be used in the output template. Monitors have default aliases. +`Uptime Args RefreshRate`++- Aliases to `uptime`+- Args: default monitor arguments (see below). The low and high+ thresholds refer to the number of days.+- Variables that can be used with the `-t`/`--template` argument:+ `days`, `hours`, `minutes`, `seconds`. The total uptime is the+ sum of all those fields. You can set the `-S` argument to "True"+ to add units to the display of those numeric fields.+- Default template: `Up: <days>d <hours>h <minutes>m`+ `Weather StationID Args RefreshRate` -- aliases to the Station ID: so `Weather "LIPB" []` can be used in template as `%LIBP%`-- Args: the argument list (see below)+- Aliases to the Station ID: so `Weather "LIPB" []` can be used in template as `%LIPB%`+- Args: default monitor arguments (see below) - Variables that can be used with the `-t`/`--template` argument: `station`, `stationState`, `year`, `month`, `day`, `hour`, `wind`, `visibility`, `skyCondition`, `tempC`, `tempF`,@@ -294,29 +355,32 @@ `Network Interface Args RefreshRate` -- aliases to the interface name: so `Network "eth0" []` can be used as `%eth0%`-- Args: the argument list (see below)+- Aliases to the interface name: so `Network "eth0" []` can be used as+ `%eth0%`+- Args: default monitor arguments (see below) - Variables that can be used with the `-t`/`--template` argument:- `dev`, `rx`, `tx`, `rxbar`, `txbar`-- Default template: `<dev>: <rx>|<tx>`+ `dev`, `rx`, `tx`, `rxbar`, `txbar`. Reception and transmission+ rates (`rx` and `tx`) are displayed in Kbytes per second, and you+ can set the `-S` to "True" to make them displayed with units (the+ string "Kb/s").+- Default template: `<dev>: <rx>KB|<tx>KB` `Wireless Interface Args RefreshRate` -- aliases to the interface name with the suffix "wi": thus, `Wirelss+- Aliases to the interface name with the suffix "wi": thus, `Wirelss "wlan0" []` can be used as `%wlan0wi%`-- Args: the argument list (see below)+- Args: default monitor arguments (see below) - Variables that can be used with the `-t`/`--template` argument: `essid`, `quality`, `qualitybar` - Default template: `<essid> <quality>`-- Requires the C library libiw (part of the wireless tools suite)+- Requires the C library [iwlib] (part of the wireless tools suite) installed in your system. In addition, to activate this plugin you- must pass --flags="with_iwlib" to "runhaskell Setup configure"- or to "cabal install".+ must pass `--flags="with_iwlib"` during compilation. `Memory Args RefreshRate` -- aliases to `memory`-- Args: the argument list (see below)+- Aliases to `memory`+- Args: default monitor arguments (see below) - Variables that can be used with the `-t`/`--template` argument: `total`, `free`, `buffer`, `cache`, `rest`, `used`, `usedratio`, `usedbar`, `freebar`@@ -324,53 +388,78 @@ `Swap Args RefreshRate` -- aliases to `swap`-- Args: the argument list (see below)+- Aliases to `swap`+- Args: default monitor arguments (see below) - Variables that can be used with the `-t`/`--template` argument: `total`, `used`, `free`, `usedratio` - Default template: `Swap: <usedratio>%` `Cpu Args RefreshRate` -- aliases to `cpu`-- Args: the argument list (see below)+- Aliases to `cpu`+- Args: default monitor arguments (see below) - Variables that can be used with the `-t`/`--template` argument: `total`, `bar`, `user`, `nice`, `system`, `idle`-- Default template: `Cpu: <total>`+- Default template: `Cpu: <total>%` `MultiCpu Args RefreshRate` -- aliases to `multicpu`-- Args: the argument list (see below)+- Aliases to `multicpu`+- Args: default monitor arguments (see below) - Variables that can be used with the `-t`/`--template` argument:- `total`, `bar`, `user`, `nice`, `system`, `idle`,- `total0`, `bar0`, `user0`, `nice0`, `system0`, `idle0`, ...-- Default template: `Cpu: <total>`+ `autototal`, `autobar`, `autouser`, `autonice`,+ `autosystem`, `autoidle`, `total`, `bar`, `user`, `nice`,+ `system`, `idle`, `total0`, `bar0`, `user0`, `nice0`,+ `system0`, `idle0`, ...+ The auto* variables automatically detect the number of CPUs on the system+ and display one entry for each.+- Default template: `Cpu: <total>%` `Battery Args RefreshRate` -- aliases to `battery`-- Args: the argument list (see below)-- Variables that can be used with the `-t`/`--template` argument:- `left`, `leftbar`, `status`-- Default template: `Batt: <left>`+- Same as `BatteryP ["BAT0", "BAT1", "BAT2"] Args RefreshRate`. `BatteryP Dirs Args RefreshRate` -- aliases to `battery`+- Aliases to `battery` - Dirs: list of directories in /proc/acpi/battery/ directory where to look for the `state` and `info` files. Example: `["BAT0","BAT1","BAT2"]`. Only the first 3 directories will be searched.-- Args: the argument list (see below)+- Args: default monitor arguments (see below), plus the following specif ones:+ - `-O`: string for AC "on" status (default: "On")+ - `-o`: string for AC "off" status (default: "Off")+ - `-L`: low power (`watts`) threshold (default: -12)+ - `-H`: high power threshold (default: -10)+ - `-l`: color to display power lower than the `-L` threshold+ - `-m`: color to display power lower than the `-H` threshold+ - `-h`: color to display power highter than the `-H` threshold+ - `-p`: color to display positive power (battery charging) - Variables that can be used with the `-t`/`--template` argument:- `left`, `leftbar`, `status`-- Default template: `Batt: <left>`+ `left`, `leftbar`, `timeleft`, `watts`, `acstatus`+- Default template: `Batt: <watts>, <left>% / <timeleft>`+- Example (note that you need "--" to separate regular monitor options from+ Battery's specific ones): + Run BatteryP ["BAT0"]+ ["-t", "<acstatus><watts> (<left>%)",+ "-L", "10", "-H", "80", "-p", "3",+ "--", "-O", "<fc=green>On</fc> - ", "-o", "",+ "-L", "-15", "-H", "-5",+ "-l", "red", "-m", "blue", "-h", "green"]+ 600+ In the above example, the thresholds before the "--" separator+ refer to the `<left>` field, while those after the separator affect+ how `<watts>` is displayed.+ `TopProc Args RefreshRate` -- aliases to `top`-- Args: the argument list (see below)+- Aliases to `top`+- Args: default monitor arguments (see below). The low and high+ thresholds (`-L` and `-H`) denote, for memory entries, the percent+ of the process memory over the total amount of memory currently in+ use and, for cpu entries, the activity percentage (i.e., the value+ of `cpuN`, which takes values between 0 and 100). - Variables that can be used with the `-t`/`--template` argument: `no`, `name1`, `cpu1`, `both1`, `mname1`, `mem1`, `mboth1`, `name2`, `cpu2`, `both2`, `mname2`, `mem2`, `mboth2`, ...@@ -382,8 +471,10 @@ `TopMem Args RefreshRate` -- aliases to `topmem`-- Args: the argument list (see below)+- Aliases to `topmem`+- Args: default monitor arguments (see below). The low and high+ thresholds (`-L` and `-H`) denote the percent of the process memory+ over the total amount of memory currently in use. - Variables that can be used with the `-t`/`--template` argument: `name1`, `mem1`, `both1`, `name2`, `mem2`, `both2`, ... - Default template: `<both1>`@@ -393,89 +484,108 @@ `DiskU Disks Args RefreshRate` -- aliases to `disku`+- Aliases to `disku` - Disks: list of pairs of the form (device or mount point, template), where the template can contain <size>, <free>, <used>, <freep> or <usedp>, <freebar> or <usedbar> for total, free, used, free- percentage and used percentage of the given file system capacity. Example:- `[("/", "<used>/<size>"), ("sdb1", "<usedbar>")]`-- Args: the argument list (see above). `-t`/`--template` is ignored.+ percentage and used percentage of the given file system capacity.+- Args: default monitor arguments (see below). `-t`/`--template` is ignored. - Default template: none (you must specify a template for each file system).+- Example: + DiskU [("/", "<used>/<size>"), ("sdb1", "<usedbar>")]+ ["-L", "20", "-H", "50", "-m", "1", "-p", "3",]+ 20+ `DiskIO Disks Args RefreshRate` -- aliases to `diskio`+- Aliases to `diskio` - Disks: list of pairs of the form (device or mount point, template), where the template can contain <total>, <read>, <write> for total,- read and write speed, respectively. Example:- `[("/", "<read> <write>"), ("sdb1", "<total>")]`-- Args: the argument list (see above). `-t`/`--template` is ignored.+ read and write speed, respectively.+- Args: default monitor arguments (see below). `-t`/`--template` is ignored. - Default template: none (you must specify a template for each file system).+- Example: + Disks [("/", "<read> <write>"), ("sdb1", "<total>")] [] 10+ `Thermal Zone Args RefreshRate` -- aliases to the Zone: so `Zone "THRM" []` can be used in template as `%THRM%`-- Args: the argument list (see below)+- Aliases to the Zone: so `Zone "THRM" []` can be used in template as `%THRM%`+- Args: default monitor arguments (see below) - Variables that can be used with the `-t`/`--template` argument: `temp` - Default template: `Thm: <temp>C` - This plugin works only on sytems with devices having thermal zone. Check directories in /proc/acpi/thermal_zone for possible values.-- Example: `Run Thermal "THRM" ["-t","iwl4965-temp: \<temp\>C"]`+- Example: + Run Thermal "THRM" ["-t","iwl4965-temp: <temp>C"]+ `CpuFreq Args RefreshRate` -- aliases to `cpufreq`-- Args: the argument list (see below)+- Aliases to `cpufreq`+- Args: default monitor arguments (see below) - Variables that can be used with the `-t`/`--template` argument: `cpu0`, `cpu1`, .., `cpuN` - Default template: `Freq: <cpu0>GHz` - This monitor requires acpi_cpufreq module to be loaded in kernel-- Example: `Run CpuFreq ["-t","Freq:\<cpu0\>|\<cpu1\>GHz","-L","0","-H","2","-l","lightblue","-n","white","-h","red"] 50`+- Example: + Run CpuFreq ["-t", "Freq:<cpu0>|<cpu1>GHz", "-L", "0", "-H", "2",+ "-l", "lightblue", "-n","white", "-h", "red"] 50+ `CoreTemp Args RefreshRate` -- aliases to `coretemp`-- Args: the argument list (see below)+- Aliases to `coretemp`+- Args: default monitor arguments (see below) - Variables that can be used with the `-t`/`--template` argument: `core0`, `core1`, .., `coreN` - Default template: `Temp: <core0>C` - This monitor requires coretemp module to be loaded in kernel-- Example: `Run CoreTemp ["-t","Temp:\<core0\>|\<core1\>C","-L","40","-H","60","-l","lightblue","-n","gray90","-h","red"] 50`+- Example: + Run CoreTemp ["-t", "Temp:<core0>|<core1>C",+ "-L", "40", "-H", "60",+ "-l", "lightblue", "-n", "gray90", "-h", "red"] 50 `MPD Args RefreshRate` -- aliases to `mpd`-- Args: the argument list (see below). In addition you can provide+- This monitor will only be compiled if you ask for it using the+ `with_mpd` flag. It needs [libmpd] 5.0 or later (available on Hackage).+- Aliases to `mpd`+- Args: default monitor arguments (see below). In addition you can provide `-P`, `-S` and `-Z`, with an string argument, to represent the- playing, stopped and paused states in the `statei` template field.+ playing, stopped and paused states in the `statei` template field,+ and `-h`, `-p` and `-x` for the host, port and password (default+ host is "localhost", port 6600 and empty password). - Variables that can be used with the `-t`/`--template` argument: `bar`, `state`, `statei`, `volume`, `length`- `lapsed`, `plength`+ `lapsed`, `remaining`,+ `plength` (playlist length), `ppos` (playlist position) `name`, `artist`, `composer`, `performer` `album`, `title`, `track`, `file`, `genre` - Default template: `MPD: <state>`-- Example:- Run MPD ["-t",- "<composer> <title> (<album>) <track>/<plength> <statei> ",- "--", "-P", ">>", "-Z", "|", "-S", "><"] 10- Note that you need "--" to separate regular monitor options from- MPD's specific ones.-- This monitor will only be compiled if you ask for it using the- `with_mpd` flag. It needs libmpd 4.1 or later (available on Hackage).+- Example (note that you need "--" to separate regular monitor options from+ MPD's specific ones): + Run MPD ["-t",+ "<composer> <title> (<album>) <track>/<plength> <statei> ",+ "--", "-P", ">>", "-Z", "|", "-S", "><"] 10+ `Mail Args` -- aliases to `Mail`-- Args: list of maildirs in form [("name1","path1"),("name2","path2")]-- This plugin requires INOTIFY support in Linux kernel and hinotify library.- To activate, pass --flags="with_inotify" to "runhaskell Setup configure"- or to "cabal install".+- Aliases to `Mail`+- Args: list of maildirs in form+ `[("name1","path1"),("name2","path2")]`. Paths may start with a '~'+ to expand to the user's home directory.+- This plugin requires inotify support in your linux kernel and the+ [hinotify] package. To activate, pass `--flags="with_inotify"`+ during compilation. `MBox Mboxes Opts Alias` -- Mboxes a list of mbox files of the form [("name", "path", "color")],+- Mboxes a list of mbox files of the form `[("name", "path", "color")]`, where name is the displayed name, path the absolute or relative (to BaseDir) path of the mbox file, and color the color to use to display the mail count (use an empty string for the default).@@ -487,42 +597,127 @@ of displayed mail coints -s suffix --suffix suffix a string giving a suffix for the list of displayed mail coints-- This plugin requires INOTIFY support in Linux kernel and hinotify library.- To activate, pass --flags="with_inotify" to "runhaskell Setup- configure" or to "cabal install".-- Example:- `Run MBox [("I ", "inbox", "red"), ("O ", "/foo/mbox", "")]- ["-d", "/var/mail/", "-p", " "] "mbox"`- will look for mails in `/var/mail/inbox` and `/foo/mbox`, and will put- a space in front of the printed string (when it's not empty); it- can be used in the template with the alias `mbox`.+- Paths may start with a '~' to expand to the user's home directory.+- This plugin requires inotify support in your linux kernel and the+ [hinotify] package. To activate, pass `--flags="with_inotify"`+ during compilation.+- Example. The following command look for mails in `/var/mail/inbox`+ and `~/foo/mbox`, and will put a space in front of the printed string+ (when it's not empty); it can be used in the template with the alias+ `mbox`: + Run MBox [("I ", "inbox", "red"), ("O ", "~/foo/mbox", "")]+ ["-d", "/var/mail/", "-p", " "] "mbox"++`XPropertyLog PropName`++- Aliases to `PropName`+- Reads the X property named by `PropName` (a string) and displays its+ value. The [xmonadpropwrite script] in xmobar's distribution can be+ used to set the given property from the output of any other program+ or script.+ ## Monitor Plugins Commands Arguments These are the arguments that can be used for internal commands in the `commands` configuration option: - -H number --High=number The high threshold- -L number --Low=number The low threshold- -h color number --high=color number Color for the high threshold: es "#FF0000"- -n color number --normal=color number Color for the normal threshold: es "#00FF00"- -l color number --low=color number Color for the low threshold: es "#0000FF"- -p number --ppad=number Pad percentages to given width- -m number --minwidth=number Minimum field width- -M number --maxwidth=number Maximum field width- -w number --width=number Fixed field width- -c chars --padchars=chars Chars used (cyclically) for padding- -a ["r" or "l"] --align=["r" or "l"] Pad alignment (right/left)- -b chars --bback=chars Chars used to draw bar backgrounds (default ":")- -f chars --bfore=chars Chars used to draw bar foregrounds (default "#")- -W number --bwidth=number Bar width (default 10)- -t output template --template=output template Output template of the command.+- `-t` _string_ Output template+ - Template for the monitor output. Field names must be enclosed+ between pointy brackets (`<foo>`) and will be substituted by the+ computed values. You can also specify a foreground color for a+ region bracketing it between `<fc=color>` and `</fc>`. The rest+ of the template is output verbatim.+ - Long option: `--template`+ - Default value: per monitor (see above).+- `-H` _number_ The high threshold.+ - Numerical values higher than _number_ will be displayed with the+ color specified by `-h` (see below).+ - Long option: `--High`+ - Default value: 66+- `-L` _number_ The low threshold.+ - Numerical values higher than _number_ and lower than the high+ threshold will be displayed with the color specified by `-m`+ (see below). Values lower than _number_ will use the `-l` color.+ - Long option: `--Low` - Default value: 80+ - Default value: 33+- `-h` _color_ High threshold color.+ - Color for displaying values above the high threshold. _color_ can+ be either a name (e.g. "blue") or an hexadecimal RGB (e.g.+ "#FF0000").+ - Long option: `--high`+ - Default: none (use the default foreground).+- `-n` _color_ Color for 'normal' values+ - Color used for values greater than the low threshold but lower+ than the high one.+ - Long option: `--normal`+ - Default: none (use the default foreground).+- `-l` _color_ The low threshold color+ - Color for displaying values below the low threshold.+ - Long option: `--low`+ - Default: none (use the default foreground).+- `-S` _boolean_ Display optional suffixes+ - When set to a true designator ("True", "Yes" or "On"), optional+ value suffixes such as the '%' symbol or optional units will be+ displayed.+ - Long option: `--suffix`+ - Default: False.+- `-p` _number_ Percentages padding+ - Width, in number of digits, for quantities representing+ percentages. For instance `-p 3` means that all percentages+ in the monitor will be represented using 3 digits.+ - Long option: `--ppad`+ - Default value: 0 (don't pad)+- `-m` _number_ Minimum field width+ - Minimum width, in number of characters, of the fields in the+ monitor template. Values whose printed representation is shorter+ than this value will be padded using the padding characters+ given by the `-c` option with the alignment specified by `-a`+ (see below).+ - Long option: `--minwidth`+ - Default: 0+- `-M` _number_ Maximum field width+ - Maximum width, in number of characters, of the fields in the+ monitor template. Values whose printed representation is longer+ than this value will be truncated.+ - Long option: `--maxwidth`+ - Default: 0 (no maximum width)+- `-w` _number_ Fixed field width+ - All fields will be set to this width, padding or truncating as+ needed.+ - Long option: `--width`+ - Default: 0 (variable width)+- `-c` _string_+ - Characters used for padding. The characters of _string_ are used+ cyclically. E.g., with `-P +- -w 6`, a field with value "foo"+ will be represented as "+-+foo".+ - Long option: `--padchars`+ - Default value: " "+- `-a` r|l Field alignment+ - Whether to use right (r) or left (l) alignment of field values+ when padding.+ - Long option: `--align`+ - Default value: r (padding to the left)+- `-b` _string_ Bar background+ - Characters used, cyclically, to draw the background of bars.+ For instance, if you set this option to "·.", an empty bar will+ look like this: `·.·.·.·.·.`+ - Long option: `--bback`+ - Default value: ":"+- `-f` _string_ Bar foreground+ - Characters used, cyclically, to draw the foreground of bars.+ - Long option: `--bfore`+ - Default value: "#"+- `-W` _number_ Bar width+ - Total number of characters used to draw bars.+ - Long option: `--bwidth`+ - Default value: 10 -Commands' arguments must be set as a list. Es:+Commands' arguments must be set as a list. E.g.: - Run Weather "EGPF" ["-t","<station>: <tempC>C"] 36000+ Run Weather "EGPF" ["-t", "<station>: <tempC>C"] 36000 -In this case [xmobar] will run the weather monitor, getting information+In this case xmobar will run the weather monitor, getting information for the weather station ID EGPF (Glasgow Airport, as a homage to GHC) every hour (36000 tenth of seconds), with a template that will output something like:@@ -540,14 +735,18 @@ - ProgramName: the name of the program - Args: the arguments to be passed to the program at execution time+- RefreshRate: number of tenths of second between re-runs of the+ command. A zero or negative rate means that the command will be+ executed only once. - Alias: a name to be used in the template. If the alias is en empty string the program name can be used in the template. -Es:+E.g.: - Run Com "uname" ["-s","-r"] "" 36000+ Run Com "uname" ["-s","-r"] "" 0 -can be used in the output template as `%uname%`+can be used in the output template as `%uname%` (and xmobar will call+_uname_ only once), while Run Com "date" ["+\"%a %b %_d %H:%M\""] "mydate" 600 @@ -555,20 +754,49 @@ ## Other Plugins -`Date Args Alias RefreshRate`- `StdinReader` +- Aliases to StdinReader+- Displays any text received by xmobar on its standard input.++`Date Format Alias RefreshRate`++- Format is a time format string, as accepted by the standard ISO C+ `strftime` function (or Haskell's `formatCalendarTime`).+- Sample usage: `Run Date "%a %b %_d %Y <fc=#ee9a00>%H:%M:%S</fc>" "date" 10`+ `CommandReader "/path/to/program" Alias` +- Runs the given program, and displays its standard output.+ `PipeReader "/path/to/pipe" Alias` +- Reads its displayed output from the given pipe.++`XMonadLog`++- Aliases to XMonadLog+- Displays information from xmonad's `_XMONAD_LOG`. You can set this+ property by using `xmonadPropLog` as your log hook in xmonad's+ configuration, as in the following example (more info [here]):++ main = do+ spawn "xmobar"+ xmonad $ defaultConfig {+ logHook = dynamicLogString defaultPP >>= xmonadPropLog+ }+ This plugin can be used as a sometimes more convenient alternative+ to `StdinReader`. For it instance, allows you to (re)start xmobar+ outside xmonad.++[here]: http://xmonad.org/xmonad-docs/xmonad-contrib/XMonad-Hooks-DynamicLog.html+ Plugins ======= ## Writing a Plugin -Writing a plugin for [xmobar] should be very simple. You need to create+Writing a plugin for xmobar should be very simple. You need to create a data type with at least one constructor. Next you must declare this data type an instance of the `Exec` class, by@@ -624,13 +852,14 @@ 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 `Plugins/HelloWorld.hs` or the other-plugins that are distributed with [xmobar].+For a very basic example see `samples/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]:+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: @@ -643,7 +872,7 @@ runnableTypes :: Command :*: Monitors :*: HelloWorld :*: () runnableTypes = undefined -3. Rebuild and reinstall [xmobar]. Now test it with:+3. Rebuild and reinstall xmobar. Now test it with: xmobar Plugins/helloworld.config @@ -677,56 +906,88 @@ runnableTypes :: Command :*: () runnableTypes = undefined -3. rebuild [xmobar].+3. rebuild xmobar. +Bug Reports+===========++To submit bug reports you can use the [bug tracker over at Google+code] or send mail to our [Mailing list].++[bug tracker over at Google code]: http://code.google.com/p/xmobar/issues+ Credits ======= +xmobar [incorporates patches] from Ben Boeckel, Roman Cheplyaka, John+Goerzen, Juraj Hercek, Tomas Janousek, Spencer Janssen, Krzysztof+Kosciuszkiewicz, Lennart Kolmodin, Dmitry Kurochkin, Svein Ove, Jens+Petersen, Petr Rockai, Andrew Sackville-West, Alexander Solovyov,+Sergei Trofimovich, Jan Vornberger, Daniel Wagner and Norbert Zeh.++[incorporates patches]: http://www.ohloh.net/p/xmobar/contributors++__Andrea Rossato__:+ Thanks to Robert Manea and Spencer Janssen for their help in understanding how X works. They gave me suggestions on how to solve-many problems with [xmobar].+many problems with xmobar. Thanks to Claus Reinke for make me understand existential types (or at least for letting me think I grasp existential types...;-). -[xmobar] incorporates patches from: Krzysztof Kosciuszkiewicz, Spencer-Janssen, Jens Petersen, Dmitry Kurochkin, Lennart Kolmodin, and-Norbert Zeh.+__jao__: +Thanks to Andrea for creating xmobar in the first place, and for+giving me the chance to contribute.+ Useful links ============ -The [xmobar] home page+- [Github page].+- [Mailing list].+- [xmobar's Ohloh page].+- Andrea's original [xmobar] home page, and [xmobar darcs repository]. -The [xmonad] home page+- To understand the internal mysteries of xmobar you may try reading+ [this tutorial] on X Window Programming in Haskell. -[xmobar darcs repository]+- My [sawflibs] project includes a module to automate running xmobar+ in [sawfish]. -To understand the internal mysteries of xmobar you may try reading-this tutorial [on X Window Programming in Haskell].+[xmobar's Ohloh page]: https://www.ohloh.net/p/xmobar+[xmobar]: http://code.haskell.org/~arossato/xmobar/+[xmobar darcs repository]: http://code.haskell.org/xmobar+[this tutorial]: http://www.haskell.org/haskellwiki/X_window_programming_in_Haskell+[sawflibs]: http://github.com/jaor/sawflibs Author ====== -Andrea Rossato--`andrea.rossato at ing.unitn.it`+Andrea Rossato originally designed and implemented xmobar up to+version 0.11.1. Since then, it is maintained by [Jose Antonio Ortega+Ruiz](http://hacks-galore.org/jao/). Legal ===== -This software is released under a BSD-style license. See LICENSE for+This software is released under a BSD-style license. See [LICENSE] for more details. -Copyright © 2007 Andrea Rossato+Copyright © 2007-2010 Andrea Rossato -[This is a screen shot]: http://haskell.org/sitewiki/images/a/ae/Arossato-config.png-[Hackage]: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmobar-[xmobar]: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmobar-[xmobar darcs repository]: http://code.haskell.org/xmobar-[on X Window Programming in Haskell]: http://www.haskell.org/haskellwiki/X_window_programming_in_Haskell-[Ion3]: http://modeemi.fi/~tuomov/ion/-[xmonad]: http://xmonad.org-[utf8-string]: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/utf8-string-[X11-xft]: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/X11-xft+Copyright © 2010 Jose Antonio Ortega Ruiz++[Github]: http://github.com/jaor/xmobar/+[Github page]: http://github.com/jaor/xmobar+[Hackage]: http://hackage.haskell.org/package/xmobar/+[LICENSE]: https://github.com/jaor/xmobar/raw/master/LICENSE+[Mailing list]: http://projects.haskell.org/cgi-bin/mailman/listinfo/xmobar+[MPD]: http://mpd.wikia.com/+[X11-xft]: http://hackage.haskell.org/package/X11-xft/ [i3status]: http://i3.zekjur.net/i3status/+[iwlib]: http://www.hpl.hp.com/personal/Jean_Tourrilhes/Linux/Tools.html+[hinotify]: http://hackage.haskell.org/package/hinotify/+[libmpd]: http://hackage.haskell.org/package/libmpd/+[sawfish]: http://sawfish.wikia.com/+[utf8-string]: http://hackage.haskell.org/package/utf8-string/
− Runnable.hs
@@ -1,59 +0,0 @@-{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}--------------------------------------------------------------------------------- |--- Module : Xmobar.Runnable--- Copyright : (c) Andrea Rossato--- License : BSD-style (see LICENSE)------ Maintainer : Andrea Rossato <andrea.rossato@unitn.it>--- Stability : unstable--- Portability : unportable------ The existential type to store the list of commands to be executed.--- I must thank Claus Reinke for the help in understanding the mysteries of--- reading existential types. The Read instance of Runnable must be credited to--- him.------ See here:--- http:\/\/www.haskell.org\/pipermail\/haskell-cafe\/2007-July\/028227.html-----------------------------------------------------------------------------------module Runnable where--import Control.Monad-import Text.Read-import Config (runnableTypes)-import Commands--data Runnable = forall r . (Exec r, Read r, Show r) => Run r--instance Exec Runnable where- start (Run a) = start a- alias (Run a) = alias a--instance Show Runnable where- show (Run x) = show x--instance Read Runnable where- readPrec = readRunnable--class ReadAsAnyOf ts ex where- -- | Reads an existential type as any of hidden types ts- readAsAnyOf :: ts -> ReadPrec ex--instance ReadAsAnyOf () ex where- readAsAnyOf ~() = mzero--instance (Show t, Read t, Exec t, ReadAsAnyOf ts Runnable) => ReadAsAnyOf (t,ts) Runnable where- readAsAnyOf ~(t,ts) = r t `mplus` readAsAnyOf ts- where r ty = do { m <- readPrec; return (Run (m `asTypeOf` ty)) }---- | The 'Prelude.Read' parser for the 'Runnable' existential type. It--- needs an 'Prelude.undefined' with a type signature containing the--- list of all possible types hidden within 'Runnable'. See 'Config.runnableTypes'.--- Each hidden type must have a 'Prelude.Read' instance.-readRunnable :: ReadPrec Runnable-readRunnable = prec 10 $ do- Ident "Run" <- lexP- parens $ readAsAnyOf runnableTypes
− Runnable.hs-boot
@@ -1,8 +0,0 @@-{-# LANGUAGE ExistentialQuantification #-}-module Runnable where-import Commands--data Runnable = forall r . (Exec r,Read r,Show r) => Run r--instance Read Runnable-instance Exec Runnable
− StatFS.hsc
@@ -1,79 +0,0 @@--------------------------------------------------------------------------------- |--- Module : StatFS--- Copyright : (c) Jose A Ortega Ruiz--- License : BSD-style (see LICENSE)------ Maintainer : Jose A Ortega Ruiz <jao@gnu.org>--- Stability : unstable--- Portability : unportable------ A binding to C's statvfs(2)-----------------------------------------------------------------------------------{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-}---module StatFS ( FileSystemStats(..), getFileSystemStats ) where--import Foreign-import Foreign.C.Types-import Foreign.C.String-import Data.ByteString (useAsCString)-import Data.ByteString.Char8 (pack)--#if defined (__FreeBSD__)-# include <sys/param.h>-# include <sys/mount.h>-#else-#include <sys/vfs.h>-#endif--data FileSystemStats = FileSystemStats {- fsStatBlockSize :: Integer- -- ^ Optimal transfer block size.- , fsStatBlockCount :: Integer- -- ^ Total data blocks in file system.- , fsStatByteCount :: Integer- -- ^ Total bytes in file system.- , fsStatBytesFree :: Integer- -- ^ Free bytes in file system.- , fsStatBytesAvailable :: Integer- -- ^ Free bytes available to non-superusers.- , fsStatBytesUsed :: Integer- -- ^ Bytes used.- } deriving (Show, Eq)--data CStatfs--#if defined(__FreeBSD__)-foreign import ccall unsafe "sys/mount.h statfs"-#else-foreign import ccall unsafe "sys/vfs.h statfs64"-#endif- c_statfs :: CString -> Ptr CStatfs -> IO CInt--toI :: CLong -> Integer-toI = toInteger--getFileSystemStats :: String -> IO (Maybe FileSystemStats)-getFileSystemStats path =- allocaBytes (#size struct statfs) $ \vfs ->- useAsCString (pack path) $ \cpath -> do- res <- c_statfs cpath vfs- if res == -1 then return Nothing- else do- bsize <- (#peek struct statfs, f_bsize) vfs- bcount <- (#peek struct statfs, f_blocks) vfs- bfree <- (#peek struct statfs, f_bfree) vfs- bavail <- (#peek struct statfs, f_bavail) vfs- let bpb = toI bsize- return $ Just FileSystemStats- { fsStatBlockSize = bpb- , fsStatBlockCount = toI bcount- , fsStatByteCount = toI bcount * bpb- , fsStatBytesFree = toI bfree * bpb- , fsStatBytesAvailable = toI bavail * bpb- , fsStatBytesUsed = toI (bcount - bfree) * bpb- }
− XUtil.hsc
@@ -1,259 +0,0 @@-{-# OPTIONS -fglasgow-exts #-}--------------------------------------------------------------------------------- |--- Module : XUtil--- Copyright : (C) 2007 Andrea Rossato--- License : BSD3------ Maintainer : andrea.rossato@unitn.it--- Stability : unstable--- Portability : unportable-----------------------------------------------------------------------------------module XUtil- ( XFont- , initFont- , initCoreFont- , initUtf8Font- , textExtents- , textWidth- , printString- , initColor- , newWindow- , nextEvent'- , readFileSafe- , hGetLineSafe- , io- , fi- , withColors- , DynPixel(..)- ) where--import Control.Concurrent-import Control.Monad.Trans-import Data.IORef-import Foreign-import Graphics.X11.Xlib hiding (textExtents, textWidth)-import qualified Graphics.X11.Xlib as Xlib (textExtents, textWidth)-import Graphics.X11.Xlib.Extras-import System.Mem.Weak ( addFinalizer )-import System.Posix.Types (Fd(..))-import System.IO-#if defined XFT || defined UTF8-# if __GLASGOW_HASKELL__ < 612-import Foreign.C-import qualified System.IO.UTF8 as UTF8 (readFile,hGetLine)-# else-import qualified System.IO as UTF8 (readFile,hGetLine)-# endif-#endif-#if defined XFT-import Data.List-import Graphics.X11.Xft-import Graphics.X11.Xrender-#endif--readFileSafe :: FilePath -> IO String-#if defined XFT || defined UTF8-readFileSafe = UTF8.readFile-#else-readFileSafe = readFile-#endif--hGetLineSafe :: Handle -> IO String-#if defined XFT || defined UTF8-hGetLineSafe = UTF8.hGetLine-#else-hGetLineSafe = hGetLine-#endif---- Hide the Core Font/Xft switching here-data XFont = Core FontStruct- | Utf8 FontSet-#ifdef XFT- | Xft XftFont-#endif---- | When initFont gets a font name that starts with 'xft:' it switchs to the Xft backend--- Example: 'xft:Sans-10'-initFont :: Display ->String -> IO XFont-initFont d s =-#ifdef XFT- let xftPrefix = "xft:" in- if xftPrefix `isPrefixOf` s then- fmap Xft $ initXftFont d s- else-#endif-#if defined UTF8 || __GLASGOW_HASKELL__ >= 612- fmap Utf8 $ initUtf8Font d s-#else- fmap Core $ initCoreFont d s-#endif---- | Given a fontname returns the font structure. If the font name is--- not valid the default font will be loaded and returned.-initCoreFont :: Display -> String -> IO FontStruct-initCoreFont d s = do- f <- catch getIt fallBack- addFinalizer f (freeFont d f)- return f- where getIt = loadQueryFont d s- fallBack = const $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"---- | Given a fontname returns the font structure. If the font name is--- not valid the default font will be loaded and returned.-initUtf8Font :: Display -> String -> IO FontSet-initUtf8Font d s = do- setupLocale- (_,_,f) <- catch getIt fallBack- addFinalizer f (freeFontSet d f)- return f- where getIt = createFontSet d s- fallBack = const $ createFontSet d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"--#ifdef XFT-initXftFont :: Display -> String -> IO XftFont-initXftFont d s = do- setupLocale- f <- xftFontOpen d (defaultScreenOfDisplay d) (drop 4 s)- addFinalizer f (xftFontClose d f)- return f-#endif--textWidth :: Display -> XFont -> String -> IO Int-textWidth _ (Utf8 fs) s = return $ fi $ wcTextEscapement fs s-textWidth _ (Core fs) s = return $ fi $ Xlib.textWidth fs s-#ifdef XFT-textWidth dpy (Xft xftdraw) s = do- gi <- xftTextExtents dpy xftdraw s- return $ xglyphinfo_xOff gi-#endif--textExtents :: XFont -> String -> IO (Int32,Int32)-textExtents (Core fs) s = do- let (_,a,d,_) = Xlib.textExtents fs s- return (a,d)-textExtents (Utf8 fs) s = do- let (_,rl) = wcTextExtents fs s- ascent = fi $ - (rect_y rl)- descent = fi $ rect_height rl + (fi $ rect_y rl)- return (ascent, descent)-#ifdef XFT-textExtents (Xft xftfont) _ = do- ascent <- fi `fmap` xftfont_ascent xftfont- descent <- fi `fmap` xftfont_descent xftfont- return (ascent, descent)-#endif--printString :: Display -> Drawable -> XFont -> GC -> String -> String- -> Position -> Position -> String -> IO ()-printString d p (Core fs) gc fc bc x y s = do- setFont d gc $ fontFromFontStruct fs- withColors d [fc, bc] $ \[fc', bc'] -> do- setForeground d gc fc'- setBackground d gc bc'- drawImageString d p gc x y s--printString d p (Utf8 fs) gc fc bc x y s =- withColors d [fc, bc] $ \[fc', bc'] -> do- setForeground d gc fc'- setBackground d gc bc'- io $ wcDrawImageString d p fs gc x y s--#ifdef XFT-printString dpy drw fs@(Xft font) gc fc bc x y s = do- let screen = defaultScreenOfDisplay dpy- colormap = defaultColormapOfScreen screen- visual = defaultVisualOfScreen screen- withColors dpy [bc] $ \[bcolor] -> do- (a,d) <- textExtents fs s- gi <- xftTextExtents dpy font s- setForeground dpy gc bcolor- fillRectangle dpy drw gc (x - fi (xglyphinfo_x gi))- (y - fi (a + d))- (fi $ xglyphinfo_xOff gi)- (fi $ 4 + a + d)- withXftDraw dpy drw visual colormap $- \draw -> withXftColorName dpy visual colormap fc $- \color -> xftDrawString draw color font x (y - 2) s-#endif--data DynPixel = DynPixel { allocated :: Bool- , pixel :: Pixel- }---- | Get the Pixel value for a named color: if an invalid name is--- given the black pixel will be returned.-initColor :: Display -> String -> IO DynPixel-initColor dpy c = (initColor' dpy c) `catch`- (const . return $ DynPixel False (blackPixel dpy $ defaultScreen dpy))--type ColorCache = [(String, Color)]-{-# NOINLINE colorCache #-}-colorCache :: IORef ColorCache-colorCache = unsafePerformIO $ newIORef []--getCachedColor :: String -> IO (Maybe Color)-getCachedColor color_name = lookup color_name `fmap` readIORef colorCache--putCachedColor :: String -> Color -> IO ()-putCachedColor name c_id = modifyIORef colorCache $ \c -> (name, c_id) : c--initColor' :: Display -> String -> IO DynPixel-initColor' dpy c = do- let colormap = defaultColormap dpy (defaultScreen dpy)- cached_color <- getCachedColor c- c' <- case cached_color of- Just col -> return col- _ -> do (c'', _) <- allocNamedColor dpy colormap c- putCachedColor c c''- return c''- return $ DynPixel True (color_pixel c')--withColors :: MonadIO m => Display -> [String] -> ([Pixel] -> m a) -> m a-withColors d cs f = do- ps <- mapM (io . initColor d) cs- f $ map pixel ps---- | Creates a window with the attribute override_redirect set to True.--- Windows Managers should not touch this kind of windows.-newWindow :: Display -> Screen -> Window -> Rectangle -> Bool -> IO Window-newWindow dpy scr rw (Rectangle x y w h) o = do- let visual = defaultVisualOfScreen scr- attrmask = cWOverrideRedirect- allocaSetWindowAttributes $- \attributes -> do- set_override_redirect attributes o- createWindow dpy rw x y w h 0 (defaultDepthOfScreen scr)- inputOutput visual attrmask attributes--- | A version of nextEvent that does not block in foreign calls.-nextEvent' :: Display -> XEventPtr -> IO ()-nextEvent' d p = do- pend <- pending d- if pend /= 0- then nextEvent d p- else do- threadWaitRead (Fd fd)- nextEvent' d p- where- fd = connectionNumber d--io :: MonadIO m => IO a -> m a-io = liftIO---- | Short-hand for 'fromIntegral'-fi :: (Integral a, Num b) => a -> b-fi = fromIntegral--#if __GLASGOW_HASKELL__ < 612 && (defined XFT || defined UTF8)-#include <locale.h>-foreign import ccall unsafe "locale.h setlocale"- setlocale :: CInt -> CString -> IO CString--setupLocale :: IO ()-setupLocale = withCString "" (setlocale $ #const LC_ALL) >> return ()-# else-setupLocale :: IO ()-setupLocale = return ()-#endif
− Xmobar.hs
@@ -1,286 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}--------------------------------------------------------------------------------- |--- Module : Xmobar--- Copyright : (c) Andrea Rossato--- License : BSD-style (see LICENSE)------ Maintainer : Andrea Rossato <andrea.rossato@unitn.it>--- Stability : unstable--- Portability : unportable------ A status bar for the Xmonad Window Manager-----------------------------------------------------------------------------------module Xmobar- ( -- * Main Stuff- -- $main- X , XConf (..), runX- , eventLoop- -- * Program Execution- -- $command- , startCommand- -- * Window Management- -- $window- , createWin, updateWin- -- * Printing- -- $print- , drawInWin, printStrings- ) where--import Prelude hiding (catch)-import Graphics.X11.Xlib hiding (textExtents, textWidth)-import Graphics.X11.Xlib.Extras-import Graphics.X11.Xinerama--import Control.Arrow ((&&&))-import Control.Monad.Reader-import Control.Concurrent-import Control.Concurrent.STM-import Control.Exception hiding (handle)-import Data.Bits-import Data.Maybe(fromMaybe)-import Data.Typeable (Typeable)--import Config-import Parsers-import Commands-import Runnable-import XUtil---- $main------ The Xmobar data type and basic loops and functions.---- | The X type is a ReaderT-type X = ReaderT XConf IO---- | The ReaderT inner component-data XConf =- XConf { display :: Display- , rect :: Rectangle- , window :: Window- , fontS :: XFont- , config :: Config- }---- | Runs the ReaderT-runX :: XConf -> X () -> IO ()-runX xc f = runReaderT f xc--data WakeUp = WakeUp deriving (Show,Typeable)-instance Exception WakeUp---- | The event loop-eventLoop :: XConf -> [(Maybe ThreadId, TVar String)] -> IO ()-eventLoop xc@(XConf d _ w fs c) v = block $ do- tv <- atomically $ newTVar []- t <- myThreadId- ct <- forkIO (checker t tv "" `catch` \(SomeException _) -> return ())- go tv ct- where- -- interrupt the drawing thread every time a var is updated- checker t tvar ov = do- nval <- atomically $ do- nv <- fmap concat $ mapM readTVar (map snd v)- guard (nv /= ov)- writeTVar tvar nv- return nv- throwTo t WakeUp- checker t tvar nval-- -- Continuously wait for a timer interrupt or an expose event- go tv ct = do- catch (unblock $ allocaXEvent $ \e ->- handle tv ct =<< (nextEvent' d e >> getEvent e))- (\WakeUp -> runX xc (updateWin tv) >> return ())- go tv ct-- -- event hanlder- handle _ ct (ConfigureEvent {ev_window = win}) = do- rootw <- rootWindow d (defaultScreen d)- when (win == rootw) $ block $ do- killThread ct- destroyWindow d w- (r',w') <- createWin d fs c- eventLoop (XConf d r' w' fs c) v-- handle tvar _ (ExposeEvent {}) = runX xc (updateWin tvar)-- handle _ _ _ = return ()---- $command---- | Runs a command as an independent thread and returns its thread id--- and the TVar the command will be writing to.-startCommand :: (Runnable,String,String) -> IO (Maybe ThreadId, TVar String)-startCommand (com,s,ss)- | alias com == "" = do var <- atomically $ newTVar is- atomically $ writeTVar var "Could not parse the template"- return (Nothing,var)- | otherwise = do var <- atomically $ newTVar is- let cb str = atomically $ writeTVar var (s ++ str ++ ss)- h <- forkIO $ start com cb- return (Just h,var)- where is = s ++ "Updating..." ++ ss---- $window---- | The function to create the initial window-createWin :: Display -> XFont -> Config -> IO (Rectangle,Window)-createWin d fs c = do- let dflt = defaultScreen d- srs <- getScreenInfo d- rootw <- rootWindow d dflt- (as,ds) <- textExtents fs "0"- let ht = as + ds + 4- (r,o) = setPosition (position c) srs (fi ht)- win <- newWindow d (defaultScreenOfDisplay d) rootw r o- selectInput d win (exposureMask .|. structureNotifyMask)- setProperties r c d win srs- when (lowerOnStart c) (lowerWindow d win)- mapWindow d win- return (r,win)--setPosition :: XPosition -> [Rectangle] -> Dimension -> (Rectangle,Bool)-setPosition p rs ht =- case p' of- Top -> (Rectangle rx ry rw h , True)- TopW a i -> (Rectangle (ax a i ) ry (nw i ) h , True)- TopSize a i ch -> (Rectangle (ax a i ) ry (nw i ) (mh ch), True)- Bottom -> (Rectangle rx ny rw h , True)- BottomW a i -> (Rectangle (ax a i ) ny (nw i ) h , True)- BottomSize a i ch -> (Rectangle (ax a i ) ny (nw i ) (mh ch), True)- Static cx cy cw ch -> (Rectangle (fi cx ) (fi cy) (fi cw) (fi ch), True)- OnScreen _ p'' -> setPosition p'' [scr] ht- where- (scr@(Rectangle rx ry rw rh), p') =- case p of OnScreen i x -> (fromMaybe (head rs) $ safeIndex i rs, x)- _ -> (head rs, p)- ny = ry + fi (rh - ht)- center i = rx + (fi $ div (remwid i) 2)- right i = rx + (fi $ remwid i)- remwid i = rw - pw (fi i)- ax L = const rx- ax R = right- ax C = center- pw i = rw * (min 100 i) `div` 100- nw = fi . pw . fi- h = fi ht- mh h' = max (fi h') h-- safeIndex i = lookup i . zip [0..]--setProperties :: Rectangle -> Config -> Display -> Window -> [Rectangle] -> IO ()-setProperties r c d w srs = do- a1 <- internAtom d "_NET_WM_STRUT_PARTIAL" False- c1 <- internAtom d "CARDINAL" False- a2 <- internAtom d "_NET_WM_WINDOW_TYPE" False- c2 <- internAtom d "ATOM" False- v <- internAtom d "_NET_WM_WINDOW_TYPE_DOCK" False- changeProperty32 d w a1 c1 propModeReplace $ map fi $- getStrutValues r (position c) (getRootWindowHeight srs)- changeProperty32 d w a2 c2 propModeReplace [fromIntegral v]--getRootWindowHeight :: [Rectangle] -> Int-getRootWindowHeight srs = foldr1 max (map getMaxScreenYCoord srs)- where- getMaxScreenYCoord sr = fi (rect_y sr) + fi (rect_height sr)--getStrutValues :: Rectangle -> XPosition -> Int -> [Int]-getStrutValues r@(Rectangle x y w h) p rwh =- case p of- OnScreen _ p' -> getStrutValues r p' rwh- Top -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]- TopW _ _ -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]- TopSize {} -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]- Bottom -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]- BottomW _ _ -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]- BottomSize {} -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]- Static _ _ _ _ -> getStaticStrutValues p rwh- where st = fi y + fi h- sb = rwh - fi y- nx = fi x- nw = fi (x + fi w - 1)---- get some reaonable strut values for static placement. -getStaticStrutValues :: XPosition -> Int -> [Int]-getStaticStrutValues (Static cx cy cw ch) rwh- -- if the yPos is in the top half of the screen, then assume a Top- -- placement, otherwise, it's a Bottom placement- | cy < (rwh `div` 2) = [0, 0, st, 0, 0, 0, 0, 0, xs, xe, 0, 0]- | otherwise = [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, xs, xe]- where st = cy + ch - sb = rwh - cy- xs = cx -- a simple calculation for horizontal (x) placement- xe = xs + cw-getStaticStrutValues _ _ = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]- -updateWin :: TVar String -> X ()-updateWin v = do- xc <- ask- let (conf,rec) = (config &&& rect) xc- [lc,rc] = if length (alignSep conf) == 2- then alignSep conf- else alignSep defaultConfig- i <- io $ atomically $ readTVar v- let def = [i,[],[]]- [l,c,r] = case break (==lc) i of- (le,_:re) -> case break (==rc) re of- (ce,_:ri) -> [le,ce,ri]- _ -> def- _ -> def- ps <- io $ mapM (parseString conf) [l,c,r]- drawInWin rec ps---- $print---- | Draws in and updates the window-drawInWin :: Rectangle -> [[(String, String)]] -> X ()-drawInWin (Rectangle _ _ wid ht) ~[left,center,right] = do- r <- ask- let (c,d ) = (config &&& display) r- (w,fs) = (window &&& fontS ) r- strLn = io . mapM (\(s,cl) -> textWidth d fs s >>= \tw -> return (s,cl,fi tw))- withColors d [bgColor c] $ \[bgcolor] -> do- gc <- io $ createGC d w- -- create a pixmap to write to and fill it with a rectangle- p <- io $ createPixmap d w wid ht- (defaultDepthOfScreen (defaultScreenOfDisplay d))- -- the fgcolor of the rectangle will be the bgcolor of the window- io $ setForeground d gc bgcolor- io $ fillRectangle d p gc 0 0 wid ht- -- write to the pixmap the new string- printStrings p gc fs 1 L =<< strLn left- printStrings p gc fs 1 R =<< strLn right- printStrings p gc fs 1 C =<< strLn center- -- copy the pixmap with the new string to the window- io $ copyArea d p w gc 0 0 wid ht 0 0- -- free up everything (we do not want to leak memory!)- io $ freeGC d gc- io $ freePixmap d p- -- resync- io $ sync d True---- | An easy way to print the stuff we need to print-printStrings :: Drawable -> GC -> XFont -> Position- -> Align -> [(String, String, Position)] -> X ()-printStrings _ _ _ _ _ [] = return ()-printStrings dr gc fontst offs a sl@((s,c,l):xs) = do- r <- ask- (as,ds) <- io $ textExtents fontst s- let (conf,d) = (config &&& display) r- Rectangle _ _ wid _ = rect r- totSLen = foldr (\(_,_,len) -> (+) len) 0 sl- valign = fi $ as + ds- remWidth = fi wid - fi totSLen- offset = case a of- C -> (remWidth + offs) `div` 2- R -> remWidth - 1- L -> offs- (fc,bc) = case (break (==',') c) of- (f,',':b) -> (f, b )- (f, _) -> (f, bgColor conf)- io $ printString d dr fontst gc fc bc offset valign s- printStrings dr gc fontst (offs + l) a xs
+ samples/Plugins/HelloWorld.hs view
@@ -0,0 +1,24 @@+-----------------------------------------------------------------------------+-- |+-- 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 Plugins.HelloWorld where++import Plugins++data HelloWorld = HelloWorld+ deriving (Read, Show)++instance Exec HelloWorld where+ alias HelloWorld = "helloWorld"+ run HelloWorld = return "<fc=red>Hello World!!</fc>"
+ samples/Plugins/helloworld.config view
@@ -0,0 +1,12 @@+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>"+ }
+ samples/xmobar.config view
@@ -0,0 +1,18 @@+Config { font = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"+ , bgColor = "black"+ , fgColor = "grey"+ , position = Top+ , lowerOnStart = True+ , commands = [ Run Weather "EGPF" ["-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+ ]+ , sepChar = "%"+ , alignSep = "}{"+ , template = "%cpu% | %memory% * %swap% | %eth0% - %eth1% }{ <fc=#ee9a00>%date%</fc>| %EGPF% | %uname%"+ }
− scripts/xmonadpropwrite.hs
@@ -1,41 +0,0 @@--- Copyright Spencer Janssen <spencerjanssen@gmail.com>--- Tomas Janousek <tomi@nomi.cz>--- BSD3 (see LICENSE)------ Reads from standard input and writes to an X propery on root window.--- To be used with XPropertyLog:--- Add it to commands:--- Run XPropertyLog "_XMONAD_LOG_CUSTOM"--- Add it to the template:--- template = "... %_XMONAD_LOG_CUSTOM% ..."--- Run:--- $ blah blah | xmonadpropwrite _XMONAD_LOG_CUSTOM--import Control.Monad-import Graphics.X11-import Graphics.X11.Xlib.Extras-import qualified Data.ByteString as B-import Foreign.C (CChar)-import System.IO-import System.Environment--main = do- atom <- flip fmap getArgs $ \args -> case args of- [a] -> a- _ -> "_XMONAD_LOG"-- d <- openDisplay ""- xlog <- internAtom d atom False- ustring <- internAtom d "UTF8_STRING" False-- root <- rootWindow d (defaultScreen d)-- forever $ do- msg <- B.getLine- changeProperty8 d root xlog ustring propModeReplace (encodeCChar msg)- sync d True-- return ()--encodeCChar :: B.ByteString -> [CChar]-encodeCChar = map fromIntegral . B.unpack
+ src/Commands.hs view
@@ -0,0 +1,84 @@+-----------------------------------------------------------------------------+-- |+-- 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 Commands+ ( Command (..)+ , Exec (..)+ , tenthSeconds+ ) where++import Prelude hiding (catch)+import Control.Concurrent+import Control.Exception+import Data.Char+import System.Process+import System.Exit+import System.IO (hClose)+import XUtil++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 = do+ run e >>= cb+ tenthSeconds (rate e) >> go++data Command = Com Program Args Alias Rate+ deriving (Show,Read,Eq)++type Args = [String]+type Program = String+type Alias = String+type Rate = Int++instance Exec Command where+ alias (Com p _ a _)+ | p /= "" = if a == "" then p else a+ | otherwise = ""+ start (Com prog args _ r) cb = if r > 0 then go else exec+ where go = exec >> tenthSeconds r >> go+ exec = do+ (i,o,e,p) <- runInteractiveCommand (unwords (prog:args))+ exit <- waitForProcess p+ let closeHandles = hClose o >> hClose i >> hClose e+ case exit of+ ExitSuccess -> do+ str <- catch (hGetLineSafe o)+ (\(SomeException _) -> return "")+ closeHandles+ cb str+ _ -> do closeHandles+ cb $ "Could not execute command " ++ prog+++-- | 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 y+ tenthSeconds (x - s)+ | otherwise = threadDelay (s * 100000)+ where y = maxBound :: Int+ x = y `div` 100000
+ src/Config.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE CPP, TypeOperators #-}++-----------------------------------------------------------------------------+-- |+-- Module : Xmobar.Config+-- Copyright : (c) Andrea Rossato+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- The configuration module of Xmobar, a text based status bar+--+-----------------------------------------------------------------------------++module Config+ ( -- * Configuration+ -- $config+ Config (..)+ , XPosition (..), Align (..), Border(..)+ , defaultConfig+ , runnableTypes+ ) where++import Commands+import {-# SOURCE #-} Runnable+import Plugins.Monitors+import Plugins.Date+import Plugins.PipeReader+import Plugins.CommandReader+import Plugins.StdinReader+import Plugins.XMonadLog+import Plugins.EWMH++#ifdef INOTIFY+import Plugins.Mail+import Plugins.MBox+#endif++-- $config+-- Configuration data type and default configuration++-- | The configuration data type+data Config =+ Config { font :: String -- ^ Font+ , bgColor :: String -- ^ Backgroud color+ , fgColor :: String -- ^ Default font color+ , position :: XPosition -- ^ Top Bottom or Static+ , border :: Border -- ^ NoBorder TopB BottomB or FullB+ , borderColor :: String -- ^ Border color+ , lowerOnStart :: Bool -- ^ Lower to the bottom of the+ -- window stack on initialization+ , commands :: [Runnable] -- ^ For setting the command, the command arguments+ -- and refresh rate for the programs to run (optional)+ , sepChar :: String -- ^ The character to be used for indicating+ -- commands in the output template (default '%')+ , alignSep :: String -- ^ Separators for left, center and right text alignment+ , template :: String -- ^ The output template+ } deriving (Read)++data XPosition = Top+ | TopW Align Int+ | TopSize Align Int Int+ | Bottom+ | BottomW Align Int+ | BottomSize Align Int Int+ | Static {xpos, ypos, width, height :: Int}+ | OnScreen Int XPosition+ deriving ( Read, Eq )++data Align = L | R | C deriving ( Read, Eq )++data Border = NoBorder+ | TopB+ | BottomB+ | FullB+ | TopBM Int+ | BottomBM Int+ | FullBM Int+ deriving ( Read, Eq )++-- | The default configuration values+defaultConfig :: Config+defaultConfig =+ Config { font = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"+ , bgColor = "#000000"+ , fgColor = "#BFBFBF"+ , position = Top+ , border = NoBorder+ , borderColor = "#BFBFBF"+ , lowerOnStart = True+ , commands = [ Run $ Date "%a %b %_d %Y * %H:%M:%S" "theDate" 10+ , Run StdinReader]+ , sepChar = "%"+ , alignSep = "}{"+ , template = "%StdinReader% }{ <fc=#00FF00>%uname%</fc> * <fc=#FF0000>%theDate%</fc>"+ }+++-- | An alias for tuple types that is more convenient for long lists.+type a :*: b = (a, b)+infixr :*:++-- | This is the list of types that can be hidden inside+-- 'Runnable.Runnable', the existential type that stores all commands+-- to be executed by Xmobar. It is used by 'Runnable.readRunnable' in+-- the 'Runnable.Runnable' Read instance. To install a plugin just add+-- the plugin's type to the list of types (separated by ':*:') appearing in+-- this function's type signature.+runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*:+#ifdef INOTIFY+ Mail :*: MBox :*:+#endif+ ()+runnableTypes = undefined
+ src/IWlib.hsc view
@@ -0,0 +1,75 @@+-----------------------------------------------------------------------------+-- |+-- Module : IWlib+-- Copyright : (c) Jose A Ortega Ruiz+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- A partial binding to iwlib+--+-----------------------------------------------------------------------------++{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-}+++module IWlib (WirelessInfo(..), getWirelessInfo) where++import Foreign+import Foreign.C.Types+import Foreign.C.String++data WirelessInfo = WirelessInfo { wiEssid :: String, wiQuality :: Int }+ deriving Show++#include <iwlib.h>++data WCfg+data WStats+data WRange++foreign import ccall "iwlib.h iw_sockets_open"+ c_iw_open :: IO CInt++foreign import ccall "unistd.h close"+ c_iw_close :: CInt -> IO ()++foreign import ccall "iwlib.h iw_get_basic_config"+ c_iw_basic_config :: CInt -> CString -> Ptr WCfg -> IO CInt++foreign import ccall "iwlib.h iw_get_stats"+ c_iw_stats :: CInt -> CString -> Ptr WStats -> Ptr WRange -> CInt -> IO CInt++foreign import ccall "iwlib.h iw_get_range_info"+ c_iw_range :: CInt -> CString -> Ptr WRange -> IO CInt++getWirelessInfo :: String -> IO WirelessInfo+getWirelessInfo iface =+ allocaBytes (#size struct wireless_config) $ \wc ->+ allocaBytes (#size struct iw_statistics) $ \stats ->+ allocaBytes (#size struct iw_range) $ \rng ->+ withCString iface $ \istr -> do+ i <- c_iw_open+ bcr <- c_iw_basic_config i istr wc+ str <- c_iw_stats i istr stats rng 1+ rgr <- c_iw_range i istr rng+ c_iw_close i+ if (bcr < 0) then return WirelessInfo { wiEssid = "", wiQuality = 0 } else+ do hase <- (#peek struct wireless_config, has_essid) wc :: IO CInt+ eon <- (#peek struct wireless_config, essid_on) wc :: IO CInt+ essid <- if hase /= 0 && eon /= 0 then+ do let e = (#ptr struct wireless_config, essid) wc+ peekCString e+ else return ""+ q <- if str >= 0 && rgr >=0 then+ do qualv <- xqual $ (#ptr struct iw_statistics, qual) stats+ mv <- xqual $ (#ptr struct iw_range, max_qual) rng+ let mxv = if mv /= 0 then fromIntegral mv else 1+ return $ fromIntegral qualv / mxv+ else return 0+ let qv = round (100 * (q :: Double))+ return $ WirelessInfo { wiEssid = essid, wiQuality = min 100 qv }+ where xqual p = let qp = (#ptr struct iw_param, value) p in+ (#peek struct iw_quality, qual) qp :: IO CChar
+ src/Main.hs view
@@ -0,0 +1,164 @@+{-# LANGUAGE FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module : Xmobar.Main+-- Copyright : (c) Andrea Rossato+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- The main module of Xmobar, a text based status bar+--+-----------------------------------------------------------------------------++module Main ( -- * Main Stuff+ -- $main+ main+ , readConfig+ , readDefaultConfig+ ) where++import Xmobar+import Parsers+import Config+import XUtil++import Data.List (intercalate)++import Paths_xmobar (version)+import Data.IORef+import Data.Version (showVersion)+import Graphics.X11.Xlib+import System.Console.GetOpt+import System.Exit+import System.Environment+import System.Posix.Files+import Control.Monad (unless)++-- $main++-- | The main entry point+main :: IO ()+main = do+ d <- openDisplay ""+ args <- getArgs+ (o,file) <- getOpts args+ (c,defaultings) <- case file of+ [cfgfile] -> readConfig cfgfile+ _ -> readDefaultConfig++ unless (null defaultings) $ putStrLn $ "Fields missing from config defaulted: "+ ++ intercalate "," defaultings++ -- listen for ConfigureEvents on the root window, for xrandr support:+ rootw <- rootWindow d (defaultScreen d)+ selectInput d rootw structureNotifyMask++ civ <- newIORef c+ doOpts civ o+ conf <- readIORef civ+ fs <- initFont d (font conf)+ cl <- parseTemplate conf (template conf)+ vars <- mapM startCommand cl+ (r,w) <- createWin d fs conf+ eventLoop (XConf d r w fs conf) vars++-- | Reads the configuration files or quits with an error+readConfig :: FilePath -> IO (Config,[String])+readConfig f = do+ file <- io $ fileExist f+ s <- io $ if file then readFileSafe f else error $ f ++ ": file not found!\n" ++ usage+ either (\err -> error $ f ++ ": configuration file contains errors at:\n" ++ show err)+ return $ parseConfig s++-- | Read default configuration file or load the default config+readDefaultConfig :: IO (Config,[String])+readDefaultConfig = do+ home <- io $ getEnv "HOME"+ let path = home ++ "/.xmobarrc"+ f <- io $ fileExist path+ if f then readConfig path else return (defaultConfig,[])++data Opts = Help+ | Version+ | Font String+ | BgColor String+ | FgColor String+ | T+ | B+ | AlignSep String+ | Commands String+ | SepChar String+ | Template String+ | OnScr String+ deriving Show++options :: [OptDescr Opts]+options =+ [ Option ['h','?' ] ["help" ] (NoArg Help ) "This help"+ , Option ['V' ] ["version" ] (NoArg Version ) "Show version information"+ , Option ['f' ] ["font" ] (ReqArg Font "font name") "The font name"+ , Option ['B' ] ["bgcolor" ] (ReqArg BgColor "bg color" ) "The background color. Default black"+ , Option ['F' ] ["fgcolor" ] (ReqArg FgColor "fg color" ) "The foreground color. Default grey"+ , Option ['o' ] ["top" ] (NoArg T ) "Place xmobar at the top of the screen"+ , Option ['b' ] ["bottom" ] (NoArg B ) "Place xmobar at the bottom of the screen"+ , Option ['a' ] ["alignsep" ] (ReqArg AlignSep "alignsep" ) "Separators for left, center and right text\nalignment. Default: '}{'"+ , Option ['s' ] ["sepchar" ] (ReqArg SepChar "char" ) "The character used to separate commands in\nthe output template. Default '%'"+ , Option ['t' ] ["template" ] (ReqArg Template "template" ) "The output template"+ , Option ['c' ] ["commands" ] (ReqArg Commands "commands" ) "The list of commands to be executed"+ , Option ['x' ] ["screen" ] (ReqArg OnScr "screen" ) "On which X screen number to start"+ ]++getOpts :: [String] -> IO ([Opts], [String])+getOpts argv =+ case getOpt Permute options argv of+ (o,n,[]) -> return (o,n)+ (_,_,errs) -> error (concat errs ++ usage)++usage :: String+usage = (usageInfo header options) ++ footer+ where header = "Usage: xmobar [OPTION...] [FILE]\nOptions:"+ footer = "\nMail bug reports and suggestions to " ++ mail ++ "\n"++info :: String+info = "xmobar " ++ showVersion version+ ++ "\n (C) 2007 - 2010 Andrea Rossato "+ ++ "\n (C) 2010 Jose A Ortega Ruiz\n "+ ++ mail ++ "\n" ++ license++mail :: String+mail = "<xmobar@projects.haskell.org>"++license :: String+license = "\nThis program is distributed in the hope that it will be useful,\n" +++ "but WITHOUT ANY WARRANTY; without even the implied warranty of\n" +++ "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n" +++ "See the License for more details."++doOpts :: IORef Config -> [Opts] -> IO ()+doOpts _ [] = return ()+doOpts conf (o:oo) =+ case o of+ Help -> putStr usage >> exitWith ExitSuccess+ Version -> putStrLn info >> exitWith ExitSuccess+ Font s -> modifyIORef conf (\c -> c { font = s }) >> go+ BgColor s -> modifyIORef conf (\c -> c { bgColor = s }) >> go+ FgColor s -> modifyIORef conf (\c -> c { fgColor = s }) >> go+ T -> modifyIORef conf (\c -> c { position = Top }) >> go+ B -> modifyIORef conf (\c -> c { position = Bottom}) >> go+ AlignSep s -> modifyIORef conf (\c -> c { alignSep = s }) >> go+ SepChar s -> modifyIORef conf (\c -> c { sepChar = s }) >> go+ Template s -> modifyIORef conf (\c -> c { template = s }) >> go+ OnScr n -> modifyIORef conf (\c -> c { position = OnScreen (read n) $ position c }) >> go+ Commands s -> case readCom s of+ Right x -> modifyIORef conf (\c -> c { commands = x }) >> go+ Left e -> putStr (e ++ usage) >> exitWith (ExitFailure 1)+ where readCom str =+ case readStr str of+ [x] -> Right x+ _ -> Left "xmobar: cannot read list of commands specified with the -c option\n"+ readStr str =+ [x | (x,t) <- reads str, ("","") <- lex t]+ go = doOpts conf oo
+ src/Parsers.hs view
@@ -0,0 +1,183 @@+{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving #-}+-----------------------------------------------------------------------------+-- |+-- Module : Xmobar.Parsers+-- Copyright : (c) Andrea Rossato+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- Parsers needed for Xmobar, a text based status bar+--+-----------------------------------------------------------------------------++module Parsers+ ( parseString+ , parseTemplate+ , parseConfig+ ) where++import Config+import Runnable+import Commands++import qualified Data.Map as Map+import Text.ParserCombinators.Parsec+import Text.ParserCombinators.Parsec.Perm++-- | Runs the string parser+parseString :: Config -> String -> IO [(String, String)]+parseString c s =+ case parse (stringParser (fgColor c)) "" s of+ Left _ -> return [("Could not parse string: " ++ s, fgColor c)]+ Right x -> return (concat x)++-- | Gets the string and combines the needed parsers+stringParser :: String -> Parser [[(String, String)]]+stringParser c = manyTill (textParser c <|> colorParser) eof++-- | Parses a maximal string without color markup.+textParser :: String -> Parser [(String, String)]+textParser c = do s <- many1 $+ noneOf "<" <|>+ ( try $ notFollowedBy' (char '<')+ (string "fc=" <|> string "/fc>" ) )+ return [(s, c)]++-- | Wrapper for notFollowedBy that returns the result of the first parser.+-- Also works around the issue that, at least in Parsec 3.0.0, notFollowedBy+-- accepts only parsers with return type Char.+notFollowedBy' :: Parser a -> Parser b -> Parser a+notFollowedBy' p e = do x <- p+ notFollowedBy $ try (e >> return '*')+ return x++-- | Parsers a string wrapped in a color specification.+colorParser :: Parser [(String, String)]+colorParser = do+ c <- between (string "<fc=") (string ">") colors+ s <- manyTill (textParser c <|> colorParser) (try $ string "</fc>")+ return (concat s)++-- | Parses a color specification (hex or named)+colors :: Parser String+colors = many1 (alphaNum <|> char ',' <|> char '#')++-- | Parses the output template string+templateStringParser :: Config -> Parser (String,String,String)+templateStringParser c = do+ s <- allTillSep c+ com <- templateCommandParser c+ ss <- allTillSep c+ return (com, s, ss)++-- | Parses the command part of the template string+templateCommandParser :: Config -> Parser String+templateCommandParser c =+ let chr = char . head . sepChar+ in between (chr c) (chr c) (allTillSep c)++-- | Combines the template parsers+templateParser :: Config -> Parser [(String,String,String)]+templateParser = many . templateStringParser++-- | Actually runs the template parsers+parseTemplate :: Config -> String -> IO [(Runnable,String,String)]+parseTemplate c s =+ do str <- case parse (templateParser c) "" s of+ Left _ -> return [("","","")]+ Right x -> return x+ let cl = map alias (commands c)+ m = Map.fromList $ zip cl (commands c)+ return $ combine c m str++-- | Given a finite "Map" and a parsed template produce the resulting+-- output string.+combine :: Config -> Map.Map String Runnable -> [(String, String, String)] -> [(Runnable,String,String)]+combine _ _ [] = []+combine c m ((ts,s,ss):xs) = (com, s, ss) : combine c m xs+ where com = Map.findWithDefault dflt ts m+ dflt = Run $ Com ts [] [] 10++allTillSep :: Config -> Parser String+allTillSep = many . noneOf . sepChar++stripComments :: String -> String+stripComments = unlines . map (drop 5 . strip False . (replicate 5 ' '++)) . lines+ where strip m ('-':'-':xs) = if m then "--" ++ strip m xs else ""+ strip m ('\\':xss) = case xss of+ '\\':xs -> '\\' : strip m xs+ _ -> strip m $ drop 1 xss+ strip m ('"':xs) = '"': strip (not m) xs+ strip m (x:xs) = x : strip m xs+ strip _ [] = []++-- | Parse the config, logging a list of fields that were missing and replaced+-- by the default definition.+parseConfig :: String -> Either ParseError (Config,[String])+parseConfig = runParser parseConf fields "Config" . stripComments+ where+ parseConf = do+ many space+ sepEndSpc ["Config","{"]+ x <- perms+ eof+ s <- getState+ return (x,s)++ perms = permute $ Config+ <$?> pFont <|?> pBgColor+ <|?> pFgColor <|?> pPosition+ <|?> pBorder <|?> pBdColor+ <|?> pLowerOnStart <|?> pCommands+ <|?> pSepChar <|?> pAlignSep+ <|?> pTemplate++ fields = [ "font", "bgColor", "fgColor", "sepChar", "alignSep"+ , "border", "borderColor" ,"template", "position"+ , "lowerOnStart", "commands"]+ pFont = strField font "font"+ pBgColor = strField bgColor "bgColor"+ pFgColor = strField fgColor "fgColor"+ pBdColor = strField borderColor "borderColor"+ pSepChar = strField sepChar "sepChar"+ pAlignSep = strField alignSep "alignSep"+ pTemplate = strField template "template"++ pPosition = field position "position" $ tillFieldEnd >>= read' "position"+ pLowerOnStart = field lowerOnStart "lowerOnStart" $ tillFieldEnd >>= read' "lowerOnStart"+ pBorder = field border "border" $ tillFieldEnd >>= read' "border"+ pCommands = field commands "commands" $ readCommands++ staticPos = do string "Static"+ wrapSkip (string "{")+ p <- many (noneOf "}")+ wrapSkip (string "}")+ string ","+ return ("Static {" ++ p ++ "}")+ tillFieldEnd = staticPos <|> many (noneOf ",}\n\r")++ commandsEnd = wrapSkip (string "]") >> oneOf "},"+ readCommands = manyTill anyChar (try commandsEnd) >>= read' commandsErr . flip (++) "]"++ strField e n = field e n . between (strDel "start" n) (strDel "end" n) . many $ noneOf "\"\n\r"+ strDel t n = char '"' <?> strErr t n+ strErr t n = "the " ++ t ++ " of the string field " ++ n ++ " - a double quote (\")."++ wrapSkip x = many space >> x >>= \r -> many space >> return r+ sepEndSpc = mapM_ (wrapSkip . try . string)+ fieldEnd = many $ space <|> oneOf ",}"+ field e n c = (,) (e defaultConfig) $+ updateState (filter (/= n)) >> sepEndSpc [n,"="] >>+ wrapSkip c >>= \r -> fieldEnd >> return r++ read' d s = case reads s of+ [(x, _)] -> return x+ _ -> fail $ "error reading the " ++ d ++ " field: " ++ s++commandsErr :: String+commandsErr = "commands: this usually means that a command could not be parsed.\n" +++ "The error could be located at the begining of the command which follows the offending one."+
+ src/Plugins.hs view
@@ -0,0 +1,25 @@+-----------------------------------------------------------------------------+-- |+-- Module : Xmobar.Plugins+-- Copyright : (c) Andrea Rossato+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- This module exports the API for plugins.+--+-- Have a look at Plugins\/HelloWorld.hs+--+-----------------------------------------------------------------------------++module Plugins+ ( Exec (..)+ , tenthSeconds+ , readFileSafe+ , hGetLineSafe+ ) where++import Commands+import XUtil
+ src/Plugins/CommandReader.hs view
@@ -0,0 +1,39 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.CommandReader+-- Copyright : (c) John Goerzen+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- A plugin for reading from external commands+-- note: stderr is lost here+--+-----------------------------------------------------------------------------++module Plugins.CommandReader where++import System.IO+import Plugins+import System.Process(runInteractiveCommand, getProcessExitCode)++data CommandReader = CommandReader String String+ deriving (Read, Show)++instance Exec CommandReader where+ alias (CommandReader _ a) = a+ start (CommandReader p _) cb = do+ (hstdin, hstdout, hstderr, ph) <- runInteractiveCommand p+ hClose hstdin+ hClose hstderr+ hSetBinaryMode hstdout False+ hSetBuffering hstdout LineBuffering+ forever ph (hGetLineSafe hstdout >>= cb)+ where forever ph a =+ do a+ ec <- getProcessExitCode ph+ case ec of+ Nothing -> forever ph a+ Just _ -> cb "EXITED"
+ src/Plugins/Date.hs view
@@ -0,0 +1,37 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.Date+-- Copyright : (c) Andrea Rossato+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- A date plugin for Xmobar+--+-- Usage example: in template put+--+-- > Run Date "%a %b %_d %Y <fc=#ee9a00> %H:%M:%S</fc>" "Mydate" 10+--+-----------------------------------------------------------------------------++module Plugins.Date (Date(..)) where++import Plugins++import System.Locale+import System.Time++data Date = Date String String Int+ deriving (Read, Show)++instance Exec Date where+ alias (Date _ a _) = a+ run (Date f _ _) = date f+ rate (Date _ _ r) = r++date :: String -> IO String+date format = do+ t <- toCalendarTime =<< getClockTime+ return $ formatCalendarTime defaultTimeLocale format t
+ src/Plugins/EWMH.hs view
@@ -0,0 +1,264 @@+{-# OPTIONS_GHC -w #-}+{-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns, GeneralizedNewtypeDeriving #-}++-----------------------------------------------------------------------------+-- |+-- Module : Plugins.EWMH+-- Copyright : (c) Spencer Janssen+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Spencer Janssen <spencerjanssen@gmail.com>+-- Stability : unstable+-- Portability : unportable+--+-- An experimental plugin to display EWMH pager information+--+-----------------------------------------------------------------------------++module Plugins.EWMH (EWMH(..)) where++import Control.Monad.State+import Control.Monad.Reader+import Graphics.X11 hiding (Modifier, Color)+import Graphics.X11.Xlib.Extras+import Plugins+#ifdef UTF8+#undef UTF8+import Codec.Binary.UTF8.String as UTF8+#define UTF8+#endif+import Foreign.C (CChar, CLong)+import XUtil (nextEvent')++import Data.List (intersperse, intercalate)++import Data.Map (Map)+import qualified Data.Map as Map+import Data.Set (Set)+import qualified Data.Set as Set+++data EWMH = EWMH | EWMHFMT Component deriving (Read, Show)++instance Exec EWMH where+ alias EWMH = "EWMH"++ start ew cb = allocaXEvent $ \ep -> execM $ do+ d <- asks display+ r <- asks root++ liftIO xSetErrorHandler++ liftIO $ selectInput d r propertyChangeMask+ handlers' <- mapM (\(a, h) -> liftM2 (,) (getAtom a) (return h)) handlers+ mapM_ ((=<< asks root) . snd) handlers'++ forever $ do+ liftIO . cb . fmtOf ew =<< get+ liftIO $ nextEvent' d ep+ e <- liftIO $ getEvent ep+ case e of+ PropertyEvent { ev_atom = a, ev_window = w } -> do+ case lookup a handlers' of+ Just f -> f w+ _ -> return ()+ _ -> return ()++ return ()++defaultPP = Sep (Text " : ") [ Workspaces [Color "white" "black" :% Current, Hide :% Empty]+ , Layout+ , Color "#00ee00" "" :$ Short 120 :$ WindowName]++fmtOf EWMH = flip fmt defaultPP+fmtOf (EWMHFMT f) = flip fmt f++sep :: [a] -> [[a]] -> [a]+sep x xs = intercalate x $ filter (not . null) xs++fmt :: EwmhState -> Component -> String+fmt e (Text s) = s+fmt e (l :+ r) = fmt e l ++ fmt e r+fmt e (m :$ r) = modifier m $ fmt e r+fmt e (Sep c xs) = sep (fmt e c) $ map (fmt e) xs+fmt e WindowName = windowName $ Map.findWithDefault initialClient (activeWindow e) (clients e)+fmt e Layout = layout e+fmt e (Workspaces opts) = sep " "+ [foldr ($) n [modifier m | (m :% a) <- opts, a `elem` as]+ | (n, as) <- attrs]+ where+ stats i = [ (Current, i == currentDesktop e)+ , (Empty, Set.notMember i nonEmptys && i /= currentDesktop e)+ -- TODO for visible , (Visibl+ ]+ attrs :: [(String, [WsType])]+ attrs = [(n, [s | (s, b) <- stats i, b]) | (i, n) <- zip [0 ..] (desktopNames e)]+ nonEmptys = Set.unions . map desktops . Map.elems $ clients e++modifier :: Modifier -> (String -> String)+modifier Hide = const ""+modifier (Color fg bg) = \x -> concat ["<fc=", fg, if null bg then "" else "," ++ bg+ , ">", x, "</fc>"]+modifier (Short n) = take n+modifier (Wrap l r) = \x -> l ++ x ++ r++data Component = Text String+ | Component :+ Component+ | Modifier :$ Component+ | Sep Component [Component]+ | WindowName+ | Layout+ | Workspaces [WsOpt]+ deriving (Read, Show)++infixr 0 :$+infixr 5 :+++data Modifier = Hide+ | Color String String+ | Short Int+ | Wrap String String+ deriving (Read, Show)++data WsOpt = Modifier :% WsType+ | WSep Component+ deriving (Read, Show)+infixr 0 :%++data WsType = Current | Empty | Visible+ deriving (Read, Show, Eq)++data EwmhConf = C { root :: Window+ , display :: Display }++data EwmhState = S { currentDesktop :: CLong+ , activeWindow :: Window+ , desktopNames :: [String]+ , layout :: String+ , clients :: Map Window Client }+ deriving Show++data Client = Cl { windowName :: String+ , desktops :: Set CLong }+ deriving Show++getAtom :: String -> M Atom+getAtom s = do+ d <- asks display+ liftIO $ internAtom d s False++windowProperty32 :: String -> Window -> M (Maybe [CLong])+windowProperty32 s w = do+ (C {display}) <- ask+ a <- getAtom s+ liftIO $ getWindowProperty32 display a w++windowProperty8 :: String -> Window -> M (Maybe [CChar])+windowProperty8 s w = do+ (C {display}) <- ask+ a <- getAtom s+ liftIO $ getWindowProperty8 display a w++initialState :: EwmhState+initialState = S 0 0 [] [] Map.empty++initialClient :: Client+initialClient = Cl "" Set.empty++handlers, clientHandlers :: [(String, Updater)]+handlers = [ ("_NET_CURRENT_DESKTOP", updateCurrentDesktop)+ , ("_NET_DESKTOP_NAMES", updateDesktopNames )+ , ("_NET_ACTIVE_WINDOW", updateActiveWindow)+ , ("_NET_CLIENT_LIST", updateClientList)+ ] ++ clientHandlers++clientHandlers = [ ("_NET_WM_NAME", updateName)+ , ("_NET_WM_DESKTOP", updateDesktop) ]++newtype M a = M (ReaderT EwmhConf (StateT EwmhState IO) a)+ deriving (Monad, Functor, MonadIO, MonadReader EwmhConf, MonadState EwmhState)++execM :: M a -> IO a+execM (M m) = do+ d <- openDisplay ""+ r <- rootWindow d (defaultScreen d)+ let conf = C r d+ evalStateT (runReaderT m (C r d)) initialState++type Updater = Window -> M ()++updateCurrentDesktop, updateDesktopNames, updateActiveWindow :: Updater+updateCurrentDesktop _ = do+ (C {root}) <- ask+ mwp <- windowProperty32 "_NET_CURRENT_DESKTOP" root+ case mwp of+ Just [x] -> modify (\s -> s { currentDesktop = x })+ _ -> return ()++updateActiveWindow _ = do+ (C {root}) <- ask+ mwp <- windowProperty32 "_NET_ACTIVE_WINDOW" root+ case mwp of+ Just [x] -> modify (\s -> s { activeWindow = fromIntegral x })+ _ -> return ()++updateDesktopNames _ = do+ (C {root}) <- ask+ mwp <- windowProperty8 "_NET_DESKTOP_NAMES" root+ case mwp of+ Just xs -> modify (\s -> s { desktopNames = parse xs })+ _ -> return ()+ where+ dropNull ('\0':xs) = xs+ dropNull xs = xs++ split [] = []+ split xs = case span (/= '\0') xs of+ (x, ys) -> x : split (dropNull ys)+ parse = split . decodeCChar++updateClientList _ = do+ (C {root}) <- ask+ mwp <- windowProperty32 "_NET_CLIENT_LIST" root+ case mwp of+ Just xs -> do+ cl <- gets clients+ let cl' = Map.fromList $ map (flip (,) initialClient . fromIntegral) xs+ dels = Map.difference cl cl'+ new = Map.difference cl' cl+ modify (\s -> s { clients = Map.union (Map.intersection cl cl') cl'})+ mapM_ unmanage (map fst $ Map.toList dels)+ mapM_ listen (map fst $ Map.toList cl')+ mapM_ update (map fst $ Map.toList new)+ _ -> return ()+ where+ unmanage w = asks display >>= \d -> liftIO $ selectInput d w 0+ listen w = asks display >>= \d -> liftIO $ selectInput d w propertyChangeMask+ update w = mapM_ (($ w) . snd) clientHandlers++modifyClient :: Window -> (Client -> Client) -> M ()+modifyClient w f = modify (\s -> s { clients = Map.alter f' w $ clients s })+ where+ f' Nothing = Just $ f initialClient+ f' (Just x) = Just $ f x++updateName w = do+ mwp <- windowProperty8 "_NET_WM_NAME" w+ case mwp of+ Just xs -> modifyClient w (\c -> c { windowName = decodeCChar xs })+ _ -> return ()++updateDesktop w = do+ mwp <- windowProperty32 "_NET_WM_DESKTOP" w+ case mwp of+ Just x -> modifyClient w (\c -> c { desktops = Set.fromList x })+ _ -> return ()++decodeCChar :: [CChar] -> String+#ifdef UTF8+#undef UTF8+decodeCChar = UTF8.decode . map fromIntegral+#define UTF8+#else+decodeCChar = map (toEnum . fromIntegral)+#endif
+ src/Plugins/MBox.hs view
@@ -0,0 +1,111 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.MBox+-- Copyright : (c) Jose A Ortega Ruiz+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- A plugin for checking mail in mbox files.+--+-----------------------------------------------------------------------------++module Plugins.MBox (MBox(..)) where++import Prelude hiding (catch)+import Plugins+import Plugins.Utils (changeLoop, expandHome)++import Control.Monad (when)+import Control.Concurrent.STM+import Control.Exception (SomeException, handle, evaluate)++import System.Console.GetOpt+import System.Directory (doesFileExist)+import System.FilePath ((</>))+import System.INotify (Event(..), EventVariety(..), initINotify, addWatch)++import qualified Data.ByteString.Lazy.Char8 as B++data Options = Options+ { oAll :: Bool+ , oUniq :: Bool+ , oDir :: FilePath+ , oPrefix :: String+ , oSuffix :: String+ }++defaults :: Options+defaults = Options {+ oAll = False, oUniq = False, oDir = "", oPrefix = "", oSuffix = ""+ }++options :: [OptDescr (Options -> Options)]+options =+ [ Option "a" ["all"] (NoArg (\o -> o { oAll = True })) ""+ , Option "u" [] (NoArg (\o -> o { oUniq = True })) ""+ , Option "d" ["dir"] (ReqArg (\x o -> o { oDir = x }) "") ""+ , Option "p" ["prefix"] (ReqArg (\x o -> o { oPrefix = x }) "") ""+ , Option "s" ["suffix"] (ReqArg (\x o -> o { oSuffix = x }) "") ""+ ]++parseOptions :: [String] -> IO Options+parseOptions args =+ case getOpt Permute options args of+ (o, _, []) -> return $ foldr id defaults o+ (_, _, errs) -> ioError . userError $ concat errs++-- | A list of display names, paths to mbox files and display colours,+-- followed by a list of options.+data MBox = MBox [(String, FilePath, String)] [String] String+ deriving (Read, Show)++instance Exec MBox where+ alias (MBox _ _ a) = a+ start (MBox boxes args _) cb = do++ opts <- parseOptions args+ let showAll = oAll opts+ prefix = oPrefix opts+ suffix = oSuffix opts+ uniq = oUniq opts+ names = map (\(t, _, _) -> t) boxes+ colors = map (\(_, _, c) -> c) boxes+ extractPath (_, f, _) = expandHome $ oDir opts </> f+ events = [CloseWrite]++ i <- initINotify+ vs <- mapM (\b -> do+ f <- extractPath b+ exists <- doesFileExist f+ n <- if exists then countMails f else return (-1)+ v <- newTVarIO (f, n)+ when exists $+ addWatch i events f (handleNotification v) >> return ()+ return v)+ boxes++ changeLoop (mapM (fmap snd . readTVar) vs) $ \ns ->+ let s = unwords [ showC uniq m n c | (m, n, c) <- zip3 names ns colors+ , showAll || n > 0 ]+ in cb (if null s then "" else prefix ++ s ++ suffix)++showC :: Bool -> String -> Int -> String -> String+showC u m n c =+ if c == "" then msg else "<fc=" ++ c ++ ">" ++ msg ++ "</fc>"+ where msg = m ++ if not u || n > 1 then show n else ""++countMails :: FilePath -> IO Int+countMails f =+ handle ((\_ -> evaluate 0) :: SomeException -> IO Int)+ (do txt <- B.readFile f+ evaluate $! length . filter (B.isPrefixOf from) . B.lines $ txt)+ where from = B.pack "From "++handleNotification :: TVar (FilePath, Int) -> Event -> IO ()+handleNotification v _ = do+ (p, _) <- atomically $ readTVar v+ n <- countMails p+ atomically $ writeTVar v (p, n)
+ src/Plugins/Mail.hs view
@@ -0,0 +1,70 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.Mail+-- Copyright : (c) Spencer Janssen+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Spencer Janssen <sjanssen@cse.unl.edu>+-- Stability : unstable+-- Portability : unportable+--+-- A plugin for checking mail.+--+-----------------------------------------------------------------------------++module Plugins.Mail where++import Prelude hiding (catch)+import Plugins+import Plugins.Utils (expandHome, changeLoop)++import Control.Monad+import Control.Concurrent.STM++import System.Directory+import System.FilePath+import System.INotify++import Data.List (isPrefixOf)+import Data.Set (Set)+import qualified Data.Set as S++-- | A list of mail box names and paths to maildirs.+data Mail = Mail [(String, FilePath)]+ deriving (Read, Show)++instance Exec Mail where+ start (Mail ms) cb = do+ vs <- mapM (const $ newTVarIO S.empty) ms++ let ts = map fst ms+ rs = map ((</> "new") . snd) ms+ ev = [Move, MoveIn, MoveOut, Create, Delete]++ ds <- mapM expandHome rs+ i <- initINotify+ zipWithM_ (\d v -> addWatch i ev d (handle v)) ds vs++ forM_ (zip ds vs) $ \(d, v) -> do+ s <- fmap (S.fromList . filter (not . isPrefixOf "."))+ $ getDirectoryContents d+ atomically $ modifyTVar v (S.union s)++ changeLoop (mapM (fmap S.size . readTVar) vs) $ \ns ->+ cb . unwords $ [m ++ ":" ++ show n+ | (m, n) <- zip ts ns+ , n /= 0 ]++modifyTVar :: TVar a -> (a -> a) -> STM ()+modifyTVar v f = readTVar v >>= writeTVar v . f++handle :: TVar (Set String) -> Event -> IO ()+handle v e = atomically $ modifyTVar v $ case e of+ Created {} -> create+ MovedIn {} -> create+ Deleted {} -> delete+ MovedOut {} -> delete+ _ -> id+ where+ delete = S.delete (filePath e)+ create = S.insert (filePath e)
+ src/Plugins/Monitors.hs view
@@ -0,0 +1,119 @@+{-# LANGUAGE CPP #-}++-----------------------------------------------------------------------------+-- |+-- Module : Xmobar.Plugins.Monitors+-- Copyright : (c) Andrea Rossato+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- The system monitor plugin for Xmobar.+--+-----------------------------------------------------------------------------++module Plugins.Monitors where++import Plugins++import Plugins.Monitors.Common ( runM )+import Plugins.Monitors.Weather+import Plugins.Monitors.Net+import Plugins.Monitors.Mem+import Plugins.Monitors.Swap+import Plugins.Monitors.Cpu+import Plugins.Monitors.MultiCpu+import Plugins.Monitors.Batt+import Plugins.Monitors.Thermal+import Plugins.Monitors.CpuFreq+import Plugins.Monitors.CoreTemp+import Plugins.Monitors.Disk+import Plugins.Monitors.Top+import Plugins.Monitors.Uptime+#ifdef IWLIB+import Plugins.Monitors.Wireless+#endif+#ifdef LIBMPD+import Plugins.Monitors.MPD+#endif++data Monitors = Weather Station Args Rate+ | Network Interface Args Rate+ | Memory Args Rate+ | Swap Args Rate+ | Cpu Args Rate+ | MultiCpu Args Rate+ | Battery Args Rate+ | BatteryP [String] Args Rate+ | DiskU DiskSpec Args Rate+ | DiskIO DiskSpec Args Rate+ | Thermal Zone Args Rate+ | CpuFreq Args Rate+ | CoreTemp Args Rate+ | TopProc Args Rate+ | TopMem Args Rate+ | Uptime Args Rate+#ifdef IWLIB+ | Wireless Interface Args Rate+#endif+#ifdef LIBMPD+ | MPD Args Rate+#endif+ deriving (Show,Read,Eq)++type Args = [String]+type Program = String+type Alias = String+type Station = String+type Zone = String+type Interface = String+type Rate = Int+type DiskSpec = [(String, String)]++instance Exec Monitors where+ alias (Weather s _ _) = s+ alias (Network i _ _) = i+ alias (Thermal z _ _) = z+ alias (Memory _ _) = "memory"+ alias (Swap _ _) = "swap"+ alias (Cpu _ _) = "cpu"+ alias (MultiCpu _ _) = "multicpu"+ alias (Battery _ _) = "battery"+ alias (BatteryP _ _ _)= "battery"+ alias (CpuFreq _ _) = "cpufreq"+ alias (TopProc _ _) = "top"+ alias (TopMem _ _) = "topmem"+ alias (CoreTemp _ _) = "coretemp"+ alias (DiskU _ _ _) = "disku"+ alias (DiskIO _ _ _) = "diskio"+ alias (Uptime _ _) = "uptime"+#ifdef IWLIB+ alias (Wireless i _ _) = i ++ "wi"+#endif+#ifdef LIBMPD+ alias (MPD _ _) = "mpd"+#endif+ start (Weather s a r) = runM (a ++ [s]) weatherConfig runWeather r+ start (Network i a r) = runM (a ++ [i]) netConfig runNet r+ start (Thermal z a r) = runM (a ++ [z]) thermalConfig runThermal r+ start (Memory a r) = runM a memConfig runMem r+ start (Swap a r) = runM a swapConfig runSwap r+ start (Cpu a r) = runM a cpuConfig runCpu r+ start (MultiCpu a r) = runM a multiCpuConfig runMultiCpu r+ start (Battery a r) = runM a battConfig runBatt r+ start (BatteryP s a r) = runM a battConfig (runBatt' s) r+ start (CpuFreq a r) = runM a cpuFreqConfig runCpuFreq r+ start (CoreTemp a r) = runM a coreTempConfig runCoreTemp r+ start (DiskU s a r) = runM a diskUConfig (runDiskU s) r+ start (DiskIO s a r) = runM a diskIOConfig (runDiskIO s) r+ start (TopMem a r) = runM a topMemConfig runTopMem r+ start (Uptime a r) = runM a uptimeConfig runUptime r+ start (TopProc a r) = startTop a r+#ifdef IWLIB+ start (Wireless i a r) = runM (a ++ [i]) wirelessConfig runWireless r+#endif+#ifdef LIBMPD+ start (MPD a r) = runM a mpdConfig runMPD r+#endif
+ src/Plugins/Monitors/Batt.hs view
@@ -0,0 +1,165 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.Monitors.Batt+-- Copyright : (c) Andrea Rossato, 2010 Petr Rockai, 2010 Jose A Ortega+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- A battery monitor for Xmobar+--+-----------------------------------------------------------------------------++module Plugins.Monitors.Batt ( battConfig, runBatt, runBatt' ) where++import qualified Data.ByteString.Lazy.Char8 as B+import Plugins.Monitors.Common+import System.Posix.Files (fileExist)+import System.Console.GetOpt++data BattOpts = BattOpts+ { onString :: String+ , offString :: String+ , posColor :: Maybe String+ , lowWColor :: Maybe String+ , mediumWColor :: Maybe String+ , highWColor :: Maybe String+ , lowThreshold :: Float+ , highThreshold :: Float+ }++defaultOpts :: BattOpts+defaultOpts = BattOpts+ { onString = "On"+ , offString = "Off"+ , posColor = Nothing+ , lowWColor = Nothing+ , mediumWColor = Nothing+ , highWColor = Nothing+ , lowThreshold = -12+ , highThreshold = -10+ }++options :: [OptDescr (BattOpts -> BattOpts)]+options =+ [ Option "O" ["on"] (ReqArg (\x o -> o { onString = x }) "") ""+ , Option "o" ["off"] (ReqArg (\x o -> o { offString = x }) "") ""+ , Option "p" ["positive"] (ReqArg (\x o -> o { posColor = Just x }) "") ""+ , Option "l" ["low"] (ReqArg (\x o -> o { lowWColor = Just x }) "") ""+ , Option "m" ["medium"] (ReqArg (\x o -> o { mediumWColor = Just x }) "") ""+ , Option "h" ["high"] (ReqArg (\x o -> o { highWColor = Just x }) "") ""+ , Option "L" ["lowt"] (ReqArg (\x o -> o { lowThreshold = read x }) "") ""+ , Option "H" ["hight"] (ReqArg (\x o -> o { highThreshold = read x }) "") ""+ ]++parseOpts :: [String] -> IO BattOpts+parseOpts argv =+ case getOpt Permute options argv of+ (o, _, []) -> return $ foldr id defaultOpts o+ (_, _, errs) -> ioError . userError $ concat errs++data Result = Result Float Float Float String | NA++base :: String+base = "/sys/class/power_supply"++battConfig :: IO MConfig+battConfig = mkMConfig+ "Batt: <watts>, <left>% / <timeleft>" -- template+ ["leftbar", "left", "acstatus", "timeleft", "watts"] -- replacements++data Files = Files+ { f_full :: String+ , f_now :: String+ , f_voltage :: String+ , f_current :: String+ } | NoFiles++data Battery = Battery+ { full :: Float+ , now :: Float+ , voltage :: Float+ , current :: Float+ }++batteryFiles :: String -> IO Files+batteryFiles bat =+ do is_charge <- fileExist $ prefix ++ "/charge_now"+ is_energy <- fileExist $ prefix ++ "/energy_now"+ return $ case (is_charge, is_energy) of+ (True, _) -> files "/charge"+ (_, True) -> files "/energy"+ _ -> NoFiles+ where prefix = base ++ "/" ++ bat+ files ch = Files { f_full = prefix ++ ch ++ "_full"+ , f_now = prefix ++ ch ++ "_now"+ , f_current = prefix ++ "/current_now"+ , f_voltage = prefix ++ "/voltage_now" }++haveAc :: IO (Maybe Bool)+haveAc = do know <- fileExist $ base ++ "/AC/online"+ if know+ then do s <- B.unpack `fmap` catRead (base ++ "/AC/online")+ return $ Just $ s == "1\n"+ else return Nothing++readBattery :: Files -> IO Battery+readBattery NoFiles = return $ Battery 0 0 0 0+readBattery files =+ do a <- grab $ f_full files -- microwatthours+ b <- grab $ f_now files+ c <- grab $ f_voltage files -- microvolts+ d <- grab $ f_current files -- microwatts (huh!)+ return $ Battery (3600 * a / 1000000) -- wattseconds+ (3600 * b / 1000000) -- wattseconds+ (c / 1000000) -- volts+ (d / c) -- amperes+ where grab = fmap (read . B.unpack) . catRead++readBatteries :: BattOpts -> [Files] -> IO Result+readBatteries opts bfs =+ do bats <- mapM readBattery (take 3 bfs)+ ac' <- haveAc+ let ac = (ac' == Just True)+ sign = if ac then 1 else -1+ left = sum (map now bats) / sum (map full bats)+ watts = sign * sum (map voltage bats) * sum (map current bats)+ time = if watts == 0 then 0 else sum $ map time' bats -- negate sign+ time' b = (if ac then full b - now b else now b) / (sign * watts)+ acstr = case ac' of+ Nothing -> "?"+ Just True -> onString opts+ Just False -> offString opts+ return $ if isNaN left then NA else Result left watts time acstr++runBatt :: [String] -> Monitor String+runBatt = runBatt' ["BAT0","BAT1","BAT2"]++runBatt' :: [String] -> [String] -> Monitor String+runBatt' bfs args = do+ opts <- io $ parseOpts args+ c <- io $ readBatteries opts =<< mapM batteryFiles bfs+ case c of+ Result x w t s ->+ do l <- fmtPercent x+ parseTemplate (l ++ s:[fmtTime $ floor t, fmtWatts w opts])+ NA -> return "N/A"+ where fmtPercent :: Float -> Monitor [String]+ fmtPercent x = do+ p <- showPercentWithColors x+ b <- showPercentBar (100 * x) x+ return [b, p]+ fmtWatts x o = color x o $ showDigits 1 x ++ "W"+ fmtTime :: Integer -> String+ fmtTime x = hours ++ ":" ++ if length minutes == 2+ then minutes else '0' : minutes+ where hours = show (x `div` 3600)+ minutes = show ((x `mod` 3600) `div` 60)+ maybeColor Nothing _ = ""+ maybeColor (Just c) str = "<fc=" ++ c ++ ">" ++ str ++ "</fc>"+ color x o | x >= 0 = maybeColor (posColor o)+ | x >= highThreshold o = maybeColor (highWColor o)+ | x >= lowThreshold o = maybeColor (mediumWColor o)+ | otherwise = maybeColor (lowWColor o)
+ src/Plugins/Monitors/Common.hs view
@@ -0,0 +1,446 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.Monitors.Common+-- Copyright : (c) Andrea Rossato+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- Utilities for creating monitors for Xmobar+--+-----------------------------------------------------------------------------++module Plugins.Monitors.Common (+ -- * Monitors+ -- $monitor+ Monitor+ , MConfig (..)+ , Opts (..)+ , setConfigValue+ , getConfigValue+ , mkMConfig+ , runM+ , io+ -- * Parsers+ -- $parsers+ , runP+ , skipRestOfLine+ , getNumbers+ , getNumbersAsString+ , getAllBut+ , getAfterString+ , skipTillString+ , parseTemplate+ -- ** String Manipulation+ -- $strings+ , padString+ , showWithPadding+ , showWithColors+ , showWithColors'+ , showPercentWithColors+ , showPercentsWithColors+ , showPercentBar+ , showLogBar+ , showWithUnits+ , takeDigits+ , showDigits+ , floatToPercent+ , parseFloat+ , parseInt+ , stringParser+ -- * Threaded Actions+ -- $thread+ , doActionTwiceWithDelay+ , catRead+ ) where+++import Control.Concurrent+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 Numeric+import Text.ParserCombinators.Parsec+import System.Console.GetOpt+import Control.Exception (SomeException,handle)+import System.Process (readProcess)++import Plugins+-- $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+ , minWidth :: IORef Int+ , maxWidth :: IORef Int+ , padChars :: IORef String+ , padRight :: IORef Bool+ , barBack :: IORef String+ , barFore :: IORef String+ , barWidth :: IORef Int+ , useSuffix :: IORef Bool+ }++-- | 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 (\_ -> 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+ mn <- newIORef 0+ mx <- newIORef 0+ pc <- newIORef " "+ pr <- newIORef False+ bb <- newIORef ":"+ bf <- newIORef "#"+ bw <- newIORef 10+ up <- newIORef False+ return $ MC nc l lc h hc t e p mn mx pc pr bb bf bw up++data Opts = HighColor String+ | NormalColor String+ | LowColor String+ | Low String+ | High String+ | Template String+ | PercentPad String+ | MinWidth String+ | MaxWidth String+ | Width String+ | PadChars String+ | PadAlign String+ | BarBack String+ | BarFore String+ | BarWidth String+ | UseSuffix 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 "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 "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"+ ]++doArgs :: [String]+ -> ([String] -> Monitor String)+ -> Monitor String+doArgs args action =+ case getOpt Permute options args of+ (o, n, []) -> do doConfigOptions o+ action n+ (_, _, 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+ MinWidth w -> setConfigValue (nz w) minWidth+ MaxWidth w -> setConfigValue (nz w) maxWidth+ Width w -> setConfigValue (nz w) minWidth >>+ setConfigValue (nz w) maxWidth+ 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) >> next++runM :: [String] -> IO MConfig -> ([String] -> Monitor String) -> Int+ -> (String -> IO ()) -> IO ()+runM args conf action r cb = handle (cb . showException) loop+ where ac = doArgs args action+ loop = conf >>= runReaderT ac >>= cb >> tenthSeconds r >> 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 = liftM concat . many $+ many1 (noneOf "<") <|> colorSpec++-- | 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 ++ ">")++-- | 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 --"%")++-- | 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.+parseTemplate :: [String] -> Monitor String+parseTemplate l =+ do t <- getConfigValue template+ s <- io $ runP templateParser t+ e <- getConfigValue export+ let m = Map.fromList . zip e $ l+ return $ combine m s++-- | Given a finite "Map" and a parsed templatet produces the+-- | resulting output string.+combine :: Map.Map String String -> [(String, String, String)] -> String+combine _ [] = []+combine m ((s,ts,ss):xs) =+ s ++ str ++ ss ++ combine m xs+ where str = Map.findWithDefault err ts m+ err = "<" ++ ts ++ " not found!>"++-- $strings++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+padString mnw mxw pad pr 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+ 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+ return $ padString mn mx p pr 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 = liftM 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)++showLogBar :: Float -> Float -> Monitor String+showLogBar f v = do+ h <- fromIntegral `fmap` getConfigValue high+ l <- fromIntegral `fmap` getConfigValue low+ bw <- fromIntegral `fmap` getConfigValue barWidth+ let [ll, hh] = sort [l, h]+ choose x | x == 0.0 = 0+ | x <= ll = 1 / bw+ | otherwise = f + logBase 2 (x / hh) / bw+ showPercentBar v $ choose v++-- $threads++doActionTwiceWithDelay :: Int -> IO [a] -> IO ([a], [a])+doActionTwiceWithDelay delay action =+ do v1 <- newMVar []+ forkIO $! getData action v1 0+ v2 <- newMVar []+ forkIO $! getData action v2 delay+ threadDelay (delay `div` 3 * 4)+ a <- readMVar v1+ b <- readMVar v2+ return (a,b)++getData :: IO a -> MVar a -> Int -> IO ()+getData action var d =+ do threadDelay d+ s <- action+ modifyMVar_ var (\_ -> return $! s)++catRead :: FilePath -> IO B.ByteString+catRead file = B.pack `fmap` readProcess "/bin/cat" [file] ""
+ src/Plugins/Monitors/CoreCommon.hs view
@@ -0,0 +1,59 @@+-----------------------------------------------------------------------------+-- |+-- 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 Plugins.Monitors.CoreCommon where++import Plugins.Monitors.Common+import System.Posix.Files (fileExist)+import System.IO (withFile, IOMode(ReadMode), hGetLine)+import System.Directory+import Data.Char (isDigit)+import Data.List (isPrefixOf)++-- |+-- Function checks the existence of first file specified by pattern and if the+-- file doesn't exists failure message is shown, otherwise the data retrieval+-- is performed.+checkedDataRetrieval :: (Num a, Ord a, Show a) =>+ String -> String -> String -> String -> (Double -> a)+ -> (a -> String) -> Monitor String+checkedDataRetrieval failureMessage dir file pattern trans fmt = do+ exists <- io $ fileExist $ concat [dir, "/", pattern, "0/", file]+ case exists of+ False -> return failureMessage+ True -> retrieveData dir file pattern trans fmt++-- |+-- Function retrieves data from files in directory dir specified by+-- pattern. String values are converted to double and 'trans' applied+-- to each one. Final array is processed by template parser function+-- and returned as monitor string.+retrieveData :: (Num a, Ord a, Show a) =>+ String -> String -> String -> (Double -> a) -> (a -> String) ->+ Monitor String+retrieveData dir file pattern trans fmt = do+ count <- io $ dirCount dir pattern+ contents <- io $ mapM getGuts $ files count+ values <- mapM (showWithColors fmt) $ map conversion contents+ parseTemplate values+ where+ getGuts f = withFile f ReadMode hGetLine+ dirCount path str = getDirectoryContents path+ >>= return . length+ . filter (\s -> str `isPrefixOf` s+ && isDigit (last s))+ files count = map (\i -> concat [dir, "/", pattern, show i, "/", file])+ [0 .. count - 1]+ conversion = trans . (read :: String -> Double)+
+ src/Plugins/Monitors/CoreTemp.hs view
@@ -0,0 +1,41 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.Monitors.CoreTemp+-- Copyright : (c) Juraj Hercek+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Juraj Hercek <juhe_haskell@hck.sk>+-- Stability : unstable+-- Portability : unportable+--+-- A core temperature monitor for Xmobar+--+-----------------------------------------------------------------------------++module Plugins.Monitors.CoreTemp where++import Plugins.Monitors.Common+import Plugins.Monitors.CoreCommon++-- |+-- Core temperature default configuration. Default template contains only one+-- core temperature, user should specify custom template in order to get more+-- core frequencies.+coreTempConfig :: IO MConfig+coreTempConfig = mkMConfig+ "Temp: <core0>C" -- template+ (zipWith (++) (repeat "core") (map show [0 :: Int ..])) -- available+ -- replacements++-- |+-- Function retrieves monitor string holding the core temperature+-- (or temperatures)+runCoreTemp :: [String] -> Monitor String+runCoreTemp _ = do+ let dir = "/sys/bus/platform/devices"+ file = "temp1_input"+ pattern = "coretemp."+ divisor = 1e3 :: Double+ failureMessage = "CoreTemp: N/A"+ checkedDataRetrieval failureMessage dir file pattern (/divisor) show+
+ src/Plugins/Monitors/Cpu.hs view
@@ -0,0 +1,53 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.Monitors.Cpu+-- Copyright : (c) Andrea Rossato+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- A cpu monitor for Xmobar+--+-----------------------------------------------------------------------------++module Plugins.Monitors.Cpu where++import Plugins.Monitors.Common+import qualified Data.ByteString.Lazy.Char8 as B++cpuConfig :: IO MConfig+cpuConfig = mkMConfig+ "Cpu: <total>%"+ ["bar","total","user","nice","system","idle"]++cpuData :: IO [Float]+cpuData = do s <- B.readFile "/proc/stat"+ return $ cpuParser s++cpuParser :: B.ByteString -> [Float]+cpuParser =+ map (read . B.unpack) . tail . B.words . head . B.lines++parseCPU :: IO [Float]+parseCPU =+ do (a,b) <- doActionTwiceWithDelay 750000 cpuData+ let dif = zipWith (-) b a+ tot = foldr (+) 0 dif+ percent = map (/ tot) dif+ return percent++formatCpu :: [Float] -> Monitor [String]+formatCpu [] = return $ replicate 6 ""+formatCpu xs = do+ let t = foldr (+) 0 $ take 3 xs+ b <- showPercentBar (100 * t) t+ ps <- showPercentsWithColors (t:xs)+ return (b:ps)++runCpu :: [String] -> Monitor String+runCpu _ =+ do c <- io parseCPU+ l <- formatCpu c+ parseTemplate l
+ src/Plugins/Monitors/CpuFreq.hs view
@@ -0,0 +1,43 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.Monitors.CpuFreq+-- Copyright : (c) Juraj Hercek+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Juraj Hercek <juhe_haskell@hck.sk>+-- Stability : unstable+-- Portability : unportable+--+-- A cpu frequency monitor for Xmobar+--+-----------------------------------------------------------------------------++module Plugins.Monitors.CpuFreq where++import Plugins.Monitors.Common+import Plugins.Monitors.CoreCommon++-- |+-- Cpu frequency default configuration. Default template contains only one+-- core frequency, user should specify custom template in order to get more+-- cpu frequencies.+cpuFreqConfig :: IO MConfig+cpuFreqConfig = mkMConfig+ "Freq: <cpu0>" -- template+ (zipWith (++) (repeat "cpu") (map show [0 :: Int ..])) -- available+ -- replacements++-- |+-- Function retrieves monitor string holding the cpu frequency (or+-- frequencies)+runCpuFreq :: [String] -> Monitor String+runCpuFreq _ = do+ let dir = "/sys/devices/system/cpu"+ file = "cpufreq/scaling_cur_freq"+ pattern = "cpu"+ divisor = 1e6 :: Double+ failureMessage = "CpuFreq: N/A"+ fmt x | x < 1 = show (round (x * 1000) :: Integer) ++ "MHz"+ | otherwise = showDigits 1 x ++ "GHz"+ checkedDataRetrieval failureMessage dir file pattern (/divisor) fmt+
+ src/Plugins/Monitors/Disk.hs view
@@ -0,0 +1,137 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.Monitors.Disk+-- Copyright : (c) Jose A Ortega Ruiz+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- Disk usage and throughput monitors for Xmobar+--+-----------------------------------------------------------------------------++module Plugins.Monitors.Disk ( diskUConfig, runDiskU+ , diskIOConfig, runDiskIO+ ) where++import Plugins.Monitors.Common+import StatFS++import Control.Monad (zipWithM)+import qualified Data.ByteString.Lazy.Char8 as B+import Data.List (isPrefixOf, find, intercalate)++diskIOConfig :: IO MConfig+diskIOConfig = mkMConfig "" ["total", "read", "write",+ "totalbar", "readbar", "writebar"]++diskUConfig :: IO MConfig+diskUConfig = mkMConfig ""+ ["size", "free", "used", "freep", "usedp", "freebar", "usedbar"]++type DevName = String+type Path = String++mountedDevices :: [String] -> IO [(DevName, Path)]+mountedDevices req = do+ s <- B.readFile "/etc/mtab"+ return (parse s)+ where+ parse = map undev . filter isDev . map (firstTwo . B.words) . B.lines+ firstTwo (a:b:_) = (B.unpack a, B.unpack b)+ firstTwo _ = ("", "")+ isDev (d, p) = "/dev/" `isPrefixOf` d &&+ (p `elem` req || drop 5 d `elem` req)+ undev (d, f) = (drop 5 d, f)++diskData :: IO [(DevName, [Float])]+diskData = do+ s <- B.readFile "/proc/diskstats"+ let extract ws = (head ws, map read (tail ws))+ return $ map (extract . map B.unpack . drop 2 . B.words) (B.lines s)++mountedData :: [DevName] -> IO [(DevName, [Float])]+mountedData devs = do+ (dt, dt') <- doActionTwiceWithDelay 750000 diskData+ return $ map (parseDev (zipWith diff dt' dt)) devs+ where diff (dev, xs) (_, ys) = (dev, zipWith (-) xs ys)++parseDev :: [(DevName, [Float])] -> DevName -> (DevName, [Float])+parseDev dat dev =+ case find ((==dev) . fst) dat of+ Nothing -> (dev, [0, 0, 0])+ Just (_, xs) ->+ let rSp = speed (xs !! 2) (xs !! 3)+ wSp = speed (xs !! 6) (xs !! 7)+ sp = speed (xs !! 2 + xs !! 6) (xs !! 3 + xs !! 7)+ speed x t = if t == 0 then 0 else 500 * x / t+ dat' = if length xs > 6 then [sp, rSp, wSp] else [0, 0, 0]+ in (dev, dat')++fsStats :: String -> IO [Integer]+fsStats path = do+ stats <- getFileSystemStats path+ case stats of+ Nothing -> return [-1, -1, -1]+ Just f -> let tot = fsStatByteCount f+ free = fsStatBytesAvailable f+ used = fsStatBytesUsed f+ in return [tot, free, used]++speedToStr :: Float -> String+speedToStr = showWithUnits 2 1++sizeToStr :: Integer -> String+sizeToStr = showWithUnits 3 0 . fromIntegral++findTempl :: DevName -> Path -> [(String, String)] -> String+findTempl dev path disks =+ case find devOrPath disks of+ Just (_, t) -> t+ Nothing -> ""+ where devOrPath (d, _) = d == dev || d == path++devTemplates :: [(String, String)]+ -> [(DevName, Path)]+ -> [(DevName, [Float])]+ -> [(String, [Float])]+devTemplates disks mounted dat =+ map (\(d, p) -> (findTempl d p disks, findData d)) mounted+ where findData dev = case find ((==dev) . fst) dat of+ Nothing -> [0, 0, 0]+ Just (_, xs) -> xs++runDiskIO' :: (String, [Float]) -> Monitor String+runDiskIO' (tmp, xs) = do+ s <- mapM (showWithColors speedToStr) xs+ b <- mapM (showLogBar 0.8) xs+ setConfigValue tmp template+ parseTemplate $ s ++ b++runDiskIO :: [(String, String)] -> [String] -> Monitor String+runDiskIO disks _ = do+ mounted <- io $ mountedDevices (map fst disks)+ dat <- io $ mountedData (map fst mounted)+ strs <- mapM runDiskIO' $ devTemplates disks mounted dat+ return $ intercalate " " strs++runDiskU' :: String -> String -> Monitor String+runDiskU' tmp path = do+ setConfigValue tmp template+ fstats <- io $ fsStats path+ let strs = map sizeToStr fstats+ freep = (fstats !! 1) * 100 `div` head fstats+ fr = fromIntegral freep / 100+ s <- zipWithM showWithColors' strs [100, freep, 100 - freep]+ sp <- showPercentsWithColors [fr, 1 - fr]+ fb <- showPercentBar (fromIntegral freep) fr+ ub <- showPercentBar (fromIntegral $ 100 - freep) (1 - fr)+ parseTemplate $ s ++ sp ++ [fb, ub]++runDiskU :: [(String, String)] -> [String] -> Monitor String+runDiskU disks _ = do+ devs <- io $ mountedDevices (map fst disks)+ strs <- mapM (\(d, p) -> runDiskU' (findTempl d p disks) p) devs+ return $ intercalate " " strs
+ src/Plugins/Monitors/MPD.hs view
@@ -0,0 +1,115 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.Monitors.MPD+-- Copyright : (c) Jose A Ortega Ruiz+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- MPD status and song+--+-----------------------------------------------------------------------------++module Plugins.Monitors.MPD ( mpdConfig, runMPD ) where++import Plugins.Monitors.Common+import System.Console.GetOpt+import qualified Network.MPD as M++mpdConfig :: IO MConfig+mpdConfig = mkMConfig "MPD: <state>"+ [ "bar", "state", "statei", "volume", "length"+ , "lapsed", "remaining", "plength", "ppos", "file"+ , "name", "artist", "composer", "performer"+ , "album", "title", "track", "genre"+ ]++data MOpts = MOpts+ { mPlaying :: String+ , mStopped :: String+ , mPaused :: String+ , mHost :: String+ , mPort :: Integer+ , mPassword :: String+ }++defaultOpts :: MOpts+defaultOpts = MOpts+ { mPlaying = ">>"+ , mStopped = "><"+ , mPaused = "||"+ , mHost = "127.0.0.1"+ , mPort = 6600+ , mPassword = ""+ }++options :: [OptDescr (MOpts -> MOpts)]+options =+ [ Option "P" ["playing"] (ReqArg (\x o -> o { mPlaying = x }) "") ""+ , Option "S" ["stopped"] (ReqArg (\x o -> o { mStopped = x }) "") ""+ , Option "Z" ["paused"] (ReqArg (\x o -> o { mPaused = x }) "") ""+ , Option "h" ["host"] (ReqArg (\x o -> o { mHost = x }) "") ""+ , Option "p" ["port"] (ReqArg (\x o -> o { mPort = read x }) "") ""+ , Option "x" ["password"] (ReqArg (\x o -> o { mPassword = x }) "") ""+ ]++runMPD :: [String] -> Monitor String+runMPD args = do+ opts <- io $ mopts args+ let mpd = M.withMPDEx (mHost opts) (mPort opts) (mPassword opts)+ status <- io $ mpd M.status+ song <- io $ mpd M.currentSong+ s <- parseMPD status song opts+ parseTemplate s++mopts :: [String] -> IO MOpts+mopts argv =+ case getOpt Permute options argv of+ (o, _, []) -> return $ foldr id defaultOpts o+ (_, _, errs) -> ioError . userError $ concat errs++parseMPD :: M.Response M.Status -> M.Response (Maybe M.Song) -> MOpts+ -> Monitor [String]+parseMPD (Left e) _ _ = return $ show e:repeat ""+parseMPD (Right st) song opts = do+ songData <- parseSong song+ bar <- showPercentBar (100 * b) b+ return $ [bar, ss, si, vol, len, lap, remain, plen, ppos] ++ songData+ where s = M.stState st+ ss = show s+ si = stateGlyph s opts+ vol = int2str $ M.stVolume st+ (p, t) = M.stTime st+ [lap, len, remain] = map showTime [floor p, t, max 0 (t - floor p)]+ b = if t > 0 then realToFrac $ p / fromIntegral t else 0+ plen = int2str $ M.stPlaylistLength st+ ppos = maybe "" (int2str . (+1)) $ M.stSongPos st++stateGlyph :: M.State -> MOpts -> String+stateGlyph s o =+ case s of+ M.Playing -> mPlaying o+ M.Paused -> mPaused o+ M.Stopped -> mStopped o++parseSong :: M.Response (Maybe M.Song) -> Monitor [String]+parseSong (Left _) = return $ repeat ""+parseSong (Right Nothing) = return $ repeat ""+parseSong (Right (Just s)) =+ let join [] = ""+ join (x:xs) = foldl (\a o -> a ++ ", " ++ o) x xs+ str sel = maybe "" join (M.sgGet sel s)+ sels = [ M.Name, M.Artist, M.Composer, M.Performer+ , M.Album, M.Title, M.Track, M.Genre ]+ fields = M.sgFilePath s : map str sels+ in mapM showWithPadding fields++showTime :: Integer -> String+showTime t = int2str minutes ++ ":" ++ int2str seconds+ where minutes = t `div` 60+ seconds = t `mod` 60++int2str :: (Num a, Ord a) => a -> String+int2str x = if x < 10 then '0':sx else sx where sx = show x
+ src/Plugins/Monitors/Mem.hs view
@@ -0,0 +1,59 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.Monitors.Mem+-- Copyright : (c) Andrea Rossato+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- A memory monitor for Xmobar+--+-----------------------------------------------------------------------------++module Plugins.Monitors.Mem (memConfig, runMem, totalMem, usedMem) where++import Plugins.Monitors.Common++memConfig :: IO MConfig+memConfig = mkMConfig+ "Mem: <usedratio>% (<cache>M)" -- template+ ["usedbar", "freebar", "usedratio", "total",+ "free", "buffer", "cache", "rest", "used"] -- available replacements++fileMEM :: IO String+fileMEM = readFile "/proc/meminfo"++parseMEM :: IO [Float]+parseMEM =+ do file <- fileMEM+ let content = map words $ take 4 $ lines file+ [total, free, buffer, cache] = map (\line -> (read $ line !! 1 :: Float) / 1024) content+ rest = free + buffer + cache+ used = total - rest+ usedratio = used / total+ return [usedratio, total, free, buffer, cache, rest, used]++totalMem :: IO Float+totalMem = fmap ((*1024) . (!!1)) parseMEM++usedMem :: IO Float+usedMem = fmap ((*1024) . (!!6)) parseMEM++formatMem :: [Float] -> Monitor [String]+formatMem (r:xs) =+ do let f = showDigits 0+ rr = 100 * r+ ub <- showPercentBar rr r+ fb <- showPercentBar (100 - rr) (1 - r)+ rs <- showPercentWithColors r+ s <- mapM (showWithColors f) xs+ return (ub:fb:rs:s)+formatMem _ = return $ replicate 9 "N/A"++runMem :: [String] -> Monitor String+runMem _ =+ do m <- io parseMEM+ l <- formatMem m+ parseTemplate l
+ src/Plugins/Monitors/MultiCpu.hs view
@@ -0,0 +1,76 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.Monitors.MultiCpu+-- Copyright : (c) Jose A Ortega Ruiz+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A Ortega <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- A multi-cpu monitor for Xmobar+--+-----------------------------------------------------------------------------++module Plugins.Monitors.MultiCpu(multiCpuConfig, runMultiCpu) where++import Plugins.Monitors.Common+import qualified Data.ByteString.Lazy.Char8 as B+import Data.List (isPrefixOf, transpose, unfoldr)++multiCpuConfig :: IO MConfig+multiCpuConfig =+ mkMConfig "Cpu: <total>%" $+ ["auto" ++ k | k <- monitors] +++ [ k ++ n | n <- "" : map show [0 :: Int ..]+ , k <- monitors]+ where monitors = ["bar","total","user","nice","system","idle"]+++cpuData :: IO [[Float]]+cpuData = parse `fmap` B.readFile "/proc/stat"+ where parse = map parseList . cpuLists+ cpuLists = takeWhile isCpu . map B.words . B.lines+ isCpu (w:_) = "cpu" `isPrefixOf` B.unpack w+ isCpu _ = False+ parseList = map (parseFloat . B.unpack) . tail++parseCpuData :: IO [[Float]]+parseCpuData =+ do (as, bs) <- doActionTwiceWithDelay 950000 cpuData+ let p0 = zipWith percent bs as+ return p0++percent :: [Float] -> [Float] -> [Float]+percent b a = if tot > 0 then map (/ tot) $ take 4 dif else [0, 0, 0, 0]+ where dif = zipWith (-) b a+ tot = foldr (+) 0 dif++formatMultiCpus :: [[Float]] -> Monitor [String]+formatMultiCpus [] = return []+formatMultiCpus xs = fmap concat $ mapM formatCpu xs++formatCpu :: [Float] -> Monitor [String]+formatCpu xs+ | length xs < 4 = showPercentsWithColors $ replicate 6 0.0+ | otherwise = let t = foldr (+) 0 $ take 3 xs+ in do b <- showPercentBar (100 * t) t+ ps <- showPercentsWithColors (t:xs)+ return (b:ps)++splitEvery :: (Eq a) => Int -> [a] -> [[a]]+splitEvery n = unfoldr (\x -> if null x then Nothing else Just $ splitAt n x)++groupData :: [String] -> [[String]]+groupData = transpose . tail . splitEvery 6++formatAutoCpus :: [String] -> Monitor [String]+formatAutoCpus [] = return $ replicate 6 ""+formatAutoCpus xs = return $ map unwords (groupData xs)++runMultiCpu :: [String] -> Monitor String+runMultiCpu _ =+ do c <- io parseCpuData+ l <- formatMultiCpus c+ a <- formatAutoCpus l+ parseTemplate $ a ++ l
+ src/Plugins/Monitors/Net.hs view
@@ -0,0 +1,96 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.Monitors.Net+-- Copyright : (c) Andrea Rossato+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- A net device monitor for Xmobar+--+-----------------------------------------------------------------------------++module Plugins.Monitors.Net (netConfig, runNet) where++import Plugins.Monitors.Common+import qualified Data.ByteString.Lazy.Char8 as B++data NetDev = NA+ | ND { netDev :: String+ , netRx :: Float+ , netTx :: Float+ } deriving (Eq,Show,Read)++interval :: Int+interval = 500000++netConfig :: IO MConfig+netConfig = mkMConfig+ "<dev>: <rx>KB|<tx>KB" -- template+ ["dev", "rx", "tx", "rxbar", "txbar"] -- available replacements++-- Given a list of indexes, take the indexed elements from a list.+getNElements :: [Int] -> [a] -> [a]+getNElements ns as = map (as!!) ns++-- Split into words, with word boundaries indicated by the given predicate.+-- Drops delimiters. Duplicates 'Data.List.Split.wordsBy'.+--+-- > map (wordsBy (`elem` " :")) ["lo:31174097 31174097", "eth0: 43598 88888"]+--+-- will become @[["lo","31174097","31174097"], ["eth0","43598","88888"]]@+wordsBy :: (a -> Bool) -> [a] -> [[a]]+wordsBy f s = case dropWhile f s of+ [] -> []+ s' -> w : wordsBy f s'' where (w, s'') = break f s'++readNetDev :: [String] -> NetDev+readNetDev [] = NA+readNetDev xs =+ ND (xs !! 0) (r (xs !! 1)) (r (xs !! 2))+ where r s | s == "" = 0+ | otherwise = read s / 1024++fileNET :: IO [NetDev]+fileNET =+ do f <- B.readFile "/proc/net/dev"+ return $ netParser f++netParser :: B.ByteString -> [NetDev]+netParser =+ map (readNetDev . getNElements [0,1,9] . wordsBy (`elem` " :") . B.unpack) . drop 2 . B.lines++formatNet :: Float -> Monitor (String, String)+formatNet d = do+ s <- getConfigValue useSuffix+ let str = if s then (++"Kb/s") . showDigits 1 else showDigits 1+ b <- showLogBar 0.9 d+ x <- showWithColors str d+ return (x, b)++printNet :: NetDev -> Monitor String+printNet nd =+ case nd of+ ND d r t -> do (rx, rb) <- formatNet r+ (tx, tb) <- formatNet t+ parseTemplate [d,rx,tx,rb,tb]+ NA -> return "N/A"++parseNET :: String -> IO [NetDev]+parseNET nd =+ do (a,b) <- doActionTwiceWithDelay interval fileNET+ let netRate f da db = takeDigits 2 $ (f db - f da) * fromIntegral (1000000 `div` interval)+ diffRate (da,db) = ND (netDev da)+ (netRate netRx da db)+ (netRate netTx da db)+ return $ filter (\d -> netDev d == nd) $ map diffRate $ zip a b++runNet :: [String] -> Monitor String+runNet nd =+ do pn <- io $ parseNET $ head nd+ n <- case pn of+ [x] -> return x+ _ -> return NA+ printNet n
+ src/Plugins/Monitors/Swap.hs view
@@ -0,0 +1,55 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.Monitors.Swap+-- Copyright : (c) Andrea Rossato+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- A swap usage monitor for Xmobar+--+-----------------------------------------------------------------------------++module Plugins.Monitors.Swap where++import Plugins.Monitors.Common++import qualified Data.ByteString.Lazy.Char8 as B++swapConfig :: IO MConfig+swapConfig = mkMConfig+ "Swap: <usedratio>%" -- template+ ["usedratio", "total", "used", "free"] -- available replacements++fileMEM :: IO B.ByteString+fileMEM = B.readFile "/proc/meminfo"++parseMEM :: IO [Float]+parseMEM =+ do file <- fileMEM+ let li i l+ | l /= [] = head l !! i+ | otherwise = B.empty+ fs s l+ | l == [] = False+ | otherwise = head l == B.pack s+ get_data s = flip (/) 1024 . read . B.unpack . li 1 . filter (fs s)+ st = map B.words . B.lines $ file+ tot = get_data "SwapTotal:" st+ free = get_data "SwapFree:" st+ return [(tot - free) / tot, tot, tot - free, free]++formatSwap :: [Float] -> Monitor [String]+formatSwap (r:xs) =+ do other <- mapM (showWithColors (showDigits 2)) xs+ ratio <- showPercentWithColors r+ return $ ratio:other+formatSwap _ = return $ replicate 4 "N/A"++runSwap :: [String] -> Monitor String+runSwap _ =+ do m <- io parseMEM+ l <- formatSwap m+ parseTemplate l
+ src/Plugins/Monitors/Thermal.hs view
@@ -0,0 +1,42 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.Monitors.Thermal+-- Copyright : (c) Juraj Hercek+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Juraj Hercek <juhe_haskell@hck.sk>+-- Stability : unstable+-- Portability : unportable+--+-- A thermal monitor for Xmobar+--+-----------------------------------------------------------------------------++module Plugins.Monitors.Thermal where++import qualified Data.ByteString.Lazy.Char8 as B+import Plugins.Monitors.Common+import System.Posix.Files (fileExist)++-- | Default thermal configuration.+thermalConfig :: IO MConfig+thermalConfig = mkMConfig+ "Thm: <temp>C" -- template+ ["temp"] -- available replacements++-- | Retrieves thermal information. Argument is name of thermal directory in+-- \/proc\/acpi\/thermal_zone. Returns the monitor string parsed according to+-- template (either default or user specified).+runThermal :: [String] -> Monitor String+runThermal args = do+ let zone = head args+ file = "/proc/acpi/thermal_zone/" ++ zone ++ "/temperature"+ exists <- io $ fileExist file+ case exists of+ False -> return $ "Thermal (" ++ zone ++ "): N/A"+ True -> do number <- io $ B.readFile file+ >>= return . (read :: String -> Int)+ . stringParser (1, 0)+ thermal <- showWithColors show number+ parseTemplate [ thermal ]+
+ src/Plugins/Monitors/Top.hs view
@@ -0,0 +1,179 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.Monitors.Top+-- Copyright : (c) Jose A Ortega Ruiz+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- Process activity and memory consumption monitors+--+-----------------------------------------------------------------------------++{-# LANGUAGE ForeignFunctionInterface #-}++module Plugins.Monitors.Top (startTop, topMemConfig, runTopMem) where++import Plugins.Monitors.Common++import Control.Exception (SomeException, handle)+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Data.List (sortBy, foldl')+import Data.Ord (comparing)+import Data.Time.Clock (UTCTime, getCurrentTime, diffUTCTime)+import System.Directory (getDirectoryContents)+import System.FilePath ((</>))+import System.IO (IOMode(ReadMode), hGetLine, withFile)+import System.Posix.Unistd (SysVar(ClockTick), getSysVar)++import Foreign.C.Types++maxEntries :: Int+maxEntries = 10++intStrs :: [String]+intStrs = map show [1..maxEntries]++topMemConfig :: IO MConfig+topMemConfig = mkMConfig "<both1>"+ [ k ++ n | n <- intStrs , k <- ["name", "mem", "both"]]++topConfig :: IO MConfig+topConfig = mkMConfig "<both1>"+ ("no" : [ k ++ n | n <- intStrs+ , k <- [ "name", "cpu", "both"+ , "mname", "mem", "mboth"]])++foreign import ccall "unistd.h getpagesize"+ c_getpagesize :: CInt++pageSize :: Float+pageSize = fromIntegral c_getpagesize / 1024++processes :: IO [FilePath]+processes = fmap (filter isPid) (getDirectoryContents "/proc")+ where isPid = (`elem` ['0'..'9']) . head++getProcessData :: FilePath -> IO [String]+getProcessData pidf =+ handle ign $ withFile ("/proc" </> pidf </> "stat") ReadMode readWords+ where readWords = fmap words . hGetLine+ ign = const (return []) :: SomeException -> IO [String]++handleProcesses :: ([String] -> a) -> IO [a]+handleProcesses f =+ fmap (foldl' (\a p -> if length p < 15 then a else f p : a) [])+ (processes >>= mapM getProcessData)++showInfo :: String -> String -> Float -> Monitor [String]+showInfo nm sms mms = do+ mnw <- getConfigValue maxWidth+ mxw <- getConfigValue minWidth+ let lsms = length sms+ nmw = mnw - lsms - 1+ nmx = mxw - lsms - 1+ rnm = if nmw > 0 then padString nmw nmx " " True nm else nm+ mstr <- showWithColors' sms mms+ both <- showWithColors' (rnm ++ " " ++ sms) mms+ return [nm, mstr, both]++processName :: [String] -> String+processName = drop 1 . init . (!!1)++sortTop :: [(String, Float)] -> [(String, Float)]+sortTop = sortBy (flip (comparing snd))++type MemInfo = (String, Float)++meminfo :: [String] -> MemInfo+meminfo fs = (processName fs, pageSize * parseFloat (fs!!23))++meminfos :: IO [MemInfo]+meminfos = handleProcesses meminfo++showMemInfo :: Float -> MemInfo -> Monitor [String]+showMemInfo scale (nm, rss) =+ showInfo nm (showWithUnits 2 1 rss) (100 * rss / sc)+ where sc = if scale > 0 then scale else 100++showMemInfos :: [MemInfo] -> Monitor [[String]]+showMemInfos ms = mapM (showMemInfo tm) ms+ where tm = sum (map snd ms)++runTopMem :: [String] -> Monitor String+runTopMem _ = do+ mis <- io meminfos+ pstr <- showMemInfos (sortTop mis)+ parseTemplate $ concat pstr++type Pid = Int+type TimeInfo = (String, Float)+type TimeEntry = (Pid, TimeInfo)+type Times = [TimeEntry]+type TimesRef = IORef (Times, UTCTime)++timeMemEntry :: [String] -> (TimeEntry, MemInfo)+timeMemEntry fs = ((p, (n, t)), (n, r))+ where p = parseInt (head fs)+ n = processName fs+ t = parseFloat (fs!!13) + parseFloat (fs!!14)+ (_, r) = meminfo fs++timeMemEntries :: IO [(TimeEntry, MemInfo)]+timeMemEntries = handleProcesses timeMemEntry++timeMemInfos :: IO (Times, [MemInfo], Int)+timeMemInfos = fmap res timeMemEntries+ where res x = (sortBy (comparing fst) $ map fst x, map snd x, length x)++combine :: Times -> Times -> Times+combine _ [] = []+combine [] ts = ts+combine l@((p0, (n0, t0)):ls) r@((p1, (n1, t1)):rs)+ | p0 == p1 && n0 == n1 = (p0, (n0, t1 - t0)) : combine ls rs+ | p0 <= p1 = combine ls r+ | otherwise = (p1, (n1, t1)) : combine l rs++take' :: Int -> [a] -> [a]+take' m l = let !r = tk m l in length l `seq` r+ where tk 0 _ = []+ tk _ [] = []+ tk n (x:xs) = let !r = tk (n - 1) xs in x : r++topProcesses :: TimesRef -> Float -> IO (Int, [TimeInfo], [MemInfo])+topProcesses tref scale = do+ (t0, c0) <- readIORef tref+ (t1, mis, len) <- timeMemInfos+ c1 <- getCurrentTime+ let scx = realToFrac (diffUTCTime c1 c0) * scale+ !scx' = if scx > 0 then scx else scale+ nts = map (\(_, (nm, t)) -> (nm, min 100 (t / scx'))) (combine t0 t1)+ !t1' = take' (length t1) t1+ !nts' = take' maxEntries (sortTop nts)+ !mis' = take' maxEntries (sortTop mis)+ writeIORef tref (t1', c1)+ return (len, nts', mis')++showTimeInfo :: TimeInfo -> Monitor [String]+showTimeInfo (n, t) = showInfo n (showDigits 0 t) t++showTimeInfos :: [TimeInfo] -> Monitor [[String]]+showTimeInfos = mapM showTimeInfo++runTop :: TimesRef -> Float -> [String] -> Monitor String+runTop tref scale _ = do+ (no, ps, ms) <- io $ topProcesses tref scale+ pstr <- showTimeInfos ps+ mstr <- showMemInfos ms+ parseTemplate $ show no : concat (zipWith (++) pstr mstr) ++ repeat "N/A"++startTop :: [String] -> Int -> (String -> IO ()) -> IO ()+startTop a r cb = do+ cr <- getSysVar ClockTick+ c <- getCurrentTime+ tref <- newIORef ([], c)+ let scale = fromIntegral cr / 100+ _ <- topProcesses tref scale+ runM a topConfig (runTop tref scale) r cb
+ src/Plugins/Monitors/Uptime.hs view
@@ -0,0 +1,50 @@+------------------------------------------------------------------------------+-- |+-- Module : Plugins.Monitors.Uptime+-- Copyright : (c) 2010 Jose Antonio Ortega Ruiz+-- License : BSD3-style (see LICENSE)+--+-- Maintainer : jao@gnu.org+-- Stability : unstable+-- Portability : unportable+-- Created: Sun Dec 12, 2010 20:26+--+--+-- Uptime+--+------------------------------------------------------------------------------+++module Plugins.Monitors.Uptime (uptimeConfig, runUptime) where++import Plugins.Monitors.Common++import qualified Data.ByteString.Lazy.Char8 as B++uptimeConfig :: IO MConfig+uptimeConfig = mkMConfig "Up <days>d <hours>h <minutes>m"+ ["days", "hours", "minutes", "seconds"]++readUptime :: IO Float+readUptime =+ fmap (read . B.unpack . head . B.words) (B.readFile "/proc/uptime")++secsPerDay :: Integer+secsPerDay = 24 * 3600++uptime :: Monitor [String]+uptime = do+ t <- io readUptime+ u <- getConfigValue useSuffix+ let tsecs = floor t+ secs = tsecs `mod` secsPerDay+ days = tsecs `quot` secsPerDay+ hours = secs `quot` 3600+ mins = (secs `mod` 3600) `div` 60+ ss = secs `mod` 60+ str x s = if u then show x ++ s else show x+ mapM (`showWithColors'` days)+ [str days "d", str hours "h", str mins "m", str ss "s"]++runUptime :: [String] -> Monitor String+runUptime _ = uptime >>= parseTemplate
+ src/Plugins/Monitors/Weather.hs view
@@ -0,0 +1,141 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.Monitors.Weather+-- Copyright : (c) Andrea Rossato+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- A weather monitor for Xmobar+--+-----------------------------------------------------------------------------++module Plugins.Monitors.Weather where++import Plugins.Monitors.Common++import Control.Monad (when)+import System.Process+import System.Exit+import System.IO++import Text.ParserCombinators.Parsec+++weatherConfig :: IO MConfig+weatherConfig = mkMConfig+ "<station>: <tempC>C, rh <rh>% (<hour>)" -- template+ ["station" -- available replacements+ , "stationState"+ , "year"+ , "month"+ , "day"+ , "hour"+ , "wind"+ , "visibility"+ , "skyCondition"+ , "tempC"+ , "tempF"+ , "dewPoint"+ , "rh"+ , "pressure"+ ]++data WeatherInfo =+ WI { stationPlace :: String+ , stationState :: String+ , year :: String+ , month :: String+ , day :: String+ , hour :: String+ , wind :: String+ , visibility :: String+ , skyCondition :: String+ , tempC :: Int+ , tempF :: Int+ , dewPoint :: String+ , humidity :: Int+ , pressure :: Int+ } deriving (Show)++pTime :: Parser (String, String, String, String)+pTime = do y <- getNumbersAsString+ char '.'+ m <- getNumbersAsString+ char '.'+ d <- getNumbersAsString+ char ' '+ (h:hh:mi:mimi) <- getNumbersAsString+ char ' '+ return (y, m, d ,([h]++[hh]++":"++[mi]++mimi))++pTemp :: Parser (Int, Int)+pTemp = do let num = digit <|> char '-' <|> char '.'+ f <- manyTill num $ char ' '+ manyTill anyChar $ char '('+ c <- manyTill num $ char ' '+ skipRestOfLine+ return $ (floor (read c :: Double), floor (read f :: Double))++pRh :: Parser Int+pRh = do s <- manyTill digit $ (char '%' <|> char '.')+ return $ read s++pPressure :: Parser Int+pPressure = do manyTill anyChar $ char '('+ s <- manyTill digit $ char ' '+ skipRestOfLine+ return $ read s++parseData :: Parser [WeatherInfo]+parseData =+ do st <- getAllBut ","+ space+ ss <- getAllBut "("+ skipRestOfLine >> getAllBut "/"+ (y,m,d,h) <- pTime+ w <- getAfterString "Wind: "+ v <- getAfterString "Visibility: "+ sk <- getAfterString "Sky conditions: "+ skipTillString "Temperature: "+ (tC,tF) <- pTemp+ dp <- getAfterString "Dew Point: "+ skipTillString "Relative Humidity: "+ rh <- pRh+ skipTillString "Pressure (altimeter): "+ p <- pPressure+ manyTill skipRestOfLine eof+ return $ [WI st ss y m d h w v sk tC tF dp rh p]++defUrl :: String+defUrl = "http://weather.noaa.gov/pub/data/observations/metar/decoded/"++getData :: String -> IO String+getData url=+ do (i,o,e,p) <- runInteractiveCommand ("curl " ++ defUrl ++ url ++ ".TXT")+ exit <- waitForProcess p+ let closeHandles = do hClose o+ hClose i+ hClose e+ case exit of+ ExitSuccess -> do str <- hGetContents o+ when (str == str) $ return ()+ closeHandles+ return str+ _ -> do closeHandles+ return "Could not retrieve data"++formatWeather :: [WeatherInfo] -> Monitor String+formatWeather [(WI st ss y m d h w v sk tC tF dp r p)] =+ do cel <- showWithColors show tC+ far <- showWithColors show tF+ parseTemplate [st, ss, y, m, d, h, w, v, sk, cel, far, dp, show r , show p ]+formatWeather _ = return "N/A"++runWeather :: [String] -> Monitor String+runWeather str =+ do d <- io $ getData $ head str+ i <- io $ runP parseData d+ formatWeather i
+ src/Plugins/Monitors/Wireless.hs view
@@ -0,0 +1,34 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.Monitors.Wireless+-- Copyright : (c) Jose Antonio Ortega Ruiz+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose Antonio Ortega Ruiz+-- Stability : unstable+-- Portability : unportable+--+-- A monitor reporting ESSID and link quality for wireless interfaces+--+-----------------------------------------------------------------------------++module Plugins.Monitors.Wireless (wirelessConfig, runWireless) where++import Plugins.Monitors.Common+import IWlib++wirelessConfig :: IO MConfig+wirelessConfig =+ mkMConfig "<essid> <quality>" ["essid", "quality", "qualitybar"]++runWireless :: [String] -> Monitor String+runWireless (iface:_) = do+ wi <- io $ getWirelessInfo iface+ let essid = wiEssid wi+ qlty = wiQuality wi+ fqlty = fromIntegral qlty+ e = if essid == "" then "N/A" else essid+ q <- if qlty >= 0 then showWithColors show qlty else showWithPadding ""+ qb <- showPercentBar fqlty (fqlty / 100)+ parseTemplate [e, q, qb]+runWireless _ = return ""
+ src/Plugins/PipeReader.hs view
@@ -0,0 +1,28 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.PipeReader+-- Copyright : (c) Andrea Rossato+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- A plugin for reading from named pipes+--+-----------------------------------------------------------------------------++module Plugins.PipeReader where++import System.IO+import Plugins++data PipeReader = PipeReader String String+ deriving (Read, Show)++instance Exec PipeReader where+ alias (PipeReader _ a) = a+ start (PipeReader p _) cb = do+ h <- openFile p ReadWriteMode+ forever (hGetLineSafe h >>= cb)+ where forever a = a >> forever a
+ src/Plugins/StdinReader.hs view
@@ -0,0 +1,33 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.StdinReader+-- Copyright : (c) Andrea Rossato+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- A plugin for reading from stdin+--+-----------------------------------------------------------------------------++module Plugins.StdinReader where++import Prelude hiding (catch)+import System.Posix.Process+import System.Exit+import System.IO+import Control.Exception (SomeException(..),catch)+import Plugins++data StdinReader = StdinReader+ deriving (Read, Show)++instance Exec StdinReader where+ start StdinReader cb = do+ cb =<< catch (hGetLineSafe stdin) (\(SomeException e) -> do hPrint stderr e; return "")+ eof <- hIsEOF stdin+ if eof+ then exitImmediately ExitSuccess+ else start StdinReader cb
+ src/Plugins/Utils.hs view
@@ -0,0 +1,39 @@+------------------------------------------------------------------------------+-- |+-- Module: Plugins.Utils+-- Copyright: (c) 2010 Jose Antonio Ortega Ruiz+-- License: BSD3-style (see LICENSE)+--+-- Maintainer: Jose A Ortega Ruiz <jao@gnu.org>+-- Stability: unstable+-- Portability: unportable+-- Created: Sat Dec 11, 2010 20:55+--+--+-- Miscellaneous utility functions+--+------------------------------------------------------------------------------+++module Plugins.Utils (expandHome, changeLoop) where++import Control.Monad+import Control.Concurrent.STM++import System.Environment+import System.FilePath+++expandHome :: FilePath -> IO FilePath+expandHome ('~':'/':path) = fmap (</> path) (getEnv "HOME")+expandHome p = return p++changeLoop :: Eq a => STM a -> (a -> IO ()) -> IO ()+changeLoop s f = atomically s >>= go+ where+ go old = do+ f old+ go =<< atomically (do+ new <- s+ guard (new /= old)+ return new)
+ src/Plugins/XMonadLog.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE CPP #-}++-----------------------------------------------------------------------------+-- |+-- Module : Plugins.StdinReader+-- Copyright : (c) Spencer Janssen+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Spencer Janssen <spencerjanssen@gmail.com>+-- Stability : unstable+-- Portability : unportable+--+-- A plugin to display information from _XMONAD_LOG, specified at+-- http://code.haskell.org/XMonadContrib/XMonad/Hooks/DynamicLog.hs+--+-----------------------------------------------------------------------------++module Plugins.XMonadLog (XMonadLog(..)) where++import Control.Monad+import Graphics.X11+import Graphics.X11.Xlib.Extras+import Plugins+#ifdef UTF8+#undef UTF8+import Codec.Binary.UTF8.String as UTF8+#define UTF8+#endif+import Foreign.C (CChar)+import XUtil (nextEvent')+++data XMonadLog = XMonadLog | XPropertyLog String+ deriving (Read, Show)++instance Exec XMonadLog where+ alias XMonadLog = "XMonadLog"+ alias (XPropertyLog atom) = atom++ start x cb = do+ let atom = case x of+ XMonadLog -> "_XMONAD_LOG"+ XPropertyLog a -> a+ d <- openDisplay ""+ xlog <- internAtom d atom False++ root <- rootWindow d (defaultScreen d)+ selectInput d root propertyChangeMask++ let update = do+ mwp <- getWindowProperty8 d xlog root+ maybe (return ()) (cb . decodeCChar) mwp++ update++ allocaXEvent $ \ep -> forever $ do+ nextEvent' d ep+ e <- getEvent ep+ case e of+ PropertyEvent { ev_atom = a } | a == xlog -> update+ _ -> return ()++ return ()++decodeCChar :: [CChar] -> String+#ifdef UTF8+#undef UTF8+decodeCChar = UTF8.decode . map fromIntegral+#define UTF8+#else+decodeCChar = map (toEnum . fromIntegral)+#endif
+ src/Runnable.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module : Xmobar.Runnable+-- Copyright : (c) Andrea Rossato+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- The existential type to store the list of commands to be executed.+-- I must thank Claus Reinke for the help in understanding the mysteries of+-- reading existential types. The Read instance of Runnable must be credited to+-- him.+--+-- See here:+-- http:\/\/www.haskell.org\/pipermail\/haskell-cafe\/2007-July\/028227.html+--+-----------------------------------------------------------------------------++module Runnable where++import Control.Monad+import Text.Read+import Config (runnableTypes)+import Commands++data Runnable = forall r . (Exec r, Read r, Show r) => Run r++instance Exec Runnable where+ start (Run a) = start a+ alias (Run a) = alias a++instance Show Runnable where+ show (Run x) = show x++instance Read Runnable where+ readPrec = readRunnable++class ReadAsAnyOf ts ex where+ -- | Reads an existential type as any of hidden types ts+ readAsAnyOf :: ts -> ReadPrec ex++instance ReadAsAnyOf () ex where+ readAsAnyOf ~() = mzero++instance (Show t, Read t, Exec t, ReadAsAnyOf ts Runnable) => ReadAsAnyOf (t,ts) Runnable where+ readAsAnyOf ~(t,ts) = r t `mplus` readAsAnyOf ts+ where r ty = do { m <- readPrec; return (Run (m `asTypeOf` ty)) }++-- | The 'Prelude.Read' parser for the 'Runnable' existential type. It+-- needs an 'Prelude.undefined' with a type signature containing the+-- list of all possible types hidden within 'Runnable'. See 'Config.runnableTypes'.+-- Each hidden type must have a 'Prelude.Read' instance.+readRunnable :: ReadPrec Runnable+readRunnable = prec 10 $ do+ Ident "Run" <- lexP+ parens $ readAsAnyOf runnableTypes
+ src/Runnable.hs-boot view
@@ -0,0 +1,8 @@+{-# LANGUAGE ExistentialQuantification #-}+module Runnable where+import Commands++data Runnable = forall r . (Exec r,Read r,Show r) => Run r++instance Read Runnable+instance Exec Runnable
+ src/StatFS.hsc view
@@ -0,0 +1,79 @@+-----------------------------------------------------------------------------+-- |+-- Module : StatFS+-- Copyright : (c) Jose A Ortega Ruiz+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- A binding to C's statvfs(2)+--+-----------------------------------------------------------------------------++{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-}+++module StatFS ( FileSystemStats(..), getFileSystemStats ) where++import Foreign+import Foreign.C.Types+import Foreign.C.String+import Data.ByteString (useAsCString)+import Data.ByteString.Char8 (pack)++#if defined (__FreeBSD__)+# include <sys/param.h>+# include <sys/mount.h>+#else+#include <sys/vfs.h>+#endif++data FileSystemStats = FileSystemStats {+ fsStatBlockSize :: Integer+ -- ^ Optimal transfer block size.+ , fsStatBlockCount :: Integer+ -- ^ Total data blocks in file system.+ , fsStatByteCount :: Integer+ -- ^ Total bytes in file system.+ , fsStatBytesFree :: Integer+ -- ^ Free bytes in file system.+ , fsStatBytesAvailable :: Integer+ -- ^ Free bytes available to non-superusers.+ , fsStatBytesUsed :: Integer+ -- ^ Bytes used.+ } deriving (Show, Eq)++data CStatfs++#if defined(__FreeBSD__)+foreign import ccall unsafe "sys/mount.h statfs"+#else+foreign import ccall unsafe "sys/vfs.h statfs64"+#endif+ c_statfs :: CString -> Ptr CStatfs -> IO CInt++toI :: CLong -> Integer+toI = toInteger++getFileSystemStats :: String -> IO (Maybe FileSystemStats)+getFileSystemStats path =+ allocaBytes (#size struct statfs) $ \vfs ->+ useAsCString (pack path) $ \cpath -> do+ res <- c_statfs cpath vfs+ if res == -1 then return Nothing+ else do+ bsize <- (#peek struct statfs, f_bsize) vfs+ bcount <- (#peek struct statfs, f_blocks) vfs+ bfree <- (#peek struct statfs, f_bfree) vfs+ bavail <- (#peek struct statfs, f_bavail) vfs+ let bpb = toI bsize+ return $ Just FileSystemStats+ { fsStatBlockSize = bpb+ , fsStatBlockCount = toI bcount+ , fsStatByteCount = toI bcount * bpb+ , fsStatBytesFree = toI bfree * bpb+ , fsStatBytesAvailable = toI bavail * bpb+ , fsStatBytesUsed = toI (bcount - bfree) * bpb+ }
+ src/XUtil.hsc view
@@ -0,0 +1,259 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module : XUtil+-- Copyright : (C) 2007 Andrea Rossato+-- License : BSD3+--+-- Maintainer : andrea.rossato@unitn.it+-- Stability : unstable+-- Portability : unportable+--+-----------------------------------------------------------------------------++module XUtil+ ( XFont+ , initFont+ , initCoreFont+ , initUtf8Font+ , textExtents+ , textWidth+ , printString+ , initColor+ , newWindow+ , nextEvent'+ , readFileSafe+ , hGetLineSafe+ , io+ , fi+ , withColors+ , DynPixel(..)+ ) where++import Control.Concurrent+import Control.Monad.Trans+import Data.IORef+import Foreign+import Graphics.X11.Xlib hiding (textExtents, textWidth)+import qualified Graphics.X11.Xlib as Xlib (textExtents, textWidth)+import Graphics.X11.Xlib.Extras+import System.Mem.Weak ( addFinalizer )+import System.Posix.Types (Fd(..))+import System.IO+#if defined XFT || defined UTF8+# if __GLASGOW_HASKELL__ < 612+import Foreign.C+import qualified System.IO.UTF8 as UTF8 (readFile,hGetLine)+# else+import qualified System.IO as UTF8 (readFile,hGetLine)+# endif+#endif+#if defined XFT+import Data.List+import Graphics.X11.Xft+import Graphics.X11.Xrender+#endif++readFileSafe :: FilePath -> IO String+#if defined XFT || defined UTF8+readFileSafe = UTF8.readFile+#else+readFileSafe = readFile+#endif++hGetLineSafe :: Handle -> IO String+#if defined XFT || defined UTF8+hGetLineSafe = UTF8.hGetLine+#else+hGetLineSafe = hGetLine+#endif++-- Hide the Core Font/Xft switching here+data XFont = Core FontStruct+ | Utf8 FontSet+#ifdef XFT+ | Xft XftFont+#endif++-- | When initFont gets a font name that starts with 'xft:' it switchs to the Xft backend+-- Example: 'xft:Sans-10'+initFont :: Display ->String -> IO XFont+initFont d s =+#ifdef XFT+ let xftPrefix = "xft:" in+ if xftPrefix `isPrefixOf` s then+ fmap Xft $ initXftFont d s+ else+#endif+#if defined UTF8 || __GLASGOW_HASKELL__ >= 612+ fmap Utf8 $ initUtf8Font d s+#else+ fmap Core $ initCoreFont d s+#endif++-- | Given a fontname returns the font structure. If the font name is+-- not valid the default font will be loaded and returned.+initCoreFont :: Display -> String -> IO FontStruct+initCoreFont d s = do+ f <- catch getIt fallBack+ addFinalizer f (freeFont d f)+ return f+ where getIt = loadQueryFont d s+ fallBack = const $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"++-- | Given a fontname returns the font structure. If the font name is+-- not valid the default font will be loaded and returned.+initUtf8Font :: Display -> String -> IO FontSet+initUtf8Font d s = do+ setupLocale+ (_,_,f) <- catch getIt fallBack+ addFinalizer f (freeFontSet d f)+ return f+ where getIt = createFontSet d s+ fallBack = const $ createFontSet d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"++#ifdef XFT+initXftFont :: Display -> String -> IO XftFont+initXftFont d s = do+ setupLocale+ f <- xftFontOpen d (defaultScreenOfDisplay d) (drop 4 s)+ addFinalizer f (xftFontClose d f)+ return f+#endif++textWidth :: Display -> XFont -> String -> IO Int+textWidth _ (Utf8 fs) s = return $ fi $ wcTextEscapement fs s+textWidth _ (Core fs) s = return $ fi $ Xlib.textWidth fs s+#ifdef XFT+textWidth dpy (Xft xftdraw) s = do+ gi <- xftTextExtents dpy xftdraw s+ return $ xglyphinfo_xOff gi+#endif++textExtents :: XFont -> String -> IO (Int32,Int32)+textExtents (Core fs) s = do+ let (_,a,d,_) = Xlib.textExtents fs s+ return (a,d)+textExtents (Utf8 fs) s = do+ let (_,rl) = wcTextExtents fs s+ ascent = fi $ - (rect_y rl)+ descent = fi $ rect_height rl + (fi $ rect_y rl)+ return (ascent, descent)+#ifdef XFT+textExtents (Xft xftfont) _ = do+ ascent <- fi `fmap` xftfont_ascent xftfont+ descent <- fi `fmap` xftfont_descent xftfont+ return (ascent, descent)+#endif++printString :: Display -> Drawable -> XFont -> GC -> String -> String+ -> Position -> Position -> String -> IO ()+printString d p (Core fs) gc fc bc x y s = do+ setFont d gc $ fontFromFontStruct fs+ withColors d [fc, bc] $ \[fc', bc'] -> do+ setForeground d gc fc'+ setBackground d gc bc'+ drawImageString d p gc x y s++printString d p (Utf8 fs) gc fc bc x y s =+ withColors d [fc, bc] $ \[fc', bc'] -> do+ setForeground d gc fc'+ setBackground d gc bc'+ io $ wcDrawImageString d p fs gc x y s++#ifdef XFT+printString dpy drw fs@(Xft font) gc fc bc x y s = do+ let screen = defaultScreenOfDisplay dpy+ colormap = defaultColormapOfScreen screen+ visual = defaultVisualOfScreen screen+ withColors dpy [bc] $ \[bcolor] -> do+ (a,d) <- textExtents fs s+ gi <- xftTextExtents dpy font s+ setForeground dpy gc bcolor+ fillRectangle dpy drw gc (x - fi (xglyphinfo_x gi))+ (y - fi (a + d))+ (fi $ xglyphinfo_xOff gi)+ (fi $ 4 + a + d)+ withXftDraw dpy drw visual colormap $+ \draw -> withXftColorName dpy visual colormap fc $+ \color -> xftDrawString draw color font x (y - 2) s+#endif++data DynPixel = DynPixel { allocated :: Bool+ , pixel :: Pixel+ }++-- | Get the Pixel value for a named color: if an invalid name is+-- given the black pixel will be returned.+initColor :: Display -> String -> IO DynPixel+initColor dpy c = (initColor' dpy c) `catch`+ (const . return $ DynPixel False (blackPixel dpy $ defaultScreen dpy))++type ColorCache = [(String, Color)]+{-# NOINLINE colorCache #-}+colorCache :: IORef ColorCache+colorCache = unsafePerformIO $ newIORef []++getCachedColor :: String -> IO (Maybe Color)+getCachedColor color_name = lookup color_name `fmap` readIORef colorCache++putCachedColor :: String -> Color -> IO ()+putCachedColor name c_id = modifyIORef colorCache $ \c -> (name, c_id) : c++initColor' :: Display -> String -> IO DynPixel+initColor' dpy c = do+ let colormap = defaultColormap dpy (defaultScreen dpy)+ cached_color <- getCachedColor c+ c' <- case cached_color of+ Just col -> return col+ _ -> do (c'', _) <- allocNamedColor dpy colormap c+ putCachedColor c c''+ return c''+ return $ DynPixel True (color_pixel c')++withColors :: MonadIO m => Display -> [String] -> ([Pixel] -> m a) -> m a+withColors d cs f = do+ ps <- mapM (io . initColor d) cs+ f $ map pixel ps++-- | Creates a window with the attribute override_redirect set to True.+-- Windows Managers should not touch this kind of windows.+newWindow :: Display -> Screen -> Window -> Rectangle -> Bool -> IO Window+newWindow dpy scr rw (Rectangle x y w h) o = do+ let visual = defaultVisualOfScreen scr+ attrmask = cWOverrideRedirect+ allocaSetWindowAttributes $+ \attributes -> do+ set_override_redirect attributes o+ createWindow dpy rw x y w h 0 (defaultDepthOfScreen scr)+ inputOutput visual attrmask attributes+-- | A version of nextEvent that does not block in foreign calls.+nextEvent' :: Display -> XEventPtr -> IO ()+nextEvent' d p = do+ pend <- pending d+ if pend /= 0+ then nextEvent d p+ else do+ threadWaitRead (Fd fd)+ nextEvent' d p+ where+ fd = connectionNumber d++io :: MonadIO m => IO a -> m a+io = liftIO++-- | Short-hand for 'fromIntegral'+fi :: (Integral a, Num b) => a -> b+fi = fromIntegral++#if __GLASGOW_HASKELL__ < 612 && (defined XFT || defined UTF8)+#include <locale.h>+foreign import ccall unsafe "locale.h setlocale"+ setlocale :: CInt -> CString -> IO CString++setupLocale :: IO ()+setupLocale = withCString "" (setlocale $ #const LC_ALL) >> return ()+# else+setupLocale :: IO ()+setupLocale = return ()+#endif
+ src/Xmobar.hs view
@@ -0,0 +1,306 @@+{-# LANGUAGE DeriveDataTypeable #-}+-----------------------------------------------------------------------------+-- |+-- Module : Xmobar+-- Copyright : (c) Andrea Rossato+-- License : BSD-style (see LICENSE)+--+-- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>+-- Stability : unstable+-- Portability : unportable+--+-- A status bar for the Xmonad Window Manager+--+-----------------------------------------------------------------------------++module Xmobar+ ( -- * Main Stuff+ -- $main+ X , XConf (..), runX+ , eventLoop+ -- * Program Execution+ -- $command+ , startCommand+ -- * Window Management+ -- $window+ , createWin, updateWin+ -- * Printing+ -- $print+ , drawInWin, printStrings+ ) where++import Prelude hiding (catch)+import Graphics.X11.Xlib hiding (textExtents, textWidth)+import Graphics.X11.Xlib.Extras+import Graphics.X11.Xinerama++import Control.Arrow ((&&&))+import Control.Monad.Reader+import Control.Concurrent+import Control.Concurrent.STM+import Control.Exception hiding (handle)+import Data.Bits+import Data.Maybe(fromMaybe)+import Data.Typeable (Typeable)++import Config+import Parsers+import Commands+import Runnable+import XUtil++-- $main+--+-- The Xmobar data type and basic loops and functions.++-- | The X type is a ReaderT+type X = ReaderT XConf IO++-- | The ReaderT inner component+data XConf =+ XConf { display :: Display+ , rect :: Rectangle+ , window :: Window+ , fontS :: XFont+ , config :: Config+ }++-- | Runs the ReaderT+runX :: XConf -> X () -> IO ()+runX xc f = runReaderT f xc++data WakeUp = WakeUp deriving (Show,Typeable)+instance Exception WakeUp++-- | The event loop+eventLoop :: XConf -> [(Maybe ThreadId, TVar String)] -> IO ()+eventLoop xc@(XConf d _ w fs c) v = block $ do+ tv <- atomically $ newTVar []+ t <- myThreadId+ ct <- forkIO (checker t tv "" `catch` \(SomeException _) -> return ())+ go tv ct+ where+ -- interrupt the drawing thread every time a var is updated+ checker t tvar ov = do+ nval <- atomically $ do+ nv <- fmap concat $ mapM readTVar (map snd v)+ guard (nv /= ov)+ writeTVar tvar nv+ return nv+ throwTo t WakeUp+ checker t tvar nval++ -- Continuously wait for a timer interrupt or an expose event+ go tv ct = do+ catch (unblock $ allocaXEvent $ \e ->+ handle tv ct =<< (nextEvent' d e >> getEvent e))+ (\WakeUp -> runX xc (updateWin tv) >> return ())+ go tv ct++ -- event hanlder+ handle _ ct (ConfigureEvent {ev_window = win}) = do+ rootw <- rootWindow d (defaultScreen d)+ when (win == rootw) $ block $ do+ killThread ct+ destroyWindow d w+ (r',w') <- createWin d fs c+ eventLoop (XConf d r' w' fs c) v++ handle tvar _ (ExposeEvent {}) = runX xc (updateWin tvar)++ handle _ _ _ = return ()++-- $command++-- | Runs a command as an independent thread and returns its thread id+-- and the TVar the command will be writing to.+startCommand :: (Runnable,String,String) -> IO (Maybe ThreadId, TVar String)+startCommand (com,s,ss)+ | alias com == "" = do var <- atomically $ newTVar is+ atomically $ writeTVar var "Could not parse the template"+ return (Nothing,var)+ | otherwise = do var <- atomically $ newTVar is+ let cb str = atomically $ writeTVar var (s ++ str ++ ss)+ h <- forkIO $ start com cb+ return (Just h,var)+ where is = s ++ "Updating..." ++ ss++-- $window++-- | The function to create the initial window+createWin :: Display -> XFont -> Config -> IO (Rectangle,Window)+createWin d fs c = do+ let dflt = defaultScreen d+ srs <- getScreenInfo d+ rootw <- rootWindow d dflt+ (as,ds) <- textExtents fs "0"+ let ht = as + ds + 4+ (r,o) = setPosition (position c) srs (fi ht)+ win <- newWindow d (defaultScreenOfDisplay d) rootw r o+ selectInput d win (exposureMask .|. structureNotifyMask)+ setProperties r c d win srs+ when (lowerOnStart c) (lowerWindow d win)+ mapWindow d win+ return (r,win)++setPosition :: XPosition -> [Rectangle] -> Dimension -> (Rectangle,Bool)+setPosition p rs ht =+ case p' of+ Top -> (Rectangle rx ry rw h , True)+ TopW a i -> (Rectangle (ax a i ) ry (nw i ) h , True)+ TopSize a i ch -> (Rectangle (ax a i ) ry (nw i ) (mh ch), True)+ Bottom -> (Rectangle rx ny rw h , True)+ BottomW a i -> (Rectangle (ax a i ) ny (nw i ) h , True)+ BottomSize a i ch -> (Rectangle (ax a i ) ny (nw i ) (mh ch), True)+ Static cx cy cw ch -> (Rectangle (fi cx ) (fi cy) (fi cw) (fi ch), True)+ OnScreen _ p'' -> setPosition p'' [scr] ht+ where+ (scr@(Rectangle rx ry rw rh), p') =+ case p of OnScreen i x -> (fromMaybe (head rs) $ safeIndex i rs, x)+ _ -> (head rs, p)+ ny = ry + fi (rh - ht)+ center i = rx + (fi $ div (remwid i) 2)+ right i = rx + (fi $ remwid i)+ remwid i = rw - pw (fi i)+ ax L = const rx+ ax R = right+ ax C = center+ pw i = rw * (min 100 i) `div` 100+ nw = fi . pw . fi+ h = fi ht+ mh h' = max (fi h') h++ safeIndex i = lookup i . zip [0..]++setProperties :: Rectangle -> Config -> Display -> Window -> [Rectangle] -> IO ()+setProperties r c d w srs = do+ a1 <- internAtom d "_NET_WM_STRUT_PARTIAL" False+ c1 <- internAtom d "CARDINAL" False+ a2 <- internAtom d "_NET_WM_WINDOW_TYPE" False+ c2 <- internAtom d "ATOM" False+ v <- internAtom d "_NET_WM_WINDOW_TYPE_DOCK" False+ changeProperty32 d w a1 c1 propModeReplace $ map fi $+ getStrutValues r (position c) (getRootWindowHeight srs)+ changeProperty32 d w a2 c2 propModeReplace [fromIntegral v]++getRootWindowHeight :: [Rectangle] -> Int+getRootWindowHeight srs = foldr1 max (map getMaxScreenYCoord srs)+ where+ getMaxScreenYCoord sr = fi (rect_y sr) + fi (rect_height sr)++getStrutValues :: Rectangle -> XPosition -> Int -> [Int]+getStrutValues r@(Rectangle x y w h) p rwh =+ case p of+ OnScreen _ p' -> getStrutValues r p' rwh+ Top -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]+ TopW _ _ -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]+ TopSize {} -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0]+ Bottom -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]+ BottomW _ _ -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]+ BottomSize {} -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw]+ Static _ _ _ _ -> getStaticStrutValues p rwh+ where st = fi y + fi h+ sb = rwh - fi y+ nx = fi x+ nw = fi (x + fi w - 1)++-- get some reaonable strut values for static placement.+getStaticStrutValues :: XPosition -> Int -> [Int]+getStaticStrutValues (Static cx cy cw ch) rwh+ -- if the yPos is in the top half of the screen, then assume a Top+ -- placement, otherwise, it's a Bottom placement+ | cy < (rwh `div` 2) = [0, 0, st, 0, 0, 0, 0, 0, xs, xe, 0, 0]+ | otherwise = [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, xs, xe]+ where st = cy + ch+ sb = rwh - cy+ xs = cx -- a simple calculation for horizontal (x) placement+ xe = xs + cw+getStaticStrutValues _ _ = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]++updateWin :: TVar String -> X ()+updateWin v = do+ xc <- ask+ let (conf,rec) = (config &&& rect) xc+ [lc,rc] = if length (alignSep conf) == 2+ then alignSep conf+ else alignSep defaultConfig+ i <- io $ atomically $ readTVar v+ let def = [i,[],[]]+ [l,c,r] = case break (==lc) i of+ (le,_:re) -> case break (==rc) re of+ (ce,_:ri) -> [le,ce,ri]+ _ -> def+ _ -> def+ ps <- io $ mapM (parseString conf) [l,c,r]+ drawInWin rec ps++-- $print++-- | Draws in and updates the window+drawInWin :: Rectangle -> [[(String, String)]] -> X ()+drawInWin (Rectangle _ _ wid ht) ~[left,center,right] = do+ r <- ask+ let (c,d ) = (config &&& display) r+ (w,fs) = (window &&& fontS ) r+ strLn = io . mapM (\(s,cl) -> textWidth d fs s >>= \tw -> return (s,cl,fi tw))+ withColors d [bgColor c, borderColor c] $ \[bgcolor, bdcolor] -> do+ gc <- io $ createGC d w+ -- create a pixmap to write to and fill it with a rectangle+ p <- io $ createPixmap d w wid ht+ (defaultDepthOfScreen (defaultScreenOfDisplay d))+ -- the fgcolor of the rectangle will be the bgcolor of the window+ io $ setForeground d gc bgcolor+ io $ fillRectangle d p gc 0 0 wid ht+ -- write to the pixmap the new string+ printStrings p gc fs 1 L =<< strLn left+ printStrings p gc fs 1 R =<< strLn right+ printStrings p gc fs 1 C =<< strLn center+ -- draw 1 pixel border if requested+ io $ drawBorder (border c) d p gc bdcolor wid ht+ -- copy the pixmap with the new string to the window+ io $ copyArea d p w gc 0 0 wid ht 0 0+ -- free up everything (we do not want to leak memory!)+ io $ freeGC d gc+ io $ freePixmap d p+ -- resync+ io $ sync d True++drawBorder :: Border -> Display -> Drawable -> GC -> Pixel -> Dimension+ -> Dimension -> IO ()+drawBorder b d p gc c wi ht = case b of+ NoBorder -> return ()+ TopB -> drawBorder (TopBM 0) d p gc c w h+ BottomB -> drawBorder (BottomBM 0) d p gc c w h+ FullB -> drawBorder (FullBM 0) d p gc c w h+ TopBM m -> sf >> drawLine d p gc 0 (fi m) (fi w) 0+ BottomBM m -> let rw = (fi h) - (fi m) in+ sf >> drawLine d p gc 0 rw (fi w) rw+ FullBM m -> let rm = fi m; mp = fi m in+ sf >> drawRectangle d p gc mp mp (w - rm) (h - rm)+ where sf = setForeground d gc c+ (w, h) = (wi - 1, ht - 1)++-- | An easy way to print the stuff we need to print+printStrings :: Drawable -> GC -> XFont -> Position+ -> Align -> [(String, String, Position)] -> X ()+printStrings _ _ _ _ _ [] = return ()+printStrings dr gc fontst offs a sl@((s,c,l):xs) = do+ r <- ask+ (as,ds) <- io $ textExtents fontst s+ let (conf,d) = (config &&& display) r+ Rectangle _ _ wid ht = rect r+ totSLen = foldr (\(_,_,len) -> (+) len) 0 sl+ valign = fi $ as + ds+ remWidth = fi wid - fi totSLen+ offset = case a of+ C -> (remWidth + offs) `div` 2+ R -> remWidth+ L -> offs+ (fc,bc) = case (break (==',') c) of+ (f,',':b) -> (f, b )+ (f, _) -> (f, bgColor conf)+ withColors d [bc] $ \[bc'] -> do+ io $ setForeground d gc bc'+ io $ fillRectangle d dr gc offset 0 (fi l) ht+ io $ printString d dr fontst gc fc bc offset valign s+ printStrings dr gc fontst (offs + l) a xs
xmobar.cabal view
@@ -1,22 +1,31 @@ name: xmobar-version: 0.11.1-homepage: http://code.haskell.org/~arossato/xmobar+version: 0.12+homepage: http://projects.haskell.org/xmobar/+bug-reports: http://code.google.com/p/xmobar/issues synopsis: A Minimalistic Text Based Status Bar description: Xmobar is a minimalistic text based status bar. .- Inspired by the Ion3 status bar, it supports similar features,- like dynamic color management, output templates, and extensibility- through plugins.+ Inspired by the Ion3 status bar, it supports similar+ features, like dynamic color management, output templates,+ and extensibility through plugins. category: System license: BSD3 license-file: LICENSE author: Andrea Rossato-maintainer: andrea.rossato@unitn.it+maintainer: Jose A. Ortega Ruiz <jao@gnu.org> cabal-version: >= 1.6 build-type: Simple -data-files: xmobar.config-sample+data-files: samples/xmobar.config+extra-source-files: README, NEWS,+ samples/Plugins/helloworld.config,+ samples/Plugins/HelloWorld.hs +source-repository head+ type: git+ location: git://github.com/jaor/xmobar.git+ branch: master+ flag small_base description: Choose the new smaller, split-up base package. @@ -29,20 +38,36 @@ default: True flag with_inotify- description: inotify support (modern Linux only). Required for the Mail plugin.+ description: inotify support (modern Linux only). Required for the Mail and MBox plugins. default: False flag with_iwlib- description: wireless info support. Required for the Wireless plugin, needs iwlib installed.+ description: Wireless info support. Required for the Wireless plugin, needs iwlib installed. default: False flag with_mpd- description: mpd support. Needs libmpd installed.+ description: MPD support. Needs libmpd installed. default: False +flag all_extensions+ description: Includes all optional extensions.+ default: False+ executable xmobar+ hs-source-dirs: src main-is: Main.hs- other-modules: Xmobar, Config, Parsers, Commands, XUtil, StatFS, Runnable, Plugins+ other-modules:+ Xmobar, Config, Parsers, Commands, XUtil, StatFS, Runnable,+ Plugins, Plugins.CommandReader, Plugins.Date, Plugins.EWMH,+ Plugins.PipeReader, Plugins.StdinReader, Plugins.XMonadLog,+ Plugins.Utils, Plugins.Monitors, Plugins.Monitors.Batt,+ Plugins.Monitors.Common, Plugins.Monitors.CoreCommon,+ Plugins.Monitors.CoreTemp, Plugins.Monitors.CpuFreq,+ Plugins.Monitors.Cpu, Plugins.Monitors.Disk, Plugins.Monitors.Mem,+ Plugins.Monitors.MultiCpu, Plugins.Monitors.Net,+ Plugins.Monitors.Swap, Plugins.Monitors.Thermal, Plugins.Monitors.Top,+ Plugins.Monitors.Uptime, Plugins.Monitors.Weather+ ghc-prof-options: -prof -auto-all if true@@ -62,23 +87,25 @@ else build-depends: base < 3 - if flag(with_xft)+ if flag(with_xft) || flag(all_extensions) build-depends: utf8-string, X11-xft >= 0.2 cpp-options: -DXFT - if flag(with_utf8)+ if flag(with_utf8) || flag(all_extensions) build-depends: utf8-string cpp-options: -DUTF8 - if flag(with_inotify)+ if flag(with_inotify) || flag(all_extensions) build-depends: hinotify+ other-modules: Plugins.Mail, Plugins.MBox cpp-options: -DINOTIFY - if flag(with_iwlib)+ if flag(with_iwlib) || flag(all_extensions) extra-libraries: iw- other-modules: IWlib+ other-modules: IWlib, Plugins.Monitors.Wireless cpp-options: -DIWLIB - if flag(with_mpd)- build-depends: libmpd > 0.4+ if flag(with_mpd) || flag(all_extensions)+ build-depends: libmpd >= 0.5+ other-modules: Plugins.Monitors.MPD cpp-options: -DLIBMPD
− xmobar.config-sample
@@ -1,18 +0,0 @@-Config { font = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"- , bgColor = "black"- , fgColor = "grey"- , position = Top- , lowerOnStart = True- , commands = [ Run Weather "EGPF" ["-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- ]- , sepChar = "%"- , alignSep = "}{"- , template = "%cpu% | %memory% * %swap% | %eth0% - %eth1% }{ <fc=#ee9a00>%date%</fc>| %EGPF% | %uname%"- }