From 976312375bbedd05eb822b3b0d5d044aa7d4a3ea Mon Sep 17 00:00:00 2001 From: Reto Habluetzel Date: Mon, 27 Aug 2012 21:07:54 +0200 Subject: added PipeReader2 which accepts a default --- src/Config.hs | 3 ++- src/Plugins/PipeReader2.hs | 30 ++++++++++++++++++++++++++++++ 2 files changed, 32 insertions(+), 1 deletion(-) create mode 100644 src/Plugins/PipeReader2.hs (limited to 'src') diff --git a/src/Config.hs b/src/Config.hs index a6ad3e2..58956af 100644 --- a/src/Config.hs +++ b/src/Config.hs @@ -28,6 +28,7 @@ import {-# SOURCE #-} Runnable import Plugins.Monitors import Plugins.Date import Plugins.PipeReader +import Plugins.PipeReader2 import Plugins.BufferedPipeReader import Plugins.CommandReader import Plugins.StdinReader @@ -120,7 +121,7 @@ infixr :*: -- the 'Runnable.Runnable' Read instance. To install a plugin just add -- the plugin's type to the list of types (separated by ':*:') appearing in -- this function's type signature. -runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: BufferedPipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*: Kbd :*: +runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: PipeReader2 :*: BufferedPipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*: Kbd :*: #ifdef INOTIFY Mail :*: MBox :*: #endif diff --git a/src/Plugins/PipeReader2.hs b/src/Plugins/PipeReader2.hs new file mode 100644 index 0000000..511f107 --- /dev/null +++ b/src/Plugins/PipeReader2.hs @@ -0,0 +1,30 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.PipeReader2 +-- Copyright : (c) Andrea Rossato +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Jose A. Ortega Ruiz +-- Stability : unstable +-- Portability : unportable +-- +-- A plugin for reading from named pipes. As opposed to PipeReader, this +-- plugin displays a default string when it starts. +-- +----------------------------------------------------------------------------- + +module Plugins.PipeReader2 where + +import System.IO +import Plugins + +data PipeReader2 = PipeReader2 String String String + deriving (Read, Show) + +instance Exec PipeReader2 where + alias (PipeReader2 _ a _) = a + start (PipeReader2 p _ def) cb = do + h <- openFile p ReadWriteMode + cb def + forever (hGetLineSafe h >>= cb) + where forever a = a >> forever a -- cgit v1.2.3 From a9de120224fa1dbb1f740d3d51d8bde6432c0884 Mon Sep 17 00:00:00 2001 From: Reto Habluetzel Date: Wed, 29 Aug 2012 23:12:08 +0200 Subject: added dynnetwork, which selects the busiest network of a list and displays it --- src/Plugins/Monitors.hs | 39 +++++++++++++++++++++------------------ src/Plugins/Monitors/Net.hs | 44 +++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 64 insertions(+), 19 deletions(-) (limited to 'src') diff --git a/src/Plugins/Monitors.hs b/src/Plugins/Monitors.hs index a531e26..bea91eb 100644 --- a/src/Plugins/Monitors.hs +++ b/src/Plugins/Monitors.hs @@ -48,24 +48,25 @@ import Plugins.Monitors.Volume import Plugins.Monitors.Mpris #endif -data Monitors = Weather Station Args Rate - | Network Interface Args Rate - | BatteryP [String] Args Rate - | DiskU DiskSpec Args Rate - | DiskIO DiskSpec Args Rate - | Thermal Zone Args Rate - | ThermalZone ZoneNo Args Rate - | Memory Args Rate - | Swap Args Rate - | Cpu Args Rate - | MultiCpu Args Rate - | Battery Args Rate - | Brightness Args Rate - | CpuFreq Args Rate - | CoreTemp Args Rate - | TopProc Args Rate - | TopMem Args Rate - | Uptime Args Rate +data Monitors = Weather Station Args Rate + | Network Interface Args Rate + | DynNetwork [Interface] Args Rate + | BatteryP [String] Args Rate + | DiskU DiskSpec Args Rate + | DiskIO DiskSpec Args Rate + | Thermal Zone Args Rate + | ThermalZone ZoneNo Args Rate + | Memory Args Rate + | Swap Args Rate + | Cpu Args Rate + | MultiCpu Args Rate + | Battery Args Rate + | Brightness Args Rate + | CpuFreq Args Rate + | CoreTemp Args Rate + | TopProc Args Rate + | TopMem Args Rate + | Uptime Args Rate #ifdef IWLIB | Wireless Interface Args Rate #endif @@ -95,6 +96,7 @@ type DiskSpec = [(String, String)] instance Exec Monitors where alias (Weather s _ _) = s alias (Network i _ _) = i + alias (DynNetwork _ _ _) = "dynnetwork" alias (Thermal z _ _) = z alias (ThermalZone z _ _) = "thermal" ++ show z alias (Memory _ _) = "memory" @@ -126,6 +128,7 @@ instance Exec Monitors where alias (Mpris2 _ _ _) = "mpris2" #endif start (Network i a r) = startNet i a r + start (DynNetwork is a r) = startDynNet is a r start (Cpu a r) = startCpu a r start (MultiCpu a r) = startMultiCpu a r start (TopProc a r) = startTop a r diff --git a/src/Plugins/Monitors/Net.hs b/src/Plugins/Monitors/Net.hs index 768907c..170da07 100644 --- a/src/Plugins/Monitors/Net.hs +++ b/src/Plugins/Monitors/Net.hs @@ -13,12 +13,16 @@ -- ----------------------------------------------------------------------------- -module Plugins.Monitors.Net (startNet) where +module Plugins.Monitors.Net ( + startNet + , startDynNet + ) where import Plugins.Monitors.Common import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Time.Clock (UTCTime, getCurrentTime, diffUTCTime) +import Control.Monad (forM, filterM, liftM) import qualified Data.ByteString.Lazy.Char8 as B @@ -28,6 +32,23 @@ data NetDev = NA type NetDevRef = IORef (NetDev, UTCTime) +{- The more information available, the better. + - Note that names don't matter. Therefore, if only the names differ, + - a compare evaluates to EQ while (==) evaluates to False. + -} +instance Ord NetDev where + compare NA NA = EQ + compare NA _ = LT + compare _ NA = GT + compare (NI _) (NI _) = EQ + compare (NI _) (ND _ _ _) = LT + compare (ND _ _ _) (NI _) = GT + compare (ND _ x1 y1) (ND _ x2 y2) = + if downcmp /= EQ + then downcmp + else y1 `compare` y2 + where downcmp = x1 `compare` x2 + netConfig :: IO MConfig netConfig = mkMConfig ": KB|KB" -- template @@ -103,9 +124,30 @@ parseNet nref nd = do runNet :: NetDevRef -> String -> [String] -> Monitor String runNet nref i _ = io (parseNet nref i) >>= printNet +parseNets :: [(NetDevRef, String)] -> IO [NetDev] +parseNets = mapM (\(ref, i) -> parseNet ref i) + +runNets :: [(NetDevRef, String)] -> [String] -> Monitor String +runNets refs _ = io (parseActive refs) >>= printNet + where parseActive refs = parseNets refs >>= return . selectActive + +selectActive :: [NetDev] -> NetDev +selectActive = maximum + startNet :: String -> [String] -> Int -> (String -> IO ()) -> IO () startNet i a r cb = do t0 <- getCurrentTime nref <- newIORef (NA, t0) _ <- parseNet nref i runM a netConfig (runNet nref i) r cb + +startDynNet :: [String] -> [String] -> Int -> (String -> IO ()) -> IO () +startDynNet is a r cb = do + refs <- forM is $ \i -> do + t <- getCurrentTime + nref <- newIORef (NA, t) + _ <- parseNet nref i + return (nref, i) + runM a netConfig (runNets refs) r cb + +-- TODO: Prelude.head: empty list -- cgit v1.2.3 From 2cf7e19b8be5e892c03bd95cf4e1acffe0e53e66 Mon Sep 17 00:00:00 2001 From: Reto Habluetzel Date: Wed, 29 Aug 2012 23:16:54 +0200 Subject: cleaned up imports, renamed variable --- src/Plugins/Monitors/Net.hs | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) (limited to 'src') diff --git a/src/Plugins/Monitors/Net.hs b/src/Plugins/Monitors/Net.hs index 170da07..10ca9cc 100644 --- a/src/Plugins/Monitors/Net.hs +++ b/src/Plugins/Monitors/Net.hs @@ -22,7 +22,7 @@ import Plugins.Monitors.Common import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Time.Clock (UTCTime, getCurrentTime, diffUTCTime) -import Control.Monad (forM, filterM, liftM) +import Control.Monad (forM) import qualified Data.ByteString.Lazy.Char8 as B @@ -129,11 +129,9 @@ parseNets = mapM (\(ref, i) -> parseNet ref i) runNets :: [(NetDevRef, String)] -> [String] -> Monitor String runNets refs _ = io (parseActive refs) >>= printNet - where parseActive refs = parseNets refs >>= return . selectActive + where parseActive refs' = parseNets refs' >>= return . selectActive + selectActive = maximum -selectActive :: [NetDev] -> NetDev -selectActive = maximum - startNet :: String -> [String] -> Int -> (String -> IO ()) -> IO () startNet i a r cb = do t0 <- getCurrentTime -- cgit v1.2.3 From 431b8eaffd865593bed4e1db1843452a1f1fe64c Mon Sep 17 00:00:00 2001 From: Reto Habluetzel Date: Tue, 4 Sep 2012 07:10:26 +0200 Subject: automatic detection of devices using /sys/class/net directory --- src/Plugins/Monitors.hs | 6 +++--- src/Plugins/Monitors/Net.hs | 34 +++++++++++++++++++++++----------- 2 files changed, 26 insertions(+), 14 deletions(-) (limited to 'src') diff --git a/src/Plugins/Monitors.hs b/src/Plugins/Monitors.hs index bea91eb..009da68 100644 --- a/src/Plugins/Monitors.hs +++ b/src/Plugins/Monitors.hs @@ -50,7 +50,7 @@ import Plugins.Monitors.Mpris data Monitors = Weather Station Args Rate | Network Interface Args Rate - | DynNetwork [Interface] Args Rate + | DynNetwork Args Rate | BatteryP [String] Args Rate | DiskU DiskSpec Args Rate | DiskIO DiskSpec Args Rate @@ -96,7 +96,7 @@ type DiskSpec = [(String, String)] instance Exec Monitors where alias (Weather s _ _) = s alias (Network i _ _) = i - alias (DynNetwork _ _ _) = "dynnetwork" + alias (DynNetwork _ _) = "dynnetwork" alias (Thermal z _ _) = z alias (ThermalZone z _ _) = "thermal" ++ show z alias (Memory _ _) = "memory" @@ -128,7 +128,7 @@ instance Exec Monitors where alias (Mpris2 _ _ _) = "mpris2" #endif start (Network i a r) = startNet i a r - start (DynNetwork is a r) = startDynNet is a r + start (DynNetwork a r) = startDynNet a r start (Cpu a r) = startCpu a r start (MultiCpu a r) = startMultiCpu a r start (TopProc a r) = startTop a r diff --git a/src/Plugins/Monitors/Net.hs b/src/Plugins/Monitors/Net.hs index 10ca9cc..8234670 100644 --- a/src/Plugins/Monitors/Net.hs +++ b/src/Plugins/Monitors/Net.hs @@ -22,7 +22,9 @@ import Plugins.Monitors.Common import Data.IORef (IORef, newIORef, readIORef, writeIORef) import Data.Time.Clock (UTCTime, getCurrentTime, diffUTCTime) -import Control.Monad (forM) +import Control.Monad (forM, filterM) +import System.Directory (getDirectoryContents, doesFileExist) +import System.FilePath (()) import qualified Data.ByteString.Lazy.Char8 as B @@ -32,10 +34,9 @@ data NetDev = NA type NetDevRef = IORef (NetDev, UTCTime) -{- The more information available, the better. - - Note that names don't matter. Therefore, if only the names differ, - - a compare evaluates to EQ while (==) evaluates to False. - -} +-- The more information available, the better. +-- Note that names don't matter. Therefore, if only the names differ, +-- a compare evaluates to EQ while (==) evaluates to False. instance Ord NetDev where compare NA NA = EQ compare NA _ = LT @@ -54,9 +55,18 @@ netConfig = mkMConfig ": KB|KB" -- template ["dev", "rx", "tx", "rxbar", "txbar"] -- available replacements +operstateDir :: String -> FilePath +operstateDir d = "/sys/class/net" d "operstate" + +existingDevs :: IO [String] +existingDevs = getDirectoryContents "/sys/class/net" >>= filterM isDev + where isDev d | d `elem` excludes = return False + | otherwise = doesFileExist (operstateDir d) + excludes = [".", "..", "lo"] + isUp :: String -> IO Bool isUp d = do - operstate <- B.readFile $ "/sys/class/net/" ++ d ++ "/operstate" + operstate <- B.readFile (operstateDir d) return $ "up" == (B.unpack . head . B.lines) operstate readNetDev :: [String] -> IO NetDev @@ -139,13 +149,15 @@ startNet i a r cb = do _ <- parseNet nref i runM a netConfig (runNet nref i) r cb -startDynNet :: [String] -> [String] -> Int -> (String -> IO ()) -> IO () -startDynNet is a r cb = do - refs <- forM is $ \i -> do +startDynNet :: [String] -> Int -> (String -> IO ()) -> IO () +startDynNet a r cb = do + devs <- existingDevs + refs <- forM devs $ \d -> do t <- getCurrentTime nref <- newIORef (NA, t) - _ <- parseNet nref i - return (nref, i) + _ <- parseNet nref d + return (nref, d) runM a netConfig (runNets refs) r cb -- TODO: Prelude.head: empty list +-- TODO: remember last active interface. -- cgit v1.2.3 From 7e5e4bca3f7b35ec5569c28b4a86546a1234eb51 Mon Sep 17 00:00:00 2001 From: Reto Habluetzel Date: Fri, 14 Sep 2012 23:07:23 +0200 Subject: removed todo comments --- src/Plugins/Monitors/Net.hs | 3 --- 1 file changed, 3 deletions(-) (limited to 'src') diff --git a/src/Plugins/Monitors/Net.hs b/src/Plugins/Monitors/Net.hs index 8234670..9ea4346 100644 --- a/src/Plugins/Monitors/Net.hs +++ b/src/Plugins/Monitors/Net.hs @@ -158,6 +158,3 @@ startDynNet a r cb = do _ <- parseNet nref d return (nref, d) runM a netConfig (runNets refs) r cb - --- TODO: Prelude.head: empty list --- TODO: remember last active interface. -- cgit v1.2.3 From 1b38bbadb62fa06f5e00ee89e0384591dc522325 Mon Sep 17 00:00:00 2001 From: Reto Habluetzel Date: Fri, 14 Sep 2012 23:12:40 +0200 Subject: better readable code --- src/Plugins/Monitors/Net.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src') diff --git a/src/Plugins/Monitors/Net.hs b/src/Plugins/Monitors/Net.hs index 9ea4346..b8adc74 100644 --- a/src/Plugins/Monitors/Net.hs +++ b/src/Plugins/Monitors/Net.hs @@ -135,7 +135,7 @@ runNet :: NetDevRef -> String -> [String] -> Monitor String runNet nref i _ = io (parseNet nref i) >>= printNet parseNets :: [(NetDevRef, String)] -> IO [NetDev] -parseNets = mapM (\(ref, i) -> parseNet ref i) +parseNets = mapM $ \(ref, i) -> parseNet ref i runNets :: [(NetDevRef, String)] -> [String] -> Monitor String runNets refs _ = io (parseActive refs) >>= printNet -- cgit v1.2.3 From a0a1865dd268e50c77a5a8dea09a46da7408fd54 Mon Sep 17 00:00:00 2001 From: Reto Habluetzel Date: Sat, 15 Sep 2012 16:34:35 +0200 Subject: Enhanced PipeReader capabilities * Removed PipeReader2 * PipeReader pipename can be prefixed with default. (e.g. "I am default:/home/foo/pipe") --- src/Config.hs | 3 +-- src/Plugins/PipeReader.hs | 10 ++++++++-- 2 files changed, 9 insertions(+), 4 deletions(-) (limited to 'src') diff --git a/src/Config.hs b/src/Config.hs index 58956af..a6ad3e2 100644 --- a/src/Config.hs +++ b/src/Config.hs @@ -28,7 +28,6 @@ import {-# SOURCE #-} Runnable import Plugins.Monitors import Plugins.Date import Plugins.PipeReader -import Plugins.PipeReader2 import Plugins.BufferedPipeReader import Plugins.CommandReader import Plugins.StdinReader @@ -121,7 +120,7 @@ infixr :*: -- the 'Runnable.Runnable' Read instance. To install a plugin just add -- the plugin's type to the list of types (separated by ':*:') appearing in -- this function's type signature. -runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: PipeReader2 :*: BufferedPipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*: Kbd :*: +runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: BufferedPipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*: Kbd :*: #ifdef INOTIFY Mail :*: MBox :*: #endif diff --git a/src/Plugins/PipeReader.hs b/src/Plugins/PipeReader.hs index 3fd0dd4..42ae500 100644 --- a/src/Plugins/PipeReader.hs +++ b/src/Plugins/PipeReader.hs @@ -23,6 +23,12 @@ data PipeReader = PipeReader String String instance Exec PipeReader where alias (PipeReader _ a) = a start (PipeReader p _) cb = do - h <- openFile p ReadWriteMode + let (def, pipe) = split ':' p + h <- openFile pipe ReadWriteMode + cb def forever (hGetLineSafe h >>= cb) - where forever a = a >> forever a + where + forever a = a >> forever a + split c xs | c `elem` xs = let (pre, post) = span ((/=) c) xs + in (pre, dropWhile ((==) c) post) + | otherwise = ([], xs) -- cgit v1.2.3 From e2407925093dfcc4e89dabeceb46429adda015b9 Mon Sep 17 00:00:00 2001 From: Reto Habluetzel Date: Sat, 15 Sep 2012 18:54:13 +0200 Subject: removed PipeReader2 as funcionality was move to PipeReader --- src/Plugins/PipeReader2.hs | 30 ------------------------------ 1 file changed, 30 deletions(-) delete mode 100644 src/Plugins/PipeReader2.hs (limited to 'src') diff --git a/src/Plugins/PipeReader2.hs b/src/Plugins/PipeReader2.hs deleted file mode 100644 index 511f107..0000000 --- a/src/Plugins/PipeReader2.hs +++ /dev/null @@ -1,30 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Plugins.PipeReader2 --- Copyright : (c) Andrea Rossato --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A. Ortega Ruiz --- Stability : unstable --- Portability : unportable --- --- A plugin for reading from named pipes. As opposed to PipeReader, this --- plugin displays a default string when it starts. --- ------------------------------------------------------------------------------ - -module Plugins.PipeReader2 where - -import System.IO -import Plugins - -data PipeReader2 = PipeReader2 String String String - deriving (Read, Show) - -instance Exec PipeReader2 where - alias (PipeReader2 _ a _) = a - start (PipeReader2 p _ def) cb = do - h <- openFile p ReadWriteMode - cb def - forever (hGetLineSafe h >>= cb) - where forever a = a >> forever a -- cgit v1.2.3