Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Avoiding boilerplate when dealing with many unrelated types

I'm writing code that deals with values from Language.Exts.Annotated.Syntax, where a variety of types are defined that mirror the structure of a Haskell module:

data Module l = ...
data Decl l = ...
data Exp t = ...
-- etc

I'd like to be able to write functions that walk these data structures and perform various transformations on them. Because there's no one common data type, I can't write one function that does everything.

So far I've written a Tree type that wraps each of these types so that my transformation function can do Tree l -> Tree l:

data Tree l = ModuleT (Module l)
            | DeclT (Decl l)
            | ExpT (Exp l)
            -- etc copy & paste

However I'm now finding myself writing a lot of code that takes a Module, wraps it ModuleT, calls a function, then unwraps the result back to Module again. I have:

class AnnotatedTree ast where
  tree :: ast l -> Tree l
  untree :: Tree l -> ast l

instance AnnotatedTree Module where
  tree = ModuleT
  untree (ModuleT x) = x
  untree _ = error "expected ModuleT"

-- etc ad nauseam

Two questions:

  1. Given that I can't change the types in Language.Exts.Annotated.Syntax, am I going about this the wrong way?
  2. If not, can I cut down on all this boilerplate somehow?
like image 405
Tim Robinson Avatar asked Dec 06 '09 13:12

Tim Robinson


1 Answers

All of those types seem to be instances of Typeable and Data. You can define your type Tree to be an instance of Typeable and Data as well, and then use one of the available generics libraries (SYB, uniplate, ...) to traverse the Tree with ease.

My personal favorite is uniplate. For example, collecting all GuardedAlt from Tree would be as easy as:

import Data.Uniplate.PlateData

...

allGuardedAlts :: Tree l -> [l]
allGuardedAlts t = [ l | GuardedAlt l _ _ <- universeBi t]

You could take a look at my package graphtype where I did similar things.

like image 143
ADEpt Avatar answered Oct 21 '22 20:10

ADEpt