-- 'Data.Traversable.Traversable' class.
module Control.Applicative (
- -- * Applicative functors
- Applicative(..),
- -- * Alternatives
- Alternative(..),
- -- * Instances
- Const(..), WrappedMonad(..), WrappedArrow(..), ZipList(..),
- -- * Utility functions
- (<$>), (<$), (<**>),
- liftA, liftA2, liftA3,
- optional,
- ) where
+ -- * Applicative functors
+ Applicative(..),
+ -- * Alternatives
+ Alternative(..),
+ -- * Instances
+ Const(..), WrappedMonad(..), WrappedArrow(..), ZipList(..),
+ -- * Utility functions
+ (<$>), (<$), (<**>),
+ liftA, liftA2, liftA3,
+ optional,
+ ) where
import Prelude hiding (id,(.))
import Control.Category
-import Control.Arrow
- (Arrow(arr, (&&&)), ArrowZero(zeroArrow), ArrowPlus((<+>)))
+import Control.Arrow (Arrow(arr, (&&&)), ArrowZero(zeroArrow), ArrowPlus((<+>)))
import Control.Monad (liftM, ap, MonadPlus(..))
import Control.Monad.Instances ()
import Control.Monad.ST (ST)
-- Minimal complete definition: 'pure' and '<*>'.
class Functor f => Applicative f where
- -- | Lift a value.
- pure :: a -> f a
+ -- | Lift a value.
+ pure :: a -> f a
- -- | Sequential application.
- (<*>) :: f (a -> b) -> f a -> f b
+ -- | Sequential application.
+ (<*>) :: f (a -> b) -> f a -> f b
- -- | Sequence actions, discarding the value of the first argument.
- (*>) :: f a -> f b -> f b
- (*>) = liftA2 (const id)
+ -- | Sequence actions, discarding the value of the first argument.
+ (*>) :: f a -> f b -> f b
+ (*>) = liftA2 (const id)
- -- | Sequence actions, discarding the value of the second argument.
- (<*) :: f a -> f b -> f a
- (<*) = liftA2 const
+ -- | Sequence actions, discarding the value of the second argument.
+ (<*) :: f a -> f b -> f a
+ (<*) = liftA2 const
-- | A monoid on applicative functors.
--
--
-- * @many v = some v '<|>' 'pure' []@
class Applicative f => Alternative f where
- -- | The identity of '<|>'
- empty :: f a
- -- | An associative binary operation
- (<|>) :: f a -> f a -> f a
-
- -- | One or more.
- some :: f a -> f [a]
- some v = some_v
- where many_v = some_v <|> pure []
- some_v = (:) <$> v <*> many_v
-
- -- | Zero or more.
- many :: f a -> f [a]
- many v = many_v
- where many_v = some_v <|> pure []
- some_v = (:) <$> v <*> many_v
+ -- | The identity of '<|>'
+ empty :: f a
+ -- | An associative binary operation
+ (<|>) :: f a -> f a -> f a
+
+ -- | One or more.
+ some :: f a -> f [a]
+ some v = some_v
+ where
+ many_v = some_v <|> pure []
+ some_v = (:) <$> v <*> many_v
+
+ -- | Zero or more.
+ many :: f a -> f [a]
+ many v = many_v
+ where
+ many_v = some_v <|> pure []
+ some_v = (:) <$> v <*> many_v
-- instances for Prelude types
instance Applicative Maybe where
- pure = return
- (<*>) = ap
+ pure = return
+ (<*>) = ap
instance Alternative Maybe where
- empty = Nothing
- Nothing <|> p = p
- Just x <|> _ = Just x
+ empty = Nothing
+ Nothing <|> p = p
+ Just x <|> _ = Just x
instance Applicative [] where
- pure = return
- (<*>) = ap
+ pure = return
+ (<*>) = ap
instance Alternative [] where
- empty = []
- (<|>) = (++)
+ empty = []
+ (<|>) = (++)
instance Applicative IO where
- pure = return
- (<*>) = ap
+ pure = return
+ (<*>) = ap
instance Applicative (ST s) where
- pure = return
- (<*>) = ap
+ pure = return
+ (<*>) = ap
instance Applicative (Lazy.ST s) where
- pure = return
- (<*>) = ap
+ pure = return
+ (<*>) = ap
#ifdef __GLASGOW_HASKELL__
instance Applicative STM where
#endif
instance Applicative ((->) a) where
- pure = const
- (<*>) f g x = f x (g x)
+ pure = const
+ (<*>) f g x = f x (g x)
instance Monoid a => Applicative ((,) a) where
- pure x = (mempty, x)
- (u, f) <*> (v, x) = (u `mappend` v, f x)
+ pure x = (mempty, x)
+ (u, f) <*> (v, x) = (u `mappend` v, f x)
instance Applicative (Either e) where
- pure = Right
- Left e <*> _ = Left e
- Right f <*> r = fmap f r
+ pure = Right
+ Left e <*> _ = Left e
+ Right f <*> r = fmap f r
-- new instances
newtype Const a b = Const { getConst :: a }
instance Functor (Const m) where
- fmap _ (Const v) = Const v
+ fmap _ (Const v) = Const v
instance Monoid m => Applicative (Const m) where
- pure _ = Const mempty
- Const f <*> Const v = Const (f `mappend` v)
+ pure _ = Const mempty
+ Const f <*> Const v = Const (f `mappend` v)
newtype WrappedMonad m a = WrapMonad { unwrapMonad :: m a }
instance Monad m => Functor (WrappedMonad m) where
- fmap f (WrapMonad v) = WrapMonad (liftM f v)
+ fmap f (WrapMonad v) = WrapMonad (liftM f v)
instance Monad m => Applicative (WrappedMonad m) where
- pure = WrapMonad . return
- WrapMonad f <*> WrapMonad v = WrapMonad (f `ap` v)
+ pure = WrapMonad . return
+ WrapMonad f <*> WrapMonad v = WrapMonad (f `ap` v)
instance MonadPlus m => Alternative (WrappedMonad m) where
- empty = WrapMonad mzero
- WrapMonad u <|> WrapMonad v = WrapMonad (u `mplus` v)
+ empty = WrapMonad mzero
+ WrapMonad u <|> WrapMonad v = WrapMonad (u `mplus` v)
newtype WrappedArrow a b c = WrapArrow { unwrapArrow :: a b c }
instance Arrow a => Functor (WrappedArrow a b) where
- fmap f (WrapArrow a) = WrapArrow (a >>> arr f)
+ fmap f (WrapArrow a) = WrapArrow (a >>> arr f)
instance Arrow a => Applicative (WrappedArrow a b) where
- pure x = WrapArrow (arr (const x))
- WrapArrow f <*> WrapArrow v = WrapArrow (f &&& v >>> arr (uncurry id))
+ pure x = WrapArrow (arr (const x))
+ WrapArrow f <*> WrapArrow v = WrapArrow (f &&& v >>> arr (uncurry id))
instance (ArrowZero a, ArrowPlus a) => Alternative (WrappedArrow a b) where
- empty = WrapArrow zeroArrow
- WrapArrow u <|> WrapArrow v = WrapArrow (u <+> v)
+ empty = WrapArrow zeroArrow
+ WrapArrow u <|> WrapArrow v = WrapArrow (u <+> v)
-- | Lists, but with an 'Applicative' functor based on zipping, so that
--
newtype ZipList a = ZipList { getZipList :: [a] }
instance Functor ZipList where
- fmap f (ZipList xs) = ZipList (map f xs)
+ fmap f (ZipList xs) = ZipList (map f xs)
instance Applicative ZipList where
- pure x = ZipList (repeat x)
- ZipList fs <*> ZipList xs = ZipList (zipWith id fs xs)
+ pure x = ZipList (repeat x)
+ ZipList fs <*> ZipList xs = ZipList (zipWith id fs xs)
-- extra functions
-- | A class for categories.
-- id and (.) must form a monoid.
class Category cat where
- -- | the identity morphism
- id :: cat a a
+ -- | the identity morphism
+ id :: cat a a
- -- | morphism composition
- (.) :: cat b c -> cat a b -> cat a c
+ -- | morphism composition
+ (.) :: cat b c -> cat a b -> cat a c
{-# RULES
"identity/left" forall p .
#-}
instance Category (->) where
- id = Prelude.id
+ id = Prelude.id
#ifndef __HADDOCK__
-- Haddock 1.x cannot parse this:
- (.) = (Prelude..)
+ (.) = (Prelude..)
#endif
-- | Right-to-left composition
-- for this module.
module Data.Foldable (
- -- * Folds
- Foldable(..),
- -- ** Special biased folds
- foldr',
- foldl',
- foldrM,
- foldlM,
- -- ** Folding actions
- -- *** Applicative actions
- traverse_,
- for_,
- sequenceA_,
- asum,
- -- *** Monadic actions
- mapM_,
- forM_,
- sequence_,
- msum,
- -- ** Specialized folds
- toList,
- concat,
- concatMap,
- and,
- or,
- any,
- all,
- sum,
- product,
- maximum,
- maximumBy,
- minimum,
- minimumBy,
- -- ** Searches
- elem,
- notElem,
- find
- ) where
+ -- * Folds
+ Foldable(..),
+ -- ** Special biased folds
+ foldr',
+ foldl',
+ foldrM,
+ foldlM,
+ -- ** Folding actions
+ -- *** Applicative actions
+ traverse_,
+ for_,
+ sequenceA_,
+ asum,
+ -- *** Monadic actions
+ mapM_,
+ forM_,
+ sequence_,
+ msum,
+ -- ** Specialized folds
+ toList,
+ concat,
+ concatMap,
+ and,
+ or,
+ any,
+ all,
+ sum,
+ product,
+ maximum,
+ maximumBy,
+ minimum,
+ minimumBy,
+ -- ** Searches
+ elem,
+ notElem,
+ find
+ ) where
import Prelude hiding (foldl, foldr, foldl1, foldr1, mapM_, sequence_,
elem, notElem, concat, concatMap, and, or, any, all,
-- > foldr f z (Node l k r) = foldr f (f k (foldr f z r)) l
--
class Foldable t where
- -- | Combine the elements of a structure using a monoid.
- fold :: Monoid m => t m -> m
- fold = foldMap id
-
- -- | Map each element of the structure to a monoid,
- -- and combine the results.
- foldMap :: Monoid m => (a -> m) -> t a -> m
- foldMap f = foldr (mappend . f) mempty
-
- -- | Right-associative fold of a structure.
- --
- -- @'foldr' f z = 'Prelude.foldr' f z . 'toList'@
- foldr :: (a -> b -> b) -> b -> t a -> b
- foldr f z t = appEndo (foldMap (Endo . f) t) z
-
- -- | Left-associative fold of a structure.
- --
- -- @'foldl' f z = 'Prelude.foldl' f z . 'toList'@
- foldl :: (a -> b -> a) -> a -> t b -> a
- foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z
-
- -- | A variant of 'foldr' that has no base case,
- -- and thus may only be applied to non-empty structures.
- --
- -- @'foldr1' f = 'Prelude.foldr1' f . 'toList'@
- foldr1 :: (a -> a -> a) -> t a -> a
- foldr1 f xs = fromMaybe (error "foldr1: empty structure")
- (foldr mf Nothing xs)
- where mf x Nothing = Just x
- mf x (Just y) = Just (f x y)
-
- -- | A variant of 'foldl' that has no base case,
- -- and thus may only be applied to non-empty structures.
- --
- -- @'foldl1' f = 'Prelude.foldl1' f . 'toList'@
- foldl1 :: (a -> a -> a) -> t a -> a
- foldl1 f xs = fromMaybe (error "foldl1: empty structure")
- (foldl mf Nothing xs)
- where mf Nothing y = Just y
- mf (Just x) y = Just (f x y)
+ -- | Combine the elements of a structure using a monoid.
+ fold :: Monoid m => t m -> m
+ fold = foldMap id
+
+ -- | Map each element of the structure to a monoid,
+ -- and combine the results.
+ foldMap :: Monoid m => (a -> m) -> t a -> m
+ foldMap f = foldr (mappend . f) mempty
+
+ -- | Right-associative fold of a structure.
+ --
+ -- @'foldr' f z = 'Prelude.foldr' f z . 'toList'@
+ foldr :: (a -> b -> b) -> b -> t a -> b
+ foldr f z t = appEndo (foldMap (Endo . f) t) z
+
+ -- | Left-associative fold of a structure.
+ --
+ -- @'foldl' f z = 'Prelude.foldl' f z . 'toList'@
+ foldl :: (a -> b -> a) -> a -> t b -> a
+ foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z
+
+ -- | A variant of 'foldr' that has no base case,
+ -- and thus may only be applied to non-empty structures.
+ --
+ -- @'foldr1' f = 'Prelude.foldr1' f . 'toList'@
+ foldr1 :: (a -> a -> a) -> t a -> a
+ foldr1 f xs = fromMaybe (error "foldr1: empty structure")
+ (foldr mf Nothing xs)
+ where
+ mf x Nothing = Just x
+ mf x (Just y) = Just (f x y)
+
+ -- | A variant of 'foldl' that has no base case,
+ -- and thus may only be applied to non-empty structures.
+ --
+ -- @'foldl1' f = 'Prelude.foldl1' f . 'toList'@
+ foldl1 :: (a -> a -> a) -> t a -> a
+ foldl1 f xs = fromMaybe (error "foldl1: empty structure")
+ (foldl mf Nothing xs)
+ where
+ mf Nothing y = Just y
+ mf (Just x) y = Just (f x y)
-- instances for Prelude types
instance Foldable Maybe where
- foldr _ z Nothing = z
- foldr f z (Just x) = f x z
+ foldr _ z Nothing = z
+ foldr f z (Just x) = f x z
- foldl _ z Nothing = z
- foldl f z (Just x) = f z x
+ foldl _ z Nothing = z
+ foldl f z (Just x) = f z x
instance Foldable [] where
- foldr = Prelude.foldr
- foldl = Prelude.foldl
- foldr1 = Prelude.foldr1
- foldl1 = Prelude.foldl1
+ foldr = Prelude.foldr
+ foldl = Prelude.foldl
+ foldr1 = Prelude.foldr1
+ foldl1 = Prelude.foldl1
instance Ix i => Foldable (Array i) where
- foldr f z = Prelude.foldr f z . elems
- foldl f z = Prelude.foldl f z . elems
- foldr1 f = Prelude.foldr1 f . elems
- foldl1 f = Prelude.foldl1 f . elems
+ foldr f z = Prelude.foldr f z . elems
+ foldl f z = Prelude.foldl f z . elems
+ foldr1 f = Prelude.foldr1 f . elems
+ foldl1 f = Prelude.foldl1 f . elems
-- | Fold over the elements of a structure,
-- associating to the right, but strictly.
-- or qualify uses of these function names with an alias for this module.
module Data.Traversable (
- Traversable(..),
- for,
- forM,
- mapAccumL,
- mapAccumR,
- fmapDefault,
- foldMapDefault,
- ) where
+ Traversable(..),
+ for,
+ forM,
+ mapAccumL,
+ mapAccumR,
+ fmapDefault,
+ foldMapDefault,
+ ) where
import Prelude hiding (mapM, sequence, foldr)
import qualified Prelude (mapM, foldr)
-- ('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 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
+ -- | 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 _ Nothing = pure Nothing
- traverse f (Just x) = Just <$> f x
+ traverse _ Nothing = pure Nothing
+ traverse f (Just x) = Just <$> f x
instance Traversable [] where
- {-# INLINE traverse #-} -- so that traverse can fuse
- 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) `fmap` traverse f (elems arr)
+ traverse f arr = listArray (bounds arr) `fmap` traverse f (elems arr)
-- general functions
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)
+ 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)
+ 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,
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)
+ 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)
+ 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,
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)
projects / ghc-base.git / commitdiff