Programming in Haskell: Searching for TRUTH

 

I just came across a programming problem that I think shows perfectly what working with Haskell is like.

Here's the actual function I'm working on (from the Hickory game engine):

processInput :: RenderInfo -> InputEvent -> Model -> (Model, [InputEvent])

processInput renderinfo (RawEvent (InputTouchesUp touchInfos)) model =
        let accum (m, oes) touchInfo = let (m', oes') = touchUp renderinfo touchInfo m 
                                            in (m', oes ++ oes')
        in foldl accum (model,[]) touchInfos 
        
processInput renderinfo (RawEvent (InputTouchesDown touchInfos)) model = 
        let accum (m, oes) touchInfo = let (m', oes') = touchDown renderinfo touchInfo m 
                                            in (m', oes ++ oes')
        in foldl accum (model,[]) touchInfos
        

So processInput take some info, an event, and the model, and it gives back an updated version of the model, along with some number of new events to be processed on the next frame. There are a few different implementations for processInput-- one pattern matches on InputTouchesUp and calls touchUp, and one pattern matches on InputTouchesDown and calls touchDown.

touchUp :: RenderInfo -> TouchUpInfo -> Model -> (Model, [InputEvent])
touchDown :: RenderInfo -> TouchDownInfo -> Model -> (Model, [InputEvent])

To handle events like InputTouchesUp, I want to use my touchUp function on each individual touch (think multi-touch on a smart phone).

I need to fold here instead of map, because each touchUp manipulates the model, and I need to accumulate those effects.

Now, without going into the details of the function, the main thing is that I end up having the same code in two places, so obviously I can refactor that.

Let's put this in its own function to start with.

accumModelEffects :: Model -> [touchInfo] -> (RenderInfo -> touchInfo -> Model -> (Model, [InputEvent]) -> RenderInfo -> (Model, [InputEvent])

accumModelEffects model touchInfos f renderinfo = 
        let accum (m, oes) touchInfo = let (m', oes') = f renderinfo touchInfo m 
                                            in (m', oes ++ oes')
        in foldl accum (model,[]) touchInfos 
        
processInput :: RenderInfo -> InputEvent -> Model -> (Model, [InputEvent])
processInput renderinfo (RawEvent (InputTouchesUp touchInfos)) model =
        accumModelEffects model touchInfos touchUp renderinfo
        
processInput renderinfo (RawEvent (InputTouchesDown touchInfos)) model = 
        accumModelEffects model touchInfos touchDown renderinfo
        

f is now the name of the touch effect function, which we pass in as a parameter.

touchInfo is a type variable (it starts with a lowercase letter), because it needs to work for either TouchUpInfo or TouchDownInfo.

In most languages, I think the accepted practice is to stop here. Afterall, we eliminated the duplicate code. What more could we want?

In Haskell, we want the TRUTH! What IS this function? Is it a general pattern? Will it ever be used again?

And a question I find even more fascinating: Has anyone ever written this before? And, is there already a name for it? Let's find out!

We'll start by combining two of our parameters, f and renderinfo. We can combine them because they are only used together. renderinfo is always the first argument of f, so let's just pass them in already combined. Note that in Haskell, we don't have to provide all the arguments to a function at the same time. This process is called Currying, and is named after, you guessed it, Haskell Curry!

accumModelEffects :: Model -> [touchInfo] -> (touchInfo -> Model -> (Model, [InputEvent]) -> (Model, [InputEvent])

accumModelEffects model touchInfos f = 
        let accum (m, oes) touchInfo = let (m', oes') = f touchInfo m 
                                            in (m', oes ++ oes')
        in foldl accum (model,[]) touchInfos 
        
processInput :: RenderInfo -> InputEvent -> Model -> (Model, [InputEvent])
processInput renderinfo (RawEvent (InputTouchesUp touchInfos)) model =
        accumModelEffects model touchInfos (touchUp renderinfo)
        
processInput renderinfo (RawEvent (InputTouchesDown touchInfos)) model = 
        accumModelEffects model touchInfos (touchDown renderinfo)
        

Now let's generalize that type signature. This function is just manipulating things. They don't need to be Models or InputEvents. We never actually use functions inside of here that require knowledge of what those things actually are! So we can use type variables instead. This will let us use this function for many purposes instead of just this one, but will also let us discover if anyone else has written this function before.

We'll also generalize our variable names, because they now represent abstract types.

accumModelEffects :: a -> [x] -> (x -> a -> (a, [b]) -> (a, [b])
accumModelEffects starta xs f = 
    let accum (a, bs) x = let (a', bs') = f x a 
                            in (a', bs ++ bs')
    in foldl accum (starta,[]) xs 
    

So, what is this function actually doing? It applies f to each x in xs, while also accumulating effects on starta.

A better name eludes me, but let's see if someone has already written this function. We'll use Hoogle, which is a Haskell API search engine. We can search for that specific type signature to see if a similar function already exists.

Here's the search.

No identical matches, but the first result is something called gmapAccumA, which seems close to what we want except that it's specialized over the Data and Applicative typeclasses. That name reminds me though-- there's a function in Data.List called mapAccumL with a similar name. Here's what it looks like:

mapAccumL :: (acc -> x -> (acc, y)) -> acc -> [x] -> (acc, [y])

The mapAccumL function behaves like a combination of map and foldl; it applies a function to each element of a list, passing an accumulating parameter from left to right, and returning a final value of this accumulator together with the new list.

There's a definite similarity! The order of the parameters is a bit different, but other than that, the only difference is that the applied function returns a single thing instead of a list of things-- (acc, y) instead of (a, [b]). That's not a big difference though. In our function we use (++) to concatenate the lists of b's into one list of b's, but we could just as well do that outside of the function. Let's refactor to use mapAccumL.

mapAccumLConcat starta xs f = let (a', xs') = mapAccumL f starta xs
    in (a', concat xs')
    

Now it's starting to look like TRUTH! We got to use a standard library function, and we learned something also. Next time a similar situation comes up, we know to reach for mapAccumL right away! Note: We do need to flip the last two parameters of our touchUp and touchDown functions because of the way mapAccumL expects its accumulator function to work. But if we don't want to do that we could use a lambda or the 'flip' function.

We can simplify a little further. All our function does now is run mapAccumL and then map the concat function over the second element in the resulting tuple. It would be nice to have this function:

(a -> b) -> (c, a) -> (c, b)

Back again to Hoogle, we find mapSnd, but it's in some non-standard package. Ah well, it's easy enough to write ourselves.

mapSnd :: (a -> b) -> (c, a) -> (c, b)
mapSnd f (c,a) = (c, f a)

mapAccumLConcat a xs f = mapSnd concat $ mapAccumL f a xs

Now THAT is some good truth. It's so skinny it almost seems not worth it to even have the function! We can just use "mapSnd concat $ mapAccumL" if we like.

To me, the power of functional programming is that you can learn about the programs you write. You can learn about what abstractions you're using, even if you didn't realize you were using them at first! This makes you a better programmer. Next time, you can write that complicated logic in one line of code.