xmobar 0.6 → 0.7
raw patch · 25 files changed
+1353/−1100 lines, 25 files
Files
- Commands.hs +16/−50
- Config.hs +7/−6
- Main.hs +111/−13
- Monitors/Batt.hs +0/−67
- Monitors/Common.hs +0/−286
- Monitors/Cpu.hs +0/−53
- Monitors/Mem.hs +0/−47
- Monitors/Net.hs +0/−99
- Monitors/Swap.hs +0/−50
- Monitors/Weather.hs +0/−129
- Parsers.hs +2/−2
- Plugins/HelloWorld.hs +1/−1
- Plugins/Monitors.hs +60/−0
- Plugins/Monitors/Batt.hs +68/−0
- Plugins/Monitors/Common.hs +295/−0
- Plugins/Monitors/Cpu.hs +53/−0
- Plugins/Monitors/Mem.hs +47/−0
- Plugins/Monitors/Net.hs +99/−0
- Plugins/Monitors/Swap.hs +50/−0
- Plugins/Monitors/Weather.hs +129/−0
- README +119/−35
- Runnable.hs +1/−1
- XMobar.hs +0/−254
- Xmobar.hs +285/−0
- xmobar.cabal +10/−7
Commands.hs view
@@ -1,6 +1,6 @@ ----------------------------------------------------------------------------- -- |--- Module : XMobar.Commands+-- Module : Xmobar.Commands -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- @@ -13,8 +13,7 @@ -- 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 stores the monitors to be run internally by--- XMobar.+-- The 'Command' data type is for OS commands to be run by Xmobar -- ----------------------------------------------------------------------------- @@ -24,67 +23,34 @@ import System.Exit import System.IO (hClose, hGetLine) -import Monitors.Common ( runM )-import Monitors.Weather-import Monitors.Net-import Monitors.Mem-import Monitors.Swap-import Monitors.Cpu-import Monitors.Batt- class Exec e where run :: e -> IO String rate :: e -> Int alias :: e -> String data Command = Com Program Args Alias Rate- | Weather Station Args Rate- | Network Interface Args Rate- | Memory Args Rate- | Swap Args Rate- | Cpu Args Rate- | Battery Args Rate deriving (Show,Read,Eq) type Args = [String] type Program = String type Alias = String-type Station = String-type Interface = String type Rate = Int instance Exec Command where- alias (Weather s _ _) = s- alias (Network i _ _) = i- alias (Memory _ _) = "memory"- alias (Swap _ _) = "swap"- alias (Cpu _ _) = "cpu"- alias (Battery _ _) = "battery" alias (Com p _ a _) | p /= "" = if a == "" then p else a | otherwise = ""- rate (Weather _ _ r) = r- rate (Network _ _ r) = r- rate (Memory _ r) = r- rate (Swap _ r) = r- rate (Cpu _ r) = r- rate (Battery _ r) = r rate (Com _ _ _ r) = r- run (Weather s a _) = runM (a ++ [s]) weatherConfig runWeather - run (Network i a _) = runM (a ++ [i]) netConfig runNet- run (Memory args _) = runM args memConfig runMem- run (Swap args _) = runM args swapConfig runSwap- run (Cpu args _) = runM args cpuConfig runCpu- run (Battery args _) = runM args battConfig runBatt- run (Com prog args _ _) = 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 <- hGetLine o- closeHandles- return str- _ -> do closeHandles- return $ "Could not execute command " ++ prog--+ run (Com prog args _ _) = 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 <- hGetLine o+ closeHandles+ return str+ _ -> do closeHandles+ return $ "Could not execute command " ++ prog
Config.hs view
@@ -1,6 +1,6 @@ ----------------------------------------------------------------------------- -- |--- Module : XMobar.Config+-- Module : Xmobar.Config -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- @@ -8,7 +8,7 @@ -- Stability : unstable -- Portability : unportable ----- The configuration module of XMobar, a status bar for the Xmonad Window Manager +-- The configuration module of Xmobar, a text based status bar -- ----------------------------------------------------------------------------- @@ -21,6 +21,7 @@ import Commands import {-# SOURCE #-} Runnable+import Plugins.Monitors -- $config -- Configuration data type and default configuration@@ -55,16 +56,16 @@ , height = 15 , align = "left" , refresh = 10- , commands = [Run $ Memory [] 10]+ , commands = [] , sepChar = "%"- , template = "Uptime: <fc=#00FF00>%uptime%</fc> ** <fc=#FF0000>%date%</fc> %memory%"+ , template = "Uptime: <fc=#00FF00>%uptime%</fc> ** <fc=#FF0000>%date%</fc>" } -- | 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+-- 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 appearing in this function's type -- signature.-runnableTypes :: (Command,())+runnableTypes :: (Command,(Monitors,())) runnableTypes = undefined
Main.hs view
@@ -1,6 +1,6 @@ ----------------------------------------------------------------------------- -- |--- Module : XMobar.Main+-- Module : Xmobar.Main -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- @@ -8,7 +8,7 @@ -- Stability : unstable -- Portability : unportable ----- The main module of XMobar, a status bar for the Xmonad Window Manager +-- The main module of Xmobar, a text based status bar -- ----------------------------------------------------------------------------- @@ -19,11 +19,15 @@ , readDefaultConfig ) where -import XMobar+import Xmobar import Parsers import Config++import Data.IORef+import System.Console.GetOpt+import System.Exit import System.Environment-import System.IO.Error+import System.Posix.Files -- $main @@ -31,28 +35,122 @@ main :: IO () main = do args <- getArgs- config <- case args of- [cfgfile] -> readConfig cfgfile- _ -> readDefaultConfig+ (o,file) <- getOpts args+ conf <- case file of+ [cfgfile] -> readConfig cfgfile+ _ -> readDefaultConfig+ c <- newIORef conf + doOpts c o+ config <- readIORef c cl <- parseTemplate config (template config) var <- execCommands config cl (d,w) <- createWin config- runXMobar config var d w eventLoop+ eventLoop config var d w+ return () -- | Reads the configuration files or quits with an error readConfig :: FilePath -> IO Config readConfig f = - do s <- readFile f+ do file <- fileExist f+ s <- if file then readFile f else error $ f ++ ": file not found!\n" ++ usage case reads s of [(config,_)] -> return config- [] -> error ("Corrupt config file: " ++ f)+ [] -> error $ f ++ ": configuration file contains errors!\n" ++ usage _ -> error ("Some problem occured. Aborting...") --- | Read default configuration or quit with an error+-- | Read default configuration file or load the default config readDefaultConfig :: IO Config readDefaultConfig = do home <- getEnv "HOME" let path = home ++ "/.xmobarrc"- catch (readConfig path)- (\e -> if isUserError e then ioError e else return defaultConfig)+ f <- fileExist path+ if f then readConfig path else return defaultConfig +data Opts = Help+ | Version + | Font String+ | BgColor String+ | FgColor String+ | XPos String+ | YPos String+ | Width String+ | Height String+ | Align String+ | Refresh String+ | Commands String+ | SepChar String+ | Template 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 ['x'] ["xpos"] (ReqArg XPos "x pos") "The x position. Default 0"+ , Option ['y'] ["ypos"] (ReqArg YPos "y pos") "The y position. Default 0"+ , Option ['W'] ["width"] (ReqArg Width "width") "The status bar width. Default 1024"+ , Option ['H'] ["height"] (ReqArg Height "height") "The status bar height. Default 15"+ , Option ['a'] ["align"] (ReqArg Align "align") "The text alignment: center, left or right.\nDefault: left"+ , Option ['r'] ["refresh"] (ReqArg Refresh "rate") "The refresh rate in tenth of seconds:\ndefault 1 sec."+ , Option ['s'] ["sepchar"] (ReqArg SepChar "char") "The character used to separate commands in\nthe output template. Default '%'"+ , Option ['t'] ["template"] (ReqArg Template "tempate") "The output template"+ , Option ['c'] ["commands"] (ReqArg Commands "commands") "The list of commands to be executed"+ ]++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++version :: String+version = "Xmobar 0.7 (C) 2007 Andrea Rossato " ++ mail ++ license++mail :: String+mail = "<andrea.rossato@unibz.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 version >> 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+ XPos s -> modifyIORef conf (\c -> c { xPos = readInt s c xPos}) >> go+ YPos s -> modifyIORef conf (\c -> c { yPos = readInt s c yPos }) >> go+ Width s -> modifyIORef conf (\c -> c { width = readInt s c width }) >> go+ Height s -> modifyIORef conf (\c -> c { height = readInt s c height }) >> go+ Align s -> modifyIORef conf (\c -> c { align = s }) >> go+ Refresh s -> modifyIORef conf (\c -> c { refresh = readInt s c refresh }) >> go+ SepChar s -> modifyIORef conf (\c -> c { sepChar = s }) >> go+ Template s -> modifyIORef conf (\c -> c { template = s }) >> 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"+ readInt str c f =+ case readStr str of+ [x] -> x+ _ -> f c+ readStr str =+ [x | (x,t) <- reads str, ("","") <- lex t]+ go = doOpts conf oo
− Monitors/Batt.hs
@@ -1,67 +0,0 @@--------------------------------------------------------------------------------- |--- Module : 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 Monitors.Batt where--import qualified Data.ByteString.Lazy.Char8 as B-import System.Posix.Files--import Monitors.Common--battConfig :: IO MConfig-battConfig = mkMConfig- "Batt: <left>" -- template- ["left"] -- available replacements--fileB1 :: (String, String)-fileB1 = ("/proc/acpi/battery/BAT1/info", "/proc/acpi/battery/BAT1/state")--fileB2 :: (String, String)-fileB2 = ("/proc/acpi/battery/BAT2/info", "/proc/acpi/battery/BAT2/state")--checkFileBatt :: (String, String) -> IO Bool-checkFileBatt (i,_) =- fileExist i--readFileBatt :: (String, String) -> IO (B.ByteString, B.ByteString)-readFileBatt (i,s) = - do a <- B.readFile i- b <- B.readFile s- return (a,b)--parseBATT :: IO Float-parseBATT =- do (a1,b1) <- readFileBatt fileB1- c <- checkFileBatt fileB2- let sp p s = read $ stringParser p s- (fu, pr) = (sp (3,2) a1, sp (2,4) b1)- case c of- True -> do (a2,b2) <- readFileBatt fileB1- let full = fu + (sp (3,2) a2)- present = pr + (sp (2,4) b2)- return $ present / full- _ -> return $ pr / fu---formatBatt :: Float -> Monitor [String] -formatBatt x =- do let f s = floatToPercent (s / 100)- l <- showWithColors f (x * 100)- return [l]--runBatt :: [String] -> Monitor String-runBatt _ =- do c <- io $ parseBATT- l <- formatBatt c- parseTemplate l
− Monitors/Common.hs
@@ -1,286 +0,0 @@--------------------------------------------------------------------------------- |--- Module : 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 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- , showWithColors- , takeDigits- , floatToPercent- , stringParser- -- * Threaded Actions- -- $thread- , doActionTwiceWithDelay- ) 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 Numeric--import Text.ParserCombinators.Parsec--import System.Console.GetOpt---- $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]- } ---- | 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- return $ MC nc l lc h hc t e--data Opts = HighColor String- | NormalColor String- | LowColor String- | Low String- | High String- | Template 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."- ]--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- 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--runM :: [String] -> IO MConfig -> ([String] -> Monitor String) -> IO String-runM args conf action =- do c <- conf- let ac = doArgs args action- runReaderT ac c--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 <- many $ noneOf "<"- ; (_,com,_) <- templateCommandParser- ; ss <- many $ noneOf "<"- ; return (s, com, ss)- } ---- | Parses the command part of the template string-templateCommandParser :: Parser (String,String,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--floatToPercent :: Float -> String-floatToPercent n = - showFFloat (Just 2) (n*100) "%" --stringParser :: Pos -> B.ByteString -> String-stringParser (x,y) =- flip (!!) x . map B.unpack . B.words . flip (!!) y . B.lines--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>"--showWithColors :: (Float -> String) -> Float -> Monitor String-showWithColors f x =- do h <- getConfigValue high- l <- getConfigValue low- let col = setColor $ f x- head $ [col highColor | x > fromIntegral h ] ++- [col normalColor | x > fromIntegral l ] ++- [col lowColor | True]---- $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)
− Monitors/Cpu.hs
@@ -1,53 +0,0 @@--------------------------------------------------------------------------------- |--- Module : 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 Monitors.Cpu where--import Monitors.Common-import qualified Data.ByteString.Lazy.Char8 as B--cpuConfig :: IO MConfig-cpuConfig = mkMConfig- "Cpu: <total>" -- template- ["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 x =- do let f s = floatToPercent (s / 100)- t = foldr (+) 0 $ take 3 x- list = t:x- mapM (showWithColors f) . map (* 100) $ list--runCpu :: [String] -> Monitor String-runCpu _ =- do c <- io $ parseCPU- l <- formatCpu c- parseTemplate l
− Monitors/Mem.hs
@@ -1,47 +0,0 @@--------------------------------------------------------------------------------- |--- Module : 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 Monitors.Mem where--import Monitors.Common--memConfig :: IO MConfig-memConfig = mkMConfig- "Mem: <usedratio>% (<cache>M)" -- template- ["total", "free", "buffer", -- available replacements- "cache", "rest", "used", "usedratio"]--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 * 100 / total- return [total, free, buffer, cache, rest, used, usedratio]--formatMem :: [Float] -> Monitor [String]-formatMem x =- do let f n = show (takeDigits 2 n)- mapM (showWithColors f) x--runMem :: [String] -> Monitor String-runMem _ =- do m <- io $ parseMEM- l <- formatMem m- parseTemplate l
− Monitors/Net.hs
@@ -1,99 +0,0 @@--------------------------------------------------------------------------------- |--- Module : 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 Monitors.Net where--import 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"] -- available replacements----- takes to element of a list given their indexes-getTwoElementsAt :: Int -> Int -> [a] -> [a]-getTwoElementsAt x y xs =- z : [zz]- where z = xs !! x- zz = xs !! y---- split a list of strings returning a list with: 1. the first part of--- the split; 2. the second part of the split without the Char; 3. the--- rest of the list. For instance: ------ > splitAtChar ':' ["lo:31174097","31174097"] ------ will become ["lo","31174097","31174097"]-splitAtChar :: Char -> [String] -> [String]-splitAtChar c xs =- first : (rest xs)- where rest = map $ \x -> if (c `elem` x) then (tail $ dropWhile (/= c) x) else x- first = head $ map (takeWhile (/= c)) . filter (\x -> (c `elem` x)) $ xs--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 . map (splitAtChar ':') . map (getTwoElementsAt 0 8) . map (words . B.unpack) . drop 2 . B.lines--formatNet :: Float -> Monitor String-formatNet d =- showWithColors f d- where f s = show s ++ "Kb"--printNet :: NetDev -> Monitor String-printNet nd =- do case nd of- ND d r t -> do rx <- formatNet r- tx <- formatNet t- parseTemplate [d,rx,tx]- 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
− Monitors/Swap.hs
@@ -1,50 +0,0 @@--------------------------------------------------------------------------------- |--- Module : 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 Monitors.Swap where--import 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 p x y = flip (/) 1024 . read . stringParser x $ y- tot = p (1,11) file- free = p (1,12) file- return [tot, (tot - free), free, (tot - free) / tot]--formatSwap :: [Float] -> Monitor [String] -formatSwap x =- do let f1 n = show (takeDigits 2 n)- f2 n = floatToPercent n- (hd, tl) = splitAt 3 x- firsts <- mapM (showWithColors f1) hd- lasts <- mapM (showWithColors f2) tl- return $ firsts ++ lasts--runSwap :: [String] -> Monitor String-runSwap _ =- do m <- io $ parseMEM- l <- formatSwap m- parseTemplate l
− Monitors/Weather.hs
@@ -1,129 +0,0 @@--------------------------------------------------------------------------------- |--- Module : 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 Monitors.Weather where--import Monitors.Common--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- , temperature :: Float- , dewPoint :: String- , humidity :: Float- , pressure :: String- } 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 Float-pTemp = do manyTill anyChar $ char '('- s <- manyTill digit $ (char ' ' <|> char '.')- skipRestOfLine- return $read s--pRh :: Parser Float-pRh = do s <- manyTill digit $ (char '%' <|> char '.')- 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: "- temp <- pTemp- dp <- getAfterString "Dew Point: "- skipTillString "Relative Humidity: "- rh <- pRh- p <- getAfterString "Pressure (altimeter): "- manyTill skipRestOfLine eof- return $ [WI st ss y m d h w v sk temp 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- return str- _ -> do closeHandles- return "Could not retrieve data"--formatWeather :: [WeatherInfo] -> Monitor String-formatWeather [(WI st ss y m d h w v sk temp dp r p)] =- do cel <- showWithColors show temp- far <- showWithColors (show . takeDigits 1) (((9 / 5) * temp) + 32)- rh <- showWithColors show r- parseTemplate [st, ss, y, m, d, h, w, v, sk, cel, far, dp, rh , p ]-formatWeather _ = return "N/A"--runWeather :: [String] -> Monitor String-runWeather str =- do d <- io $ getData $ head str- i <- io $ runP parseData d- formatWeather i
Parsers.hs view
@@ -1,6 +1,6 @@ ----------------------------------------------------------------------------- -- |--- Module : XMobar.Parsers+-- Module : Xmobar.Parsers -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- @@ -8,7 +8,7 @@ -- Stability : unstable -- Portability : unportable ----- Parsers needed for XMobar, a status bar for the Xmonad Window Manager +-- Parsers needed for Xmobar, a text based status bar -- -----------------------------------------------------------------------------
Plugins/HelloWorld.hs view
@@ -8,7 +8,7 @@ -- Stability : unstable -- Portability : unportable ----- A plugin example for XMobar, a status bar for the Xmonad Window Manager +-- A plugin example for Xmobar, a text based status bar -- -----------------------------------------------------------------------------
+ Plugins/Monitors.hs view
@@ -0,0 +1,60 @@+-----------------------------------------------------------------------------+-- |+-- 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.Batt++data Monitors = Weather Station Args Rate+ | Network Interface Args Rate+ | Memory Args Rate+ | Swap Args Rate+ | Cpu Args Rate+ | Battery Args Rate+ deriving (Show,Read,Eq)++type Args = [String]+type Program = String+type Alias = String+type Station = String+type Interface = String+type Rate = Int++instance Exec Monitors where+ alias (Weather s _ _) = s+ alias (Network i _ _) = i+ alias (Memory _ _) = "memory"+ alias (Swap _ _) = "swap"+ alias (Cpu _ _) = "cpu"+ alias (Battery _ _) = "battery"+ rate (Weather _ _ r) = r+ rate (Network _ _ r) = r+ rate (Memory _ r) = r+ rate (Swap _ r) = r+ rate (Cpu _ r) = r+ rate (Battery _ r) = r+ run (Weather s a _) = runM (a ++ [s]) weatherConfig runWeather + run (Network i a _) = runM (a ++ [i]) netConfig runNet+ run (Memory args _) = runM args memConfig runMem+ run (Swap args _) = runM args swapConfig runSwap+ run (Cpu args _) = runM args cpuConfig runCpu+ run (Battery args _) = runM args battConfig runBatt
+ Plugins/Monitors/Batt.hs view
@@ -0,0 +1,68 @@+-----------------------------------------------------------------------------+-- |+-- 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 + | NA++battConfig :: IO MConfig+battConfig = mkMConfig+ "Batt: <left>" -- template+ ["left"] -- available replacements++fileB1 :: (String, String)+fileB1 = ("/proc/acpi/battery/BAT1/info", "/proc/acpi/battery/BAT1/state")++fileB2 :: (String, String)+fileB2 = ("/proc/acpi/battery/BAT2/info", "/proc/acpi/battery/BAT2/state")++readFileBatt :: (String, String) -> IO (B.ByteString, B.ByteString)+readFileBatt (i,s) = + do a <- rf i+ b <- rf s+ return (a,b)+ where rf file = do+ f <- fileExist file+ if f then B.readFile file else return B.empty++parseBATT :: IO Batt+parseBATT =+ do (a1,b1) <- readFileBatt fileB1+ (a2,b2) <- readFileBatt fileB2+ let sp p s = case stringParser p s of+ [] -> 0+ x -> read x+ (f1, p1) = (sp (3,2) a1, sp (2,4) b1)+ (f2, p2) = (sp (3,2) a2, sp (2,4) b2)+ left = (p1 + p2) / (f1 + f2) --present / full+ return $ if isNaN left then NA else Batt left++formatBatt :: Float -> Monitor [String] +formatBatt x =+ do let f s = floatToPercent (s / 100)+ l <- showWithColors f (x * 100)+ return [l]++runBatt :: [String] -> Monitor String+runBatt _ =+ do c <- io $ parseBATT+ case c of+ Batt x -> do l <- formatBatt x+ parseTemplate l + NA -> return "N/A"
+ Plugins/Monitors/Common.hs view
@@ -0,0 +1,295 @@+-----------------------------------------------------------------------------+-- |+-- 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+ , showWithColors+ , takeDigits+ , showDigits+ , floatToPercent+ , stringParser+ -- * Threaded Actions+ -- $thread+ , doActionTwiceWithDelay+ ) 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++-- $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]+ } ++-- | 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+ return $ MC nc l lc h hc t e++data Opts = HighColor String+ | NormalColor String+ | LowColor String+ | Low String+ | High String+ | Template 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."+ ]++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+ 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++runM :: [String] -> IO MConfig -> ([String] -> Monitor String) -> IO String+runM args conf action =+ do c <- conf+ let ac = doArgs args action+ runReaderT ac c++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 <- many $ noneOf "<"+ ; (_,com,_) <- templateCommandParser+ ; ss <- many $ noneOf "<"+ ; return (s, com, ss)+ } ++-- | Parses the command part of the template string+templateCommandParser :: Parser (String,String,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 ""++floatToPercent :: Float -> String+floatToPercent n = + showDigits 2 (n * 100) ++ "%"++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>"++showWithColors :: (Float -> String) -> Float -> Monitor String+showWithColors f x =+ do h <- getConfigValue high+ l <- getConfigValue low+ let col = setColor $ f x+ [ll,hh] = map fromIntegral $ sort [l, h] -- consider high < low + head $ [col highColor | x > hh ] +++ [col normalColor | x > ll ] +++ [col lowColor | True]++-- $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)
+ Plugins/Monitors/Cpu.hs view
@@ -0,0 +1,53 @@+-----------------------------------------------------------------------------+-- |+-- 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+ ["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 x =+ do let f s = floatToPercent (s / 100)+ t = foldr (+) 0 $ take 3 x+ list = t:x+ mapM (showWithColors f) . map (* 100) $ list++runCpu :: [String] -> Monitor String+runCpu _ =+ do c <- io $ parseCPU+ l <- formatCpu c+ parseTemplate l
+ Plugins/Monitors/Mem.hs view
@@ -0,0 +1,47 @@+-----------------------------------------------------------------------------+-- |+-- 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 where++import Plugins.Monitors.Common++memConfig :: IO MConfig+memConfig = mkMConfig+ "Mem: <usedratio>% (<cache>M)" -- template+ ["total", "free", "buffer", -- available replacements+ "cache", "rest", "used", "usedratio"]++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 * 100 / total+ return [total, free, buffer, cache, rest, used, usedratio]++formatMem :: [Float] -> Monitor [String]+formatMem x =+ do let f n = showDigits 2 n+ mapM (showWithColors f) x++runMem :: [String] -> Monitor String+runMem _ =+ do m <- io $ parseMEM+ l <- formatMem m+ parseTemplate l
+ Plugins/Monitors/Net.hs view
@@ -0,0 +1,99 @@+-----------------------------------------------------------------------------+-- |+-- 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"] -- available replacements+++-- takes two elements of a list given their indexes+getTwoElementsAt :: Int -> Int -> [a] -> [a]+getTwoElementsAt x y xs =+ z : [zz]+ where z = xs !! x+ zz = xs !! y++-- split a list of strings returning a list with: 1. the first part of+-- the split; 2. the second part of the split without the Char; 3. the+-- rest of the list. For instance: +--+-- > splitAtChar ':' ["lo:31174097","31174097"] +--+-- will become ["lo","31174097","31174097"]+splitAtChar :: Char -> [String] -> [String]+splitAtChar c xs =+ first : (rest xs)+ where rest = map $ \x -> if (c `elem` x) then (tail $ dropWhile (/= c) x) else x+ first = head $ map (takeWhile (/= c)) . filter (\x -> (c `elem` x)) $ xs++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 . map (splitAtChar ':') . map (getTwoElementsAt 0 8) . map (words . B.unpack) . drop 2 . B.lines++formatNet :: Float -> Monitor String+formatNet d =+ showWithColors f d+ where f s = showDigits 1 s ++ "Kb"++printNet :: NetDev -> Monitor String+printNet nd =+ do case nd of+ ND d r t -> do rx <- formatNet r+ tx <- formatNet t+ parseTemplate [d,rx,tx]+ 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 view
@@ -0,0 +1,50 @@+-----------------------------------------------------------------------------+-- |+-- 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 p x y = flip (/) 1024 . read . stringParser x $ y+ tot = p (1,11) file+ free = p (1,12) file+ return [tot, (tot - free), free, (tot - free) / tot]++formatSwap :: [Float] -> Monitor [String] +formatSwap x =+ do let f1 n = showDigits 2 n+ f2 n = floatToPercent n+ (hd, tl) = splitAt 3 x+ firsts <- mapM (showWithColors f1) hd+ lasts <- mapM (showWithColors f2) tl+ return $ firsts ++ lasts++runSwap :: [String] -> Monitor String+runSwap _ =+ do m <- io $ parseMEM+ l <- formatSwap m+ parseTemplate l
+ Plugins/Monitors/Weather.hs view
@@ -0,0 +1,129 @@+-----------------------------------------------------------------------------+-- |+-- 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 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+ , temperature :: Float+ , dewPoint :: String+ , humidity :: Float+ , pressure :: String+ } 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 Float+pTemp = do manyTill anyChar $ char '('+ s <- manyTill digit $ (char ' ' <|> char '.')+ skipRestOfLine+ return $read s++pRh :: Parser Float+pRh = do s <- manyTill digit $ (char '%' <|> char '.')+ 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: "+ temp <- pTemp+ dp <- getAfterString "Dew Point: "+ skipTillString "Relative Humidity: "+ rh <- pRh+ p <- getAfterString "Pressure (altimeter): "+ manyTill skipRestOfLine eof+ return $ [WI st ss y m d h w v sk temp 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+ return str+ _ -> do closeHandles+ return "Could not retrieve data"++formatWeather :: [WeatherInfo] -> Monitor String+formatWeather [(WI st ss y m d h w v sk temp dp r p)] =+ do cel <- showWithColors show temp+ far <- showWithColors (showDigits 1) (((9 / 5) * temp) + 32)+ rh <- showWithColors show r+ parseTemplate [st, ss, y, m, d, h, w, v, sk, cel, far, dp, rh , p ]+formatWeather _ = return "N/A"++runWeather :: [String] -> Monitor String+runWeather str =+ do d <- io $ getData $ head str+ i <- io $ runP parseData d+ formatWeather i
README view
@@ -1,22 +1,39 @@-XMobar - a status bar for the XMonad Window Manager+Xmobar - A Minimalistic Text Based Status Bar ABOUT ===== -Xmobar is a minimalistic, text based, status bar, designed for the-XMonad Window Manager.+Xmobar is a minimalistic, text based, status bar. -It was inspired by the Ion3 status bar, and supports similar features.+It was inspired by the Ion3 status bar, and supports similar features,+like dynamic color management, output templates, and extensibility+through plugins.+ See xmobar.config-sample for a sample configuration. Try it with: xmobar xmobar.config-sample +DOWNLOAD+========++You can get the Xmobar source code from Hackage:+http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmobar++To get the darcs source run:+darcs get http://gorgias.mine.nu/repos/xmobar/++The latest binary can be found here:+http://gorgias.mine.nu/xmobar/xmobar-0.7.bin++A recent screen shot can be found here:+http://gorgias.mine.nu/xmobar/xmobar-0.7.png+ INSTALLATION ============ -tar xvfz xmobar-0.6-cd xmobar-0.6+tar xvfz xmobar-0.7+cd xmobar-0.7 runhaskell Setup.lhs configure --prefix=/usr/local runhaskell Setup.lhs build runhaskell Setup.lhs haddock (optional for building the code documentation)@@ -49,9 +66,9 @@ font: Name of the font to be used bgColor: Backgroud color fgColor: Default font color-xPos: x position (origin in the upper left corner) of the XMobar window +xPos: x position (origin in the upper left corner) of the Xmobar window yPos: y position-width: width of the XMobar window +width: width of the Xmobar window height: height align: text alignment refresh: Refresh rate in tenth of seconds@@ -60,17 +77,52 @@ output template (default '%') template: The output template +Command Line Options+--------------------++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.++Example:+xmobar -B white -a right -F blue -t '%LIPB%' -c '[Run Weather "LIPB" [] 36000]'++This is the list of command line options (the output of +xmobar --help):++Usage: xmobar [OPTION...] [FILE]+Options:+ -h, -? --help This help+ -V --version Show version information+ -f font name --font=font name The font name+ -B bg color --bgcolor=bg color The background color. Default black+ -F fg color --fgcolor=fg color The foreground color. Default grey+ -x x pos --xpos=x pos The x position. Default 0+ -y y pos --ypos=y pos The y position. Default 0+ -W width --width=width The status bar width. Default 1024+ -H height --height=height The status bar height. Default 15+ -a align --align=align The text alignment: center, left or right.+ Default: left+ -r rate --refresh=rate The refresh rate in tenth of seconds:+ default 1 sec.+ -s char --sepchar=char The character used to separate commands in+ the output template. Default '%'+ -t tempate --template=tempate The output template+ -c commands --commands=commands The list of commands to be executed+Mail bug reports and suggestions to <andrea.rossato@unibz.it>+ 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 search (internal commands such as Weather or Network have default aliasing, 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 try to+If no command is found in the "commands" list, Xmobar will try to execute a program with the name found in the template. If the execution is not successful an error will be reported. @@ -78,16 +130,26 @@ ----------------------------------- 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. -Available template commands are: Weather, Network, Memory, Swap, Cpu,-Battery, and Com. This last one is used to execute external programs.+The option consists in a list of commands separated by a comma and+enclosed by square parenthesis. Example: +[Run Memory ["-t","Mem: <usedratio>%"] 10, Run Swap [] 10]++The only internal available command is Com (see below Executing+External Commands). But by default Xmobar comes with a plugin+consisting in a set of system monitors. This plugin installs the+following internal commands: Weather, Network, Memory, Swap, Cpu,+Battery.++To remove them see below Installing/Removing a Plugin+ Other commands can be created as plugins with the Plugin-infrastructure.+infrastructure. See below Writing a Plugin This is an example of a command in the "commands" list: Run Memory ["-t","Mem: <usedratio>%"] 10@@ -160,7 +222,7 @@ Commands' arguments must be set as a list. Es: 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:@@ -192,7 +254,7 @@ 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@@ -202,9 +264,9 @@ rate :: e -> Int alias :: e -> String -"run" must produce the IO String that will be displayed by XMobar.+"run" must produce the IO String that will be displayed by Xmobar. "rate" is the refresh rate for you plugin (the number of tenth of-seconds between two succesive runs);+seconds between two successive runs); "alias" is the name to be used in the output template. That requires importing the plugin API (the Exec class definition),@@ -221,26 +283,26 @@ to the type list in the type signature of Config.runnableTypes. For a vary basic example see Plugins/HelloWorld.hs that is distributed-with XMobar.+with Xmobar. -Installing a Plugin--------------------+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: 1. import the plugin module in Config.hs, by adding: import Plugins.HelloWorld 2. add the plugin data type to the list of data types in the type- signauture of "runnableTypes" in Config.hs. For instance, for the- HelloWorld plugin, chnage "runnableTypes" into:+ signature of "runnableTypes" in Config.hs. For instance, for the+ HelloWorld plugin, change "runnableTypes" into: -runnableTypes :: (Command,(HelloWorld,()))+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 @@ -255,6 +317,23 @@ That's it. +To remove a plugin, just remove its type from the type signature of+runnableTypes and remove the imported modules.++To remove the system monitor plugin:++1. remove, from Config.hs, the line+import Plugins.Monitors++2. in Config.hs change+runnableTypes :: (Command,(Monitors,()))+runnableTypes = undefined+to+runnableTypes :: (Command,())+runnableTypes = undefined++3. rebuild Xmobar.+ AUTHOR ====== @@ -263,20 +342,25 @@ CREDITS ======= -Thanks to Robert Manea for his help in understanding how X works. He-gave me suggestions on how to solve many many problems with XMobar.+Thanks to Robert Manea and Spencer Janssen for their help in+understanding how X works. He gave me suggestions on how to solve many+problems with Xmobar. -XMobar incorporates patches from:-Krzysztof Kosciuszkiewicz+Thanks to Claus Reinke for make me understand existential types (or at+least for letting me thing I grasp existential types...;-). +Xmobar incorporates patches from: Krzysztof Kosciuszkiewicz and+Spencer Janssen. + LINKS ===== -The XMobar home page:+The Xmobar home page: http://gorgias.mine.nu/repos/xmobar/ -XMobars darcs repository:+Xmobars darcs repository: http://gorgias.mine.nu/repos/xmobar/ -The XMonad Window Manager-http://xmonad.org+To understand the internal mysteries of Xmobar try reading this:+http://www.haskell.org/haskellwiki/X_window_programming_in_Haskell+
Runnable.hs view
@@ -1,7 +1,7 @@ {-# OPTIONS -fglasgow-exts #-} ----------------------------------------------------------------------------- -- |--- Module : XMobar.Runnable+-- Module : Xmobar.Runnable -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) --
− XMobar.hs
@@ -1,254 +0,0 @@-{-# OPTIONS -fglasgow-exts #-}--------------------------------------------------------------------------------- |--- Module : XMobar--- Copyright : (c) Andrea Rossato--- License : BSD-style (see LICENSE)--- --- Maintainer : Andrea Rossato <andrea.rossato@unibz.it>--- Stability : unstable--- Portability : unportable------ A status bar for the Xmonad Window Manager -----------------------------------------------------------------------------------module XMobar (-- * Main Stuff- -- $main- Xbar- , runXMobar- , eventLoop- , createWin- -- * Printing- -- $print- , drawInWin- , printStrings- -- * Program Execution- -- $commands- , execCommands- , execCommand- , runCommandLoop- , readVariables- -- * Unmamaged Windows- -- $unmanwin- , mkUnmanagedWindow- -- * Useful Utilities- , initColor- , io- ) where--import Graphics.X11.Xlib-import Graphics.X11.Xlib.Misc--import Control.Monad.State-import Control.Monad.Reader-import Control.Concurrent--import Config-import Parsers-import Commands-import Runnable---- $main------ The XMobar data type and basic loops and functions.---- | This is just esthetics, stolen from XMonad: see 'runXMobar'-newtype Xbar a = X (ReaderT Config (StateT XState IO) a)- deriving (Functor, Monad, MonadIO, MonadState XState, MonadReader Config)---- | The State component of StateT-data XState = - XState { display :: Display- , window :: Window- , vars :: [(ThreadId, MVar String)]- }---- | Totally useless: but it is nice to be able to use get to get the--- state and ask to get the configuration: functions requires less--- arguments, after all.-runXMobar :: Config -> [(ThreadId, MVar String)] -> Display -> Window -> Xbar () -> IO ()-runXMobar c v d w (X f) = - do runStateT (runReaderT f c) (XState d w v)- return ()---- | The event loop-eventLoop :: Xbar ()-eventLoop =- do c <- ask- s <- get- i <- io $ readVariables (vars s)- ps <- io $ parseString c i- drawInWin ps- -- back again: we are never ending- io $ tenthSeconds (refresh c)- eventLoop---- | The function to create the initial window-createWin :: Config -> IO (Display, Window)-createWin config =- do dpy <- openDisplay ""- let dflt = defaultScreen dpy- rootw <- rootWindow dpy dflt- win <- mkUnmanagedWindow dpy (defaultScreenOfDisplay dpy) rootw - (fi $ xPos config) - (fi $ yPos config) - (fi $ width config) - (fi $ height config)- mapWindow dpy win- return (dpy,win)----- $print---- | Draws in and updates the window-drawInWin :: [(String, String)] -> Xbar ()-drawInWin str = - do config <- ask- st <- get- let (dpy,win) = (display st, window st)- bgcolor <- io $ initColor dpy $ bgColor config- gc <- io $ createGC dpy win- --let's get the fonts- fontst <- io $ loadQueryFont dpy (font config)- io $ setFont dpy gc (fontFromFontStruct fontst)- -- create a pixmap to write to and fill it with a rectangle- p <- io $ createPixmap dpy win - (fi (width config)) - (fi (height config)) - (defaultDepthOfScreen (defaultScreenOfDisplay dpy))- -- the fgcolor of the rectangle will be the bgcolor of the window- io $ setForeground dpy gc bgcolor- io $ fillRectangle dpy p gc 0 0 - (fi $ width config) - (fi $ height config)- -- write to the pixmap the new string- let strWithLenth = map (\(s,c) -> (s,c,textWidth fontst s)) str- p' <- printStrings p gc fontst 1 strWithLenth - -- copy the pixmap with the new string to the window- io $ copyArea dpy p' win gc 0 0 (fi (width config)) (fi (height config)) 0 0- -- free up everything (we do not want to leak memory!)- io $ freeFont dpy fontst- io $ freeGC dpy gc- io $ freePixmap dpy p'- -- resync- io $ sync dpy True---- | An easy way to print the stuff we need to print-printStrings :: Drawable - -> GC- -> FontStruct- -> Position- -> [(String, String, Position)]- -> Xbar Pixmap-printStrings p _ _ _ [] = return p-printStrings p gc fontst offs sl@((s,c,l):xs) =- do config <- ask- st <- get- let (_,asc,_,_) = textExtents fontst s- totSLen = foldr (\(_,_,len) -> (+) len) 0 sl- valign = (fi (height config) + fi asc) `div` 2- remWidth = fi (width config) - fi totSLen- offset = case (align config) of- "center" -> (remWidth + offs) `div` 2- "right" -> remWidth - 1- "left" -> offs- _ -> offs- fgcolor <- io $ initColor (display st) c- bgcolor <- io $ initColor (display st) (bgColor config)- io $ setForeground (display st) gc fgcolor- io $ setBackground (display st) gc bgcolor- io $ drawImageString (display st) p gc offset valign s- p' <- printStrings p gc fontst (offs + l) xs- return p'---- $commands---- | Runs a list of programs as independent threads and returns their thread id--- and the MVar they will be writing to.-execCommands :: Config -> [(Runnable,String,String)] -> IO [(ThreadId, MVar String)]-execCommands _ [] = return []-execCommands c (x:xs) =- do i <- execCommand c x- is <- execCommands c xs- return $ i : is--execCommand :: Config -> (Runnable,String,String) -> IO (ThreadId, MVar String)-execCommand c com = - do var <- newMVar "Updating..."- h <- forkIO $ runCommandLoop var c com- return (h,var)--runCommandLoop :: MVar String -> Config -> (Runnable,String,String) -> IO ()-runCommandLoop var conf c@(com,s,ss)- | alias com == "" = - do modifyMVar_ var (\_ -> return $ "Could not parse the template")- tenthSeconds (refresh conf)- runCommandLoop var conf c- | otherwise =- do str <- run com- modifyMVar_ var (\_ -> return $ s ++ str ++ ss)- tenthSeconds (rate com) - runCommandLoop var conf c---- | Reads MVars set by 'runCommandLoop'-readVariables :: [(ThreadId, MVar String)] -> IO String-readVariables [] = return ""-readVariables ((_,v):xs) =- do f <- readMVar v- fs <- readVariables xs- return $! f ++ fs--{- $unmanwin--This is a way to create unmamaged window. It was a mistery in Haskell. -Till I've found out...;-)---}---- | Creates a window with the attribute override_redirect set to True.--- Windows Managers should not touch this kind of windows.-mkUnmanagedWindow :: Display- -> Screen- -> Window- -> Position- -> Position- -> Dimension- -> Dimension- -> IO Window-mkUnmanagedWindow dpy scr rw x y w h = do- let visual = defaultVisualOfScreen scr- attrmask = cWOverrideRedirect- win <- allocaSetWindowAttributes $ - \attributes -> do- set_override_redirect attributes True- createWindow dpy rw x y w h 0 (defaultDepthOfScreen scr) - inputOutput visual attrmask attributes - return win--{- $utility-Utilities, aka stollen without givin' credit stuff.--}---- | Get the Pixel value for a named color-initColor :: Display -> String -> IO Pixel-initColor dpy c = (color_pixel . fst) `liftM` allocNamedColor dpy colormap c- where colormap = defaultColormap dpy (defaultScreen dpy)---- | Short-hand for lifting in the IO monad-io :: IO a -> Xbar a-io = liftIO---- | 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---- | Short-hand for 'fromIntegral'-fi :: (Integral a, Num b) => a -> b-fi = fromIntegral
+ Xmobar.hs view
@@ -0,0 +1,285 @@+{-# OPTIONS -fglasgow-exts #-}+-----------------------------------------------------------------------------+-- |+-- Module : Xmobar+-- Copyright : (c) Andrea Rossato+-- License : BSD-style (see LICENSE)+-- +-- Maintainer : Andrea Rossato <andrea.rossato@unibz.it>+-- Stability : unstable+-- Portability : unportable+--+-- A status bar for the Xmonad Window Manager +--+-----------------------------------------------------------------------------++module Xmobar (-- * Main Stuff+ -- $main+ Xbar+ , runXbar+ , eventLoop+ , createWin+ , updateWin+ -- * Printing+ -- $print+ , drawInWin+ , printStrings+ -- * Program Execution+ -- $commands+ , execCommands+ , execCommand+ , runCommandLoop+ , readVariables+ -- * Unmamaged Windows+ -- $unmanwin+ , mkUnmanagedWindow+ -- * Useful Utilities+ , initColor+ , io+ ) where++import Prelude hiding (catch)+import Graphics.X11.Xlib+import Graphics.X11.Xlib.Misc+import Graphics.X11.Xlib.Event++import Control.Monad.State+import Control.Monad.Reader+import Control.Concurrent+import Control.Exception++import System.Posix.Types (Fd(..))++import Config+import Parsers+import Commands+import Runnable++-- $main+--+-- The Xmobar data type and basic loops and functions.++-- | This is copied from XMonad.+newtype Xbar a = X (ReaderT Config (StateT XState IO) a)+ deriving (Functor, Monad, MonadIO, MonadState XState, MonadReader Config)++-- | The State component of StateT+data XState = + XState { display :: Display+ , window :: Window+ , vars :: [(ThreadId, MVar String)]+ }++-- | We use get to get the state and ask to get the configuration: whis way +-- functions requires less arguments.+runXbar :: Config -> [(ThreadId, MVar String)] -> Display -> Window -> Xbar () -> IO ()+runXbar c v d w (X f) = + do runStateT (runReaderT f c) (XState d w v)+ return ()++-- | 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++-- | The event loop+eventLoop :: Config -> [(ThreadId, MVar String)] -> Display -> Window -> IO ()+eventLoop c v d w = do+ t <- forkIO (block go)+ timer t+ where+ -- interrupt the drawing thread every so often+ timer t = do+ tenthSeconds (refresh c)+ throwTo t (ErrorCall "Xmobar.eventLoop: yield")+ timer t+ -- Continuously wait for a timer interrupt or an expose event+ go = do+ runXbar c v d w updateWin+ catch (unblock $ allocaXEvent $ nextEvent' d) (const $ return ())+ go++-- | The function to create the initial window+createWin :: Config -> IO (Display, Window)+createWin config =+ do dpy <- openDisplay ""+ let dflt = defaultScreen dpy+ rootw <- rootWindow dpy dflt+ win <- mkUnmanagedWindow dpy (defaultScreenOfDisplay dpy) rootw + (fi $ xPos config) + (fi $ yPos config) + (fi $ width config) + (fi $ height config)+ selectInput dpy win exposureMask+ mapWindow dpy win+ return (dpy,win)++updateWin :: Xbar ()+updateWin =+ do c <- ask+ s <- get+ i <- io $ readVariables (vars s)+ ps <- io $ parseString c i+ drawInWin ps++-- $print++-- | Draws in and updates the window+drawInWin :: [(String, String)] -> Xbar ()+drawInWin str = + do config <- ask+ st <- get+ let (dpy,win) = (display st, window st)+ bgcolor <- io $ initColor dpy $ bgColor config+ gc <- io $ createGC dpy win+ --let's get the fonts+ let lf c = loadQueryFont dpy (font c)+ fontst <- io $ catch (lf config) (const $ lf defaultConfig)+ io $ setFont dpy gc (fontFromFontStruct fontst)+ -- create a pixmap to write to and fill it with a rectangle+ p <- io $ createPixmap dpy win + (fi (width config)) + (fi (height config)) + (defaultDepthOfScreen (defaultScreenOfDisplay dpy))+ -- the fgcolor of the rectangle will be the bgcolor of the window+ io $ setForeground dpy gc bgcolor+ io $ fillRectangle dpy p gc 0 0 + (fi $ width config) + (fi $ height config)+ -- write to the pixmap the new string+ let strWithLenth = map (\(s,c) -> (s,c,textWidth fontst s)) str+ printStrings p gc fontst 1 strWithLenth + -- copy the pixmap with the new string to the window+ io $ copyArea dpy p win gc 0 0 (fi (width config)) (fi (height config)) 0 0+ -- free up everything (we do not want to leak memory!)+ io $ freeFont dpy fontst+ io $ freeGC dpy gc+ io $ freePixmap dpy p+ -- resync+ io $ sync dpy True++-- | An easy way to print the stuff we need to print+printStrings :: Drawable + -> GC+ -> FontStruct+ -> Position+ -> [(String, String, Position)]+ -> Xbar ()+printStrings _ _ _ _ [] = return ()+printStrings d gc fontst offs sl@((s,c,l):xs) =+ do config <- ask+ st <- get+ let (_,asc,_,_) = textExtents fontst s+ totSLen = foldr (\(_,_,len) -> (+) len) 0 sl+ valign = (fi (height config) + fi asc) `div` 2+ remWidth = fi (width config) - fi totSLen+ offset = case (align config) of+ "center" -> (remWidth + offs) `div` 2+ "right" -> remWidth - 1+ "left" -> offs+ _ -> offs+ fgcolor <- io $ initColor (display st) c+ bgcolor <- io $ initColor (display st) (bgColor config)+ io $ setForeground (display st) gc fgcolor+ io $ setBackground (display st) gc bgcolor+ io $ drawImageString (display st) d gc offset valign s+ printStrings d gc fontst (offs + l) xs++-- $commands++-- | Runs a list of programs as independent threads and returns their thread id+-- and the MVar they will be writing to.+execCommands :: Config -> [(Runnable,String,String)] -> IO [(ThreadId, MVar String)]+execCommands c xs = mapM (execCommand c) xs++execCommand :: Config -> (Runnable,String,String) -> IO (ThreadId, MVar String)+execCommand c com = + do var <- newMVar "Updating..."+ h <- forkIO $ runCommandLoop var c com+ return (h,var)++runCommandLoop :: MVar String -> Config -> (Runnable,String,String) -> IO ()+runCommandLoop var conf c@(com,s,ss)+ | alias com == "" = + do modifyMVar_ var (\_ -> return $ "Could not parse the template")+ tenthSeconds (refresh conf)+ runCommandLoop var conf c+ | otherwise =+ do str <- run com+ modifyMVar_ var (\_ -> return $ s ++ str ++ ss)+ tenthSeconds (rate com) + runCommandLoop var conf c++-- | Reads MVars set by 'runCommandLoop'+readVariables :: [(ThreadId, MVar String)] -> IO String+readVariables [] = return ""+readVariables ((_,v):xs) =+ do f <- readMVar v+ fs <- readVariables xs+ return $! f ++ fs++{- $unmanwin++This is a way to create unmamaged window. It was a mistery in Haskell. +Till I've found out...;-)++-}++-- | Creates a window with the attribute override_redirect set to True.+-- Windows Managers should not touch this kind of windows.+mkUnmanagedWindow :: Display+ -> Screen+ -> Window+ -> Position+ -> Position+ -> Dimension+ -> Dimension+ -> IO Window+mkUnmanagedWindow dpy scr rw x y w h = do+ let visual = defaultVisualOfScreen scr+ attrmask = cWOverrideRedirect+ win <- allocaSetWindowAttributes $ + \attributes -> do+ set_override_redirect attributes True+ createWindow dpy rw x y w h 0 (defaultDepthOfScreen scr) + inputOutput visual attrmask attributes + return win++{- $utility+Utilities, aka stollen without givin' credit stuff.+-}++-- | Get the Pixel value for a named color: if an invalid name is+-- given the black pixel will be returned.+initColor :: Display -> String -> IO Pixel+initColor dpy c =+ catch (initColor' dpy c) (const $ return $ blackPixel dpy (defaultScreen dpy))++initColor' :: Display -> String -> IO Pixel+initColor' dpy c = (color_pixel . fst) `liftM` allocNamedColor dpy colormap c+ where colormap = defaultColormap dpy (defaultScreen dpy)++-- | Short-hand for lifting in the IO monad+io :: IO a -> Xbar a+io = liftIO++-- | 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++-- | Short-hand for 'fromIntegral'+fi :: (Integral a, Num b) => a -> b+fi = fromIntegral
xmobar.cabal view
@@ -1,10 +1,12 @@ name: xmobar-version: 0.6-homepage: http://gorgias.mine.nu/repos/xmobar/-synopsis: A Statusbar for the XMonad Window Manager-description: Xmobar is a minimal status bar for the XMonad Window Manager.+version: 0.7+homepage: http://gorgias.mine.nu/xmobar/+synopsis: A Minimalistic Text Based Status Bar+description: Xmobar is a minimalistic text based status bar. .- It was inspired by the Ion3 status bar, and supports similar features.+ 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@@ -15,7 +17,8 @@ executable: xmobar main-is: Main.hs Hs-Source-Dirs: ./-Other-Modules: XMobar, Config, Parsers, Commands, Runnable, Plugins, Monitors.Common, Monitors.Batt - Monitors.Weather, Monitors.Swap, Monitors.Mem, Monitors.Cpu, Monitors.Net+Other-Modules: Xmobar, Config, Parsers, Commands, Runnable, Plugins, Plugins.Monitors.Common, + Plugins.Monitors.Batt Plugins.Monitors.Weather, Plugins.Monitors.Swap, + Plugins.Monitors.Mem, Plugins.Monitors.Cpu, Plugins.Monitors.Net ghc-options: -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s -threaded ghc-prof-options: -prof -auto-all