    -----------------------------------------------------------------------------
    -- |
    -- Module      : System.Taffybar.Widget.NetworkGraph
    -- Copyright   : (c) Ivan A. Malison
    -- License     : BSD3-style (see LICENSE)
    --
    -- Maintainer  : Ivan A. Malison
    -- Stability   : unstable
    -- Portability : unportable
    --
    -- This module provides a channel based network graph widget.
    -----------------------------------------------------------------------------

    module System.Taffybar.Widget.NetworkGraph where

    import Data.Default (Default(..))
    import Data.Foldable (for_)
    import qualified GI.Gtk
    import GI.Gtk.Objects.Widget (widgetSetTooltipMarkup)
    import System.Taffybar.Context
    import System.Taffybar.Hooks
    import System.Taffybar.Information.Network
    import System.Taffybar.Util (postGUIASync)
    import System.Taffybar.Widget.Generic.ChannelGraph
    import System.Taffybar.Widget.Generic.ChannelWidget
    import System.Taffybar.Widget.Generic.Graph
    import System.Taffybar.Widget.Text.NetworkMonitor

    -- | 'NetworkGraphConfig' configures the network graph widget.
    data NetworkGraphConfig = NetworkGraphConfig
      { NetworkGraphConfig -> GraphConfig
    networkGraphGraphConfig :: GraphConfig -- ^ The configuration of the graph itself.
      -- | A tooltip format string, together with the precision that should be used
      -- for numbers in the string.
      , NetworkGraphConfig -> Maybe (String, Int)
    networkGraphTooltipFormat :: Maybe (String, Int)
      -- | A function to scale the y axis of the network config. The default is
      -- `logBase $ 2 ** 32`.
      , NetworkGraphConfig -> Double -> Double
    networkGraphScale :: Double -> Double
      -- | A filter function that determines whether a given interface will be
      -- included in the network stats.
      , NetworkGraphConfig -> String -> Bool
    interfacesFilter :: String -> Bool
      }

    -- | Default configuration paramters for the network graph.
    defaultNetworkGraphConfig :: NetworkGraphConfig
    defaultNetworkGraphConfig :: NetworkGraphConfig
    defaultNetworkGraphConfig = NetworkGraphConfig
      { networkGraphGraphConfig :: GraphConfig
    networkGraphGraphConfig = GraphConfig
    forall a. Default a => a
    def
      , networkGraphTooltipFormat :: Maybe (String, Int)
    networkGraphTooltipFormat = (String, Int) -> Maybe (String, Int)
    forall a. a -> Maybe a
    Just (String
    defaultNetFormat, Int
    3)
      , networkGraphScale :: Double -> Double
    networkGraphScale = Double -> Double -> Double
    forall a. Floating a => a -> a -> a
    logBase (Double -> Double -> Double) -> Double -> Double -> Double
    forall a b. (a -> b) -> a -> b
    $ Double
    2 Double -> Double -> Double
    forall a. Floating a => a -> a -> a
    ** Double
    32
      , interfacesFilter :: String -> Bool
    interfacesFilter = Bool -> String -> Bool
    forall a b. a -> b -> a
    const Bool
    True
      }

    instance Default NetworkGraphConfig where
      def :: NetworkGraphConfig
    def = NetworkGraphConfig
    defaultNetworkGraphConfig

    -- | 'networkGraphNew' instantiates a network graph widget from a 'GraphConfig'
    -- and a list of interfaces.
    networkGraphNew :: GraphConfig -> Maybe [String] -> TaffyIO GI.Gtk.Widget
    networkGraphNew :: GraphConfig -> Maybe [String] -> TaffyIO Widget
    networkGraphNew GraphConfig
    config Maybe [String]
    interfaces =
      NetworkGraphConfig -> TaffyIO Widget
    networkGraphNewWith NetworkGraphConfig
    forall a. Default a => a
    def
                            { networkGraphGraphConfig :: GraphConfig
    networkGraphGraphConfig = GraphConfig
    config
                            , interfacesFilter :: String -> Bool
    interfacesFilter = (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
                            }

    -- | 'networkGraphNewWith' instantiates a network graph widget from a
    -- 'NetworkGraphConfig'.
    networkGraphNewWith :: NetworkGraphConfig -> TaffyIO GI.Gtk.Widget
    networkGraphNewWith :: NetworkGraphConfig -> TaffyIO Widget
    networkGraphNewWith NetworkGraphConfig
    config = do
      NetworkInfoChan BroadcastChan In [(String, (Rational, Rational))]
    chan <- TaffyIO NetworkInfoChan
    getNetworkChan
      let getUpDown :: [(String, (Rational, Rational))] -> (Rational, Rational)
    getUpDown = [(Rational, Rational)] -> (Rational, Rational)
    sumSpeeds ([(Rational, Rational)] -> (Rational, Rational))
    -> ([(String, (Rational, Rational))] -> [(Rational, Rational)])
    -> [(String, (Rational, Rational))]
    -> (Rational, Rational)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((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))]
        -> [(String, (Rational, Rational))])
    -> [(String, (Rational, Rational))]
    -> [(Rational, Rational)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((String, (Rational, Rational)) -> Bool)
    -> [(String, (Rational, Rational))]
    -> [(String, (Rational, Rational))]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (NetworkGraphConfig -> String -> Bool
    interfacesFilter NetworkGraphConfig
    config (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)
          toSample :: (Rational, Rational) -> [Double]
    toSample (Rational
    up, Rational
    down) = (Rational -> Double) -> [Rational] -> [Double]
    forall a b. (a -> b) -> [a] -> [b]
    map (NetworkGraphConfig -> Double -> Double
    networkGraphScale NetworkGraphConfig
    config (Double -> Double) -> (Rational -> Double) -> Rational -> Double
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Rational -> Double
    forall a. Fractional a => Rational -> a
    fromRational) [Rational
    up, Rational
    down]
          sampleBuilder :: [(String, (Rational, Rational))] -> IO [Double]
    sampleBuilder = [Double] -> IO [Double]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Double] -> IO [Double])
    -> ([(String, (Rational, Rational))] -> [Double])
    -> [(String, (Rational, Rational))]
    -> IO [Double]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Rational, Rational) -> [Double]
    toSample ((Rational, Rational) -> [Double])
    -> ([(String, (Rational, Rational))] -> (Rational, Rational))
    -> [(String, (Rational, Rational))]
    -> [Double]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(String, (Rational, Rational))] -> (Rational, Rational)
    getUpDown
      Widget
    widget <- GraphConfig
    -> BroadcastChan In [(String, (Rational, Rational))]
    -> ([(String, (Rational, Rational))] -> IO [Double])
    -> TaffyIO Widget
    forall (m :: * -> *) a.
    MonadIO m =>
    GraphConfig -> BroadcastChan In a -> (a -> IO [Double]) -> m Widget
    channelGraphNew (NetworkGraphConfig -> GraphConfig
    networkGraphGraphConfig NetworkGraphConfig
    config) BroadcastChan In [(String, (Rational, Rational))]
    chan [(String, (Rational, Rational))] -> IO [Double]
    sampleBuilder
      Maybe (String, Int)
    -> ((String, Int) -> TaffyIO Widget) -> ReaderT Context IO ()
    forall (t :: * -> *) (f :: * -> *) a b.
    (Foldable t, Applicative f) =>
    t a -> (a -> f b) -> f ()
    for_ (NetworkGraphConfig -> Maybe (String, Int)
    networkGraphTooltipFormat NetworkGraphConfig
    config) (((String, Int) -> TaffyIO Widget) -> ReaderT Context IO ())
    -> ((String, Int) -> TaffyIO Widget) -> ReaderT Context IO ()
    forall a b. (a -> b) -> a -> b
    $ \(String
    format, Int
    precision) ->
        Widget
    -> BroadcastChan In [(String, (Rational, Rational))]
    -> ([(String, (Rational, Rational))] -> IO ())
    -> TaffyIO Widget
    forall (m :: * -> *) w a.
    (MonadIO m, IsWidget w) =>
    w -> BroadcastChan In a -> (a -> IO ()) -> m w
    channelWidgetNew Widget
    widget BroadcastChan In [(String, (Rational, Rational))]
    chan (([(String, (Rational, Rational))] -> IO ()) -> TaffyIO Widget)
    -> ([(String, (Rational, Rational))] -> IO ()) -> TaffyIO Widget
    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))]
    speedInfo
              tooltip :: Text
    tooltip = String -> Int -> (Double, Double) -> Text
    showInfo String
    format Int
    precision (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
    $ Widget -> Maybe Text -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> Maybe Text -> m ()
    widgetSetTooltipMarkup Widget
    widget (Maybe Text -> IO ()) -> Maybe Text -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Text -> Maybe Text
    forall a. a -> Maybe a
    Just Text
    tooltip
      Widget -> TaffyIO Widget
    forall a. a -> ReaderT Context IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Widget
    widget