Filtering an Event.

filterDups.hs

{-# LANGUAGE ScopedTypeVariables #-} -- allows "forall t. Moment t"

import Data.Maybe

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       = 10001
        , tpCustomHTML = Nothing
        , tpStatic     = ""
        } setup

setup :: Window -> IO ()
setup window = do
    return window # set title "Filter Events based on Behavior"
    
    input1  <- UI.input
    input2  <- UI.input

    counter <- UI.span
    filtered <- UI.span 

    bevent  <- UI.button #+ [UI.string "Fire Event"]
    
    getBody window #+ [
        row [UI.string "(", element input1, UI.string ",", element input2, UI.string ")"],
        row [UI.string "Button Event Count: ", element counter],
        row [UI.string "Filtered Event Count: ", element filtered],
        row [element bevent]]

    let networkDescription :: forall t. Frameworks t => Moment t ()
        networkDescription = do
        
        binput1  <- behaviorValue input1 "0"
        binput2  <- behaviorValue input2 "0"
        eclick   <- event UI.click bevent
        
        let
            result :: Behavior t (Int, Int)
            result = f <$> binput1 <*> binput2
                where f x y = (,) (readNumber x) (readNumber y)

            readNumber :: String -> Int
            readNumber s = read s    

            clickE :: Event t (Int, Int)
            clickE = result <@ eclick

            firstB :: Behavior t Int
            firstB = stepper 0 $ fst <$> clickE

            firstNotEq :: (Eq a) => a -> (a, b) -> Bool
            firstNotEq old (new, _) = new /= old

            --filterDup :: (Eq a, Num a) => Event t (a, t1) -> Event t (a, t1)
            filterDup = filterApply (firstNotEq <$> firstB)

            counterUn :: Behavior t Int
            counterUn = accumB 0 $ (+1) <$ clickE

            counterFil :: Behavior t Int
            counterFil = accumB 0 $ (+1) <$ (filterDup clickE)
            
        return counter # sink text (show <$> counterUn)
        return filtered # sink text (show <$> counterFil)

    network <- compile networkDescription    
    actuate network