    -----------------------------------------------------------------------------
    -- |
    -- 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 :: FilePath
    networkInfoFile = "/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 :: FilePath -> IO (Maybe [Int])
    getNetInfo iface :: FilePath
    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
      FilePath -> MaybeT IO ()
    isInterfaceUp FilePath
    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
    $ FilePath
    -> (FilePath -> [(FilePath, [Int])]) -> FilePath -> IO [Int]
    forall a.
    FilePath -> (FilePath -> [(FilePath, [a])]) -> FilePath -> IO [a]
    getParsedInfo FilePath
    networkInfoFile FilePath -> [(FilePath, [Int])]
    parseDevNet' FilePath
    iface

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

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

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

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

    handleFailure :: IO a -> MaybeT IO a
    handleFailure :: IO a -> MaybeT IO a
    handleFailure action :: 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 :: SomeException -> IO (Maybe a)
    eToNothing _ = Maybe a -> IO (Maybe 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
      FilePath
    contents <- FilePath -> IO FilePath
    readFile FilePath
    networkInfoFile
      FilePath -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length FilePath
    contents Int -> IO () -> IO ()
    forall a b. a -> b -> b
    `seq` () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      SystemTime
    time <- IO SystemTime -> IO SystemTime
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO SystemTime
    getSystemTime
      let mkSample :: (FilePath, (Int, Int)) -> TxSample
    mkSample (device :: FilePath
    device, (up :: Int
    up, down :: Int
    down)) =
              TxSample :: Int -> Int -> SystemTime -> FilePath -> TxSample
    TxSample { sampleUp :: Int
    sampleUp = Int
    up
                       , sampleDown :: Int
    sampleDown = Int
    down
                       , sampleTime :: SystemTime
    sampleTime = SystemTime
    time
                       , sampleDevice :: FilePath
    sampleDevice = FilePath
    device
                       }
      [TxSample] -> IO [TxSample]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([TxSample] -> IO [TxSample]) -> [TxSample] -> IO [TxSample]
    forall a b. (a -> b) -> a -> b
    $ ((FilePath, (Int, Int)) -> TxSample)
    -> [(FilePath, (Int, Int))] -> [TxSample]
    forall a b. (a -> b) -> [a] -> [b]
    map (FilePath, (Int, Int)) -> TxSample
    mkSample ([(FilePath, (Int, Int))] -> [TxSample])
    -> [(FilePath, (Int, Int))] -> [TxSample]
    forall a b. (a -> b) -> a -> b
    $ FilePath -> [(FilePath, (Int, Int))]
    parseDevNet FilePath
    contents

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

    monitorNetworkInterfaces
      :: RealFrac a1
      => a1 -> ([(String, (Rational, Rational))] -> IO ()) -> IO ()
    monitorNetworkInterfaces :: a1 -> ([(FilePath, (Rational, Rational))] -> IO ()) -> IO ()
    monitorNetworkInterfaces interval :: a1
    interval onUpdate :: [(FilePath, (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 [(FilePath, (TxSample, TxSample))]
    samplesVar <- [(FilePath, (TxSample, TxSample))]
    -> IO (MVar [(FilePath, (TxSample, TxSample))])
    forall a. a -> IO (MVar a)
    MV.newMVar []
      let sampleToSpeeds :: (a, (TxSample, TxSample)) -> (a, (Rational, Rational))
    sampleToSpeeds (device :: a
    device, (s1 :: TxSample
    s1, s2 :: TxSample
    s2)) = (a
    device, TxSample -> TxSample -> (Rational, Rational)
    getSpeed TxSample
    s1 TxSample
    s2)
          doOnUpdate :: [(FilePath, (TxSample, TxSample))]
    -> IO [(FilePath, (TxSample, TxSample))]
    doOnUpdate samples :: [(FilePath, (TxSample, TxSample))]
    samples = do
            let speedInfo :: [(FilePath, (Rational, Rational))]
    speedInfo = ((FilePath, (TxSample, TxSample))
     -> (FilePath, (Rational, Rational)))
    -> [(FilePath, (TxSample, TxSample))]
    -> [(FilePath, (Rational, Rational))]
    forall a b. (a -> b) -> [a] -> [b]
    map (FilePath, (TxSample, TxSample))
    -> (FilePath, (Rational, Rational))
    forall a. (a, (TxSample, TxSample)) -> (a, (Rational, Rational))
    sampleToSpeeds [(FilePath, (TxSample, TxSample))]
    samples
            [(FilePath, (Rational, Rational))] -> IO ()
    onUpdate [(FilePath, (Rational, Rational))]
    speedInfo
            [(FilePath, (TxSample, TxSample))]
    -> IO [(FilePath, (TxSample, TxSample))]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [(FilePath, (TxSample, TxSample))]
    samples
          doUpdate :: IO ()
    doUpdate = MVar [(FilePath, (TxSample, TxSample))]
    -> ([(FilePath, (TxSample, TxSample))]
        -> IO [(FilePath, (TxSample, TxSample))])
    -> IO ()
    forall a. MVar a -> (a -> IO a) -> IO ()
    MV.modifyMVar_ MVar [(FilePath, (TxSample, TxSample))]
    samplesVar ((IO [(FilePath, (TxSample, TxSample))]
    -> ([(FilePath, (TxSample, TxSample))]
        -> IO [(FilePath, (TxSample, TxSample))])
    -> IO [(FilePath, (TxSample, TxSample))]
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [(FilePath, (TxSample, TxSample))]
    -> IO [(FilePath, (TxSample, TxSample))]
    doOnUpdate) (IO [(FilePath, (TxSample, TxSample))]
     -> IO [(FilePath, (TxSample, TxSample))])
    -> ([(FilePath, (TxSample, TxSample))]
        -> IO [(FilePath, (TxSample, TxSample))])
    -> [(FilePath, (TxSample, TxSample))]
    -> IO [(FilePath, (TxSample, TxSample))]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(FilePath, (TxSample, TxSample))]
    -> IO [(FilePath, (TxSample, TxSample))]
    updateSamples)
      a1 -> IO () -> IO ThreadId
    forall d a. RealFrac d => d -> IO a -> IO ThreadId
    foreverWithDelay a1
    interval IO ()
    doUpdate

    updateSamples ::
      [(String, (TxSample, TxSample))] ->
      IO [(String, (TxSample, TxSample))]
    updateSamples :: [(FilePath, (TxSample, TxSample))]
    -> IO [(FilePath, (TxSample, TxSample))]
    updateSamples currentSamples :: [(FilePath, (TxSample, TxSample))]
    currentSamples = do
      let getLast :: TxSample -> TxSample
    getLast sample :: TxSample
    sample@TxSample { sampleDevice :: TxSample -> FilePath
    sampleDevice = FilePath
    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
    $ FilePath
    -> [(FilePath, (TxSample, TxSample))] -> Maybe (TxSample, TxSample)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup FilePath
    device [(FilePath, (TxSample, TxSample))]
    currentSamples
          getSamplePair :: TxSample -> (FilePath, (TxSample, TxSample))
    getSamplePair sample :: TxSample
    sample@TxSample { sampleDevice :: TxSample -> FilePath
    sampleDevice = FilePath
    device } =
            let lastSample :: TxSample
    lastSample = TxSample -> TxSample
    getLast TxSample
    sample
            in TxSample
    lastSample TxSample
    -> (FilePath, (TxSample, TxSample))
    -> (FilePath, (TxSample, TxSample))
    forall a b. a -> b -> b
    `seq` (FilePath
    device, (TxSample
    sample, TxSample
    lastSample))
      [(FilePath, (TxSample, TxSample))]
    -> ([TxSample] -> [(FilePath, (TxSample, TxSample))])
    -> Maybe [TxSample]
    -> [(FilePath, (TxSample, TxSample))]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [(FilePath, (TxSample, TxSample))]
    currentSamples ((TxSample -> (FilePath, (TxSample, TxSample)))
    -> [TxSample] -> [(FilePath, (TxSample, TxSample))]
    forall a b. (a -> b) -> [a] -> [b]
    map TxSample -> (FilePath, (TxSample, TxSample))
    getSamplePair) (Maybe [TxSample] -> [(FilePath, (TxSample, TxSample))])
    -> IO (Maybe [TxSample]) -> IO [(FilePath, (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
    == 0
                  then 0
                  else NominalDiffTime -> Rational
    forall a. Real a => a -> Rational
    toRational (NominalDiffTime -> Rational) -> NominalDiffTime -> Rational
    forall a b. (a -> b) -> a -> b
    $ 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 (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 (d1 :: a
    d1, u1 :: b
    u1) (d2 :: a
    d2, u2 :: 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)