xmobar (empty) → 0.3
raw patch · 13 files changed
+1170/−0 lines, 13 filesdep +X11dep +basedep +mtlbuild-type:Customsetup-changed
Dependencies added: X11, base, mtl, parsec, unix
Files
- Config.hs +58/−0
- LICENSE +27/−0
- Main.hs +51/−0
- Monitors/Cpu.hs +109/−0
- Monitors/Mem.hs +99/−0
- Monitors/Net.hs +142/−0
- Monitors/Weather.hs +119/−0
- Parsers.hs +99/−0
- README +71/−0
- Setup.lhs +80/−0
- XMobar.hs +262/−0
- xmobar.cabal +40/−0
- xmobar.config-sample +13/−0
+ Config.hs view
@@ -0,0 +1,58 @@+-----------------------------------------------------------------------------+-- |+-- Module : XMobar.Config+-- Copyright : (c) Andrea Rossato+-- License : BSD-style (see LICENSE)+-- +-- Maintainer : Andrea Rossato <andrea.rossato@unibz.it>+-- Stability : unstable+-- Portability : unportable+--+-- The configuration module of XMobar, a status bar for the Xmonad Window Manager +--+-----------------------------------------------------------------------------++module Config ( -- * Configuration+ -- $config+ Config (..)+ , defaultConfig+ ) where++-- $config+-- Configuration data type and default configuration++-- | The configuration data type+data Config = + Config { fonts :: String -- ^ Fonts+ , bgColor :: String -- ^ Backgroud color+ , fgColor :: String -- ^ Default font color+ , xPos :: Int -- ^ x Window position (origin in the upper left corner) + , yPos :: Int -- ^ y Window position + , width :: Int -- ^ Window width+ , hight :: Int -- ^ Window hight+ , align :: String -- ^ text alignment+ , refresh :: Int -- ^ Refresh rate in tenth of seconds+ , commands :: [(String, Int, [String])] -- ^ For setting the refresh rate and + -- options for the programs to run (optionals)+ , sepChar :: String -- ^ The character to be used for indicating + -- commands in the output template (default '%')+ , template :: String -- ^ The output template + } deriving (Eq, Show, Read, Ord)++-- | The default configuration values+defaultConfig :: Config+defaultConfig =+ Config { fonts = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"+ , bgColor = "#000000"+ , fgColor = "#BFBFBF"+ , xPos = 0+ , yPos = 0+ , width = 1024+ , hight = 15+ , align = "left"+ , refresh = 10+ , commands = [("date", 10, [])]+ , sepChar = "%"+ , template = "Uptime: <fc=#00FF00>%uptime%</fc> ** <fc=#FF0000>%date%</fc>"+ }+
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) Andrea Rossato++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ Main.hs view
@@ -0,0 +1,51 @@+-----------------------------------------------------------------------------+-- |+-- Module : XMobar.Main+-- Copyright : (c) Andrea Rossato+-- License : BSD-style (see LICENSE)+-- +-- Maintainer : Andrea Rossato <andrea.rossato@unibz.it>+-- Stability : unstable+-- Portability : unportable+--+-- The main module of XMobar, a status bar for the Xmonad Window Manager +--+-----------------------------------------------------------------------------++module Main ( -- * Main Stuff+ -- $main+ main+ , readConfig + ) where++import XMobar+import Parsers+import Config+import System.Environment++-- $main+ +-- | The main entry point+main :: IO ()+main = + do args <- getArgs+ config <-+ if length args /= 1+ then do putStrLn ("No configuration file specified. Using default settings.")+ return defaultConfig+ else readConfig (args!!0)+ cl <- parseTemplate config (template config)+ var <- execCommands config cl+ (d,w) <- createWin config+ runXMobar config var d w eventLoop++-- | Reads the configuration files or quits with an error+readConfig :: FilePath -> IO Config+readConfig f = + do s <- readFile f+ case reads s of+ [(config,_)] -> return config+ [] -> error ("Corrupt config file: " ++ f)+ _ -> error ("Some problem occured. Aborting...")++
+ Monitors/Cpu.hs view
@@ -0,0 +1,109 @@+-----------------------------------------------------------------------------+-- |+-- 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 Main where++import Numeric+import Control.Concurrent+import Text.ParserCombinators.Parsec+++data Config = + Config { intervall :: Int+ , cpuNormal :: Integer+ , cpuNormalColor :: String+ , cpuCritical :: Integer+ , cpuCriticalColor :: String+ }++defaultConfig :: Config+defaultConfig = + Config { intervall = 500000+ , cpuNormal = 2+ , cpuNormalColor = "#00FF00" + , cpuCritical = 60+ , cpuCriticalColor = "#FF0000" + }++config :: Config+config = defaultConfig++-- Utilities++interSec :: IO ()+interSec = threadDelay (intervall config)++takeDigits :: Int -> Float -> Float+takeDigits d n = + read $ showFFloat (Just d) n ""++floatToPercent :: Float -> String+floatToPercent n = + showFFloat (Just 2) (n*100) "%" +++run :: Parser [a] -> IO String -> IO [a]+run p input+ = do a <- input+ case (parse p "" a) of+ Left _ -> return []+ Right x -> return x++fileCPU :: IO String+fileCPU = readFile "/proc/stat"+++getNumbers :: Parser Float+getNumbers = skipMany space >> many1 digit >>= \n -> return $ read n++parserCPU :: Parser [Float]+parserCPU = string "cpu" >> count 4 getNumbers++parseCPU :: IO [Float]+parseCPU = + do a <- run parserCPU fileCPU+ interSec+ b <- run parserCPU fileCPU+ let dif = zipWith (-) b a+ tot = foldr (+) 0 dif+ percent = map (/ tot) dif+ return percent++formatCpu :: [Float] -> String +formatCpu [] = ""+formatCpu (us:ni:sy:_)+ | x >= c = setColor z cpuCriticalColor+ | x >= n = setColor z cpuNormalColor+ | otherwise = floatToPercent y+ where x = (us * 100) + (sy * 100) + (ni * 100)+ y = us + sy + ni+ z = floatToPercent y+ c = fromInteger (cpuCritical config)+ n = fromInteger (cpuNormal config)+formatCpu _ = ""++setColor :: String -> (Config -> String) -> String+setColor str ty =+ "<fc=" ++ ty config ++ ">" +++ str ++ "</fc>"+ +cpu :: IO String+cpu = + do l <- parseCPU+ return $ "Cpu: " ++ formatCpu l++main :: IO ()+main =+ do c <- cpu+ putStrLn c
+ Monitors/Mem.hs view
@@ -0,0 +1,99 @@+-----------------------------------------------------------------------------+-- |+-- 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 Main where++import Numeric++data Config = + Config { memNormal :: Integer+ , memNormalColor :: String+ , memCritical :: Integer+ , memCriticalColor :: String+ , swapNormal :: Integer+ , swapNormalColor :: String+ , swapCritical :: Integer+ , swapCriticalColor :: String+ }++defaultConfig :: Config+defaultConfig = + Config { memNormal = 80+ , memNormalColor = "#00FF00" + , memCritical = 90+ , memCriticalColor = "#FF0000"+ , swapNormal = 15+ , swapNormalColor = "#00FF00" + , swapCritical = 50+ , swapCriticalColor = "#FF0000" + }+config :: Config+config = defaultConfig++-- Utilities++takeDigits :: Int -> Float -> Float+takeDigits d n = + read $ showFFloat (Just d) n ""++floatToPercent :: Float -> String+floatToPercent n = + showFFloat (Just 2) (n*100) "%" ++fileMEM :: IO String+fileMEM = readFile "/proc/meminfo"++parseMEM :: IO [Float]+parseMEM = + do file <- fileMEM + let content = map words $ take 13 $ lines file+ [total, free, buffer, cache,_,_,_,_,_,_,_,swapTotal,swapFree] = map (\line -> (read $ line !! 1 :: Float) / 1024) content+ rest = free + buffer + cache+ used = total - rest+ usedratio = used * 100 / total+ swapRatio = 100 - (swapFree / swapTotal * 100)+ return [total, free, buffer, cache, rest, used, usedratio, swapFree, swapRatio]+++formatMem :: [Float] -> String +formatMem [] = ""+formatMem (total:_:buffer:cach:_:used:_:_:swapRatio:_) =+ "Ram: " ++ ram ++ " cached: " ++ cache ++ " Swap: " ++ swap+ where (memN,memC,swapN,swapC) = (fromIntegral $ memNormal config,fromIntegral $ memCritical config+ , fromIntegral $ swapNormal config, fromIntegral $ swapCritical config)+ m = floatToPercent ((used + buffer + cach) / total)+ sw = show (takeDigits 2 swapRatio) ++ "%"+ cache = show (takeDigits 2 cach) ++ "Mb"+ ram | (used / total * 100) >= memC = setColor m memCriticalColor+ | (used / total * 100) >= memN = setColor m memNormalColor+ | otherwise = floatToPercent (used / total)+ swap | swapRatio >= swapC = setColor sw swapCriticalColor+ | swapRatio >= swapN = setColor sw swapNormalColor+ | otherwise = sw+formatMem _ = ""++setColor :: String -> (Config -> String) -> String+setColor str ty =+ "<fc=" ++ ty config ++ ">" +++ str ++ "</fc>"+ +mem :: IO String+mem =+ do m <- parseMEM+ return $ formatMem m++main :: IO ()+main =+ do m <- mem+ putStrLn m
+ Monitors/Net.hs view
@@ -0,0 +1,142 @@+-----------------------------------------------------------------------------+-- |+-- Module : Monitors.Cpu+-- 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 Main where++import Numeric+import Control.Concurrent+import Text.ParserCombinators.Parsec+import System.Environment++data Config = + Config { intervall :: Int+ , netDevice :: String+ , netNormal :: Integer+ , netNormalColor :: String+ , netCritical :: Integer+ , netCriticalColor :: String+ }++defaultConfig :: Config+defaultConfig = + Config { intervall = 500000+ , netDevice = "eth1"+ , netNormal = 0+ , netNormalColor = "#00FF00" + , netCritical = 50+ , netCriticalColor = "#FF0000" + }++config :: Config+config = defaultConfig++-- Utilities++interSec :: IO ()+interSec = threadDelay (intervall config)++takeDigits :: Int -> Float -> Float+takeDigits d n = + read $ showFFloat (Just d) n ""++floatToPercent :: Float -> String+floatToPercent n = + showFFloat (Just 2) (n*100) "%" +++run :: Parser [a] -> IO String -> IO [a]+run p input+ = do a <- input+ case (parse p "" a) of+ Left _ -> return []+ Right x -> return x++fileNET :: IO String+fileNET = + do f <- readFile "/proc/net/dev"+ return $ unlines $ drop 2 $ lines f++-- CPU++getNumbers :: Parser Float+getNumbers = skipMany space >> many1 digit >>= \n -> return $ read n++-- Net Devices++data NetDev = NA+ | ND { netDev :: String+ , netRx :: Float+ , netTx :: Float+ } deriving (Eq,Read)++instance Show NetDev where+ show NA = "N/A"+ show (ND nd rx tx) =+ nd ++ ": " ++ (formatNet rx) ++ "|" ++ formatNet tx ++formatNet :: Float -> String+formatNet d | d > fromInteger (netCritical config) = setColor str netCriticalColor + | d > fromInteger (netNormal config) = setColor str netNormalColor+ | otherwise = str+ where str = show d ++ "Kb"++pNetDev :: Parser NetDev+pNetDev = + do { skipMany1 space+ ; dn <- manyTill alphaNum $ char ':'+ ; [rx] <- count 1 getNumbers+ ; _ <- count 7 getNumbers+ ; [tx] <- count 1 getNumbers+ ; _ <- count 7 getNumbers+ ; char '\n'+ ; return $ ND dn (rx / 1024) (tx / 1024)+ } ++parserNet :: Parser [NetDev]+parserNet = manyTill pNetDev eof++parseNET :: String -> IO [NetDev]+parseNET nd = + do a <- run parserNet fileNET+ interSec+ b <- run parserNet fileNET+ let netRate f da db = takeDigits 2 $ ((f db) - (f da)) * fromIntegral (1000000 `div` (intervall config))+ 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++-- Formattings++setColor :: String -> (Config -> String) -> String+setColor str ty =+ "<fc=" ++ ty config ++ ">" +++ str ++ "</fc>"+ +net :: String -> IO String+net nd = + do pn <- parseNET nd+ n <- case pn of+ [x] -> return x+ _ -> return $ NA+ return $ show n++main :: IO ()+main =+ do args <- getArgs+ n <-+ if length args /= 1+ then error "No device specified.\nUsage: net dev"+ else net (args!!0)+ putStrLn n
+ Monitors/Weather.hs view
@@ -0,0 +1,119 @@+module Main where++import Text.ParserCombinators.Parsec+import System.Environment++import System.Process+import System.Exit+import System.IO++++data Config = + Config { weatherNormal :: Integer+ , weatherNormalColor :: String+ , weatherCritical :: Integer+ , weatherCriticalColor :: String+ }++defaultConfig :: Config+defaultConfig = + Config { weatherNormal = 0+ , weatherNormalColor = "#00FF00" + , weatherCritical = 50+ , weatherCriticalColor = "#FF0000" + }++config :: Config+config = defaultConfig+++data WeatherInfo = Fail String+ | WI { station :: String+ , time :: String+ , temperature :: Int+ , humidity :: Int+ } + +instance Show WeatherInfo where+ show (Fail _) = "N/A"+ show (WI st t temp rh) =+ st ++ ": " ++ (formatWeather temp) ++ "C, rh " ++ formatWeather rh +++ "% (" ++ t ++ ")"++parseData :: Parser WeatherInfo+parseData = + do { st <- manyTill anyChar $ char '('+ ; pNL+ ; manyTill anyChar $ char '/'+ ; space+ ; t <- manyTill anyChar newline+ ; manyTill pNL (string "Temperature")+ ; temp <- pTemp+ ; manyTill pNL (string "Relative Humidity")+ ; rh <- pRh+ ; manyTill pNL eof+ ; return $ WI st t temp rh+ } ++pTemp :: Parser Int+pTemp = do string ": "+ manyTill anyChar $ char '('+ s <- manyTill digit $ (char ' ' <|> char '.')+ pNL+ return $read s++pRh :: Parser Int+pRh = do string ": "+ s <- manyTill digit $ (char '%' <|> char '.')+ return $read s++pNL :: Parser Char+pNL = do many $ noneOf "\n\r"+ newline+++runP :: Parser WeatherInfo -> String -> IO WeatherInfo+runP p i =+ do case (parse p "" i) of+ Left err -> return $ Fail $ show err+ Right x -> return x++formatWeather :: Int -> String+formatWeather d | d > fromInteger (weatherCritical config) = setColor str weatherCriticalColor + | d > fromInteger (weatherNormal config) = setColor str weatherNormalColor+ | otherwise = str+ where str = show d+++setColor :: String -> (Config -> String) -> String+setColor str ty =+ "<fc=" ++ ty config ++ ">" +++ str ++ "</fc>"++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"++main :: IO ()+main =+ do args <- getArgs+ str <- if length args /= 1+ then error $ "No Station ID specified.\nUsage: weather STATION_ID" +++ "\nExample: xmb-weather LIPB"+ else getData (args !! 0)+ i <- runP parseData str + putStrLn $ show i+
+ Parsers.hs view
@@ -0,0 +1,99 @@+-----------------------------------------------------------------------------+-- |+-- Module : XMobar.Parsers+-- Copyright : (c) Andrea Rossato+-- License : BSD-style (see LICENSE)+-- +-- Maintainer : Andrea Rossato <andrea.rossato@unibz.it>+-- Stability : unstable+-- Portability : unportable+--+-- Parsers needed for XMobar, a status bar for the Xmonad Window Manager +--+-----------------------------------------------------------------------------++module Parsers (+ -- * Parsing+ -- $parser+ parseString+ , stringParser+ , defaultColors+ , colorsAndText+ , templateStringParser+ , templateCommandParser+ , templateParser+ , parseTemplate+ ) where++import Config+import Text.ParserCombinators.Parsec+++{- $parser+These are the neede parsers. Don't trust them too much.++There are parsers for the commands output and parsers for the+formatting template.+ -}++-- | Runs the actual string parsers+parseString :: Config -> String -> IO [(String, String)]+parseString config s = + case (parse (stringParser config) "" s) of+ Left _ -> return [("Could not parse string: " ++ s+ , (fgColor config))]+ Right x -> return x++-- | Gets the string and combines the needed parsers+stringParser :: Config -> Parser [(String, String)]+stringParser c = manyTill (colorsAndText c <|> defaultColors c) eof++-- | Parses a string with the default color (no color set)+defaultColors :: Config -> Parser (String, String)+defaultColors config = + do { s <- many $ noneOf "<"+ ; return (s,(fgColor config))+ }+ <|> colorsAndText config++-- | Parses a string with a color set+colorsAndText :: Config -> Parser (String, String) +colorsAndText config = + do { string "<fc=#"+ ; n <- count 6 hexDigit+ ; string ">"+ ; s <- many $ noneOf "<"+ ; string "</fc>"+ ; return (s,"#"++n)+ }+ <|> defaultColors config++-- | Parses the output template string+templateStringParser :: Config -> Parser (String,String,String)+templateStringParser c =+ do{ s <- many $ noneOf (sepChar c)+ ; (_,com,_) <- templateCommandParser c+ ; ss <- many $ noneOf (sepChar c)+ ; return (s, com, ss)+ } ++-- | Parses the command part of the template string+templateCommandParser :: Config -> Parser (String,String,String)+templateCommandParser c =+ do { let chr = head $ sepChar c+ ; char chr+ ; com <- many $ noneOf (sepChar c)+ ; char chr+ ; return $ ("",com,"")+ }+-- | Combines the template parsers+templateParser :: Config -> Parser [(String,String,String)]+templateParser c = many (templateStringParser c)++-- | Actually runs the template parsers+parseTemplate :: Config -> String -> IO [(String,String,String)]+parseTemplate config s = + case (parse (templateParser config) "" s) of+ Left _ -> return [("","","")]+ Right x -> return x+
+ README view
@@ -0,0 +1,71 @@+XMobar - a status bar for the XMonad Window Manager++ABOUT+-----++Xmobar is a minimal status bar for the XMonad Window Manager.++It was inspired by the Ion3 status bar, and supports similar features.+See xmobar.config-sample for a sample configuration.++Try it with:+xmobar xmobar.config-sample++INSTALLATION+------------++tar xvfz xmobar-0.1+runhaskell Setup.lhs configure --prefix=/usr/local+runhaskell Setup.lhs build+runhaskell Setup.lhs haddock (optional for building the code documentation)+runhaskell Setup.lhs install (possibly to be run as root)++Run with:+xmobar /path/to/config $++CONFIGURATION+-------------++See xmobar.config-sample for an example.++For the output template:++- %command% will execute command and print the output. The output may+ contain markups to change the characters' color.++- <fc=#FF0000>string</fc> will print "string" with #FF0000 color (red).++Other configuration options:++fonts: 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 +yPos: y position+width: width of the XMobar window +hight: hight+align: text alignment +refresh: Refresh rate in tenth of seconds+commands: For setting the options of the programs to run (optionals)+sepChar: The character to be used for indicating commands in the+ output template (default '%')+template: The output template +++AUTHOR+------++Andrea Rossato <andrea.rossato@unibz.it>+++LINKS+-----++The XMobar home page:+http://gorgias.mine.nu/xmobar/++XMobars darcs repository:+http://gorgias.mine.nu/repos/xmobar/++The XMonad Window Manager+http://xmonad.org
+ Setup.lhs view
@@ -0,0 +1,80 @@+#!/usr/bin/env runhaskell++> import Distribution.Simple+> import Distribution.PackageDescription+> import Distribution.Setup+> import Distribution.Simple.Utils+> import Distribution.Simple.LocalBuildInfo+> import Distribution.Program+> import Distribution.PreProcess++> import System.FilePath.Posix+> import System.Directory+> import Data.List+++> main = defaultMainWithHooks defaultUserHooks {haddockHook = xmonadHaddock}++> -- a different implementation of haddock hook from+> -- from Distribution.Simple: will use synopsis and description for +> -- building executables' documentation.++> xmonadHaddock pkg_descr lbi hooks (HaddockFlags hoogle verbose) = do+> confHaddock <- do let programConf = withPrograms lbi+> haddockName = programName haddockProgram+> mHaddock <- lookupProgram haddockName programConf+> maybe (die "haddock command not found") return mHaddock++> let tmpDir = (buildDir lbi) </> "tmp"+> createDirectoryIfMissing True tmpDir+> createDirectoryIfMissing True haddockPref+> preprocessSources pkg_descr lbi verbose (allSuffixHandlers hooks)+> setupMessage "Running Haddock for" pkg_descr++> let outputFlag = if hoogle then "--hoogle" else "--html"+> showPkg = showPackageId (package pkg_descr)+> showDepPkgs = map showPackageId (packageDeps lbi)+ +> withExe pkg_descr $ \exe -> do +> let bi = buildInfo exe+> inFiles <- getModulePaths bi (otherModules bi)+> srcMainPath <- findFile (hsSourceDirs bi) (modulePath exe)++> let prologName = showPkg ++ "-haddock-prolog.txt"+> writeFile prologName (description pkg_descr ++ "\n")++> let exeTargetDir = haddockPref </> exeName exe+> outFiles = srcMainPath : inFiles+> haddockFile = exeTargetDir </> (haddockName pkg_descr)++> createDirectoryIfMissing True exeTargetDir+> rawSystemProgram verbose confHaddock+> ([outputFlag,+> "--odir=" ++ exeTargetDir,+> "--title=" ++ showPkg ++ ": " ++ synopsis pkg_descr,+> "--package=" ++ showPkg,+> "--dump-interface=" ++ haddockFile,+> "--prologue=" ++ prologName+> ]+> ++ map ("--use-package=" ++) showDepPkgs+> ++ programArgs confHaddock+> ++ (if verbose > 4 then ["--verbose"] else [])+> ++ outFiles+> )+> removeFile prologName+ +> getModulePaths :: BuildInfo -> [String] -> IO [FilePath]+> getModulePaths bi =+> fmap concat .+> mapM (flip (moduleToFilePath (hsSourceDirs bi)) ["hs", "lhs"])+ ++> allSuffixHandlers :: Maybe UserHooks+> -> [PPSuffixHandler]+> allSuffixHandlers hooks+> = maybe knownSuffixHandlers+> (\h -> overridesPP (hookedPreProcessors h) knownSuffixHandlers)+> hooks+> where+> overridesPP :: [PPSuffixHandler] -> [PPSuffixHandler] -> [PPSuffixHandler]+> overridesPP = unionBy (\x y -> fst x == fst y)
+ XMobar.hs view
@@ -0,0 +1,262 @@+{-# 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+ , getOptions+ , 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 System.Process+import System.Exit+import System.IO (hClose, hGetLine)++import Config+import Parsers++-- $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 $ threadDelay $ 100000 * 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 + (fromIntegral $ xPos config) + (fromIntegral $ yPos config) + (fromIntegral $ width config) + (fromIntegral $ hight 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 (fonts config)+ io $ setFont dpy gc (fontFromFontStruct fontst)++ -- set window background + io $ setForeground dpy gc bgcolor+ io $ fillRectangle dpy win gc 0 0 + (fromIntegral $ width config) + (fromIntegral $ hight config)+ -- write+ let strWithLenth = map (\(s,c) -> (s,c,textWidth fontst s)) str+ printStrings gc fontst 1 strWithLenth + -- free everything+ io $ freeFont dpy fontst+ io $ freeGC dpy gc+ io $ flush dpy++-- | An easy way to print the stuff we need to print+printStrings :: GC+ -> FontStruct+ -> Position+ -> [(String, String, Position)]+ -> Xbar ()+printStrings _ _ _ [] = return ()+printStrings 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 = (fromIntegral (hight config) + fromIntegral asc) `div` 2+ offset = case (align config) of+ "center" -> (fromIntegral (width config) - fromIntegral totSLen) `div` 2+ "right" -> fromIntegral (width config) - fromIntegral totSLen+ "left" -> offs+ _ -> offs+ color <- io $ initColor (display st) c+ io $ setForeground (display st) gc color+ io $ drawString (display st) (window st) gc offset valign s+ printStrings gc fontst (offs + l) xs++-- $commands++-- | Gets the command options set in configuration.+getOptions :: Config -> String -> [String]+getOptions c com =+ let l = commands c+ p = filter (\(s,_,_) -> s == com) l+ in case p of+ [(_,_,opts)] -> opts+ _ -> []++-- | Gets the command options set in configuration.+getRefRate :: Config -> String -> Int+getRefRate c com =+ let l = commands c+ p = filter (\(s,_,_) -> s == com) l+ in case p of+ [(_,int,_)] -> int+ _ -> refresh c++-- | Runs a list of programs+execCommands :: Config -> [(String,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 -> (String,String,String) -> IO (ThreadId, MVar String)+execCommand c com = + do var <- newMVar "Updating..."+ h <- forkIO $ runCommandLoop var c com+ return (h,var)++-- | Runs the external program+runCommandLoop :: MVar String -> Config -> (String,String,String) -> IO ()+runCommandLoop var conf c@(s,com,ss) + | com == "" = + do modifyMVar_ var (\_ -> return $ "Could not parse the template")+ threadDelay (100000 * (refresh conf))+ runCommandLoop var conf c+ | otherwise =+ do (i,o,e,p) <- runInteractiveCommand (com ++ concat (map (' ':) $ getOptions conf com))+ -- the followinf leaks memory+ --(i,o,e,p) <- runInteractiveProcess com (getOptions c com) Nothing Nothing+ exit <- waitForProcess p+ let closeHandles = do hClose o+ hClose i+ hClose e+ case exit of+ ExitSuccess -> do str <- hGetLine o+ closeHandles+ modifyMVar_ var (\_ -> return $ s ++ str ++ ss)+ threadDelay (100000 * (getRefRate conf com))+ runCommandLoop var conf c+ _ -> do closeHandles+ modifyMVar_ var $ \_ -> return $ "Could not execute command " ++ com+ threadDelay (100000 * (getRefRate conf 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
+ xmobar.cabal view
@@ -0,0 +1,40 @@+name: xmobar+version: 0.3+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.+ .+ It was inspired by the Ion3 status bar, and supports similar features.+category: System+license: BSD3+license-file: LICENSE+author: Andrea Rossato+maintainer: andrea.rossato@unibz.it+build-depends: base>=2.0, X11>=1.2.1, mtl>=1.0, unix>=1.0, parsec>=2.0++executable: xmobar+main-is: Main.hs+Hs-Source-Dirs: ./+Other-Modules: XMobar, Config, Parsers +ghc-options: -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s -threaded+ghc-prof-options: -prof -auto-all++executable: xmb-cpu+main-is: Monitors/Cpu.hs+ghc-options: -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s+ghc-prof-options: -prof -auto-all++executable: xmb-mem+main-is: Monitors/Mem.hs+ghc-options: -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s+ghc-prof-options: -prof -auto-all++executable: xmb-net+main-is: Monitors/Net.hs+ghc-options: -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s+ghc-prof-options: -prof -auto-all++executable: xmb-weather+main-is: Monitors/Weather.hs+ghc-options: -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s+ghc-prof-options: -prof -auto-all
+ xmobar.config-sample view
@@ -0,0 +1,13 @@+Config { fonts = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"+ , bgColor = "#000000"+ , fgColor = "#BFBFBF"+ , xPos = 0+ , yPos = 0+ , width = 1024+ , hight = 15+ , align = "right"+ , refresh = 10+ , commands = [("xmb-weather", 36000, ["EGXD"]), ("xmb-net", 10, ["eth1"])]+ , sepChar = "%"+ , template = "%xmb-cpu% %xmb-mem% %xmb-net% | %xmb-weather% | <fc=#ee9a00>%date%</fc>"+ }