1{-# LANGUAGE DeriveTraversable #-}
2{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE NoImplicitPrelude #-}
4{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE StandaloneDeriving #-}
6{-# LANGUAGE Trustworthy #-}
7{-# LANGUAGE TypeOperators #-}
8
9-----------------------------------------------------------------------------
10-- |
11-- Module      :  Data.Traversable
12-- Copyright   :  Conor McBride and Ross Paterson 2005
13-- License     :  BSD-style (see the LICENSE file in the distribution)
14--
15-- Maintainer  :  libraries@haskell.org
16-- Stability   :  experimental
17-- Portability :  portable
18--
19-- Class of data structures that can be traversed from left to right,
20-- performing an action on each element.
21--
22-- See also
23--
24--  * \"Applicative Programming with Effects\",
25--    by Conor McBride and Ross Paterson,
26--    /Journal of Functional Programming/ 18:1 (2008) 1-13, online at
27--    <http://www.soi.city.ac.uk/~ross/papers/Applicative.html>.
28--
29--  * \"The Essence of the Iterator Pattern\",
30--    by Jeremy Gibbons and Bruno Oliveira,
31--    in /Mathematically-Structured Functional Programming/, 2006, online at
32--    <http://web.comlab.ox.ac.uk/oucl/work/jeremy.gibbons/publications/#iterator>.
33--
34--  * \"An Investigation of the Laws of Traversals\",
35--    by Mauro Jaskelioff and Ondrej Rypacek,
36--    in /Mathematically-Structured Functional Programming/, 2012, online at
37--    <http://arxiv.org/pdf/1202.2919>.
38--
39-----------------------------------------------------------------------------
40
41module Data.Traversable (
42    -- * The 'Traversable' class
43    Traversable(..),
44    -- * Utility functions
45    for,
46    forM,
47    mapAccumL,
48    mapAccumR,
49    -- * General definitions for superclass methods
50    fmapDefault,
51    foldMapDefault,
52    ) where
53
54-- It is convenient to use 'Const' here but this means we must
55-- define a few instances here which really belong in Control.Applicative
56import Control.Applicative ( Const(..), ZipList(..) )
57import Data.Coerce
58import Data.Either ( Either(..) )
59import Data.Foldable ( Foldable )
60import Data.Functor
61import Data.Functor.Identity ( Identity(..) )
62import Data.Functor.Utils ( StateL(..), StateR(..) )
63import Data.Monoid ( Dual(..), Sum(..), Product(..),
64                     First(..), Last(..), Alt(..), Ap(..) )
65import Data.Ord ( Down(..) )
66import Data.Proxy ( Proxy(..) )
67
68import GHC.Arr
69import GHC.Base ( Applicative(..), Monad(..), Monoid, Maybe(..), NonEmpty(..),
70                  ($), (.), id, flip )
71import GHC.Generics
72import qualified GHC.List as List ( foldr )
73
74-- | Functors representing data structures that can be traversed from
75-- left to right.
76--
77-- A definition of 'traverse' must satisfy the following laws:
78--
79-- [Naturality]
80--   @t . 'traverse' f = 'traverse' (t . f)@
81--   for every applicative transformation @t@
82--
83-- [Identity]
84--   @'traverse' 'Identity' = 'Identity'@
85--
86-- [Composition]
87--   @'traverse' ('Data.Functor.Compose.Compose' . 'fmap' g . f)
88--     = 'Data.Functor.Compose.Compose' . 'fmap' ('traverse' g) . 'traverse' f@
89--
90-- A definition of 'sequenceA' must satisfy the following laws:
91--
92-- [Naturality]
93--   @t . 'sequenceA' = 'sequenceA' . 'fmap' t@
94--   for every applicative transformation @t@
95--
96-- [Identity]
97--   @'sequenceA' . 'fmap' 'Identity' = 'Identity'@
98--
99-- [Composition]
100--   @'sequenceA' . 'fmap' 'Data.Functor.Compose.Compose'
101--     = 'Data.Functor.Compose.Compose' . 'fmap' 'sequenceA' . 'sequenceA'@
102--
103-- where an /applicative transformation/ is a function
104--
105-- @t :: (Applicative f, Applicative g) => f a -> g a@
106--
107-- preserving the 'Applicative' operations, i.e.
108--
109-- @
110-- t ('pure' x) = 'pure' x
111-- t (f '<*>' x) = t f '<*>' t x
112-- @
113--
114-- and the identity functor 'Identity' and composition functors
115-- 'Data.Functor.Compose.Compose' are from "Data.Functor.Identity" and
116-- "Data.Functor.Compose".
117--
118-- A result of the naturality law is a purity law for 'traverse'
119--
120-- @'traverse' 'pure' = 'pure'@
121--
122-- (The naturality law is implied by parametricity and thus so is the
123-- purity law [1, p15].)
124--
125-- Instances are similar to 'Functor', e.g. given a data type
126--
127-- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)
128--
129-- a suitable instance would be
130--
131-- > instance Traversable Tree where
132-- >    traverse f Empty = pure Empty
133-- >    traverse f (Leaf x) = Leaf <$> f x
134-- >    traverse f (Node l k r) = Node <$> traverse f l <*> f k <*> traverse f r
135--
136-- This is suitable even for abstract types, as the laws for '<*>'
137-- imply a form of associativity.
138--
139-- The superclass instances should satisfy the following:
140--
141--  * In the 'Functor' instance, 'fmap' should be equivalent to traversal
142--    with the identity applicative functor ('fmapDefault').
143--
144--  * In the 'Foldable' instance, 'Data.Foldable.foldMap' should be
145--    equivalent to traversal with a constant applicative functor
146--    ('foldMapDefault').
147--
148-- References:
149-- [1] The Essence of the Iterator Pattern, Jeremy Gibbons and Bruno C. d. S. Oliveira
150class (Functor t, Foldable t) => Traversable t where
151    {-# MINIMAL traverse | sequenceA #-}
152
153    -- | Map each element of a structure to an action, evaluate these actions
154    -- from left to right, and collect the results. For a version that ignores
155    -- the results see 'Data.Foldable.traverse_'.
156    traverse :: Applicative f => (a -> f b) -> t a -> f (t b)
157    {-# INLINE traverse #-}  -- See Note [Inline default methods]
158    traverse f = sequenceA . fmap f
159
160    -- | Evaluate each action in the structure from left to right, and
161    -- collect the results. For a version that ignores the results
162    -- see 'Data.Foldable.sequenceA_'.
163    sequenceA :: Applicative f => t (f a) -> f (t a)
164    {-# INLINE sequenceA #-}  -- See Note [Inline default methods]
165    sequenceA = traverse id
166
167    -- | Map each element of a structure to a monadic action, evaluate
168    -- these actions from left to right, and collect the results. For
169    -- a version that ignores the results see 'Data.Foldable.mapM_'.
170    mapM :: Monad m => (a -> m b) -> t a -> m (t b)
171    {-# INLINE mapM #-}  -- See Note [Inline default methods]
172    mapM = traverse
173
174    -- | Evaluate each monadic action in the structure from left to
175    -- right, and collect the results. For a version that ignores the
176    -- results see 'Data.Foldable.sequence_'.
177    sequence :: Monad m => t (m a) -> m (t a)
178    {-# INLINE sequence #-}  -- See Note [Inline default methods]
179    sequence = sequenceA
180
181{- Note [Inline default methods]
182~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
183Consider
184
185   class ... => Traversable t where
186       ...
187       mapM :: Monad m => (a -> m b) -> t a -> m (t b)
188       mapM = traverse   -- Default method
189
190   instance Traversable [] where
191       {-# INLINE traverse #-}
192       traverse = ...code for traverse on lists ...
193
194This gives rise to a list-instance of mapM looking like this
195
196  $fTraversable[]_$ctraverse = ...code for traverse on lists...
197       {-# INLINE $fTraversable[]_$ctraverse #-}
198  $fTraversable[]_$cmapM    = $fTraversable[]_$ctraverse
199
200Now the $ctraverse obediently inlines into the RHS of $cmapM, /but/
201that's all!  We get
202
203  $fTraversable[]_$cmapM = ...code for traverse on lists...
204
205with NO INLINE pragma!  This happens even though 'traverse' had an
206INLINE pragma because the author knew it should be inlined pretty
207vigorously.
208
209Indeed, it turned out that the rhs of $cmapM was just too big to
210inline, so all uses of mapM on lists used a terribly inefficient
211dictionary-passing style, because of its 'Monad m =>' type.  Disaster!
212
213Solution: add an INLINE pragma on the default method:
214
215   class ... => Traversable t where
216       ...
217       mapM :: Monad m => (a -> m b) -> t a -> m (t b)
218       {-# INLINE mapM #-}     -- VERY IMPORTANT!
219       mapM = traverse
220-}
221
222-- instances for Prelude types
223
224-- | @since 2.01
225instance Traversable Maybe where
226    traverse _ Nothing = pure Nothing
227    traverse f (Just x) = Just <$> f x
228
229-- | @since 2.01
230instance Traversable [] where
231    {-# INLINE traverse #-} -- so that traverse can fuse
232    traverse f = List.foldr cons_f (pure [])
233      where cons_f x ys = liftA2 (:) (f x) ys
234
235-- | @since 4.9.0.0
236instance Traversable NonEmpty where
237  traverse f ~(a :| as) = liftA2 (:|) (f a) (traverse f as)
238
239-- | @since 4.7.0.0
240instance Traversable (Either a) where
241    traverse _ (Left x) = pure (Left x)
242    traverse f (Right y) = Right <$> f y
243
244-- | @since 4.7.0.0
245instance Traversable ((,) a) where
246    traverse f (x, y) = (,) x <$> f y
247
248-- | @since 2.01
249instance Ix i => Traversable (Array i) where
250    traverse f arr = listArray (bounds arr) `fmap` traverse f (elems arr)
251
252-- | @since 4.7.0.0
253instance Traversable Proxy where
254    traverse _ _ = pure Proxy
255    {-# INLINE traverse #-}
256    sequenceA _ = pure Proxy
257    {-# INLINE sequenceA #-}
258    mapM _ _ = pure Proxy
259    {-# INLINE mapM #-}
260    sequence _ = pure Proxy
261    {-# INLINE sequence #-}
262
263-- | @since 4.7.0.0
264instance Traversable (Const m) where
265    traverse _ (Const m) = pure $ Const m
266
267-- | @since 4.8.0.0
268instance Traversable Dual where
269    traverse f (Dual x) = Dual <$> f x
270
271-- | @since 4.8.0.0
272instance Traversable Sum where
273    traverse f (Sum x) = Sum <$> f x
274
275-- | @since 4.8.0.0
276instance Traversable Product where
277    traverse f (Product x) = Product <$> f x
278
279-- | @since 4.8.0.0
280instance Traversable First where
281    traverse f (First x) = First <$> traverse f x
282
283-- | @since 4.8.0.0
284instance Traversable Last where
285    traverse f (Last x) = Last <$> traverse f x
286
287-- | @since 4.12.0.0
288instance (Traversable f) => Traversable (Alt f) where
289    traverse f (Alt x) = Alt <$> traverse f x
290
291-- | @since 4.12.0.0
292instance (Traversable f) => Traversable (Ap f) where
293    traverse f (Ap x) = Ap <$> traverse f x
294
295-- | @since 4.9.0.0
296instance Traversable ZipList where
297    traverse f (ZipList x) = ZipList <$> traverse f x
298
299-- | @since 4.9.0.0
300deriving instance Traversable Identity
301
302
303-- Instances for GHC.Generics
304-- | @since 4.9.0.0
305instance Traversable U1 where
306    traverse _ _ = pure U1
307    {-# INLINE traverse #-}
308    sequenceA _ = pure U1
309    {-# INLINE sequenceA #-}
310    mapM _ _ = pure U1
311    {-# INLINE mapM #-}
312    sequence _ = pure U1
313    {-# INLINE sequence #-}
314
315-- | @since 4.9.0.0
316deriving instance Traversable V1
317
318-- | @since 4.9.0.0
319deriving instance Traversable Par1
320
321-- | @since 4.9.0.0
322deriving instance Traversable f => Traversable (Rec1 f)
323
324-- | @since 4.9.0.0
325deriving instance Traversable (K1 i c)
326
327-- | @since 4.9.0.0
328deriving instance Traversable f => Traversable (M1 i c f)
329
330-- | @since 4.9.0.0
331deriving instance (Traversable f, Traversable g) => Traversable (f :+: g)
332
333-- | @since 4.9.0.0
334deriving instance (Traversable f, Traversable g) => Traversable (f :*: g)
335
336-- | @since 4.9.0.0
337deriving instance (Traversable f, Traversable g) => Traversable (f :.: g)
338
339-- | @since 4.9.0.0
340deriving instance Traversable UAddr
341
342-- | @since 4.9.0.0
343deriving instance Traversable UChar
344
345-- | @since 4.9.0.0
346deriving instance Traversable UDouble
347
348-- | @since 4.9.0.0
349deriving instance Traversable UFloat
350
351-- | @since 4.9.0.0
352deriving instance Traversable UInt
353
354-- | @since 4.9.0.0
355deriving instance Traversable UWord
356
357-- Instance for Data.Ord
358-- | @since 4.12.0.0
359deriving instance Traversable Down
360
361-- general functions
362
363-- | 'for' is 'traverse' with its arguments flipped. For a version
364-- that ignores the results see 'Data.Foldable.for_'.
365for :: (Traversable t, Applicative f) => t a -> (a -> f b) -> f (t b)
366{-# INLINE for #-}
367for = flip traverse
368
369-- | 'forM' is 'mapM' with its arguments flipped. For a version that
370-- ignores the results see 'Data.Foldable.forM_'.
371forM :: (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b)
372{-# INLINE forM #-}
373forM = flip mapM
374
375-- |The 'mapAccumL' function behaves like a combination of 'fmap'
376-- and 'Data.Foldable.foldl'; it applies a function to each element of a structure,
377-- passing an accumulating parameter from left to right, and returning
378-- a final value of this accumulator together with the new structure.
379mapAccumL :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c)
380mapAccumL f s t = runStateL (traverse (StateL . flip f) t) s
381
382-- |The 'mapAccumR' function behaves like a combination of 'fmap'
383-- and 'Data.Foldable.foldr'; it applies a function to each element of a structure,
384-- passing an accumulating parameter from right to left, and returning
385-- a final value of this accumulator together with the new structure.
386mapAccumR :: Traversable t => (a -> b -> (a, c)) -> a -> t b -> (a, t c)
387mapAccumR f s t = runStateR (traverse (StateR . flip f) t) s
388
389-- | This function may be used as a value for `fmap` in a `Functor`
390--   instance, provided that 'traverse' is defined. (Using
391--   `fmapDefault` with a `Traversable` instance defined only by
392--   'sequenceA' will result in infinite recursion.)
393--
394-- @
395-- 'fmapDefault' f ≡ 'runIdentity' . 'traverse' ('Identity' . f)
396-- @
397fmapDefault :: forall t a b . Traversable t
398            => (a -> b) -> t a -> t b
399{-# INLINE fmapDefault #-}
400-- See Note [Function coercion] in Data.Functor.Utils.
401fmapDefault = coerce (traverse :: (a -> Identity b) -> t a -> Identity (t b))
402
403-- | This function may be used as a value for `Data.Foldable.foldMap`
404-- in a `Foldable` instance.
405--
406-- @
407-- 'foldMapDefault' f ≡ 'getConst' . 'traverse' ('Const' . f)
408-- @
409foldMapDefault :: forall t m a . (Traversable t, Monoid m)
410               => (a -> m) -> t a -> m
411{-# INLINE foldMapDefault #-}
412-- See Note [Function coercion] in Data.Functor.Utils.
413foldMapDefault = coerce (traverse :: (a -> Const m ()) -> t a -> Const m (t ()))
414