1{-# OPTIONS -fglasgow-exts #-}
2
3module GMapQAssoc (tests) where
4
5{-
6
7This example demonstrates the inadequacy of an apparently simpler
8variation on gmapQ. To this end, let us first recall a few facts.
9Firstly, function application (including constructor application) is
10left-associative. This is the reason why we had preferred our generic
11fold to be left-associative too. (In "The Sketch Of a Polymorphic
12Symphony" you can find a right-associative generic fold.)  Secondly,
13lists are right-associative. Because of these inverse associativities
14queries for the synthesis of lists require some extra effort to
15reflect the left-to-right of immediate subterms in the queried list.
16In the module Data.Generics, we solve the problem by a common
17higher-order trick, that is, we do not cons lists during folding but
18we pass functions on lists starting from the identity function and
19passing [] to the resulting function. The following example
20illustrates that we get indeed an undesirable right-to-left order if
21we just apply the simple constant datatype constructor CONST instead
22of the higher-order trick.
23
24Contributed by Ralf Laemmel, ralf@cwi.nl
25
26-}
27
28import Test.HUnit
29
30import Data.Generics
31
32
33-- The plain constant type constructor
34newtype CONST x y = CONST x
35unCONST (CONST x) = x
36
37
38-- A variation on the gmapQ combinator using CONST and not Q
39gmapQ' :: Data a => (forall a. Data a => a -> u) -> a -> [u]
40gmapQ' f = unCONST . gfoldl f' z
41  where
42    f' r a = CONST (f a : unCONST r)
43    z  = const (CONST [])
44
45
46-- A trivial datatype used for this test case
47data IntTree = Leaf Int | Fork IntTree IntTree
48               deriving (Typeable, Data)
49
50
51-- Select int if faced with a leaf
52leaf (Leaf i) = [i]
53leaf _        = []
54
55
56-- A test term
57term = Fork (Leaf 1) (Leaf 2)
58
59
60-- Process test term
61--  gmapQ  gives left-to-right order
62--  gmapQ' gives right-to-left order
63--
64tests = show ( gmapQ   ([] `mkQ` leaf) term
65             , gmapQ'  ([] `mkQ` leaf) term
66             ) ~=? output
67
68output = show ([[1],[2]],[[2],[1]])
69