reactive-banana-wx-0.4.1.0: src/NetMonitor.hs

{-----------------------------------------------------------------------------
    reactive-banana-wx
    
    Example: Minuscule network monitor
------------------------------------------------------------------------------}
import Data.Char
import Data.List
import Data.Maybe
import Graphics.UI.WX hiding (Event)
import Reactive.Banana
import Reactive.Banana.WX
import System.Process

{-----------------------------------------------------------------------------
    Main
------------------------------------------------------------------------------}
main = start $ do
    f        <- frame    [text := "Network Monitor"]
    out1     <- staticText f []
    out2     <- staticText f []
    
    set f [layout := margin 10 $
            column 10 [label "TCP network statistics",
                       grid 5 5 [[label "Packets sent: ", widget out1]
                                ,[label "Packets received: ", widget out2]]
                      ]
          , size := sz 250 70]
    
    t <- timer f [ interval := 500 ] -- timer every 500 ms

    network <- compile $ do
        etick    <- event0 t command
        bnetwork <- fromPoll $ getNetworkStatistics
        
        let showStat f = stepperD "" $ f <$> (bnetwork <@ etick)
            sent     = maybe "parse error" show . fst
            received = maybe "parse error" show . snd
        
        sink out1 [ text :== showStat sent ]
        sink out2 [ text :== showStat received ]
    
    actuate network

-- obtain network statistics
type NetworkStatistics = (Maybe Int, Maybe Int)

getNetworkStatistics :: IO NetworkStatistics
getNetworkStatistics = do
    s <- readProcess "netstat" ["-s", "-p","tcp"] ""
    return (readField "packets sent" s
           ,readField "packets received" s)

readField :: String -> String -> Maybe Int
readField fieldname = id
    . fmap (read . filter isDigit) . listToMaybe
    . filter (fieldname `isSuffixOf`) . lines