add GHC.HetMet.{hetmet_kappa,hetmet_kappa_app}

[ghc-base.git] / Data / Traversable.hs

diff --git a/Data/Traversable.hs b/Data/Traversable.hs
index 6754094..062d1a0 100644 (file)
--- 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)
 --
 -----------------------------------------------------------------------------
 -- |
 -- 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
 --
 -- 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
 --
 --
 -- See also
 --

@@ -20,19 +23,35 @@
 --    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>.
 --    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 (
 
 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 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.
 
 -- | Functors representing data structures that can be traversed from
 -- left to right.

@@ -45,10 +64,10 @@ import Data.Array
 --
 -- a suitable instance would be
 --
 --
 -- 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.
 --
 -- 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
 --    ('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
 
 -- 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
 
 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
 
 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
 
 
 -- 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
 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`
 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
 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
 
 instance Applicative Id where

-       pure = Id
-       Id f <*> Id x = Id (f x)
+    pure = Id
+    Id f <*> Id x = Id (f x)