λ Fun With Functions

Update Everything

Posted on May 17, 2020

The Problem.

In the project I’m working on there is some logic which assigns a UUID to a field in a bunch of values which make up an AST structure representing a user’s code. For testing purposes there are a series of functions which take a value in that structure and wipe out the unique ID so that we can use an equality check against it. Those are manually written functions which we have to update as the structure changes, leading to the odd “Wait, why has that still got a unique ID?” moment. I had an inkling that if this was written in Haskell (it’s actually TypeScript) this manually written code, along with the maintenance cost, could go in the bin.

First Steps.

Let me first build a bunch of data types that look a bit like the kind of problem I have.

{-# LANGUAGE DeriveDataTypeable #-}

import Data.Data

newtype UniqueID = UniqueID String deriving (Eq, Show, Data)

data JSObject = JSObject { objectParts :: [(String, JSValue)] } deriving (Eq, Show, Data)

data JSArray = JSArray { arrayParts :: [JSValue] } deriving (Eq, Show, Data)

data JSString = JSString { stringValue :: String } deriving (Eq, Show, Data)

data JSBool = JSBool { boolValue :: Bool } deriving (Eq, Show, Data)

data JSNumber = JSNumber { numberValue :: Double } deriving (Eq, Show, Data)

data JSNull = JSNull deriving (Eq, Show, Data)

data JSUndefined = JSUndefined deriving (Eq, Show, Data)

data JSCode = JSCode { code :: String, codeUniqueID :: UniqueID } deriving (Eq, Show, Data)

data JSValue = JSValueObject JSObject
             | JSValueArray JSArray
             | JSValueString JSString
             | JSValueBool JSBool
             | JSValueNumber JSNumber
             | JSValueNull JSNull
             | JSValueUndefined JSUndefined
             | JSValueCode JSCode
             deriving (Eq, Show, Data)

Don’t worry too much about the imports, that LANGUAGE pragma or the Data typeclass in the deriving clause, we’ll get back to those in time. What we have above is something that approximates the definition of JSON in most libraries but with the added bonus of the JSCode type which represents a chunk of arbitrary JavaScript and is where we hold our UniqueID value. As we can have one of those buried 9 layers down, we need to walk the tree to update those wherever we might find them.

Building The Parts.

We’ll start with a function to clear unique ID values, which just throws away the original value and gives us an empty one.

clearUniqueID :: UniqueID -> UniqueID
clearUniqueID _ = UniqueID ""

Just build up a nested structure to play with:

exampleCode = JSCode "5" (UniqueID "ABC")
exampleArray = JSArray [JSValueCode exampleCode]
exampleString = JSString "Good News"
exampleObject = JSValueObject (JSObject [("first", JSValueString exampleString), ("second", JSValueArray exampleArray)])

We can use the pretty-simple package to see the structure more clearly:

import Text.Pretty.Simple
GHCi> pPrintNoColor exampleObject
JSValueObject 
    ( JSObject 
        { objectParts = 
            [ 
                ( "first" 
                , JSValueString 
                    ( JSString { stringValue = "Good News" } )
                ) 
            , 
                ( "second" 
                , JSValueArray 
                    ( JSArray 
                        { arrayParts = 
                            [ JSValueCode 
                                ( JSCode 
                                    { code = "5" 
                                    , codeUniqueID = UniqueID "ABC" 
                                    } 
                                )
                            ]
                        }
                    )
                ) 
            ] 
        }
    )

The Good Stuff.

With the Uniplate library we just need a couple of imports:

import Data.Generics.Uniplate.Data
import Data.Generics.SYB

Then with the everywhere function we apply our transformation from earlier:

updatedExample = everywhere clearUniqueID exampleObject

That worked and lets see the result.

GHCi> pPrintNoColor updatedExample
JSValueObject 
    ( JSObject 
        { objectParts = 
            [ 
                ( "first" 
                , JSValueString 
                    ( JSString { stringValue = "Good News" } )
                ) 
            , 
                ( "second" 
                , JSValueArray 
                    ( JSArray 
                        { arrayParts = 
                            [ JSValueCode 
                                ( JSCode 
                                    { code = "5" 
                                    , codeUniqueID = UniqueID "" 
                                    } 
                                )
                            ]
                        }
                    )
                ) 
            ] 
        }
    )

…that’s it! All done, see you next time!

A Deeper Look.

First off, lets have a look at the type of that everywhere function, because that was the most mysterious part.

everywhere :: Biplate b a => (a -> a) -> b -> b

So our clearUniqueID function slotted into the first parameter and then we get a function that transforms from JSValue to JSValue. But this is only if we have an instance of Biplate JSValue UniqueID.

Looking up Biplate we want a Biplate JSValue UniqueID, there’s an instance for (Data a, Data b, Uniplate b) => Biplate a b. So a Data JSValue, a Data UniqueID and a Uniplate UniqueID gives us that Biplate JSValue UniqueID.

Following that chain along to Uniplate, if we look at the instances for it we can see there’s this one: Data a => Uniplate a. So Data a gives us a Uniplate a for every Data a that exists.

Since everything ends up with Data JSValue and Data UniqueID, which GHC has graciously derived automatically for us, we don’t have to write all of that code for walking the various types.

So What Does This Give Us?

The benefits of this are as follows:

  • No manually written pile of code that needs regular maintenance.
  • Reflection or similar runtime introspection is avoided, which might drill into the wrong thing and possibly throw an exception.
  • The types guide the behaviour, so we can guarantee that it’ll be applied to everything it should be and nothing else.

That last point is part of a bigger pattern, not using types as validation but as a building block for behaviour. Having the compiler do work which is repetitive and/or error prone and to the first point which then needs keeping up to date after it is first implemented.

Bonus Round.

There are other wonders to be found in the uniplate library too, like childrenBi which will get all the values matching a particular type from the hierarchy.

GHCi> childrenBi exampleObject :: [UniqueID]
[UniqueID "ABC"]