X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FTraversable.hs;h=062d1a0b1ca6de3bbcaf0d21d28f9d551c30fabf;hb=HEAD;hp=675409461bd51b7d95fa0bcffd575e45d19eb228;hpb=b9b6e38a1ebb5f05b382609fe0776d91cdd1090b;p=ghc-base.git diff --git a/Data/Traversable.hs b/Data/Traversable.hs index 6754094..062d1a0 100644 --- a/Data/Traversable.hs +++ b/Data/Traversable.hs @@ -1,14 +1,17 @@ +{-# LANGUAGE CPP #-} + ----------------------------------------------------------------------------- -- | -- Module : Data.Traversable -- Copyright : Conor McBride and Ross Paterson 2005 -- License : BSD-style (see the LICENSE file in the distribution) -- --- Maintainer : ross@soi.city.ac.uk +-- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- --- Class of data structures that can be traversed from left to right. +-- Class of data structures that can be traversed from left to right, +-- performing an action on each element. -- -- See also -- @@ -20,19 +23,35 @@ -- by Jeremy Gibbons and Bruno Oliveira, -- in /Mathematically-Structured Functional Programming/, 2006, and online at -- . +-- +-- 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(..), - fmapDefault, - foldMapDefault, - ) where + 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) -import Data.Array + +#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. @@ -45,10 +64,10 @@ import Data.Array -- -- a suitable instance would be -- --- > instance Traversable Tree --- > 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 +-- > 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. @@ -63,45 +82,100 @@ import Data.Array -- ('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 an 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 + -- | 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 f Nothing = pure Nothing - traverse f (Just x) = Just <$> f x + traverse _ Nothing = pure Nothing + traverse f (Just x) = Just <$> f x instance Traversable [] where - traverse f = Prelude.foldr cons_f (pure []) - where cons_f x ys = (:) <$> f x <*> ys + {-# 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 + mapM = Prelude.mapM instance Ix i => Traversable (Array i) where - traverse f arr = listArray (bounds arr) <$> traverse f (elems arr) + traverse f arr = listArray (bounds arr) `fmap` traverse f (elems arr) -- general functions --- | This function may be used as a value for `fmap` in a `Functor` instance. +-- | '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` @@ -114,8 +188,8 @@ foldMapDefault f = getConst . traverse (Const . f) newtype Id a = Id { getId :: a } instance Functor Id where - fmap f (Id x) = Id (f x) + fmap f (Id x) = Id (f x) instance Applicative Id where - pure = Id - Id f <*> Id x = Id (f x) + pure = Id + Id f <*> Id x = Id (f x)