module System.Taffybar.Widget.Text.NetworkMonitor where

import           Control.Monad
import           Control.Monad.Trans.Class
import qualified Data.Text as T
import           GI.Gtk
import           System.Taffybar.Context
import           System.Taffybar.Hooks
import           System.Taffybar.Information.Network
import           System.Taffybar.Util
import           System.Taffybar.Widget.Generic.ChannelWidget
import           Text.Printf
import           Text.StringTemplate

defaultNetFormat :: String
defaultNetFormat :: String
defaultNetFormat = String
"▼ $inAuto$ ▲ $outAuto$"

showInfo :: String -> Int -> (Double, Double) -> T.Text
showInfo :: String -> Int -> (Double, Double) -> Text
showInfo String
template Int
prec (Double
incomingb, Double
outgoingb) =
  let
    attribs :: [(String, String)]
attribs = [ (String
"inB", Double -> String
forall a. Show a => a -> String
show Double
incomingb)
              , (String
"inKB", Int -> Double -> String
toKB Int
prec Double
incomingb)
              , (String
"inMB", Int -> Double -> String
toMB Int
prec Double
incomingb)
              , (String
"inAuto", Int -> Double -> String
toAuto Int
prec Double
incomingb)
              , (String
"outB", Double -> String
forall a. Show a => a -> String
show Double
outgoingb)
              , (String
"outKB", Int -> Double -> String
toKB Int
prec Double
outgoingb)
              , (String
"outMB", Int -> Double -> String
toMB Int
prec Double
outgoingb)
              , (String
"outAuto", Int -> Double -> String
toAuto Int
prec Double
outgoingb)
              ]
  in
    StringTemplate Text -> Text
forall a. Stringable a => StringTemplate a -> a
render (StringTemplate Text -> Text)
-> (StringTemplate Text -> StringTemplate Text)
-> StringTemplate Text
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> StringTemplate Text -> StringTemplate Text
forall a b.
(ToSElem a, Stringable b) =>
[(String, a)] -> StringTemplate b -> StringTemplate b
setManyAttrib [(String, String)]
attribs (StringTemplate Text -> Text) -> StringTemplate Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> StringTemplate Text
forall a. Stringable a => String -> StringTemplate a
newSTMP String
template

toKB :: Int -> Double -> String
toKB :: Int -> Double -> String
toKB Int
prec = Int -> Double -> String
setDigits Int
prec (Double -> String) -> (Double -> Double) -> Double -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
1024)

toMB :: Int -> Double -> String
toMB :: Int -> Double -> String
toMB Int
prec = Int -> Double -> String
setDigits Int
prec (Double -> String) -> (Double -> Double) -> Double -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
1024 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
1024))

setDigits :: Int -> Double -> String
setDigits :: Int -> Double -> String
setDigits Int
dig = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
format
    where format :: String
format = String
"%." String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
dig String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"f"

toAuto :: Int -> Double -> String
toAuto :: Int -> Double -> String
toAuto Int
prec Double
value = String -> Int -> Double -> String -> String
forall r. PrintfType r => String -> r
printf String
"%.*f%s" Int
p Double
v String
unit
  where value' :: Double
value' = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 Double
value
        mag :: Int
        mag :: Int
mag = if Double
value' Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 then Int
0 else Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
4 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
1024 Double
value'
        v :: Double
v = Double
value' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1024 Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mag
        unit :: String
unit = case Int
mag of
          Int
0 -> String
"B/s"
          Int
1 -> String
"KiB/s"
          Int
2 -> String
"MiB/s"
          Int
3 -> String
"GiB/s"
          Int
4 -> String
"TiB/s"
          Int
_ -> String
"??B/s" -- unreachable
        p :: Int
        p :: Int
p = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
prec Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
10 Double
v

networkMonitorNew :: String -> Maybe [String] -> TaffyIO GI.Gtk.Widget
networkMonitorNew :: String -> Maybe [String] -> TaffyIO Widget
networkMonitorNew String
template Maybe [String]
interfaces = do
  NetworkInfoChan BroadcastChan In [(String, (Rational, Rational))]
chan <- TaffyIO NetworkInfoChan
getNetworkChan
  let filterFn :: String -> Bool
filterFn = (String -> Bool)
-> ([String] -> String -> Bool) -> Maybe [String] -> String -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
True) ((String -> [String] -> Bool) -> [String] -> String -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem) Maybe [String]
interfaces
  Label
label <- IO Label -> ReaderT Context IO Label
forall (m :: * -> *) a. Monad m => m a -> ReaderT Context m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Label -> ReaderT Context IO Label)
-> IO Label -> ReaderT Context IO Label
forall a b. (a -> b) -> a -> b
$ Maybe Text -> IO Label
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text -> m Label
labelNew Maybe Text
forall a. Maybe a
Nothing
  ReaderT Context IO Label -> ReaderT Context IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT Context IO Label -> ReaderT Context IO ())
-> ReaderT Context IO Label -> ReaderT Context IO ()
forall a b. (a -> b) -> a -> b
$ Label
-> BroadcastChan In [(String, (Rational, Rational))]
-> ([(String, (Rational, Rational))] -> IO ())
-> ReaderT Context IO Label
forall (m :: * -> *) w a.
(MonadIO m, IsWidget w) =>
w -> BroadcastChan In a -> (a -> IO ()) -> m w
channelWidgetNew Label
label BroadcastChan In [(String, (Rational, Rational))]
chan (([(String, (Rational, Rational))] -> IO ())
 -> ReaderT Context IO Label)
-> ([(String, (Rational, Rational))] -> IO ())
-> ReaderT Context IO Label
forall a b. (a -> b) -> a -> b
$ \[(String, (Rational, Rational))]
speedInfo ->
    let (Rational
up, Rational
down) = [(Rational, Rational)] -> (Rational, Rational)
sumSpeeds ([(Rational, Rational)] -> (Rational, Rational))
-> [(Rational, Rational)] -> (Rational, Rational)
forall a b. (a -> b) -> a -> b
$ ((String, (Rational, Rational)) -> (Rational, Rational))
-> [(String, (Rational, Rational))] -> [(Rational, Rational)]
forall a b. (a -> b) -> [a] -> [b]
map (String, (Rational, Rational)) -> (Rational, Rational)
forall a b. (a, b) -> b
snd ([(String, (Rational, Rational))] -> [(Rational, Rational)])
-> [(String, (Rational, Rational))] -> [(Rational, Rational)]
forall a b. (a -> b) -> a -> b
$ ((String, (Rational, Rational)) -> Bool)
-> [(String, (Rational, Rational))]
-> [(String, (Rational, Rational))]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> Bool
filterFn (String -> Bool)
-> ((String, (Rational, Rational)) -> String)
-> (String, (Rational, Rational))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, (Rational, Rational)) -> String
forall a b. (a, b) -> a
fst) [(String, (Rational, Rational))]
speedInfo
        labelString :: Text
labelString = String -> Int -> (Double, Double) -> Text
showInfo String
template Int
3 (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
down, Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
up)
    in IO () -> IO ()
postGUIASync (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Label -> Text -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLabel a) =>
a -> Text -> m ()
labelSetMarkup Label
label Text
labelString
  Label -> TaffyIO Widget
forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
toWidget Label
label