-- This module describes a structure intermediate between a functor and
-- a monad: it provides pure expressions and sequencing, but no binding.
-- (Technically, a strong lax monoidal functor.) For more details, see
+-- /Applicative Programming with Effects/,
+-- by Conor McBride and Ross Paterson, online at
-- <http://www.soi.city.ac.uk/~ross/papers/Applicative.html>.
--
-- This interface was introduced for parsers by Niklas Röjemo, because
-- * Instances
WrappedMonad(..), Const(..), ZipList(..),
-- * Utility functions
- (<$), (*>), (<*), (<**>),
+ (<$>), (<$), (*>), (<*), (<**>),
liftA, liftA2, liftA3
) where
#endif
import Control.Monad (liftM, ap)
+import Control.Monad.Instances ()
import Data.Monoid (Monoid(..))
infixl 4 <$>, <$
-- [/interchange/]
-- @u '<*>' 'pure' y = 'pure' ('$' y) '<*>' u@
--
--- [/pure application/]
--- @f '<$>' v = 'pure' f '<*>' v@
---
--- Minimal complete definition: 'pure' and '<*>'.
---
--- If @f@ is also a 'Functor', define @('<$>') = 'fmap'@.
--- If it is also a 'Monad', define @'pure' = 'return'@ and @('<*>') = 'ap'@.
+-- If @f@ is also a 'Monad', define @'pure' = 'return'@ and @('<*>') = 'ap'@.
-class Applicative f where
+class Functor f => Applicative f where
-- | Lift a value.
pure :: a -> f a
-- | Sequential application.
(<*>) :: f (a -> b) -> f a -> f b
- -- | Map a function over an action.
- (<$>) :: (a -> b) -> f a -> f b
- f <$> v = pure f <*> v
-
-- instances for Prelude types
instance Applicative Maybe where
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)
+
-- new instances
newtype WrappedMonad m a = WrapMonad { unwrapMonad :: m a }
+instance Monad m => Functor (WrappedMonad m) where
+ 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)
- f <$> WrapMonad v = WrapMonad (liftM f v)
newtype Const a b = Const { getConst :: a }
+instance Functor (Const m) where
+ fmap _ (Const v) = Const v
+
instance Monoid m => Applicative (Const m) where
pure _ = Const mempty
Const f <*> Const v = Const (f `mappend` v)
- _ <$> Const v = Const 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)
+
instance Applicative ZipList where
pure x = ZipList (repeat x)
ZipList fs <*> ZipList xs = ZipList (zipWith id fs xs)
- f <$> ZipList xs = ZipList (map f xs)
-- extra functions
+-- | A synonym for 'fmap'.
+(<$>) :: Functor f => (a -> b) -> f a -> f b
+f <$> a = fmap f a
+
-- | Replace the value.
-(<$) :: Applicative f => a -> f b -> f a
+(<$) :: Functor f => a -> f b -> f a
(<$) = (<$>) . const
-- | Sequence actions, discarding the value of the first argument.
(<**>) :: Applicative f => f a -> f (a -> b) -> f b
(<**>) = liftA2 (flip ($))
--- | A synonym for '<$>'.
+-- | Lift a function to actions.
+-- This function may be used as a value for `fmap` in a `Functor` instance.
liftA :: Applicative f => (a -> b) -> f a -> f b
-liftA f a = f <$> a
+liftA f a = pure f <*> a
-- | Lift a binary function to actions.
liftA2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c
import qualified Data.List as List
import Data.Monoid (Monoid(..))
import Data.Typeable
-import Control.Applicative (Applicative(..))
+import Control.Applicative (Applicative(..), (<$>))
import Data.Traversable (Traversable(traverse))
import Data.Foldable (Foldable(foldMap))
null, length, take, drop, splitAt, foldl, foldl1, foldr, foldr1,
reverse)
import qualified Data.List (foldl')
-import Control.Applicative (Applicative(..))
+import Control.Applicative (Applicative(..), (<$>))
import Control.Monad (MonadPlus(..))
import Data.Monoid (Monoid(..))
import Data.Foldable
newtype Seq a = Seq (FingerTree (Elem a))
instance Functor Seq where
- fmap = fmapDefault
+ fmap f (Seq xs) = Seq (fmap (fmap f) xs)
instance Foldable Seq where
foldr f z (Seq xs) = foldr (flip (foldr f)) z xs
foldl1 f (Deep _ pr m sf) =
foldl f (foldl (foldl f) (foldl1 f pr) m) sf
+instance Functor FingerTree where
+ fmap _ Empty = Empty
+ fmap f (Single x) = Single (f x)
+ fmap f (Deep v pr m sf) =
+ Deep v (fmap f pr) (fmap (fmap f) m) (fmap f sf)
+
instance Traversable FingerTree where
traverse _ Empty = pure Empty
traverse f (Single x) = Single <$> f x
foldl1 f (Three a b c) = (a `f` b) `f` c
foldl1 f (Four a b c d) = ((a `f` b) `f` c) `f` d
+instance Functor Digit where
+ fmap = fmapDefault
+
instance Traversable Digit where
traverse f (One a) = One <$> f a
traverse f (Two a b) = Two <$> f a <*> f b
foldl f z (Node2 _ a b) = (z `f` a) `f` b
foldl f z (Node3 _ a b c) = ((z `f` a) `f` b) `f` c
+instance Functor Node where
+ fmap = fmapDefault
+
instance Traversable Node where
traverse f (Node2 v a b) = Node2 v <$> f a <*> f b
traverse f (Node3 v a b c) = Node3 v <$> f a <*> f b <*> f c
--
-- Class of data structures that can be traversed from left to right.
--
--- See also <http://www.soi.city.ac.uk/~ross/papers/Applicative.html>.
+-- See also /Applicative Programming with Effects/,
+-- by Conor McBride and Ross Paterson, online at
+-- <http://www.soi.city.ac.uk/~ross/papers/Applicative.html>.
module Data.Traversable (
Traversable(..),
- sequenceA,
- sequence,
fmapDefault,
foldMapDefault,
) where
import Prelude hiding (mapM, sequence)
import qualified Prelude (mapM)
import Control.Applicative
+import Data.Foldable (Foldable)
import Data.Monoid (Monoid)
import Data.Array
-- | Functors representing data structures that can be traversed from
-- left to right.
--
--- Minimal complete definition: 'traverse'.
+-- Minimal complete definition: 'traverse' or 'sequenceA'.
--
-- Instances are similar to 'Functor', e.g. given a data type
--
-- This is suitable even for abstract types, as the laws for '<*>'
-- imply a form of associativity.
--
-class Traversable t where
+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
+
-- instances for Prelude types
instance Traversable Maybe where
-- general functions
--- | Evaluate each action in the structure from left to right,
--- and collect the results.
-sequenceA :: (Traversable t, Applicative f) => t (f a) -> f (t a)
-sequenceA = traverse id
-
--- | Evaluate each monadic action in the structure from left to right,
--- and collect the results.
-sequence :: (Traversable t, Monad m) => t (m a) -> m (t a)
-sequence = mapM id
-
--- | Any 'Traversable' can also be made an instance of 'Functor' by
--- defining 'fmap' as 'fmapDefault'.
+-- | This function may be used as a value for `fmap` in a `Functor` instance.
fmapDefault :: Traversable t => (a -> b) -> t a -> t b
fmapDefault f = getId . traverse (Id . f)
--- | Any 'Traversable' can also be made an instance of
--- 'Data.Foldable.Foldable' by defining 'Data.Foldable.foldMap'
--- as 'foldMapDefault'.
+-- | 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)
newtype Id a = Id { getId :: a }
+instance Functor Id where
+ fmap f (Id x) = Id (f x)
+
instance Applicative Id where
pure = Id
Id f <*> Id x = Id (f x)
import Prelude
#endif
-import Control.Applicative (Applicative(..))
+import Control.Applicative (Applicative(..), (<$>))
import Control.Monad
import Data.Monoid (Monoid(..))
import Data.Sequence (Seq, empty, singleton, (<|), (|>), fromList,
projects / haskell-directory.git / commitdiff