ref: d4dea2defccb349c3a6833bcd10ebf16c6cea49d
dir: /lib/Data/Traversable.hs/
-----------------------------------------------------------------------------
-- |
-- 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 : stable
-- Portability : portable
--
-- Class of data structures that can be traversed from left to right,
-- performing an action on each element. Instances are expected to satisfy
-- the listed [laws](#laws).
-----------------------------------------------------------------------------
module Data.Traversable (
-- * The 'Traversable' class
Traversable(..),
-- * Utility functions
for,
forM,
forAccumM,
mapAccumL,
mapAccumR,
mapAccumM,
-- * General definitions for superclass methods
fmapDefault,
foldMapDefault,
) where
import Prelude() -- do not import Prelude
import Primitives
import Control.Applicative
import Control.Error
import Control.Monad(Monad(..), MonadPlus(..), liftM)
--import Data.Coerce
import Data.Either
import Data.Foldable
import Data.Function
import Data.Functor
import Data.Functor.Const
import Data.Functor.Identity
--import Data.Functor.Utils ( StateL(..), StateR(..), StateT(..), (#.) )
import Data.List_Type
import qualified Data.List as List
import Data.Maybe
import Data.Monoid
import Data.Proxy
--import Data.Ord ( Down(..) )
--import Data.Proxy ( Proxy(..) )
class (Functor t, Foldable t) => Traversable (t :: Type -> Type) where
traverse :: forall (f :: Type -> Type) a b . Applicative f => (a -> f b) -> t a -> f (t b)
traverse f = sequenceA . fmap f
sequenceA :: forall (f :: Type -> Type) a . Applicative f => t (f a) -> f (t a)
sequenceA = traverse id
mapM :: forall (m :: Type -> Type) a b . Monad m => (a -> m b) -> t a -> m (t b)
mapM = traverse
sequence :: forall (m :: Type -> Type) a . Monad m => t (m a) -> m (t a)
sequence = sequenceA
instance Traversable Maybe where
traverse _ Nothing = pure Nothing
traverse f (Just x) = Just <$> f x
instance Traversable [] where
traverse f = List.foldr cons_f (pure [])
where cons_f x ys = liftA2 (:) (f x) ys
instance forall a . Traversable (Either a) where
traverse _ (Left x) = pure (Left x)
traverse f (Right y) = Right <$> f y
instance Traversable Identity where
traverse f (Identity a) = Identity <$> f a
instance Traversable Proxy where
traverse _ _ = pure Proxy
instance forall m . Traversable (Const m) where
traverse _ (Const m) = pure $ Const m
{-
-- | @since 4.15
deriving instance Traversable Solo
-- | @since 4.7.0.0
instance Traversable ((,) a) where
traverse f (x, y) = (,) x <$> f y
-- | @since 2.01
instance Ix i => Traversable (Array i) where
traverse f arr = listArray (bounds arr) `fmap` traverse f (elems arr)
-- | @since 4.7.0.0
instance Traversable Proxy where
traverse _ _ = pure Proxy
{-# INLINE traverse #-}
sequenceA _ = pure Proxy
{-# INLINE sequenceA #-}
mapM _ _ = pure Proxy
{-# INLINE mapM #-}
sequence _ = pure Proxy
{-# INLINE sequence #-}
-- | @since 4.7.0.0
instance Traversable (Const m) where
traverse _ (Const m) = pure $ Const m
-- | @since 4.8.0.0
instance Traversable Dual where
traverse f (Dual x) = Dual <$> f x
-- | @since 4.8.0.0
instance Traversable Sum where
traverse f (Sum x) = Sum <$> f x
-- | @since 4.8.0.0
instance Traversable Product where
traverse f (Product x) = Product <$> f x
-- | @since 4.8.0.0
instance Traversable First where
traverse f (First x) = First <$> traverse f x
-- | @since 4.8.0.0
instance Traversable Last where
traverse f (Last x) = Last <$> traverse f x
-- | @since 4.12.0.0
instance (Traversable f) => Traversable (Alt f) where
traverse f (Alt x) = Alt <$> traverse f x
-- | @since 4.12.0.0
instance (Traversable f) => Traversable (Ap f) where
traverse f (Ap x) = Ap <$> traverse f x
-- | @since 4.9.0.0
instance Traversable ZipList where
traverse f (ZipList x) = ZipList <$> traverse f x
instance Traversable (Arg a) where
traverse f (Arg x a) = Arg x `fmap` f a
-- Instances for GHC.Generics
-- | @since 4.9.0.0
instance Traversable U1 where
traverse _ _ = pure U1
{-# INLINE traverse #-}
sequenceA _ = pure U1
{-# INLINE sequenceA #-}
mapM _ _ = pure U1
{-# INLINE mapM #-}
sequence _ = pure U1
{-# INLINE sequence #-}
-- | @since 4.9.0.0
deriving instance Traversable V1
-- | @since 4.9.0.0
deriving instance Traversable Par1
-- | @since 4.9.0.0
deriving instance Traversable f => Traversable (Rec1 f)
-- | @since 4.9.0.0
deriving instance Traversable (K1 i c)
-- | @since 4.9.0.0
deriving instance Traversable f => Traversable (M1 i c f)
-- | @since 4.9.0.0
deriving instance (Traversable f, Traversable g) => Traversable (f :+: g)
-- | @since 4.9.0.0
deriving instance (Traversable f, Traversable g) => Traversable (f :*: g)
-- | @since 4.9.0.0
deriving instance (Traversable f, Traversable g) => Traversable (f :.: g)
-- | @since 4.9.0.0
deriving instance Traversable UAddr
-- | @since 4.9.0.0
deriving instance Traversable UChar
-- | @since 4.9.0.0
deriving instance Traversable UDouble
-- | @since 4.9.0.0
deriving instance Traversable UFloat
-- | @since 4.9.0.0
deriving instance Traversable UInt
-- | @since 4.9.0.0
deriving instance Traversable UWord
-- Instance for Data.Ord
-- | @since 4.12.0.0
deriving instance Traversable Down
-}
-- general functions
-- | 'for' is 'traverse' with its arguments flipped. For a version
-- that ignores the results see 'Data.Foldable.for_'.
for :: forall (t :: Type -> Type) (f :: Type -> Type) a b . (Traversable t, Applicative f) => t a -> (a -> f b) -> f (t b)
for = flip traverse
forM :: forall (t :: Type -> Type) (m :: Type -> Type) a b . (Traversable t, Monad m) => t a -> (a -> m b) -> m (t b)
forM = flip mapM
mapAccumL :: forall t s a b. Traversable t
=> (s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL f s t =
runStateL (traverse (StateL . flip f) t) s
--coerce (traverse @t @(StateL s) @a @b) (flip f) t s
mapAccumR :: forall t s a b. Traversable t
=> (s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumR f s t =
runStateR (traverse (StateR . flip f) t) s
--coerce (traverse @t @(StateR s) @a @b) (flip f) t s
mapAccumM
:: forall m t s a b. (Monad m, Traversable t)
=> (s -> a -> m (s, b))
-> s -> t a -> m (s, t b)
mapAccumM f s t =
runStateT (traverse (StateT . flip f) t) s
-- coerce (mapM @t @(StateT s m) @a @b) (StateT #. flip f) t s
forAccumM
:: (Monad m, Traversable t)
=> s -> t a -> (s -> a -> m (s, b)) -> m (s, t b)
forAccumM s t f = mapAccumM f s t
fmapDefault :: forall t a b . Traversable t
=> (a -> b) -> t a -> t b
fmapDefault f = runIdentity . traverse (Identity . f)
foldMapDefault :: forall t m a . (Traversable t, Monoid m)
=> (a -> m) -> t a -> m
foldMapDefault f = getConst . traverse (Const . f)
-----------------------
newtype StateL s a = StateL (s -> (s, a))
runStateL :: StateL s a -> s -> (s, a)
runStateL (StateL f) = f
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)
newtype StateR s a = StateR (s -> (s, a))
runStateR :: StateR s a -> s -> (s, a)
runStateR (StateR f) = f
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)
newtype StateT s m a = StateT (s -> m (s, a))
runStateT :: StateT s m a -> s -> m (s, a)
runStateT (StateT f) = f
instance Monad m => Functor (StateT s m) where
fmap = liftM
instance Monad m => Applicative (StateT s m) where
pure a = StateT $ \ s -> return (s, a)
StateT mf <*> StateT mx = StateT $ \ s -> do
(s', f) <- mf s
(s'', x) <- mx s'
return (s'', f x)
instance (Monad m) => Monad (StateT s m) where
m >>= k = StateT $ \ s -> do
(s', a) <- runStateT m s
runStateT (k a) s'