xmobar 0.40 → 0.41
raw patch · 17 files changed
+674/−143 lines, 17 files
Files
- changelog.md +7/−0
- doc/plugins.org +8/−5
- readme.org +2/−2
- src/Xmobar.hs +3/−0
- src/Xmobar/App/Config.hs +1/−0
- src/Xmobar/App/EventLoop.hs +1/−1
- src/Xmobar/App/Main.hs +5/−1
- src/Xmobar/Config/Parse.hs +6/−3
- src/Xmobar/Config/Types.hs +13/−0
- src/Xmobar/Plugins/Monitors/Disk.hs +41/−124
- src/Xmobar/Plugins/Monitors/Disk/Common.hs +21/−0
- src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc +403/−0
- src/Xmobar/Plugins/Monitors/Disk/Linux.hs +148/−0
- src/Xmobar/Plugins/Monitors/K10Temp.hs +7/−1
- src/Xmobar/Plugins/Monitors/Net/FreeBSD.hsc +0/−1
- src/Xmobar/System/Signal.hs +3/−4
- xmobar.cabal +5/−1
changelog.md view
@@ -1,3 +1,10 @@+## Version 0.41 (January, 2022)++_New features_++ - Disk monitors for FreeBSD (Michal Zielonka).+ - Improvements to signal handling when using xmobar as a library (John Soo).+ ## Version 0.40 (November, 2021) _New features_
doc/plugins.org view
@@ -294,7 +294,7 @@ "-L", "10", "-H", "80", "-p", "3", "--", "-O", "<fc=green>On</fc> - ", "-i", "", "-L", "-15", "-H", "-5",- "-l", "red", "-m", "blue", "-h", "green"+ "-l", "red", "-m", "blue", "-h", "green", "-a", "notify-send -u critical 'Battery running out!!'", "-A", "3"] 600@@ -462,7 +462,8 @@ - Aliases to =k10temp= - - Slot: The PCI slot address of the k10temp device+ - Slot: The PCI slot address of the k10temp device as a string. You+ can find it as a subdirectory in =/sys/bus/pci/drivers/k10temp/=. - Args: default monitor arguments @@ -484,9 +485,11 @@ - Example: #+begin_src haskell- Run CoreTemp ["-t", "Temp: <Tdie>C|<Tccd1>C",- "-L", "40", "-H", "60",- "-l", "lightblue", "-n", "gray90", "-h", "red"] 50+ Run K10Temp "0000:00:18.3"+ ["-t", "Temp: <Tdie>C|<Tccd1>C",+ "-L", "40", "-H", "60",+ "-l", "lightblue", "-n", "gray90", "-h", "red"]+ 50 #+end_src
readme.org view
@@ -139,8 +139,8 @@ Alexander Polakov, Sibi Prabakaran, Pavan Rikhi, Petr Rockai, Andrew Emmanuel Rosa, Sackville-West, Amir Saeid, Markus Scherer, Daniel Schüssler, Olivier Schneider, Alexander Shabalin, Valentin Shirokov,-Peter Simons, Alexander Solovyov, Will Song, John Soros, Felix-Springer, Travis Staton, Artem Tarasov, Samuli Thomasson, Edward+Peter Simons, Alexander Solovyov, Will Song, John Soo, John Soros,+Felix Springer, Travis Staton, Artem Tarasov, Samuli Thomasson, Edward Tjörnhammar, Sergei Trofimovich, Thomas Tuegel, John Tyree, Jan Vornberger, Anton Vorontsov, Daniel Wagner, Zev Weiss, Phil Xiaojun Hu, Nikolay Yakimov, Edward Z. Yang, Leo Zhang, Norbert Zeh, and
src/Xmobar.hs view
@@ -23,6 +23,7 @@ , Runnable (..) , Exec (..) , Command (..)+ , SignalType (..) , module Xmobar.Config.Types , module Xmobar.Config.Parse , module Xmobar.Plugins.BufferedPipeReader@@ -74,6 +75,8 @@ import Xmobar.Plugins.MarqueePipeReader import Xmobar.Plugins.XMonadLog import Xmobar.Plugins.NotmuchMail++import Xmobar.System.Signal(SignalType (..)) import Xmobar.App.Main(xmobar, xmobarMain, configFromArgs) import Xmobar.App.Config(defaultConfig)
src/Xmobar/App/Config.hs view
@@ -64,6 +64,7 @@ , template = "%StdinReader% }{ " ++ "<fc=#00FF00>%uname%</fc> * <fc=#FF0000>%theDate%</fc>" , verbose = False+ , signal = SignalChan Nothing } -- | Return the path to the xmobar data directory. This directory is
src/Xmobar/App/EventLoop.hs view
@@ -42,7 +42,7 @@ import qualified Data.List.NonEmpty as NE import Xmobar.System.Signal-import Xmobar.Config.Types+import Xmobar.Config.Types (persistent, position, iconRoot, Config, Align(..), XPosition(..)) import Xmobar.Run.Exec import Xmobar.Run.Runnable import Xmobar.X11.Actions
src/Xmobar/App/Main.hs view
@@ -18,12 +18,14 @@ module Xmobar.App.Main (xmobar, xmobarMain, configFromArgs) where import Control.Concurrent.Async (Async, cancel)+import Control.Concurrent.STM (newEmptyTMVarIO) import Control.Exception (bracket) import Control.Monad (unless) import Data.Foldable (for_) import qualified Data.Map as Map import Data.List (intercalate)+import Data.Maybe (isJust) import System.Posix.Process (executeFile) import System.Environment (getArgs) import System.FilePath ((</>), takeBaseName, takeDirectory, takeExtension)@@ -53,7 +55,9 @@ fl <- mapM (initFont d) (additionalFonts conf) cls <- mapM (parseTemplate (commands conf) (sepChar conf)) (splitTemplate (alignSep conf) (template conf))- sig <- setupSignalHandler+ let confSig = unSignalChan (signal conf)+ sig <- maybe newEmptyTMVarIO pure confSig+ unless (isJust confSig) $ setupSignalHandler sig refLock <- newRefreshLock withTimer (refreshLock refLock) $ bracket (mapM (mapM $ startCommand sig) cls)
src/Xmobar/Config/Parse.hs view
@@ -57,7 +57,7 @@ x <- perms eof s <- getState- return (x,s)+ return (x, s) perms = permute $ Config <$?> pFont <|?> pFontList <|?> pWmClass <|?> pWmName@@ -68,7 +68,7 @@ <|?> pAllDesktops <|?> pOverrideRedirect <|?> pPickBroadest <|?> pLowerOnStart <|?> pPersistent <|?> pIconRoot <|?> pCommands <|?> pSepChar <|?> pAlignSep <|?> pTemplate- <|?> pVerbose+ <|?> pVerbose <|?> pSignal fields = [ "font", "additionalFonts","bgColor", "fgColor" , "wmClass", "wmName", "sepChar"@@ -76,7 +76,7 @@ , "position" , "textOffset", "textOffsets", "iconOffset" , "allDesktops", "overrideRedirect", "pickBroadest" , "hideOnStart", "lowerOnStart", "persistent", "iconRoot"- , "alpha", "commands", "verbose"+ , "alpha", "commands", "verbose", "signal" ] pFont = strField font "font"@@ -105,6 +105,9 @@ pIconRoot = readField iconRoot "iconRoot" pAlpha = readField alpha "alpha" pVerbose = readField verbose "verbose"++ pSignal = field signal "signal" $+ fail "signal is meant for use with Xmobar as a library.\n It is not meant for use in the configuration file." pCommands = field commands "commands" readCommands
src/Xmobar/Config/Types.hs view
@@ -17,9 +17,12 @@ -- $config Config (..) , XPosition (..), Align (..), Border(..)+ , SignalChan (..) ) where +import qualified Control.Concurrent.STM as STM import Xmobar.Run.Runnable (Runnable(..))+import Xmobar.System.Signal (SignalType) -- $config -- Configuration data type@@ -65,6 +68,7 @@ -- right text alignment , template :: String -- ^ The output template , verbose :: Bool -- ^ Emit additional debug messages+ , signal :: SignalChan -- ^ The signal channel used to send signals to xmobar } deriving (Read, Show) data XPosition = Top@@ -91,3 +95,12 @@ | BottomBM Int | FullBM Int deriving ( Read, Show, Eq )++newtype SignalChan = SignalChan { unSignalChan :: Maybe (STM.TMVar SignalType) }++instance Read SignalChan where+ readsPrec _ _ = fail "SignalChan is not readable from a String"++instance Show SignalChan where+ show (SignalChan (Just _)) = "SignalChan (Just <tmvar>)"+ show (SignalChan Nothing) = "SignalChan Nothing"
src/Xmobar/Plugins/Monitors/Disk.hs view
@@ -12,21 +12,26 @@ -- ----------------------------------------------------------------------------- +{-# LANGUAGE CPP #-}+ module Xmobar.Plugins.Monitors.Disk (diskUConfig, runDiskU, startDiskIO) where import Xmobar.Plugins.Monitors.Common-import Xmobar.System.StatFS--import Data.IORef (IORef, newIORef, readIORef, writeIORef)+#if defined(freebsd_HOST_OS)+import qualified Xmobar.Plugins.Monitors.Disk.FreeBSD as MD+#else+import qualified Xmobar.Plugins.Monitors.Disk.Linux as MD+#endif -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+import Data.List (find) +import Xmobar.Plugins.Monitors.Disk.Common (+ DevName+ , Path+ )+ data DiskIOOpts = DiskIOOpts { totalIconPattern :: Maybe IconPattern , writeIconPattern :: Maybe IconPattern@@ -93,103 +98,12 @@ , "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 r = 4096 * xs !! 2- w = 4096 * xs !! 6- t = r + w- rSp = speed r (xs !! 3)- wSp = speed w (xs !! 7)- sp = speed t (xs !! 3 + xs !! 7)- speed x d = if d == 0 then 0 else x / d- dat' = if length xs > 6- then [sp, rSp, wSp, t, r, w]- else [0, 0, 0, 0, 0, 0]- in (dev, dat')- speedToStr :: Float -> String speedToStr = showWithUnits 2 1 . (/ 1024) 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@@ -202,37 +116,25 @@ setConfigValue tmp template parseTemplate $ s ++ b ++ vb ++ ipat -runDiskIO :: DevDataRef -> [(String, String)] -> [String] -> Monitor String+runDiskIO :: MD.DevDataRef -> [(String, String)] -> [String] -> Monitor String runDiskIO dref disks argv = do opts <- io $ parseOptsWith dioOptions dioDefaultOpts argv- dev <- io $ mountedOrDiskDevices (map fst disks)- dat <- io $ mountedData dref (map fst dev)- strs <- mapM (runDiskIO' opts) $ devTemplates disks dev dat+ stats <- io $ MD.fetchDataIO dref disks+ mounted <- io $ MD.fetchDataUsage disks+ strs <- mapM (runDiskIO' opts) $ devTemplates disks (map fst mounted) stats return $ (if contiguous opts then concat else 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)+ dref <- MD.initializeDevDataRef disks 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+runDiskU' :: DiskUOpts -> String -> [Integer] -> Monitor String+runDiskU' opts tmp stat = do setConfigValue tmp template- [total, free, diff] <- io (handle ign $ fsStats path)- let strs = map sizeToStr [free, diff]+ let [total, free, diff] = stat+ 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]@@ -244,12 +146,27 @@ 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 $ parseOptsWith duOptions duDefaultOpts argv- strs <- mapM (\(d, p) -> runDiskU' opts (findTempl d p disks) p) devs+ stats <- io $ MD.fetchDataUsage disks+ strs <- mapM (\((d, p), stat) -> runDiskU' opts (findTempl d p disks) stat) stats return $ (if contiguousU opts then concat else unwords) strs++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
+ src/Xmobar/Plugins/Monitors/Disk/Common.hs view
@@ -0,0 +1,21 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.Monitors.Disk.Common+-- Copyright : (c) 2010, 2011, 2012, 2014, 2018, 2019 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.Common (+ DevName+ , Path+ ) where++type DevName = String+type Path = String
+ src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc view
@@ -0,0 +1,403 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CApiFFI #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NumDecimals #-}+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.Monitors.Disk.Freebsd+-- Copyright : (c) 2010, 2011, 2012, 2014, 2018, 2019 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.FreeBSD+ (+ fetchDataIO+ , fetchDataUsage+ , initializeDevDataRef+ , DevDataRef+ ) where++import Data.IORef (+ IORef+ , newIORef+ , readIORef+ , writeIORef+ )++import Xmobar.Plugins.Monitors.Disk.Common (+ DevName+ , Path+ )++import qualified Control.Exception.Extensible as E+import qualified Data.List as DL+import qualified Data.Map as DM+import qualified Data.Set as DS+import Data.Time.Clock.POSIX+import Foreign+import Foreign.C.Error (throwErrnoIfMinus1_)+import Foreign.C.String+import Foreign.C.Types+import System.BSD.Sysctl++#include <sys/sysctl.h>+#include <sys/mount.h>+#include <devstat.h>+#include <libgeom.h>++foreign import ccall unsafe "sys/mount.h getfsstat" c_getfsstat :: Ptr STATFS -> CInt -> CInt -> IO CInt+foreign import ccall unsafe "geom_stats_open" c_geom_stats_open :: IO CInt+foreign import ccall unsafe "geom_stats_snapshot_get" c_geom_stats_snapshot_get :: IO (Ptr GSNAP)+foreign import ccall unsafe "&geom_stats_snapshot_free" c_geom_stats_snapshot_free :: FinalizerPtr GSNAP+foreign import ccall unsafe "geom_stats_snapshot_next" c_geom_stats_snapshot_next :: Ptr GSNAP -> IO (Ptr DEVSTAT)+foreign import ccall unsafe "geom_gettree" c_geom_gettree :: Ptr GMESH -> IO CInt+foreign import ccall unsafe "geom_lookupid" c_geom_lookupid :: Ptr GMESH -> Ptr VOIDPTR -> IO (Ptr GIDENT)+foreign import ccall unsafe "&geom_deletetree" c_geom_deletetree :: FinalizerPtr GMESH+foreign import ccall unsafe "geom_stats_snapshot_timestamp" c_geom_stats_snapshot_timestamp :: Ptr GSNAP -> Ptr Timespec -> IO CInt++type DevDataRef = IORef (DM.Map String DevStatData)++data STATFS+data StatFs = StatFs !(ForeignPtr STATFS)+ deriving (Eq, Show)++data DEVSTAT+data DevStat = DevStat !(ForeignPtr DEVSTAT)+ deriving (Eq, Show)++data GMESH+data GMesh = GMesh !(ForeignPtr GMESH)++data GSNAP+data GSnap = GSnap !(ForeignPtr GSNAP)++data GIDENT+data VOIDPTR+data Timespec++data DevStatData = DevStatData {+ devname :: String+ , readDevStat :: Int64+ , writeDevStat :: Int64+ , devstatId :: Ptr VOIDPTR+ , devStatTime :: Rational+ }+ deriving (Show, Eq)++data StatFsData = StatFsData+ {+ fsMntFromName :: String+ , fsMntOnName :: String+ , fsStatBlockSize :: Integer+ -- ^ Optimal transfer block size.+ , fsStatBlockCount :: Integer+ -- ^ Total data blocks in file system.+ , fsStatByteCount :: Integer+ -- ^ Total bytes in file system.+ , fsStatBytesFree :: Integer+ -- ^ Free bytes in file system.+ , fsStatBytesAvailable :: Integer+ -- ^ Free bytes available to non-superusers.+ , fsStatBytesUsed :: Integer+ -- ^ Bytes used.+ }+ deriving (Show, Read, Eq)++data GIdentData = GIdentData+ {+ lgPtr :: Ptr VOIDPTR+ , lgWhat :: CInt+ }+ deriving (Show, Eq)++instance Storable GIdentData where+ alignment _ = #{alignment struct gident}+ sizeOf _ = #{size struct gident}+ peek ptr = do+ gIdentLgPtr <- #{peek struct gident, lg_ptr} ptr :: IO (Ptr VOIDPTR)+ gIdentLgWhat <- #{peek struct gident, lg_what} ptr :: IO CInt+ return GIdentData {+ lgPtr=gIdentLgPtr+ , lgWhat=gIdentLgWhat+ }++ poke _ _ = pure ()++instance Storable DevStatData where+ alignment _ = #{alignment struct devstat}+ sizeOf _ = #{size struct devstat}+ peek ptr = do+ device_id <- #{peek struct devstat, id} ptr :: IO (Ptr VOIDPTR)+ device_name <- peekCString $ #{ptr struct devstat, device_name} ptr+ unit_number <- #{peek struct devstat, unit_number} ptr :: IO Int+ bytes_values <- peekArray 4 $ #{ptr struct devstat, bytes} ptr :: IO [CUIntMax]+ let+ read_value = bytes_values !! #{const DEVSTAT_READ}+ write_value = bytes_values !! #{const DEVSTAT_WRITE}+ return DevStatData {+ devname=concat [device_name, show unit_number]+ , readDevStat=fromInteger . toInteger $ read_value+ , writeDevStat=fromInteger . toInteger $ write_value+ , devstatId=device_id+ , devStatTime=0+ }+++ poke _ _ = pure ()++instance Storable StatFsData where+ alignment _ = #{alignment struct statfs}+ sizeOf _ = #{size struct statfs}+ peek ptr = do+ fmntfromname <- peekCString $ #{ptr struct statfs, f_mntfromname} ptr+ fmntonname <- peekCString $ #{ptr struct statfs, f_mntonname} ptr+ bsize <- #{peek struct statfs, f_bsize} ptr+ bcount <- #{peek struct statfs, f_blocks} ptr+ bfree <- #{peek struct statfs, f_bfree} ptr+ bavail <- #{peek struct statfs, f_bavail} ptr+ let+ bpb = toI bsize+ return $ StatFsData {+ fsMntFromName = fmntfromname+ , fsMntOnName = fmntonname+ , fsStatBlockSize = bpb+ , fsStatBlockCount = toI bcount+ , fsStatByteCount = toI bcount * bpb+ , fsStatBytesFree = toI bfree * bpb+ , fsStatBytesAvailable = toI bavail * bpb+ , fsStatBytesUsed = toI (bcount - bfree) * bpb+ }++ poke _ _ = pure ()+++toI :: CULong -> Integer+toI = toInteger++mountCount :: IO CInt+mountCount = c_getfsstat nullPtr 0 #{const MNT_NOWAIT}++getMountInfo :: IO [StatFsData]+getMountInfo = do+ cmountcount <- mountCount+ let+ cbytes = cmountcount * #{size struct statfs}+ bytes = fromInteger . toInteger $ cbytes+ mountcount = fromInteger . toInteger $ cmountcount+ allocaBytes bytes $ \vfs -> do+ c_getfsstat vfs cbytes #{const MNT_NOWAIT}+ peekArray mountcount $ castPtr vfs :: IO [StatFsData]++cTimeToInteger :: CTime -> Integer+cTimeToInteger (CTime n) = fromIntegral n++getSnapshotTime :: GSnap -> IO Integer+getSnapshotTime (GSnap snap_fp) = do+ allocaBytes #{const sizeof(struct timespec)} $ \p_ts -> do+ withForeignPtr snap_fp $ \snap_ptr -> do+ throwErrnoIfMinus1_ "geom_stats_snapshot_timestamp"+ $ c_geom_stats_snapshot_timestamp snap_ptr p_ts+ u_sec <- #{peek struct timespec,tv_sec} p_ts :: IO CTime+ u_nsec <- #{peek struct timespec,tv_nsec} p_ts :: IO CLong+ return (cTimeToInteger u_sec * 1e12 + fromIntegral u_nsec * 1e3)++checkGeomStat' :: GIdentData -> GSnap -> DevStatData -> [DevStatData] -> IO [DevStatData]+checkGeomStat' gident_data gsnap stat acc+ | (lgWhat gident_data) /= #{const ISPROVIDER} = return acc+ | otherwise = do+ lgNamePtr <- #{peek struct gprovider, lg_name} $ lgPtr gident_data+ lgName <- peekCString $ castPtr lgNamePtr+ lgTime <- toRational <$> getSnapshotTime gsnap+ return $ stat+ {+ devname=concat ["/dev/", lgName]+ , devStatTime= lgTime / 1e12+ } : acc+++checkGeomStat :: Ptr GIDENT -> GSnap -> DevStatData -> [DevStatData] -> IO [DevStatData]+checkGeomStat gident_ptr gsnap stat acc+ | gident_ptr == nullPtr = return acc+ | otherwise = do+ gIdent <- peek $ castPtr gident_ptr :: IO GIdentData+ checkGeomStat' gIdent gsnap stat acc+++getGeomStats' :: GMesh -> GSnap -> Ptr DEVSTAT -> [DevStatData] -> IO [DevStatData]+getGeomStats' gmeshD@(GMesh gmesh_fp) gsnapD@(GSnap snap_fp) ptr acc+ | ptr == nullPtr = return acc+ | otherwise = do+ withForeignPtr snap_fp $ \snap_ptr -> do+ acc' <- withForeignPtr gmesh_fp $ \gmesh_ptr -> do+ stat <- (peek $ castPtr ptr) :: IO DevStatData+ gIdentPtr <- c_geom_lookupid gmesh_ptr (devstatId stat)+ checkGeomStat gIdentPtr gsnapD stat acc+ nextStatPtr <- c_geom_stats_snapshot_next snap_ptr+ getGeomStats' gmeshD gsnapD nextStatPtr acc'++getGeomStats :: IO [DevStatData]+getGeomStats = do+ gmesh_fp <- mallocForeignPtrBytes bytesmesh+ addForeignPtrFinalizer c_geom_deletetree gmesh_fp+ c_geom_stats_open+ withForeignPtr gmesh_fp $ \gmesh_ptr -> do+ c_geom_gettree gmesh_ptr+ snap_ptr <- c_geom_stats_snapshot_get+ snap_fp <- newForeignPtr c_geom_stats_snapshot_free snap_ptr+ withForeignPtr snap_fp $ \snap_ptr' -> do+ nextStatPtr <- c_geom_stats_snapshot_next snap_ptr'+ getGeomStats' (GMesh gmesh_fp) (GSnap snap_fp) nextStatPtr []+ where+ bytesmesh = #{size struct gmesh}+++readGeomStats :: DM.Map String DevStatData -> IO (DM.Map String DevStatData)+readGeomStats acc = do+ (Prelude.foldr (\x-> DM.insert (devname x) x) acc) <$> getGeomStats++defaultDevStatData :: DevStatData+defaultDevStatData = DevStatData+ {+ devname = ""+ , readDevStat = 0+ , writeDevStat = 0+ , devstatId = nullPtr+ , devStatTime = 0+ }++sysctlNextOid :: [Int32] -> IO [Int32]+sysctlNextOid oid = do+ let query_oid = #{const CTL_SYSCTL} : #{const CTL_SYSCTL_NEXT} : oid+ E.catch (sysctlPeekArray query_oid :: IO [Int32]) (\(E.SomeException _) -> return [])++sysctlOidToName :: [Int32] -> IO String+sysctlOidToName oid = do+ let query_oid = #{const CTL_SYSCTL} : #{const CTL_SYSCTL_NAME} : oid+ nameO <- sysctlReadString query_oid+ return nameO++fetchZfsStat :: [Int32] -> DM.Map (String, String) DevStatData -> [String] -> IO (DM.Map (String, String) DevStatData)+fetchZfsStat oid acc (_ : _ : poolName : "dataset" : refName : "nread" : []) = do+ readsB <- sysctlReadLong oid+ let val = DM.findWithDefault defaultDevStatData (poolName, refName) acc+ val' = val+ {+ readDevStat = readsB+ }+ return $ DM.insert (poolName, refName) val' acc++fetchZfsStat oid acc (_ : _ : poolName : "dataset" : refName : "nwritten" : []) = do+ writesB <- sysctlReadLong oid+ let val = DM.findWithDefault defaultDevStatData (poolName, refName) acc+ val' = val+ {+ writeDevStat = writesB+ }+ return $ DM.insert (poolName, refName) val' acc++fetchZfsStat oid acc (_ : _ : poolName : "dataset" : refName : "dataset_name" : []) = do+ datasetName <- sysctlReadString oid+ datasetTime <- toRational <$> getPOSIXTime+ let val = DM.findWithDefault defaultDevStatData (poolName, refName) acc+ val' = val+ {+ devname = datasetName+ , devStatTime = datasetTime+ }+ return $ DM.insert (poolName, refName) val' acc++fetchZfsStat _ acc _ = return acc++readZfsStat' :: [Int32] -> [Int32] -> DM.Map (String, String) DevStatData -> IO (DM.Map (String, String) DevStatData)+readZfsStat' mainOid actOid acc+ | mainOid `DL.isPrefixOf` actOid = do+ nameDS <- sysctlOidToName actOid+ let nameArr = splitOnDot nameDS+ acc' <- fetchZfsStat actOid acc nameArr+ nextOid <- sysctlNextOid actOid+ readZfsStat' mainOid nextOid acc'++ | otherwise = return acc++splitOnDot :: String -> [String]+splitOnDot [] = [[]]+splitOnDot ('.':xs) = [] : splitOnDot xs+splitOnDot (x:xs) =+ let rest = splitOnDot xs+ in (x : head rest) : tail rest++readZfsStats :: DM.Map DevName DevStatData -> IO (DM.Map DevName DevStatData)+readZfsStats acc = do+ mainO <- sysctlNameToOid "kstat.zfs"+ mainOid <- sysctlExtractOid mainO+ (DM.foldr (\x-> DM.insert (devname x) x) acc) <$> (readZfsStat' mainOid mainOid $ DM.empty)++readDevsStats :: IO (DM.Map DevName DevStatData)+readDevsStats = do+ geomStats <- readGeomStats DM.empty+ readZfsStats geomStats++extractDataIO :: DM.Map String DevStatData -> DM.Map String DevStatData -> String -> (DevName, [Float])+extractDataIO currs prevs disk = (disk, diffStat)+ where+ diffStat = [sp, rSp, wSp, fromInteger t, fromInteger r, fromInteger w]+ r = toInteger $ (readDevStat curr) - (readDevStat prev)+ w = toInteger $ (writeDevStat curr) - (writeDevStat prev)+ t = r + w+ rSp = speed r diffTime+ wSp = speed w diffTime+ sp = speed t diffTime+ curr = DM.findWithDefault defaultDevStatData disk currs+ prev = DM.findWithDefault defaultDevStatData disk prevs+ diffTime = (devStatTime curr) - (devStatTime prev)+ speed :: Integer -> Rational -> Float+ speed _ 0 = 0+ speed x d = (fromInteger x) / (realToFrac d)++fetchDataIO :: DevDataRef -> [(String, String)] -> IO [(DevName, [Float])]+fetchDataIO dref disks = do+ currStats <- readDevsStats+ prevStats <- readIORef dref+ writeIORef dref currStats+ return $ map (extractDataIO currStats prevStats) $ mountedOrDiskDevices disks currStats++fetchDataUsage :: [(String, String)] -> IO [((DevName, Path), [Integer])]+fetchDataUsage disks = Prelude.map extractStat <$> Prelude.filter isReq <$> getMountInfo+ where+ req = Prelude.map fst disks+ isReq :: StatFsData -> Bool+ isReq stat = (fsMntOnName stat) `elem` req+ || Prelude.drop 5 (fsMntFromName stat) `elem` req+ || (fsMntFromName stat) `elem` req+ extractStat :: StatFsData -> ((String, String), [Integer])+ extractStat stat = ((fsMntFromName stat, fsMntOnName stat)+ , [+ fsStatByteCount stat+ , fsStatBytesFree stat+ , fsStatBytesUsed stat+ ]+ )++initializeDevDataRef :: [(String, String)] -> IO DevDataRef+initializeDevDataRef _ = do+ stats <- readDevsStats+ newIORef stats++mountedOrDiskDevices :: [(DevName, Path)] -> DM.Map String DevStatData -> [DevName]+mountedOrDiskDevices mounted devs = DS.elems $ mountedOrDiskDevices' mountedAcc (DM.keys devs)+ where+ mountedAcc = mountedOrDiskDevices' DS.empty (map fst mounted)++mountedOrDiskDevices' :: DS.Set DevName -> [DevName] -> DS.Set DevName+mountedOrDiskDevices' acc [] = acc+mountedOrDiskDevices' acc (x:xs) = mountedOrDiskDevices' (DS.insert x acc) xs
+ src/Xmobar/Plugins/Monitors/Disk/Linux.hs view
@@ -0,0 +1,148 @@+-----------------------------------------------------------------------------+-- |+-- Module : Plugins.Monitors.Disk.Linux+-- Copyright : (c) 2010, 2011, 2012, 2014, 2018, 2019 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.Linux+ (+ fetchDataIO+ , fetchDataUsage+ , initializeDevDataRef+ , DevDataRef+ ) where++import Data.IORef (+ IORef+ , newIORef+ , readIORef+ , writeIORef+ )++import Xmobar.System.StatFS (+ getFileSystemStats+ , fsStatByteCount+ , fsStatBytesAvailable+ , fsStatBytesUsed+ )+import qualified Data.ByteString.Lazy.Char8 as B+import Data.List (isPrefixOf, find)+import Data.Maybe (catMaybes)+import System.Directory (canonicalizePath, doesFileExist)+import Control.Exception (SomeException, handle)++import Xmobar.Plugins.Monitors.Disk.Common (+ DevName+ , Path+ )++type DevDataRef = IORef [(DevName, [Float])]++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]++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 r = 4096 * xs !! 2+ w = 4096 * xs !! 6+ t = r + w+ rSp = speed r (xs !! 3)+ wSp = speed w (xs !! 7)+ sp = speed t (xs !! 3 + xs !! 7)+ speed x d = if d == 0 then 0 else x / d+ dat' = if length xs > 6+ then [sp, rSp, wSp, t, r, w]+ else [0, 0, 0, 0, 0, 0]+ in (dev, dat')++fetchDataIO :: DevDataRef -> [(String, String)] -> IO [(String, [Float])]+fetchDataIO dref disks = do+ dev <- mountedOrDiskDevices (map fst disks)+ mountedData dref (map fst dev)++fetchDataUsage :: [(String, String)] -> IO [((String, String), [Integer])]+fetchDataUsage disks = do+ devs <- mountedDevices (map fst disks)+ mapM fetchStats devs+ where+ fetchStats :: (String, String) -> IO ((String, String), [Integer])+ fetchStats (dev, path) = do+ stats <- handle ign $ fsStats path+ return ((dev, path), stats)+ ign = const (return [0, 0, 0]) :: SomeException -> IO [Integer]++initializeDevDataRef :: [(String, String)] -> IO DevDataRef+initializeDevDataRef disks = do+ dev <- mountedOrDiskDevices (map fst disks)+ newIORef (map (\d -> (fst d, repeat 0)) dev)
src/Xmobar/Plugins/Monitors/K10Temp.hs view
@@ -28,6 +28,12 @@ ] -- available replacements -- |+-- Base directory for k10temp system bus+--+k10Dir :: String+k10Dir = "/sys/bus/pci/drivers/k10temp/"++-- | -- Function retrieves monitor string holding the temperature -- (or temperatures) runK10Temp :: [String] -> Monitor String@@ -35,7 +41,7 @@ dn <- getConfigValue decDigits failureMessage <- getConfigValue naString let slot = head args- path = ["/sys/bus/pci/drivers/k10temp/" ++ slot ++ "/hwmon/hwmon", "/temp", "_input"]+ path = [k10Dir ++ slot ++ "/hwmon/hwmon", "/temp", "_input"] divisor = 1e3 :: Double show' = showDigits (max 0 dn) checkedDataRetrieval failureMessage [path] Nothing (/divisor) show'
src/Xmobar/Plugins/Monitors/Net/FreeBSD.hsc view
@@ -29,7 +29,6 @@ import Foreign (Int32, plusPtr) import Foreign.C.Types (CUIntMax, CUChar) import Foreign.C.String (peekCString)-import Foreign.ForeignPtr () import Foreign.Storable (Storable, alignment, sizeOf, peek, poke) import System.BSD.Sysctl (OID, sysctlPrepareOid, sysctlReadInt, sysctlPeek)
src/Xmobar/System/Signal.hs view
@@ -60,12 +60,11 @@ parseSignalType = fmap fst . safeHead . reads -- | Signal handling-setupSignalHandler :: IO (TMVar SignalType)-setupSignalHandler = do- tid <- newEmptyTMVarIO+setupSignalHandler :: TMVar SignalType -> IO ()+setupSignalHandler tid = do installHandler sigUSR2 (Catch $ updatePosHandler tid) Nothing installHandler sigUSR1 (Catch $ changeScreenHandler tid) Nothing- return tid+ return () updatePosHandler :: TMVar SignalType -> IO () updatePosHandler sig = do
xmobar.cabal view
@@ -1,5 +1,5 @@ name: xmobar-version: 0.40+version: 0.41 homepage: http://xmobar.org synopsis: A Minimalistic Text Based Status Bar description: Xmobar is a minimalistic text based status bar.@@ -159,6 +159,7 @@ Xmobar.Plugins.Monitors.Cpu.Common, Xmobar.Plugins.Monitors.CpuFreq, Xmobar.Plugins.Monitors.Disk,+ Xmobar.Plugins.Monitors.Disk.Common, Xmobar.Plugins.Monitors.Mem, Xmobar.Plugins.Monitors.MultiCoreTemp, Xmobar.Plugins.Monitors.MultiCpu,@@ -297,9 +298,11 @@ -- enables freebsd specific code extra-libraries: procstat , kvm+ , geom build-depends: bsd-sysctl other-modules: Xmobar.Plugins.Monitors.Batt.FreeBSD, Xmobar.Plugins.Monitors.Cpu.FreeBSD,+ Xmobar.Plugins.Monitors.Disk.FreeBSD, Xmobar.Plugins.Monitors.Mem.FreeBSD, Xmobar.Plugins.Monitors.Net.FreeBSD, Xmobar.Plugins.Monitors.Swap.FreeBSD,@@ -308,6 +311,7 @@ else other-modules: Xmobar.Plugins.Monitors.Batt.Linux, Xmobar.Plugins.Monitors.Cpu.Linux,+ Xmobar.Plugins.Monitors.Disk.Linux, Xmobar.Plugins.Monitors.Mem.Linux, Xmobar.Plugins.Monitors.Net.Linux, Xmobar.Plugins.Monitors.Swap.Linux,