content: -----------------------------------------------------------------------------
  -- |
  -- 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 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
  
  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 iface = runMaybeT $ do
    isInterfaceUp iface
    handleFailure $ getParsedInfo networkInfoFile parseDevNet' iface
  
  parseDevNet' :: String -> [(String, [Int])]
  parseDevNet' input =
    map makeList $ parseDevNet input
    where makeList (a, (u, d)) = (a, [u, d])
  
  parseDevNet :: String -> [(String, (Int, Int))]
  parseDevNet = mapMaybe (getDeviceUpDown . words) . drop 2 . lines
  
  getDeviceUpDown :: [String] -> Maybe (String, (Int, Int))
  getDeviceUpDown s = do
    dev <- initSafe <$> s `atMay` 0
    down <- readDef (-1) <$> s `atMay` 1
    up <- readDef (-1) <$> s `atMay` out
    dev `seq` down `seq` up `seq` return (dev, (down, up))
    where
      out = length s - 8
  
  -- Nothing if interface does not exist or is down
  isInterfaceUp :: String -> MaybeT IO ()
  isInterfaceUp iface = do
    state <- handleFailure $ readFile $ "/sys/class/net/" ++ iface ++ "/operstate"
    case state of
      'u' : _ -> return ()
      _ -> mzero
  
  handleFailure :: IO a -> MaybeT IO a
  handleFailure action = MaybeT $ catch (Just <$> action) eToNothing
    where
      eToNothing :: SomeException -> IO (Maybe a)
      eToNothing _ = pure Nothing
  
  getDeviceSamples :: IO (Maybe [TxSample])
  getDeviceSamples = runMaybeT $ handleFailure $ do
    contents <- readFile networkInfoFile
    length contents `seq` return ()
    time <- liftIO getSystemTime
    let mkSample (device, (up, down)) =
            TxSample { sampleUp = up
                     , sampleDown = down
                     , sampleTime = time
                     , sampleDevice = device
                     }
    return $ map mkSample $ parseDevNet contents
  
  data TxSample = TxSample
    { sampleUp :: Int
    , sampleDown :: Int
    , sampleTime :: SystemTime
    , sampleDevice :: String
    } deriving (Show, Eq)
  
  monitorNetworkInterfaces
    :: RealFrac a1
    => a1 -> ([(String, (Rational, Rational))] -> IO ()) -> IO ()
  monitorNetworkInterfaces interval onUpdate = void $ do
    samplesVar <- MV.newMVar []
    let sampleToSpeeds (device, (s1, s2)) = (device, getSpeed s1 s2)
        doOnUpdate samples = do
          let speedInfo = map sampleToSpeeds samples
          onUpdate speedInfo
          return samples
        doUpdate = MV.modifyMVar_ samplesVar (updateSamples >=> doOnUpdate)
    foreverWithDelay interval doUpdate
  
  updateSamples ::
    [(String, (TxSample, TxSample))] ->
    IO [(String, (TxSample, TxSample))]
  updateSamples currentSamples = do
    let getLast sample@TxSample { sampleDevice = device } =
          maybe sample fst $ lookup device currentSamples
        getSamplePair sample@TxSample { sampleDevice = device } =
          let lastSample = getLast sample
          in lastSample `seq` (device, (sample, lastSample))
    maybe currentSamples (map getSamplePair) <$> getDeviceSamples
  
  getSpeed :: TxSample -> TxSample -> (Rational, Rational)
  getSpeed TxSample { sampleUp = thisUp
                    , sampleDown = thisDown
                    , sampleTime = thisTime
                    }
           TxSample { sampleUp = lastUp
                    , sampleDown = lastDown
                    , sampleTime = lastTime
                    } =
          let intervalDiffTime =
                diffUTCTime
                (systemToUTCTime thisTime)
                (systemToUTCTime lastTime)
              intervalRatio =
                if intervalDiffTime == 0
                then 0
                else toRational $ 1 / intervalDiffTime
          in ( fromIntegral (thisDown - lastDown) * intervalRatio
             , fromIntegral (thisUp - lastUp) * intervalRatio
             )
  
  sumSpeeds :: [(Rational, Rational)] -> (Rational, Rational)
  sumSpeeds = foldr1 sumOne
    where
      sumOne (d1, u1) (d2, u2) = (d1 + d2, u1 + u2)
  