diff --git a/Config.hs b/Config.hs new file mode 100644 --- /dev/null +++ b/Config.hs @@ -0,0 +1,58 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMobar.Config +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Andrea Rossato +-- 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: %uptime% ** %date%" + } + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Main.hs b/Main.hs new file mode 100644 --- /dev/null +++ b/Main.hs @@ -0,0 +1,51 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMobar.Main +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Andrea Rossato +-- 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...") + + diff --git a/Monitors/Cpu.hs b/Monitors/Cpu.hs new file mode 100644 --- /dev/null +++ b/Monitors/Cpu.hs @@ -0,0 +1,109 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Monitors.Cpu +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Andrea Rossato +-- 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 = + "" ++ + str ++ "" + +cpu :: IO String +cpu = + do l <- parseCPU + return $ "Cpu: " ++ formatCpu l + +main :: IO () +main = + do c <- cpu + putStrLn c diff --git a/Monitors/Mem.hs b/Monitors/Mem.hs new file mode 100644 --- /dev/null +++ b/Monitors/Mem.hs @@ -0,0 +1,99 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Monitors.Mem +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Andrea Rossato +-- 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 = + "" ++ + str ++ "" + +mem :: IO String +mem = + do m <- parseMEM + return $ formatMem m + +main :: IO () +main = + do m <- mem + putStrLn m diff --git a/Monitors/Net.hs b/Monitors/Net.hs new file mode 100644 --- /dev/null +++ b/Monitors/Net.hs @@ -0,0 +1,142 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Monitors.Cpu +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Andrea Rossato +-- 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 = + "" ++ + str ++ "" + +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 diff --git a/Monitors/Weather.hs b/Monitors/Weather.hs new file mode 100644 --- /dev/null +++ b/Monitors/Weather.hs @@ -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 = + "" ++ + str ++ "" + +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 + diff --git a/Parsers.hs b/Parsers.hs new file mode 100644 --- /dev/null +++ b/Parsers.hs @@ -0,0 +1,99 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMobar.Parsers +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Andrea Rossato +-- 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 "" + ; s <- many $ noneOf "<" + ; string "" + ; 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 + diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -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. + +- string 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 + + +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 diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -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) diff --git a/XMobar.hs b/XMobar.hs new file mode 100644 --- /dev/null +++ b/XMobar.hs @@ -0,0 +1,262 @@ +{-# OPTIONS -fglasgow-exts #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMobar +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Andrea Rossato +-- 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 diff --git a/xmobar.cabal b/xmobar.cabal new file mode 100644 --- /dev/null +++ b/xmobar.cabal @@ -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 diff --git a/xmobar.config-sample b/xmobar.config-sample new file mode 100644 --- /dev/null +++ b/xmobar.config-sample @@ -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% | %date%" + }