Hi apfelmus,

Your code is fine, I like it. A minor hint is that mergeForest is a fold:
   mergeForest = foldr merge []
Also, we have
   prettyPrint = putStr . unlines . prettyPrint' $ forest

Nice help on the simple things.

I can't know, but it doesn't seem unreasonable that you intend to use
the ArcForest as a trie, i.e. an efficient implementation of a set of
paths which allows to look up quickly whether a given path (here of type
[String]) is in the set or not. So, we have

For a while, I was thinking what on Earth are you talking about, even while I continued reading the rest of the email, but it eventually clicked what you where trying to show me - which was something I didn't dare try until I got more familiar with Haskell.

You're examples got me started on dealing with these sorts of complex tree structures (or tries as you call them).  They made more sense as I spent more time reading and rereading them.

Now, we can build up our finite map for paths:

   data MapPath v = TriePath (Maybe v) (MapString (MapPath v))

because it (maybe) contains a value for the key '[] :: Path' and it
(maybe) contains a map of paths that is organized by their first String
element.

In my own code I had to diverge from your definition because for my needs, every node needed to contain a value (even if it was a default value).  I plan to later add other numerical values to every node so that I can traverse them and do calculations that feed up and trickle down the tree.

Now what about 'MapString v', how do we get this? Well, your
implementation corresponds to the choice

  type MapString v = [(String,v)]

But in our case, we can apply the same trick again! We have 'String =
[Char]' and given an implementation of

  data MapChar v = ...

we can use exactly the same code from 'MapPath v' to implement
'MapString v'! (This reuse can be abstracted into a type class, but I'll
not cover that here.) Of course, we need 'MapChar v' now. But yet, again
we can think of Char as

  Char ^= Int ^= [Bool]

where the '[Bool]' means the list of digits in binary representation.
So, given 'MapBool v', we can implement 'MapChar v' with yet again the
same code that we used for the preceding finite maps! Fortunately, the
recursion ends here because a finite map for 'Bool'eans is just the pair

  type MapBool v = (Maybe v, Maybe v)

That's quite beautiful, but I don't actually need to go that far.  Question though, does taking the approach to this conclusion actually have real applications?

In case your head does not yet hurt too much :), further information
about tries in Haskell and a detailed explanation of why the code above
works, can be found in.

I did try to write my own insertWithInit called by fromPath (below), which I couldn't get working.  Branches went missing from the result.  I had so much trouble figuring where in the function I forgot to do something.

At this point my head was about to explode, so I took a different approach using union called by fromList' (also below), which from my limited testing appears to work.  I also find the union function incredibly easy to understand.  I only hope I got it right.

Thanks much,

-John

import qualified Data.Map as Map
import Data.Map (Map)

type Path k = [k]

data Trie k v = Trie v (Map k (Trie k v)) deriving Show

singleton :: v -> Trie k v
singleton v = Trie v Map.empty

insertWithInit :: (Ord k) =>
  v -> (v -> v -> v) -> Path k -> v -> Trie k v -> Trie k v
insertWithInit _ fInsert [] v (Trie v' m) =
  Trie (fInsert v v') m
insertWithInit fInit fInsert (x:xs) v (Trie v' m) =
  Trie v' (Map.insertWith merge x subTrie m)
  where
    subTrie = insertWithInit fInit fInsert xs v (singleton fInit)
    merge = seq

-- Left biased union
union :: (Ord k) => Trie k v -> Trie k v -> Trie k v
union (Trie k0 v0) (Trie k1 v1) = Trie k0 v
  where
    v = Map.unionWith union v0 v1

fromPath :: (Ord k) => v -> v -> Path k -> Trie k v
fromPath initV v path = foldr addParent (singleton v) path
  where
    addParent step child = Trie initV (Map.fromList [(step, child)])

fromList :: [Path String] -> Trie String ()
fromList paths = foldl f (singleton ()) paths
  where
    f :: Trie String () -> Path String -> Trie String ()
    f trie path = insertWithInit () (\x y -> ()) path () trie

fromList' :: [Path String] -> Trie String ()
fromList' paths = foldl f (singleton ()) paths
  where
    f :: Trie String () -> Path String -> Trie String ()
    f trie path = union trie (fromPath () () path)

prettyPrint :: Trie String () -> IO ()
prettyPrint trie = putStrLn $ unlines $ prettyPrint' trie
  where
    prettyPrint' (Trie v m) = Map.foldWithKey f [] m
    f k a out = out ++ [k] ++ (map (" " ++) (prettyPrint' a))