try to reorganize modules per os

We should make better split os specify code for FreeBSD and Linux.
Idea comes from @liskin.

3 files changed, 237 insertions, 0 deletions

diff --git a/src/Xmobar/Plugins/Monitors/Net/Common.hs b/src/Xmobar/Plugins/Monitors/Net/Common.hs
new file mode 100644
index 0000000..16ed865
--- /dev/null
+++ b/src/Xmobar/Plugins/Monitors/Net/Common.hs
@@ -0,0 +1,50 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Plugins.Monitors.Net.Common
+-- Copyright   :  (c) 2011, 2012, 2013, 2014, 2017, 2020 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.Common (
+                        NetDev(..)
+                      , NetDevInfo(..)
+                      , NetDevRawTotal
+                      , NetDevRate
+                      , NetDevRef
+                      ) where
+
+import Data.IORef (IORef)
+import Data.Time.Clock (UTCTime)
+import Data.Word (Word64)
+
+data NetDev num = N String (NetDevInfo num) | NA deriving (Eq,Show,Read)
+data NetDevInfo num = NI | ND 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 (N _ i1) (N _ i2) = i1 `compare` i2
+
+instance Ord num => Ord (NetDevInfo num) where
+    compare NI NI                 = EQ
+    compare NI ND {}              = LT
+    compare ND {} NI              = GT
+    compare (ND x1 y1) (ND x2 y2) = x1 `compare` x2 <> y1 `compare` y2
diff --git a/src/Xmobar/Plugins/Monitors/Net/FreeBSD.hsc b/src/Xmobar/Plugins/Monitors/Net/FreeBSD.hsc
new file mode 100644
index 0000000..ab446e3
--- /dev/null
+++ b/src/Xmobar/Plugins/Monitors/Net/FreeBSD.hsc
@@ -0,0 +1,118 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE CApiFFI #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Plugins.Monitors.Net.FreeBSD
+-- Copyright   :  (c) 2011, 2012, 2013, 2014, 2017, 2020 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.FreeBSD (
+  existingDevs
+  , findNetDev
+  ) where
+
+import Xmobar.Plugins.Monitors.Net.Common (NetDevRawTotal, NetDev(..), NetDevInfo(..))
+import Control.Exception (catch, SomeException(..))
+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)
+
+#include <sys/sysctl.h>
+#include <net/if.h>
+#include <net/if_mib.h>
+
+data IfData = AvailableIfData {
+  name :: String
+  , txBytes :: CUIntMax
+  , rxBytes :: CUIntMax
+  , isUp :: Bool
+  } | NotAvailableIfData
+  deriving (Show, Read, Eq)
+
+instance Storable IfData where
+  alignment _ = #{alignment struct ifmibdata}
+  sizeOf _    = #{size struct ifmibdata}
+  peek ptr    = do
+    cname <- peekCString (ptr `plusPtr` (#offset struct ifmibdata, ifmd_name))
+    tx <- peek ((ifmd_data_ptr ptr) `plusPtr` (#offset struct if_data, ifi_obytes)) :: IO CUIntMax
+    rx <- peek ((ifmd_data_ptr ptr) `plusPtr` (#offset struct if_data, ifi_ibytes)) :: IO CUIntMax
+    state <- peek ((ifmd_data_ptr ptr) `plusPtr` (#offset struct if_data, ifi_link_state)) :: IO CUChar
+    return $ AvailableIfData {name = cname, txBytes = tx, rxBytes = rx, isUp = up state}
+      where
+        up state = state == (#const LINK_STATE_UP)
+        ifmd_data_ptr p = p `plusPtr` (#offset struct ifmibdata, ifmd_data)
+
+  poke _ _    = pure ()
+
+getNetIfCountOID :: IO OID
+getNetIfCountOID = sysctlPrepareOid [
+  #const CTL_NET
+  , #const PF_LINK
+  , #const NETLINK_GENERIC
+  , #const IFMIB_SYSTEM
+  , #const IFMIB_IFCOUNT]
+
+getNetIfDataOID :: Int32 -> IO OID
+getNetIfDataOID i = sysctlPrepareOid [
+  #const CTL_NET
+  , #const PF_LINK
+  , #const NETLINK_GENERIC
+  , #const IFMIB_IFDATA
+  , i
+  , #const IFDATA_GENERAL]
+
+getNetIfCount :: IO Int32
+getNetIfCount = do
+  oid <- getNetIfCountOID
+  sysctlReadInt oid
+
+getNetIfData :: Int32 -> IO IfData
+getNetIfData i = do
+  oid <- getNetIfDataOID i
+  res <- catch (sysctlPeek oid) (\(SomeException _) -> return NotAvailableIfData)
+  return res
+
+getAllNetworkData :: IO [IfData]
+getAllNetworkData = do
+  count <- getNetIfCount
+  result <- mapM getNetIfData [1..count]
+  return result
+
+existingDevs :: IO [String]
+existingDevs = getAllNetworkData >>= (\xs -> return $ filter (/= "lo0") $ fmap name xs)
+
+convertIfDataToNetDev :: IfData -> IO NetDevRawTotal
+convertIfDataToNetDev ifData = do
+  let up = isUp ifData
+      rx = fromInteger . toInteger $ rxBytes ifData
+      tx = fromInteger . toInteger $ txBytes ifData
+      d = name ifData
+  return $ N d (if up then ND rx tx else NI)
+
+netConvertIfDataToNetDev :: [IfData] -> IO [NetDevRawTotal]
+netConvertIfDataToNetDev = mapM convertIfDataToNetDev
+
+findNetDev :: String -> IO NetDevRawTotal
+findNetDev dev = do
+  nds <- getAllNetworkData >>= netConvertIfDataToNetDev
+  case filter isDev nds of
+    x:_ -> return x
+    _ -> return NA
+  where isDev (N d _) = d == dev
+        isDev NA = False
diff --git a/src/Xmobar/Plugins/Monitors/Net/Linux.hs b/src/Xmobar/Plugins/Monitors/Net/Linux.hs
new file mode 100644
index 0000000..9306497
--- /dev/null
+++ b/src/Xmobar/Plugins/Monitors/Net/Linux.hs
@@ -0,0 +1,69 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Plugins.Monitors.Net.Linux
+-- Copyright   :  (c) 2011, 2012, 2013, 2014, 2017, 2020 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
+--
+
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Xmobar.Plugins.Monitors.Net.Linux (
+  existingDevs
+  , findNetDev
+  ) where
+
+import Xmobar.Plugins.Monitors.Net.Common (NetDevRawTotal, NetDev(..), NetDevInfo(..))
+
+import Control.Monad (filterM)
+import System.Directory (getDirectoryContents, doesFileExist)
+import System.FilePath ((</>))
+import System.IO.Error (catchIOError)
+import System.IO.Unsafe (unsafeInterleaveIO)
+
+import qualified Data.ByteString.Char8 as B
+
+
+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 $! (head . B.lines) operstate `elem` ["up", "unknown"]
+
+readNetDev :: [String] -> IO NetDevRawTotal
+readNetDev ~[d, x, y] = do
+  up <- unsafeInterleaveIO $ isUp d
+  return $ N d (if up then ND (r x) (r y) else NI)
+    where r s | s == "" = 0
+              | otherwise = read s
+
+netParser :: B.ByteString -> IO [NetDevRawTotal]
+netParser = mapM (readNetDev . splitDevLine) . readDevLines
+  where readDevLines = drop 2 . B.lines
+        splitDevLine = map B.unpack . selectCols . filter (not . B.null) . B.splitWith (`elem` [' ',':'])
+        selectCols cols = map (cols!!) [0,1,9]
+
+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 (N d _) = d == dev
+        isDev NA = False