Traversable.hs 10.9 KB
Newer Older
1 2
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
3
{-# LANGUAGE NoImplicitPrelude #-}
4 5 6
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeOperators #-}
7

8 9 10 11 12 13
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Traversable
-- Copyright   :  Conor McBride and Ross Paterson 2005
-- License     :  BSD-style (see the LICENSE file in the distribution)
--
14
-- Maintainer  :  libraries@haskell.org
15 16 17 18 19 20 21 22
-- Stability   :  experimental
-- Portability :  portable
--
-- Class of data structures that can be traversed from left to right,
-- performing an action on each element.
--
-- See also
--
Ross Paterson's avatar
Ross Paterson committed
23 24 25
--  * \"Applicative Programming with Effects\",
--    by Conor McBride and Ross Paterson,
--    /Journal of Functional Programming/ 18:1 (2008) 1-13, online at
26 27
--    <http://www.soi.city.ac.uk/~ross/papers/Applicative.html>.
--
Ross Paterson's avatar
Ross Paterson committed
28
--  * \"The Essence of the Iterator Pattern\",
29
--    by Jeremy Gibbons and Bruno Oliveira,
Ross Paterson's avatar
Ross Paterson committed
30
--    in /Mathematically-Structured Functional Programming/, 2006, online at
31 32
--    <http://web.comlab.ox.ac.uk/oucl/work/jeremy.gibbons/publications/#iterator>.
--
Ross Paterson's avatar
Ross Paterson committed
33 34 35 36 37
--  * \"An Investigation of the Laws of Traversals\",
--    by Mauro Jaskelioff and Ondrej Rypacek,
--    in /Mathematically-Structured Functional Programming/, 2012, online at
--    <http://arxiv.org/pdf/1202.2919>.
--
dterei's avatar
dterei committed
38
-----------------------------------------------------------------------------
39 40

module Data.Traversable (
Ross Paterson's avatar
Ross Paterson committed
41
    -- * The 'Traversable' class
42
    Traversable(..),
Ross Paterson's avatar
Ross Paterson committed
43
    -- * Utility functions
44 45 46 47
    for,
    forM,
    mapAccumL,
    mapAccumR,
Ross Paterson's avatar
Ross Paterson committed
48
    -- * General definitions for superclass methods
49 50 51
    fmapDefault,
    foldMapDefault,
    ) where
52

53 54 55
-- It is convenient to use 'Const' here but this means we must
-- define a few instances here which really belong in Control.Applicative
import Control.Applicative ( Const(..), ZipList(..) )
56
import Data.Either ( Either(..) )
57 58
import Data.Foldable ( Foldable )
import Data.Functor
59
import Data.Monoid ( Dual(..), Sum(..), Product(..), First(..), Last(..) )
60
import Data.Proxy ( Proxy(..) )
61

62
import GHC.Arr
63 64
import GHC.Base ( Applicative(..), Monad(..), Monoid, Maybe(..),
                  ($), (.), id, flip )
65
import GHC.Generics
66
import qualified GHC.List as List ( foldr )
67

68 69 70
-- | Functors representing data structures that can be traversed from
-- left to right.
--
Ross Paterson's avatar
Ross Paterson committed
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
-- A definition of 'traverse' must satisfy the following laws:
--
-- [/naturality/]
--   @t . 'traverse' f = 'traverse' (t . f)@
--   for every applicative transformation @t@
--
-- [/identity/]
--   @'traverse' Identity = Identity@
--
-- [/composition/]
--   @'traverse' (Compose . 'fmap' g . f) = Compose . 'fmap' ('traverse' g) . 'traverse' f@
--
-- A definition of 'sequenceA' must satisfy the following laws:
--
-- [/naturality/]
--   @t . 'sequenceA' = 'sequenceA' . 'fmap' t@
--   for every applicative transformation @t@
--
-- [/identity/]
--   @'sequenceA' . 'fmap' Identity = Identity@
--
-- [/composition/]
--   @'sequenceA' . 'fmap' Compose = Compose . 'fmap' 'sequenceA' . 'sequenceA'@
--
-- where an /applicative transformation/ is a function
--
-- @t :: (Applicative f, Applicative g) => f a -> g a@
--
-- preserving the 'Applicative' operations, i.e.
--
--  * @t ('pure' x) = 'pure' x@
--
--  * @t (x '<*>' y) = t x '<*>' t y@
--
-- and the identity functor @Identity@ and composition of functors @Compose@
-- are defined as
--
-- >   newtype Identity a = Identity a
-- >
-- >   instance Functor Identity where
-- >     fmap f (Identity x) = Identity (f x)
-- >
thomie's avatar
thomie committed
113
-- >   instance Applicative Identity where
Ross Paterson's avatar
Ross Paterson committed
114 115 116 117 118 119 120 121 122 123 124 125 126 127
-- >     pure x = Identity x
-- >     Identity f <*> Identity x = Identity (f x)
-- >
-- >   newtype Compose f g a = Compose (f (g a))
-- >
-- >   instance (Functor f, Functor g) => Functor (Compose f g) where
-- >     fmap f (Compose x) = Compose (fmap (fmap f) x)
-- >
-- >   instance (Applicative f, Applicative g) => Applicative (Compose f g) where
-- >     pure x = Compose (pure (pure x))
-- >     Compose f <*> Compose x = Compose ((<*>) <$> f <*> x)
--
-- (The naturality law is implied by parametricity.)
--
128 129 130 131 132 133
-- 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
--
Ross Paterson's avatar
Ross Paterson committed
134
-- > instance Traversable Tree where
Don Stewart's avatar
Don Stewart committed
135 136 137
-- >    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
138 139 140 141 142 143 144 145 146 147 148 149 150 151
--
-- 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
152 153
    {-# MINIMAL traverse | sequenceA #-}

bernalex's avatar
bernalex committed
154 155 156
    -- | Map each element of a structure to an action, evaluate these actions
    -- from left to right, and collect the results. For a version that ignores
    -- the results see 'Data.Foldable.traverse_'.
157 158 159
    traverse :: Applicative f => (a -> f b) -> t a -> f (t b)
    traverse f = sequenceA . fmap f

160 161 162
    -- | Evaluate each action in the structure from left to right, and
    -- and collect the results. For a version that ignores the results
    -- see 'Data.Foldable.sequenceA_'.
163 164 165 166
    sequenceA :: Applicative f => t (f a) -> f (t a)
    sequenceA = traverse id

    -- | Map each element of a structure to a monadic action, evaluate
167 168
    -- these actions from left to right, and collect the results. For
    -- a version that ignores the results see 'Data.Foldable.mapM_'.
169
    mapM :: Monad m => (a -> m b) -> t a -> m (t b)
170
    mapM = traverse
171

172 173 174
    -- | Evaluate each monadic action in the structure from left to
    -- right, and collect the results. For a version that ignores the
    -- results see 'Data.Foldable.sequence_'.
175
    sequence :: Monad m => t (m a) -> m (t a)
176
    sequence = sequenceA
177 178 179 180

-- instances for Prelude types

instance Traversable Maybe where
181 182
    traverse _ Nothing = pure Nothing
    traverse f (Just x) = Just <$> f x
183 184

instance Traversable [] where
185
    {-# INLINE traverse #-} -- so that traverse can fuse
186
    traverse f = List.foldr cons_f (pure [])
187
      where cons_f x ys = (:) <$> f x <*> ys
188

189 190 191 192 193 194 195
instance Traversable (Either a) where
    traverse _ (Left x) = pure (Left x)
    traverse f (Right y) = Right <$> f y

instance Traversable ((,) a) where
    traverse f (x, y) = (,) x <$> f y

196
instance Ix i => Traversable (Array i) where
197
    traverse f arr = listArray (bounds arr) `fmap` traverse f (elems arr)
198

199 200 201 202 203
instance Traversable Proxy where
    traverse _ _ = pure Proxy
    {-# INLINE traverse #-}
    sequenceA _ = pure Proxy
    {-# INLINE sequenceA #-}
204
    mapM _ _ = pure Proxy
205
    {-# INLINE mapM #-}
206
    sequence _ = pure Proxy
207 208
    {-# INLINE sequence #-}

209 210 211
instance Traversable (Const m) where
    traverse _ (Const m) = pure $ Const m

212 213 214 215 216 217 218 219 220 221 222 223 224 225 226
instance Traversable Dual where
    traverse f (Dual x) = Dual <$> f x

instance Traversable Sum where
    traverse f (Sum x) = Sum <$> f x

instance Traversable Product where
    traverse f (Product x) = Product <$> f x

instance Traversable First where
    traverse f (First x) = First <$> traverse f x

instance Traversable Last where
    traverse f (Last x) = Last <$> traverse f x

227 228 229
instance Traversable ZipList where
    traverse f (ZipList x) = ZipList <$> traverse f x

230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246
-- Instances for GHC.Generics
deriving instance Traversable V1
deriving instance Traversable U1
deriving instance Traversable Par1
deriving instance Traversable f => Traversable (Rec1 f)
deriving instance Traversable (K1 i c)
deriving instance Traversable f => Traversable (M1 i c f)
deriving instance (Traversable f, Traversable g) => Traversable (f :+: g)
deriving instance (Traversable f, Traversable g) => Traversable (f :*: g)
deriving instance (Traversable f, Traversable g) => Traversable (f :.: g)
deriving instance Traversable UAddr
deriving instance Traversable UChar
deriving instance Traversable UDouble
deriving instance Traversable UFloat
deriving instance Traversable UInt
deriving instance Traversable UWord

247 248
-- general functions

249 250
-- | 'for' is 'traverse' with its arguments flipped. For a version
-- that ignores the results see 'Data.Foldable.for_'.
251 252 253 254
for :: (Traversable t, Applicative f) => t a -> (a -> f b) -> f (t b)
{-# INLINE for #-}
for = flip traverse

255 256
-- | 'forM' is 'mapM' with its arguments flipped. For a version that
-- ignores the results see 'Data.Foldable.forM_'.
257 258 259 260
forM :: (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b)
{-# INLINE forM #-}
forM = flip mapM

261 262 263 264
-- left-to-right state transformer
newtype StateL s a = StateL { runStateL :: s -> (s, a) }

instance Functor (StateL s) where
265
    fmap f (StateL k) = StateL $ \ s -> let (s', v) = k s in (s', f v)
266 267

instance Applicative (StateL s) where
268 269 270 271 272
    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)
273 274 275 276 277 278 279 280 281 282 283 284

-- |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
285
    fmap f (StateR k) = StateR $ \ s -> let (s', v) = k s in (s', f v)
286 287

instance Applicative (StateR s) where
288 289 290 291 292
    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)
293 294 295 296 297 298 299 300

-- |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

301 302 303 304
-- | 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.)
305
fmapDefault :: Traversable t => (a -> b) -> t a -> t b
306
{-# INLINE fmapDefault #-}
307 308 309 310 311 312 313 314 315 316 317 318
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
319
    fmap f (Id x) = Id (f x)
320 321

instance Applicative Id where
322 323
    pure = Id
    Id f <*> Id x = Id (f x)
dterei's avatar
dterei committed
324