summaryrefslogtreecommitdiffhomepage
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Xmobar/Plugins/Monitors/Load.hs32
-rw-r--r--src/Xmobar/Plugins/Monitors/Load/Common.hs21
-rw-r--r--src/Xmobar/Plugins/Monitors/Load/FreeBSD.hsc58
-rw-r--r--src/Xmobar/Plugins/Monitors/Load/Linux.hs38
4 files changed, 134 insertions, 15 deletions
diff --git a/src/Xmobar/Plugins/Monitors/Load.hs b/src/Xmobar/Plugins/Monitors/Load.hs
index bc0af09..270c049 100644
--- a/src/Xmobar/Plugins/Monitors/Load.hs
+++ b/src/Xmobar/Plugins/Monitors/Load.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
-----------------------------------------------------------------------------
-- |
-- Module : Plugins.Monitors.Load
@@ -17,28 +19,28 @@
module Xmobar.Plugins.Monitors.Load (loadConfig, runLoad) where
import Xmobar.Plugins.Monitors.Common
-import qualified Data.ByteString.Lazy.Char8 as B
-import System.Posix.Files (fileExist)
+import Xmobar.Plugins.Monitors.Load.Common (Result(..))
+
+#if defined(freebsd_HOST_OS)
+import qualified Xmobar.Plugins.Monitors.Load.FreeBSD as ML
+#else
+import qualified Xmobar.Plugins.Monitors.Load.Linux as ML
+#endif
+
-- | Default configuration.
loadConfig :: IO MConfig
loadConfig = mkMConfig "Load: <load1>" ["load1", "load5", "load15"]
--- | Parses the contents of a loadavg proc file, returning
--- the list of load averages
-parseLoadAvgs :: B.ByteString -> [Float]
-parseLoadAvgs =
- map (read . B.unpack) . take 3 . B.words . head . B.lines
-- | Retrieves load information. Returns the monitor string parsed
-- according to template (either default or user specified).
runLoad :: [String] -> Monitor String
runLoad _ = do
- let file = "/proc/loadavg"
- exists <- io $ fileExist file
- if exists then
- (do l <- io $ B.readFile file >>= return . parseLoadAvgs
- d <- getConfigValue decDigits
- parseTemplate =<< mapM (showWithColors (showDigits d)) l)
- else
- getConfigValue naString
+ result <- io ML.fetchLoads
+ case result of
+ Result loads ->
+ do
+ d <- getConfigValue decDigits
+ parseTemplate =<< mapM (showWithColors (showDigits d)) loads
+ NA -> getConfigValue naString
diff --git a/src/Xmobar/Plugins/Monitors/Load/Common.hs b/src/Xmobar/Plugins/Monitors/Load/Common.hs
new file mode 100644
index 0000000..578944c
--- /dev/null
+++ b/src/Xmobar/Plugins/Monitors/Load/Common.hs
@@ -0,0 +1,21 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Plugins.Monitors.Load.Common
+-- Copyright : Finn Lawler
+-- License : BSD-style (see LICENSE)
+--
+-- Author : Finn Lawler <flawler@cs.tcd.ie>
+-- Maintainer : jao <mail@jao.io>
+-- Stability : unstable
+-- Portability : unportable
+--
+-- A load average monitor for Xmobar. Adapted from
+-- Xmobar.Plugins.Monitors.Thermal by Juraj Hercek.
+--
+-----------------------------------------------------------------------------
+
+module Xmobar.Plugins.Monitors.Load.Common (
+ Result(..)
+ ) where
+
+data Result = Result [Float] | NA
diff --git a/src/Xmobar/Plugins/Monitors/Load/FreeBSD.hsc b/src/Xmobar/Plugins/Monitors/Load/FreeBSD.hsc
new file mode 100644
index 0000000..bde7e91
--- /dev/null
+++ b/src/Xmobar/Plugins/Monitors/Load/FreeBSD.hsc
@@ -0,0 +1,58 @@
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE CApiFFI #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : Plugins.Monitors.Load.FreeBSD
+-- Copyright : Finn Lawler
+-- License : BSD-style (see LICENSE)
+--
+-- Author : Finn Lawler <flawler@cs.tcd.ie>
+-- Maintainer : jao <mail@jao.io>
+-- Stability : unstable
+-- Portability : unportable
+--
+-- A load average monitor for Xmobar. Adapted from
+-- Xmobar.Plugins.Monitors.Thermal by Juraj Hercek.
+--
+-----------------------------------------------------------------------------
+
+module Xmobar.Plugins.Monitors.Load.FreeBSD (fetchLoads) where
+
+import Xmobar.Plugins.Monitors.Load.Common (Result(..))
+import Foreign.C.Types (CUInt, CUIntMax)
+import Foreign.Marshal.Array (peekArray)
+import Foreign.Ptr (plusPtr)
+import Foreign.Storable (Storable, alignment, peek, peekByteOff, poke, sizeOf)
+import System.BSD.Sysctl (sysctlPeek)
+
+#include <sys/resource.h>
+
+
+data LoadAvg = LoadAvg {loads :: [Float]}
+
+
+calcLoad :: CUInt -> CUIntMax -> Float
+calcLoad l s = ((fromIntegral . toInteger) l) / ((fromIntegral . toInteger) s)
+
+
+instance Storable LoadAvg where
+ alignment _ = #{alignment struct loadavg}
+ sizeOf _ = #{size struct loadavg}
+ peek ptr = do
+ load_values <- peekArray 3 $ #{ptr struct loadavg, ldavg} ptr :: IO [CUInt]
+ scale <- #{peek struct loadavg, fscale} ptr :: IO CUIntMax
+ let
+ l1 = calcLoad (load_values !! 0) scale
+ l5 = calcLoad (load_values !! 1) scale
+ l15 = calcLoad (load_values !! 2) scale
+
+ return $ LoadAvg{loads = [l1, l5, l15]}
+
+ poke _ _ = pure ()
+
+
+fetchLoads :: IO Result
+fetchLoads = do
+ res <- sysctlPeek "vm.loadavg" :: IO LoadAvg
+ return $ Result (loads res)
diff --git a/src/Xmobar/Plugins/Monitors/Load/Linux.hs b/src/Xmobar/Plugins/Monitors/Load/Linux.hs
new file mode 100644
index 0000000..9ba5a5c
--- /dev/null
+++ b/src/Xmobar/Plugins/Monitors/Load/Linux.hs
@@ -0,0 +1,38 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module : Plugins.Monitors.Load.Linux
+-- Copyright : Finn Lawler
+-- License : BSD-style (see LICENSE)
+--
+-- Author : Finn Lawler <flawler@cs.tcd.ie>
+-- Maintainer : jao <mail@jao.io>
+-- Stability : unstable
+-- Portability : unportable
+--
+-- A load average monitor for Xmobar. Adapted from
+-- Xmobar.Plugins.Monitors.Thermal by Juraj Hercek.
+--
+-----------------------------------------------------------------------------
+
+module Xmobar.Plugins.Monitors.Load.Linux (fetchLoads) where
+
+import Xmobar.Plugins.Monitors.Load.Common (Result(..))
+import qualified Data.ByteString.Lazy.Char8 as B
+import System.Posix.Files (fileExist)
+
+-- | Parses the contents of a loadavg proc file, returning
+-- the list of load averages
+parseLoadAvgs :: B.ByteString -> [Float]
+parseLoadAvgs =
+ map (read . B.unpack) . take 3 . B.words . head . B.lines
+
+fetchLoads :: IO Result
+fetchLoads = do
+ let file = "/proc/loadavg"
+
+ exists <- fileExist file
+ if exists then
+ (do contents <- B.readFile file
+ return $ Result (parseLoadAvgs contents))
+ else
+ return NA