Experiments with EMGM: Emacs org files

I've been meaning to write some things about EMGM for a while, but I hadn't found one of those round tuits as of yet. Until now.

David Miani is working on a Haskell library for interacting with emacs org files. "For those that do not know, an org file is a structured outline style file that has nested headings, text, tables and other elements," says David. He has a collection of datatypes for building and manipulating these files.

David seeks a better way to do what he's doing. (It's a noble goal. I hope you keep doing it.) To return to his words: "While writing an OrgFile is fairly easy, reading (and accessing inner parts) of an org file is very tedious, and modifying them is horrendous." He goes on to give an example that I'll describe more below.

When I read the above statement, I was expecting that generic programming could help him out. When I saw his code, I knew it was a perfect use case. That's what inspired this entry, the first use case for EMGM from Haskell Café.

First, this is a literate Haskell post, so we run through the usual preliminaries.

> {-# LANGUAGE TemplateHaskell       #-}
> {-# LANGUAGE MultiParamTypeClasses #-}
> {-# LANGUAGE FlexibleContexts      #-}
> {-# LANGUAGE FlexibleInstances     #-}
> {-# LANGUAGE OverlappingInstances  #-}
> {-# LANGUAGE UndecidableInstances  #-}
> 
> module Org where
> 
> import Text.Regex.Posix

We import Generics.EMGM.Derive for the deriving portion of EMGM. This is not exported from the main body of the library, because it has a lot of symbols only needed for building a representation. We'd rather not clog up your symbol list if possible.

> import Generics.EMGM.Derive

In general, I'd recommend doing the deriving in a separate module and only export the datatype and generated type class instances. Then, in other modules, you can use EMGM functions or write your own. However, this being a demonstration, we will also import Generics.EMGM here to use the available functions.

> import qualified Generics.EMGM as G

The following collection of types are copied from David's post. They describe the structure of an org file.

> type Line = Int
> type Column = Int
> 
> data FilePosition = FilePosition Line Column
> 
> data WithPos a = WithPos { filePos :: FilePosition, innerValue :: a }
> 
> data OrgTableP = OrgTableP [WithPos OrgTableRow]
> 
> data OrgFileElementP
>   = TableP OrgTableP
>   | ParagraphP String
>   | HeadingP OrgHeadingP
> 
> data OrgHeadingP = OrgHeadingP Int String [WithPos OrgFileElementP]
> 
> data OrgFileP = OrgFileP [WithPos OrgFileElementP]
> 
> data OrgTableRow
>   = OrgTableRow [String]
>   | OrgTableRowSep 

In order to use EMGM, we must generate the values and instances used by the library. This is simple with one Template Haskell (TH).

> $(deriveMany 
>   [ ''FilePosition
>   , ''WithPos
>   , ''OrgTableP
>   , ''OrgHeadingP
>   , ''OrgFileElementP
>   , ''OrgFileP
>   , ''OrgTableRow
>   ])

Note that in this case, we had to use deriveMany for a list of type names. For the most part, we'd probably use derive; however, the datatypes OrgHeadingP and OrgFileElementP are mutually recursive. If we use derive for each type, then some values are generated that are naturally also muturally recursive. Apparently, TH expects all symbols to be available on a per-splice basis. This means that we can't $(derive ''OrgFileElementP) and then $(derive ''OrgHeadingP) or vice versa. We have to derive them simultaneously, so that both sets of symbols are available at the same time.

David gives the example of reading "the description line for the project named 'Project14'" in the following file:

* 2007 Projects
** Project 1
Description: 1
Tags: None
** Project 2
Tags: asdf,fdsa
Description: hello
* 2008 Projects
* 2009 Projects
** Project14
Tags: RightProject
Description: we want this

He then provides some messy code to perform it. (No offense meant. Mine would've looked no better.) I'll skip the code, since I couldn't get it to compile as provided.

Our solution using EMGM follows:

> projDesc :: String -> OrgFileP -> Maybe String
> projDesc name file = do
>   hdg <- G.firstr (headings name file)
>   para <- firstPara hdg
>   if para =~ "Description" then return para else Nothing
> 
> headings :: String -> OrgFileP -> [OrgHeadingP]
> headings name = filter check . G.collect
>   where
>     check (OrgHeadingP _ possible _) = name == possible
> 
> firstPara :: OrgHeadingP -> Maybe String
> firstPara hdg = paraStr =<< G.firstr (G.collect hdg)
>   where
>     paraStr (ParagraphP str) = Just str
>     paraStr _                = Nothing

Primarily, we take advantage of the functions collect and firstr. Here, collect is the key. It's type is collect :: (Rep (Collect b) a) => a -> [b], and it returns a list of bs stored somewhere in a value of type a. This allows us to collect the OrgHeadingPs in an OrgFileP (headings) and the OrgFileElementPs in an OrgHeadingP (firstPara). Now, we don't have to build a bunch of functions that break down each of these types to get to their components.

Our use of firstr is simply the same as we would use the Prelude function head, except that firstr returns a Maybe: unlike head, it's a total function.

David's top-level function would now become this:

> get14 :: OrgFileP -> Maybe String
> get14 = projDesc "Project14"

Well, this was a fun experiment with generic programming. I hope to do more in the future.

I want to thank David for bringing up this problem in the mailing list. Not only did I get to play more with EMGM, I also released an update to the library when I discovered the issue requiring deriveMany.

Update 2008-03-30: The source code for this entry is now available at GitHub.

Template Haskell 2.3 or Cabal 1.2? EMGM can't have both!

Updates below!

I'm about ready to give up. I would like EMGM to support both GHC 6.8 and 6.10 to allow for more potential uses. This effectively means it should build with Cabal version 1.2 (which is distributed with GHC 6.8) and 1.6 (distributed with GHC 6.10). I didn't think this would be a difficult problem, — shows you what little I know — but it has turned into a reasonably sized annoyance.

As of version 0.2, EMGM supports generating code for type representations using Template Haskell (TH). Since TH is now a dependency, I thought it would be handy to provide the representation values and instances for it. And so I do that here. If you look at the linked file, you'll notice an #ifdef surrounding $(derive ''Loc). This is because the template-haskell package includes a new Loc datatype in version 2.3, and in order to support versions 2.2 (for GHC 6.8) and 2.3 (for GHC 6.10), I needed to do some funky C preprocessor (CPP) stuff.

Well, I followed the advice given in this thread started by Jason Ducek with useful responses from Duncan Coutts. The result was this emgm.cabal file with a flag for determining which version of template-haskell was available and whether or not to define the necessary macro. I later learned that this does't work when attempting to cabal-install GHC 6.8, because template-haskell-2.3 fails to correctly specify the version of base or GHC that it requires.

Now, to work around this problem, Duncan described how to hook into Cabal to get the actual package dependencies and insert the CPP option into the build info. It was not too difficult to figure this out. And in fact, the code for my Setup.lhs is in the appendix of this article in case it is later useful for me or someone else.

Unfortunately, as soon as I had this implemented, I discovered it didn't work in GHC 6.8.3/Cabal 1.2. There's a very minor difference in Cabal that simply breaks my code, and I don't know how to work around it. The difference is in PackageIdentifier:

Cabal 1.2:

> data PackageIdentifier = PackageIdentifier { pkgName :: String, pkgVersion :: Version }

Cabal 1.6:

> data PackageIdentifier = PackageIdentifier { pkgName :: PackageName, pkgVersion :: Version }
> newtype PackageName = PackageName String

I need PackageIdentifier to determine which version of template-haskell is being used as a dependency. But I either use a String or a PackageName depending on which version of Cabal is used. I don't think there's a way to know which version of Cabal is used when building a Setup.lhs file.

As far as I can tell, my options are the following:

1. Hack more on the Setup.lhs to figure out a different way of dealing with the template-haskell issue.
2. Release for GHC 6.10 only. Note that the problem only occurs when mixing cabal-install and template-haskell. EMGM builds fine with GHC 6.8 in general.
3. Remove the TH deriving code and the CPP macro.
4. Leave things as they are and warn people about the issue. If/when template-haskell gets patched, it may fix the problem.

I'm probably going to go with the last option for now.

Appendix

This is a literate Haskell Setup.lhs containing a build hook for passing a CPP option when a version of the template-haskell package greater than or equal to 2.3 is specified as a dependency. You might find it a useful example of using part of the Cabal library.

> module Main (main) where

> import System.Cmd
> import System.FilePath

> import Data.Version

> import Distribution.Simple
> import Distribution.Simple.LocalBuildInfo
> import Distribution.Simple.Program
> import Distribution.Simple.Setup

> import Distribution.Package
> import Distribution.PackageDescription

> main :: IO ()
> main = defaultMainWithHooks hooks
>   where
>     hooks = simpleUserHooks { buildHook = buildHook' }

> -- Insert CPP flag for building with template-haskell versions >= 2.3.
> buildHook' :: PackageDescription -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()
> buildHook' pkg lbi hooks flags =
>   buildHook simpleUserHooks pkg (lbi { localPkgDescr = newPkgDescr }) hooks flags
>   where

>     -- Old local package description
>     oldPkgDescr = localPkgDescr lbi

>     -- New local package description
>     newPkgDescr =
>       case thVersion of
>         Nothing ->
>           oldPkgDescr
>         Just version ->
>           if version >= Version [2,3] []
>           then
>             oldPkgDescr
>               { library = addThCppToLibrary (library oldPkgDescr)
>               , executables = map addThCppToExec (executables oldPkgDescr)
>               }
>           else
>             oldPkgDescr

>     -- Template Haskell package name
>     thPackageName = "template-haskell"

>     -- template-haskell version
>     thVersion = findThVersion (packageDeps lbi)

>     -- CPP options for template-haskell >= 2.3
>     thCppOpt = "-DTH_LOC_DERIVEREP"

>     -- Find the version of the template-haskell package
>     findThVersion []          = Nothing
>     findThVersion (PackageIdentifier (PackageName name) version:ps)
>       | name == thPackageName = Just version
>       | otherwise             = findThVersion ps

>     -- Add the template-haskell CPP flag to a BuildInfo
>     addThCppToBuildInfo :: BuildInfo -> BuildInfo
>     addThCppToBuildInfo bi =
>       bi { cppOptions = thCppOpt : cppOptions bi }

>     -- Add the template-haskell CPP flag to a library package description
>     addThCppToLibrary :: Maybe Library -> Maybe Library
>     addThCppToLibrary ml = do
>       lib <- ml
>       return (lib { libBuildInfo = addThCppToBuildInfo (libBuildInfo lib) })

>     -- Add the template-haskell CPP flag to an executable package description
>     addThCppToExec :: Executable -> Executable
>     addThCppToExec exec =
>       exec { buildInfo = addThCppToBuildInfo (buildInfo exec) }

P.S. I used the recently released pandoc 1.2 for this article. Nice highlighting, eh?

Update #1: Apparently, Blogger's feed and/or Planet Haskell aren't ready for the games I played with pandoc. Thus, I have removed the syntax highlighting. That's unfortunate, because it looked good on the web.

Update #2: Thanks to the magic of the internets and the fact that there are people much smarter than I, there is a solution. In hindsight, it's obvious (of course): dynamically typed programming!

Neil Mitchell sent me this little piece of code which does just the trick:

> mkPackageName :: (Read a) => String -> a
> mkPackageName nm =
>   fst $ head $ reads shownNm ++ reads ("PackageName " ++ shownNm)
>   where
>     shownNm = show nm

So, I plugged this into thPackageName, removed PackageName from the pattern in findThVersion, and—voilà!—it worked.

Incremental fold, a design pattern

I recently read the article "How to Refold a Map" by David F. Place in The Monad.Reader Issue 11. I've been thinking about incremental algorithms in Haskell for some time, and I realized that Place has written a specific instance (and optimization) of a more general concept: the incremental fold.

In this article, I demonstrate a design pattern for converting a datatype and related functions into an incremental fold. The pattern is not difficult to comprehend, but it would be nice to improve upon it. I explore a few improvements and issues with those improvements. Ultimately, I'd like to see this functionality in a program instead of a design pattern.

Note: This is a literate Haskell article. You can copy the text of the entire article, paste it into a new file called IncrementalTreeFold.lhs, and load it into GHCi.

> {-# LANGUAGE MultiParamTypeClasses #-}
> {-# LANGUAGE FlexibleInstances #-}
> {-# LANGUAGE ScopedTypeVariables #-}

> module IncrementalTreeFold where
> import Prelude hiding (elem)
> import qualified Data.Char as Char (ord)

Introducing a Typical Binary Tree

Before we get to the conversion, let's choose an appropriate datatype. Place adapted the Map type used in Data.Map (or Set in Data.Set). To simplify my presentation, I will use an ordered binary tree with labeled nodes.

> data Tree a
>   = Tip
>   | Bin a (Tree a) (Tree a)
>   deriving Show

Next, let's introduce some useful functions. An incremental fold is not necessarily like applying a fold function (a.k.a. a catamorphism, not a crush function that has become known as a fold) to a value directly. Instead, as I will later show, it integrates into existing functions that manipulate values. That said, we should have some functions for building Trees. Here is the beginning of a Tree API. (There are a number of other operations, e.g. delete and lookup, that can easily be added but do not contribute much to the discussion.)

empty builds a tree with no elements.

> empty :: (Ord a) => Tree a
> empty = Tip

singleton builds a tree with a single element.

> singleton :: (Ord a) => a -> Tree a
> singleton x = Bin x Tip Tip

insert puts a value in the appropriate place given a left-to-right ordering of values in the tree.

> insert :: (Ord a) => a -> Tree a -> Tree a
> insert x t =
>   case t of
>     Tip ->
>       singleton x
>     Bin y lt rt ->
>       case compare x y of
>         LT -> Bin y (insert x lt) rt
>         GT -> Bin y lt (insert x rt)
>         EQ -> Bin x lt rt

fromList creates a tree from a list of values.

> fromList :: (Ord a) => [a] -> Tree a
> fromList = foldr insert empty

elem determines if a value is an element of a tree.

> elem :: (Ord a) => a -> Tree a -> Bool
> elem x t =
>   case t of
>     Tip ->
>       False
>     Bin y lt rt ->
>       case compare x y of
>         LT -> elem x lt
>         GT -> elem x rt
>         EQ -> True

Now, using our library of sorts, we can create binary search tree and check if a value is in the tree.

> test1 = 37 `elem` fromList [8,23,37,82,3]

Tree Folds

Suppose that we now want the size of the tree. For good abstraction and high reuse, we create a fold function.

> data Alg a b = Alg { ftip :: b, fbin :: a -> b -> b -> b }

> fold :: Alg a b -> Tree a -> b
> fold alg = go
>   where
>     go Tip           = ftip alg
>     go (Bin x lt rt) = fbin alg x (go lt) (go rt)

fold allows us to write a simple size function.

> size :: Tree a -> Int
> size = fold (Alg 0 (\_ lr rr -> 1 + lr + rr))

I use the datatype Alg here to contain the algebra of the fold. In size, we simply replace each constructor in the algebra of Tree with a corresponding element from the algebra of integer addition. Since you're reading this article, you're probably a Haskell programmer and already familiar with the sorts of functions that can be written with folds. Here are a few others.

> filter :: (a -> Bool) -> Tree a -> [a]
> filter f = fold (Alg [] (\x lr rr -> if f x then [x] else [] ++ lr ++ rr))

> ord :: Tree Char -> Tree Int
> ord  = fold (Alg Tip (\x lt rt -> Bin (Char.ord x) lt rt))

Incremental Change

Now that we have a grasp on using a fold on a datatype, I would like to show how to extend my binary tree "library" defined above to support an incremental fold. The incremental fold can (I believe) do everything a traditional fold can do, but it does it during Tree construction instead of externally in a separate function. This means that every time we produce a new Tree (via singleton, insert, or fromList for example), we get a new result of the incremental fold.

Transforming our library into an incremental calculating machine involves several steps. The first step is extending the datatype to hold the incremental result. Since we want to be polymorphic in the result type, we add a type parameter r to the Tree type constructor. And since each constructor may possibly have an incremental result, it must also be extended with a place holder for r.

> data Tree' a r
>   = Tip' r
>   | Bin' a (Tree' a r) (Tree' a r) r
>   deriving Show

For convenience and possibly to hide the modified constructors from the outside world, we add a function for retrieving the increment result.

> result' :: Tree' a r -> r
> result' (Tip' r)       = r
> result' (Bin' _ _ _ r) = r

As I mentioned earlier, the machinery of the fold is now in the construction. To implement this second step, we use smart constructors.

> tip' :: Alg a r -> Tree' a r
> tip' alg = Tip' (ftip alg)

> bin' :: Alg a r -> a -> Tree' a r -> Tree' a r -> Tree' a r
> bin' alg x lt rt = Bin' x lt rt (fbin alg x (result' lt) (result' rt))

Both tip' and bin' construct new values of Tree' a r and using the algebra, calculate the incremental result to be stored in each value. Thus, the actual fold operation is "hidden" in the construction of values.

Now, in order to put the incremental fold to work in a function, we simply (1) add the algebra to the function's arguments, (2) add an wildcard pattern for the result field in constructor patterns, and (3) replace applications of the constructors with that of their incremental cousins. Here's an example of the singleton and insert functions modified for incremental folding.

> singleton' :: (Ord a) => Alg a r -> a -> Tree' a r
> singleton' alg x = bin' alg x (tip' alg) (tip' alg)

> insert' :: (Ord a) => Alg a r -> a -> Tree' a r -> Tree' a r
> insert' alg x t =
>   case t of
>     Tip' _ ->
>       singleton' alg x
>     Bin' y lt rt _ ->
>       case compare x y of
>         LT -> bin' alg y (insert' alg x lt) rt
>         GT -> bin' alg y lt (insert' alg x rt)
>         EQ -> bin' alg x lt rt

Comparing these functions with the initial versions, we see that the changes are readily apparent. Modify every other Tree'-hugging function in the same manner, and you have a design pattern for an incremental fold!

Improving the Incremental Implementation

Of course, you may complain that there's some amount of boilerplate work involved. For example, we have to add this alg argument everywhere. Let's try to replace that with a type class.

< class Alg'' a r where
<   ftip'' :: r
<   fbin'' :: a -> r -> r -> r

And we redefine our smart constructors.

< tip'' :: (Alg' a r) => Tree' a r
< tip'' = Tip' ftip''

But there's a problem here! GHC reports that it Could not deduce (Alg'' a r) from the context (Alg'' a1 r). The poor compiler cannot infer the type of the parameter a since ftip'' has only type r.

Let's try another version of the class. In this one, we add a dummy argument to ftip' in order to force GHC to correctly infer the full type.

> class Alg'' a r where
>   ftip'' :: a -> r
>   fbin'' :: a -> r -> r -> r

> tip'' :: forall a r . (Alg'' a r) => Tree' a r
> tip'' = Tip' (ftip'' (undefined :: a))

> bin'' :: (Alg'' a r) => a -> Tree' a r -> Tree' a r -> Tree' a r
> bin'' x lt rt = Bin' x lt rt (fbin'' x (result' lt) (result' rt))

This provides one (not very pretty) solution to the problem. I'm able to get around the need to require an argument for tip'' by using lexically scoped type variables. But it doesn't remove the ugly type from ftip'', and the user is forced to ignore it when writing an instance.

The functions can now be rewritten with the Alg'' constraint.

> empty'' :: (Ord a, Alg'' a r) => Tree' a r
> empty'' = tip''

> singleton'' :: (Ord a, Alg'' a r) => a -> Tree' a r
> singleton'' x = bin'' x tip'' tip''

> insert'' :: (Ord a, Alg'' a r) => a -> Tree' a r -> Tree' a r
> insert'' x t =
>   case t of
>     Tip' _ ->
>       singleton'' x
>     Bin' y lt rt _ ->
>       case compare x y of
>         LT -> bin'' y (insert'' x lt) rt
>         GT -> bin'' y lt (insert'' x rt)
>         EQ -> bin'' x lt rt

> fromList'' :: (Ord a, Alg'' a r) => [a] -> Tree' a r
> fromList'' = foldr insert'' empty''

These versions look more like the non-incremental implementations above. To use them, we need to declare an instance of Alg'' with an appropriate algebra for our desired incremental result. Here's how we would rewrite size.

> newtype Size = Size { unSize :: Int }

> instance Alg'' a Size where
>   ftip'' _ = Size 0
>   fbin'' _ lr rr = Size (1 + unSize lr + unSize rr)

> size'' :: Tree' a Size -> Int
> size'' = unSize . result'

> test2 = size'' $ insert'' 's' $ insert'' 'p' $ insert'' 'l' $ fromList'' "onderzoek"

Size is still defined as a fold, but the result is incrementally built with each application of a library function. This can have a nice performance boost as Place also found in his article.

Generic Thoughts

On reflecting over my implementation, I really don't like the dummy arguments required by constructors like Tip. There are other approaches to dealing with this, but I haven't yet found a better one. If you use a functional dependency such as r -> a in the definition of Alg'', then a would be uniquely determined by r. In the case of size'', we would have to specify a concrete element type for Tree' instead of the parameter a (or use undecidable instances). Perhaps, dear reader, you might have a better solution?

The incremental fold pattern is great for documenting an idea, but it has several downsides: (1) The obvious one is that it requires modifying a datatype and code. This is not always desirable and often not practical. (2) Implementing an incremental fold can involve a lot of boilerplate code and many, small changes that are monotonous and boring. It's very easy to make mistakes. In fact, I made several copy-paste-and-forget-to-change errors while writing this article.

As Jeremy Gibbons and others have shown us, design patterns are better as programs. Since the code is so regular, it seems very receptive to some generic programming. I plan to explore this further, possibly using one of the many generics libraries available for Haskell or designing a new one. Suggestions and feedback are welcome.

Update 2008-03-30: The source code for this entry is now available at GitHub.