-----------------------------------------------------------------------------
-- |
-- 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