summaryrefslogtreecommitdiffhomepage
path: root/Plugins
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2010-12-21 02:36:35 +0100
committerJose Antonio Ortega Ruiz <jao@gnu.org>2010-12-21 02:36:35 +0100
commite3853a9cb2a9a2cffa174d1334e2ca8ba610f151 (patch)
tree13aa04faea320afe85636e23686280386c1c2910 /Plugins
parent598bfe5deeff079280e8513c55dc7bda3e8cf9a0 (diff)
downloadxmobar-e3853a9cb2a9a2cffa174d1334e2ca8ba610f151.tar.gz
xmobar-e3853a9cb2a9a2cffa174d1334e2ca8ba610f151.tar.bz2
Haskell sources moved to src/ to unclutter toplevel
Diffstat (limited to 'Plugins')
-rw-r--r--Plugins/CommandReader.hs39
-rw-r--r--Plugins/Date.hs37
-rw-r--r--Plugins/EWMH.hs264
-rw-r--r--Plugins/HelloWorld.hs24
-rw-r--r--Plugins/MBox.hs111
-rw-r--r--Plugins/Mail.hs70
-rw-r--r--Plugins/Monitors.hs119
-rw-r--r--Plugins/Monitors/Batt.hs165
-rw-r--r--Plugins/Monitors/Common.hs446
-rw-r--r--Plugins/Monitors/CoreCommon.hs59
-rw-r--r--Plugins/Monitors/CoreTemp.hs41
-rw-r--r--Plugins/Monitors/Cpu.hs53
-rw-r--r--Plugins/Monitors/CpuFreq.hs43
-rw-r--r--Plugins/Monitors/Disk.hs137
-rw-r--r--Plugins/Monitors/MPD.hs115
-rw-r--r--Plugins/Monitors/Mem.hs59
-rw-r--r--Plugins/Monitors/MultiCpu.hs81
-rw-r--r--Plugins/Monitors/Net.hs96
-rw-r--r--Plugins/Monitors/Swap.hs55
-rw-r--r--Plugins/Monitors/Thermal.hs42
-rw-r--r--Plugins/Monitors/Top.hs179
-rw-r--r--Plugins/Monitors/Uptime.hs50
-rw-r--r--Plugins/Monitors/Weather.hs141
-rw-r--r--Plugins/Monitors/Wireless.hs34
-rw-r--r--Plugins/PipeReader.hs28
-rw-r--r--Plugins/StdinReader.hs33
-rw-r--r--Plugins/Utils.hs39
-rw-r--r--Plugins/XMonadLog.hs72
-rw-r--r--Plugins/helloworld.config12
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>"
- }