[Haskell-cafe] Paths to tree

[John Ky]

Hi,

I've written some code and was wondering if there was a better way to write
it in terms of readability, brevity and/or efficiency.

The function concerned is pathsToForest which takes a list of paths (ie.
[[String]]) and converts it into a tree structure where the individual nodes
are the names in the path.  Siblings with the same name are merged.

For instance:

  prettyPrint $ mergeForest $ pathsToForest [["a", "b", "c"], ["c", "b",
"a"], ["a", "b", "d"]]

gives:

  a
   b
    d
    c
  c
   b
    a

Thanks

-John

import Data.Tree
import Control.Monad

data ArcData = ArcData
  { name :: String
  } deriving Show

type ArcTree = Tree ArcData
type ArcForest = Forest ArcData

pathsToForest :: [[String]] -> ArcForest
pathsToForest paths = mergeForest $ concat $ map pathToTree paths


mergeForest :: ArcForest -> ArcForest
mergeForest [] = []
mergeForest (x:xs) = merge x (mergeForest xs)
  where
    merge :: ArcTree -> ArcForest -> ArcForest
    merge tree [] = [tree]
    merge tree (y:ys) =
      if sameTreeName tree y
        then
          merge
            tree
            { subForest = mergeForest ((subForest tree) ++ (subForest y))
            }
            ys
        else
          (y:merge tree ys)

treeName :: ArcTree -> String
treeName tree = name $ rootLabel $ tree

sameTreeName :: ArcTree -> ArcTree -> Bool
sameTreeName treeLeft treeRight = treeName treeLeft == treeName treeRight

pathToTree :: [String] -> ArcForest
pathToTree [] = []
pathToTree (name:subpath) =
  [ Node
    { rootLabel = ArcData { name = name }
    , subForest = pathToTree subpath
    }
  ]

prettyPrint' :: ArcForest -> [String]
prettyPrint' [] = []
prettyPrint' (x:xs) =
      [name $ rootLabel $ x] ++ (map (" " ++) (prettyPrint' $ subForest x))
++
      prettyPrint' xs

prettyPrint :: ArcForest -> IO ()
prettyPrint forest = do
  forM_ (prettyPrint' forest) putStrLn
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.haskell.org/pipermail/haskell-cafe/attachments/20070129/0055719d/attachment.htm