diff options
Diffstat (limited to 'Plugins')
29 files changed, 0 insertions, 2644 deletions
diff --git a/Plugins/CommandReader.hs b/Plugins/CommandReader.hs deleted file mode 100644 index 7c7c92d..0000000 --- a/Plugins/CommandReader.hs +++ /dev/null @@ -1,39 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Plugins.CommandReader --- Copyright : (c) John Goerzen --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> --- Stability : unstable --- Portability : unportable --- --- A plugin for reading from external commands --- note: stderr is lost here --- ------------------------------------------------------------------------------ - -module Plugins.CommandReader where - -import System.IO -import Plugins -import System.Process(runInteractiveCommand, getProcessExitCode) - -data CommandReader = CommandReader String String - deriving (Read, Show) - -instance Exec CommandReader where - alias (CommandReader _ a) = a - start (CommandReader p _) cb = do - (hstdin, hstdout, hstderr, ph) <- runInteractiveCommand p - hClose hstdin - hClose hstderr - hSetBinaryMode hstdout False - hSetBuffering hstdout LineBuffering - forever ph (hGetLineSafe hstdout >>= cb) - where forever ph a = - do a - ec <- getProcessExitCode ph - case ec of - Nothing -> forever ph a - Just _ -> cb "EXITED" diff --git a/Plugins/Date.hs b/Plugins/Date.hs deleted file mode 100644 index bfcb132..0000000 --- a/Plugins/Date.hs +++ /dev/null @@ -1,37 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Plugins.Date --- Copyright : (c) Andrea Rossato --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> --- Stability : unstable --- Portability : unportable --- --- A date plugin for Xmobar --- --- Usage example: in template put --- --- > Run Date "%a %b %_d %Y <fc=#ee9a00> %H:%M:%S</fc>" "Mydate" 10 --- ------------------------------------------------------------------------------ - -module Plugins.Date (Date(..)) where - -import Plugins - -import System.Locale -import System.Time - -data Date = Date String String Int - deriving (Read, Show) - -instance Exec Date where - alias (Date _ a _) = a - run (Date f _ _) = date f - rate (Date _ _ r) = r - -date :: String -> IO String -date format = do - t <- toCalendarTime =<< getClockTime - return $ formatCalendarTime defaultTimeLocale format t diff --git a/Plugins/EWMH.hs b/Plugins/EWMH.hs deleted file mode 100644 index d5b70cb..0000000 --- a/Plugins/EWMH.hs +++ /dev/null @@ -1,264 +0,0 @@ -{-# OPTIONS_GHC -w #-} -{-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns, GeneralizedNewtypeDeriving #-} - ------------------------------------------------------------------------------ --- | --- Module : Plugins.EWMH --- Copyright : (c) Spencer Janssen --- License : BSD-style (see LICENSE) --- --- Maintainer : Spencer Janssen <spencerjanssen@gmail.com> --- Stability : unstable --- Portability : unportable --- --- An experimental plugin to display EWMH pager information --- ------------------------------------------------------------------------------ - -module Plugins.EWMH (EWMH(..)) where - -import Control.Monad.State -import Control.Monad.Reader -import Graphics.X11 hiding (Modifier, Color) -import Graphics.X11.Xlib.Extras -import Plugins -#ifdef UTF8 -#undef UTF8 -import Codec.Binary.UTF8.String as UTF8 -#define UTF8 -#endif -import Foreign.C (CChar, CLong) -import XUtil (nextEvent') - -import Data.List (intersperse, intercalate) - -import Data.Map (Map) -import qualified Data.Map as Map -import Data.Set (Set) -import qualified Data.Set as Set - - -data EWMH = EWMH | EWMHFMT Component deriving (Read, Show) - -instance Exec EWMH where - alias EWMH = "EWMH" - - start ew cb = allocaXEvent $ \ep -> execM $ do - d <- asks display - r <- asks root - - liftIO xSetErrorHandler - - liftIO $ selectInput d r propertyChangeMask - handlers' <- mapM (\(a, h) -> liftM2 (,) (getAtom a) (return h)) handlers - mapM_ ((=<< asks root) . snd) handlers' - - forever $ do - liftIO . cb . fmtOf ew =<< get - liftIO $ nextEvent' d ep - e <- liftIO $ getEvent ep - case e of - PropertyEvent { ev_atom = a, ev_window = w } -> do - case lookup a handlers' of - Just f -> f w - _ -> return () - _ -> return () - - return () - -defaultPP = Sep (Text " : ") [ Workspaces [Color "white" "black" :% Current, Hide :% Empty] - , Layout - , Color "#00ee00" "" :$ Short 120 :$ WindowName] - -fmtOf EWMH = flip fmt defaultPP -fmtOf (EWMHFMT f) = flip fmt f - -sep :: [a] -> [[a]] -> [a] -sep x xs = intercalate x $ filter (not . null) xs - -fmt :: EwmhState -> Component -> String -fmt e (Text s) = s -fmt e (l :+ r) = fmt e l ++ fmt e r -fmt e (m :$ r) = modifier m $ fmt e r -fmt e (Sep c xs) = sep (fmt e c) $ map (fmt e) xs -fmt e WindowName = windowName $ Map.findWithDefault initialClient (activeWindow e) (clients e) -fmt e Layout = layout e -fmt e (Workspaces opts) = sep " " - [foldr ($) n [modifier m | (m :% a) <- opts, a `elem` as] - | (n, as) <- attrs] - where - stats i = [ (Current, i == currentDesktop e) - , (Empty, Set.notMember i nonEmptys && i /= currentDesktop e) - -- TODO for visible , (Visibl - ] - attrs :: [(String, [WsType])] - attrs = [(n, [s | (s, b) <- stats i, b]) | (i, n) <- zip [0 ..] (desktopNames e)] - nonEmptys = Set.unions . map desktops . Map.elems $ clients e - -modifier :: Modifier -> (String -> String) -modifier Hide = const "" -modifier (Color fg bg) = \x -> concat ["<fc=", fg, if null bg then "" else "," ++ bg - , ">", x, "</fc>"] -modifier (Short n) = take n -modifier (Wrap l r) = \x -> l ++ x ++ r - -data Component = Text String - | Component :+ Component - | Modifier :$ Component - | Sep Component [Component] - | WindowName - | Layout - | Workspaces [WsOpt] - deriving (Read, Show) - -infixr 0 :$ -infixr 5 :+ - -data Modifier = Hide - | Color String String - | Short Int - | Wrap String String - deriving (Read, Show) - -data WsOpt = Modifier :% WsType - | WSep Component - deriving (Read, Show) -infixr 0 :% - -data WsType = Current | Empty | Visible - deriving (Read, Show, Eq) - -data EwmhConf = C { root :: Window - , display :: Display } - -data EwmhState = S { currentDesktop :: CLong - , activeWindow :: Window - , desktopNames :: [String] - , layout :: String - , clients :: Map Window Client } - deriving Show - -data Client = Cl { windowName :: String - , desktops :: Set CLong } - deriving Show - -getAtom :: String -> M Atom -getAtom s = do - d <- asks display - liftIO $ internAtom d s False - -windowProperty32 :: String -> Window -> M (Maybe [CLong]) -windowProperty32 s w = do - (C {display}) <- ask - a <- getAtom s - liftIO $ getWindowProperty32 display a w - -windowProperty8 :: String -> Window -> M (Maybe [CChar]) -windowProperty8 s w = do - (C {display}) <- ask - a <- getAtom s - liftIO $ getWindowProperty8 display a w - -initialState :: EwmhState -initialState = S 0 0 [] [] Map.empty - -initialClient :: Client -initialClient = Cl "" Set.empty - -handlers, clientHandlers :: [(String, Updater)] -handlers = [ ("_NET_CURRENT_DESKTOP", updateCurrentDesktop) - , ("_NET_DESKTOP_NAMES", updateDesktopNames ) - , ("_NET_ACTIVE_WINDOW", updateActiveWindow) - , ("_NET_CLIENT_LIST", updateClientList) - ] ++ clientHandlers - -clientHandlers = [ ("_NET_WM_NAME", updateName) - , ("_NET_WM_DESKTOP", updateDesktop) ] - -newtype M a = M (ReaderT EwmhConf (StateT EwmhState IO) a) - deriving (Monad, Functor, MonadIO, MonadReader EwmhConf, MonadState EwmhState) - -execM :: M a -> IO a -execM (M m) = do - d <- openDisplay "" - r <- rootWindow d (defaultScreen d) - let conf = C r d - evalStateT (runReaderT m (C r d)) initialState - -type Updater = Window -> M () - -updateCurrentDesktop, updateDesktopNames, updateActiveWindow :: Updater -updateCurrentDesktop _ = do - (C {root}) <- ask - mwp <- windowProperty32 "_NET_CURRENT_DESKTOP" root - case mwp of - Just [x] -> modify (\s -> s { currentDesktop = x }) - _ -> return () - -updateActiveWindow _ = do - (C {root}) <- ask - mwp <- windowProperty32 "_NET_ACTIVE_WINDOW" root - case mwp of - Just [x] -> modify (\s -> s { activeWindow = fromIntegral x }) - _ -> return () - -updateDesktopNames _ = do - (C {root}) <- ask - mwp <- windowProperty8 "_NET_DESKTOP_NAMES" root - case mwp of - Just xs -> modify (\s -> s { desktopNames = parse xs }) - _ -> return () - where - dropNull ('\0':xs) = xs - dropNull xs = xs - - split [] = [] - split xs = case span (/= '\0') xs of - (x, ys) -> x : split (dropNull ys) - parse = split . decodeCChar - -updateClientList _ = do - (C {root}) <- ask - mwp <- windowProperty32 "_NET_CLIENT_LIST" root - case mwp of - Just xs -> do - cl <- gets clients - let cl' = Map.fromList $ map (flip (,) initialClient . fromIntegral) xs - dels = Map.difference cl cl' - new = Map.difference cl' cl - modify (\s -> s { clients = Map.union (Map.intersection cl cl') cl'}) - mapM_ unmanage (map fst $ Map.toList dels) - mapM_ listen (map fst $ Map.toList cl') - mapM_ update (map fst $ Map.toList new) - _ -> return () - where - unmanage w = asks display >>= \d -> liftIO $ selectInput d w 0 - listen w = asks display >>= \d -> liftIO $ selectInput d w propertyChangeMask - update w = mapM_ (($ w) . snd) clientHandlers - -modifyClient :: Window -> (Client -> Client) -> M () -modifyClient w f = modify (\s -> s { clients = Map.alter f' w $ clients s }) - where - f' Nothing = Just $ f initialClient - f' (Just x) = Just $ f x - -updateName w = do - mwp <- windowProperty8 "_NET_WM_NAME" w - case mwp of - Just xs -> modifyClient w (\c -> c { windowName = decodeCChar xs }) - _ -> return () - -updateDesktop w = do - mwp <- windowProperty32 "_NET_WM_DESKTOP" w - case mwp of - Just x -> modifyClient w (\c -> c { desktops = Set.fromList x }) - _ -> return () - -decodeCChar :: [CChar] -> String -#ifdef UTF8 -#undef UTF8 -decodeCChar = UTF8.decode . map fromIntegral -#define UTF8 -#else -decodeCChar = map (toEnum . fromIntegral) -#endif diff --git a/Plugins/HelloWorld.hs b/Plugins/HelloWorld.hs deleted file mode 100644 index df5cff6..0000000 --- a/Plugins/HelloWorld.hs +++ /dev/null @@ -1,24 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Plugins.HelloWorld --- Copyright : (c) Andrea Rossato --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> --- Stability : unstable --- Portability : unportable --- --- A plugin example for Xmobar, a text based status bar --- ------------------------------------------------------------------------------ - -module Plugins.HelloWorld where - -import Plugins - -data HelloWorld = HelloWorld - deriving (Read, Show) - -instance Exec HelloWorld where - alias HelloWorld = "helloWorld" - run HelloWorld = return "<fc=red>Hello World!!</fc>" diff --git a/Plugins/MBox.hs b/Plugins/MBox.hs deleted file mode 100644 index 65a8bb3..0000000 --- a/Plugins/MBox.hs +++ /dev/null @@ -1,111 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Plugins.MBox --- Copyright : (c) Jose A Ortega Ruiz --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A Ortega Ruiz <jao@gnu.org> --- Stability : unstable --- Portability : unportable --- --- A plugin for checking mail in mbox files. --- ------------------------------------------------------------------------------ - -module Plugins.MBox (MBox(..)) where - -import Prelude hiding (catch) -import Plugins -import Plugins.Utils (changeLoop, expandHome) - -import Control.Monad (when) -import Control.Concurrent.STM -import Control.Exception (SomeException, handle, evaluate) - -import System.Console.GetOpt -import System.Directory (doesFileExist) -import System.FilePath ((</>)) -import System.INotify (Event(..), EventVariety(..), initINotify, addWatch) - -import qualified Data.ByteString.Lazy.Char8 as B - -data Options = Options - { oAll :: Bool - , oUniq :: Bool - , oDir :: FilePath - , oPrefix :: String - , oSuffix :: String - } - -defaults :: Options -defaults = Options { - oAll = False, oUniq = False, oDir = "", oPrefix = "", oSuffix = "" - } - -options :: [OptDescr (Options -> Options)] -options = - [ Option "a" ["all"] (NoArg (\o -> o { oAll = True })) "" - , Option "u" [] (NoArg (\o -> o { oUniq = True })) "" - , Option "d" ["dir"] (ReqArg (\x o -> o { oDir = x }) "") "" - , Option "p" ["prefix"] (ReqArg (\x o -> o { oPrefix = x }) "") "" - , Option "s" ["suffix"] (ReqArg (\x o -> o { oSuffix = x }) "") "" - ] - -parseOptions :: [String] -> IO Options -parseOptions args = - case getOpt Permute options args of - (o, _, []) -> return $ foldr id defaults o - (_, _, errs) -> ioError . userError $ concat errs - --- | A list of display names, paths to mbox files and display colours, --- followed by a list of options. -data MBox = MBox [(String, FilePath, String)] [String] String - deriving (Read, Show) - -instance Exec MBox where - alias (MBox _ _ a) = a - start (MBox boxes args _) cb = do - - opts <- parseOptions args - let showAll = oAll opts - prefix = oPrefix opts - suffix = oSuffix opts - uniq = oUniq opts - names = map (\(t, _, _) -> t) boxes - colors = map (\(_, _, c) -> c) boxes - extractPath (_, f, _) = expandHome $ oDir opts </> f - events = [CloseWrite] - - i <- initINotify - vs <- mapM (\b -> do - f <- extractPath b - exists <- doesFileExist f - n <- if exists then countMails f else return (-1) - v <- newTVarIO (f, n) - when exists $ - addWatch i events f (handleNotification v) >> return () - return v) - boxes - - changeLoop (mapM (fmap snd . readTVar) vs) $ \ns -> - let s = unwords [ showC uniq m n c | (m, n, c) <- zip3 names ns colors - , showAll || n > 0 ] - in cb (if null s then "" else prefix ++ s ++ suffix) - -showC :: Bool -> String -> Int -> String -> String -showC u m n c = - if c == "" then msg else "<fc=" ++ c ++ ">" ++ msg ++ "</fc>" - where msg = m ++ if not u || n > 1 then show n else "" - -countMails :: FilePath -> IO Int -countMails f = - handle ((\_ -> evaluate 0) :: SomeException -> IO Int) - (do txt <- B.readFile f - evaluate $! length . filter (B.isPrefixOf from) . B.lines $ txt) - where from = B.pack "From " - -handleNotification :: TVar (FilePath, Int) -> Event -> IO () -handleNotification v _ = do - (p, _) <- atomically $ readTVar v - n <- countMails p - atomically $ writeTVar v (p, n) diff --git a/Plugins/Mail.hs b/Plugins/Mail.hs deleted file mode 100644 index 38cdaae..0000000 --- a/Plugins/Mail.hs +++ /dev/null @@ -1,70 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Plugins.Mail --- Copyright : (c) Spencer Janssen --- License : BSD-style (see LICENSE) --- --- Maintainer : Spencer Janssen <sjanssen@cse.unl.edu> --- Stability : unstable --- Portability : unportable --- --- A plugin for checking mail. --- ------------------------------------------------------------------------------ - -module Plugins.Mail where - -import Prelude hiding (catch) -import Plugins -import Plugins.Utils (expandHome, changeLoop) - -import Control.Monad -import Control.Concurrent.STM - -import System.Directory -import System.FilePath -import System.INotify - -import Data.List (isPrefixOf) -import Data.Set (Set) -import qualified Data.Set as S - --- | A list of mail box names and paths to maildirs. -data Mail = Mail [(String, FilePath)] - deriving (Read, Show) - -instance Exec Mail where - start (Mail ms) cb = do - vs <- mapM (const $ newTVarIO S.empty) ms - - let ts = map fst ms - rs = map ((</> "new") . snd) ms - ev = [Move, MoveIn, MoveOut, Create, Delete] - - ds <- mapM expandHome rs - i <- initINotify - zipWithM_ (\d v -> addWatch i ev d (handle v)) ds vs - - forM_ (zip ds vs) $ \(d, v) -> do - s <- fmap (S.fromList . filter (not . isPrefixOf ".")) - $ getDirectoryContents d - atomically $ modifyTVar v (S.union s) - - changeLoop (mapM (fmap S.size . readTVar) vs) $ \ns -> - cb . unwords $ [m ++ ":" ++ show n - | (m, n) <- zip ts ns - , n /= 0 ] - -modifyTVar :: TVar a -> (a -> a) -> STM () -modifyTVar v f = readTVar v >>= writeTVar v . f - -handle :: TVar (Set String) -> Event -> IO () -handle v e = atomically $ modifyTVar v $ case e of - Created {} -> create - MovedIn {} -> create - Deleted {} -> delete - MovedOut {} -> delete - _ -> id - where - delete = S.delete (filePath e) - create = S.insert (filePath e) diff --git a/Plugins/Monitors.hs b/Plugins/Monitors.hs deleted file mode 100644 index 9887d74..0000000 --- a/Plugins/Monitors.hs +++ /dev/null @@ -1,119 +0,0 @@ -{-# LANGUAGE CPP #-} - ------------------------------------------------------------------------------ --- | --- Module : Xmobar.Plugins.Monitors --- Copyright : (c) Andrea Rossato --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> --- Stability : unstable --- Portability : unportable --- --- The system monitor plugin for Xmobar. --- ------------------------------------------------------------------------------ - -module Plugins.Monitors where - -import Plugins - -import Plugins.Monitors.Common ( runM ) -import Plugins.Monitors.Weather -import Plugins.Monitors.Net -import Plugins.Monitors.Mem -import Plugins.Monitors.Swap -import Plugins.Monitors.Cpu -import Plugins.Monitors.MultiCpu -import Plugins.Monitors.Batt -import Plugins.Monitors.Thermal -import Plugins.Monitors.CpuFreq -import Plugins.Monitors.CoreTemp -import Plugins.Monitors.Disk -import Plugins.Monitors.Top -import Plugins.Monitors.Uptime -#ifdef IWLIB -import Plugins.Monitors.Wireless -#endif -#ifdef LIBMPD -import Plugins.Monitors.MPD -#endif - -data Monitors = Weather Station Args Rate - | Network Interface Args Rate - | Memory Args Rate - | Swap Args Rate - | Cpu Args Rate - | MultiCpu Args Rate - | Battery Args Rate - | BatteryP [String] Args Rate - | DiskU DiskSpec Args Rate - | DiskIO DiskSpec Args Rate - | Thermal Zone Args Rate - | CpuFreq Args Rate - | CoreTemp Args Rate - | TopProc Args Rate - | TopMem Args Rate - | Uptime Args Rate -#ifdef IWLIB - | Wireless Interface Args Rate -#endif -#ifdef LIBMPD - | MPD Args Rate -#endif - deriving (Show,Read,Eq) - -type Args = [String] -type Program = String -type Alias = String -type Station = String -type Zone = String -type Interface = String -type Rate = Int -type DiskSpec = [(String, String)] - -instance Exec Monitors where - alias (Weather s _ _) = s - alias (Network i _ _) = i - alias (Thermal z _ _) = z - alias (Memory _ _) = "memory" - alias (Swap _ _) = "swap" - alias (Cpu _ _) = "cpu" - alias (MultiCpu _ _) = "multicpu" - alias (Battery _ _) = "battery" - alias (BatteryP _ _ _)= "battery" - alias (CpuFreq _ _) = "cpufreq" - alias (TopProc _ _) = "top" - alias (TopMem _ _) = "topmem" - alias (CoreTemp _ _) = "coretemp" - alias (DiskU _ _ _) = "disku" - alias (DiskIO _ _ _) = "diskio" - alias (Uptime _ _) = "uptime" -#ifdef IWLIB - alias (Wireless i _ _) = i ++ "wi" -#endif -#ifdef LIBMPD - alias (MPD _ _) = "mpd" -#endif - start (Weather s a r) = runM (a ++ [s]) weatherConfig runWeather r - start (Network i a r) = runM (a ++ [i]) netConfig runNet r - start (Thermal z a r) = runM (a ++ [z]) thermalConfig runThermal r - start (Memory a r) = runM a memConfig runMem r - start (Swap a r) = runM a swapConfig runSwap r - start (Cpu a r) = runM a cpuConfig runCpu r - start (MultiCpu a r) = runM a multiCpuConfig runMultiCpu r - start (Battery a r) = runM a battConfig runBatt r - start (BatteryP s a r) = runM a battConfig (runBatt' s) r - start (CpuFreq a r) = runM a cpuFreqConfig runCpuFreq r - start (CoreTemp a r) = runM a coreTempConfig runCoreTemp r - start (DiskU s a r) = runM a diskUConfig (runDiskU s) r - start (DiskIO s a r) = runM a diskIOConfig (runDiskIO s) r - start (TopMem a r) = runM a topMemConfig runTopMem r - start (Uptime a r) = runM a uptimeConfig runUptime r - start (TopProc a r) = startTop a r -#ifdef IWLIB - start (Wireless i a r) = runM (a ++ [i]) wirelessConfig runWireless r -#endif -#ifdef LIBMPD - start (MPD a r) = runM a mpdConfig runMPD r -#endif diff --git a/Plugins/Monitors/Batt.hs b/Plugins/Monitors/Batt.hs deleted file mode 100644 index 11b2d6c..0000000 --- a/Plugins/Monitors/Batt.hs +++ /dev/null @@ -1,165 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Plugins.Monitors.Batt --- Copyright : (c) Andrea Rossato, 2010 Petr Rockai, 2010 Jose A Ortega --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> --- Stability : unstable --- Portability : unportable --- --- A battery monitor for Xmobar --- ------------------------------------------------------------------------------ - -module Plugins.Monitors.Batt ( battConfig, runBatt, runBatt' ) where - -import qualified Data.ByteString.Lazy.Char8 as B -import Plugins.Monitors.Common -import System.Posix.Files (fileExist) -import System.Console.GetOpt - -data BattOpts = BattOpts - { onString :: String - , offString :: String - , posColor :: Maybe String - , lowWColor :: Maybe String - , mediumWColor :: Maybe String - , highWColor :: Maybe String - , lowThreshold :: Float - , highThreshold :: Float - } - -defaultOpts :: BattOpts -defaultOpts = BattOpts - { onString = "On" - , offString = "Off" - , posColor = Nothing - , lowWColor = Nothing - , mediumWColor = Nothing - , highWColor = Nothing - , lowThreshold = -12 - , highThreshold = -10 - } - -options :: [OptDescr (BattOpts -> BattOpts)] -options = - [ Option "O" ["on"] (ReqArg (\x o -> o { onString = x }) "") "" - , Option "o" ["off"] (ReqArg (\x o -> o { offString = x }) "") "" - , Option "p" ["positive"] (ReqArg (\x o -> o { posColor = Just x }) "") "" - , Option "l" ["low"] (ReqArg (\x o -> o { lowWColor = Just x }) "") "" - , Option "m" ["medium"] (ReqArg (\x o -> o { mediumWColor = Just x }) "") "" - , Option "h" ["high"] (ReqArg (\x o -> o { highWColor = Just x }) "") "" - , Option "L" ["lowt"] (ReqArg (\x o -> o { lowThreshold = read x }) "") "" - , Option "H" ["hight"] (ReqArg (\x o -> o { highThreshold = read x }) "") "" - ] - -parseOpts :: [String] -> IO BattOpts -parseOpts argv = - case getOpt Permute options argv of - (o, _, []) -> return $ foldr id defaultOpts o - (_, _, errs) -> ioError . userError $ concat errs - -data Result = Result Float Float Float String | NA - -base :: String -base = "/sys/class/power_supply" - -battConfig :: IO MConfig -battConfig = mkMConfig - "Batt: <watts>, <left>% / <timeleft>" -- template - ["leftbar", "left", "acstatus", "timeleft", "watts"] -- replacements - -data Files = Files - { f_full :: String - , f_now :: String - , f_voltage :: String - , f_current :: String - } | NoFiles - -data Battery = Battery - { full :: Float - , now :: Float - , voltage :: Float - , current :: Float - } - -batteryFiles :: String -> IO Files -batteryFiles bat = - do is_charge <- fileExist $ prefix ++ "/charge_now" - is_energy <- fileExist $ prefix ++ "/energy_now" - return $ case (is_charge, is_energy) of - (True, _) -> files "/charge" - (_, True) -> files "/energy" - _ -> NoFiles - where prefix = base ++ "/" ++ bat - files ch = Files { f_full = prefix ++ ch ++ "_full" - , f_now = prefix ++ ch ++ "_now" - , f_current = prefix ++ "/current_now" - , f_voltage = prefix ++ "/voltage_now" } - -haveAc :: IO (Maybe Bool) -haveAc = do know <- fileExist $ base ++ "/AC/online" - if know - then do s <- B.unpack `fmap` catRead (base ++ "/AC/online") - return $ Just $ s == "1\n" - else return Nothing - -readBattery :: Files -> IO Battery -readBattery NoFiles = return $ Battery 0 0 0 0 -readBattery files = - do a <- grab $ f_full files -- microwatthours - b <- grab $ f_now files - c <- grab $ f_voltage files -- microvolts - d <- grab $ f_current files -- microwatts (huh!) - return $ Battery (3600 * a / 1000000) -- wattseconds - (3600 * b / 1000000) -- wattseconds - (c / 1000000) -- volts - (d / c) -- amperes - where grab = fmap (read . B.unpack) . catRead - -readBatteries :: BattOpts -> [Files] -> IO Result -readBatteries opts bfs = - do bats <- mapM readBattery (take 3 bfs) - ac' <- haveAc - let ac = (ac' == Just True) - sign = if ac then 1 else -1 - left = sum (map now bats) / sum (map full bats) - watts = sign * sum (map voltage bats) * sum (map current bats) - time = if watts == 0 then 0 else sum $ map time' bats -- negate sign - time' b = (if ac then full b - now b else now b) / (sign * watts) - acstr = case ac' of - Nothing -> "?" - Just True -> onString opts - Just False -> offString opts - return $ if isNaN left then NA else Result left watts time acstr - -runBatt :: [String] -> Monitor String -runBatt = runBatt' ["BAT0","BAT1","BAT2"] - -runBatt' :: [String] -> [String] -> Monitor String -runBatt' bfs args = do - opts <- io $ parseOpts args - c <- io $ readBatteries opts =<< mapM batteryFiles bfs - case c of - Result x w t s -> - do l <- fmtPercent x - parseTemplate (l ++ s:[fmtTime $ floor t, fmtWatts w opts]) - NA -> return "N/A" - where fmtPercent :: Float -> Monitor [String] - fmtPercent x = do - p <- showPercentWithColors x - b <- showPercentBar (100 * x) x - return [b, p] - fmtWatts x o = color x o $ showDigits 1 x ++ "W" - fmtTime :: Integer -> String - fmtTime x = hours ++ ":" ++ if length minutes == 2 - then minutes else '0' : minutes - where hours = show (x `div` 3600) - minutes = show ((x `mod` 3600) `div` 60) - maybeColor Nothing _ = "" - maybeColor (Just c) str = "<fc=" ++ c ++ ">" ++ str ++ "</fc>" - color x o | x >= 0 = maybeColor (posColor o) - | x >= highThreshold o = maybeColor (highWColor o) - | x >= lowThreshold o = maybeColor (mediumWColor o) - | otherwise = maybeColor (lowWColor o) diff --git a/Plugins/Monitors/Common.hs b/Plugins/Monitors/Common.hs deleted file mode 100644 index cc1a6a7..0000000 --- a/Plugins/Monitors/Common.hs +++ /dev/null @@ -1,446 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Plugins.Monitors.Common --- Copyright : (c) Andrea Rossato --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> --- Stability : unstable --- Portability : unportable --- --- Utilities for creating monitors for Xmobar --- ------------------------------------------------------------------------------ - -module Plugins.Monitors.Common ( - -- * Monitors - -- $monitor - Monitor - , MConfig (..) - , Opts (..) - , setConfigValue - , getConfigValue - , mkMConfig - , runM - , io - -- * Parsers - -- $parsers - , runP - , skipRestOfLine - , getNumbers - , getNumbersAsString - , getAllBut - , getAfterString - , skipTillString - , parseTemplate - -- ** String Manipulation - -- $strings - , padString - , showWithPadding - , showWithColors - , showWithColors' - , showPercentWithColors - , showPercentsWithColors - , showPercentBar - , showLogBar - , showWithUnits - , takeDigits - , showDigits - , floatToPercent - , parseFloat - , parseInt - , stringParser - -- * Threaded Actions - -- $thread - , doActionTwiceWithDelay - , catRead - ) where - - -import Control.Concurrent -import Control.Monad.Reader -import qualified Data.ByteString.Lazy.Char8 as B -import Data.IORef -import qualified Data.Map as Map -import Data.List -import Numeric -import Text.ParserCombinators.Parsec -import System.Console.GetOpt -import Control.Exception (SomeException,handle) -import System.Process (readProcess) - -import Plugins --- $monitor - -type Monitor a = ReaderT MConfig IO a - -data MConfig = - MC { normalColor :: IORef (Maybe String) - , low :: IORef Int - , lowColor :: IORef (Maybe String) - , high :: IORef Int - , highColor :: IORef (Maybe String) - , template :: IORef String - , export :: IORef [String] - , ppad :: IORef Int - , minWidth :: IORef Int - , maxWidth :: IORef Int - , padChars :: IORef String - , padRight :: IORef Bool - , barBack :: IORef String - , barFore :: IORef String - , barWidth :: IORef Int - , useSuffix :: IORef Bool - } - --- | from 'http:\/\/www.haskell.org\/hawiki\/MonadState' -type Selector a = MConfig -> IORef a - -sel :: Selector a -> Monitor a -sel s = - do hs <- ask - liftIO $ readIORef (s hs) - -mods :: Selector a -> (a -> a) -> Monitor () -mods s m = - do v <- ask - io $ modifyIORef (s v) m - -setConfigValue :: a -> Selector a -> Monitor () -setConfigValue v s = - mods s (\_ -> v) - -getConfigValue :: Selector a -> Monitor a -getConfigValue = sel - -mkMConfig :: String - -> [String] - -> IO MConfig -mkMConfig tmpl exprts = - do lc <- newIORef Nothing - l <- newIORef 33 - nc <- newIORef Nothing - h <- newIORef 66 - hc <- newIORef Nothing - t <- newIORef tmpl - e <- newIORef exprts - p <- newIORef 0 - mn <- newIORef 0 - mx <- newIORef 0 - pc <- newIORef " " - pr <- newIORef False - bb <- newIORef ":" - bf <- newIORef "#" - bw <- newIORef 10 - up <- newIORef False - return $ MC nc l lc h hc t e p mn mx pc pr bb bf bw up - -data Opts = HighColor String - | NormalColor String - | LowColor String - | Low String - | High String - | Template String - | PercentPad String - | MinWidth String - | MaxWidth String - | Width String - | PadChars String - | PadAlign String - | BarBack String - | BarFore String - | BarWidth String - | UseSuffix String - -options :: [OptDescr Opts] -options = - [ Option "H" ["High"] (ReqArg High "number" ) "The high threshold" - , Option "L" ["Low"] (ReqArg Low "number" ) "The low threshold" - , Option "h" ["high"] (ReqArg HighColor "color number" ) "Color for the high threshold: ex \"#FF0000\"" - , Option "n" ["normal"] (ReqArg NormalColor "color number" ) "Color for the normal threshold: ex \"#00FF00\"" - , Option "l" ["low"] (ReqArg LowColor "color number" ) "Color for the low threshold: ex \"#0000FF\"" - , Option "t" ["template"] (ReqArg Template "output template" ) "Output template." - , Option "S" ["suffix"] (ReqArg UseSuffix "True/False" ) "Use % to display percents or other suffixes." - , Option "p" ["ppad"] (ReqArg PercentPad "percent padding") "Minimum percentage width." - , Option "m" ["minwidth"] (ReqArg MinWidth "minimum width" ) "Minimum field width" - , Option "M" ["maxwidth"] (ReqArg MaxWidth "maximum width" ) "Maximum field width" - , Option "w" ["width"] (ReqArg Width "fixed width" ) "Fixed field width" - , Option "c" ["padchars"] (ReqArg PadChars "padding chars" ) "Characters to use for padding" - , Option "a" ["align"] (ReqArg PadAlign "padding alignment") "'l' for left padding, 'r' for right" - , Option "b" ["bback"] (ReqArg BarBack "bar background" ) "Characters used to draw bar backgrounds" - , Option "f" ["bfore"] (ReqArg BarFore "bar foreground" ) "Characters used to draw bar foregrounds" - , Option "W" ["bwidth"] (ReqArg BarWidth "bar width" ) "Bar width" - ] - -doArgs :: [String] - -> ([String] -> Monitor String) - -> Monitor String -doArgs args action = - case getOpt Permute options args of - (o, n, []) -> do doConfigOptions o - action n - (_, _, errs) -> return (concat errs) - -doConfigOptions :: [Opts] -> Monitor () -doConfigOptions [] = io $ return () -doConfigOptions (o:oo) = - do let next = doConfigOptions oo - nz s = let x = read s in max 0 x - bool = (`elem` ["True", "true", "Yes", "yes", "On", "on"]) - (case o of - High h -> setConfigValue (read h) high - Low l -> setConfigValue (read l) low - HighColor c -> setConfigValue (Just c) highColor - NormalColor c -> setConfigValue (Just c) normalColor - LowColor c -> setConfigValue (Just c) lowColor - Template t -> setConfigValue t template - PercentPad p -> setConfigValue (nz p) ppad - MinWidth w -> setConfigValue (nz w) minWidth - MaxWidth w -> setConfigValue (nz w) maxWidth - Width w -> setConfigValue (nz w) minWidth >> - setConfigValue (nz w) maxWidth - PadChars s -> setConfigValue s padChars - PadAlign a -> setConfigValue ("r" `isPrefixOf` a) padRight - BarBack s -> setConfigValue s barBack - BarFore s -> setConfigValue s barFore - BarWidth w -> setConfigValue (nz w) barWidth - UseSuffix u -> setConfigValue (bool u) useSuffix) >> next - -runM :: [String] -> IO MConfig -> ([String] -> Monitor String) -> Int - -> (String -> IO ()) -> IO () -runM args conf action r cb = handle (cb . showException) loop - where ac = doArgs args action - loop = conf >>= runReaderT ac >>= cb >> tenthSeconds r >> loop - -showException :: SomeException -> String -showException = ("error: "++) . show . flip asTypeOf undefined - -io :: IO a -> Monitor a -io = liftIO - --- $parsers - -runP :: Parser [a] -> String -> IO [a] -runP p i = - case parse p "" i of - Left _ -> return [] - Right x -> return x - -getAllBut :: String -> Parser String -getAllBut s = - manyTill (noneOf s) (char $ head s) - -getNumbers :: Parser Float -getNumbers = skipMany space >> many1 digit >>= \n -> return $ read n - -getNumbersAsString :: Parser String -getNumbersAsString = skipMany space >> many1 digit >>= \n -> return n - -skipRestOfLine :: Parser Char -skipRestOfLine = - do many $ noneOf "\n\r" - newline - -getAfterString :: String -> Parser String -getAfterString s = - do { try $ manyTill skipRestOfLine $ string s - ; manyTill anyChar newline - } <|> return "" - -skipTillString :: String -> Parser String -skipTillString s = - manyTill skipRestOfLine $ string s - --- | Parses the output template string -templateStringParser :: Parser (String,String,String) -templateStringParser = - do { s <- nonPlaceHolder - ; com <- templateCommandParser - ; ss <- nonPlaceHolder - ; return (s, com, ss) - } - where - nonPlaceHolder = liftM concat . many $ - many1 (noneOf "<") <|> colorSpec - --- | Recognizes color specification and returns it unchanged -colorSpec :: Parser String -colorSpec = try (string "</fc>") <|> try ( - do string "<fc=" - s <- many1 (alphaNum <|> char ',' <|> char '#') - char '>' - return $ "<fc=" ++ s ++ ">") - --- | Parses the command part of the template string -templateCommandParser :: Parser String -templateCommandParser = - do { char '<' - ; com <- many $ noneOf ">" - ; char '>' - ; return com - } - --- | Combines the template parsers -templateParser :: Parser [(String,String,String)] -templateParser = many templateStringParser --"%") - --- | Takes a list of strings that represent the values of the exported --- keys. The strings are joined with the exported keys to form a map --- to be combined with 'combine' to the parsed template. Returns the --- final output of the monitor. -parseTemplate :: [String] -> Monitor String -parseTemplate l = - do t <- getConfigValue template - s <- io $ runP templateParser t - e <- getConfigValue export - let m = Map.fromList . zip e $ l - return $ combine m s - --- | Given a finite "Map" and a parsed templatet produces the --- | resulting output string. -combine :: Map.Map String String -> [(String, String, String)] -> String -combine _ [] = [] -combine m ((s,ts,ss):xs) = - s ++ str ++ ss ++ combine m xs - where str = Map.findWithDefault err ts m - err = "<" ++ ts ++ " not found!>" - --- $strings - -type Pos = (Int, Int) - -takeDigits :: Int -> Float -> Float -takeDigits d n = - fromIntegral (round (n * fact) :: Int) / fact - where fact = 10 ^ d - -showDigits :: (RealFloat a) => Int -> a -> String -showDigits d n = showFFloat (Just d) n "" - -showWithUnits :: Int -> Int -> Float -> String -showWithUnits d n x - | x < 0 = '-' : showWithUnits d n (-x) - | n > 3 || x < 10^(d + 1) = show (round x :: Int) ++ units n - | x <= 1024 = showDigits d (x/1024) ++ units (n+1) - | otherwise = showWithUnits d (n+1) (x/1024) - where units = (!!) ["B", "K", "M", "G", "T"] - -padString :: Int -> Int -> String -> Bool -> String -> String -padString mnw mxw pad pr s = - let len = length s - rmin = if mnw <= 0 then 1 else mnw - rmax = if mxw <= 0 then max len rmin else mxw - (rmn, rmx) = if rmin <= rmax then (rmin, rmax) else (rmax, rmin) - rlen = min (max rmn len) rmx - in if rlen < len then - take rlen s - else let ps = take (rlen - len) (cycle pad) - in if pr then s ++ ps else ps ++ s - -parseFloat :: String -> Float -parseFloat s = case readFloat s of - (v, _):_ -> v - _ -> 0 - -parseInt :: String -> Int -parseInt s = case readDec s of - (v, _):_ -> v - _ -> 0 - -floatToPercent :: Float -> Monitor String -floatToPercent n = - do pad <- getConfigValue ppad - pc <- getConfigValue padChars - pr <- getConfigValue padRight - up <- getConfigValue useSuffix - let p = showDigits 0 (n * 100) - ps = if up then "%" else "" - return $ padString pad pad pc pr p ++ ps - -stringParser :: Pos -> B.ByteString -> String -stringParser (x,y) = - B.unpack . li x . B.words . li y . B.lines - where li i l | length l > i = l !! i - | otherwise = B.empty - -setColor :: String -> Selector (Maybe String) -> Monitor String -setColor str s = - do a <- getConfigValue s - case a of - Nothing -> return str - Just c -> return $ - "<fc=" ++ c ++ ">" ++ str ++ "</fc>" - -showWithPadding :: String -> Monitor String -showWithPadding s = - do mn <- getConfigValue minWidth - mx <- getConfigValue maxWidth - p <- getConfigValue padChars - pr <- getConfigValue padRight - return $ padString mn mx p pr s - -colorizeString :: (Num a, Ord a) => a -> String -> Monitor String -colorizeString x s = do - h <- getConfigValue high - l <- getConfigValue low - let col = setColor s - [ll,hh] = map fromIntegral $ sort [l, h] -- consider high < low - head $ [col highColor | x > hh ] ++ - [col normalColor | x > ll ] ++ - [col lowColor | True] - -showWithColors :: (Num a, Ord a) => (a -> String) -> a -> Monitor String -showWithColors f x = showWithPadding (f x) >>= colorizeString x - -showWithColors' :: (Num a, Ord a) => String -> a -> Monitor String -showWithColors' str = showWithColors (const str) - -showPercentsWithColors :: [Float] -> Monitor [String] -showPercentsWithColors fs = - do fstrs <- mapM floatToPercent fs - zipWithM (showWithColors . const) fstrs (map (*100) fs) - -showPercentWithColors :: Float -> Monitor String -showPercentWithColors f = liftM head $ showPercentsWithColors [f] - -showPercentBar :: Float -> Float -> Monitor String -showPercentBar v x = do - bb <- getConfigValue barBack - bf <- getConfigValue barFore - bw <- getConfigValue barWidth - let len = min bw $ round (fromIntegral bw * x) - s <- colorizeString v (take len $ cycle bf) - return $ s ++ take (bw - len) (cycle bb) - -showLogBar :: Float -> Float -> Monitor String -showLogBar f v = do - h <- fromIntegral `fmap` getConfigValue high - l <- fromIntegral `fmap` getConfigValue low - bw <- fromIntegral `fmap` getConfigValue barWidth - let [ll, hh] = sort [l, h] - choose x | x == 0.0 = 0 - | x <= ll = 1 / bw - | otherwise = f + logBase 2 (x / hh) / bw - showPercentBar v $ choose v - --- $threads - -doActionTwiceWithDelay :: Int -> IO [a] -> IO ([a], [a]) -doActionTwiceWithDelay delay action = - do v1 <- newMVar [] - forkIO $! getData action v1 0 - v2 <- newMVar [] - forkIO $! getData action v2 delay - threadDelay (delay `div` 3 * 4) - a <- readMVar v1 - b <- readMVar v2 - return (a,b) - -getData :: IO a -> MVar a -> Int -> IO () -getData action var d = - do threadDelay d - s <- action - modifyMVar_ var (\_ -> return $! s) - -catRead :: FilePath -> IO B.ByteString -catRead file = B.pack `fmap` readProcess "/bin/cat" [file] "" diff --git a/Plugins/Monitors/CoreCommon.hs b/Plugins/Monitors/CoreCommon.hs deleted file mode 100644 index 80e7700..0000000 --- a/Plugins/Monitors/CoreCommon.hs +++ /dev/null @@ -1,59 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Plugins.Monitors.CoreCommon --- Copyright : (c) Juraj Hercek --- License : BSD-style (see LICENSE) --- --- Maintainer : Juraj Hercek <juhe_haskell@hck.sk> --- Stability : unstable --- Portability : unportable --- --- The common part for cpu core monitors (e.g. cpufreq, coretemp) --- ------------------------------------------------------------------------------ - -module Plugins.Monitors.CoreCommon where - -import Plugins.Monitors.Common -import System.Posix.Files (fileExist) -import System.IO (withFile, IOMode(ReadMode), hGetLine) -import System.Directory -import Data.Char (isDigit) -import Data.List (isPrefixOf) - --- | --- Function checks the existence of first file specified by pattern and if the --- file doesn't exists failure message is shown, otherwise the data retrieval --- is performed. -checkedDataRetrieval :: (Num a, Ord a, Show a) => - String -> String -> String -> String -> (Double -> a) - -> (a -> String) -> Monitor String -checkedDataRetrieval failureMessage dir file pattern trans fmt = do - exists <- io $ fileExist $ concat [dir, "/", pattern, "0/", file] - case exists of - False -> return failureMessage - True -> retrieveData dir file pattern trans fmt - --- | --- Function retrieves data from files in directory dir specified by --- pattern. String values are converted to double and 'trans' applied --- to each one. Final array is processed by template parser function --- and returned as monitor string. -retrieveData :: (Num a, Ord a, Show a) => - String -> String -> String -> (Double -> a) -> (a -> String) -> - Monitor String -retrieveData dir file pattern trans fmt = do - count <- io $ dirCount dir pattern - contents <- io $ mapM getGuts $ files count - values <- mapM (showWithColors fmt) $ map conversion contents - parseTemplate values - where - getGuts f = withFile f ReadMode hGetLine - dirCount path str = getDirectoryContents path - >>= return . length - . filter (\s -> str `isPrefixOf` s - && isDigit (last s)) - files count = map (\i -> concat [dir, "/", pattern, show i, "/", file]) - [0 .. count - 1] - conversion = trans . (read :: String -> Double) - diff --git a/Plugins/Monitors/CoreTemp.hs b/Plugins/Monitors/CoreTemp.hs deleted file mode 100644 index a24b284..0000000 --- a/Plugins/Monitors/CoreTemp.hs +++ /dev/null @@ -1,41 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Plugins.Monitors.CoreTemp --- Copyright : (c) Juraj Hercek --- License : BSD-style (see LICENSE) --- --- Maintainer : Juraj Hercek <juhe_haskell@hck.sk> --- Stability : unstable --- Portability : unportable --- --- A core temperature monitor for Xmobar --- ------------------------------------------------------------------------------ - -module Plugins.Monitors.CoreTemp where - -import Plugins.Monitors.Common -import Plugins.Monitors.CoreCommon - --- | --- Core temperature default configuration. Default template contains only one --- core temperature, user should specify custom template in order to get more --- core frequencies. -coreTempConfig :: IO MConfig -coreTempConfig = mkMConfig - "Temp: <core0>C" -- template - (zipWith (++) (repeat "core") (map show [0 :: Int ..])) -- available - -- replacements - --- | --- Function retrieves monitor string holding the core temperature --- (or temperatures) -runCoreTemp :: [String] -> Monitor String -runCoreTemp _ = do - let dir = "/sys/bus/platform/devices" - file = "temp1_input" - pattern = "coretemp." - divisor = 1e3 :: Double - failureMessage = "CoreTemp: N/A" - checkedDataRetrieval failureMessage dir file pattern (/divisor) show - diff --git a/Plugins/Monitors/Cpu.hs b/Plugins/Monitors/Cpu.hs deleted file mode 100644 index ab89246..0000000 --- a/Plugins/Monitors/Cpu.hs +++ /dev/null @@ -1,53 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Plugins.Monitors.Cpu --- Copyright : (c) Andrea Rossato --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> --- Stability : unstable --- Portability : unportable --- --- A cpu monitor for Xmobar --- ------------------------------------------------------------------------------ - -module Plugins.Monitors.Cpu where - -import Plugins.Monitors.Common -import qualified Data.ByteString.Lazy.Char8 as B - -cpuConfig :: IO MConfig -cpuConfig = mkMConfig - "Cpu: <total>%" - ["bar","total","user","nice","system","idle"] - -cpuData :: IO [Float] -cpuData = do s <- B.readFile "/proc/stat" - return $ cpuParser s - -cpuParser :: B.ByteString -> [Float] -cpuParser = - map (read . B.unpack) . tail . B.words . head . B.lines - -parseCPU :: IO [Float] -parseCPU = - do (a,b) <- doActionTwiceWithDelay 750000 cpuData - let dif = zipWith (-) b a - tot = foldr (+) 0 dif - percent = map (/ tot) dif - return percent - -formatCpu :: [Float] -> Monitor [String] -formatCpu [] = return $ repeat "" -formatCpu xs = do - let t = foldr (+) 0 $ take 3 xs - b <- showPercentBar (100 * t) t - ps <- showPercentsWithColors (t:xs) - return (b:ps) - -runCpu :: [String] -> Monitor String -runCpu _ = - do c <- io parseCPU - l <- formatCpu c - parseTemplate l diff --git a/Plugins/Monitors/CpuFreq.hs b/Plugins/Monitors/CpuFreq.hs deleted file mode 100644 index 4f01922..0000000 --- a/Plugins/Monitors/CpuFreq.hs +++ /dev/null @@ -1,43 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Plugins.Monitors.CpuFreq --- Copyright : (c) Juraj Hercek --- License : BSD-style (see LICENSE) --- --- Maintainer : Juraj Hercek <juhe_haskell@hck.sk> --- Stability : unstable --- Portability : unportable --- --- A cpu frequency monitor for Xmobar --- ------------------------------------------------------------------------------ - -module Plugins.Monitors.CpuFreq where - -import Plugins.Monitors.Common -import Plugins.Monitors.CoreCommon - --- | --- Cpu frequency default configuration. Default template contains only one --- core frequency, user should specify custom template in order to get more --- cpu frequencies. -cpuFreqConfig :: IO MConfig -cpuFreqConfig = mkMConfig - "Freq: <cpu0>" -- template - (zipWith (++) (repeat "cpu") (map show [0 :: Int ..])) -- available - -- replacements - --- | --- Function retrieves monitor string holding the cpu frequency (or --- frequencies) -runCpuFreq :: [String] -> Monitor String -runCpuFreq _ = do - let dir = "/sys/devices/system/cpu" - file = "cpufreq/scaling_cur_freq" - pattern = "cpu" - divisor = 1e6 :: Double - failureMessage = "CpuFreq: N/A" - fmt x | x < 1 = show (round (x * 1000) :: Integer) ++ "MHz" - | otherwise = showDigits 1 x ++ "GHz" - checkedDataRetrieval failureMessage dir file pattern (/divisor) fmt - diff --git a/Plugins/Monitors/Disk.hs b/Plugins/Monitors/Disk.hs deleted file mode 100644 index f3a7a2a..0000000 --- a/Plugins/Monitors/Disk.hs +++ /dev/null @@ -1,137 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Plugins.Monitors.Disk --- Copyright : (c) Jose A Ortega Ruiz --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A Ortega Ruiz <jao@gnu.org> --- Stability : unstable --- Portability : unportable --- --- Disk usage and throughput monitors for Xmobar --- ------------------------------------------------------------------------------ - -module Plugins.Monitors.Disk ( diskUConfig, runDiskU - , diskIOConfig, runDiskIO - ) where - -import Plugins.Monitors.Common -import StatFS - -import Control.Monad (zipWithM) -import qualified Data.ByteString.Lazy.Char8 as B -import Data.List (isPrefixOf, find, intercalate) - -diskIOConfig :: IO MConfig -diskIOConfig = mkMConfig "" ["total", "read", "write", - "totalbar", "readbar", "writebar"] - -diskUConfig :: IO MConfig -diskUConfig = mkMConfig "" - ["size", "free", "used", "freep", "usedp", "freebar", "usedbar"] - -type DevName = String -type Path = String - -mountedDevices :: [String] -> IO [(DevName, Path)] -mountedDevices req = do - s <- B.readFile "/etc/mtab" - return (parse s) - where - parse = map undev . filter isDev . map (firstTwo . B.words) . B.lines - firstTwo (a:b:_) = (B.unpack a, B.unpack b) - firstTwo _ = ("", "") - isDev (d, p) = "/dev/" `isPrefixOf` d && - (p `elem` req || drop 5 d `elem` req) - undev (d, f) = (drop 5 d, f) - -diskData :: IO [(DevName, [Float])] -diskData = do - s <- B.readFile "/proc/diskstats" - let extract ws = (head ws, map read (tail ws)) - return $ map (extract . map B.unpack . drop 2 . B.words) (B.lines s) - -mountedData :: [DevName] -> IO [(DevName, [Float])] -mountedData devs = do - (dt, dt') <- doActionTwiceWithDelay 750000 diskData - return $ map (parseDev (zipWith diff dt' dt)) devs - where diff (dev, xs) (_, ys) = (dev, zipWith (-) xs ys) - -parseDev :: [(DevName, [Float])] -> DevName -> (DevName, [Float]) -parseDev dat dev = - case find ((==dev) . fst) dat of - Nothing -> (dev, [0, 0, 0]) - Just (_, xs) -> - let rSp = speed (xs !! 2) (xs !! 3) - wSp = speed (xs !! 6) (xs !! 7) - sp = speed (xs !! 2 + xs !! 6) (xs !! 3 + xs !! 7) - speed x t = if t == 0 then 0 else 500 * x / t - dat' = if length xs > 6 then [sp, rSp, wSp] else [0, 0, 0] - in (dev, dat') - -fsStats :: String -> IO [Integer] -fsStats path = do - stats <- getFileSystemStats path - case stats of - Nothing -> return [-1, -1, -1] - Just f -> let tot = fsStatByteCount f - free = fsStatBytesAvailable f - used = fsStatBytesUsed f - in return [tot, free, used] - -speedToStr :: Float -> String -speedToStr = showWithUnits 2 1 - -sizeToStr :: Integer -> String -sizeToStr = showWithUnits 3 0 . fromIntegral - -findTempl :: DevName -> Path -> [(String, String)] -> String -findTempl dev path disks = - case find devOrPath disks of - Just (_, t) -> t - Nothing -> "" - where devOrPath (d, _) = d == dev || d == path - -devTemplates :: [(String, String)] - -> [(DevName, Path)] - -> [(DevName, [Float])] - -> [(String, [Float])] -devTemplates disks mounted dat = - map (\(d, p) -> (findTempl d p disks, findData d)) mounted - where findData dev = case find ((==dev) . fst) dat of - Nothing -> [0, 0, 0] - Just (_, xs) -> xs - -runDiskIO' :: (String, [Float]) -> Monitor String -runDiskIO' (tmp, xs) = do - s <- mapM (showWithColors speedToStr) xs - b <- mapM (showLogBar 0.8) xs - setConfigValue tmp template - parseTemplate $ s ++ b - -runDiskIO :: [(String, String)] -> [String] -> Monitor String -runDiskIO disks _ = do - mounted <- io $ mountedDevices (map fst disks) - dat <- io $ mountedData (map fst mounted) - strs <- mapM runDiskIO' $ devTemplates disks mounted dat - return $ intercalate " " strs - -runDiskU' :: String -> String -> Monitor String -runDiskU' tmp path = do - setConfigValue tmp template - fstats <- io $ fsStats path - let strs = map sizeToStr fstats - freep = (fstats !! 1) * 100 `div` head fstats - fr = fromIntegral freep / 100 - s <- zipWithM showWithColors' strs [100, freep, 100 - freep] - sp <- showPercentsWithColors [fr, 1 - fr] - fb <- showPercentBar (fromIntegral freep) fr - ub <- showPercentBar (fromIntegral $ 100 - freep) (1 - fr) - parseTemplate $ s ++ sp ++ [fb, ub] - -runDiskU :: [(String, String)] -> [String] -> Monitor String -runDiskU disks _ = do - devs <- io $ mountedDevices (map fst disks) - strs <- mapM (\(d, p) -> runDiskU' (findTempl d p disks) p) devs - return $ intercalate " " strs diff --git a/Plugins/Monitors/MPD.hs b/Plugins/Monitors/MPD.hs deleted file mode 100644 index daf0ed4..0000000 --- a/Plugins/Monitors/MPD.hs +++ /dev/null @@ -1,115 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Plugins.Monitors.MPD --- Copyright : (c) Jose A Ortega Ruiz --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A Ortega Ruiz <jao@gnu.org> --- Stability : unstable --- Portability : unportable --- --- MPD status and song --- ------------------------------------------------------------------------------ - -module Plugins.Monitors.MPD ( mpdConfig, runMPD ) where - -import Plugins.Monitors.Common -import System.Console.GetOpt -import qualified Network.MPD as M - -mpdConfig :: IO MConfig -mpdConfig = mkMConfig "MPD: <state>" - [ "bar", "state", "statei", "volume", "length" - , "lapsed", "remaining", "plength", "ppos", "file" - , "name", "artist", "composer", "performer" - , "album", "title", "track", "genre" - ] - -data MOpts = MOpts - { mPlaying :: String - , mStopped :: String - , mPaused :: String - , mHost :: String - , mPort :: Integer - , mPassword :: String - } - -defaultOpts :: MOpts -defaultOpts = MOpts - { mPlaying = ">>" - , mStopped = "><" - , mPaused = "||" - , mHost = "127.0.0.1" - , mPort = 6600 - , mPassword = "" - } - -options :: [OptDescr (MOpts -> MOpts)] -options = - [ Option "P" ["playing"] (ReqArg (\x o -> o { mPlaying = x }) "") "" - , Option "S" ["stopped"] (ReqArg (\x o -> o { mStopped = x }) "") "" - , Option "Z" ["paused"] (ReqArg (\x o -> o { mPaused = x }) "") "" - , Option "h" ["host"] (ReqArg (\x o -> o { mHost = x }) "") "" - , Option "p" ["port"] (ReqArg (\x o -> o { mPort = read x }) "") "" - , Option "x" ["password"] (ReqArg (\x o -> o { mPassword = x }) "") "" - ] - -runMPD :: [String] -> Monitor String -runMPD args = do - opts <- io $ mopts args - let mpd = M.withMPDEx (mHost opts) (mPort opts) (mPassword opts) - status <- io $ mpd M.status - song <- io $ mpd M.currentSong - s <- parseMPD status song opts - parseTemplate s - -mopts :: [String] -> IO MOpts -mopts argv = - case getOpt Permute options argv of - (o, _, []) -> return $ foldr id defaultOpts o - (_, _, errs) -> ioError . userError $ concat errs - -parseMPD :: M.Response M.Status -> M.Response (Maybe M.Song) -> MOpts - -> Monitor [String] -parseMPD (Left e) _ _ = return $ show e:repeat "" -parseMPD (Right st) song opts = do - songData <- parseSong song - bar <- showPercentBar (100 * b) b - return $ [bar, ss, si, vol, len, lap, remain, plen, ppos] ++ songData - where s = M.stState st - ss = show s - si = stateGlyph s opts - vol = int2str $ M.stVolume st - (p, t) = M.stTime st - [lap, len, remain] = map showTime [floor p, t, max 0 (t - floor p)] - b = if t > 0 then realToFrac $ p / fromIntegral t else 0 - plen = int2str $ M.stPlaylistLength st - ppos = maybe "" (int2str . (+1)) $ M.stSongPos st - -stateGlyph :: M.State -> MOpts -> String -stateGlyph s o = - case s of - M.Playing -> mPlaying o - M.Paused -> mPaused o - M.Stopped -> mStopped o - -parseSong :: M.Response (Maybe M.Song) -> Monitor [String] -parseSong (Left _) = return $ repeat "" -parseSong (Right Nothing) = return $ repeat "" -parseSong (Right (Just s)) = - let join [] = "" - join (x:xs) = foldl (\a o -> a ++ ", " ++ o) x xs - str sel = maybe "" join (M.sgGet sel s) - sels = [ M.Name, M.Artist, M.Composer, M.Performer - , M.Album, M.Title, M.Track, M.Genre ] - fields = M.sgFilePath s : map str sels - in mapM showWithPadding fields - -showTime :: Integer -> String -showTime t = int2str minutes ++ ":" ++ int2str seconds - where minutes = t `div` 60 - seconds = t `mod` 60 - -int2str :: (Num a, Ord a) => a -> String -int2str x = if x < 10 then '0':sx else sx where sx = show x diff --git a/Plugins/Monitors/Mem.hs b/Plugins/Monitors/Mem.hs deleted file mode 100644 index 5c55ee2..0000000 --- a/Plugins/Monitors/Mem.hs +++ /dev/null @@ -1,59 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Plugins.Monitors.Mem --- Copyright : (c) Andrea Rossato --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> --- Stability : unstable --- Portability : unportable --- --- A memory monitor for Xmobar --- ------------------------------------------------------------------------------ - -module Plugins.Monitors.Mem (memConfig, runMem, totalMem, usedMem) where - -import Plugins.Monitors.Common - -memConfig :: IO MConfig -memConfig = mkMConfig - "Mem: <usedratio>% (<cache>M)" -- template - ["usedbar", "freebar", "usedratio", "total", - "free", "buffer", "cache", "rest", "used"] -- available replacements - -fileMEM :: IO String -fileMEM = readFile "/proc/meminfo" - -parseMEM :: IO [Float] -parseMEM = - do file <- fileMEM - let content = map words $ take 4 $ lines file - [total, free, buffer, cache] = map (\line -> (read $ line !! 1 :: Float) / 1024) content - rest = free + buffer + cache - used = total - rest - usedratio = used / total - return [usedratio, total, free, buffer, cache, rest, used] - -totalMem :: IO Float -totalMem = fmap ((*1024) . (!!1)) parseMEM - -usedMem :: IO Float -usedMem = fmap ((*1024) . (!!6)) parseMEM - -formatMem :: [Float] -> Monitor [String] -formatMem (r:xs) = - do let f = showDigits 0 - rr = 100 * r - ub <- showPercentBar rr r - fb <- showPercentBar (100 - rr) (1 - r) - rs <- showPercentWithColors r - s <- mapM (showWithColors f) xs - return (ub:fb:rs:s) -formatMem _ = return $ replicate 9 "N/A" - -runMem :: [String] -> Monitor String -runMem _ = - do m <- io parseMEM - l <- formatMem m - parseTemplate l diff --git a/Plugins/Monitors/MultiCpu.hs b/Plugins/Monitors/MultiCpu.hs deleted file mode 100644 index 535196a..0000000 --- a/Plugins/Monitors/MultiCpu.hs +++ /dev/null @@ -1,81 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Plugins.Monitors.MultiCpu --- Copyright : (c) Jose A Ortega Ruiz --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A Ortega <jao@gnu.org> --- Stability : unstable --- Portability : unportable --- --- A multi-cpu monitor for Xmobar --- ------------------------------------------------------------------------------ - -module Plugins.Monitors.MultiCpu(multiCpuConfig, runMultiCpu) where - -import Plugins.Monitors.Common -import qualified Data.ByteString.Lazy.Char8 as B -import Data.List (isPrefixOf, transpose, unfoldr) - -multiCpuConfig :: IO MConfig -multiCpuConfig = - mkMConfig "Cpu: <total>%" $ - map ("auto" ++) monitors - ++ [ k ++ n | n <- "" : map show [0 :: Int ..] - , k <- monitors] - where monitors = ["bar","total","user","nice","system","idle"] - - -cpuData :: IO [[Float]] -cpuData = do s <- B.readFile "/proc/stat" - return $ cpuParser s - -cpuParser :: B.ByteString -> [[Float]] -cpuParser = map parseList . cpuLists - where cpuLists = takeWhile isCpu . map B.words . B.lines - isCpu (w:_) = "cpu" `isPrefixOf` B.unpack w - isCpu _ = False - parseList = map (read . B.unpack) . tail - -parseCpuData :: IO [[Float]] -parseCpuData = - do (as, bs) <- doActionTwiceWithDelay 950000 cpuData - let p0 = zipWith percent bs as - return p0 - -percent :: [Float] -> [Float] -> [Float] -percent b a = if tot > 0 then map (/ tot) $ take 4 dif else [0, 0, 0, 0] - where dif = zipWith (-) b a - tot = foldr (+) 0 dif - -formatMultiCpus :: [[Float]] -> Monitor [String] -formatMultiCpus [] = return $ repeat "" -formatMultiCpus xs = fmap concat $ mapM formatCpu xs - -formatCpu :: [Float] -> Monitor [String] -formatCpu xs - | length xs < 4 = showPercentsWithColors $ replicate 6 0.0 - | otherwise = let t = foldr (+) 0 $ take 3 xs - in do b <- showPercentBar (100 * t) t - ps <- showPercentsWithColors (t:xs) - return (b:ps) - -splitEvery :: (Eq a) => Int -> [a] -> [[a]] -splitEvery n = unfoldr (\x -> if x == [] - then Nothing - else Just $ splitAt n x) - -groupData :: [String] -> [[String]] -groupData = transpose . tail . splitEvery 6 - -formatAutoCpus :: [String] -> Monitor [String] -formatAutoCpus [] = return $ replicate 6 "" -formatAutoCpus xs = return $ map unwords (groupData xs) - -runMultiCpu :: [String] -> Monitor String -runMultiCpu _ = - do c <- io parseCpuData - l <- formatMultiCpus c - a <- formatAutoCpus l - parseTemplate (a ++ l) diff --git a/Plugins/Monitors/Net.hs b/Plugins/Monitors/Net.hs deleted file mode 100644 index d9cd534..0000000 --- a/Plugins/Monitors/Net.hs +++ /dev/null @@ -1,96 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Plugins.Monitors.Net --- Copyright : (c) Andrea Rossato --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> --- Stability : unstable --- Portability : unportable --- --- A net device monitor for Xmobar --- ------------------------------------------------------------------------------ - -module Plugins.Monitors.Net (netConfig, runNet) where - -import Plugins.Monitors.Common -import qualified Data.ByteString.Lazy.Char8 as B - -data NetDev = NA - | ND { netDev :: String - , netRx :: Float - , netTx :: Float - } deriving (Eq,Show,Read) - -interval :: Int -interval = 500000 - -netConfig :: IO MConfig -netConfig = mkMConfig - "<dev>: <rx>KB|<tx>KB" -- template - ["dev", "rx", "tx", "rxbar", "txbar"] -- available replacements - --- Given a list of indexes, take the indexed elements from a list. -getNElements :: [Int] -> [a] -> [a] -getNElements ns as = map (as!!) ns - --- Split into words, with word boundaries indicated by the given predicate. --- Drops delimiters. Duplicates 'Data.List.Split.wordsBy'. --- --- > map (wordsBy (`elem` " :")) ["lo:31174097 31174097", "eth0: 43598 88888"] --- --- will become @[["lo","31174097","31174097"], ["eth0","43598","88888"]]@ -wordsBy :: (a -> Bool) -> [a] -> [[a]] -wordsBy f s = case dropWhile f s of - [] -> [] - s' -> w : wordsBy f s'' where (w, s'') = break f s' - -readNetDev :: [String] -> NetDev -readNetDev [] = NA -readNetDev xs = - ND (xs !! 0) (r (xs !! 1)) (r (xs !! 2)) - where r s | s == "" = 0 - | otherwise = read s / 1024 - -fileNET :: IO [NetDev] -fileNET = - do f <- B.readFile "/proc/net/dev" - return $ netParser f - -netParser :: B.ByteString -> [NetDev] -netParser = - map (readNetDev . getNElements [0,1,9] . wordsBy (`elem` " :") . B.unpack) . drop 2 . B.lines - -formatNet :: Float -> Monitor (String, String) -formatNet d = do - s <- getConfigValue useSuffix - let str = if s then (++"Kb/s") . showDigits 1 else showDigits 1 - b <- showLogBar 0.9 d - x <- showWithColors str d - return (x, b) - -printNet :: NetDev -> Monitor String -printNet nd = - case nd of - ND d r t -> do (rx, rb) <- formatNet r - (tx, tb) <- formatNet t - parseTemplate [d,rx,tx,rb,tb] - NA -> return "N/A" - -parseNET :: String -> IO [NetDev] -parseNET nd = - do (a,b) <- doActionTwiceWithDelay interval fileNET - let netRate f da db = takeDigits 2 $ (f db - f da) * fromIntegral (1000000 `div` interval) - diffRate (da,db) = ND (netDev da) - (netRate netRx da db) - (netRate netTx da db) - return $ filter (\d -> netDev d == nd) $ map diffRate $ zip a b - -runNet :: [String] -> Monitor String -runNet nd = - do pn <- io $ parseNET $ head nd - n <- case pn of - [x] -> return x - _ -> return NA - printNet n diff --git a/Plugins/Monitors/Swap.hs b/Plugins/Monitors/Swap.hs deleted file mode 100644 index e466dbb..0000000 --- a/Plugins/Monitors/Swap.hs +++ /dev/null @@ -1,55 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Plugins.Monitors.Swap --- Copyright : (c) Andrea Rossato --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> --- Stability : unstable --- Portability : unportable --- --- A swap usage monitor for Xmobar --- ------------------------------------------------------------------------------ - -module Plugins.Monitors.Swap where - -import Plugins.Monitors.Common - -import qualified Data.ByteString.Lazy.Char8 as B - -swapConfig :: IO MConfig -swapConfig = mkMConfig - "Swap: <usedratio>%" -- template - ["usedratio", "total", "used", "free"] -- available replacements - -fileMEM :: IO B.ByteString -fileMEM = B.readFile "/proc/meminfo" - -parseMEM :: IO [Float] -parseMEM = - do file <- fileMEM - let li i l - | l /= [] = head l !! i - | otherwise = B.empty - fs s l - | l == [] = False - | otherwise = head l == B.pack s - get_data s = flip (/) 1024 . read . B.unpack . li 1 . filter (fs s) - st = map B.words . B.lines $ file - tot = get_data "SwapTotal:" st - free = get_data "SwapFree:" st - return [(tot - free) / tot, tot, tot - free, free] - -formatSwap :: [Float] -> Monitor [String] -formatSwap (r:xs) = - do other <- mapM (showWithColors (showDigits 2)) xs - ratio <- showPercentWithColors r - return $ ratio:other -formatSwap _ = return $ replicate 4 "N/A" - -runSwap :: [String] -> Monitor String -runSwap _ = - do m <- io parseMEM - l <- formatSwap m - parseTemplate l diff --git a/Plugins/Monitors/Thermal.hs b/Plugins/Monitors/Thermal.hs deleted file mode 100644 index a3ffe6d..0000000 --- a/Plugins/Monitors/Thermal.hs +++ /dev/null @@ -1,42 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Plugins.Monitors.Thermal --- Copyright : (c) Juraj Hercek --- License : BSD-style (see LICENSE) --- --- Maintainer : Juraj Hercek <juhe_haskell@hck.sk> --- Stability : unstable --- Portability : unportable --- --- A thermal monitor for Xmobar --- ------------------------------------------------------------------------------ - -module Plugins.Monitors.Thermal where - -import qualified Data.ByteString.Lazy.Char8 as B -import Plugins.Monitors.Common -import System.Posix.Files (fileExist) - --- | Default thermal configuration. -thermalConfig :: IO MConfig -thermalConfig = mkMConfig - "Thm: <temp>C" -- template - ["temp"] -- available replacements - --- | Retrieves thermal information. Argument is name of thermal directory in --- \/proc\/acpi\/thermal_zone. Returns the monitor string parsed according to --- template (either default or user specified). -runThermal :: [String] -> Monitor String -runThermal args = do - let zone = head args - file = "/proc/acpi/thermal_zone/" ++ zone ++ "/temperature" - exists <- io $ fileExist file - case exists of - False -> return $ "Thermal (" ++ zone ++ "): N/A" - True -> do number <- io $ B.readFile file - >>= return . (read :: String -> Int) - . stringParser (1, 0) - thermal <- showWithColors show number - parseTemplate [ thermal ] - diff --git a/Plugins/Monitors/Top.hs b/Plugins/Monitors/Top.hs deleted file mode 100644 index e45210c..0000000 --- a/Plugins/Monitors/Top.hs +++ /dev/null @@ -1,179 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Plugins.Monitors.Top --- Copyright : (c) Jose A Ortega Ruiz --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A Ortega Ruiz <jao@gnu.org> --- Stability : unstable --- Portability : unportable --- --- Process activity and memory consumption monitors --- ------------------------------------------------------------------------------ - -{-# LANGUAGE ForeignFunctionInterface #-} - -module Plugins.Monitors.Top (startTop, topMemConfig, runTopMem) where - -import Plugins.Monitors.Common - -import Control.Exception (SomeException, handle) -import Data.IORef (IORef, newIORef, readIORef, writeIORef) -import Data.List (sortBy, foldl') -import Data.Ord (comparing) -import Data.Time.Clock (UTCTime, getCurrentTime, diffUTCTime) -import System.Directory (getDirectoryContents) -import System.FilePath ((</>)) -import System.IO (IOMode(ReadMode), hGetLine, withFile) -import System.Posix.Unistd (SysVar(ClockTick), getSysVar) - -import Foreign.C.Types - -maxEntries :: Int -maxEntries = 10 - -intStrs :: [String] -intStrs = map show [1..maxEntries] - -topMemConfig :: IO MConfig -topMemConfig = mkMConfig "<both1>" - [ k ++ n | n <- intStrs , k <- ["name", "mem", "both"]] - -topConfig :: IO MConfig -topConfig = mkMConfig "<both1>" - ("no" : [ k ++ n | n <- intStrs - , k <- [ "name", "cpu", "both" - , "mname", "mem", "mboth"]]) - -foreign import ccall "unistd.h getpagesize" - c_getpagesize :: CInt - -pageSize :: Float -pageSize = fromIntegral c_getpagesize / 1024 - -processes :: IO [FilePath] -processes = fmap (filter isPid) (getDirectoryContents "/proc") - where isPid = (`elem` ['0'..'9']) . head - -getProcessData :: FilePath -> IO [String] -getProcessData pidf = - handle ign $ withFile ("/proc" </> pidf </> "stat") ReadMode readWords - where readWords = fmap words . hGetLine - ign = const (return []) :: SomeException -> IO [String] - -handleProcesses :: ([String] -> a) -> IO [a] -handleProcesses f = - fmap (foldl' (\a p -> if length p < 15 then a else f p : a) []) - (processes >>= mapM getProcessData) - -showInfo :: String -> String -> Float -> Monitor [String] -showInfo nm sms mms = do - mnw <- getConfigValue maxWidth - mxw <- getConfigValue minWidth - let lsms = length sms - nmw = mnw - lsms - 1 - nmx = mxw - lsms - 1 - rnm = if nmw > 0 then padString nmw nmx " " True nm else nm - mstr <- showWithColors' sms mms - both <- showWithColors' (rnm ++ " " ++ sms) mms - return [nm, mstr, both] - -processName :: [String] -> String -processName = drop 1 . init . (!!1) - -sortTop :: [(String, Float)] -> [(String, Float)] -sortTop = sortBy (flip (comparing snd)) - -type MemInfo = (String, Float) - -meminfo :: [String] -> MemInfo -meminfo fs = (processName fs, pageSize * parseFloat (fs!!23)) - -meminfos :: IO [MemInfo] -meminfos = handleProcesses meminfo - -showMemInfo :: Float -> MemInfo -> Monitor [String] -showMemInfo scale (nm, rss) = - showInfo nm (showWithUnits 2 1 rss) (100 * rss / sc) - where sc = if scale > 0 then scale else 100 - -showMemInfos :: [MemInfo] -> Monitor [[String]] -showMemInfos ms = mapM (showMemInfo tm) ms - where tm = sum (map snd ms) - -runTopMem :: [String] -> Monitor String -runTopMem _ = do - mis <- io meminfos - pstr <- showMemInfos (sortTop mis) - parseTemplate $ concat pstr - -type Pid = Int -type TimeInfo = (String, Float) -type TimeEntry = (Pid, TimeInfo) -type Times = [TimeEntry] -type TimesRef = IORef (Times, UTCTime) - -timeMemEntry :: [String] -> (TimeEntry, MemInfo) -timeMemEntry fs = ((p, (n, t)), (n, r)) - where p = parseInt (head fs) - n = processName fs - t = parseFloat (fs!!13) + parseFloat (fs!!14) - (_, r) = meminfo fs - -timeMemEntries :: IO [(TimeEntry, MemInfo)] -timeMemEntries = handleProcesses timeMemEntry - -timeMemInfos :: IO (Times, [MemInfo], Int) -timeMemInfos = fmap res timeMemEntries - where res x = (sortBy (comparing fst) $ map fst x, map snd x, length x) - -combine :: Times -> Times -> Times -combine _ [] = [] -combine [] ts = ts -combine l@((p0, (n0, t0)):ls) r@((p1, (n1, t1)):rs) - | p0 == p1 && n0 == n1 = (p0, (n0, t1 - t0)) : combine ls rs - | p0 <= p1 = combine ls r - | otherwise = (p1, (n1, t1)) : combine l rs - -take' :: Int -> [a] -> [a] -take' m l = let !r = tk m l in length l `seq` r - where tk 0 _ = [] - tk _ [] = [] - tk n (x:xs) = let !r = tk (n - 1) xs in x : r - -topProcesses :: TimesRef -> Float -> IO (Int, [TimeInfo], [MemInfo]) -topProcesses tref scale = do - (t0, c0) <- readIORef tref - (t1, mis, len) <- timeMemInfos - c1 <- getCurrentTime - let scx = realToFrac (diffUTCTime c1 c0) * scale - !scx' = if scx > 0 then scx else scale - nts = map (\(_, (nm, t)) -> (nm, min 100 (t / scx'))) (combine t0 t1) - !t1' = take' (length t1) t1 - !nts' = take' maxEntries (sortTop nts) - !mis' = take' maxEntries (sortTop mis) - writeIORef tref (t1', c1) - return (len, nts', mis') - -showTimeInfo :: TimeInfo -> Monitor [String] -showTimeInfo (n, t) = showInfo n (showDigits 0 t) t - -showTimeInfos :: [TimeInfo] -> Monitor [[String]] -showTimeInfos = mapM showTimeInfo - -runTop :: TimesRef -> Float -> [String] -> Monitor String -runTop tref scale _ = do - (no, ps, ms) <- io $ topProcesses tref scale - pstr <- showTimeInfos ps - mstr <- showMemInfos ms - parseTemplate $ show no : concat (zipWith (++) pstr mstr) ++ repeat "N/A" - -startTop :: [String] -> Int -> (String -> IO ()) -> IO () -startTop a r cb = do - cr <- getSysVar ClockTick - c <- getCurrentTime - tref <- newIORef ([], c) - let scale = fromIntegral cr / 100 - _ <- topProcesses tref scale - runM a topConfig (runTop tref scale) r cb diff --git a/Plugins/Monitors/Uptime.hs b/Plugins/Monitors/Uptime.hs deleted file mode 100644 index 8524bcc..0000000 --- a/Plugins/Monitors/Uptime.hs +++ /dev/null @@ -1,50 +0,0 @@ ------------------------------------------------------------------------------- --- | --- Module : Plugins.Monitors.Uptime --- Copyright : (c) 2010 Jose Antonio Ortega Ruiz --- License : BSD3-style (see LICENSE) --- --- Maintainer : jao@gnu.org --- Stability : unstable --- Portability : unportable --- Created: Sun Dec 12, 2010 20:26 --- --- --- Uptime --- ------------------------------------------------------------------------------- - - -module Plugins.Monitors.Uptime (uptimeConfig, runUptime) where - -import Plugins.Monitors.Common - -import qualified Data.ByteString.Lazy.Char8 as B - -uptimeConfig :: IO MConfig -uptimeConfig = mkMConfig "Up <days>d <hours>h <minutes>m" - ["days", "hours", "minutes", "seconds"] - -readUptime :: IO Float -readUptime = - fmap (read . B.unpack . head . B.words) (B.readFile "/proc/uptime") - -secsPerDay :: Integer -secsPerDay = 24 * 3600 - -uptime :: Monitor [String] -uptime = do - t <- io readUptime - u <- getConfigValue useSuffix - let tsecs = floor t - secs = tsecs `mod` secsPerDay - days = tsecs `quot` secsPerDay - hours = secs `quot` 3600 - mins = (secs `mod` 3600) `div` 60 - ss = secs `mod` 60 - str x s = if u then show x ++ s else show x - mapM (`showWithColors'` days) - [str days "d", str hours "h", str mins "m", str ss "s"] - -runUptime :: [String] -> Monitor String -runUptime _ = uptime >>= parseTemplate diff --git a/Plugins/Monitors/Weather.hs b/Plugins/Monitors/Weather.hs deleted file mode 100644 index 1277438..0000000 --- a/Plugins/Monitors/Weather.hs +++ /dev/null @@ -1,141 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Plugins.Monitors.Weather --- Copyright : (c) Andrea Rossato --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> --- Stability : unstable --- Portability : unportable --- --- A weather monitor for Xmobar --- ------------------------------------------------------------------------------ - -module Plugins.Monitors.Weather where - -import Plugins.Monitors.Common - -import Control.Monad (when) -import System.Process -import System.Exit -import System.IO - -import Text.ParserCombinators.Parsec - - -weatherConfig :: IO MConfig -weatherConfig = mkMConfig - "<station>: <tempC>C, rh <rh>% (<hour>)" -- template - ["station" -- available replacements - , "stationState" - , "year" - , "month" - , "day" - , "hour" - , "wind" - , "visibility" - , "skyCondition" - , "tempC" - , "tempF" - , "dewPoint" - , "rh" - , "pressure" - ] - -data WeatherInfo = - WI { stationPlace :: String - , stationState :: String - , year :: String - , month :: String - , day :: String - , hour :: String - , wind :: String - , visibility :: String - , skyCondition :: String - , tempC :: Int - , tempF :: Int - , dewPoint :: String - , humidity :: Int - , pressure :: Int - } deriving (Show) - -pTime :: Parser (String, String, String, String) -pTime = do y <- getNumbersAsString - char '.' - m <- getNumbersAsString - char '.' - d <- getNumbersAsString - char ' ' - (h:hh:mi:mimi) <- getNumbersAsString - char ' ' - return (y, m, d ,([h]++[hh]++":"++[mi]++mimi)) - -pTemp :: Parser (Int, Int) -pTemp = do let num = digit <|> char '-' <|> char '.' - f <- manyTill num $ char ' ' - manyTill anyChar $ char '(' - c <- manyTill num $ char ' ' - skipRestOfLine - return $ (floor (read c :: Double), floor (read f :: Double)) - -pRh :: Parser Int -pRh = do s <- manyTill digit $ (char '%' <|> char '.') - return $ read s - -pPressure :: Parser Int -pPressure = do manyTill anyChar $ char '(' - s <- manyTill digit $ char ' ' - skipRestOfLine - return $ read s - -parseData :: Parser [WeatherInfo] -parseData = - do st <- getAllBut "," - space - ss <- getAllBut "(" - skipRestOfLine >> getAllBut "/" - (y,m,d,h) <- pTime - w <- getAfterString "Wind: " - v <- getAfterString "Visibility: " - sk <- getAfterString "Sky conditions: " - skipTillString "Temperature: " - (tC,tF) <- pTemp - dp <- getAfterString "Dew Point: " - skipTillString "Relative Humidity: " - rh <- pRh - skipTillString "Pressure (altimeter): " - p <- pPressure - manyTill skipRestOfLine eof - return $ [WI st ss y m d h w v sk tC tF dp rh p] - -defUrl :: String -defUrl = "http://weather.noaa.gov/pub/data/observations/metar/decoded/" - -getData :: String -> IO String -getData url= - do (i,o,e,p) <- runInteractiveCommand ("curl " ++ defUrl ++ url ++ ".TXT") - exit <- waitForProcess p - let closeHandles = do hClose o - hClose i - hClose e - case exit of - ExitSuccess -> do str <- hGetContents o - when (str == str) $ return () - closeHandles - return str - _ -> do closeHandles - return "Could not retrieve data" - -formatWeather :: [WeatherInfo] -> Monitor String -formatWeather [(WI st ss y m d h w v sk tC tF dp r p)] = - do cel <- showWithColors show tC - far <- showWithColors show tF - parseTemplate [st, ss, y, m, d, h, w, v, sk, cel, far, dp, show r , show p ] -formatWeather _ = return "N/A" - -runWeather :: [String] -> Monitor String -runWeather str = - do d <- io $ getData $ head str - i <- io $ runP parseData d - formatWeather i diff --git a/Plugins/Monitors/Wireless.hs b/Plugins/Monitors/Wireless.hs deleted file mode 100644 index 4ac0c10..0000000 --- a/Plugins/Monitors/Wireless.hs +++ /dev/null @@ -1,34 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Plugins.Monitors.Wireless --- Copyright : (c) Jose Antonio Ortega Ruiz --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose Antonio Ortega Ruiz --- Stability : unstable --- Portability : unportable --- --- A monitor reporting ESSID and link quality for wireless interfaces --- ------------------------------------------------------------------------------ - -module Plugins.Monitors.Wireless (wirelessConfig, runWireless) where - -import Plugins.Monitors.Common -import IWlib - -wirelessConfig :: IO MConfig -wirelessConfig = - mkMConfig "<essid> <quality>" ["essid", "quality", "qualitybar"] - -runWireless :: [String] -> Monitor String -runWireless (iface:_) = do - wi <- io $ getWirelessInfo iface - let essid = wiEssid wi - qlty = wiQuality wi - fqlty = fromIntegral qlty - e = if essid == "" then "N/A" else essid - q <- if qlty >= 0 then showWithColors show qlty else showWithPadding "" - qb <- showPercentBar fqlty (fqlty / 100) - parseTemplate [e, q, qb] -runWireless _ = return ""
\ No newline at end of file diff --git a/Plugins/PipeReader.hs b/Plugins/PipeReader.hs deleted file mode 100644 index 3fd0dd4..0000000 --- a/Plugins/PipeReader.hs +++ /dev/null @@ -1,28 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Plugins.PipeReader --- Copyright : (c) Andrea Rossato --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> --- Stability : unstable --- Portability : unportable --- --- A plugin for reading from named pipes --- ------------------------------------------------------------------------------ - -module Plugins.PipeReader where - -import System.IO -import Plugins - -data PipeReader = PipeReader String String - deriving (Read, Show) - -instance Exec PipeReader where - alias (PipeReader _ a) = a - start (PipeReader p _) cb = do - h <- openFile p ReadWriteMode - forever (hGetLineSafe h >>= cb) - where forever a = a >> forever a diff --git a/Plugins/StdinReader.hs b/Plugins/StdinReader.hs deleted file mode 100644 index 2ee217e..0000000 --- a/Plugins/StdinReader.hs +++ /dev/null @@ -1,33 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Plugins.StdinReader --- Copyright : (c) Andrea Rossato --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> --- Stability : unstable --- Portability : unportable --- --- A plugin for reading from stdin --- ------------------------------------------------------------------------------ - -module Plugins.StdinReader where - -import Prelude hiding (catch) -import System.Posix.Process -import System.Exit -import System.IO -import Control.Exception (SomeException(..),catch) -import Plugins - -data StdinReader = StdinReader - deriving (Read, Show) - -instance Exec StdinReader where - start StdinReader cb = do - cb =<< catch (hGetLineSafe stdin) (\(SomeException e) -> do hPrint stderr e; return "") - eof <- hIsEOF stdin - if eof - then exitImmediately ExitSuccess - else start StdinReader cb diff --git a/Plugins/Utils.hs b/Plugins/Utils.hs deleted file mode 100644 index 1dbcd40..0000000 --- a/Plugins/Utils.hs +++ /dev/null @@ -1,39 +0,0 @@ ------------------------------------------------------------------------------- --- | --- Module: Plugins.Utils --- Copyright: (c) 2010 Jose Antonio Ortega Ruiz --- License: BSD3-style (see LICENSE) --- --- Maintainer: Jose A Ortega Ruiz <jao@gnu.org> --- Stability: unstable --- Portability: unportable --- Created: Sat Dec 11, 2010 20:55 --- --- --- Miscellaneous utility functions --- ------------------------------------------------------------------------------- - - -module Plugins.Utils (expandHome, changeLoop) where - -import Control.Monad -import Control.Concurrent.STM - -import System.Environment -import System.FilePath - - -expandHome :: FilePath -> IO FilePath -expandHome ('~':'/':path) = fmap (</> path) (getEnv "HOME") -expandHome p = return p - -changeLoop :: Eq a => STM a -> (a -> IO ()) -> IO () -changeLoop s f = atomically s >>= go - where - go old = do - f old - go =<< atomically (do - new <- s - guard (new /= old) - return new) diff --git a/Plugins/XMonadLog.hs b/Plugins/XMonadLog.hs deleted file mode 100644 index 3461e26..0000000 --- a/Plugins/XMonadLog.hs +++ /dev/null @@ -1,72 +0,0 @@ -{-# LANGUAGE CPP #-} - ------------------------------------------------------------------------------ --- | --- Module : Plugins.StdinReader --- Copyright : (c) Spencer Janssen --- License : BSD-style (see LICENSE) --- --- Maintainer : Spencer Janssen <spencerjanssen@gmail.com> --- Stability : unstable --- Portability : unportable --- --- A plugin to display information from _XMONAD_LOG, specified at --- http://code.haskell.org/XMonadContrib/XMonad/Hooks/DynamicLog.hs --- ------------------------------------------------------------------------------ - -module Plugins.XMonadLog (XMonadLog(..)) where - -import Control.Monad -import Graphics.X11 -import Graphics.X11.Xlib.Extras -import Plugins -#ifdef UTF8 -#undef UTF8 -import Codec.Binary.UTF8.String as UTF8 -#define UTF8 -#endif -import Foreign.C (CChar) -import XUtil (nextEvent') - - -data XMonadLog = XMonadLog | XPropertyLog String - deriving (Read, Show) - -instance Exec XMonadLog where - alias XMonadLog = "XMonadLog" - alias (XPropertyLog atom) = atom - - start x cb = do - let atom = case x of - XMonadLog -> "_XMONAD_LOG" - XPropertyLog a -> a - d <- openDisplay "" - xlog <- internAtom d atom False - - root <- rootWindow d (defaultScreen d) - selectInput d root propertyChangeMask - - let update = do - mwp <- getWindowProperty8 d xlog root - maybe (return ()) (cb . decodeCChar) mwp - - update - - allocaXEvent $ \ep -> forever $ do - nextEvent' d ep - e <- getEvent ep - case e of - PropertyEvent { ev_atom = a } | a == xlog -> update - _ -> return () - - return () - -decodeCChar :: [CChar] -> String -#ifdef UTF8 -#undef UTF8 -decodeCChar = UTF8.decode . map fromIntegral -#define UTF8 -#else -decodeCChar = map (toEnum . fromIntegral) -#endif diff --git a/Plugins/helloworld.config b/Plugins/helloworld.config deleted file mode 100644 index 3818bfa..0000000 --- a/Plugins/helloworld.config +++ /dev/null @@ -1,12 +0,0 @@ -Config { font = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" - , bgColor = "#000000" - , fgColor = "#BFBFBF" - , position = TopW C 90 - , commands = [ Run Cpu [] 10 - , Run Weather "LIPB" [] 36000 - , Run HelloWorld - ] - , sepChar = "%" - , alignSep = "}{" - , template = "%cpu% } %helloWorld% { %LIPB% | <fc=yellow>%date%</fc>" - } |