    -----------------------------------------------------------------------------
    -- |
    -- Module      : System.Taffybar.Information.Network
    -- Copyright   : (c) José A. Romero L.
    -- License     : BSD3-style (see LICENSE)
    --
    -- Maintainer  : José A. Romero L. <escherdragon@gmail.com>
    -- Stability   : unstable
    -- Portability : unportable
    --
    -- Provides information about network traffic over selected interfaces,
    -- obtained from parsing the @\/proc\/net\/dev@ file using some of the
    -- facilities provided by the "System.Taffybar.Information.StreamInfo" module.
    --
    -----------------------------------------------------------------------------

    module System.Taffybar.Information.Network where

    import           Control.Applicative
    import qualified Control.Concurrent.MVar as MV
    import           Control.Exception (catch, SomeException)
    import           Control.Monad
    import           Control.Monad.IO.Class
    import           Control.Monad.Trans.Maybe (MaybeT(..))
    import           Data.Maybe ( mapMaybe )
    import           Data.Time.Clock
    import           Data.Time.Clock.System
    import           Safe ( atMay, initSafe, readDef )
    import           System.Taffybar.Information.StreamInfo ( getParsedInfo )
    import           System.Taffybar.Util

    import           Prelude

    networkInfoFile :: FilePath
    networkInfoFile :: String
    networkInfoFile = String
    "/proc/net/dev"

    -- | Returns a two-element list containing the current number of bytes received
    -- and transmitted via the given network interface (e.g. \"wlan0\"), according
    -- to the contents of the @\/proc\/dev\/net@ file.
    getNetInfo :: String -> IO (Maybe [Int])
    getNetInfo :: String -> IO (Maybe [Int])
    getNetInfo String
    iface = MaybeT IO [Int] -> IO (Maybe [Int])
    forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
    runMaybeT (MaybeT IO [Int] -> IO (Maybe [Int]))
    -> MaybeT IO [Int] -> IO (Maybe [Int])
    forall a b. (a -> b) -> a -> b
    $ do
      String -> MaybeT IO ()
    isInterfaceUp String
    iface
      IO [Int] -> MaybeT IO [Int]
    forall a. IO a -> MaybeT IO a
    handleFailure (IO [Int] -> MaybeT IO [Int]) -> IO [Int] -> MaybeT IO [Int]
    forall a b. (a -> b) -> a -> b
    $ String -> (String -> [(String, [Int])]) -> String -> IO [Int]
    forall a. String -> (String -> [(String, [a])]) -> String -> IO [a]
    getParsedInfo String
    networkInfoFile String -> [(String, [Int])]
    parseDevNet' String
    iface

    parseDevNet' :: String -> [(String, [Int])]
    parseDevNet' :: String -> [(String, [Int])]
    parseDevNet' String
    input =
      ((String, (Int, Int)) -> (String, [Int]))
    -> [(String, (Int, Int))] -> [(String, [Int])]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, (Int, Int)) -> (String, [Int])
    forall {a} {a}. (a, (a, a)) -> (a, [a])
    makeList ([(String, (Int, Int))] -> [(String, [Int])])
    -> [(String, (Int, Int))] -> [(String, [Int])]
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, (Int, Int))]
    parseDevNet String
    input
      where makeList :: (a, (a, a)) -> (a, [a])
    makeList (a
    a, (a
    u, a
    d)) = (a
    a, [a
    u, a
    d])

    parseDevNet :: String -> [(String, (Int, Int))]
    parseDevNet :: String -> [(String, (Int, Int))]
    parseDevNet = (String -> Maybe (String, (Int, Int)))
    -> [String] -> [(String, (Int, Int))]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe ([String] -> Maybe (String, (Int, Int))
    getDeviceUpDown ([String] -> Maybe (String, (Int, Int)))
    -> (String -> [String]) -> String -> Maybe (String, (Int, Int))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    words) ([String] -> [(String, (Int, Int))])
    -> (String -> [String]) -> String -> [(String, (Int, Int))]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [String] -> [String]
    forall a. Int -> [a] -> [a]
    drop Int
    2 ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines

    getDeviceUpDown :: [String] -> Maybe (String, (Int, Int))
    getDeviceUpDown :: [String] -> Maybe (String, (Int, Int))
    getDeviceUpDown [String]
    s = do
      String
    dev <- String -> String
    forall a. [a] -> [a]
    initSafe (String -> String) -> Maybe String -> Maybe String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [String]
    s [String] -> Int -> Maybe String
    forall a. [a] -> Int -> Maybe a
    `atMay` Int
    0
      Int
    down <- Int -> String -> Int
    forall a. Read a => a -> String -> a
    readDef (-Int
    1) (String -> Int) -> Maybe String -> Maybe Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [String]
    s [String] -> Int -> Maybe String
    forall a. [a] -> Int -> Maybe a
    `atMay` Int
    1
      Int
    up <- Int -> String -> Int
    forall a. Read a => a -> String -> a
    readDef (-Int
    1) (String -> Int) -> Maybe String -> Maybe Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [String]
    s [String] -> Int -> Maybe String
    forall a. [a] -> Int -> Maybe a
    `atMay` Int
    out
      String
    dev String -> Maybe (String, (Int, Int)) -> Maybe (String, (Int, Int))
    forall a b. a -> b -> b
    `seq` Int
    down Int -> Maybe (String, (Int, Int)) -> Maybe (String, (Int, Int))
    forall a b. a -> b -> b
    `seq` Int
    up Int -> Maybe (String, (Int, Int)) -> Maybe (String, (Int, Int))
    forall a b. a -> b -> b
    `seq` (String, (Int, Int)) -> Maybe (String, (Int, Int))
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    dev, (Int
    down, Int
    up))
      where
        out :: Int
    out = [String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    s Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    8

    -- Nothing if interface does not exist or is down
    isInterfaceUp :: String -> MaybeT IO ()
    isInterfaceUp :: String -> MaybeT IO ()
    isInterfaceUp String
    iface = do
      String
    state <- IO String -> MaybeT IO String
    forall a. IO a -> MaybeT IO a
    handleFailure (IO String -> MaybeT IO String) -> IO String -> MaybeT IO String
    forall a b. (a -> b) -> a -> b
    $ String -> IO String
    readFile (String -> IO String) -> String -> IO String
    forall a b. (a -> b) -> a -> b
    $ String
    "/sys/class/net/" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    iface String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "/operstate"
      case String
    state of
        Char
    'u' : String
    _ -> () -> MaybeT IO ()
    forall a. a -> MaybeT IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        String
    _ -> MaybeT IO ()
    forall a. MaybeT IO a
    forall (m :: * -> *) a. MonadPlus m => m a
    mzero

    handleFailure :: IO a -> MaybeT IO a
    handleFailure :: forall a. IO a -> MaybeT IO a
    handleFailure IO a
    action = IO (Maybe a) -> MaybeT IO a
    forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
    MaybeT (IO (Maybe a) -> MaybeT IO a) -> IO (Maybe a) -> MaybeT IO a
    forall a b. (a -> b) -> a -> b
    $ IO (Maybe a) -> (SomeException -> IO (Maybe a)) -> IO (Maybe a)
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    catch (a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> Maybe a) -> IO a -> IO (Maybe a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO a
    action) SomeException -> IO (Maybe a)
    forall a. SomeException -> IO (Maybe a)
    eToNothing
      where
        eToNothing :: SomeException -> IO (Maybe a)
        eToNothing :: forall a. SomeException -> IO (Maybe a)
    eToNothing SomeException
    _ = Maybe a -> IO (Maybe a)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe a
    forall a. Maybe a
    Nothing

    getDeviceSamples :: IO (Maybe [TxSample])
    getDeviceSamples :: IO (Maybe [TxSample])
    getDeviceSamples = MaybeT IO [TxSample] -> IO (Maybe [TxSample])
    forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
    runMaybeT (MaybeT IO [TxSample] -> IO (Maybe [TxSample]))
    -> MaybeT IO [TxSample] -> IO (Maybe [TxSample])
    forall a b. (a -> b) -> a -> b
    $ IO [TxSample] -> MaybeT IO [TxSample]
    forall a. IO a -> MaybeT IO a
    handleFailure (IO [TxSample] -> MaybeT IO [TxSample])
    -> IO [TxSample] -> MaybeT IO [TxSample]
    forall a b. (a -> b) -> a -> b
    $ do
      String
    contents <- String -> IO String
    readFile String
    networkInfoFile
      String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    contents Int -> IO () -> IO ()
    forall a b. a -> b -> b
    `seq` () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      SystemTime
    time <- IO SystemTime -> IO SystemTime
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO SystemTime
    getSystemTime
      let mkSample :: (String, (Int, Int)) -> TxSample
    mkSample (String
    device, (Int
    up, Int
    down)) =
              TxSample { sampleUp :: Int
    sampleUp = Int
    up
                       , sampleDown :: Int
    sampleDown = Int
    down
                       , sampleTime :: SystemTime
    sampleTime = SystemTime
    time
                       , sampleDevice :: String
    sampleDevice = String
    device
                       }
      [TxSample] -> IO [TxSample]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([TxSample] -> IO [TxSample]) -> [TxSample] -> IO [TxSample]
    forall a b. (a -> b) -> a -> b
    $ ((String, (Int, Int)) -> TxSample)
    -> [(String, (Int, Int))] -> [TxSample]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, (Int, Int)) -> TxSample
    mkSample ([(String, (Int, Int))] -> [TxSample])
    -> [(String, (Int, Int))] -> [TxSample]
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, (Int, Int))]
    parseDevNet String
    contents

    data TxSample = TxSample
      { TxSample -> Int
    sampleUp :: Int
      , TxSample -> Int
    sampleDown :: Int
      , TxSample -> SystemTime
    sampleTime :: SystemTime
      , TxSample -> String
    sampleDevice :: String
      } deriving (Int -> TxSample -> String -> String
    [TxSample] -> String -> String
    TxSample -> String
    (Int -> TxSample -> String -> String)
    -> (TxSample -> String)
    -> ([TxSample] -> String -> String)
    -> Show TxSample
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> TxSample -> String -> String
    showsPrec :: Int -> TxSample -> String -> String
    $cshow :: TxSample -> String
    show :: TxSample -> String
    $cshowList :: [TxSample] -> String -> String
    showList :: [TxSample] -> String -> String
    Show, TxSample -> TxSample -> Bool
    (TxSample -> TxSample -> Bool)
    -> (TxSample -> TxSample -> Bool) -> Eq TxSample
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: TxSample -> TxSample -> Bool
    == :: TxSample -> TxSample -> Bool
    $c/= :: TxSample -> TxSample -> Bool
    /= :: TxSample -> TxSample -> Bool
    Eq)

    monitorNetworkInterfaces
      :: RealFrac a1
      => a1 -> ([(String, (Rational, Rational))] -> IO ()) -> IO ()
    monitorNetworkInterfaces :: forall a1.
    RealFrac a1 =>
    a1 -> ([(String, (Rational, Rational))] -> IO ()) -> IO ()
    monitorNetworkInterfaces a1
    interval [(String, (Rational, Rational))] -> IO ()
    onUpdate = IO ThreadId -> IO ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
      MVar [(String, (TxSample, TxSample))]
    samplesVar <- [(String, (TxSample, TxSample))]
    -> IO (MVar [(String, (TxSample, TxSample))])
    forall a. a -> IO (MVar a)
    MV.newMVar []
      let sampleToSpeeds :: (a, (TxSample, TxSample)) -> (a, (Rational, Rational))
    sampleToSpeeds (a
    device, (TxSample
    s1, TxSample
    s2)) = (a
    device, TxSample -> TxSample -> (Rational, Rational)
    getSpeed TxSample
    s1 TxSample
    s2)
          doOnUpdate :: [(String, (TxSample, TxSample))]
    -> IO [(String, (TxSample, TxSample))]
    doOnUpdate [(String, (TxSample, TxSample))]
    samples = do
            let speedInfo :: [(String, (Rational, Rational))]
    speedInfo = ((String, (TxSample, TxSample)) -> (String, (Rational, Rational)))
    -> [(String, (TxSample, TxSample))]
    -> [(String, (Rational, Rational))]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, (TxSample, TxSample)) -> (String, (Rational, Rational))
    forall {a}. (a, (TxSample, TxSample)) -> (a, (Rational, Rational))
    sampleToSpeeds [(String, (TxSample, TxSample))]
    samples
            [(String, (Rational, Rational))] -> IO ()
    onUpdate [(String, (Rational, Rational))]
    speedInfo
            [(String, (TxSample, TxSample))]
    -> IO [(String, (TxSample, TxSample))]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(String, (TxSample, TxSample))]
    samples
          doUpdate :: IO ()
    doUpdate = MVar [(String, (TxSample, TxSample))]
    -> ([(String, (TxSample, TxSample))]
        -> IO [(String, (TxSample, TxSample))])
    -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    MV.modifyMVar_ MVar [(String, (TxSample, TxSample))]
    samplesVar ((IO [(String, (TxSample, TxSample))]
    -> ([(String, (TxSample, TxSample))]
        -> IO [(String, (TxSample, TxSample))])
    -> IO [(String, (TxSample, TxSample))]
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [(String, (TxSample, TxSample))]
    -> IO [(String, (TxSample, TxSample))]
    doOnUpdate) (IO [(String, (TxSample, TxSample))]
     -> IO [(String, (TxSample, TxSample))])
    -> ([(String, (TxSample, TxSample))]
        -> IO [(String, (TxSample, TxSample))])
    -> [(String, (TxSample, TxSample))]
    -> IO [(String, (TxSample, TxSample))]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(String, (TxSample, TxSample))]
    -> IO [(String, (TxSample, TxSample))]
    updateSamples)
      a1 -> IO () -> IO ThreadId
    forall (m :: * -> *) d.
    (MonadIO m, RealFrac d) =>
    d -> IO () -> m ThreadId
    foreverWithDelay a1
    interval IO ()
    doUpdate

    updateSamples ::
      [(String, (TxSample, TxSample))] ->
      IO [(String, (TxSample, TxSample))]
    updateSamples :: [(String, (TxSample, TxSample))]
    -> IO [(String, (TxSample, TxSample))]
    updateSamples [(String, (TxSample, TxSample))]
    currentSamples = do
      let getLast :: TxSample -> TxSample
    getLast sample :: TxSample
    sample@TxSample { sampleDevice :: TxSample -> String
    sampleDevice = String
    device } =
            TxSample
    -> ((TxSample, TxSample) -> TxSample)
    -> Maybe (TxSample, TxSample)
    -> TxSample
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe TxSample
    sample (TxSample, TxSample) -> TxSample
    forall a b. (a, b) -> a
    fst (Maybe (TxSample, TxSample) -> TxSample)
    -> Maybe (TxSample, TxSample) -> TxSample
    forall a b. (a -> b) -> a -> b
    $ String
    -> [(String, (TxSample, TxSample))] -> Maybe (TxSample, TxSample)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    device [(String, (TxSample, TxSample))]
    currentSamples
          getSamplePair :: TxSample -> (String, (TxSample, TxSample))
    getSamplePair sample :: TxSample
    sample@TxSample { sampleDevice :: TxSample -> String
    sampleDevice = String
    device } =
            let lastSample :: TxSample
    lastSample = TxSample -> TxSample
    getLast TxSample
    sample
            in TxSample
    lastSample TxSample
    -> (String, (TxSample, TxSample)) -> (String, (TxSample, TxSample))
    forall a b. a -> b -> b
    `seq` (String
    device, (TxSample
    sample, TxSample
    lastSample))
      [(String, (TxSample, TxSample))]
    -> ([TxSample] -> [(String, (TxSample, TxSample))])
    -> Maybe [TxSample]
    -> [(String, (TxSample, TxSample))]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [(String, (TxSample, TxSample))]
    currentSamples ((TxSample -> (String, (TxSample, TxSample)))
    -> [TxSample] -> [(String, (TxSample, TxSample))]
    forall a b. (a -> b) -> [a] -> [b]
    map TxSample -> (String, (TxSample, TxSample))
    getSamplePair) (Maybe [TxSample] -> [(String, (TxSample, TxSample))])
    -> IO (Maybe [TxSample]) -> IO [(String, (TxSample, TxSample))]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO (Maybe [TxSample])
    getDeviceSamples

    getSpeed :: TxSample -> TxSample -> (Rational, Rational)
    getSpeed :: TxSample -> TxSample -> (Rational, Rational)
    getSpeed TxSample { sampleUp :: TxSample -> Int
    sampleUp = Int
    thisUp
                      , sampleDown :: TxSample -> Int
    sampleDown = Int
    thisDown
                      , sampleTime :: TxSample -> SystemTime
    sampleTime = SystemTime
    thisTime
                      }
             TxSample { sampleUp :: TxSample -> Int
    sampleUp = Int
    lastUp
                      , sampleDown :: TxSample -> Int
    sampleDown = Int
    lastDown
                      , sampleTime :: TxSample -> SystemTime
    sampleTime = SystemTime
    lastTime
                      } =
            let intervalDiffTime :: NominalDiffTime
    intervalDiffTime =
                  UTCTime -> UTCTime -> NominalDiffTime
    diffUTCTime
                  (SystemTime -> UTCTime
    systemToUTCTime SystemTime
    thisTime)
                  (SystemTime -> UTCTime
    systemToUTCTime SystemTime
    lastTime)
                intervalRatio :: Rational
    intervalRatio =
                  if NominalDiffTime
    intervalDiffTime NominalDiffTime -> NominalDiffTime -> Bool
    forall a. Eq a => a -> a -> Bool
    == NominalDiffTime
    0
                  then Rational
    0
                  else NominalDiffTime -> Rational
    forall a. Real a => a -> Rational
    toRational (NominalDiffTime -> Rational) -> NominalDiffTime -> Rational
    forall a b. (a -> b) -> a -> b
    $ NominalDiffTime
    1 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Fractional a => a -> a -> a
    / NominalDiffTime
    intervalDiffTime
            in ( Int -> Rational
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int
    thisDown Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    lastDown) Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Rational
    intervalRatio
               , Int -> Rational
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int
    thisUp Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    lastUp) Rational -> Rational -> Rational
    forall a. Num a => a -> a -> a
    * Rational
    intervalRatio
               )

    sumSpeeds :: [(Rational, Rational)] -> (Rational, Rational)
    sumSpeeds :: [(Rational, Rational)] -> (Rational, Rational)
    sumSpeeds = ((Rational, Rational)
     -> (Rational, Rational) -> (Rational, Rational))
    -> [(Rational, Rational)] -> (Rational, Rational)
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 (Rational, Rational)
    -> (Rational, Rational) -> (Rational, Rational)
    forall {a} {b}. (Num a, Num b) => (a, b) -> (a, b) -> (a, b)
    sumOne
      where
        sumOne :: (a, b) -> (a, b) -> (a, b)
    sumOne (a
    d1, b
    u1) (a
    d2, b
    u2) = (a
    d1 a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    d2, b
    u1 b -> b -> b
    forall a. Num a => a -> a -> a
    + b
    u2)