Simple netwire program I've written a simple program to test out the capabilities of netwire (or rather, how to write programs using netwire). The goal is to have an application that shows a window, starting out as completely filled with red. Pressing space should switch from red to blue and vice versa. Pressing escape or closing the window should terminate the program. I've been able to write something that works (using Allegro, but that doesn't matter too much - the Allegro part can't be simplified, at least not by much), but it's gotten a bit lengthy for something that sounds so simple.

{-# LANGUAGE OverloadedStrings #-}

module Main(main) where

import Control.Wire hiding (when)
import Prelude hiding ((.),id)
import qualified Graphics.UI.Allegro.Raw as Al
import Data.Monoid
import Control.Monad.Reader
import qualified Data.Set as S
import Data.Set (Set)

iff True  a _  = a
iff False _ b  = b

data Game = Game {
    keyState :: Set Al.Key,
    isClosed :: Bool
}

data Result = GameColor Al.Color | Quit

colRed = Al.Color {Al.colorR = 1.0, Al.colorG = 0.0, Al.colorB = 0.0, Al.colorA = 1.0}
colBlue = Al.Color {Al.colorR = 0.0, Al.colorG = 0.0, Al.colorB = 1.0, Al.colorA = 1.0}

initG = Game { keyState = S.empty, isClosed = False }
addKey (g@ Game {keyState = s}) k = g {keyState = S.insert k s}

-- Produce when event occurs, inhibit otherwise
gameEvent :: Monoid e =&gt; (Game -&gt; Bool) -&gt; Event e (ReaderT Game IO) a
gameEvent f = mkFixM $ \_ a -&gt;
  iff &lt;$&gt; asks f &lt;*&gt; (return $ Right a) &lt;*&gt; (return $ Left mempty)

windowClosed = gameEvent isClosed

keyPressed k = gameEvent (S.member k . keyState)

doQuit = pure Quit . (keyPressed Al.KeyEscape &lt;|&gt; windowClosed)
color = doColorRed


-- The once prevents infinite recursion in case space was pressed
doColorRed = pure (GameColor colRed) . (once &lt;|&gt; notE (keyPressed Al.KeySpace)) --&gt;
              doColorBlue
doColorBlue = pure (GameColor colBlue) . (once &lt;|&gt; notE (keyPressed Al.KeySpace)) --&gt;
                doColorRed

colorApp :: Wire () (ReaderT Game IO) a Result
colorApp = doQuit &lt;|&gt;
            color

main = do
  Al.initialize
  Al.installKeyboard
  Just window &lt;- Al.createDisplay 800 600
  Al.setTargetBackbuffer window
  Just q &lt;- Al.createEventQueue
  t &lt;- Al.createTimer $ 1/60
  Al.registerEventSource q =&lt;&lt; Al.getKeyboardEventSource
  Al.registerEventSource q =&lt;&lt; Al.getDisplayEventSource window
  Al.registerEventSource q =&lt;&lt; Al.getTimerEventSource t
  Al.startTimer t
  loop colorApp clockSession q
  Al.destroyEventQueue q
  Al.destroyDisplay window where
    loop w session q = do
      game &lt;- handleEvents initG q
      (mx, w', session') &lt;- runReaderT (stepSession w session ()) game
      case mx of
         Left ex -&gt; putStrLn $ "Inhibited: " ++ show ex -- this should never happen
         Right (GameColor c) -&gt; do
           Al.clearToColor c
           Al.flipDisplay
           loop w' session' q
         Right Quit -&gt; return ()
    handleEvents g q = do 
      ev &lt;- Al.waitForEvent q
      case ev of
        Al.KeyDownEvent{Al.eventKeycode = k} -&gt; handleEvents (addKey g k) q
        Al.Timer{}                           -&gt; return g
        Al.DisplayClose{}                    -&gt; return g{isClosed = True}
        _                                    -&gt; handleEvents g q
Your iff function would be better expressed with &lt;|&gt; or msum. They're for making a choice, so one of them ought be used in place of iff, I'm not sure where the True/False values are feeding out into iff, but I would maybe change them to feed out something that's a Monoid type or MonadPlus instead of Bool then use the appropriate choice technique.

You named a data type which appears to be the purpose of being a state Result, was this supposed to be a Command, Instruction, NextState, or Update instead perhaps? Result seems like a confusing name to me for what I (think?) that is.

data Update = Color (Float, Float, Float) | Quit | Reset | etc | etc | whatever
type Command = (Game -&gt; Update -&gt; IO Game) -- Presuming those functions which execute changes like doColorRed return an IO monad


I think you're missing a cohesive set of data models to present your system and it's possible states for which you could write functions to alter... When working with any UI presentation, it's usually best to create a model of your system and a separate view which responds to your model.

I would change:

  case mx of
     Left ex -&gt; putStrLn $ "Inhibited: " ++ show ex -- this should never happen
     Right (GameColor c) -&gt; do
       Al.clearToColor c
       Al.flipDisplay
       loop w' session' q
     Right Quit -&gt; return ()


To:

toColor (r,g,b) = Al.Color {Al.colorR = r, Al.colorG = g, Al.colorB = b, Al.colorA = 1.0}
ProcessCommand g (Color c) = Al.clearToColor (toColor c) &gt;&gt; Al.flipDisplay &gt;&gt; (gameLoop g)
ProcessCommand g Quit = return ()


then where you do your case, make sure your Game data type (represented as g above) has those w', session', and q variables as a part of your Game data type so the gameLoop function can execute that loop given any Game

and your case can take advantage of the exception monad instead of doing a case...

fmap (processCommand g) (mx &lt;|&gt; Right $ someFunctionThatTakesMxAndCreatesACommandToPrintTheError mx)


Give some of these techniques a try and see how it cleans up for ya. After that perhaps you'll see a higher level design appear that will make the domain a little easier to model and approach.