/
Traversable.hs
154 lines (136 loc) · 4.13 KB
/
Traversable.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
{-# LANGUAGE ConstraintKinds, KindSignatures, MultiParamTypeClasses, RankNTypes, UndecidableInstances, ImplicitParams, ScopedTypeVariables #-}
-- | All of the functions below work only on «interesting» subterms.
-- It is up to the instance writer to decide which subterms are
-- interesting and which subterms should count as immediate. This can
-- also depend on the context @c@.
--
-- The context, denoted @c@, is a constraint (of kind @* -> Constraint@)
-- that provides additional facilities to work with the data. Most
-- functions take an implicit parameter @?c :: p c@; it's
-- used to disambugate which context you are referring to. @p@ can be
-- @Proxy@ from the @tagged@ package or any other suitable type
-- constructor.
--
-- For more information, see:
--
-- [Scrap your boilerplate with class]
-- <http://research.microsoft.com/en-us/um/people/simonpj/papers/hmap/>
--
-- [Generalizing generic fold]
-- <http://ro-che.info/articles/2013-03-11-generalizing-gfoldl.html>
module Data.Generics.Traversable
(
-- * Open recursion combinators
GTraversable(..)
, gmap
, gmapM
, gfoldMap
, gfoldr
, gfoldl'
-- * Closed recursion combinators
, Rec
, everywhere
, everywhere'
, everywhereM
, everything
)
where
import GHC.Exts (Constraint)
import Control.Applicative
import Control.Monad
import Data.Monoid
import Data.Functor.Identity
import Data.Functor.Constant
import Data.Generics.Traversable.Core
import Data.Generics.Traversable.Instances ()
-- for documentation only
import Data.Foldable
import Data.Traversable
-- | 'Rec' enables \"deep traversals\".
--
-- It is satisfied automatically when its superclass constraints are
-- satisfied — you are not supposed to declare new instances of this class.
class (GTraversable (Rec c) a, c a) => Rec (c :: * -> Constraint) a
instance (GTraversable (Rec c) a, c a) => Rec (c :: * -> Constraint) a
-- | Generic map over the immediate subterms
gmap
:: (GTraversable c a, ?c :: p c)
=> (forall d . (c d) => d -> d)
-> a -> a
gmap f = runIdentity . gtraverse (Identity . f)
-- | Generic monadic map over the immediate subterms
gmapM
:: (Monad m, GTraversable c a, ?c :: p c)
=> (forall d . (c d) => d -> m d)
-> a -> m a
gmapM f = unwrapMonad . gtraverse (WrapMonad . f)
-- | Generic monoidal fold over the immediate subterms (cf. 'foldMap' from
-- "Data.Foldable")
gfoldMap
:: (Monoid r, GTraversable c a, ?c :: p c)
=> (forall d . (c d) => d -> r)
-> a -> r
gfoldMap f = getConstant . gtraverse (Constant . f)
-- | Generic right fold over the immediate subterms
gfoldr
:: (GTraversable c a, ?c :: p c)
=> (forall d . (c d) => d -> r -> r)
-> r -> a -> r
gfoldr f z t = appEndo (gfoldMap (Endo . f) t) z
-- | Generic strict left fold over the immediate subterms
gfoldl'
:: (GTraversable c a, ?c :: p c)
=> (forall d . (c d) => r -> d -> r)
-> r -> a -> r
gfoldl' f z0 xs = gfoldr f' id xs z0
where f' x k z = k $! f z x
data Proxy (c :: * -> Constraint) = Proxy
-- | Apply a transformation everywhere in bottom-up manner
everywhere
:: forall a c p .
(Rec c a, ?c :: p c)
=> (forall d. (Rec c d) => d -> d)
-> a -> a
everywhere f =
let ?c = Proxy :: Proxy (Rec c) in
let
go :: forall a . Rec c a => a -> a
go = f . gmap go
in go
-- | Apply a transformation everywhere in top-down manner
everywhere'
:: forall a c p .
(Rec c a, ?c :: p c)
=> (forall d. (Rec c d) => d -> d)
-> a -> a
everywhere' f =
let ?c = Proxy :: Proxy (Rec c) in
let
go :: forall a . Rec c a => a -> a
go = gmap go . f
in go
-- | Monadic variation on everywhere
everywhereM
:: forall m a c p .
(Monad m, Rec c a, ?c :: p c)
=> (forall d. (Rec c d) => d -> m d)
-> a -> m a
everywhereM f =
let ?c = Proxy :: Proxy (Rec c) in
let
go :: forall a . Rec c a => a -> m a
go = f <=< gmapM go
in go
-- | Strict left fold over all elements, top-down
everything
:: forall r a c p .
(Rec c a, ?c :: p c)
=> (r -> r -> r)
-> (forall d . (Rec c d) => d -> r)
-> a -> r
everything combine f =
let ?c = Proxy :: Proxy (Rec c) in
let
go :: forall a . Rec c a => a -> r
go x = gfoldl' (\a y -> combine a (go y)) (f x) x
in go