Ticket #2607: selector.hs

File selector.hs, 1.6 KB (added by simonmar, 6 years ago)
Line 
1module Main where
2
3-- A simple tree to hold hierarchial XML-like data structure
4
5data Tree a = Tree a [Tree a] deriving Show
6
7-- A member of the event sequence which attempts to build a tree.
8-- For example, the following sequence
9--     [Start "top", Leaf "leaf", Start "sub", Stop, Stop]
10-- should correspond to the following tree:
11--     Tree "top" [Tree "leaf" [], Tree "sub" []]
12
13data TreeEvent = Start String   -- Branch off a new subtree
14                | Stop          -- Stop branching and return 1 level
15                | Leaf String   -- A simple leaf without children
16                deriving Show
17
18-- Lazy printing of an infinite tree building process
19
20main = print . snd . build $ Start "top" : cycle [Leaf "sub"]
21
22-- Convert a stream of tree building events
23-- into a list of unconsumed events and a constructed tree body.
24
25type UnconsumedEvent = TreeEvent        -- Alias for program documentation
26
27build :: [TreeEvent] -> ([UnconsumedEvent], [Tree String])
28build (Start str : es) =
29        let (es', subnodes) = build es
30            (spill, siblings) = build es'
31        in (spill, (Tree str subnodes : siblings))
32build (Leaf str : es) =
33        let (spill, siblings) = build es
34        in (spill, Tree str [] : siblings)
35build (Stop : es) = (es, [])
36build [] = ([], [])
37
38-- Stricter version of build, never terminates on infinite input,
39-- but exhibits no space leaks whatsoever.
40build' f (Start str : es) =
41        let (es', subnodes) = build' id es
42        in build' ((Tree str subnodes) :) es'
43build' f (Leaf str : es) = build' ((Tree str []) :) es
44build' f (Stop : es) = (es, f [])
45build' f [] = ([], f [])