In Part 1, we have seen how an interface-based OOP model can be implemented in idiomatic Haskell; we defined interfaces, a typeclass to enable a typesafe cast-to-interface function, and an accessor function / operator to conveniently access an object member through an interface. We will now look at how we can implement mutable objects in idiomatic Haskell.

Mutability in Haskell

Haskell is a pure functional programming language, and part of that is that dealing with mutability requires special attention. A lot has been written about this general topic already, so I'll skip over the details.

The first approach a Haskeller would typically take when presented with a problem that is inherently stateful is simple: Functions. More specifically, endofunctions (functions where the input and output types are the same):

increaseCounter :: Int -> Int
increaseCounter i = i + 1

Some might prefer state monads, which are really just a very very thin abstraction layer over the same mechanism:

increaseCounter :: State Int
increaseCounter = modify (+ 1)

Unfortunately, this won't cut it. We will see later why exactly that is.

But we can step it up: If we accept moving our methods to IO return types, then we get access to IORef, a simple mutable-variable type. It doesn't provide much in terms of thread safety beyond making individual updates atomic, but for the purpose of this post, this is good enough. Here's what IORef usage looks like:

increaseCounter :: IORef Int -> IO ()
increaseCounter counterVar =
  modifyIORef counterVar (+ 1)

If we do want better threading support, STM (Software Transactional Memory) and its mutable variable primitive TVar are a good idea:

-- TVar in STM
increaseCounter :: TVar Int -> STM ()
increaseCounter counterVar =
  modifyTVar counterVar (+ 1)

-- TVar in IO
increaseCounterIO :: TVar Int ->  IO ()
increaseCounterIO counterVar =
  atomically $ increaseCounter counterVar

We will however use IORef for now. Generalizing mutability is going to be a topic in a future post.

Mutable Fields With IORef

Using IORef for our mutable fields has a few consequences. First, because our fields are now mutable, anything that accesses them has to live in IO. This means that our interfaces also have to have methods in IO, otherwise they cannot read data from mutable fields. But when we define an interface, we do not want to dictate whether data is read from a mutable field or not, so once we start supporting mutability at all, it's best to have all interface methods live in IO. This is unfortunate, because it means that we give up immutability guarantees; but we will address this concern later, introducing some simple type system tricks that will buy us some guarantees back.

Another consequence is that object construction now also has to happen in IO, because that's where we have to create our IORefs. In practice, this means we will be writing at least one IO function for each of our types, and that function will essentially play the role of a constructor (in the OOP sense, not the Haskell sense).

Case Study: A GUI System

Let's put the above in practice: We're building a classic event-driven GUI, consisting of a main loop and a collection of composable components. First, let's jot down a quick outline of what the main loop will look like:

runGUI :: Graphics -> IO Event -> Component -> IO ()
runGUI g eventSource component = forever $ do
  (component ==> render) g
  event <- eventSource
  (component ==> handleEvent) event

I'm not showing the definition of Graphics; we'll assume that it is an opaque type provided by a suitable library that allows us to render all sorts of graphics primitives and represents a GUI context like a window or a canvas. Usages that appear in this post should be self-explanatory.

I'm not showing implementations of eventSource here either, but it's easy to imagine what it might look like: a naive implementation could just repeatedly poll all inputs, and return a suitable Event as soon as any of them produces anything, while a more sophisticated implementation would probably be multi-threaded and use some sort of thread-safe channel to move events around. And, speaking of events, here's what the Event type might look like:

data Event
  = ClickEvent Position -- Mouse button down at position
  | KeypressEvent Keycode (Maybe Char) -- A key has been pressed
  | TimerEvent Integer -- A timer tick

Note that we're using a plain algebraic data type here: we don't use OOP here, because we don't need (nor want) extensible runtime polymorphism. Naturally, a real-world GUI would need a much richer event type. We'll get back to events in a minute though.

Rendering

The main loop tells us what kind of interface (or interfaces) our component must support: there must be a render method, and a handleEvent method. Let's start with render:

data Renderable
  = Renderable
      { render :: Renderable -> Graphics -> IO ()
      }

Let's write some components and their Renderable implementations. Starting with a very simple one: the static label.

data Label
  = Label
      { labelPosition :: IORef Position
      , labelText :: IORef String
      }

-- Since 'Label' is mutable, it needs a constructor function:
newLabel :: Position -> String -> IO Label
newLabel position txt =
  Label <$> newIORef position
        <*> newIORef txt

instance Label `Is` Renderable where
  cast label =
    Renderable
      { render = \this g -> do
          position <- readIORef (labelPosition label)
          txt <- readIORef (labelText label)
          drawText g AlignLeft AlignBaseline position txt
      }

Great. Only slightly more elaborate: Buttons.

data Button
  = Button
      { buttonRect :: IORef Rect
      , buttonLabel :: IORef String
      , buttonOnClick :: IORef (IO ())
      }

-- Yes, that's right, an `IORef` that contains an `IO` action. This is the
-- most general way in which we can implement runtime-overridable callbacks
-- in `IO`; in a real project, we would probably use a stricter messaging
-- system, but that would blow up the scope of this example too much.

-- Again, we need a constructor
newButton :: Rect -> String -> IO () -> IO ()
newButton rect label onClick =
  Button <$> newIORef rect
         <*> newIORef label
         <*> newIORef onClick

instance Button `Is` Renderable where
  cast btn =
    Renderable
      { render :: \this g = do
          rect <- readIORef (buttonRect btn)
          txt <- readIORef (buttonLabel btn)
          drawFilledRect g rect (RGB 192 192 192)
          drawRect g rect (RGB 0 0 0)
          drawText g AlignCenter AlignMiddle (rectCenter rect) txt
      }

OK, so now we can render our crude components. But a button isn't a button if we can't click it, so...

Handling Events

First attempt:

data EventHandler
  = EventHandler
      { handleEvent :: EventHandler -> Event -> IO ()
      }

And let's provide a default implementation that our real implementations can use as a template:

defEventHandler :: EventHandler
defEventHandler
  = EventHandler
      { handleEvent = \this event -> return ()
      }

That is, the default implementation dispatches events according to their constructor in handleEvent, and provides "do-nothing" defaults for all the individual handlers. This means that we can override just the methods that interest us, and leave the rest at their defaults.

So here's how we implement EventHandler for our two component classes:

instance Label `Is` EventHandler where
  cast label = defEventHandler -- That's right, the default is perfect!

instance Button `Is` EventHandler where
  cast btn =
    EventHandler
      { handleEvent = \this e -> case e of
          ClickEvent position -> do
            onClick <- readIORef (buttonOnClick btn)
            onClick
          _ -> handleEvent defEventHandler this e
      }

In practice, we might instantiate a button like so:

myBtn <- newButton (Rect 10 10 150 20) "Say hello" $ do
          putStrLn "Hello!"

Multiple Interfaces

One problem though. We have defined two interfaces, but we want to pass in one value that implements both. We could of course change the type of our runGUI function like so:

  -- Note the lowercase spelling of 'component' here: it is a type variable,
  -- not a type like in the above example.
  runGUI :: ( component `Is` Renderable
            , component `Is` EventHandler
            )
         => Graphics -> IO Event -> component -> IO ()

It works, because our (==>) operator automatically resolves to the right interface through the Is typeclass. It's not ideal though, and I will show you why.

But first, let's build a feedback mechanism into the handleEvent method: we will change the return type from IO () to IO Accepted, like this:

data Accepted = Rejected | Accepted
      deriving (Read, Show, Ord, Eq, Enum, Bounded)


data EventHandler
  = EventHandler
      { handleEvent :: EventHandler -> Event -> IO Accepted
      }

defEventHandler :: EventHandler
defEventHandler
  = EventHandler
      { handleEvent = \this event -> return Rejected
      }

-- And we'll also build a collision check into our button, so that it only
-- accepts click events that are actually within its area:

instance Button `Is` EventHandler where
  cast btn =
    EventHandler
      { handleEvent = \this e -> case e of
          ClickEvent position -> do
            rect <- readIORef (buttonRect btn)
            if pointInRect position rect then do
              onClick <- readIORef (buttonOnClick btn)
              onClick
              return Accepted
            else
              return Rejected
          _ -> handleEvent defEventHandler this e
      }

This is useful, because we need our GUI to be compositional, that is, we want to compose complex GUIs from simple building blocks, and part of that will involve dispatching events to multiple components. For that to work nicely, we need a way to tell whether a component has accepted an event or not: if it has, we consider it handled and stop, but if it hasn't, we try the next component in line. Here's such a component group type:

data ComponentGroup
  = ComponentGroup
      { cgroupChildren :: IORef [Component]
      }

And this is where our first approach to multiple interface types breaks down: if we put both the `Is` Renderable and `Is` EventHandler constaints on the component list here, and make it [component], we don't get a heterogenous list - all list elements must be of the same type, because that is how Haskell's type system works. So we need to move the "must be both Renderable and an EventHandler" constraint to the term level, just like we did with individual interfaces. The solution is quite simple, actually: We simply define another interface that captures the notion of implementing both the other interfaces. The pattern is just the same as before:

data Component
  = Component
      { componentRenderable :: Component -> Renderable
      , componentEventHandler :: Component -> EventHandler
      }

instance Component `Is` Renderable where
  cast c = componentRenderable c c

instance Component `Is` EventHandler where
  cast c = componentEventHandler c c

And then we write boring instances for our components:

instance Label `Is` Component where
  cast lbl = Component (cast lbl) (cast lbl)

instance Button `Is` Component where
  cast btn = Component (cast btn) (cast btn)

And now our ComponentGroup type will work. Some boilerplate is needed still:

newComponentGroup :: IO ComponentGroup
newComponentGroup = ComponentGroup <$> newIORef []

addComponent :: ComponentGroup -> Component -> IO ()
addComponent group component =
  modifyIORef (cgroupChildren group) (component:)

And of course we need to implement the Renderable, EventHandler, and Component instances:

instance ComponentGroup `Is` Renderable where
  cast group =
    Renderable
      { render = \this g -> do
          children <- readIORef (cgroupChildren group)
          -- Just forward the render calls!
          forM_ children $ \child -> (child ==> render) g
      }

instance ComponentGroup `Is` EventHandler where
  cast group =
    EventHandler
      { handleEvent = \this event -> do
          children <- readIORef (cgroupChildren group)
          dispatchEvent children event
      }

dispatchEvent :: [Component] -> Event -> IO Accepted
dispatchEvent [] _ = return Rejected
dispatchEvent (x:xs) e =
  (x ==> handleEvent) e >>= \case
    Accepted -> return Accepted
    Rejected -> dispatchEvent xs e

-- And the boring instance:
instance ComponentGroup `Is` Component where
  cast g = Component (cast g) (cast g)
          

Now we can combine components of different underlying types into the same list; we just need to cast them.

master <- newComponentGroup
addComponent master =<< (cast <$> newButton (Rect 10 10 100 20) "OK" exitSuccess)
addComponent master =<< (cast <$> newButton (Rect 110 10 100 20) "Abort" exitFailure)
addComponent master =<< (cast <$> newLabel (Position 0 0) "Press one of these buttons here...")
-- We'll handwaivingly assume that suitable Graphics and event sources have
-- been conjured up somehow here...
runGUI g eventSource (cast master :: Component)

We can also make the buttons do something other than just exit the application, such as updating labels:

master <- newComponentGroup
label1 <- newLabel (Position 0 0) "Press one of these buttons here...")
let say = writeIORef (labelText label1)
button1 <- newButton (Rect 10 10 100 20) "Hello" (say "You clicked 'Hello'")
button2 <- newButton (Rect 10 30 100 20) "Hi" (say "You clicked 'Hi'")
button3 <- newButton (Rect 10 50 100 20) "Bye" exitSuccess

addComponent master (cast button1)
addComponent master (cast button2)
addComponent master (cast button3)
addComponent master (cast label1)

runGUI g eventSource (cast master :: Component)

Conclusion

At this point, we have covered much of the OOP design space, and we have managed to retain a lot of Haskell's type goodness. Particularly, we can now express the following OOP concepts:

• Objects
• Interfaces
• Typesafe Object → Interface casts
• Virtual methods and full open recursion
• Mutable object state
• Encapsulation
• Interface-based inheritance
• Interface hierarchies

We're missing some interesting features still, which I intend resolve in the next parts:

• Visibility (public / private)
• Mutability Control, similar to the const keyword in C++, although we will take a different approach (hint: we will be leveraging Haskell's type system...)
• Generalized Mutability: we will decouple mutable objects from a particular mutability primitive type and mutation monad, generalizing from IORef + IO
• Dynamic Casts, the ability to perform casts that may fail at runtime, similar to dynamic_cast in C++, or the semantics of Data.Dynamic in plain Haskell
• Object Inheritance, being able to write "classes" that inherit from other "classes". So far we have only used inheritance with interfaces, expressing interfaces in terms of other interfaces: we can say "class A implements interface X", and we can also say "anything that implements interface X also implements interfaces Y and Z", but we haven't expressed proper class inheritance yet, saying things like "type A inherits from type B" (or "A is a superclass of B").

Finally: the OOP framework laid out in this blog series is also available on Hackage, under the name boop, feel free to read along and see what it looks like when you put it all together.