{-# LANGUAGE CPP #-}
module Xmobar.Plugins.Monitors.Net (
startNet
, startDynNet
) where
import Xmobar.Plugins.Monitors.Common
import Xmobar.Plugins.Monitors.Net.Common (NetDev(..), NetDevInfo(..), NetDevRate, NetDevRef)
import Data.IORef (newIORef, readIORef, writeIORef)
import Data.Time.Clock (getCurrentTime, diffUTCTime)
import System.Console.GetOpt
#if defined(freebsd_HOST_OS)
import qualified Xmobar.Plugins.Monitors.Net.FreeBSD as MN
#else
import qualified Xmobar.Plugins.Monitors.Net.Linux as MN
#endif
import Control.Monad (forM)
type DevList = [String]
parseDevList :: String -> DevList
parseDevList :: String -> DevList
parseDevList = String -> DevList
splitOnComma
where splitOnComma :: String -> DevList
splitOnComma [] = [[]]
splitOnComma (Char
',':String
xs) = [] String -> DevList -> DevList
forall a. a -> [a] -> [a]
: String -> DevList
splitOnComma String
xs
splitOnComma (Char
x:String
xs) =
let rest :: DevList
rest = String -> DevList
splitOnComma String
xs
in (Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: DevList -> String
forall a. HasCallStack => [a] -> a
head DevList
rest) String -> DevList -> DevList
forall a. a -> [a] -> [a]
: DevList -> DevList
forall a. HasCallStack => [a] -> [a]
tail DevList
rest
data NetOpts = NetOpts
{ NetOpts -> Maybe IconPattern
rxIconPattern :: Maybe IconPattern
, NetOpts -> Maybe IconPattern
txIconPattern :: Maybe IconPattern
, NetOpts -> Maybe DevList
onlyDevList :: Maybe DevList
, NetOpts -> String
upIndicator :: String
}
defaultOpts :: NetOpts
defaultOpts :: NetOpts
defaultOpts = NetOpts
{ rxIconPattern :: Maybe IconPattern
rxIconPattern = Maybe IconPattern
forall a. Maybe a
Nothing
, txIconPattern :: Maybe IconPattern
txIconPattern = Maybe IconPattern
forall a. Maybe a
Nothing
, onlyDevList :: Maybe DevList
onlyDevList = Maybe DevList
forall a. Maybe a
Nothing
, upIndicator :: String
upIndicator = String
"+"
}
options :: [OptDescr (NetOpts -> NetOpts)]
options :: [OptDescr (NetOpts -> NetOpts)]
options =
[ String
-> DevList
-> ArgDescr (NetOpts -> NetOpts)
-> String
-> OptDescr (NetOpts -> NetOpts)
forall a. String -> DevList -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"rx-icon-pattern"] ((String -> NetOpts -> NetOpts)
-> String -> ArgDescr (NetOpts -> NetOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x NetOpts
o ->
NetOpts
o { rxIconPattern = Just $ parseIconPattern x }) String
"") String
""
, String
-> DevList
-> ArgDescr (NetOpts -> NetOpts)
-> String
-> OptDescr (NetOpts -> NetOpts)
forall a. String -> DevList -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"tx-icon-pattern"] ((String -> NetOpts -> NetOpts)
-> String -> ArgDescr (NetOpts -> NetOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x NetOpts
o ->
NetOpts
o { txIconPattern = Just $ parseIconPattern x }) String
"") String
""
, String
-> DevList
-> ArgDescr (NetOpts -> NetOpts)
-> String
-> OptDescr (NetOpts -> NetOpts)
forall a. String -> DevList -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"up"] ((String -> NetOpts -> NetOpts)
-> String -> ArgDescr (NetOpts -> NetOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x NetOpts
o -> NetOpts
o { upIndicator = x }) String
"") String
""
, String
-> DevList
-> ArgDescr (NetOpts -> NetOpts)
-> String
-> OptDescr (NetOpts -> NetOpts)
forall a. String -> DevList -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"devices"] ((String -> NetOpts -> NetOpts)
-> String -> ArgDescr (NetOpts -> NetOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x NetOpts
o ->
NetOpts
o { onlyDevList = Just $ parseDevList x }) String
"") String
""
]
data UnitPerSec = Bs | KBs | MBs | GBs deriving (UnitPerSec -> UnitPerSec -> Bool
(UnitPerSec -> UnitPerSec -> Bool)
-> (UnitPerSec -> UnitPerSec -> Bool) -> Eq UnitPerSec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UnitPerSec -> UnitPerSec -> Bool
== :: UnitPerSec -> UnitPerSec -> Bool
$c/= :: UnitPerSec -> UnitPerSec -> Bool
/= :: UnitPerSec -> UnitPerSec -> Bool
Eq,Int -> UnitPerSec
UnitPerSec -> Int
UnitPerSec -> [UnitPerSec]
UnitPerSec -> UnitPerSec
UnitPerSec -> UnitPerSec -> [UnitPerSec]
UnitPerSec -> UnitPerSec -> UnitPerSec -> [UnitPerSec]
(UnitPerSec -> UnitPerSec)
-> (UnitPerSec -> UnitPerSec)
-> (Int -> UnitPerSec)
-> (UnitPerSec -> Int)
-> (UnitPerSec -> [UnitPerSec])
-> (UnitPerSec -> UnitPerSec -> [UnitPerSec])
-> (UnitPerSec -> UnitPerSec -> [UnitPerSec])
-> (UnitPerSec -> UnitPerSec -> UnitPerSec -> [UnitPerSec])
-> Enum UnitPerSec
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: UnitPerSec -> UnitPerSec
succ :: UnitPerSec -> UnitPerSec
$cpred :: UnitPerSec -> UnitPerSec
pred :: UnitPerSec -> UnitPerSec
$ctoEnum :: Int -> UnitPerSec
toEnum :: Int -> UnitPerSec
$cfromEnum :: UnitPerSec -> Int
fromEnum :: UnitPerSec -> Int
$cenumFrom :: UnitPerSec -> [UnitPerSec]
enumFrom :: UnitPerSec -> [UnitPerSec]
$cenumFromThen :: UnitPerSec -> UnitPerSec -> [UnitPerSec]
enumFromThen :: UnitPerSec -> UnitPerSec -> [UnitPerSec]
$cenumFromTo :: UnitPerSec -> UnitPerSec -> [UnitPerSec]
enumFromTo :: UnitPerSec -> UnitPerSec -> [UnitPerSec]
$cenumFromThenTo :: UnitPerSec -> UnitPerSec -> UnitPerSec -> [UnitPerSec]
enumFromThenTo :: UnitPerSec -> UnitPerSec -> UnitPerSec -> [UnitPerSec]
Enum,Eq UnitPerSec
Eq UnitPerSec =>
(UnitPerSec -> UnitPerSec -> Ordering)
-> (UnitPerSec -> UnitPerSec -> Bool)
-> (UnitPerSec -> UnitPerSec -> Bool)
-> (UnitPerSec -> UnitPerSec -> Bool)
-> (UnitPerSec -> UnitPerSec -> Bool)
-> (UnitPerSec -> UnitPerSec -> UnitPerSec)
-> (UnitPerSec -> UnitPerSec -> UnitPerSec)
-> Ord UnitPerSec
UnitPerSec -> UnitPerSec -> Bool
UnitPerSec -> UnitPerSec -> Ordering
UnitPerSec -> UnitPerSec -> UnitPerSec
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: UnitPerSec -> UnitPerSec -> Ordering
compare :: UnitPerSec -> UnitPerSec -> Ordering
$c< :: UnitPerSec -> UnitPerSec -> Bool
< :: UnitPerSec -> UnitPerSec -> Bool
$c<= :: UnitPerSec -> UnitPerSec -> Bool
<= :: UnitPerSec -> UnitPerSec -> Bool
$c> :: UnitPerSec -> UnitPerSec -> Bool
> :: UnitPerSec -> UnitPerSec -> Bool
$c>= :: UnitPerSec -> UnitPerSec -> Bool
>= :: UnitPerSec -> UnitPerSec -> Bool
$cmax :: UnitPerSec -> UnitPerSec -> UnitPerSec
max :: UnitPerSec -> UnitPerSec -> UnitPerSec
$cmin :: UnitPerSec -> UnitPerSec -> UnitPerSec
min :: UnitPerSec -> UnitPerSec -> UnitPerSec
Ord)
data NetValue = NetValue Float UnitPerSec deriving (NetValue -> NetValue -> Bool
(NetValue -> NetValue -> Bool)
-> (NetValue -> NetValue -> Bool) -> Eq NetValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NetValue -> NetValue -> Bool
== :: NetValue -> NetValue -> Bool
$c/= :: NetValue -> NetValue -> Bool
/= :: NetValue -> NetValue -> Bool
Eq,Int -> NetValue -> String -> String
[NetValue] -> String -> String
NetValue -> String
(Int -> NetValue -> String -> String)
-> (NetValue -> String)
-> ([NetValue] -> String -> String)
-> Show NetValue
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> NetValue -> String -> String
showsPrec :: Int -> NetValue -> String -> String
$cshow :: NetValue -> String
show :: NetValue -> String
$cshowList :: [NetValue] -> String -> String
showList :: [NetValue] -> String -> String
Show)
instance Show UnitPerSec where
show :: UnitPerSec -> String
show UnitPerSec
Bs = String
"B/s"
show UnitPerSec
KBs = String
"KB/s"
show UnitPerSec
MBs = String
"MB/s"
show UnitPerSec
GBs = String
"GB/s"
netConfig :: IO MConfig
netConfig :: IO MConfig
netConfig = String -> DevList -> IO MConfig
mkMConfig
String
"<dev>: <rx>KB|<tx>KB"
[String
"dev", String
"rx", String
"tx", String
"rxbar", String
"rxvbar", String
"rxipat", String
"txbar", String
"txvbar", String
"txipat", String
"up"]
formatNet :: Maybe IconPattern -> Float -> Monitor (String, String, String, String)
formatNet :: Maybe IconPattern
-> Float -> Monitor (String, String, String, String)
formatNet Maybe IconPattern
mipat Float
d = do
s <- Selector Bool -> Monitor Bool
forall a. Selector a -> Monitor a
getConfigValue Selector Bool
useSuffix
dd <- getConfigValue decDigits
let str Bool
True Float
v = Int -> Float -> String
forall a. RealFloat a => Int -> a -> String
showDigits Int
dd Float
d' String -> String -> String
forall a. [a] -> [a] -> [a]
++ UnitPerSec -> String
forall a. Show a => a -> String
show UnitPerSec
u
where (NetValue Float
d' UnitPerSec
u) = Float -> NetValue
byteNetVal Float
v
str Bool
False Float
v = Int -> Float -> String
forall a. RealFloat a => Int -> a -> String
showDigits Int
dd (Float -> String) -> Float -> String
forall a b. (a -> b) -> a -> b
$ Float
v Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
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 :: NetOpts -> NetDevRate -> Monitor String
printNet NetOpts
opts NetDevRate
nd =
case NetDevRate
nd of
N String
d (ND Float
r Float
t) -> do
(rx, rb, rvb, ripat) <- Maybe IconPattern
-> Float -> Monitor (String, String, String, String)
formatNet (NetOpts -> Maybe IconPattern
rxIconPattern NetOpts
opts) Float
r
(tx, tb, tvb, tipat) <- formatNet (txIconPattern opts) t
parseTemplate [d,rx,tx,rb,rvb,ripat,tb,tvb,tipat, upIndicator opts]
N String
_ NetDevInfo Float
NI -> String -> Monitor String
forall a. a -> ReaderT MConfig IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
NetDevRate
NA -> Selector String -> Monitor String
forall a. Selector a -> Monitor a
getConfigValue Selector String
naString
parseNet :: NetDevRef -> String -> IO NetDevRate
parseNet :: NetDevRef -> String -> IO NetDevRate
parseNet NetDevRef
nref String
nd = do
(n0, t0) <- NetDevRef -> IO (NetDevRawTotal, UTCTime)
forall a. IORef a -> IO a
readIORef NetDevRef
nref
n1 <- MN.findNetDev nd
t1 <- getCurrentTime
writeIORef nref (n1, t1)
let scx = NominalDiffTime -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
t1 UTCTime
t0)
scx' = if Float
scx Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 then Float
scx else Float
1
rate a
da a
db = Int -> Float -> Float
takeDigits Int
2 (Float -> Float) -> Float -> Float
forall a b. (a -> b) -> a -> b
$ a -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a
db a -> a -> a
forall a. Num a => a -> a -> a
- a
da) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
scx'
diffRate (N String
d (ND a
ra a
ta)) (N String
_ (ND a
rb a
tb)) = String -> NetDevInfo Float -> NetDevRate
forall num. String -> NetDevInfo num -> NetDev num
N String
d (Float -> Float -> NetDevInfo Float
forall num. num -> num -> NetDevInfo num
ND (a -> a -> Float
forall {a}. Integral a => a -> a -> Float
rate a
ra a
rb) (a -> a -> Float
forall {a}. Integral a => a -> a -> Float
rate a
ta a
tb))
diffRate (N String
d NetDevInfo a
NI) NetDev a
_ = String -> NetDevInfo Float -> NetDevRate
forall num. String -> NetDevInfo num -> NetDev num
N String
d NetDevInfo Float
forall num. NetDevInfo num
NI
diffRate NetDev a
_ (N String
d NetDevInfo a
NI) = String -> NetDevInfo Float -> NetDevRate
forall num. String -> NetDevInfo num -> NetDev num
N String
d NetDevInfo Float
forall num. NetDevInfo num
NI
diffRate NetDev a
_ NetDev a
_ = NetDevRate
forall num. NetDev num
NA
return $ diffRate n0 n1
runNet :: NetDevRef -> String -> [String] -> Monitor String
runNet :: NetDevRef -> String -> DevList -> Monitor String
runNet NetDevRef
nref String
i DevList
argv = do
dev <- IO NetDevRate -> Monitor NetDevRate
forall a. IO a -> Monitor a
io (IO NetDevRate -> Monitor NetDevRate)
-> IO NetDevRate -> Monitor NetDevRate
forall a b. (a -> b) -> a -> b
$ NetDevRef -> String -> IO NetDevRate
parseNet NetDevRef
nref String
i
opts <- io $ parseOptsWith options defaultOpts argv
printNet opts dev
parseNets :: [(NetDevRef, String)] -> IO [NetDevRate]
parseNets :: [(NetDevRef, String)] -> IO [NetDevRate]
parseNets = ((NetDevRef, String) -> IO NetDevRate)
-> [(NetDevRef, String)] -> IO [NetDevRate]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (((NetDevRef, String) -> IO NetDevRate)
-> [(NetDevRef, String)] -> IO [NetDevRate])
-> ((NetDevRef, String) -> IO NetDevRate)
-> [(NetDevRef, String)]
-> IO [NetDevRate]
forall a b. (a -> b) -> a -> b
$ (NetDevRef -> String -> IO NetDevRate)
-> (NetDevRef, String) -> IO NetDevRate
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry NetDevRef -> String -> IO NetDevRate
parseNet
runNets :: [(NetDevRef, String)] -> [String] -> Monitor String
runNets :: [(NetDevRef, String)] -> DevList -> Monitor String
runNets [(NetDevRef, String)]
refs DevList
argv = do
opts <- IO NetOpts -> Monitor NetOpts
forall a. IO a -> Monitor a
io (IO NetOpts -> Monitor NetOpts) -> IO NetOpts -> Monitor NetOpts
forall a b. (a -> b) -> a -> b
$ [OptDescr (NetOpts -> NetOpts)] -> NetOpts -> DevList -> IO NetOpts
forall opts.
[OptDescr (opts -> opts)] -> opts -> DevList -> IO opts
parseOptsWith [OptDescr (NetOpts -> NetOpts)]
options NetOpts
defaultOpts DevList
argv
dev <- io $ parseActive $ filterRefs opts refs
printNet opts dev
where parseActive :: [(NetDevRef, String)] -> IO NetDevRate
parseActive [(NetDevRef, String)]
refs' = ([NetDevRate] -> NetDevRate) -> IO [NetDevRate] -> IO NetDevRate
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [NetDevRate] -> NetDevRate
selectActive ([(NetDevRef, String)] -> IO [NetDevRate]
parseNets [(NetDevRef, String)]
refs')
refInDevList :: NetOpts -> (a, String) -> Bool
refInDevList NetOpts
opts' (a
_, String
refname') = case NetOpts -> Maybe DevList
onlyDevList NetOpts
opts' of
Just DevList
theList -> String
refname' String -> DevList -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` DevList
theList
Maybe DevList
Nothing -> Bool
True
filterRefs :: NetOpts -> [(a, String)] -> [(a, String)]
filterRefs NetOpts
opts' [(a, String)]
refs' = case ((a, String) -> Bool) -> [(a, String)] -> [(a, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (NetOpts -> (a, String) -> Bool
forall {a}. NetOpts -> (a, String) -> Bool
refInDevList NetOpts
opts') [(a, String)]
refs' of
[] -> [(a, String)]
refs'
[(a, String)]
xs -> [(a, String)]
xs
selectActive :: [NetDevRate] -> NetDevRate
selectActive = [NetDevRate] -> NetDevRate
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum
startNet :: String -> [String] -> Int -> (String -> IO ()) -> IO ()
startNet :: String -> DevList -> Int -> (String -> IO ()) -> IO ()
startNet String
i DevList
a Int
r String -> IO ()
cb = do
t0 <- IO UTCTime
getCurrentTime
nref <- newIORef (NA, t0)
_ <- parseNet nref i
runM a netConfig (runNet nref i) r cb
startDynNet :: [String] -> Int -> (String -> IO ()) -> IO ()
startDynNet :: DevList -> Int -> (String -> IO ()) -> IO ()
startDynNet DevList
a Int
r String -> IO ()
cb = do
devs <- IO DevList
MN.existingDevs
refs <- forM devs $ \String
d -> do
t <- IO UTCTime
getCurrentTime
nref <- newIORef (NA, t)
_ <- parseNet nref d
return (nref, d)
runM a netConfig (runNets refs) r cb
byteNetVal :: Float -> NetValue
byteNetVal :: Float -> NetValue
byteNetVal Float
v
| Float
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
1024Float -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
1 = Float -> UnitPerSec -> NetValue
NetValue Float
v UnitPerSec
Bs
| Float
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
1024Float -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
2 = Float -> UnitPerSec -> NetValue
NetValue (Float
vFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
1024Float -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
1) UnitPerSec
KBs
| Float
v Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
1024Float -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
3 = Float -> UnitPerSec -> NetValue
NetValue (Float
vFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
1024Float -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
2) UnitPerSec
MBs
| Bool
otherwise = Float -> UnitPerSec -> NetValue
NetValue (Float
vFloat -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
1024Float -> Float -> Float
forall a. Floating a => a -> a -> a
**Float
3) UnitPerSec
GBs