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
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
|
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- Module : Data.Traversable
-- Copyright : Conor McBride and Ross Paterson 2005
-- License : BSD-style (see the LICENSE file in the distribution)
--
-- Maintainer : libraries@haskell.org
-- Stability : experimental
-- Portability : portable
--
-- Class of data structures that can be traversed from left to right,
-- performing an action on each element.
--
-- See also
--
-- * /Applicative Programming with Effects/,
-- by Conor McBride and Ross Paterson, online at
-- <http://www.soi.city.ac.uk/~ross/papers/Applicative.html>.
--
-- * /The Essence of the Iterator Pattern/,
-- by Jeremy Gibbons and Bruno Oliveira,
-- in /Mathematically-Structured Functional Programming/, 2006, and online at
-- <http://web.comlab.ox.ac.uk/oucl/work/jeremy.gibbons/publications/#iterator>.
--
-- Note that the functions 'mapM' and 'sequence' generalize "Prelude"
-- functions of the same names from lists to any 'Traversable' functor.
-- To avoid ambiguity, either import the "Prelude" hiding these names
-- or qualify uses of these function names with an alias for this module.
module Data.Traversable (
Traversable(..),
for,
forM,
mapAccumL,
mapAccumR,
fmapDefault,
foldMapDefault,
) where
import Prelude hiding (mapM, sequence, foldr)
import qualified Prelude (mapM, foldr)
import Control.Applicative
import Data.Foldable (Foldable())
import Data.Monoid (Monoid)
#if defined(__GLASGOW_HASKELL__)
import GHC.Arr
#elif defined(__HUGS__)
import Hugs.Array
#elif defined(__NHC__)
import Array
#endif
-- | Functors representing data structures that can be traversed from
-- left to right.
--
-- Minimal complete definition: 'traverse' or 'sequenceA'.
--
-- Instances are similar to 'Functor', e.g. given a data type
--
-- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)
--
-- a suitable instance would be
--
-- > instance Traversable Tree where
-- > traverse f Empty = pure Empty
-- > traverse f (Leaf x) = Leaf <$> f x
-- > traverse f (Node l k r) = Node <$> traverse f l <*> f k <*> traverse f r
--
-- This is suitable even for abstract types, as the laws for '<*>'
-- imply a form of associativity.
--
-- The superclass instances should satisfy the following:
--
-- * In the 'Functor' instance, 'fmap' should be equivalent to traversal
-- with the identity applicative functor ('fmapDefault').
--
-- * In the 'Foldable' instance, 'Data.Foldable.foldMap' should be
-- equivalent to traversal with a constant applicative functor
-- ('foldMapDefault').
--
class (Functor t, Foldable t) => Traversable t where
-- | Map each element of a structure to an action, evaluate
-- these actions from left to right, and collect the results.
traverse :: Applicative f => (a -> f b) -> t a -> f (t b)
traverse f = sequenceA . fmap f
-- | Evaluate each action in the structure from left to right,
-- and collect the results.
sequenceA :: Applicative f => t (f a) -> f (t a)
sequenceA = traverse id
-- | Map each element of a structure to a monadic action, evaluate
-- these actions from left to right, and collect the results.
mapM :: Monad m => (a -> m b) -> t a -> m (t b)
mapM f = unwrapMonad . traverse (WrapMonad . f)
-- | Evaluate each monadic action in the structure from left to right,
-- and collect the results.
sequence :: Monad m => t (m a) -> m (t a)
sequence = mapM id
-- instances for Prelude types
instance Traversable Maybe where
traverse _ Nothing = pure Nothing
traverse f (Just x) = Just <$> f x
instance Traversable [] where
{-# INLINE traverse #-} -- so that traverse can fuse
traverse f = Prelude.foldr cons_f (pure [])
where cons_f x ys = (:) <$> f x <*> ys
mapM = Prelude.mapM
instance Ix i => Traversable (Array i) where
traverse f arr = listArray (bounds arr) `fmap` traverse f (elems arr)
-- general functions
-- | 'for' is 'traverse' with its arguments flipped.
for :: (Traversable t, Applicative f) => t a -> (a -> f b) -> f (t b)
{-# INLINE for #-}
for = flip traverse
-- | 'forM' is 'mapM' with its arguments flipped.
forM :: (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b)
{-# INLINE forM #-}
forM = flip mapM
-- left-to-right state transformer
newtype StateL s a = StateL { runStateL :: s -> (s, a) }
instance Functor (StateL s) where
fmap f (StateL k) = StateL $ \ s -> let (s', v) = k s in (s', f v)
instance Applicative (StateL s) where
pure x = StateL (\ s -> (s, x))
StateL kf <*> StateL kv = StateL $ \ s ->
let (s', f) = kf s
(s'', v) = kv s'
in (s'', f v)
-- |The 'mapAccumL' function behaves like a combination of 'fmap'
-- and 'foldl'; it applies a function to each element of a structure,
-- passing an accumulating parameter from left to right, and returning
-- a final value of this accumulator together with the new structure.
mapAccumL :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL f s t = runStateL (traverse (StateL . flip f) t) s
-- right-to-left state transformer
newtype StateR s a = StateR { runStateR :: s -> (s, a) }
instance Functor (StateR s) where
fmap f (StateR k) = StateR $ \ s -> let (s', v) = k s in (s', f v)
instance Applicative (StateR s) where
pure x = StateR (\ s -> (s, x))
StateR kf <*> StateR kv = StateR $ \ s ->
let (s', v) = kv s
(s'', f) = kf s'
in (s'', f v)
-- |The 'mapAccumR' function behaves like a combination of 'fmap'
-- and 'foldr'; it applies a function to each element of a structure,
-- passing an accumulating parameter from right to left, and returning
-- a final value of this accumulator together with the new structure.
mapAccumR :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumR f s t = runStateR (traverse (StateR . flip f) t) s
-- | This function may be used as a value for `fmap` in a `Functor`
-- instance, provided that 'traverse' is defined. (Using
-- `fmapDefault` with a `Traversable` instance defined only by
-- 'sequenceA' will result in infinite recursion.)
fmapDefault :: Traversable t => (a -> b) -> t a -> t b
{-# INLINE fmapDefault #-}
fmapDefault f = getId . traverse (Id . f)
-- | This function may be used as a value for `Data.Foldable.foldMap`
-- in a `Foldable` instance.
foldMapDefault :: (Traversable t, Monoid m) => (a -> m) -> t a -> m
foldMapDefault f = getConst . traverse (Const . f)
-- local instances
newtype Id a = Id { getId :: a }
instance Functor Id where
fmap f (Id x) = Id (f x)
instance Applicative Id where
pure = Id
Id f <*> Id x = Id (f x)
|
