A simple proof of concept of reusable components for reactive-banana-threepenny.

Counter.hs

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RecordWildCards #-}
-- Import this module qualified.
module Counter
    ( Counter
    -- Constructor
    , new
    -- Element renderer
    , toElement
    -- Setter-like
    , resetCount
    -- Listener
    , commentEvent
    -- Getter (in two halves)
    , requestClicks
    , getClicksEvent
    ) where

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

import Reactive.Banana
import Reactive.Banana.Threepenny

data Counter = Counter
    { _strCount :: Element
    , _btnAddOne :: Element

    , _initialCount :: Int

    , _resetEvent :: Reg.Event ()
    , fireReset :: () -> IO () -- exported as resetCount

    , commentEvent :: Reg.Event String
    , _fireComment :: String -> IO ()

    , _requestClicksEvent :: Reg.Event ()
    , fireRequestClicks :: () -> IO () -- exported as requestClicks
    , getClicksEvent :: Reg.Event Int
    , _fireGetClicks :: Int -> IO ()
    }

resetCount :: Counter -> IO ()
resetCount c = (fireReset c) ()

requestClicks :: Counter -> IO ()
requestClicks c = (fireRequestClicks c) ()

new :: Int -> IO Counter
new _initialCount = do

    _strCount <- string $ show _initialCount
    _btnAddOne <- UI.button # set UI.text "+1"

    (_resetEvent, fireReset) <- Reg.newEvent

    (commentEvent, _fireComment) <- Reg.newEvent

    (_requestClicksEvent, fireRequestClicks) <- Reg.newEvent
    (getClicksEvent, _fireGetClicks) <- Reg.newEvent

    let networkDescription :: forall t. Frameworks t => Moment t ()
        networkDescription = do
            eAddOne <- ((+1) <$)
                <$> event UI.click _btnAddOne
            eReset <- (const _initialCount <$)
                <$> fromAddHandler (register _resetEvent)

            let bCount = _initialCount `accumB` (eAddOne `union` eReset)

            return _strCount # sink UI.text (show <$> bCount)

            eCountChanged <- changes bCount
            reactimate $
                _fireComment <$> filterE (not . null)
                    (countComment <$> eCountChanged)

            reactimate $ _fireComment "" <$ eReset

            let bClicks = 0 `accumB` eAddOne

            eGetClicks <- (bClicks <@)
                <$> fromAddHandler (register _requestClicksEvent)
            reactimate $ _fireGetClicks <$> eGetClicks

    network <- compile networkDescription
    actuate network

    return Counter {..}

    where
    countComment :: Int -> String
    countComment x = case x of
        20  -> "That is quite a lot of clicks."
        50  -> "Maybe you should take a break..."
        100 -> "CONGRATULATIONS! YOU REACHED THE SECRET LEVEL!"
        _   -> ""


toElement :: Counter -> IO Element
toElement c =
    row . map element $ [ _strCount c, _btnAddOne c ]

ThreepennyComponents.hs

{-# LANGUAGE ScopedTypeVariables #-}
module Main where

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

import Reactive.Banana
import Reactive.Banana.Threepenny

import qualified Counter

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

setup :: Window -> IO ()
setup w = do
    return w # set title "A reusable Threepenny component"

    counter <- Counter.new 0
    btnReset <- UI.button # set UI.text "Reset"
    strComment <- string ""
    strClicks <- string ""
    btnClicks <- UI.button # set UI.text "Update"

    getBody w #+
        [ column
            [ Counter.toElement counter
            , UI.br
            , element btnReset
            , UI.br
            , row [ element strClicks, element btnClicks ]
            , UI.br
            , element strComment
            ]
        ]

    let networkDescription :: forall t. Frameworks t => Moment t ()
        networkDescription = do

            eReset <- event UI.click btnReset
            reactimate $ Counter.resetCount counter <$ eReset

            eComment <- fromAddHandler (register $ Counter.commentEvent counter)
            let bComment = "" `stepper` eComment
            return strComment # sink text bComment

            eRequestClicks <- event UI.click btnClicks
            reactimate $ Counter.requestClicks counter <$ eRequestClicks
            eGetClicks <- fromAddHandler (register $ Counter.getClicksEvent counter)
            let bClicks = 0 `stepper` eGetClicks
            return strClicks # sink text (displayClicks <$> bClicks)

    network <- compile networkDescription
    actuate network

    Counter.requestClicks counter

    where
    displayClicks :: Int -> String
    displayClicks x = "The +1 button was clicked " ++ show x ++ " times."