{-----------------------------------------------------------------------------
    reactive-banana-threepenny
    
    Example: Minuscule network monitor
------------------------------------------------------------------------------}
{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. Moment t"

import Data.Char
import Data.List
import Data.Maybe

import System.Process

import qualified Graphics.UI.Threepenny as UI
import Graphics.UI.Threepenny.Core hiding (Event)

import Reactive.Banana
import Reactive.Banana.Threepenny

{-----------------------------------------------------------------------------
    Main
------------------------------------------------------------------------------}
main :: IO ()
main = do
    startGUI Config
        { tpPort       = 10000
        , tpCustomHTML = Nothing
        , tpStatic     = ""
        } setup

setup :: Window -> IO ()
setup window = do
    return window # set title "Network Monitor"

    out1 <- UI.span
    out2 <- UI.span
    
    getBody window #+
        [column [string "TCP network statistics",
                   grid [[string "Packets sent: ", element out1]
                        ,[string "Packets received: ", element out2]]
                  ]]
    
    timer <- UI.timer # set UI.interval 500  -- timer every 500 ms

    let networkDescription :: forall t. Frameworks t => Moment t ()
        networkDescription = do
            -- The network statistics are polled when and only when
            -- the event network handles an event.
            bnetwork <- fromPoll getNetworkStatistics
            -- That's why we need a timer that generates regular events to handle.
            etick    <- event UI.tick timer
        
            let showSent     = maybe "parse error" show . fst
                showReceived = maybe "parse error" show . snd
        
            return out1 # sink text (showSent     <$> bnetwork)
            return out2 # sink text (showReceived <$> bnetwork)
    
    network <- compile networkDescription
    actuate network
    UI.start timer

-- Obtain network statistics from the  netstat  utility
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