summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/Plugins
diff options
context:
space:
mode:
Diffstat (limited to 'src/Xmobar/Plugins')
-rw-r--r--src/Xmobar/Plugins/BufferedPipeReader.hs87
-rw-r--r--src/Xmobar/Plugins/CommandReader.hs39
-rw-r--r--src/Xmobar/Plugins/Date.hs38
-rw-r--r--src/Xmobar/Plugins/DateZone.hs85
-rw-r--r--src/Xmobar/Plugins/EWMH.hs265
-rw-r--r--src/Xmobar/Plugins/Kbd.hsc404
-rw-r--r--src/Xmobar/Plugins/Locks.hs64
-rw-r--r--src/Xmobar/Plugins/MBox.hs131
-rw-r--r--src/Xmobar/Plugins/Mail.hs92
-rw-r--r--src/Xmobar/Plugins/MarqueePipeReader.hs70
-rw-r--r--src/Xmobar/Plugins/Monitors.hs195
-rw-r--r--src/Xmobar/Plugins/Monitors/Alsa.hs146
-rw-r--r--src/Xmobar/Plugins/Monitors/Batt.hs247
-rw-r--r--src/Xmobar/Plugins/Monitors/Bright.hs99
-rw-r--r--src/Xmobar/Plugins/Monitors/CatInt.hs25
-rw-r--r--src/Xmobar/Plugins/Monitors/Common.hs544
-rw-r--r--src/Xmobar/Plugins/Monitors/CoreCommon.hs138
-rw-r--r--src/Xmobar/Plugins/Monitors/CoreTemp.hs45
-rw-r--r--src/Xmobar/Plugins/Monitors/Cpu.hs88
-rw-r--r--src/Xmobar/Plugins/Monitors/CpuFreq.hs44
-rw-r--r--src/Xmobar/Plugins/Monitors/Disk.hs241
-rw-r--r--src/Xmobar/Plugins/Monitors/MPD.hs139
-rw-r--r--src/Xmobar/Plugins/Monitors/Mem.hs96
-rw-r--r--src/Xmobar/Plugins/Monitors/Mpris.hs148
-rw-r--r--src/Xmobar/Plugins/Monitors/MultiCpu.hs128
-rw-r--r--src/Xmobar/Plugins/Monitors/Net.hs218
-rw-r--r--src/Xmobar/Plugins/Monitors/Swap.hs56
-rw-r--r--src/Xmobar/Plugins/Monitors/Thermal.hs39
-rw-r--r--src/Xmobar/Plugins/Monitors/ThermalZone.hs49
-rw-r--r--src/Xmobar/Plugins/Monitors/Top.hs195
-rw-r--r--src/Xmobar/Plugins/Monitors/UVMeter.hs157
-rw-r--r--src/Xmobar/Plugins/Monitors/Uptime.hs50
-rw-r--r--src/Xmobar/Plugins/Monitors/Volume.hs196
-rw-r--r--src/Xmobar/Plugins/Monitors/Weather.hs255
-rw-r--r--src/Xmobar/Plugins/Monitors/Wireless.hs70
-rw-r--r--src/Xmobar/Plugins/PipeReader.hs47
-rw-r--r--src/Xmobar/Plugins/StdinReader.hs44
-rw-r--r--src/Xmobar/Plugins/Utils.hs43
-rw-r--r--src/Xmobar/Plugins/XMonadLog.hs91
39 files changed, 0 insertions, 5108 deletions
diff --git a/src/Xmobar/Plugins/BufferedPipeReader.hs b/src/Xmobar/Plugins/BufferedPipeReader.hs
deleted file mode 100644
index d4d30a1..0000000
--- a/src/Xmobar/Plugins/BufferedPipeReader.hs
+++ /dev/null
@@ -1,87 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Plugins.BufferedPipeReader
--- Copyright : (c) Jochen Keil
--- License : BSD-style (see LICENSE)
---
--- Maintainer : Jochen Keil <jochen dot keil at gmail dot com>
--- Stability : unstable
--- Portability : unportable
---
--- A plugin for reading (temporarily) from named pipes with reset
---
------------------------------------------------------------------------------
-
-module Xmobar.Plugins.BufferedPipeReader where
-
-import Control.Monad(forM_, when, void)
-import Control.Concurrent
-import Control.Concurrent.STM
-import System.IO
-import System.IO.Unsafe(unsafePerformIO)
-
-import Xmobar.Environment
-import Xmobar.Plugins
-import Xmobar.Signal
-
-data BufferedPipeReader = BufferedPipeReader String [(Int, Bool, String)]
- deriving (Read, Show)
-
-{-# NOINLINE signal #-}
-signal :: MVar SignalType
-signal = unsafePerformIO newEmptyMVar
-
-instance Exec BufferedPipeReader where
- alias ( BufferedPipeReader a _ ) = a
-
- trigger br@( BufferedPipeReader _ _ ) sh =
- takeMVar signal >>= sh . Just >> trigger br sh
-
- start ( BufferedPipeReader _ ps ) cb = do
-
- (chan, str, rst) <- initV
- forM_ ps $ \p -> forkIO $ reader p chan
- writer chan str rst
-
- where
- initV :: IO ( TChan (Int, Bool, String), TVar (Maybe String), TVar Bool )
- initV = atomically $ do
- tc <- newTChan
- ts <- newTVar Nothing
- tb <- newTVar False
- return (tc, ts, tb)
-
- reader :: (Int, Bool, FilePath) -> TChan (Int, Bool, String) -> IO ()
- reader p@(to, tg, fp) tc = do
- fp' <- expandEnv fp
- openFile fp' ReadWriteMode >>= hGetLineSafe >>= \dt ->
- atomically $ writeTChan tc (to, tg, dt)
- reader p tc
-
- writer :: TChan (Int, Bool, String)
- -> TVar (Maybe String) -> TVar Bool -> IO ()
- writer tc ts otb = do
- (to, tg, dt, ntb) <- update
- cb dt
- when tg $ putMVar signal $ Reveal 0
- when (to /= 0) $ sfork $ reset to tg ts ntb
- writer tc ts ntb
-
- where
- sfork :: IO () -> IO ()
- sfork f = void (forkIO f)
-
- update :: IO (Int, Bool, String, TVar Bool)
- update = atomically $ do
- (to, tg, dt) <- readTChan tc
- when (to == 0) $ writeTVar ts $ Just dt
- writeTVar otb False
- tb <- newTVar True
- return (to, tg, dt, tb)
-
- reset :: Int -> Bool -> TVar (Maybe String) -> TVar Bool -> IO ()
- reset to tg ts tb = do
- threadDelay ( to * 100 * 1000 )
- readTVarIO tb >>= \b -> when b $ do
- when tg $ putMVar signal $ Hide 0
- readTVarIO ts >>= maybe (return ()) cb
diff --git a/src/Xmobar/Plugins/CommandReader.hs b/src/Xmobar/Plugins/CommandReader.hs
deleted file mode 100644
index 80b6299..0000000
--- a/src/Xmobar/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 Xmobar.Plugins.CommandReader where
-
-import System.IO
-import Xmobar.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/src/Xmobar/Plugins/Date.hs b/src/Xmobar/Plugins/Date.hs
deleted file mode 100644
index fdc6a56..0000000
--- a/src/Xmobar/Plugins/Date.hs
+++ /dev/null
@@ -1,38 +0,0 @@
-{-# LANGUAGE CPP #-}
------------------------------------------------------------------------------
--- |
--- 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 Xmobar.Plugins.Date (Date(..)) where
-
-import Xmobar.Plugins
-
-#if ! MIN_VERSION_time(1,5,0)
-import System.Locale
-#endif
-import Data.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 = fmap (formatTime defaultTimeLocale format) getZonedTime
diff --git a/src/Xmobar/Plugins/DateZone.hs b/src/Xmobar/Plugins/DateZone.hs
deleted file mode 100644
index 753f530..0000000
--- a/src/Xmobar/Plugins/DateZone.hs
+++ /dev/null
@@ -1,85 +0,0 @@
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE DoAndIfThenElse #-}
------------------------------------------------------------------------------
--- |
--- Module : Plugins.DateZone
--- Copyright : (c) Martin Perner
--- License : BSD-style (see LICENSE)
---
--- Maintainer : Martin Perner <martin@perner.cc>
--- Stability : unstable
--- Portability : unportable
---
--- A date plugin with localization and location support for Xmobar
---
--- Based on Plugins.Date
---
--- Usage example: in template put
---
--- > Run DateZone "%a %H:%M:%S" "de_DE.UTF-8" "UTC" "utcDate" 10
---
------------------------------------------------------------------------------
-
-module Xmobar.Plugins.DateZone (DateZone(..)) where
-
-import Xmobar.Plugins
-
-
-#ifdef DATEZONE
-import Control.Concurrent.STM
-
-import System.IO.Unsafe
-
-import Xmobar.Localize
-import Data.Time.Format
-import Data.Time.LocalTime
-import Data.Time.LocalTime.TimeZone.Olson
-import Data.Time.LocalTime.TimeZone.Series
-
-#if ! MIN_VERSION_time(1,5,0)
-import System.Locale (TimeLocale)
-#endif
-#else
-import System.IO
-import Xmobar.Plugins.Date
-#endif
-
-
-
-data DateZone = DateZone String String String String Int
- deriving (Read, Show)
-
-instance Exec DateZone where
- alias (DateZone _ _ _ a _) = a
-#ifndef DATEZONE
- start (DateZone f _ _ a r) cb = do
- hPutStrLn stderr $ "Warning: DateZone plugin needs -fwith_datezone."++
- " Using Date plugin instead."
- start (Date f a r) cb
-#else
- start (DateZone f l z _ r) cb = do
- lock <- atomically $ takeTMVar localeLock
- setupTimeLocale l
- locale <- getTimeLocale
- atomically $ putTMVar localeLock lock
- if z /= "" then do
- timeZone <- getTimeZoneSeriesFromOlsonFile ("/usr/share/zoneinfo/" ++ z)
- go (dateZone f locale timeZone)
- else
- go (date f locale)
-
- where go func = func >>= cb >> tenthSeconds r >> go func
-
-{-# NOINLINE localeLock #-}
--- ensures that only one plugin instance sets the locale
-localeLock :: TMVar Bool
-localeLock = unsafePerformIO (newTMVarIO False)
-
-date :: String -> TimeLocale -> IO String
-date format loc = getZonedTime >>= return . formatTime loc format
-
-dateZone :: String -> TimeLocale -> TimeZoneSeries -> IO String
-dateZone format loc timeZone = getZonedTime >>= return . formatTime loc format . utcToLocalTime' timeZone . zonedTimeToUTC
--- zonedTime <- getZonedTime
--- return $ formatTime loc format $ utcToLocalTime' timeZone $ zonedTimeToUTC zonedTime
-#endif
diff --git a/src/Xmobar/Plugins/EWMH.hs b/src/Xmobar/Plugins/EWMH.hs
deleted file mode 100644
index 363ec90..0000000
--- a/src/Xmobar/Plugins/EWMH.hs
+++ /dev/null
@@ -1,265 +0,0 @@
-{-# OPTIONS_GHC -w #-}
-{-# LANGUAGE CPP, NamedFieldPuns, GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE TupleSections, FlexibleContexts #-}
------------------------------------------------------------------------------
--- |
--- 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 Xmobar.Plugins.EWMH (EWMH(..)) where
-
-import Control.Applicative (Applicative(..))
-import Control.Monad.State
-import Control.Monad.Reader
-import Graphics.X11 hiding (Modifier, Color)
-import Graphics.X11.Xlib.Extras
-import Xmobar.Plugins
-#ifdef UTF8
-#undef UTF8
-import Codec.Binary.UTF8.String as UTF8
-#define UTF8
-#endif
-import Foreign.C (CChar, CLong)
-import Xmobar.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 } ->
- 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, Applicative, 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 ((, 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 . fst) (Map.toList dels)
- mapM_ (listen . fst) (Map.toList cl')
- mapM_ (update . 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/src/Xmobar/Plugins/Kbd.hsc b/src/Xmobar/Plugins/Kbd.hsc
deleted file mode 100644
index 372386e..0000000
--- a/src/Xmobar/Plugins/Kbd.hsc
+++ /dev/null
@@ -1,404 +0,0 @@
-{-# LANGUAGE ScopedTypeVariables, ForeignFunctionInterface, MultiParamTypeClasses, DeriveDataTypeable, FlexibleInstances, PatternGuards #-}
------------------------------------------------------------------------------
--- |
--- Module : Plugins.Kbd
--- Copyright : (c) Martin Perner
--- License : BSD-style (see LICENSE)
---
--- Maintainer : Martin Perner <martin@perner.cc>
--- Stability : unstable
--- Portability : unportable
---
--- A keyboard layout indicator for Xmobar
---
------------------------------------------------------------------------------
-
-module Xmobar.Plugins.Kbd where
-
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras
-import Foreign
-import Foreign.C.Types
-import Foreign.C.String
-import Xmobar.Plugins
-import Control.Monad (forever)
-import Xmobar.XUtil (nextEvent')
-import Data.List (isPrefixOf, findIndex)
-import Data.Maybe (fromJust)
-
-#include <X11/XKBlib.h>
-#include <X11/extensions/XKB.h>
-#include <X11/extensions/XKBstr.h>
-
---
--- Definition for XkbStaceRec and getKbdLayout taken from
--- XMonad.Layout.XKBLayout
---
-data XkbStateRec = XkbStateRec {
- group :: CUChar,
- locked_group :: CUChar,
- base_group :: CUShort,
- latched_group :: CUShort,
- mods :: CUChar,
- base_mods :: CUChar,
- latched_mods :: CUChar,
- locked_mods :: CUChar,
- compat_state :: CUChar,
- grab_mods :: CUChar,
- compat_grab_mods :: CUChar,
- lookup_mods :: CUChar,
- compat_lookup_mods :: CUChar,
- ptr_buttons :: CUShort
-}
-
-instance Storable XkbStateRec where
- sizeOf _ = (#size XkbStateRec)
- alignment _ = alignment (undefined :: CUShort)
- poke _ _ = undefined
- peek ptr = do
- r_group <- (#peek XkbStateRec, group) ptr
- r_locked_group <- (#peek XkbStateRec, locked_group) ptr
- r_base_group <- (#peek XkbStateRec, base_group) ptr
- r_latched_group <- (#peek XkbStateRec, latched_group) ptr
- r_mods <- (#peek XkbStateRec, mods) ptr
- r_base_mods <- (#peek XkbStateRec, base_mods) ptr
- r_latched_mods <- (#peek XkbStateRec, latched_mods) ptr
- r_locked_mods <- (#peek XkbStateRec, locked_mods) ptr
- r_compat_state <- (#peek XkbStateRec, compat_state) ptr
- r_grab_mods <- (#peek XkbStateRec, grab_mods) ptr
- r_compat_grab_mods <- (#peek XkbStateRec, compat_grab_mods) ptr
- r_lookup_mods <- (#peek XkbStateRec, lookup_mods) ptr
- r_compat_lookup_mods <- (#peek XkbStateRec, compat_lookup_mods) ptr
- r_ptr_buttons <- (#peek XkbStateRec, ptr_buttons) ptr
- return XkbStateRec {
- group = r_group,
- locked_group = r_locked_group,
- base_group = r_base_group,
- latched_group = r_latched_group,
- mods = r_mods,
- base_mods = r_base_mods,
- latched_mods = r_latched_mods,
- locked_mods = r_locked_mods,
- compat_state = r_compat_state,
- grab_mods = r_grab_mods,
- compat_grab_mods = r_compat_grab_mods,
- lookup_mods = r_lookup_mods,
- compat_lookup_mods = r_compat_lookup_mods,
- ptr_buttons = r_ptr_buttons
- }
-
-foreign import ccall unsafe "X11/XKBlib.h XkbGetState"
- xkbGetState :: Display -> CUInt -> Ptr XkbStateRec -> IO CInt
-
-
-getKbdLayout :: Display -> IO Int
-getKbdLayout d = alloca $ \stRecPtr -> do
- xkbGetState d 0x100 stRecPtr
- st <- peek stRecPtr
- return $ fromIntegral (group st)
-
---
---
---
-
-data XkbKeyNameRec = XkbKeyNameRec {
- name :: Ptr CChar -- array
-}
-
---
--- the t_ before alias is just because of name collisions
---
-data XkbKeyAliasRec = XkbKeyAliasRec {
- real :: Ptr CChar, -- array
- t_alias :: Ptr CChar -- array
-}
-
---
--- the t_ before geometry is just because of name collisions
---
-data XkbNamesRec = XkbNamesRec {
- keycodes :: Atom,
- t_geometry :: Atom,
- symbols :: Atom,
- types :: Atom,
- compat :: Atom,
- vmods :: Ptr Atom,
- indicators :: Ptr Atom, -- array
- groups :: Ptr Atom, -- array
- keys :: Ptr XkbKeyNameRec,
- key_aliases :: Ptr CChar, -- dont care XkbKeyAliasRec,
- radio_groups :: Ptr Atom,
- phys_symbols :: Atom,
- num_keys :: CUChar,
- num_key_aliases :: CUChar,
- num_rg :: CUShort
-}
-
---
--- the t_ before map, indicators and compat are just because of name collisions
---
-data XkbDescRec = XkbDescRec {
- t_dpy :: Ptr CChar, -- struct _XDisplay* ; don't care
- flags :: CUShort,
- device_spec :: CUShort,
- min_key_code :: KeyCode,
- max_key_code :: KeyCode,
- ctrls :: Ptr CChar, -- XkbControlsPtr ; dont' care
- server :: Ptr CChar, -- XkbServerMapPtr ; dont' care
- t_map :: Ptr CChar, --XkbClientMapPtr ; dont' care
- t_indicators :: Ptr CChar, -- XkbIndicatorPtr ; dont' care
- names :: Ptr XkbNamesRec, -- array
- t_compat :: Ptr CChar, -- XkbCompatMap ; dont' care
- geom :: Ptr CChar -- XkbGeometryPtr ; dont' care
-
-}
-
-instance Storable XkbKeyNameRec where
- sizeOf _ = (#size XkbKeyNameRec)
- alignment _ = alignment (undefined :: CUShort)
- poke _ _ = undefined
- peek ptr = do
- r_name <- (#peek XkbKeyNameRec, name) ptr
-
- return XkbKeyNameRec {
- name = r_name
- }
-
-instance Storable XkbKeyAliasRec where
- sizeOf _ = (#size XkbKeyAliasRec)
- alignment _ = alignment (undefined :: CUShort)
- poke _ _ = undefined
- peek ptr = do
- r_real <- (#peek XkbKeyAliasRec, real) ptr
- r_alias <- (#peek XkbKeyAliasRec, alias) ptr
-
- return XkbKeyAliasRec {
- real = r_real,
- t_alias = r_alias
- }
-
-instance Storable XkbNamesRec where
- sizeOf _ = (#size XkbNamesRec)
- alignment _ = alignment (undefined :: CUShort)
- poke _ _ = undefined
- peek ptr = do
- r_keycodes <- (#peek XkbNamesRec, keycodes) ptr
- r_geometry <- (#peek XkbNamesRec, geometry) ptr
- r_symbols <- (#peek XkbNamesRec, symbols ) ptr
- r_types <- (#peek XkbNamesRec, types ) ptr
- r_compat <- (#peek XkbNamesRec, compat ) ptr
- r_vmods <- (#peek XkbNamesRec, vmods ) ptr
- r_indicators <- (#peek XkbNamesRec, indicators ) ptr
- r_groups <- (#peek XkbNamesRec, groups ) ptr
- r_keys <- (#peek XkbNamesRec, keys ) ptr
- r_key_aliases <- (#peek XkbNamesRec, key_aliases ) ptr
- r_radio_groups <- (#peek XkbNamesRec, radio_groups ) ptr
- r_phys_symbols <- (#peek XkbNamesRec, phys_symbols ) ptr
- r_num_keys <- (#peek XkbNamesRec,num_keys ) ptr
- r_num_key_aliases <- (#peek XkbNamesRec, num_key_aliases ) ptr
- r_num_rg <- (#peek XkbNamesRec, num_rg ) ptr
-
- return XkbNamesRec {
- keycodes = r_keycodes,
- t_geometry = r_geometry,
- symbols = r_symbols,
- types = r_types,
- compat = r_compat,
- vmods = r_vmods,
- indicators = r_indicators,
- groups = r_groups,
- keys = r_keys,
- key_aliases = r_key_aliases,
- radio_groups = r_radio_groups,
- phys_symbols = r_phys_symbols,
- num_keys = r_num_keys,
- num_key_aliases = r_num_key_aliases,
- num_rg = r_num_rg
- }
-
-instance Storable XkbDescRec where
- sizeOf _ = (#size XkbDescRec)
- alignment _ = alignment (undefined :: CUShort)
- poke _ _ = undefined
- peek ptr = do
- r_dpy <- (#peek XkbDescRec, dpy) ptr
- r_flags <- (#peek XkbDescRec, flags) ptr
- r_device_spec <- (#peek XkbDescRec, device_spec) ptr
- r_min_key_code <- (#peek XkbDescRec, min_key_code) ptr
- r_max_key_code <- (#peek XkbDescRec, max_key_code) ptr
- r_ctrls <- (#peek XkbDescRec, ctrls) ptr
- r_server <- (#peek XkbDescRec, server) ptr
- r_map <- (#peek XkbDescRec, map) ptr
- r_indicators <- (#peek XkbDescRec, indicators) ptr
- r_names <- (#peek XkbDescRec, names) ptr
- r_compat <- (#peek XkbDescRec, compat) ptr
- r_geom <- (#peek XkbDescRec, geom) ptr
-
- return XkbDescRec {
- t_dpy = r_dpy,
- flags = r_flags,
- device_spec = r_device_spec,
- min_key_code = r_min_key_code,
- max_key_code = r_max_key_code,
- ctrls = r_ctrls,
- server = r_server,
- t_map = r_map,
- t_indicators = r_indicators,
- names = r_names,
- t_compat = r_compat,
- geom = r_geom
- }
-
---
--- C bindings
---
-
-foreign import ccall unsafe "X11/XKBlib.h XkbAllocKeyboard"
- xkbAllocKeyboard :: IO (Ptr XkbDescRec)
-
-foreign import ccall unsafe "X11/XKBlib.h XkbGetNames"
- xkbGetNames :: Display -> CUInt -> (Ptr XkbDescRec) -> IO Status
-
-foreign import ccall unsafe "X11/XKBlib.h XGetAtomName"
- xGetAtomName :: Display -> Atom -> IO CString
-
-foreign import ccall unsafe "X11/XKBlib.h XkbFreeNames"
- xkbFreeNames :: (Ptr XkbDescRec) -> CUInt -> CInt -> IO ()
-
-foreign import ccall unsafe "X11/XKBlib.h XkbFreeKeyboard"
- xkbFreeKeyboard :: (Ptr XkbDescRec) -> CUInt -> CInt -> IO ()
-
-foreign import ccall unsafe "X11/XKBlib.h XkbSelectEventDetails"
- xkbSelectEventDetails :: Display -> CUInt -> CUInt -> CULong -> CULong -> IO CUInt
-
-foreign import ccall unsafe "X11/XKBlib.h XkbSelectEvents"
- xkbSelectEvents :: Display -> CUInt -> CUInt -> CUInt -> IO CUInt
-
-
-xkbUseCoreKbd :: CUInt
-xkbUseCoreKbd = #const XkbUseCoreKbd
-
-xkbStateNotify :: CUInt
-xkbStateNotify = #const XkbStateNotify
-
-xkbIndicatorStateNotify :: CUInt
-xkbIndicatorStateNotify = #const XkbIndicatorStateNotify
-
-xkbMapNotify :: CUInt
-xkbMapNotify = #const XkbMapNotify
-
-xkbMapNotifyMask :: CUInt
-xkbMapNotifyMask = #const XkbMapNotifyMask
-
-xkbNewKeyboardNotifyMask :: CUInt
-xkbNewKeyboardNotifyMask = #const XkbNewKeyboardNotifyMask
-
-xkbAllStateComponentsMask :: CULong
-xkbAllStateComponentsMask = #const XkbAllStateComponentsMask
-
-xkbGroupStateMask :: CULong
-xkbGroupStateMask = #const XkbGroupStateMask
-
-xkbSymbolsNameMask :: CUInt
-xkbSymbolsNameMask = #const XkbSymbolsNameMask
-
-xkbGroupNamesMask :: CUInt
-xkbGroupNamesMask = #const XkbGroupNamesMask
-
-type KbdOpts = [(String, String)]
-
--- gets the layout string
-getLayoutStr :: Display -> IO String
-getLayoutStr dpy = do
- kbdDescPtr <- xkbAllocKeyboard
- status <- xkbGetNames dpy xkbSymbolsNameMask kbdDescPtr
- str <- getLayoutStr' status dpy kbdDescPtr
- xkbFreeNames kbdDescPtr xkbGroupNamesMask 1
- xkbFreeKeyboard kbdDescPtr 0 1
- return str
-
-getLayoutStr' :: Status -> Display -> (Ptr XkbDescRec) -> IO String
-getLayoutStr' st dpy kbdDescPtr =
- if st == 0 then -- Success
- do
- kbdDesc <- peek kbdDescPtr
- nameArray <- peek (names kbdDesc)
- atom <- xGetAtomName dpy (symbols nameArray)
- str <- peekCString atom
- return str
- else -- Behaviour on error
- do
- return "Error while requesting layout!"
-
-
--- 'Bad' prefixes of layouts
-noLaySymbols :: [String]
-noLaySymbols = ["group", "inet", "ctr", "pc", "ctrl"]
-
-
--- splits the layout string into the actual layouts
-splitLayout :: String -> [String]
-splitLayout s = splitLayout' noLaySymbols $ split s '+'
-
-splitLayout' :: [String] -> [String] -> [String]
--- end of recursion, remove empty strings
-splitLayout' [] s = map (takeWhile (\x -> x /= ':')) $ filter (\x -> length x > 0) s
--- remove current string if it has a 'bad' prefix
-splitLayout' bad s = splitLayout' (tail bad) [x | x <- s, not $ isPrefixOf (head bad) x]
-
--- split String at each Char
-split :: String -> Char -> [String]
-split [] _ = [""]
-split (c:cs) delim
- | c == delim = "" : rest
- | otherwise = (c : head rest) : tail rest
- where
- rest = split cs delim
-
--- replaces input string if on search list (exact match) with corresponding
--- element on replacement list.
---
--- if not found, return string unchanged
-searchReplaceLayout :: KbdOpts -> String -> String
-searchReplaceLayout opts s = let c = findIndex (\x -> fst x == s) opts in
- case c of
- Nothing -> s
- x -> let i = (fromJust x) in
- snd $ opts!!i
-
--- returns the active layout
-getKbdLay :: Display -> KbdOpts -> IO String
-getKbdLay dpy opts = do
- lay <- getLayoutStr dpy
- curLay <- getKbdLayout dpy
- return $ searchReplaceLayout opts $ (splitLayout lay)!!(curLay)
-
-
-
-data Kbd = Kbd [(String, String)]
- deriving (Read, Show)
-
-instance Exec Kbd where
- alias (Kbd _) = "kbd"
- start (Kbd opts) cb = do
-
- dpy <- openDisplay ""
-
- -- initial set of layout
- cb =<< getKbdLay dpy opts
-
- -- enable listing for
- -- group changes
- _ <- xkbSelectEventDetails dpy xkbUseCoreKbd xkbStateNotify xkbAllStateComponentsMask xkbGroupStateMask
- -- layout/geometry changes
- _ <- xkbSelectEvents dpy xkbUseCoreKbd xkbNewKeyboardNotifyMask xkbNewKeyboardNotifyMask
-
- allocaXEvent $ \e -> forever $ do
- nextEvent' dpy e
- _ <- getEvent e
- cb =<< getKbdLay dpy opts
-
- closeDisplay dpy
- return ()
-
--- vim:ft=haskell:ts=4:shiftwidth=4:softtabstop=4:expandtab:foldlevel=20:
diff --git a/src/Xmobar/Plugins/Locks.hs b/src/Xmobar/Plugins/Locks.hs
deleted file mode 100644
index 9a971e5..0000000
--- a/src/Xmobar/Plugins/Locks.hs
+++ /dev/null
@@ -1,64 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Plugins.Locks
--- Copyright : (c) Patrick Chilton
--- License : BSD-style (see LICENSE)
---
--- Maintainer : Patrick Chilton <chpatrick@gmail.com>
--- Stability : unstable
--- Portability : unportable
---
--- A plugin that displays the status of the lock keys.
---
------------------------------------------------------------------------------
-
-module Xmobar.Plugins.Locks where
-
-import Graphics.X11
-import Data.List
-import Data.Bits
-import Control.Monad
-import Graphics.X11.Xlib.Extras
-import Xmobar.Plugins
-import Xmobar.Plugins.Kbd
-import Xmobar.XUtil (nextEvent')
-
-data Locks = Locks
- deriving (Read, Show)
-
-locks :: [ ( KeySym, String )]
-locks = [ ( xK_Caps_Lock, "CAPS" )
- , ( xK_Num_Lock, "NUM" )
- , ( xK_Scroll_Lock, "SCROLL" )
- ]
-
-run' :: Display -> Window -> IO String
-run' d root = do
- modMap <- getModifierMapping d
- ( _, _, _, _, _, _, _, m ) <- queryPointer d root
-
- ls <- filterM ( \( ks, _ ) -> do
- kc <- keysymToKeycode d ks
- return $ case find (elem kc . snd) modMap of
- Nothing -> False
- Just ( i, _ ) -> testBit m (fromIntegral i)
- ) locks
-
- return $ unwords $ map snd ls
-
-instance Exec Locks where
- alias Locks = "locks"
- start Locks cb = do
- d <- openDisplay ""
- root <- rootWindow d (defaultScreen d)
- _ <- xkbSelectEventDetails d xkbUseCoreKbd xkbIndicatorStateNotify m m
-
- allocaXEvent $ \ep -> forever $ do
- cb =<< run' d root
- nextEvent' d ep
- getEvent ep
-
- closeDisplay d
- return ()
- where
- m = xkbAllStateComponentsMask
diff --git a/src/Xmobar/Plugins/MBox.hs b/src/Xmobar/Plugins/MBox.hs
deleted file mode 100644
index 2281629..0000000
--- a/src/Xmobar/Plugins/MBox.hs
+++ /dev/null
@@ -1,131 +0,0 @@
-{-# LANGUAGE CPP #-}
------------------------------------------------------------------------------
--- |
--- 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 Xmobar.Plugins.MBox (MBox(..)) where
-
-import Prelude
-import Xmobar.Plugins
-#ifdef INOTIFY
-import Xmobar.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
-
-#if MIN_VERSION_hinotify(0,3,10)
-import qualified Data.ByteString.Char8 as BS (ByteString, pack)
-pack :: String -> BS.ByteString
-pack = BS.pack
-#else
-pack :: String -> String
-pack = id
-#endif
-
-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
-
-#else
-import System.IO
-#endif
-
--- | 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
-#ifndef INOTIFY
- start _ _ =
- hPutStrLn stderr $ "Warning: xmobar is not compiled with -fwith_inotify" ++
- " but the MBox plugin requires it"
-#else
- 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 (pack 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 (\(SomeException _) -> evaluate 0)
- (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)
-#endif
diff --git a/src/Xmobar/Plugins/Mail.hs b/src/Xmobar/Plugins/Mail.hs
deleted file mode 100644
index c41b5b3..0000000
--- a/src/Xmobar/Plugins/Mail.hs
+++ /dev/null
@@ -1,92 +0,0 @@
-{-# LANGUAGE CPP #-}
------------------------------------------------------------------------------
--- |
--- 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 Xmobar.Plugins.Mail where
-
-import Xmobar.Plugins
-#ifdef INOTIFY
-import Xmobar.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
-
-#if MIN_VERSION_hinotify(0,3,10)
-import qualified Data.ByteString.Char8 as BS (ByteString, pack, unpack)
-unpack :: BS.ByteString -> String
-unpack = BS.unpack
-pack :: String -> BS.ByteString
-pack = BS.pack
-#else
-unpack :: String -> String
-unpack = id
-pack :: String -> String
-pack = id
-#endif
-#else
-import System.IO
-#endif
-
-
--- | A list of mail box names and paths to maildirs.
-data Mail = Mail [(String, FilePath)] String
- deriving (Read, Show)
-
-instance Exec Mail where
- alias (Mail _ a) = a
-#ifndef INOTIFY
- start _ _ =
- hPutStrLn stderr $ "Warning: xmobar is not compiled with -fwith_inotify,"
- ++ " but the Mail plugin requires it."
-#else
- 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)) (map pack 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 ]
-
-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 ((unpack . filePath) e)
- create = S.insert ((unpack . filePath) e)
-#endif
diff --git a/src/Xmobar/Plugins/MarqueePipeReader.hs b/src/Xmobar/Plugins/MarqueePipeReader.hs
deleted file mode 100644
index ad6f27f..0000000
--- a/src/Xmobar/Plugins/MarqueePipeReader.hs
+++ /dev/null
@@ -1,70 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Plugins.MarqueePipeReader
--- Copyright : (c) Reto Habluetzel
--- License : BSD-style (see LICENSE)
---
--- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>
--- Stability : unstable
--- Portability : unportable
---
--- A plugin for reading from named pipes for long texts with marquee
---
------------------------------------------------------------------------------
-
-module Xmobar.Plugins.MarqueePipeReader where
-
-import System.IO (openFile, IOMode(ReadWriteMode), Handle)
-import Xmobar.Environment
-import Xmobar.Plugins (tenthSeconds, Exec(alias, start), hGetLineSafe)
-import System.Posix.Files (getFileStatus, isNamedPipe)
-import Control.Concurrent(forkIO, threadDelay)
-import Control.Concurrent.STM (TChan, atomically, writeTChan, tryReadTChan, newTChan)
-import Control.Exception
-import Control.Monad(forever, unless)
-import Control.Applicative ((<$>))
-
-type Length = Int -- length of the text to display
-type Rate = Int -- delay in tenth seconds
-type Separator = String -- if text wraps around, use separator
-
-data MarqueePipeReader = MarqueePipeReader String (Length, Rate, Separator) String
- deriving (Read, Show)
-
-instance Exec MarqueePipeReader where
- alias (MarqueePipeReader _ _ a) = a
- start (MarqueePipeReader p (len, rate, sep) _) cb = do
- (def, pipe) <- split ':' <$> expandEnv p
- unless (null def) (cb def)
- checkPipe pipe
- h <- openFile pipe ReadWriteMode
- line <- hGetLineSafe h
- chan <- atomically newTChan
- forkIO $ writer (toInfTxt line sep) sep len rate chan cb
- forever $ pipeToChan h chan
- where
- split c xs | c `elem` xs = let (pre, post) = span (c /=) xs
- in (pre, dropWhile (c ==) post)
- | otherwise = ([], xs)
-
-pipeToChan :: Handle -> TChan String -> IO ()
-pipeToChan h chan = do
- line <- hGetLineSafe h
- atomically $ writeTChan chan line
-
-writer :: String -> Separator -> Length -> Rate -> TChan String -> (String -> IO ()) -> IO ()
-writer txt sep len rate chan cb = do
- cb (take len txt)
- mbnext <- atomically $ tryReadTChan chan
- case mbnext of
- Just new -> writer (toInfTxt new sep) sep len rate chan cb
- Nothing -> tenthSeconds rate >> writer (drop 1 txt) sep len rate chan cb
-
-toInfTxt :: String -> String -> String
-toInfTxt line sep = concat (repeat $ line ++ " " ++ sep ++ " ")
-
-checkPipe :: FilePath -> IO ()
-checkPipe file = handle (\(SomeException _) -> waitForPipe) $ do
- status <- getFileStatus file
- unless (isNamedPipe status) waitForPipe
- where waitForPipe = threadDelay 1000 >> checkPipe file
diff --git a/src/Xmobar/Plugins/Monitors.hs b/src/Xmobar/Plugins/Monitors.hs
deleted file mode 100644
index 64d38f0..0000000
--- a/src/Xmobar/Plugins/Monitors.hs
+++ /dev/null
@@ -1,195 +0,0 @@
-{-# LANGUAGE CPP #-}
-
------------------------------------------------------------------------------
--- |
--- Module : Xmobar.Plugins.Monitors
--- Copyright : (c) 2010, 2011, 2012, 2013, 2017, 2018 Jose Antonio Ortega Ruiz
--- (c) 2007-10 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 Xmobar.Plugins.Monitors where
-
-import Xmobar.Plugins
-
-import Xmobar.Plugins.Monitors.Common (runM, runMD)
-#ifdef WEATHER
-import Xmobar.Plugins.Monitors.Weather
-#endif
-import Xmobar.Plugins.Monitors.Net
-import Xmobar.Plugins.Monitors.Mem
-import Xmobar.Plugins.Monitors.Swap
-import Xmobar.Plugins.Monitors.Cpu
-import Xmobar.Plugins.Monitors.MultiCpu
-import Xmobar.Plugins.Monitors.Batt
-import Xmobar.Plugins.Monitors.Bright
-import Xmobar.Plugins.Monitors.Thermal
-import Xmobar.Plugins.Monitors.ThermalZone
-import Xmobar.Plugins.Monitors.CpuFreq
-import Xmobar.Plugins.Monitors.CoreTemp
-import Xmobar.Plugins.Monitors.Disk
-import Xmobar.Plugins.Monitors.Top
-import Xmobar.Plugins.Monitors.Uptime
-import Xmobar.Plugins.Monitors.CatInt
-#ifdef UVMETER
-import Xmobar.Plugins.Monitors.UVMeter
-#endif
-#ifdef IWLIB
-import Xmobar.Plugins.Monitors.Wireless
-#endif
-#ifdef LIBMPD
-import Xmobar.Plugins.Monitors.MPD
-import Xmobar.Plugins.Monitors.Common (runMBD)
-#endif
-#ifdef ALSA
-import Xmobar.Plugins.Monitors.Volume
-import Xmobar.Plugins.Monitors.Alsa
-#endif
-#ifdef MPRIS
-import Xmobar.Plugins.Monitors.Mpris
-#endif
-
-data Monitors = Network Interface Args Rate
- | DynNetwork Args Rate
- | BatteryP Args Args Rate
- | BatteryN Args Args Rate Alias
- | Battery 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
- | Brightness Args Rate
- | CpuFreq Args Rate
- | CoreTemp Args Rate
- | TopProc Args Rate
- | TopMem Args Rate
- | Uptime Args Rate
- | CatInt Int FilePath Args Rate
-#ifdef WEATHER
- | Weather Station Args Rate
-#endif
-#ifdef UVMETER
- | UVMeter Station Args Rate
-#endif
-#ifdef IWLIB
- | Wireless Interface Args Rate
-#endif
-#ifdef LIBMPD
- | MPD Args Rate
- | AutoMPD Args
-#endif
-#ifdef ALSA
- | Volume String String Args Rate
- | Alsa String String Args
-#endif
-#ifdef MPRIS
- | Mpris1 String Args Rate
- | Mpris2 String Args Rate
-#endif
- deriving (Show,Read,Eq)
-
-type Args = [String]
-type Program = String
-type Alias = String
-type Station = String
-type Zone = String
-type ZoneNo = Int
-type Interface = String
-type Rate = Int
-type DiskSpec = [(String, String)]
-
-instance Exec Monitors where
-#ifdef WEATHER
- alias (Weather s _ _) = s
-#endif
- alias (Network i _ _) = i
- alias (DynNetwork _ _) = "dynnetwork"
- alias (Thermal z _ _) = z
- alias (ThermalZone z _ _) = "thermal" ++ show z
- alias (Memory _ _) = "memory"
- alias (Swap _ _) = "swap"
- alias (Cpu _ _) = "cpu"
- alias (MultiCpu _ _) = "multicpu"
- alias (Battery _ _) = "battery"
- alias BatteryP {} = "battery"
- alias (BatteryN _ _ _ a)= a
- alias (Brightness _ _) = "bright"
- alias (CpuFreq _ _) = "cpufreq"
- alias (TopProc _ _) = "top"
- alias (TopMem _ _) = "topmem"
- alias (CoreTemp _ _) = "coretemp"
- alias DiskU {} = "disku"
- alias DiskIO {} = "diskio"
- alias (Uptime _ _) = "uptime"
- alias (CatInt n _ _ _) = "cat" ++ show n
-#ifdef UVMETER
- alias (UVMeter s _ _) = "uv " ++ s
-#endif
-#ifdef IWLIB
- alias (Wireless i _ _) = i ++ "wi"
-#endif
-#ifdef LIBMPD
- alias (MPD _ _) = "mpd"
- alias (AutoMPD _) = "autompd"
-#endif
-#ifdef ALSA
- alias (Volume m c _ _) = m ++ ":" ++ c
- alias (Alsa m c _) = "alsa:" ++ m ++ ":" ++ c
-#endif
-#ifdef MPRIS
- alias (Mpris1 _ _ _) = "mpris1"
- alias (Mpris2 _ _ _) = "mpris2"
-#endif
- start (Network i a r) = startNet i 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
- start (TopMem a r) = runM a topMemConfig runTopMem r
-#ifdef WEATHER
- start (Weather s a r) = runMD (a ++ [s]) weatherConfig runWeather r weatherReady
-#endif
- start (Thermal z a r) = runM (a ++ [z]) thermalConfig runThermal r
- start (ThermalZone z a r) =
- runM (a ++ [show z]) thermalZoneConfig runThermalZone r
- start (Memory a r) = runM a memConfig runMem r
- start (Swap a r) = runM a swapConfig runSwap r
- start (Battery a r) = runM a battConfig runBatt r
- start (BatteryP s a r) = runM a battConfig (runBatt' s) r
- start (BatteryN s a r _) = runM a battConfig (runBatt' s) r
- start (Brightness a r) = runM a brightConfig runBright 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) = startDiskIO s a r
- start (Uptime a r) = runM a uptimeConfig runUptime r
- start (CatInt _ s a r) = runM a catIntConfig (runCatInt s) r
-#ifdef UVMETER
- start (UVMeter s a r) = runM (a ++ [s]) uvConfig runUVMeter r
-#endif
-#ifdef IWLIB
- start (Wireless i a r) = runM a wirelessConfig (runWireless i) r
-#endif
-#ifdef LIBMPD
- start (MPD a r) = runMD a mpdConfig runMPD r mpdReady
- start (AutoMPD a) = runMBD a mpdConfig runMPD mpdWait mpdReady
-#endif
-#ifdef ALSA
- start (Volume m c a r) = runM a volumeConfig (runVolume m c) r
- start (Alsa m c a) = startAlsaPlugin m c a
-#endif
-#ifdef MPRIS
- start (Mpris1 s a r) = runM a mprisConfig (runMPRIS1 s) r
- start (Mpris2 s a r) = runM a mprisConfig (runMPRIS2 s) r
-#endif
diff --git a/src/Xmobar/Plugins/Monitors/Alsa.hs b/src/Xmobar/Plugins/Monitors/Alsa.hs
deleted file mode 100644
index 21a2786..0000000
--- a/src/Xmobar/Plugins/Monitors/Alsa.hs
+++ /dev/null
@@ -1,146 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Plugins.Monitors.Alsa
--- Copyright : (c) 2018 Daniel Schüssler
--- License : BSD-style (see LICENSE)
---
--- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>
--- Stability : unstable
--- Portability : unportable
---
--- Event-based variant of the Volume plugin.
---
------------------------------------------------------------------------------
-
-module Xmobar.Plugins.Monitors.Alsa
- ( startAlsaPlugin
- , withMonitorWaiter
- , parseOptsIncludingMonitorArgs
- , AlsaOpts(aoAlsaCtlPath)
- ) where
-
-import Control.Concurrent
-import Control.Concurrent.Async
-import Control.Exception
-import Control.Monad
-import Xmobar.Plugins.Monitors.Common
-import qualified Xmobar.Plugins.Monitors.Volume as Volume;
-import System.Console.GetOpt
-import System.Directory
-import System.Exit
-import System.IO
-import System.Process
-
-data AlsaOpts = AlsaOpts
- { aoVolumeOpts :: Volume.VolumeOpts
- , aoAlsaCtlPath :: Maybe FilePath
- }
-
-defaultOpts :: AlsaOpts
-defaultOpts = AlsaOpts Volume.defaultOpts Nothing
-
-alsaCtlOptionName :: String
-alsaCtlOptionName = "alsactl"
-
-options :: [OptDescr (AlsaOpts -> AlsaOpts)]
-options =
- Option "" [alsaCtlOptionName] (ReqArg (\x o ->
- o { aoAlsaCtlPath = Just x }) "") ""
- : fmap (fmap modifyVolumeOpts) Volume.options
- where
- modifyVolumeOpts f o = o { aoVolumeOpts = f (aoVolumeOpts o) }
-
-parseOpts :: [String] -> IO AlsaOpts
-parseOpts argv =
- case getOpt Permute options argv of
- (o, _, []) -> return $ foldr id defaultOpts o
- (_, _, errs) -> ioError . userError $ concat errs
-
-parseOptsIncludingMonitorArgs :: [String] -> IO AlsaOpts
-parseOptsIncludingMonitorArgs args =
- -- Drop generic Monitor args first
- case getOpt Permute [] args of
- (_, args', _) -> parseOpts args'
-
-startAlsaPlugin :: String -> String -> [String] -> (String -> IO ()) -> IO ()
-startAlsaPlugin mixerName controlName args cb = do
- opts <- parseOptsIncludingMonitorArgs args
-
- let run args2 = do
- -- Replicating the reparsing logic used by other plugins for now,
- -- but it seems the option parsing could be floated out (actually,
- -- GHC could in principle do it already since getOpt is pure, but
- -- it would have to inline 'runMBD', 'doArgs' and 'parseOpts' to see
- -- it, which probably isn't going to happen with the default
- -- optimization settings).
- opts2 <- io $ parseOpts args2
- Volume.runVolumeWith (aoVolumeOpts opts2) mixerName controlName
-
- withMonitorWaiter mixerName (aoAlsaCtlPath opts) $ \wait_ ->
- runMB args Volume.volumeConfig run wait_ cb
-
-withMonitorWaiter :: String -> Maybe FilePath -> (IO () -> IO a) -> IO a
-withMonitorWaiter mixerName alsaCtlPath cont = do
- mvar <- newMVar ()
-
- path <- determineAlsaCtlPath
-
- bracket (async $ readerThread mvar path) cancel $ \a -> do
-
- -- Throw on this thread if there's an exception
- -- on the reader thread.
- link a
-
- cont $ takeMVar mvar
-
- where
-
- readerThread mvar path =
- let createProc = (proc "stdbuf" ["-oL", path, "monitor", mixerName])
- {std_out = CreatePipe}
- in
- withCreateProcess createProc $ \_ (Just alsaOut) _ _ -> do
- hSetBuffering alsaOut LineBuffering
-
- forever $ do
- c <- hGetChar alsaOut
- when (c == '\n') $
- -- This uses 'tryPutMVar' because 'putMVar' would make 'runVolume' run
- -- once for each event. But we want it to run only once after a burst
- -- of events.
- void $ tryPutMVar mvar ()
-
- defaultPath = "/usr/sbin/alsactl"
-
- determineAlsaCtlPath =
- case alsaCtlPath of
- Just path -> do
- found <- doesFileExist path
- if found
- then pure path
- else throwIO . ErrorCall $
- "Specified alsactl file " ++ path ++ " does not exist"
-
- Nothing -> do
- (ec, path, err) <- readProcessWithExitCode "which" ["alsactl"] ""
- unless (null err) $ hPutStrLn stderr err
- case ec of
- ExitSuccess -> pure $ trimTrailingNewline path
- ExitFailure _ -> do
- found <- doesFileExist defaultPath
- if found
- then pure defaultPath
- else throwIO . ErrorCall $
- "alsactl not found in PATH or at " ++
- show defaultPath ++
- "; please specify with --" ++
- alsaCtlOptionName ++ "=/path/to/alsactl"
-
-
--- This is necessarily very inefficient on 'String's
-trimTrailingNewline :: String -> String
-trimTrailingNewline x =
- case reverse x of
- '\n' : '\r' : y -> reverse y
- '\n' : y -> reverse y
- _ -> x
diff --git a/src/Xmobar/Plugins/Monitors/Batt.hs b/src/Xmobar/Plugins/Monitors/Batt.hs
deleted file mode 100644
index 80f4275..0000000
--- a/src/Xmobar/Plugins/Monitors/Batt.hs
+++ /dev/null
@@ -1,247 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Plugins.Monitors.Batt
--- Copyright : (c) 2010, 2011, 2012, 2013, 2015, 2016, 2018 Jose A Ortega
--- (c) 2010 Andrea Rossato, Petr Rockai
--- License : BSD-style (see LICENSE)
---
--- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>
--- Stability : unstable
--- Portability : unportable
---
--- A battery monitor for Xmobar
---
------------------------------------------------------------------------------
-
-module Xmobar.Plugins.Monitors.Batt ( battConfig, runBatt, runBatt' ) where
-
-import Control.Exception (SomeException, handle)
-import Xmobar.Plugins.Monitors.Common
-import System.FilePath ((</>))
-import System.IO (IOMode(ReadMode), hGetLine, withFile)
-import System.Posix.Files (fileExist)
-import System.Console.GetOpt
-import Data.List (sort, sortBy, group)
-import Data.Maybe (fromMaybe)
-import Data.Ord (comparing)
-import Text.Read (readMaybe)
-
-data BattOpts = BattOpts
- { onString :: String
- , offString :: String
- , idleString :: String
- , posColor :: Maybe String
- , lowWColor :: Maybe String
- , mediumWColor :: Maybe String
- , highWColor :: Maybe String
- , lowThreshold :: Float
- , highThreshold :: Float
- , onlineFile :: FilePath
- , scale :: Float
- , onIconPattern :: Maybe IconPattern
- , offIconPattern :: Maybe IconPattern
- , idleIconPattern :: Maybe IconPattern
- }
-
-defaultOpts :: BattOpts
-defaultOpts = BattOpts
- { onString = "On"
- , offString = "Off"
- , idleString = "On"
- , posColor = Nothing
- , lowWColor = Nothing
- , mediumWColor = Nothing
- , highWColor = Nothing
- , lowThreshold = 10
- , highThreshold = 12
- , onlineFile = "AC/online"
- , scale = 1e6
- , onIconPattern = Nothing
- , offIconPattern = Nothing
- , idleIconPattern = Nothing
- }
-
-options :: [OptDescr (BattOpts -> BattOpts)]
-options =
- [ Option "O" ["on"] (ReqArg (\x o -> o { onString = x }) "") ""
- , Option "o" ["off"] (ReqArg (\x o -> o { offString = x }) "") ""
- , Option "i" ["idle"] (ReqArg (\x o -> o { idleString = 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 }) "") ""
- , Option "f" ["online"] (ReqArg (\x o -> o { onlineFile = x }) "") ""
- , Option "s" ["scale"] (ReqArg (\x o -> o {scale = read x}) "") ""
- , Option "" ["on-icon-pattern"] (ReqArg (\x o ->
- o { onIconPattern = Just $ parseIconPattern x }) "") ""
- , Option "" ["off-icon-pattern"] (ReqArg (\x o ->
- o { offIconPattern = Just $ parseIconPattern x }) "") ""
- , Option "" ["idle-icon-pattern"] (ReqArg (\x o ->
- o { idleIconPattern = Just $ parseIconPattern 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 Status = Charging | Discharging | Full | Idle | Unknown deriving (Read, Eq)
-
-data Result = Result Float Float Float Status | NA
-
-sysDir :: FilePath
-sysDir = "/sys/class/power_supply"
-
-battConfig :: IO MConfig
-battConfig = mkMConfig
- "Batt: <watts>, <left>% / <timeleft>" -- template
- ["leftbar", "leftvbar", "left", "acstatus", "timeleft", "watts", "leftipat"] -- replacements
-
-data Files = Files
- { fFull :: String
- , fNow :: String
- , fVoltage :: String
- , fCurrent :: String
- , fStatus :: String
- , isCurrent :: Bool
- } | NoFiles deriving Eq
-
-data Battery = Battery
- { full :: !Float
- , now :: !Float
- , power :: !Float
- , status :: !String
- }
-
-safeFileExist :: String -> String -> IO Bool
-safeFileExist d f = handle noErrors $ fileExist (d </> f)
- where noErrors = const (return False) :: SomeException -> IO Bool
-
-batteryFiles :: String -> IO Files
-batteryFiles bat =
- do is_charge <- exists "charge_now"
- is_energy <- if is_charge then return False else exists "energy_now"
- is_power <- exists "power_now"
- plain <- exists (if is_charge then "charge_full" else "energy_full")
- let cf = if is_power then "power_now" else "current_now"
- sf = if plain then "" else "_design"
- return $ case (is_charge, is_energy) of
- (True, _) -> files "charge" cf sf is_power
- (_, True) -> files "energy" cf sf is_power
- _ -> NoFiles
- where prefix = sysDir </> bat
- exists = safeFileExist prefix
- files ch cf sf ip = Files { fFull = prefix </> ch ++ "_full" ++ sf
- , fNow = prefix </> ch ++ "_now"
- , fCurrent = prefix </> cf
- , fVoltage = prefix </> "voltage_now"
- , fStatus = prefix </> "status"
- , isCurrent = not ip}
-
-haveAc :: FilePath -> IO Bool
-haveAc f =
- handle onError $ withFile (sysDir </> f) ReadMode (fmap (== "1") . hGetLine)
- where onError = const (return False) :: SomeException -> IO Bool
-
-readBattery :: Float -> Files -> IO Battery
-readBattery _ NoFiles = return $ Battery 0 0 0 "Unknown"
-readBattery sc files =
- do a <- grab $ fFull files
- b <- grab $ fNow files
- d <- grab $ fCurrent files
- s <- grabs $ fStatus files
- let sc' = if isCurrent files then sc / 10 else sc
- a' = max a b -- sometimes the reported max charge is lower than
- return $ Battery (3600 * a' / sc') -- wattseconds
- (3600 * b / sc') -- wattseconds
- (d / sc') -- watts
- s -- string: Discharging/Charging/Full
- where grab f = handle onError $ withFile f ReadMode (fmap read . hGetLine)
- onError = const (return (-1)) :: SomeException -> IO Float
- grabs f = handle onError' $ withFile f ReadMode hGetLine
- onError' = const (return "Unknown") :: SomeException -> IO String
-
--- sortOn is only available starting at ghc 7.10
-sortOn :: Ord b => (a -> b) -> [a] -> [a]
-sortOn f =
- map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x))
-
-mostCommonDef :: Eq a => a -> [a] -> a
-mostCommonDef x xs = head $ last $ [x] : sortOn length (group xs)
-
-readBatteries :: BattOpts -> [Files] -> IO Result
-readBatteries opts bfs =
- do let bfs' = filter (/= NoFiles) bfs
- bats <- mapM (readBattery (scale opts)) (take 3 bfs')
- ac <- haveAc (onlineFile opts)
- let sign = if ac then 1 else -1
- ft = sum (map full bats)
- left = if ft > 0 then sum (map now bats) / ft else 0
- watts = sign * sum (map power bats)
- time = if watts == 0 then 0 else max 0 (sum $ map time' bats)
- mwatts = if watts == 0 then 1 else sign * watts
- time' b = (if ac then full b - now b else now b) / mwatts
- statuses :: [Status]
- statuses = map (fromMaybe Unknown . readMaybe)
- (sort (map status bats))
- acst = mostCommonDef Unknown $ filter (Unknown/=) statuses
- racst | acst /= Unknown = acst
- | time == 0 = Idle
- | ac = Charging
- | otherwise = Discharging
- return $ if isNaN left then NA else Result left watts time racst
-
-runBatt :: [String] -> Monitor String
-runBatt = runBatt' ["BAT", "BAT0", "BAT1", "BAT2"]
-
-runBatt' :: [String] -> [String] -> Monitor String
-runBatt' bfs args = do
- opts <- io $ parseOpts args
- c <- io $ readBatteries opts =<< mapM batteryFiles bfs
- suffix <- getConfigValue useSuffix
- d <- getConfigValue decDigits
- nas <- getConfigValue naString
- case c of
- Result x w t s ->
- do l <- fmtPercent x
- ws <- fmtWatts w opts suffix d
- si <- getIconPattern opts s x
- parseTemplate (l ++ [fmtStatus opts s nas, fmtTime $ floor t, ws, si])
- NA -> getConfigValue naString
- where fmtPercent :: Float -> Monitor [String]
- fmtPercent x = do
- let x' = minimum [1, x]
- p <- showPercentWithColors x'
- b <- showPercentBar (100 * x') x'
- vb <- showVerticalBar (100 * x') x'
- return [b, vb, p]
- fmtWatts x o s d = do
- ws <- showWithPadding $ showDigits d x ++ (if s then "W" else "")
- return $ color x o ws
- 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)
- fmtStatus opts Idle _ = idleString opts
- fmtStatus _ Unknown na = na
- fmtStatus opts Full _ = idleString opts
- fmtStatus opts Charging _ = onString opts
- fmtStatus opts Discharging _ = offString opts
- maybeColor Nothing str = str
- 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)
- getIconPattern opts st x = do
- let x' = minimum [1, x]
- case st of
- Unknown -> showIconPattern (offIconPattern opts) x'
- Idle -> showIconPattern (idleIconPattern opts) x'
- Full -> showIconPattern (idleIconPattern opts) x'
- Charging -> showIconPattern (onIconPattern opts) x'
- Discharging -> showIconPattern (offIconPattern opts) x'
diff --git a/src/Xmobar/Plugins/Monitors/Bright.hs b/src/Xmobar/Plugins/Monitors/Bright.hs
deleted file mode 100644
index fe72219..0000000
--- a/src/Xmobar/Plugins/Monitors/Bright.hs
+++ /dev/null
@@ -1,99 +0,0 @@
------------------------------------------------------------------------------
----- |
----- Module : Plugins.Monitors.Birght
----- Copyright : (c) Martin Perner
----- License : BSD-style (see LICENSE)
-----
----- Maintainer : Martin Perner <martin@perner.cc>
----- Stability : unstable
----- Portability : unportable
-----
----- A screen brightness monitor for Xmobar
-----
--------------------------------------------------------------------------------
-
-module Xmobar.Plugins.Monitors.Bright (brightConfig, runBright) where
-
-import Control.Applicative ((<$>))
-import Control.Exception (SomeException, handle)
-import qualified Data.ByteString.Lazy.Char8 as B
-import System.FilePath ((</>))
-import System.Posix.Files (fileExist)
-import System.Console.GetOpt
-
-import Xmobar.Plugins.Monitors.Common
-
-data BrightOpts = BrightOpts { subDir :: String
- , currBright :: String
- , maxBright :: String
- , curBrightIconPattern :: Maybe IconPattern
- }
-
-defaultOpts :: BrightOpts
-defaultOpts = BrightOpts { subDir = "acpi_video0"
- , currBright = "actual_brightness"
- , maxBright = "max_brightness"
- , curBrightIconPattern = Nothing
- }
-
-options :: [OptDescr (BrightOpts -> BrightOpts)]
-options = [ Option "D" ["device"] (ReqArg (\x o -> o { subDir = x }) "") ""
- , Option "C" ["curr"] (ReqArg (\x o -> o { currBright = x }) "") ""
- , Option "M" ["max"] (ReqArg (\x o -> o { maxBright = x }) "") ""
- , Option "" ["brightness-icon-pattern"] (ReqArg (\x o ->
- o { curBrightIconPattern = Just $ parseIconPattern x }) "") ""
- ]
-
--- from Batt.hs
-parseOpts :: [String] -> IO BrightOpts
-parseOpts argv =
- case getOpt Permute options argv of
- (o, _, []) -> return $ foldr id defaultOpts o
- (_, _, errs) -> ioError . userError $ concat errs
-
-sysDir :: FilePath
-sysDir = "/sys/class/backlight/"
-
-brightConfig :: IO MConfig
-brightConfig = mkMConfig "<percent>" -- template
- ["vbar", "percent", "bar", "ipat"] -- replacements
-
-data Files = Files { fCurr :: String
- , fMax :: String
- }
- | NoFiles
-
-brightFiles :: BrightOpts -> IO Files
-brightFiles opts = do
- is_curr <- fileExist $ fCurr files
- is_max <- fileExist $ fCurr files
- return (if is_curr && is_max then files else NoFiles)
- where prefix = sysDir </> subDir opts
- files = Files { fCurr = prefix </> currBright opts
- , fMax = prefix </> maxBright opts
- }
-
-runBright :: [String] -> Monitor String
-runBright args = do
- opts <- io $ parseOpts args
- f <- io $ brightFiles opts
- c <- io $ readBright f
- case f of
- NoFiles -> return "hurz"
- _ -> fmtPercent opts c >>= parseTemplate
- where fmtPercent :: BrightOpts -> Float -> Monitor [String]
- fmtPercent opts c = do r <- showVerticalBar (100 * c) c
- s <- showPercentWithColors c
- t <- showPercentBar (100 * c) c
- d <- showIconPattern (curBrightIconPattern opts) c
- return [r,s,t,d]
-
-readBright :: Files -> IO Float
-readBright NoFiles = return 0
-readBright files = do
- currVal<- grab $ fCurr files
- maxVal <- grab $ fMax files
- return (currVal / maxVal)
- where grab f = handle handler (read . B.unpack <$> B.readFile f)
- handler = const (return 0) :: SomeException -> IO Float
-
diff --git a/src/Xmobar/Plugins/Monitors/CatInt.hs b/src/Xmobar/Plugins/Monitors/CatInt.hs
deleted file mode 100644
index 781eded..0000000
--- a/src/Xmobar/Plugins/Monitors/CatInt.hs
+++ /dev/null
@@ -1,25 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Plugins.Monitors.CatInt
--- Copyright : (c) Nathaniel Wesley Filardo
--- License : BSD-style (see LICENSE)
---
--- Maintainer : Nathaniel Wesley Filardo
--- Stability : unstable
--- Portability : unportable
---
------------------------------------------------------------------------------
-
-module Xmobar.Plugins.Monitors.CatInt where
-
-import Xmobar.Plugins.Monitors.Common
-import Xmobar.Plugins.Monitors.CoreCommon
-
-catIntConfig :: IO MConfig
-catIntConfig = mkMConfig "<v>" ["v"]
-
-runCatInt :: FilePath -> [String] -> Monitor String
-runCatInt p _ =
- let failureMessage = "Cannot read: " ++ show p
- fmt x = show (truncate x :: Int)
- in checkedDataRetrieval failureMessage [[p]] Nothing id fmt
diff --git a/src/Xmobar/Plugins/Monitors/Common.hs b/src/Xmobar/Plugins/Monitors/Common.hs
deleted file mode 100644
index 272690b..0000000
--- a/src/Xmobar/Plugins/Monitors/Common.hs
+++ /dev/null
@@ -1,544 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Plugins.Monitors.Common
--- Copyright : (c) 2010, 2011, 2013, 2016, 2017, 2018 Jose Antonio Ortega Ruiz
--- (c) 2007-2010 Andrea Rossato
--- License : BSD-style (see LICENSE)
---
--- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>
--- Stability : unstable
--- Portability : unportable
---
--- Utilities used by xmobar's monitors
---
------------------------------------------------------------------------------
-
-module Xmobar.Plugins.Monitors.Common (
- -- * Monitors
- -- $monitor
- Monitor
- , MConfig (..)
- , Opts (..)
- , setConfigValue
- , getConfigValue
- , mkMConfig
- , runM
- , runMD
- , runMB
- , runMBD
- , io
- -- * Parsers
- -- $parsers
- , runP
- , skipRestOfLine
- , getNumbers
- , getNumbersAsString
- , getAllBut
- , getAfterString
- , skipTillString
- , parseTemplate
- , parseTemplate'
- -- ** String Manipulation
- -- $strings
- , IconPattern
- , parseIconPattern
- , padString
- , showWithPadding
- , showWithColors
- , showWithColors'
- , showPercentWithColors
- , showPercentsWithColors
- , showPercentBar
- , showVerticalBar
- , showIconPattern
- , showLogBar
- , showLogVBar
- , showLogIconPattern
- , showWithUnits
- , takeDigits
- , showDigits
- , floatToPercent
- , parseFloat
- , parseInt
- , stringParser
- ) where
-
-
-import Control.Applicative ((<$>))
-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 Data.Char
-import Numeric
-import Text.ParserCombinators.Parsec
-import System.Console.GetOpt
-import Control.Exception (SomeException,handle)
-
-import Xmobar.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
- , decDigits :: IORef Int
- , minWidth :: IORef Int
- , maxWidth :: IORef Int
- , maxWidthEllipsis :: IORef String
- , padChars :: IORef String
- , padRight :: IORef Bool
- , barBack :: IORef String
- , barFore :: IORef String
- , barWidth :: IORef Int
- , useSuffix :: IORef Bool
- , naString :: IORef String
- , maxTotalWidth :: IORef Int
- , maxTotalWidthEllipsis :: IORef String
- }
-
--- | 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 (const 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
- d <- newIORef 0
- mn <- newIORef 0
- mx <- newIORef 0
- mel <- newIORef ""
- pc <- newIORef " "
- pr <- newIORef False
- bb <- newIORef ":"
- bf <- newIORef "#"
- bw <- newIORef 10
- up <- newIORef False
- na <- newIORef "N/A"
- mt <- newIORef 0
- mtel <- newIORef ""
- return $ MC nc l lc h hc t e p d mn mx mel pc pr bb bf bw up na mt mtel
-
-data Opts = HighColor String
- | NormalColor String
- | LowColor String
- | Low String
- | High String
- | Template String
- | PercentPad String
- | DecDigits String
- | MinWidth String
- | MaxWidth String
- | Width String
- | WidthEllipsis String
- | PadChars String
- | PadAlign String
- | BarBack String
- | BarFore String
- | BarWidth String
- | UseSuffix String
- | NAString String
- | MaxTotalWidth String
- | MaxTotalWidthEllipsis 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 "d" ["ddigits"] (ReqArg DecDigits "decimal digits") "Number of decimal digits to display."
- , 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 "e" ["maxwidthellipsis"] (ReqArg WidthEllipsis "Maximum width ellipsis") "Ellipsis to be added to the field when it has reached its max 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"
- , Option "x" ["nastring"] (ReqArg NAString "N/A string") "String used when the monitor is not available"
- , Option "T" ["maxtwidth"] (ReqArg MaxTotalWidth "Maximum total width") "Maximum total width"
- , Option "E" ["maxtwidthellipsis"] (ReqArg MaxTotalWidthEllipsis "Maximum total width ellipsis") "Ellipsis to be added to the total text when it has reached its max width."
- ]
-
-doArgs :: [String] -> ([String] -> Monitor String) -> ([String] -> Monitor Bool) -> Monitor String
-doArgs args action detect =
- case getOpt Permute options args of
- (o, n, []) -> do doConfigOptions o
- ready <- detect n
- if ready
- then action n
- else return "<Waiting...>"
- (_, _, 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
- DecDigits d -> setConfigValue (nz d) decDigits
- MinWidth w -> setConfigValue (nz w) minWidth
- MaxWidth w -> setConfigValue (nz w) maxWidth
- Width w -> setConfigValue (nz w) minWidth >>
- setConfigValue (nz w) maxWidth
- WidthEllipsis e -> setConfigValue e maxWidthEllipsis
- 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
- NAString s -> setConfigValue s naString
- MaxTotalWidth w -> setConfigValue (nz w) maxTotalWidth
- MaxTotalWidthEllipsis e -> setConfigValue e maxTotalWidthEllipsis) >> next
-
-runM :: [String] -> IO MConfig -> ([String] -> Monitor String) -> Int
- -> (String -> IO ()) -> IO ()
-runM args conf action r = runMB args conf action (tenthSeconds r)
-
-runMD :: [String] -> IO MConfig -> ([String] -> Monitor String) -> Int
- -> ([String] -> Monitor Bool) -> (String -> IO ()) -> IO ()
-runMD args conf action r = runMBD args conf action (tenthSeconds r)
-
-runMB :: [String] -> IO MConfig -> ([String] -> Monitor String) -> IO ()
- -> (String -> IO ()) -> IO ()
-runMB args conf action wait = runMBD args conf action wait (\_ -> return True)
-
-runMBD :: [String] -> IO MConfig -> ([String] -> Monitor String) -> IO ()
- -> ([String] -> Monitor Bool) -> (String -> IO ()) -> IO ()
-runMBD args conf action wait detect cb = handle (cb . showException) loop
- where ac = doArgs args action detect
- loop = conf >>= runReaderT ac >>= cb >> wait >> 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 = fmap concat . many $
- many1 (noneOf "<") <|> colorSpec <|> iconSpec
-
--- | 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 ++ ">")
-
--- | Recognizes icon specification and returns it unchanged
-iconSpec :: Parser String
-iconSpec = try (do string "<icon="
- i <- manyTill (noneOf ">") (try (string "/>"))
- return $ "<icon=" ++ i ++ "/>")
-
--- | 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 --"%")
-
-trimTo :: Int -> String -> String -> (Int, String)
-trimTo n p "" = (n, p)
-trimTo n p ('<':cs) = trimTo n p' s
- where p' = p ++ "<" ++ takeWhile (/= '>') cs ++ ">"
- s = drop 1 (dropWhile (/= '>') cs)
-trimTo 0 p s = trimTo 0 p (dropWhile (/= '<') s)
-trimTo n p s = let p' = takeWhile (/= '<') s
- s' = dropWhile (/= '<') s
- in
- if length p' <= n
- then trimTo (n - length p') (p ++ p') s'
- else trimTo 0 (p ++ take n p') s'
-
--- | 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, trimmed to MaxTotalWidth if that
--- configuration value is positive.
-parseTemplate :: [String] -> Monitor String
-parseTemplate l =
- do t <- getConfigValue template
- e <- getConfigValue export
- w <- getConfigValue maxTotalWidth
- ell <- getConfigValue maxTotalWidthEllipsis
- let m = Map.fromList . zip e $ l
- s <- parseTemplate' t m
- let (n, s') = if w > 0 && length s > w
- then trimTo (w - length ell) "" s
- else (1, s)
- return $ if n > 0 then s' else s' ++ ell
-
--- | Parses the template given to it with a map of export values and combines
--- them
-parseTemplate' :: String -> Map.Map String String -> Monitor String
-parseTemplate' t m =
- do s <- io $ runP templateParser t
- combine m s
-
--- | Given a finite "Map" and a parsed template t produces the
--- | resulting output string as the output of the monitor.
-combine :: Map.Map String String -> [(String, String, String)] -> Monitor String
-combine _ [] = return []
-combine m ((s,ts,ss):xs) =
- do next <- combine m xs
- str <- case Map.lookup ts m of
- Nothing -> return $ "<" ++ ts ++ ">"
- Just r -> let f "" = r; f n = n; in f <$> parseTemplate' r m
- return $ s ++ str ++ ss ++ next
-
--- $strings
-
-type IconPattern = Int -> String
-
-parseIconPattern :: String -> IconPattern
-parseIconPattern path =
- let spl = splitOnPercent path
- in \i -> intercalate (show i) spl
- where splitOnPercent [] = [[]]
- splitOnPercent ('%':'%':xs) = [] : splitOnPercent xs
- splitOnPercent (x:xs) =
- let rest = splitOnPercent xs
- in (x : head rest) : tail rest
-
-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 -> String
-padString mnw mxw pad pr ellipsis 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 ++ ellipsis
- 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
- ellipsis <- getConfigValue maxWidthEllipsis
- return $ padString mn mx p pr ellipsis 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 = fmap 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)
-
-showIconPattern :: Maybe IconPattern -> Float -> Monitor String
-showIconPattern Nothing _ = return ""
-showIconPattern (Just str) x = return $ str $ convert $ 100 * x
- where convert val
- | t <= 0 = 0
- | t > 8 = 8
- | otherwise = t
- where t = round val `div` 12
-
-showVerticalBar :: Float -> Float -> Monitor String
-showVerticalBar v x = colorizeString v [convert $ 100 * x]
- where convert :: Float -> Char
- convert val
- | t <= 9600 = ' '
- | t > 9608 = chr 9608
- | otherwise = chr t
- where t = 9600 + (round val `div` 12)
-
-logScaling :: Float -> Float -> Monitor Float
-logScaling f v = do
- h <- fromIntegral `fmap` getConfigValue high
- l <- fromIntegral `fmap` getConfigValue low
- bw <- fromIntegral `fmap` getConfigValue barWidth
- let [ll, hh] = sort [l, h]
- scaled x | x == 0.0 = 0
- | x <= ll = 1 / bw
- | otherwise = f + logBase 2 (x / hh) / bw
- return $ scaled v
-
-showLogBar :: Float -> Float -> Monitor String
-showLogBar f v = logScaling f v >>= showPercentBar v
-
-showLogVBar :: Float -> Float -> Monitor String
-showLogVBar f v = logScaling f v >>= showVerticalBar v
-
-showLogIconPattern :: Maybe IconPattern -> Float -> Float -> Monitor String
-showLogIconPattern str f v = logScaling f v >>= showIconPattern str
diff --git a/src/Xmobar/Plugins/Monitors/CoreCommon.hs b/src/Xmobar/Plugins/Monitors/CoreCommon.hs
deleted file mode 100644
index a84198e..0000000
--- a/src/Xmobar/Plugins/Monitors/CoreCommon.hs
+++ /dev/null
@@ -1,138 +0,0 @@
-{-# LANGUAGE CPP, PatternGuards #-}
-
------------------------------------------------------------------------------
--- |
--- 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 Xmobar.Plugins.Monitors.CoreCommon where
-
-#if __GLASGOW_HASKELL__ < 800
-import Control.Applicative
-#endif
-
-import Data.Char hiding (Space)
-import Data.Function
-import Data.List
-import Data.Maybe
-import Xmobar.Plugins.Monitors.Common
-import System.Directory
-
-checkedDataRetrieval :: (Ord a, Num a)
- => String -> [[String]] -> Maybe (String, String -> Int)
- -> (Double -> a) -> (a -> String) -> Monitor String
-checkedDataRetrieval msg paths lbl trans fmt =
- fmap (fromMaybe msg . listToMaybe . catMaybes) $
- mapM (\p -> retrieveData p lbl trans fmt) paths
-
-retrieveData :: (Ord a, Num a)
- => [String] -> Maybe (String, String -> Int)
- -> (Double -> a) -> (a -> String) -> Monitor (Maybe String)
-retrieveData path lbl trans fmt = do
- pairs <- map snd . sortBy (compare `on` fst) <$>
- (mapM readFiles =<< findFilesAndLabel path lbl)
- if null pairs
- then return Nothing
- else Just <$> ( parseTemplate
- =<< mapM (showWithColors fmt . trans . read) pairs
- )
-
--- | Represents the different types of path components
-data Comp = Fix String
- | Var [String]
- deriving Show
-
--- | Used to represent parts of file names separated by slashes and spaces
-data CompOrSep = Slash
- | Space
- | Comp String
- deriving (Eq, Show)
-
--- | Function to turn a list of of strings into a list of path components
-pathComponents :: [String] -> [Comp]
-pathComponents = joinComps . drop 2 . intercalate [Space] . map splitParts
- where
- splitParts p | (l, _:r) <- break (== '/') p = Comp l : Slash : splitParts r
- | otherwise = [Comp p]
-
- joinComps = uncurry joinComps' . partition isComp
-
- isComp (Comp _) = True
- isComp _ = False
-
- fromComp (Comp s) = s
- fromComp _ = error "fromComp applied to value other than (Comp _)"
-
- joinComps' cs [] = [Fix $ fromComp $ head cs] -- cs should have only one element here,
- -- but this keeps the pattern matching
- -- exhaustive
- joinComps' cs (p:ps) = let (ss, ps') = span (== p) ps
- ct = if null ps' || (p == Space) then length ss + 1
- else length ss
- (ls, rs) = splitAt (ct+1) cs
- c = case p of
- Space -> Var $ map fromComp ls
- Slash -> Fix $ intercalate "/" $ map fromComp ls
- _ -> error "Should not happen"
- in if null ps' then [c]
- else c:joinComps' rs (drop ct ps)
-
--- | Function to find all files matching the given path and possible label file.
--- The path must be absolute (start with a leading slash).
-findFilesAndLabel :: [String] -> Maybe (String, String -> Int)
- -> Monitor [(String, Either Int (String, String -> Int))]
-findFilesAndLabel path lbl = catMaybes
- <$> ( mapM addLabel . zip [0..] . sort
- =<< recFindFiles (pathComponents path) "/"
- )
- where
- addLabel (i, f) = maybe (return $ Just (f, Left i))
- (uncurry (justIfExists f))
- lbl
-
- justIfExists f s t = let f' = take (length f - length s) f ++ s
- in ifthen (Just (f, Right (f', t))) Nothing <$> io (doesFileExist f')
-
- recFindFiles [] d = ifthen [d] []
- <$> io (if null d then return False else doesFileExist d)
- recFindFiles ps d = ifthen (recFindFiles' ps d) (return [])
- =<< io (if null d then return True else doesDirectoryExist d)
-
- recFindFiles' [] _ = error "Should not happen"
- recFindFiles' (Fix p:ps) d = recFindFiles ps (d ++ "/" ++ p)
- recFindFiles' (Var p:ps) d = concat
- <$> ((mapM (recFindFiles ps
- . (\f -> d ++ "/" ++ f))
- . filter (matchesVar p))
- =<< io (getDirectoryContents d)
- )
-
- matchesVar [] _ = False
- matchesVar [v] f = v == f
- matchesVar (v:vs) f = let f' = drop (length v) f
- f'' = dropWhile isDigit f'
- in and [ v `isPrefixOf` f
- , not (null f')
- , isDigit (head f')
- , matchesVar vs f''
- ]
-
--- | Function to read the contents of the given file(s)
-readFiles :: (String, Either Int (String, String -> Int))
- -> Monitor (Int, String)
-readFiles (fval, flbl) = (,) <$> either return (\(f, ex) -> fmap ex
- $ io $ readFile f) flbl
- <*> io (readFile fval)
-
--- | Function that captures if-then-else
-ifthen :: a -> a -> Bool -> a
-ifthen thn els cnd = if cnd then thn else els
diff --git a/src/Xmobar/Plugins/Monitors/CoreTemp.hs b/src/Xmobar/Plugins/Monitors/CoreTemp.hs
deleted file mode 100644
index 48fe428..0000000
--- a/src/Xmobar/Plugins/Monitors/CoreTemp.hs
+++ /dev/null
@@ -1,45 +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 Xmobar.Plugins.Monitors.CoreTemp where
-
-import Xmobar.Plugins.Monitors.Common
-import Xmobar.Plugins.Monitors.CoreCommon
-
-
-import Data.Char (isDigit)
-
--- |
--- 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
- (map ((++) "core" . show) [0 :: Int ..]) -- available
- -- replacements
-
--- |
--- Function retrieves monitor string holding the core temperature
--- (or temperatures)
-runCoreTemp :: [String] -> Monitor String
-runCoreTemp _ = do
- dn <- getConfigValue decDigits
- failureMessage <- getConfigValue naString
- let path = ["/sys/bus/platform/devices/coretemp.", "/temp", "_input"]
- path' = ["/sys/bus/platform/devices/coretemp.", "/hwmon/hwmon", "/temp", "_input"]
- lbl = Just ("_label", read . dropWhile (not . isDigit))
- divisor = 1e3 :: Double
- show' = showDigits (max 0 dn)
- checkedDataRetrieval failureMessage [path, path'] lbl (/divisor) show'
diff --git a/src/Xmobar/Plugins/Monitors/Cpu.hs b/src/Xmobar/Plugins/Monitors/Cpu.hs
deleted file mode 100644
index 6befe7d..0000000
--- a/src/Xmobar/Plugins/Monitors/Cpu.hs
+++ /dev/null
@@ -1,88 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Plugins.Monitors.Cpu
--- Copyright : (c) 2011, 2017 Jose Antonio Ortega Ruiz
--- (c) 2007-2010 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 Xmobar.Plugins.Monitors.Cpu (startCpu) where
-
-import Xmobar.Plugins.Monitors.Common
-import qualified Data.ByteString.Lazy.Char8 as B
-import Data.IORef (IORef, newIORef, readIORef, writeIORef)
-import System.Console.GetOpt
-
-newtype CpuOpts = CpuOpts
- { loadIconPattern :: Maybe IconPattern
- }
-
-defaultOpts :: CpuOpts
-defaultOpts = CpuOpts
- { loadIconPattern = Nothing
- }
-
-options :: [OptDescr (CpuOpts -> CpuOpts)]
-options =
- [ Option "" ["load-icon-pattern"] (ReqArg (\x o ->
- o { loadIconPattern = Just $ parseIconPattern x }) "") ""
- ]
-
-parseOpts :: [String] -> IO CpuOpts
-parseOpts argv =
- case getOpt Permute options argv of
- (o, _, []) -> return $ foldr id defaultOpts o
- (_, _, errs) -> ioError . userError $ concat errs
-
-cpuConfig :: IO MConfig
-cpuConfig = mkMConfig
- "Cpu: <total>%"
- ["bar","vbar","ipat","total","user","nice","system","idle","iowait"]
-
-type CpuDataRef = IORef [Int]
-
-cpuData :: IO [Int]
-cpuData = cpuParser `fmap` B.readFile "/proc/stat"
-
-cpuParser :: B.ByteString -> [Int]
-cpuParser = map (read . B.unpack) . tail . B.words . head . B.lines
-
-parseCpu :: CpuDataRef -> IO [Float]
-parseCpu cref =
- do a <- readIORef cref
- b <- cpuData
- writeIORef cref b
- let dif = zipWith (-) b a
- tot = fromIntegral $ sum dif
- percent = map ((/ tot) . fromIntegral) dif
- return percent
-
-formatCpu :: CpuOpts -> [Float] -> Monitor [String]
-formatCpu _ [] = return $ replicate 8 ""
-formatCpu opts xs = do
- let t = sum $ take 3 xs
- b <- showPercentBar (100 * t) t
- v <- showVerticalBar (100 * t) t
- d <- showIconPattern (loadIconPattern opts) t
- ps <- showPercentsWithColors (t:xs)
- return (b:v:d:ps)
-
-runCpu :: CpuDataRef -> [String] -> Monitor String
-runCpu cref argv =
- do c <- io (parseCpu cref)
- opts <- io $ parseOpts argv
- l <- formatCpu opts c
- parseTemplate l
-
-startCpu :: [String] -> Int -> (String -> IO ()) -> IO ()
-startCpu a r cb = do
- cref <- newIORef []
- _ <- parseCpu cref
- runM a cpuConfig (runCpu cref) r cb
diff --git a/src/Xmobar/Plugins/Monitors/CpuFreq.hs b/src/Xmobar/Plugins/Monitors/CpuFreq.hs
deleted file mode 100644
index 1afedfa..0000000
--- a/src/Xmobar/Plugins/Monitors/CpuFreq.hs
+++ /dev/null
@@ -1,44 +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 Xmobar.Plugins.Monitors.CpuFreq where
-
-import Xmobar.Plugins.Monitors.Common
-import Xmobar.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>" (map ((++) "cpu" . show) [0 :: Int ..])
-
-
--- |
--- Function retrieves monitor string holding the cpu frequency (or
--- frequencies)
-runCpuFreq :: [String] -> Monitor String
-runCpuFreq _ = do
- suffix <- getConfigValue useSuffix
- ddigits <- getConfigValue decDigits
- let path = ["/sys/devices/system/cpu/cpu", "/cpufreq/scaling_cur_freq"]
- divisor = 1e6 :: Double
- fmt x | x < 1 = if suffix then mhzFmt x ++ "MHz"
- else ghzFmt x
- | otherwise = ghzFmt x ++ if suffix then "GHz" else ""
- mhzFmt x = show (round (x * 1000) :: Integer)
- ghzFmt = showDigits ddigits
- failureMessage <- getConfigValue naString
- checkedDataRetrieval failureMessage [path] Nothing (/divisor) fmt
diff --git a/src/Xmobar/Plugins/Monitors/Disk.hs b/src/Xmobar/Plugins/Monitors/Disk.hs
deleted file mode 100644
index aedad75..0000000
--- a/src/Xmobar/Plugins/Monitors/Disk.hs
+++ /dev/null
@@ -1,241 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Plugins.Monitors.Disk
--- Copyright : (c) 2010, 2011, 2012, 2014 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 Xmobar.Plugins.Monitors.Disk (diskUConfig, runDiskU, startDiskIO) where
-
-import Xmobar.Plugins.Monitors.Common
-import Xmobar.StatFS
-
-import Data.IORef (IORef, newIORef, readIORef, writeIORef)
-
-import Control.Exception (SomeException, handle)
-import Control.Monad (zipWithM)
-import qualified Data.ByteString.Lazy.Char8 as B
-import Data.List (isPrefixOf, find)
-import Data.Maybe (catMaybes)
-import System.Directory (canonicalizePath, doesFileExist)
-import System.Console.GetOpt
-
-data DiskIOOpts = DiskIOOpts
- { totalIconPattern :: Maybe IconPattern
- , writeIconPattern :: Maybe IconPattern
- , readIconPattern :: Maybe IconPattern
- }
-
-parseDiskIOOpts :: [String] -> IO DiskIOOpts
-parseDiskIOOpts argv =
- case getOpt Permute options argv of
- (o, _, []) -> return $ foldr id defaultOpts o
- (_, _, errs) -> ioError . userError $ concat errs
- where defaultOpts = DiskIOOpts
- { totalIconPattern = Nothing
- , writeIconPattern = Nothing
- , readIconPattern = Nothing
- }
- options =
- [ Option "" ["total-icon-pattern"] (ReqArg (\x o ->
- o { totalIconPattern = Just $ parseIconPattern x}) "") ""
- , Option "" ["write-icon-pattern"] (ReqArg (\x o ->
- o { writeIconPattern = Just $ parseIconPattern x}) "") ""
- , Option "" ["read-icon-pattern"] (ReqArg (\x o ->
- o { readIconPattern = Just $ parseIconPattern x}) "") ""
- ]
-
-diskIOConfig :: IO MConfig
-diskIOConfig = mkMConfig "" ["total", "read", "write"
- ,"totalbar", "readbar", "writebar"
- ,"totalvbar", "readvbar", "writevbar"
- ,"totalipat", "readipat", "writeipat"
- ]
-
-data DiskUOpts = DiskUOpts
- { freeIconPattern :: Maybe IconPattern
- , usedIconPattern :: Maybe IconPattern
- }
-
-parseDiskUOpts :: [String] -> IO DiskUOpts
-parseDiskUOpts argv =
- case getOpt Permute options argv of
- (o, _, []) -> return $ foldr id defaultOpts o
- (_, _, errs) -> ioError . userError $ concat errs
- where defaultOpts = DiskUOpts
- { freeIconPattern = Nothing
- , usedIconPattern = Nothing
- }
- options =
- [ Option "" ["free-icon-pattern"] (ReqArg (\x o ->
- o { freeIconPattern = Just $ parseIconPattern x}) "") ""
- , Option "" ["used-icon-pattern"] (ReqArg (\x o ->
- o { usedIconPattern = Just $ parseIconPattern x}) "") ""
- ]
-
-diskUConfig :: IO MConfig
-diskUConfig = mkMConfig ""
- [ "size", "free", "used", "freep", "usedp"
- , "freebar", "freevbar", "freeipat"
- , "usedbar", "usedvbar", "usedipat"
- ]
-
-type DevName = String
-type Path = String
-type DevDataRef = IORef [(DevName, [Float])]
-
-mountedDevices :: [String] -> IO [(DevName, Path)]
-mountedDevices req = do
- s <- B.readFile "/etc/mtab"
- parse `fmap` mapM mbcanon (devs s)
- where
- mbcanon (d, p) = doesFileExist d >>= \e ->
- if e
- then Just `fmap` canon (d,p)
- else return Nothing
- canon (d, p) = do {d' <- canonicalizePath d; return (d', p)}
- devs = filter isDev . map (firstTwo . B.words) . B.lines
- parse = map undev . filter isReq . catMaybes
- firstTwo (a:b:_) = (B.unpack a, B.unpack b)
- firstTwo _ = ("", "")
- isDev (d, _) = "/dev/" `isPrefixOf` d
- isReq (d, p) = p `elem` req || drop 5 d `elem` req
- undev (d, f) = (drop 5 d, f)
-
-diskDevices :: [String] -> IO [(DevName, Path)]
-diskDevices req = do
- s <- B.readFile "/proc/diskstats"
- parse `fmap` mapM canon (devs s)
- where
- canon (d, p) = do {d' <- canonicalizePath d; return (d', p)}
- devs = map (third . B.words) . B.lines
- parse = map undev . filter isReq
- third (_:_:c:_) = ("/dev/" ++ B.unpack c, B.unpack c)
- third _ = ("", "")
- isReq (d, p) = p `elem` req || drop 5 d `elem` req
- undev (d, f) = (drop 5 d, f)
-
-mountedOrDiskDevices :: [String] -> IO [(DevName, Path)]
-mountedOrDiskDevices req = do
- mnt <- mountedDevices req
- case mnt of
- [] -> diskDevices req
- other -> return other
-
-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 :: DevDataRef -> [DevName] -> IO [(DevName, [Float])]
-mountedData dref devs = do
- dt <- readIORef dref
- dt' <- diskData
- writeIORef dref dt'
- 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')
-
-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' :: DiskIOOpts -> (String, [Float]) -> Monitor String
-runDiskIO' opts (tmp, xs) = do
- s <- mapM (showWithColors speedToStr) xs
- b <- mapM (showLogBar 0.8) xs
- vb <- mapM (showLogVBar 0.8) xs
- ipat <- mapM (\(f,v) -> showLogIconPattern (f opts) 0.8 v)
- $ zip [totalIconPattern, readIconPattern, writeIconPattern] xs
- setConfigValue tmp template
- parseTemplate $ s ++ b ++ vb ++ ipat
-
-runDiskIO :: DevDataRef -> [(String, String)] -> [String] -> Monitor String
-runDiskIO dref disks argv = do
- opts <- io $ parseDiskIOOpts argv
- dev <- io $ mountedOrDiskDevices (map fst disks)
- dat <- io $ mountedData dref (map fst dev)
- strs <- mapM (runDiskIO' opts) $ devTemplates disks dev dat
- return $ unwords strs
-
-startDiskIO :: [(String, String)] ->
- [String] -> Int -> (String -> IO ()) -> IO ()
-startDiskIO disks args rate cb = do
- dev <- mountedOrDiskDevices (map fst disks)
- dref <- newIORef (map (\d -> (fst d, repeat 0)) dev)
- _ <- mountedData dref (map fst dev)
- runM args diskIOConfig (runDiskIO dref disks) rate cb
-
-fsStats :: String -> IO [Integer]
-fsStats path = do
- stats <- getFileSystemStats path
- case stats of
- Nothing -> return [0, 0, 0]
- Just f -> let tot = fsStatByteCount f
- free = fsStatBytesAvailable f
- used = fsStatBytesUsed f
- in return [tot, free, used]
-
-runDiskU' :: DiskUOpts -> String -> String -> Monitor String
-runDiskU' opts tmp path = do
- setConfigValue tmp template
- [total, free, diff] <- io (handle ign $ fsStats path)
- let strs = map sizeToStr [free, diff]
- freep = if total > 0 then free * 100 `div` total else 0
- fr = fromIntegral freep / 100
- s <- zipWithM showWithColors' strs [freep, 100 - freep]
- sp <- showPercentsWithColors [fr, 1 - fr]
- fb <- showPercentBar (fromIntegral freep) fr
- fvb <- showVerticalBar (fromIntegral freep) fr
- fipat <- showIconPattern (freeIconPattern opts) fr
- ub <- showPercentBar (fromIntegral $ 100 - freep) (1 - fr)
- uvb <- showVerticalBar (fromIntegral $ 100 - freep) (1 - fr)
- uipat <- showIconPattern (usedIconPattern opts) (1 - fr)
- parseTemplate $ [sizeToStr total] ++ s ++ sp ++ [fb,fvb,fipat,ub,uvb,uipat]
- where ign = const (return [0, 0, 0]) :: SomeException -> IO [Integer]
-
-
-runDiskU :: [(String, String)] -> [String] -> Monitor String
-runDiskU disks argv = do
- devs <- io $ mountedDevices (map fst disks)
- opts <- io $ parseDiskUOpts argv
- strs <- mapM (\(d, p) -> runDiskU' opts (findTempl d p disks) p) devs
- return $ unwords strs
diff --git a/src/Xmobar/Plugins/Monitors/MPD.hs b/src/Xmobar/Plugins/Monitors/MPD.hs
deleted file mode 100644
index 9525254..0000000
--- a/src/Xmobar/Plugins/Monitors/MPD.hs
+++ /dev/null
@@ -1,139 +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 Xmobar.Plugins.Monitors.MPD ( mpdConfig, runMPD, mpdWait, mpdReady ) where
-
-import Data.List
-import Data.Maybe (fromMaybe)
-import Xmobar.Plugins.Monitors.Common
-import System.Console.GetOpt
-import qualified Network.MPD as M
-import Control.Concurrent (threadDelay)
-
-mpdConfig :: IO MConfig
-mpdConfig = mkMConfig "MPD: <state>"
- [ "bar", "vbar", "ipat", "state", "statei", "volume", "length"
- , "lapsed", "remaining", "plength", "ppos", "flags", "file"
- , "name", "artist", "composer", "performer"
- , "album", "title", "track", "genre", "date"
- ]
-
-data MOpts = MOpts
- { mPlaying :: String
- , mStopped :: String
- , mPaused :: String
- , mLapsedIconPattern :: Maybe IconPattern
- }
-
-defaultOpts :: MOpts
-defaultOpts = MOpts
- { mPlaying = ">>"
- , mStopped = "><"
- , mPaused = "||"
- , mLapsedIconPattern = Nothing
- }
-
-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 "" ["lapsed-icon-pattern"] (ReqArg (\x o ->
- o { mLapsedIconPattern = Just $ parseIconPattern x }) "") ""
- ]
-
-runMPD :: [String] -> Monitor String
-runMPD args = do
- opts <- io $ mopts args
- status <- io $ M.withMPD M.status
- song <- io $ M.withMPD M.currentSong
- s <- parseMPD status song opts
- parseTemplate s
-
-mpdWait :: IO ()
-mpdWait = do
- status <- M.withMPD $ M.idle [M.PlayerS, M.MixerS, M.OptionsS]
- case status of
- Left _ -> threadDelay 10000000
- _ -> return ()
-
-mpdReady :: [String] -> Monitor Bool
-mpdReady _ = do
- response <- io $ M.withMPD M.ping
- case response of
- Right _ -> return True
- -- Only cases where MPD isn't responding is an issue; bogus information at
- -- least won't hold xmobar up.
- Left M.NoMPD -> return False
- Left (M.ConnectionError _) -> return False
- Left _ -> return True
-
-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:replicate 19 ""
-parseMPD (Right st) song opts = do
- songData <- parseSong song
- bar <- showPercentBar (100 * b) b
- vbar <- showVerticalBar (100 * b) b
- ipat <- showIconPattern (mLapsedIconPattern opts) b
- return $ [bar, vbar, ipat, ss, si, vol, len, lap, remain, plen, ppos, flags] ++ songData
- where s = M.stState st
- ss = show s
- si = stateGlyph s opts
- vol = int2str $ fromMaybe 0 (M.stVolume st)
- (p, t) = fromMaybe (0, 0) (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
- flags = playbackMode st
-
-stateGlyph :: M.State -> MOpts -> String
-stateGlyph s o =
- case s of
- M.Playing -> mPlaying o
- M.Paused -> mPaused o
- M.Stopped -> mStopped o
-
-playbackMode :: M.Status -> String
-playbackMode s =
- concat [if p s then f else "-" |
- (p,f) <- [(M.stRepeat,"r"),
- (M.stRandom,"z"),
- (M.stSingle,"s"),
- (M.stConsume,"c")]]
-
-parseSong :: M.Response (Maybe M.Song) -> Monitor [String]
-parseSong (Left _) = return $ repeat ""
-parseSong (Right Nothing) = return $ repeat ""
-parseSong (Right (Just s)) =
- let str sel = maybe "" (intercalate ", " . map M.toString) (M.sgGetTag sel s)
- sels = [ M.Name, M.Artist, M.Composer, M.Performer
- , M.Album, M.Title, M.Track, M.Genre, M.Date ]
- fields = M.toString (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 :: (Show a, Num a, Ord a) => a -> String
-int2str x = if x < 10 then '0':sx else sx where sx = show x
diff --git a/src/Xmobar/Plugins/Monitors/Mem.hs b/src/Xmobar/Plugins/Monitors/Mem.hs
deleted file mode 100644
index d69921b..0000000
--- a/src/Xmobar/Plugins/Monitors/Mem.hs
+++ /dev/null
@@ -1,96 +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 Xmobar.Plugins.Monitors.Mem (memConfig, runMem, totalMem, usedMem) where
-
-import Xmobar.Plugins.Monitors.Common
-import qualified Data.Map as M
-import System.Console.GetOpt
-
-data MemOpts = MemOpts
- { usedIconPattern :: Maybe IconPattern
- , freeIconPattern :: Maybe IconPattern
- , availableIconPattern :: Maybe IconPattern
- }
-
-defaultOpts :: MemOpts
-defaultOpts = MemOpts
- { usedIconPattern = Nothing
- , freeIconPattern = Nothing
- , availableIconPattern = Nothing
- }
-
-options :: [OptDescr (MemOpts -> MemOpts)]
-options =
- [ Option "" ["used-icon-pattern"] (ReqArg (\x o ->
- o { usedIconPattern = Just $ parseIconPattern x }) "") ""
- , Option "" ["free-icon-pattern"] (ReqArg (\x o ->
- o { freeIconPattern = Just $ parseIconPattern x }) "") ""
- , Option "" ["available-icon-pattern"] (ReqArg (\x o ->
- o { availableIconPattern = Just $ parseIconPattern x }) "") ""
- ]
-
-parseOpts :: [String] -> IO MemOpts
-parseOpts argv =
- case getOpt Permute options argv of
- (o, _, []) -> return $ foldr id defaultOpts o
- (_, _, errs) -> ioError . userError $ concat errs
-
-memConfig :: IO MConfig
-memConfig = mkMConfig
- "Mem: <usedratio>% (<cache>M)" -- template
- ["usedbar", "usedvbar", "usedipat", "freebar", "freevbar", "freeipat",
- "availablebar", "availablevbar", "availableipat",
- "usedratio", "freeratio", "availableratio",
- "total", "free", "buffer", "cache", "available", "used"] -- available replacements
-
-fileMEM :: IO String
-fileMEM = readFile "/proc/meminfo"
-
-parseMEM :: IO [Float]
-parseMEM =
- do file <- fileMEM
- let content = map words $ take 8 $ lines file
- info = M.fromList $ map (\line -> (head line, (read $ line !! 1 :: Float) / 1024)) content
- [total, free, buffer, cache] = map (info M.!) ["MemTotal:", "MemFree:", "Buffers:", "Cached:"]
- available = M.findWithDefault (free + buffer + cache) "MemAvailable:" info
- used = total - available
- usedratio = used / total
- freeratio = free / total
- availableratio = available / total
- return [usedratio, freeratio, availableratio, total, free, buffer, cache, available, used]
-
-totalMem :: IO Float
-totalMem = fmap ((*1024) . (!!1)) parseMEM
-
-usedMem :: IO Float
-usedMem = fmap ((*1024) . (!!6)) parseMEM
-
-formatMem :: MemOpts -> [Float] -> Monitor [String]
-formatMem opts (r:fr:ar:xs) =
- do let f = showDigits 0
- mon i x = [showPercentBar (100 * x) x, showVerticalBar (100 * x) x, showIconPattern i x]
- sequence $ mon (usedIconPattern opts) r
- ++ mon (freeIconPattern opts) fr
- ++ mon (availableIconPattern opts) ar
- ++ map showPercentWithColors [r, fr, ar]
- ++ map (showWithColors f) xs
-formatMem _ _ = replicate 10 `fmap` getConfigValue naString
-
-runMem :: [String] -> Monitor String
-runMem argv =
- do m <- io parseMEM
- opts <- io $ parseOpts argv
- l <- formatMem opts m
- parseTemplate l
diff --git a/src/Xmobar/Plugins/Monitors/Mpris.hs b/src/Xmobar/Plugins/Monitors/Mpris.hs
deleted file mode 100644
index 3556649..0000000
--- a/src/Xmobar/Plugins/Monitors/Mpris.hs
+++ /dev/null
@@ -1,148 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-----------------------------------------------------------------------------
--- |
--- Module : Plugins.Monitors.Mpris
--- Copyright : (c) Artem Tarasov
--- License : BSD-style (see LICENSE)
---
--- Maintainer : Artem Tarasov <lomereiter@gmail.com>
--- Stability : unstable
--- Portability : unportable
---
--- MPRIS song info
---
-----------------------------------------------------------------------------
-
-module Xmobar.Plugins.Monitors.Mpris ( mprisConfig, runMPRIS1, runMPRIS2 ) where
-
--- TODO: listen to signals
-
-import Xmobar.Plugins.Monitors.Common
-
-import Text.Printf (printf)
-
-import DBus
-import qualified DBus.Client as DC
-
-import Control.Arrow ((***))
-import Data.Maybe ( fromJust )
-import Data.Int ( Int32, Int64 )
-import System.IO.Unsafe (unsafePerformIO)
-
-import Control.Exception (try)
-
-class MprisVersion a where
- getMethodCall :: a -> String -> MethodCall
- getMetadataReply :: a -> DC.Client -> String -> IO [Variant]
- getMetadataReply mv c p = fmap methodReturnBody (DC.call_ c $ getMethodCall mv p)
- fieldsList :: a -> [String]
-
-data MprisVersion1 = MprisVersion1
-instance MprisVersion MprisVersion1 where
- getMethodCall MprisVersion1 p = (methodCall objectPath interfaceName memberName)
- { methodCallDestination = Just busName
- }
- where
- busName = busName_ $ "org.mpris." ++ p
- objectPath = objectPath_ "/Player"
- interfaceName = interfaceName_ "org.freedesktop.MediaPlayer"
- memberName = memberName_ "GetMetadata"
-
- fieldsList MprisVersion1 = [ "album", "artist", "arturl", "mtime", "title"
- , "tracknumber" ]
-
-data MprisVersion2 = MprisVersion2
-instance MprisVersion MprisVersion2 where
- getMethodCall MprisVersion2 p = (methodCall objectPath interfaceName memberName)
- { methodCallDestination = Just busName
- , methodCallBody = arguments
- }
- where
- busName = busName_ $ "org.mpris.MediaPlayer2." ++ p
- objectPath = objectPath_ "/org/mpris/MediaPlayer2"
- interfaceName = interfaceName_ "org.freedesktop.DBus.Properties"
- memberName = memberName_ "Get"
- arguments = map (toVariant::String -> Variant)
- ["org.mpris.MediaPlayer2.Player", "Metadata"]
-
- fieldsList MprisVersion2 = [ "xesam:album", "xesam:artist", "mpris:artUrl"
- , "mpris:length", "xesam:title",
- "xesam:trackNumber", "xesam:composer",
- "xesam:genre"
- ]
-
-mprisConfig :: IO MConfig
-mprisConfig = mkMConfig "<artist> - <title>"
- [ "album", "artist", "arturl", "length"
- , "title", "tracknumber" , "composer", "genre"
- ]
-
-{-# NOINLINE dbusClient #-}
-dbusClient :: DC.Client
-dbusClient = unsafePerformIO DC.connectSession
-
-runMPRIS :: (MprisVersion a) => a -> String -> [String] -> Monitor String
-runMPRIS version playerName _ = do
- metadata <- io $ getMetadata version dbusClient playerName
- if [] == metadata then
- getConfigValue naString
- else mapM showWithPadding (makeList version metadata) >>= parseTemplate
-
-runMPRIS1 :: String -> [String] -> Monitor String
-runMPRIS1 = runMPRIS MprisVersion1
-
-runMPRIS2 :: String -> [String] -> Monitor String
-runMPRIS2 = runMPRIS MprisVersion2
-
----------------------------------------------------------------------------
-
-fromVar :: (IsVariant a) => Variant -> a
-fromVar = fromJust . fromVariant
-
-unpackMetadata :: [Variant] -> [(String, Variant)]
-unpackMetadata [] = []
-unpackMetadata xs =
- (map (fromVar *** fromVar) . unpack . head) xs where
- unpack v = case variantType v of
- TypeDictionary _ _ -> dictionaryItems $ fromVar v
- TypeVariant -> unpack $ fromVar v
- TypeStructure _ ->
- let x = structureItems (fromVar v) in
- if null x then [] else unpack (head x)
- _ -> []
-
-getMetadata :: (MprisVersion a) => a -> DC.Client -> String -> IO [(String, Variant)]
-getMetadata version client player = do
- reply <- try (getMetadataReply version client player) ::
- IO (Either DC.ClientError [Variant])
- return $ case reply of
- Right metadata -> unpackMetadata metadata;
- Left _ -> []
-
-makeList :: (MprisVersion a) => a -> [(String, Variant)] -> [String]
-makeList version md = map getStr (fieldsList version) where
- formatTime n = (if hh == 0 then printf "%02d:%02d"
- else printf "%d:%02d:%02d" hh) mm ss
- where hh = (n `div` 60) `div` 60
- mm = (n `div` 60) `mod` 60
- ss = n `mod` 60
- getStr str = case lookup str md of
- Nothing -> ""
- Just v -> case variantType v of
- TypeString -> fromVar v
- TypeInt32 -> let num = fromVar v in
- case str of
- "mtime" -> formatTime (num `div` 1000)
- "tracknumber" -> printf "%02d" num
- "mpris:length" -> formatTime (num `div` 1000000)
- "xesam:trackNumber" -> printf "%02d" num
- _ -> (show::Int32 -> String) num
- TypeInt64 -> let num = fromVar v in
- case str of
- "mpris:length" -> formatTime (num `div` 1000000)
- _ -> (show::Int64 -> String) num
- TypeArray TypeString ->
- let x = arrayItems (fromVar v) in
- if null x then "" else fromVar (head x)
- _ -> ""
diff --git a/src/Xmobar/Plugins/Monitors/MultiCpu.hs b/src/Xmobar/Plugins/Monitors/MultiCpu.hs
deleted file mode 100644
index 3db3b5f..0000000
--- a/src/Xmobar/Plugins/Monitors/MultiCpu.hs
+++ /dev/null
@@ -1,128 +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 Xmobar.Plugins.Monitors.MultiCpu (startMultiCpu) where
-
-import Xmobar.Plugins.Monitors.Common
-import Control.Applicative ((<$>))
-import qualified Data.ByteString.Lazy.Char8 as B
-import Data.List (isPrefixOf, transpose, unfoldr)
-import Data.IORef (IORef, newIORef, readIORef, writeIORef)
-import System.Console.GetOpt
-
-data MultiCpuOpts = MultiCpuOpts
- { loadIconPatterns :: [IconPattern]
- , loadIconPattern :: Maybe IconPattern
- , fallbackIconPattern :: Maybe IconPattern
- }
-
-defaultOpts :: MultiCpuOpts
-defaultOpts = MultiCpuOpts
- { loadIconPatterns = []
- , loadIconPattern = Nothing
- , fallbackIconPattern = Nothing
- }
-
-options :: [OptDescr (MultiCpuOpts -> MultiCpuOpts)]
-options =
- [ Option "" ["load-icon-pattern"] (ReqArg (\x o ->
- o { loadIconPattern = Just $ parseIconPattern x }) "") ""
- , Option "" ["load-icon-patterns"] (ReqArg (\x o ->
- o { loadIconPatterns = parseIconPattern x : loadIconPatterns o }) "") ""
- , Option "" ["fallback-icon-pattern"] (ReqArg (\x o ->
- o { fallbackIconPattern = Just $ parseIconPattern x }) "") ""
- ]
-
-parseOpts :: [String] -> IO MultiCpuOpts
-parseOpts argv =
- case getOpt Permute options argv of
- (o, _, []) -> return $ foldr id defaultOpts o
- (_, _, errs) -> ioError . userError $ concat errs
-
-variables :: [String]
-variables = ["bar", "vbar","ipat","total","user","nice","system","idle"]
-vNum :: Int
-vNum = length variables
-
-multiCpuConfig :: IO MConfig
-multiCpuConfig =
- mkMConfig "Cpu: <total>%" $
- ["auto" ++ k | k <- variables] ++
- [ k ++ n | n <- "" : map show [0 :: Int ..]
- , k <- variables]
-
-type CpuDataRef = IORef [[Int]]
-
-cpuData :: IO [[Int]]
-cpuData = parse `fmap` B.readFile "/proc/stat"
- where parse = map parseList . cpuLists
- cpuLists = takeWhile isCpu . map B.words . B.lines
- isCpu (w:_) = "cpu" `isPrefixOf` B.unpack w
- isCpu _ = False
- parseList = map (parseInt . B.unpack) . tail
-
-parseCpuData :: CpuDataRef -> IO [[Float]]
-parseCpuData cref =
- do as <- readIORef cref
- bs <- cpuData
- writeIORef cref bs
- let p0 = zipWith percent bs as
- return p0
-
-percent :: [Int] -> [Int] -> [Float]
-percent b a = if tot > 0 then map (/ tot) $ take 4 dif else [0, 0, 0, 0]
- where dif = map fromIntegral $ zipWith (-) b a
- tot = sum dif
-
-formatMultiCpus :: MultiCpuOpts -> [[Float]] -> Monitor [String]
-formatMultiCpus _ [] = return []
-formatMultiCpus opts xs = concat <$> mapM (\(i, x) -> formatCpu opts i x) (zip [0..] xs)
-
-formatCpu :: MultiCpuOpts -> Int -> [Float] -> Monitor [String]
-formatCpu opts i xs
- | length xs < 4 = showPercentsWithColors $ replicate vNum 0.0
- | otherwise = let t = sum $ take 3 xs
- in do b <- showPercentBar (100 * t) t
- h <- showVerticalBar (100 * t) t
- d <- showIconPattern tryString t
- ps <- showPercentsWithColors (t:xs)
- return (b:h:d:ps)
- where tryString
- | i == 0 = loadIconPattern opts
- | i <= length (loadIconPatterns opts) = Just $ loadIconPatterns opts !! (i - 1)
- | otherwise = fallbackIconPattern opts
-
-splitEvery :: Int -> [a] -> [[a]]
-splitEvery n = unfoldr (\x -> if null x then Nothing else Just $ splitAt n x)
-
-groupData :: [String] -> [[String]]
-groupData = transpose . tail . splitEvery vNum
-
-formatAutoCpus :: [String] -> Monitor [String]
-formatAutoCpus [] = return $ replicate vNum ""
-formatAutoCpus xs = return $ map unwords (groupData xs)
-
-runMultiCpu :: CpuDataRef -> [String] -> Monitor String
-runMultiCpu cref argv =
- do c <- io $ parseCpuData cref
- opts <- io $ parseOpts argv
- l <- formatMultiCpus opts c
- a <- formatAutoCpus l
- parseTemplate $ a ++ l
-
-startMultiCpu :: [String] -> Int -> (String -> IO ()) -> IO ()
-startMultiCpu a r cb = do
- cref <- newIORef [[]]
- _ <- parseCpuData cref
- runM a multiCpuConfig (runMultiCpu cref) r cb
diff --git a/src/Xmobar/Plugins/Monitors/Net.hs b/src/Xmobar/Plugins/Monitors/Net.hs
deleted file mode 100644
index 81a5f6b..0000000
--- a/src/Xmobar/Plugins/Monitors/Net.hs
+++ /dev/null
@@ -1,218 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Plugins.Monitors.Net
--- Copyright : (c) 2011, 2012, 2013, 2014, 2017 Jose Antonio Ortega Ruiz
--- (c) 2007-2010 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 Xmobar.Plugins.Monitors.Net (
- startNet
- , startDynNet
- ) where
-
-import Xmobar.Plugins.Monitors.Common
-
-import Data.Word (Word64)
-import Data.IORef (IORef, newIORef, readIORef, writeIORef)
-import Data.Time.Clock (UTCTime, getCurrentTime, diffUTCTime)
-import Control.Monad (forM, filterM)
-import System.Directory (getDirectoryContents, doesFileExist)
-import System.FilePath ((</>))
-import System.Console.GetOpt
-import System.IO.Error (catchIOError)
-
-import qualified Data.ByteString.Lazy.Char8 as B
-
-data NetOpts = NetOpts
- { rxIconPattern :: Maybe IconPattern
- , txIconPattern :: Maybe IconPattern
- }
-
-defaultOpts :: NetOpts
-defaultOpts = NetOpts
- { rxIconPattern = Nothing
- , txIconPattern = Nothing
- }
-
-options :: [OptDescr (NetOpts -> NetOpts)]
-options =
- [ Option "" ["rx-icon-pattern"] (ReqArg (\x o ->
- o { rxIconPattern = Just $ parseIconPattern x }) "") ""
- , Option "" ["tx-icon-pattern"] (ReqArg (\x o ->
- o { txIconPattern = Just $ parseIconPattern x }) "") ""
- ]
-
-parseOpts :: [String] -> IO NetOpts
-parseOpts argv =
- case getOpt Permute options argv of
- (o, _, []) -> return $ foldr id defaultOpts o
- (_, _, errs) -> ioError . userError $ concat errs
-
-data UnitPerSec = Bs | KBs | MBs | GBs deriving (Eq,Enum,Ord)
-data NetValue = NetValue Float UnitPerSec deriving (Eq,Show)
-
-instance Show UnitPerSec where
- show Bs = "B/s"
- show KBs = "KB/s"
- show MBs = "MB/s"
- show GBs = "GB/s"
-
-data NetDev num
- = NA
- | NI String
- | ND String num num deriving (Eq,Show,Read)
-
-type NetDevRawTotal = NetDev Word64
-type NetDevRate = NetDev Float
-
-type NetDevRef = IORef (NetDevRawTotal, 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 num => Ord (NetDev num) 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
- "<dev>: <rx>KB|<tx>KB" -- template
- ["dev", "rx", "tx", "rxbar", "rxvbar", "rxipat", "txbar", "txvbar", "txipat"] -- 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 = flip catchIOError (const $ return False) $ do
- operstate <- B.readFile (operstateDir d)
- return $! (B.unpack . head . B.lines) operstate `elem` ["up", "unknown"]
-
-readNetDev :: [String] -> IO NetDevRawTotal
-readNetDev (d:x:y:_) = do
- up <- isUp d
- return (if up then ND d (r x) (r y) else NI d)
- where r s | s == "" = 0
- | otherwise = read s
-
-readNetDev _ = return NA
-
-netParser :: B.ByteString -> IO [NetDevRawTotal]
-netParser = mapM (readNetDev . splitDevLine) . readDevLines
- where readDevLines = drop 2 . B.lines
- splitDevLine = selectCols . wordsBy (`elem` " :") . B.unpack
- selectCols cols = map (cols!!) [0,1,9]
- wordsBy f s = case dropWhile f s of
- [] -> []
- s' -> w : wordsBy f s'' where (w, s'') = break f s'
-
-findNetDev :: String -> IO NetDevRawTotal
-findNetDev dev = do
- nds <- B.readFile "/proc/net/dev" >>= netParser
- case filter isDev nds of
- x:_ -> return x
- _ -> return NA
- where isDev (ND d _ _) = d == dev
- isDev (NI d) = d == dev
- isDev NA = False
-
-formatNet :: Maybe IconPattern -> Float -> Monitor (String, String, String, String)
-formatNet mipat d = do
- s <- getConfigValue useSuffix
- dd <- getConfigValue decDigits
- let str True v = showDigits dd d' ++ show u
- where (NetValue d' u) = byteNetVal v
- str False v = showDigits dd $ v / 1024
- b <- showLogBar 0.9 d
- vb <- showLogVBar 0.9 d
- ipat <- showLogIconPattern mipat 0.9 d
- x <- showWithColors (str s) d
- return (x, b, vb, ipat)
-
-printNet :: NetOpts -> NetDevRate -> Monitor String
-printNet opts nd =
- case nd of
- ND d r t -> do
- (rx, rb, rvb, ripat) <- formatNet (rxIconPattern opts) r
- (tx, tb, tvb, tipat) <- formatNet (txIconPattern opts) t
- parseTemplate [d,rx,tx,rb,rvb,ripat,tb,tvb,tipat]
- NI _ -> return ""
- NA -> getConfigValue naString
-
-parseNet :: NetDevRef -> String -> IO NetDevRate
-parseNet nref nd = do
- (n0, t0) <- readIORef nref
- n1 <- findNetDev nd
- t1 <- getCurrentTime
- writeIORef nref (n1, t1)
- let scx = realToFrac (diffUTCTime t1 t0)
- scx' = if scx > 0 then scx else 1
- rate da db = takeDigits 2 $ fromIntegral (db - da) / scx'
- diffRate (ND d ra ta) (ND _ rb tb) = ND d (rate ra rb) (rate ta tb)
- diffRate (NI d) _ = NI d
- diffRate _ (NI d) = NI d
- diffRate _ _ = NA
- return $ diffRate n0 n1
-
-runNet :: NetDevRef -> String -> [String] -> Monitor String
-runNet nref i argv = do
- dev <- io $ parseNet nref i
- opts <- io $ parseOpts argv
- printNet opts dev
-
-parseNets :: [(NetDevRef, String)] -> IO [NetDevRate]
-parseNets = mapM $ uncurry parseNet
-
-runNets :: [(NetDevRef, String)] -> [String] -> Monitor String
-runNets refs argv = do
- dev <- io $ parseActive refs
- opts <- io $ parseOpts argv
- printNet opts dev
- where parseActive refs' = fmap selectActive (parseNets refs')
- 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] -> Int -> (String -> IO ()) -> IO ()
-startDynNet a r cb = do
- devs <- existingDevs
- refs <- forM devs $ \d -> do
- t <- getCurrentTime
- nref <- newIORef (NA, t)
- _ <- parseNet nref d
- return (nref, d)
- runM a netConfig (runNets refs) r cb
-
-byteNetVal :: Float -> NetValue
-byteNetVal v
- | v < 1024**1 = NetValue v Bs
- | v < 1024**2 = NetValue (v/1024**1) KBs
- | v < 1024**3 = NetValue (v/1024**2) MBs
- | otherwise = NetValue (v/1024**3) GBs
diff --git a/src/Xmobar/Plugins/Monitors/Swap.hs b/src/Xmobar/Plugins/Monitors/Swap.hs
deleted file mode 100644
index fcaab84..0000000
--- a/src/Xmobar/Plugins/Monitors/Swap.hs
+++ /dev/null
@@ -1,56 +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 Xmobar.Plugins.Monitors.Swap where
-
-import Xmobar.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
- | null 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
- d <- getConfigValue decDigits
- other <- mapM (showWithColors (showDigits d)) 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/src/Xmobar/Plugins/Monitors/Thermal.hs b/src/Xmobar/Plugins/Monitors/Thermal.hs
deleted file mode 100644
index 320ae17..0000000
--- a/src/Xmobar/Plugins/Monitors/Thermal.hs
+++ /dev/null
@@ -1,39 +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 Xmobar.Plugins.Monitors.Thermal where
-
-import qualified Data.ByteString.Lazy.Char8 as B
-import Xmobar.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
- if exists
- then do number <- io $ fmap ((read :: String -> Int) . stringParser (1, 0)) (B.readFile file)
- thermal <- showWithColors show number
- parseTemplate [ thermal ]
- else return $ "Thermal (" ++ zone ++ "): N/A"
diff --git a/src/Xmobar/Plugins/Monitors/ThermalZone.hs b/src/Xmobar/Plugins/Monitors/ThermalZone.hs
deleted file mode 100644
index bc46b59..0000000
--- a/src/Xmobar/Plugins/Monitors/ThermalZone.hs
+++ /dev/null
@@ -1,49 +0,0 @@
-------------------------------------------------------------------------------
--- |
--- Module : Plugins.Monitors.ThermalZone
--- Copyright : (c) 2011, 2013 Jose Antonio Ortega Ruiz
--- License : BSD3-style (see LICENSE)
---
--- Maintainer : jao@gnu.org
--- Stability : unstable
--- Portability : portable
--- Created : Fri Feb 25, 2011 03:18
---
---
--- A thermal zone plugin based on the sysfs linux interface.
--- See http://kernel.org/doc/Documentation/thermal/sysfs-api.txt
---
-------------------------------------------------------------------------------
-
-module Xmobar.Plugins.Monitors.ThermalZone (thermalZoneConfig, runThermalZone) where
-
-import Xmobar.Plugins.Monitors.Common
-
-import System.Posix.Files (fileExist)
-import Control.Exception (IOException, catch)
-import qualified Data.ByteString.Char8 as B
-
--- | Default thermal configuration.
-thermalZoneConfig :: IO MConfig
-thermalZoneConfig = mkMConfig "<temp>C" ["temp"]
-
--- | Retrieves thermal information. Argument is name of thermal
--- directory in \/sys\/clas\/thermal. Returns the monitor string
--- parsed according to template (either default or user specified).
-runThermalZone :: [String] -> Monitor String
-runThermalZone args = do
- let zone = head args
- file = "/sys/class/thermal/thermal_zone" ++ zone ++ "/temp"
- handleIOError :: IOException -> IO (Maybe B.ByteString)
- handleIOError _ = return Nothing
- parse = return . (read :: String -> Int) . B.unpack
- exists <- io $ fileExist file
- if exists
- then do contents <- io $ catch (fmap Just $ B.readFile file) handleIOError
- case contents of
- Just d -> do
- mdegrees <- parse d
- temp <- showWithColors show (mdegrees `quot` 1000)
- parseTemplate [ temp ]
- Nothing -> getConfigValue naString
- else getConfigValue naString
diff --git a/src/Xmobar/Plugins/Monitors/Top.hs b/src/Xmobar/Plugins/Monitors/Top.hs
deleted file mode 100644
index d6df249..0000000
--- a/src/Xmobar/Plugins/Monitors/Top.hs
+++ /dev/null
@@ -1,195 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Plugins.Monitors.Top
--- Copyright : (c) 2010, 2011, 2012, 2013, 2014, 2018 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 #-}
-{-# LANGUAGE BangPatterns #-}
-
-module Xmobar.Plugins.Monitors.Top (startTop, topMemConfig, runTopMem) where
-
-import Xmobar.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
-
-statWords :: [String] -> [String]
-statWords line@(x:pn:ppn:xs) =
- if last pn == ')' then line else statWords (x:(pn ++ " " ++ ppn):xs)
-statWords _ = replicate 52 "0"
-
-getProcessData :: FilePath -> IO [String]
-getProcessData pidf =
- handle ign $ withFile ("/proc" </> pidf </> "stat") ReadMode readWords
- where readWords = fmap (statWords . words) . hGetLine
- ign = const (return []) :: SomeException -> IO [String]
-
-memPages :: [String] -> String
-memPages fs = fs!!23
-
-ppid :: [String] -> String
-ppid fs = fs!!3
-
-skip :: [String] -> Bool
-skip fs = length fs < 24 || memPages fs == "0" || ppid fs == "0"
-
-handleProcesses :: ([String] -> a) -> IO [a]
-handleProcesses f =
- fmap (foldl' (\a p -> if skip p 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 3 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) =
- getConfigValue decDigits >>= \d -> showInfo n (showDigits d 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/src/Xmobar/Plugins/Monitors/UVMeter.hs b/src/Xmobar/Plugins/Monitors/UVMeter.hs
deleted file mode 100644
index 079177f..0000000
--- a/src/Xmobar/Plugins/Monitors/UVMeter.hs
+++ /dev/null
@@ -1,157 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
------------------------------------------------------------------------------
--- |
--- Module : Plugins.Monitors.UVMeter
--- Copyright : (c) Róman Joost
--- License : BSD-style (see LICENSE)
---
--- Maintainer : Róman Joost
--- Stability : unstable
--- Portability : unportable
---
--- An australian uv monitor for Xmobar
---
------------------------------------------------------------------------------
-
-module Xmobar.Plugins.Monitors.UVMeter where
-
-import Xmobar.Plugins.Monitors.Common
-
-import qualified Control.Exception as CE
-import Network.HTTP.Conduit
- (parseRequest, newManager, tlsManagerSettings, httpLbs,
- responseBody)
-import Data.ByteString.Lazy.Char8 as B
-import Text.Read (readMaybe)
-import Text.Parsec
-import Text.Parsec.String
-import Control.Monad (void)
-
-
-uvConfig :: IO MConfig
-uvConfig = mkMConfig
- "<station>" -- template
- ["station" -- available replacements
- ]
-
-newtype UvInfo = UV { index :: String }
- deriving (Show)
-
-uvURL :: String
-uvURL = "https://uvdata.arpansa.gov.au/xml/uvvalues.xml"
-
-getData :: IO String
-getData =
- CE.catch (do request <- parseRequest uvURL
- manager <- newManager tlsManagerSettings
- res <- httpLbs request manager
- return $ B.unpack $ responseBody res)
- errHandler
- where errHandler
- :: CE.SomeException -> IO String
- errHandler _ = return "<Could not retrieve data>"
-
-textToXMLDocument :: String -> Either ParseError [XML]
-textToXMLDocument = parse document ""
-
-formatUVRating :: Maybe Float -> Monitor String
-formatUVRating Nothing = getConfigValue naString
-formatUVRating (Just x) = do
- uv <- showWithColors show x
- parseTemplate [uv]
-
-getUVRating :: String -> [XML] -> Maybe Float
-getUVRating locID (Element "stations" _ y:_) = getUVRating locID y
-getUVRating locID (Element "location" [Attribute attr] ys:xs)
- | locID == snd attr = getUVRating locID ys
- | otherwise = getUVRating locID xs
-getUVRating _ (Element "index" [] [Body rate]:_) = readMaybe rate
-getUVRating locID (_:xs) = getUVRating locID xs
-getUVRating _ [] = Nothing
-
-
-runUVMeter :: [String] -> Monitor String
-runUVMeter [] = return "N.A."
-runUVMeter (s:_) = do
- resp <- io getData
- case textToXMLDocument resp of
- Right doc -> formatUVRating (getUVRating s doc)
- Left _ -> getConfigValue naString
-
--- | XML Parsing code comes here.
--- This is a very simple XML parser to just deal with the uvvalues.xml
--- provided by ARPANSA. If you work on a new plugin which needs an XML
--- parser perhaps consider using a real XML parser and refactor this
--- plug-in to us it as well.
---
--- Note: This parser can not deal with short tags.
---
--- Kudos to: Charlie Harvey for his article about writing an XML Parser
--- with Parsec.
---
-
-type AttrName = String
-type AttrValue = String
-
-newtype Attribute = Attribute (AttrName, AttrValue)
- deriving (Show)
-
-data XML = Element String [Attribute] [XML]
- | Decl String
- | Body String
- deriving (Show)
-
--- | parse the document
---
-document :: Parser [XML]
-document = do
- spaces
- y <- try xmlDecl <|> tag
- spaces
- x <- many tag
- spaces
- return (y : x)
-
--- | parse any tags
---
-tag :: Parser XML
-tag = do
- char '<'
- spaces
- name <- many (letter <|> digit)
- spaces
- attr <- many attribute
- spaces
- string ">"
- eBody <- many elementBody
- endTag name
- spaces
- return (Element name attr eBody)
-
-xmlDecl :: Parser XML
-xmlDecl = do
- void $ manyTill anyToken (string "<?xml") -- ignore the byte order mark
- decl <- many (noneOf "?>")
- string "?>"
- return (Decl decl)
-
-elementBody :: Parser XML
-elementBody = spaces *> try tag <|> text
-
-endTag :: String -> Parser String
-endTag str = string "</" *> string str <* char '>'
-
-text :: Parser XML
-text = Body <$> many1 (noneOf "><")
-
-attribute :: Parser Attribute
-attribute = do
- name <- many (noneOf "= />")
- spaces
- char '='
- spaces
- char '"'
- value <- many (noneOf "\"")
- char '"'
- spaces
- return (Attribute (name, value))
diff --git a/src/Xmobar/Plugins/Monitors/Uptime.hs b/src/Xmobar/Plugins/Monitors/Uptime.hs
deleted file mode 100644
index 235fc85..0000000
--- a/src/Xmobar/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 Xmobar.Plugins.Monitors.Uptime (uptimeConfig, runUptime) where
-
-import Xmobar.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/src/Xmobar/Plugins/Monitors/Volume.hs b/src/Xmobar/Plugins/Monitors/Volume.hs
deleted file mode 100644
index 1d3281c..0000000
--- a/src/Xmobar/Plugins/Monitors/Volume.hs
+++ /dev/null
@@ -1,196 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Plugins.Monitors.Volume
--- Copyright : (c) 2011, 2013, 2015, 2018 Thomas Tuegel
--- License : BSD-style (see LICENSE)
---
--- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org>
--- Stability : unstable
--- Portability : unportable
---
--- A monitor for ALSA soundcards
---
------------------------------------------------------------------------------
-
-module Xmobar.Plugins.Monitors.Volume
- ( runVolume
- , runVolumeWith
- , volumeConfig
- , options
- , defaultOpts
- , VolumeOpts
- ) where
-
-import Control.Applicative ((<$>))
-import Control.Monad ( liftM2, liftM3, mplus )
-import Data.Traversable (sequenceA)
-import Xmobar.Plugins.Monitors.Common
-import Sound.ALSA.Mixer
-import qualified Sound.ALSA.Exception as AE
-import System.Console.GetOpt
-
-volumeConfig :: IO MConfig
-volumeConfig = mkMConfig "Vol: <volume>% <status>"
- ["volume", "volumebar", "volumevbar", "dB","status", "volumeipat"]
-
-
-data VolumeOpts = VolumeOpts
- { onString :: String
- , offString :: String
- , onColor :: Maybe String
- , offColor :: Maybe String
- , highDbThresh :: Float
- , lowDbThresh :: Float
- , volumeIconPattern :: Maybe IconPattern
- }
-
-defaultOpts :: VolumeOpts
-defaultOpts = VolumeOpts
- { onString = "[on] "
- , offString = "[off]"
- , onColor = Just "green"
- , offColor = Just "red"
- , highDbThresh = -5.0
- , lowDbThresh = -30.0
- , volumeIconPattern = Nothing
- }
-
-options :: [OptDescr (VolumeOpts -> VolumeOpts)]
-options =
- [ Option "O" ["on"] (ReqArg (\x o -> o { onString = x }) "") ""
- , Option "o" ["off"] (ReqArg (\x o -> o { offString = x }) "") ""
- , Option "" ["lowd"] (ReqArg (\x o -> o { lowDbThresh = read x }) "") ""
- , Option "" ["highd"] (ReqArg (\x o -> o { highDbThresh = read x }) "") ""
- , Option "C" ["onc"] (ReqArg (\x o -> o { onColor = Just x }) "") ""
- , Option "c" ["offc"] (ReqArg (\x o -> o { offColor = Just x }) "") ""
- , Option "" ["volume-icon-pattern"] (ReqArg (\x o ->
- o { volumeIconPattern = Just $ parseIconPattern x }) "") ""
- ]
-
-parseOpts :: [String] -> IO VolumeOpts
-parseOpts argv =
- case getOpt Permute options argv of
- (o, _, []) -> return $ foldr id defaultOpts o
- (_, _, errs) -> ioError . userError $ concat errs
-
-percent :: Integer -> Integer -> Integer -> Float
-percent v' lo' hi' = (v - lo) / (hi - lo)
- where v = fromIntegral v'
- lo = fromIntegral lo'
- hi = fromIntegral hi'
-
-formatVol :: Integer -> Integer -> Integer -> Monitor String
-formatVol lo hi v =
- showPercentWithColors $ percent v lo hi
-
-formatVolBar :: Integer -> Integer -> Integer -> Monitor String
-formatVolBar lo hi v =
- showPercentBar (100 * x) x where x = percent v lo hi
-
-formatVolVBar :: Integer -> Integer -> Integer -> Monitor String
-formatVolVBar lo hi v =
- showVerticalBar (100 * x) x where x = percent v lo hi
-
-formatVolDStr :: Maybe IconPattern -> Integer -> Integer -> Integer -> Monitor String
-formatVolDStr ipat lo hi v =
- showIconPattern ipat $ percent v lo hi
-
-switchHelper :: VolumeOpts
- -> (VolumeOpts -> Maybe String)
- -> (VolumeOpts -> String)
- -> Monitor String
-switchHelper opts cHelp strHelp = return $
- colorHelper (cHelp opts)
- ++ strHelp opts
- ++ maybe "" (const "</fc>") (cHelp opts)
-
-formatSwitch :: VolumeOpts -> Bool -> Monitor String
-formatSwitch opts True = switchHelper opts onColor onString
-formatSwitch opts False = switchHelper opts offColor offString
-
-colorHelper :: Maybe String -> String
-colorHelper = maybe "" (\c -> "<fc=" ++ c ++ ">")
-
-formatDb :: VolumeOpts -> Integer -> Monitor String
-formatDb opts dbi = do
- h <- getConfigValue highColor
- m <- getConfigValue normalColor
- l <- getConfigValue lowColor
- d <- getConfigValue decDigits
- let db = fromIntegral dbi / 100.0
- digits = showDigits d db
- startColor | db >= highDbThresh opts = colorHelper h
- | db < lowDbThresh opts = colorHelper l
- | otherwise = colorHelper m
- stopColor | null startColor = ""
- | otherwise = "</fc>"
- return $ startColor ++ digits ++ stopColor
-
-runVolume :: String -> String -> [String] -> Monitor String
-runVolume mixerName controlName argv = do
- opts <- io $ parseOpts argv
- runVolumeWith opts mixerName controlName
-
-runVolumeWith :: VolumeOpts -> String -> String -> Monitor String
-runVolumeWith opts mixerName controlName = do
- (lo, hi, val, db, sw) <- io readMixer
- p <- liftMonitor $ liftM3 formatVol lo hi val
- b <- liftMonitor $ liftM3 formatVolBar lo hi val
- v <- liftMonitor $ liftM3 formatVolVBar lo hi val
- d <- getFormatDB opts db
- s <- getFormatSwitch opts sw
- ipat <- liftMonitor $ liftM3 (formatVolDStr $ volumeIconPattern opts) lo hi val
- parseTemplate [p, b, v, d, s, ipat]
-
- where
-
- readMixer =
- AE.catch (withMixer mixerName $ \mixer -> do
- control <- getControlByName mixer controlName
- (lo, hi) <- liftMaybe $ getRange <$> volumeControl control
- val <- getVal $ volumeControl control
- db <- getDB $ volumeControl control
- sw <- getSw $ switchControl control
- return (lo, hi, val, db, sw))
- (const $ return (Nothing, Nothing, Nothing, Nothing, Nothing))
-
- volumeControl :: Maybe Control -> Maybe Volume
- volumeControl c = (playback . volume =<< c)
- `mplus` (capture . volume =<< c)
- `mplus` (common . volume =<< c)
-
- switchControl :: Maybe Control -> Maybe Switch
- switchControl c = (playback . switch =<< c)
- `mplus` (capture . switch =<< c)
- `mplus` (common . switch =<< c)
-
- liftMaybe :: Maybe (IO (a,b)) -> IO (Maybe a, Maybe b)
- liftMaybe = fmap (liftM2 (,) (fmap fst) (fmap snd)) . sequenceA
-
- liftMonitor :: Maybe (Monitor String) -> Monitor String
- liftMonitor Nothing = unavailable
- liftMonitor (Just m) = m
-
- channel v r = AE.catch (getChannel FrontLeft v) (const $ return $ Just r)
-
- getDB :: Maybe Volume -> IO (Maybe Integer)
- getDB Nothing = return Nothing
- getDB (Just v) = channel (dB v) 0
-
- getVal :: Maybe Volume -> IO (Maybe Integer)
- getVal Nothing = return Nothing
- getVal (Just v) = channel (value v) 0
-
- getSw :: Maybe Switch -> IO (Maybe Bool)
- getSw Nothing = return Nothing
- getSw (Just s) = channel s False
-
- getFormatDB :: VolumeOpts -> Maybe Integer -> Monitor String
- getFormatDB _ Nothing = unavailable
- getFormatDB opts' (Just d) = formatDb opts' d
-
- getFormatSwitch :: VolumeOpts -> Maybe Bool -> Monitor String
- getFormatSwitch _ Nothing = unavailable
- getFormatSwitch opts' (Just sw) = formatSwitch opts' sw
-
- unavailable = getConfigValue naString
diff --git a/src/Xmobar/Plugins/Monitors/Weather.hs b/src/Xmobar/Plugins/Monitors/Weather.hs
deleted file mode 100644
index cb5bf07..0000000
--- a/src/Xmobar/Plugins/Monitors/Weather.hs
+++ /dev/null
@@ -1,255 +0,0 @@
-{-# LANGUAGE CPP #-}
------------------------------------------------------------------------------
--- |
--- 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 Xmobar.Plugins.Monitors.Weather where
-
-import Xmobar.Plugins.Monitors.Common
-
-import qualified Control.Exception as CE
-
-#ifdef HTTP_CONDUIT
-import Network.HTTP.Conduit
-import Network.HTTP.Types.Status
-import Network.HTTP.Types.Method
-import qualified Data.ByteString.Lazy.Char8 as B
-#else
-import Network.HTTP
-#endif
-
-import Text.ParserCombinators.Parsec
-
-weatherConfig :: IO MConfig
-weatherConfig = mkMConfig
- "<station>: <tempC>C, rh <rh>% (<hour>)" -- template
- ["station" -- available replacements
- , "stationState"
- , "year"
- , "month"
- , "day"
- , "hour"
- , "windCardinal"
- , "windAzimuth"
- , "windMph"
- , "windKnots"
- , "windKmh"
- , "windMs"
- , "visibility"
- , "skyCondition"
- , "tempC"
- , "tempF"
- , "dewPointC"
- , "dewPointF"
- , "rh"
- , "pressure"
- ]
-
-data WindInfo =
- WindInfo {
- windCardinal :: String -- cardinal direction
- , windAzimuth :: String -- azimuth direction
- , windMph :: String -- speed (MPH)
- , windKnots :: String -- speed (knot)
- , windKmh :: String -- speed (km/h)
- , windMs :: String -- speed (m/s)
- } deriving (Show)
-
-data WeatherInfo =
- WI { stationPlace :: String
- , stationState :: String
- , year :: String
- , month :: String
- , day :: String
- , hour :: String
- , windInfo :: WindInfo
- , visibility :: String
- , skyCondition :: String
- , tempC :: Int
- , tempF :: Int
- , dewPointC :: Int
- , dewPointF :: Int
- , 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)
-
-noWind :: WindInfo
-noWind = WindInfo "μ" "μ" "0" "0" "0" "0"
-
-pWind :: Parser WindInfo
-pWind =
- let tospace = manyTill anyChar (char ' ')
- toKmh knots = knots $* 1.852
- toMs knots = knots $* 0.514
- ($*) :: String -> Double -> String
- op1 $* op2 = show (round ((read op1::Double) * op2)::Integer)
-
- -- Occasionally there is no wind and a METAR report gives simply, "Wind: Calm:0"
- wind0 = do manyTill skipRestOfLine (string "Wind: Calm:0")
- return noWind
- windVar = do manyTill skipRestOfLine (string "Wind: Variable at ")
- mph <- tospace
- string "MPH ("
- knot <- tospace
- manyTill anyChar newline
- return $ WindInfo "μ" "μ" mph knot (toKmh knot) (toMs knot)
- wind = do manyTill skipRestOfLine (string "Wind: from the ")
- cardinal <- tospace
- char '('
- azimuth <- tospace
- string "degrees) at "
- mph <- tospace
- string "MPH ("
- knot <- tospace
- manyTill anyChar newline
- return $ WindInfo cardinal azimuth mph knot (toKmh knot) (toMs knot)
- in try wind0 <|> try windVar <|> try wind <|> return noWind
-
-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
-
-{-
- example of 'http://weather.noaa.gov/pub/data/observations/metar/decoded/VTUD.TXT':
- Station name not available
- Aug 11, 2013 - 10:00 AM EDT / 2013.08.11 1400 UTC
- Wind: from the N (350 degrees) at 1 MPH (1 KT):0
- Visibility: 4 mile(s):0
- Sky conditions: mostly clear
- Temperature: 77 F (25 C)
- Dew Point: 73 F (23 C)
- Relative Humidity: 88%
- Pressure (altimeter): 29.77 in. Hg (1008 hPa)
- ob: VTUD 111400Z 35001KT 8000 FEW030 25/23 Q1008 A2977 INFO R RWY30
- cycle: 14
--}
-parseData :: Parser [WeatherInfo]
-parseData =
- do (st, ss) <- try (string "Station name not available" >> return ("??", "??")) <|>
- (do st <- getAllBut ","
- space
- ss <- getAllBut "("
- return (st, ss)
- )
- skipRestOfLine >> getAllBut "/"
- (y,m,d,h) <- pTime
- w <- pWind
- v <- getAfterString "Visibility: "
- sk <- getAfterString "Sky conditions: "
- skipTillString "Temperature: "
- (tC,tF) <- pTemp
- skipTillString "Dew Point: "
- (dC, dF) <- pTemp
- 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 dC dF rh p]
-
-defUrl :: String
--- "http://weather.noaa.gov/pub/data/observations/metar/decoded/"
-defUrl = "http://tgftp.nws.noaa.gov/data/observations/metar/decoded/"
-
-stationUrl :: String -> String
-stationUrl station = defUrl ++ station ++ ".TXT"
-
-getData :: String -> IO String
-#ifdef HTTP_CONDUIT
-getData station = CE.catch (do
- manager <- newManager tlsManagerSettings
- request <- parseUrl $ stationUrl station
- res <- httpLbs request manager
- return $ B.unpack $ responseBody res
- ) errHandler
- where errHandler :: CE.SomeException -> IO String
- errHandler _ = return "<Could not retrieve data>"
-#else
-getData station = do
- let request = getRequest (stationUrl station)
- CE.catch (simpleHTTP request >>= getResponseBody) errHandler
- where errHandler :: CE.IOException -> IO String
- errHandler _ = return "<Could not retrieve data>"
-#endif
-
-formatWeather :: [WeatherInfo] -> Monitor String
-formatWeather [WI st ss y m d h (WindInfo wc wa wm wk wkh wms) v sk tC tF dC dF r p] =
- do cel <- showWithColors show tC
- far <- showWithColors show tF
- parseTemplate [st, ss, y, m, d, h, wc, wa, wm, wk, wkh, wms, v, sk, cel, far, show dC, show dF, show r , show p ]
-formatWeather _ = getConfigValue naString
-
-runWeather :: [String] -> Monitor String
-runWeather str =
- do d <- io $ getData $ head str
- i <- io $ runP parseData d
- formatWeather i
-
-weatherReady :: [String] -> Monitor Bool
-#ifdef HTTP_CONDUIT
-weatherReady str = do
- initRequest <- parseUrl $ stationUrl $ head str
- let request = initRequest{method = methodHead}
- io $ CE.catch ( do
- manager <- newManager tlsManagerSettings
- res <- httpLbs request manager
- return $ checkResult $responseStatus res ) errHandler
- where errHandler :: CE.SomeException -> IO Bool
- errHandler _ = return False
- checkResult status
- | statusIsServerError status = False
- | statusIsClientError status = False
- | otherwise = True
-#else
-weatherReady str = do
- let station = head str
- request = headRequest (stationUrl station)
- io $ CE.catch (simpleHTTP request >>= checkResult) errHandler
- where errHandler :: CE.IOException -> IO Bool
- errHandler _ = return False
- checkResult result =
- case result of
- Left _ -> return False
- Right response ->
- case rspCode response of
- -- Permission or network errors are failures; anything
- -- else is recoverable.
- (4, _, _) -> return False
- (5, _, _) -> return False
- (_, _, _) -> return True
-#endif
diff --git a/src/Xmobar/Plugins/Monitors/Wireless.hs b/src/Xmobar/Plugins/Monitors/Wireless.hs
deleted file mode 100644
index 545f6bc..0000000
--- a/src/Xmobar/Plugins/Monitors/Wireless.hs
+++ /dev/null
@@ -1,70 +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 Xmobar.Plugins.Monitors.Wireless (wirelessConfig, runWireless) where
-
-import System.Console.GetOpt
-
-import Xmobar.Plugins.Monitors.Common
-import Network.IWlib
-
-newtype WirelessOpts = WirelessOpts
- { qualityIconPattern :: Maybe IconPattern
- }
-
-defaultOpts :: WirelessOpts
-defaultOpts = WirelessOpts
- { qualityIconPattern = Nothing
- }
-
-options :: [OptDescr (WirelessOpts -> WirelessOpts)]
-options =
- [ Option "" ["quality-icon-pattern"] (ReqArg (\d opts ->
- opts { qualityIconPattern = Just $ parseIconPattern d }) "") ""
- ]
-
-parseOpts :: [String] -> IO WirelessOpts
-parseOpts argv =
- case getOpt Permute options argv of
- (o, _, []) -> return $ foldr id defaultOpts o
- (_, _, errs) -> ioError . userError $ concat errs
-
-wirelessConfig :: IO MConfig
-wirelessConfig =
- mkMConfig "<essid> <quality>"
- ["essid", "quality", "qualitybar", "qualityvbar", "qualityipat"]
-
-runWireless :: String -> [String] -> Monitor String
-runWireless iface args = do
- opts <- io $ parseOpts args
- iface' <- if "" == iface then io findInterface else return iface
- wi <- io $ getWirelessInfo iface'
- na <- getConfigValue naString
- let essid = wiEssid wi
- qlty = fromIntegral $ wiQuality wi
- e = if essid == "" then na else essid
- ep <- showWithPadding e
- q <- if qlty >= 0
- then showPercentWithColors (qlty / 100)
- else showWithPadding ""
- qb <- showPercentBar qlty (qlty / 100)
- qvb <- showVerticalBar qlty (qlty / 100)
- qipat <- showIconPattern (qualityIconPattern opts) (qlty / 100)
- parseTemplate [ep, q, qb, qvb, qipat]
-
-findInterface :: IO String
-findInterface = do
- c <- readFile "/proc/net/wireless"
- let nds = lines c
- return $ if length nds > 2 then takeWhile (/= 'c') (nds!!2) else []
diff --git a/src/Xmobar/Plugins/PipeReader.hs b/src/Xmobar/Plugins/PipeReader.hs
deleted file mode 100644
index 7166163..0000000
--- a/src/Xmobar/Plugins/PipeReader.hs
+++ /dev/null
@@ -1,47 +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 Xmobar.Plugins.PipeReader where
-
-import System.IO
-import Xmobar.Plugins
-import Xmobar.Environment
-import System.Posix.Files
-import Control.Concurrent(threadDelay)
-import Control.Exception
-import Control.Monad(forever, unless)
-import Control.Applicative ((<$>))
-
-data PipeReader = PipeReader String String
- deriving (Read, Show)
-
-instance Exec PipeReader where
- alias (PipeReader _ a) = a
- start (PipeReader p _) cb = do
- (def, pipe) <- split ':' <$> expandEnv p
- unless (null def) (cb def)
- checkPipe pipe
- h <- openFile pipe ReadWriteMode
- forever (hGetLineSafe h >>= cb)
- where
- split c xs | c `elem` xs = let (pre, post) = span (c /=) xs
- in (pre, dropWhile (c ==) post)
- | otherwise = ([], xs)
-
-checkPipe :: FilePath -> IO ()
-checkPipe file =
- handle (\(SomeException _) -> waitForPipe) $ do
- status <- getFileStatus file
- unless (isNamedPipe status) waitForPipe
- where waitForPipe = threadDelay 1000000 >> checkPipe file
diff --git a/src/Xmobar/Plugins/StdinReader.hs b/src/Xmobar/Plugins/StdinReader.hs
deleted file mode 100644
index 372e4f9..0000000
--- a/src/Xmobar/Plugins/StdinReader.hs
+++ /dev/null
@@ -1,44 +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`.
---
--- Exports:
--- - `StdinReader` to safely display stdin content (striping actions).
--- - `UnsafeStdinReader` to display stdin content as-is.
---
------------------------------------------------------------------------------
-
-module Xmobar.Plugins.StdinReader (StdinReader(..)) where
-
-import Prelude
-import System.Posix.Process
-import System.Exit
-import System.IO
-import Control.Exception (SomeException(..), handle)
-import Xmobar.Plugins
-import Xmobar.Actions (stripActions)
-
-data StdinReader = StdinReader | UnsafeStdinReader
- deriving (Read, Show)
-
-instance Exec StdinReader where
- start stdinReader cb = do
- s <- handle (\(SomeException e) -> do hPrint stderr e; return "")
- (hGetLineSafe stdin)
- cb $ escape stdinReader s
- eof <- isEOF
- if eof
- then exitImmediately ExitSuccess
- else start stdinReader cb
-
-escape :: StdinReader -> String -> String
-escape StdinReader = stripActions
-escape UnsafeStdinReader = id
diff --git a/src/Xmobar/Plugins/Utils.hs b/src/Xmobar/Plugins/Utils.hs
deleted file mode 100644
index 6546c15..0000000
--- a/src/Xmobar/Plugins/Utils.hs
+++ /dev/null
@@ -1,43 +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 Xmobar.Plugins.Utils (expandHome, changeLoop, safeHead) 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)
-
-safeHead :: [a] -> Maybe a
-safeHead [] = Nothing
-safeHead (x:_) = Just x
diff --git a/src/Xmobar/Plugins/XMonadLog.hs b/src/Xmobar/Plugins/XMonadLog.hs
deleted file mode 100644
index 6bbba59..0000000
--- a/src/Xmobar/Plugins/XMonadLog.hs
+++ /dev/null
@@ -1,91 +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 Xmobar.Plugins.XMonadLog (XMonadLog(..)) where
-
-import Control.Monad
-import Graphics.X11
-import Graphics.X11.Xlib.Extras
-import Xmobar.Plugins
-#ifdef UTF8
-#undef UTF8
-import Codec.Binary.UTF8.String as UTF8
-#define UTF8
-#endif
-import Foreign.C (CChar)
-import Xmobar.XUtil (nextEvent')
-import Xmobar.Actions (stripActions)
-
-data XMonadLog = XMonadLog
- | UnsafeXMonadLog
- | XPropertyLog String
- | UnsafeXPropertyLog String
- | NamedXPropertyLog String String
- | UnsafeNamedXPropertyLog String String
- deriving (Read, Show)
-
-instance Exec XMonadLog where
- alias XMonadLog = "XMonadLog"
- alias UnsafeXMonadLog = "UnsafeXMonadLog"
- alias (XPropertyLog atom) = atom
- alias (NamedXPropertyLog _ name) = name
- alias (UnsafeXPropertyLog atom) = atom
- alias (UnsafeNamedXPropertyLog _ name) = name
-
- start x cb = do
- let atom = case x of
- XMonadLog -> "_XMONAD_LOG"
- UnsafeXMonadLog -> "_XMONAD_LOG"
- XPropertyLog a -> a
- UnsafeXPropertyLog a -> a
- NamedXPropertyLog a _ -> a
- UnsafeNamedXPropertyLog a _ -> a
- sanitize = case x of
- UnsafeXMonadLog -> id
- UnsafeXPropertyLog _ -> id
- UnsafeNamedXPropertyLog _ _ -> id
- _ -> stripActions
-
- 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 . sanitize . 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