1{-|
2    SYB compatibility layer. This module serves as a drop-in
3    replacement in some situations for some of the SYB operations.
4    Users should also import "Data.Generics.Uniplate.Data".
5
6    SYB is described in the paper: \"Scrap your boilerplate: a practical design
7    pattern for generic programming\" by Ralf Lammel and Simon
8    Peyton Jones.
9
10    * <http://www.cs.vu.nl/boilerplate/>
11
12    * <http://doi.acm.org/10.1145/604174.604179>
13
14    * <http://www.cs.vu.nl/boilerplate/tldi03.pdf>
15-}
16
17module Data.Generics.SYB where
18
19import Data.Generics.Uniplate.Operations
20
21
22-- | @gmapT == 'descend'@
23gmapT :: Uniplate a => (a -> a) -> a -> a
24gmapT = descend
25
26
27-- | Use 'children' and 'foldl'
28gmapQl :: Uniplate a => (r -> r' -> r) -> r -> (a -> r') -> a -> r
29gmapQl combine zero op = foldl combine zero . map op . children
30
31
32-- | Use 'children' and 'foldr'
33gmapQr :: Uniplate a => (r' -> r -> r) -> r -> (a -> r') -> a -> r
34gmapQr combine zero op = foldr combine zero . map op . children
35
36
37-- | Use 'children'
38gmapQ :: Uniplate a => (a -> u) -> a -> [u]
39gmapQ f = map f . children
40
41
42-- | Use 'children' and '!!'
43gmapQi :: Uniplate a => Int -> (a -> u) -> a -> u
44gmapQi i f x = gmapQ f x !! i
45
46
47-- | @gmapM == 'descendM'@
48gmapM :: (Uniplate a, Applicative m) => (a -> m a) -> a -> m a
49gmapM = descendM
50
51
52
53-- | @mkT == 'id'@
54mkT :: (a -> a) -> (a -> a)
55mkT = id
56
57
58-- | @everywhere == 'transformBi'@
59everywhere :: Biplate b a => (a -> a) -> b -> b
60everywhere = transformBi
61
62
63-- | @mkM == id@
64mkM :: (a -> m a) -> a -> m a
65mkM = id
66
67
68-- | @everywhereM == 'transformBiM'@
69everywhereM :: (Biplate b a, Monad m, Applicative m) => (a -> m a) -> b -> m b
70everywhereM = transformBiM
71
72
73
74-- | Only for use with 'everything'
75mkQ :: r -> (a -> r) -> (r, a -> r)
76mkQ = (,)
77
78
79-- | Use 'universe' or 'universeBi', perhaps followed by a fold.
80--
81--   Not an exact equivalent to the SYB @everything@, as the
82--   operators may be applied in different orders.
83everything :: Biplate b a => (r -> r -> r) -> (r, a -> r) -> b -> r
84everything combine (nil, op) = foldl combine nil . map op . universeBi
85