    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