No tengo la menor idea


Messing with First Class Labels

Filed under: haskell — robgreayer @ 14:48

In my sandbox Haskell project, lslplus, I’ve got massive amounts of complex state which I manage using a few levels of State and Error monad transformers.  The biggest stateful piece of the application is the simulator, which is implemented as a stack of monads:  an ErrorT transformer wrapping StateT transformer that captures the statefulness of the simulation of the simulated ‘world’, which in turn wraps another ErrorT/StateT monad stack for the LSL interpreter.

I’m unsatisfied with the amount of boilerplate involved in creating functions to manipulate the state in the simulator.  The state is complex, with a top-level ‘World’ data type composed of many other records, and collections of records, with ad hoc functions created to support ‘deep’ modifications of this structure.  In some other places in the application I’ve generated state accessor functions using  Template Haskell, but this area of the application was written earlier, and I’ve wanted to try out one of the libraries available on Hackage.  The ones I looked at were:

My intent was to try more than one, but my impression of fclabels was that it really subsumes the functionality of both the data-accessor and lenses packages, so picked that one to try out ‘in anger’.

A first class label identifies a component of  a structure, allowing both access and update. Given a label lbl, a value of type a :-> b (where :-> is an infix type constructor), access and update look something like:

get lbl rec -- get the value of a component of rec, identified by lbl
set lbl newVal rec -- update a component of rec, identified by lbl

The advantage is that first class labels themselves compose in a way that normal field-labels do not. Haskell field labels compose well for deep access to a record structure, but not for deep update of a record structure. E.g. given:

data Person = Person { name :: Name, age :: Double }
data Name = Name { forename :: String, surname :: String }

you can access the surname of a person p with the expression surname . name $ p, but update requires something much more convoluted, e.g. given a surname nm you’d need to do something like: p { name = (name p) { surname = nm }}. Field labels don’t compose for update. With field labels converted to first class labels, though, the expressions become get ( and set ( nm p respectively. Nice.  (The composition operator here is from the base module Control.Category.  It’s defined for instances of class Category, including (->) as well as (:->)).

With a slight change to my records —
data Person = Person { _name :: Name, _age :: Double }
data Name = Name { _forename :: String, _surname :: String }

the fclabels package will derive first class labels for me:

$(mkLabels [''Name,''Person])

The following labels are derived:

name :: Person :-> Name
age :: Person :-> Double
surname :: Name :-> String
forename :: Name :-> String

With this virtual dymo label maker, you can build your own labels:

-- labels for each element of a pair
fstl :: (a,b) :-> a
fstl = label fst (\ x (_,y) -> (x,y))

sndl :: (a,b) :-> b
sndl = label snd (\ y (x,_) -> (x,y))

which can come in handy.  But in looking at my own data types, I also run across things that look something like:

data Item = Item { _cost :: Int, _weight :: Double }
data Person = Person { _name :: String, _age :: Int, _possessions :: Map String Item }
data World = World { _day :: Int, _people :: Map String Person }

My deep data structures often contain collections (in this simplified example, a couple of Maps). I do really want to be able to easily compose labels to allow access to particular components of collections in the same (or nearly the same) way as I can access other components of my structures. To compose my way from ‘World’ to, say, a persons age, I need to go from ‘World’ to a collection (Map String Person) to an element of a collection (Person) to a component of a person (age). The missing piece is the label for the element of a collection. The first approach that sprang to mind was:

lm :: Ord k => (k,Map k v) :-> Maybe v

I discarded this because composing this properly would eventually lead to something like:

foo :: (String,World) :-> Maybe Person

which doesn’t work well with fclabel’s ‘getM’ and ‘setM’ functions — these expect the left hand side of the label arrow to be your state value, which in my case, going to be of type ‘World’, rather than (String,World). So I next tried something like:

lm :: Ord k => k -> Map k v :-> Maybe v

The immediate question is what does an expression like set (lm “foo”) Nothing coll, where coll is some Map String v, mean? An interpretation of this label might be:

lm k = label (lookup k) (\ v m -> maybe (delete k m) (\ v' -> insert k v' m) v)

With this definition, set (lm “foo”) Nothing coll actually deletes element “foo” from collection coll. This makes sense, but, once composed further, say with a label for the ‘age’ component of the ‘Person’ type, you’d get a label:

lbl :: String -> Map String Person :-> Maybe Int

With the above definition of lm, set (lbl “foo”) Nothing coll would also delete the underlying Person from the collection (setting the ‘age’ of the person to ‘Nothing’ deletes the person). This doesn’t seem like a desirable semantics. Another issue I found is that while you can create a label with this type ( a :-> Maybe b), you can’t extend this to an arbitrary monad — you can’t construct a label of (say) type Monad m => String :-> m Int because you can’t create a function of type:

forall m . Monad m => m Int -> String -> String

that depends on the value of its first parameter in any way[1]. Much more useful are labels of type Monad m => m a :-> m b, which work ‘forwards and backwards’ for arbitrary monads, and solve the issue of the semantics of my Map label. The Map label becomes something like:

lm :: (MonadPlus m, Ord k) => String -> m (Map k v) :-> m v
lm k = label getter setter where

    getter = lookup k `liftM` coll >>= maybe mzero return
    setter mv mc = mv >>= \ v -> mc >>= \ c -> return $ insert k v c

Or, better, for my purposes (since I’m using an error monad):

lm :: (MonadError e m, Error e, Show k, Ord k) => k -> m (Map k v) :-> m v
lm k = label getter setter where
    getter mm = mm >>= (maybe (throwError $ err k) return) . lookup k
    setter mv mm = mv >>= \ v -> insert k v `liftM` mm
    err k = strMsg $ "key " ++ show k ++ " not found"

Setting with mzero / an error would have no effect on the collection, rather than delete an element. Of course, to compose with other labels, we need to lift the other labels into the monad:

liftML :: Monad m => a :-> b -> m a :-> m b
liftML l = label (liftM $ get l) (liftM2 $ set l)

With this definition of lm, along with liftML I’m should be able to compose my way from ‘World’ all the way to the _weight of an item. With explicit lifts, it looks something like:

worldWeight k1 k2 = liftML weight.lm k2.liftML possesions.lm k1.liftML people

To actually use the lifted labels, the fclabels-provided the ‘getM’, ‘setM/=:’ and ‘modM’ functions don’t work as expected. For example, with a label l of type Monad m => m World :-> m Int, the type of getM l is (Monad m, MonadState (m World) m1) => m1 (m Int). Some alternate versions are needed:

import qualified Control.Monad.State as SM

getM :: MonadState s m => m s :-> m b -> m b
getM l = get l SM.get
setM :: MonadState s m => m s :-> m b -> b -> m ()
setM l v = set l (return v) SM.get >>= SM.put
modM :: MonadState s m => m s :-> m b -> (b -> b) -> m ()
modM l f = mod l (liftM f) SM.get >>= SM.put

infixr 7 =:
(=:) = setM

We can get rid of the explicit ‘liftML’s by augmenting the fclabel package’s mkLabels Template Haskell function:

mkLabelsPlus :: [Name] -> Q [Dec]
mkLabelsPlus names = do
    decs <- mkLabels names
    decs2 <- mapM liftDec decs
    return (decs ++ decs2)
where liftDec     (FunD nm _) = funD (mkName (nameBase nm ++ "M"))
            [clause [] (normalB $ (appE (varE 'liftML) (varE nm))) []]

This function will generate the unlifted labels (e.g. ‘person’, ‘weight’) as well as lifted version of those labels, named with the ever-so-creative ‘M’ suffix, (e.g. ‘personM’, ‘weightM’). Since I will mainly use my labels in a monadic context, the extra M’s are annoying, so an alternate TH function renames the ‘unlifted’ labels (with a ‘U’ suffix), and uses the simple names for the monadic labels:

mkLabelsAlt :: [Name] -> Q [Dec]
mkLabelsAlt names = do
    decs <- mkLabels names
    decs2 <- mapM liftDec decs
    return (map change decs ++ decs2)
    where liftDec (FunD nm _) = funD (mkName (nameBase nm))
            [clause [] (normalB $ (appE (varE 'liftML) (varE (mkName $ nameBase nm ++ "U")))) []]
          change (FunD nm x) = FunD (mkName (nameBase nm ++ "U")) x

Now I can easily compose deep access to my state data:

-- set someones age to the price of their hat...
f1 k = do
    hatCost <- getM (cost.lm "hat".possessions.lm k.people)
    (age.lm k.people) =: floor hatCost

-- update or insert a person
f2 k = (lm k.people) =: Person { _name = "Fred", _age = 32, _possessions = M.empty }
-- set k's age to 32
f3 k = (age.lm k.people) =: 32

I can run these in an ErrorT / State monad with a function like:

run :: ErrorT String (SM.State World) a -> World -> (Either String a, World)
run f = (runState . runErrorT) f

a quick test:

*FCLTest> world
World {_timestamp = 0, _people = fromList [(“person1”,Person {_name = “Joe”, _age = 17, _possessions = fromList [(“camera”,Item {_cost = 599.0, _weight = 250.0}),(“ipod”,Item {_cost = 195.0, _weight = 36.4})]}),(“person2”,Person {_name = “Zeke”, _age = 88, _possessions = fromList [(“hat”,Item {_cost = 65.0, _weight = 200.0})]})]}
*FCLTest> run (f1 “person2”) world
(Right (),World {_timestamp = 0, _people = fromList [(“person1”,Person {_name = “Joe”, _age = 17, _possessions = fromList [(“camera”,Item {_cost = 599.0, _weight = 250.0}),(“ipod”,Item {_cost = 195.0, _weight = 36.4})]}),(“person2”,Person {_name = “Zeke”, _age = 65, _possessions = fromList [(“hat”,Item {_cost = 65.0, _weight = 200.0})]})]})

With fclabels, some augmentation, and a small amount of Template Haskell hackery, it looks like I’ll be able to get rid an immense amount of boilerplate.  I’ll post some code-reduction stats once available.


Leave a Comment »

No comments yet.

RSS feed for comments on this post. TrackBack URI

Leave a Reply

Fill in your details below or click an icon to log in: Logo

You are commenting using your account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

Create a free website or blog at

%d bloggers like this: