1{-# LANGUAGE DeriveDataTypeable  #-}
2{-# LANGUAGE ScopedTypeVariables #-}
3
4{-
5
6A very, very simple example: "extract all Ints from a tree of Ints".
7The text book approach is to write a generalised fold for that. One
8can also turn the Tree datatype into functorial style and then write a
9Functor instance for the functorial datatype including a definition of
10fmap. (The original Tree datatype can be related to the functorial
11version by the usual injection and projection.)
12
13You can scrap all such boilerplate by using a traversal scheme based
14on gmap combinators as illustrated below. To get it a little more
15interesting, we use a datatype Tree with not just a case for leafs and
16fork trees, but we also add a case for trees with a weight.
17
18For completeness' sake, we mention that the fmap/generalised fold
19approach differs from the gmap approach in some details. Most notably,
20the gmap approach does not generally facilitate the identification of
21term components that relate to the type parameter of a parameterised
22datatype. The consequence of this is illustrated below as well.
23Sec. 6.3 in "Scrap Your Boilerplate ..." discusses such `type
24distinctions' as well.
25
26-}
27
28module FoldTree (tests) where
29
30import Test.HUnit
31
32-- Enable "ScrapYourBoilerplate"
33import Data.Generics
34
35
36-- A parameterised datatype for binary trees with data at the leafs
37data Tree a w = Leaf a
38              | Fork (Tree a w) (Tree a w)
39              | WithWeight (Tree a w) w
40       deriving (Typeable, Data)
41
42
43-- A typical tree
44mytree :: Tree Int Int
45mytree = Fork (WithWeight (Leaf 42) 1)
46              (WithWeight (Fork (Leaf 88) (Leaf 37)) 2)
47
48-- A less typical tree, used for testing everythingBut
49mytree' :: Tree Int Int
50mytree' = Fork (Leaf 42)
51               (WithWeight (Fork (Leaf 88) (Leaf 37)) 2)
52
53
54-- Print everything like an Int in mytree
55-- In fact, we show two attempts:
56--   1. print really just everything like an Int
57--   2. print everything wrapped with Leaf
58-- So (1.) confuses leafs and weights whereas (2.) does not.
59-- Additionally we test everythingBut, stopping when we see a WithWeight node
60tests = show ( listify (\(_::Int) -> True)         mytree
61             , everything (++) ([] `mkQ` fromLeaf) mytree
62             , everythingBut (++)
63                 (([],False) `mkQ` (\x -> (fromLeaf x, stop x))) mytree'
64             ) ~=? output
65  where
66    fromLeaf :: Tree Int Int -> [Int]
67    fromLeaf (Leaf x) = [x]
68    fromLeaf _        = []
69    stop :: (Data a, Data b) => Tree a b -> Bool
70    stop (WithWeight _ _) = True
71    stop _                = False
72
73output = "([42,1,88,37,2],[42,88,37],[42])"
74