reactive-banana-gtk example

Greet.glade

<?xml version="1.0" encoding="UTF-8"?>
<interface>
  <requires lib="gtk+" version="2.24"/>
  <!-- interface-naming-policy project-wide -->
  <object class="GtkWindow" id="mainWindow">
    <property name="can_focus">False</property>
    <property name="title" translatable="yes">Greeter</property>
    <child>
      <object class="GtkVBox" id="vbox">
        <property name="visible">True</property>
        <property name="can_focus">False</property>
        <property name="spacing">4</property>
        <property name="homogeneous">True</property>
        <child>
          <object class="GtkLabel" id="questionLabel">
            <property name="visible">True</property>
            <property name="can_focus">False</property>
            <property name="label" translatable="yes">What's your name?</property>
          </object>
          <packing>
            <property name="expand">True</property>
            <property name="fill">True</property>
            <property name="position">0</property>
          </packing>
        </child>
        <child>
          <object class="GtkEntry" id="nameEntry">
            <property name="visible">True</property>
            <property name="can_focus">True</property>
            <property name="invisible_char">●</property>
            <property name="primary_icon_activatable">False</property>
            <property name="secondary_icon_activatable">False</property>
            <property name="primary_icon_sensitive">True</property>
            <property name="secondary_icon_sensitive">True</property>
          </object>
          <packing>
            <property name="expand">True</property>
            <property name="fill">True</property>
            <property name="position">1</property>
          </packing>
        </child>
        <child>
          <object class="GtkLabel" id="greetLabel">
            <property name="visible">True</property>
            <property name="can_focus">False</property>
          </object>
          <packing>
            <property name="expand">True</property>
            <property name="fill">True</property>
            <property name="position">2</property>
          </packing>
        </child>
      </object>
    </child>
  </object>
</interface>

Greet.hs

module Main where

import Control.Monad.Trans (liftIO)

import Graphics.UI.Gtk
import Graphics.UI.Gtk.Builder

import Reactive.Banana
import Reactive.Banana.Frameworks
import Reactive.Banana.Gtk

main :: IO ()
main = do initGUI

          builder <- builderNew
          builderAddFromFile builder "Greet.glade"

          mainWindow <- builderGetObject builder castToWindow "mainWindow"
          mainWindow `on` deleteEvent $ liftIO mainQuit >> return False

          nameEntry  <- builderGetObject builder castToEntry "nameEntry"
          greetLabel <- builderGetObject builder castToLabel "greetLabel"

          network <- compile $ do
            eChanged <- event0 nameEntry editableChanged
            reactimate $ fmap (const $ greet nameEntry greetLabel) eChanged

          actuate network
          widgetShowAll mainWindow
          mainGUI

greet :: Entry -> Label -> IO ()
greet nameEntry greetLabel = do
  name <- get nameEntry entryText
  let greeting = if null name then "" else "Hello, " ++ name
  set greetLabel [ labelText := greeting ]