An elegant way to convert a tree to a functional graph library tree?

Question

My question is about the seeming awkwardness of transforming a tree into its functional graph representation , in which you need to explicitly refer to the node names in order to insert additional nodes / edges.

In particular, I recursively built a rosewood tree (currently Data.Tree.Tree a from containers ) and want to convert it to Gr a () to call various functions against it. To do this, you can first go through the tree (using the delivery monad or one of the FGL state monad types, such as NodeMapM) and mark each node with an identifier:

 {-# LANGUAGE TupleSections #-} import Control.Monad.Supply import Data.Graph.Inductive import Data.Tree tagTree :: Tree a -> Supply Int (Tree (a,Int)) tagTree (Node n xs) = do xs' <- sequence (map tagTree xs) s <- supply return $ Node (n,s) xs' 

and then evalSupply (tagTree tree) [1..] , then use something like

 taggedTreeToGraph :: Tree (a,Int) -> Gr a () taggedTreeToGraph (Node (n,i) xs) = ([],i,n,map (((),) . snd . rootLabel) xs) & foldr graphUnion empty (map taggedTreeToGraph xs) where graphUnion = undefined -- see 'mergeTwoGraphs' in package 'gbu' 

Of course, these two stages can be combined.

So is this a good way to do this conversion? Or is there an easier way that I skip, or an abstraction that I have to use to convert a tree of a tree with similar data (hopefully very general) to an FGL tree?

Editing: I think the point of view on this question is that my original parser is only four lines long and uses very simple combinators such as liftA (flip Node []) , but it seems to take a lot to change the return view The code above is weird.

(I would be happy to create Gr a () directly from the analyzer (a simple applicative parser using Parsec) with monad transformers, provided that it requires minimally invasive changes to the parser.)

Answer 1

You can use Writer to collect a list of nodes and a list of edges to go to mkGraph . Using lists with Writer inefficient, so I use DList instead and convert back to lists at the end.

 import Data.Tree import Data.Graph.Inductive import Data.DList (singleton, fromList, toList) import Control.Monad.RWS import Control.Arrow treeToGraph :: Tree a -> Gr a () treeToGraph t = uncurry mkGraph . (toList *** toList) . snd $ evalRWS (go t) () [1..] where go (Node a ns) = do i <- state $ head &&& tail es <- forM ns $ go >=> \j -> return (i, j, ()) tell (singleton (i, a), fromList es) return i