[Haskell-cafe] GUI programming

2 Feb 2010

      Hello,

I've been writing some GUI application with Gtk2hs. It's an
interpreter for lambda-calculus and combinatory logic, it's GPL and if
you interested I can share it with cafe.

The problem is that the GUI code has become very ugly and I'm tempted
to rewrite it totally. I've been looking forward to the FRP stuff, but
I've never seen a single definition of the term. Conal Eliot's
"denotational programming" is too general to be definition. I want to
try Grapefruit, but I got totally lost when I see arrow notation.

I consider more lightweight and more imperative approach, something
closer to CSP (Communicating Secuential Processes) then FRP. I've just
crafted some sample program to illustrate my idea.

The behaviour is a monad and it's IO monad so you can do any IO
(Gtk2hs) programming you wish. The differences is that you don't
attach static event handlers and tries to determine what to do
dependent on application state. You attach and detach handlers as much
as possible. Behaviour looks like a process that can stop execution
and wait for some GUI event. When event arrived it continues
execution.

Do you see this approach viable. There are steel some details to emerge:
* How to wait for several events
* How to handle IO exceptions

Here is the code:
{-# LANGUAGE ExistentialQuantification #-}
module Main where

import Data.IORef
import System.Glib
import Graphics.UI.Gtk
import Control.Monad.Trans

type Event obj = IO () -> IO (ConnectId obj)

data Behaviour a =
  forall b. BBind (Behaviour b) (b -> Behaviour a)
  | BIO (IO a)
  | forall obj. GObjectClass obj => BWaitEvent (Event obj) (Behaviour a)

instance Monad Behaviour
 where action >>= generator = BBind action generator
       return a = BIO (return a)

instance MonadIO Behaviour
 where liftIO action = BIO action

runBehaviour :: Behaviour a -> IO a
runBehaviour (BBind (BWaitEvent event after) f) = runBehaviour
(BWaitEvent event (after >>= f))
runBehaviour (BBind (BIO a) f) = a >>= \x -> runBehaviour (f x)
runBehaviour (BBind (BBind a f) g) = runBehaviour (a >>= (\x -> f x >>= g))
runBehaviour (BIO a) = a
runBehaviour (BWaitEvent event after) =
 do sigIdRef <- newIORef (error "You can't access sigIdRef before
signal is connected")
    sigId <- event $
      do sigId <- readIORef sigIdRef
         signalDisconnect sigId
         runBehaviour after
         return ()
    writeIORef sigIdRef sigId
    return (error "You can't expect result from behaviour")

waitEvent :: GObjectClass obj => Event obj -> Behaviour ()
waitEvent event = BWaitEvent event (return ())

main :: IO ()
main =
  do initGUI
     window <- windowNew
     onDestroy window mainQuit
     set window [windowTitle := "Hello World"]
     button <- buttonNew
     let buttonB label =
           do liftIO $ set button [buttonLabel := label]
              waitEvent (onClicked button)
              buttonB (label ++ "*")
     runBehaviour (buttonB "*")
     set window [containerChild := button]
     widgetShowAll window
     mainGUI

-- 
Victor Nazarov