From: Ross Paterson Date: Tue, 11 Apr 2006 14:47:34 +0000 (+0000) Subject: add superclasses to Applicative and Traversable X-Git-Tag: directory_2007-05-24~308 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=0f7f84221836acde80b6337ef2e51d6508f73f7f;p=haskell-directory.git add superclasses to Applicative and Traversable Functor is now a superclass of Applicative, and Functor and Foldable are now superclasses of Traversable. The new hierarchy makes clear the inclusions between the classes, but means more work in defining instances. Default definitions are provided to help. --- diff --git a/Control/Applicative.hs b/Control/Applicative.hs index a395314..fa78371 100644 --- a/Control/Applicative.hs +++ b/Control/Applicative.hs @@ -11,6 +11,8 @@ -- 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 -- . -- -- This interface was introduced for parsers by Niklas Röjemo, because @@ -26,7 +28,7 @@ module Control.Applicative ( -- * Instances WrappedMonad(..), Const(..), ZipList(..), -- * Utility functions - (<$), (*>), (<*), (<**>), + (<$>), (<$), (*>), (<*), (<**>), liftA, liftA2, liftA3 ) where @@ -35,6 +37,7 @@ import Prelude #endif import Control.Monad (liftM, ap) +import Control.Monad.Instances () import Data.Monoid (Monoid(..)) infixl 4 <$>, <$ @@ -56,25 +59,15 @@ 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 @@ -93,21 +86,29 @@ instance Applicative ((->) a) 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 -- @@ -115,15 +116,21 @@ instance Monoid m => Applicative (Const m) where -- 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. @@ -138,9 +145,10 @@ instance Applicative ZipList where (<**>) :: 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 diff --git a/Data/Map.hs b/Data/Map.hs index 517a6bb..54730f8 100644 --- a/Data/Map.hs +++ b/Data/Map.hs @@ -160,7 +160,7 @@ import qualified Data.Set as Set 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)) diff --git a/Data/Sequence.hs b/Data/Sequence.hs index ccc7e6c..7827ba6 100644 --- a/Data/Sequence.hs +++ b/Data/Sequence.hs @@ -67,7 +67,7 @@ import Prelude hiding ( 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 @@ -100,7 +100,7 @@ class Sized a where 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 @@ -223,6 +223,12 @@ instance Foldable FingerTree where 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 @@ -268,6 +274,9 @@ instance Foldable Digit where 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 @@ -303,6 +312,9 @@ instance Foldable Node where 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 diff --git a/Data/Traversable.hs b/Data/Traversable.hs index e133238..f8fca1b 100644 --- a/Data/Traversable.hs +++ b/Data/Traversable.hs @@ -10,12 +10,12 @@ -- -- Class of data structures that can be traversed from left to right. -- --- See also . +-- See also /Applicative Programming with Effects/, +-- by Conor McBride and Ross Paterson, online at +-- . module Data.Traversable ( Traversable(..), - sequenceA, - sequence, fmapDefault, foldMapDefault, ) where @@ -23,13 +23,14 @@ module Data.Traversable ( 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 -- @@ -45,16 +46,27 @@ import Data.Array -- 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 @@ -72,24 +84,12 @@ instance Ix i => Traversable (Array i) 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) @@ -97,6 +97,9 @@ 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) diff --git a/Data/Tree.hs b/Data/Tree.hs index bc103b8..f2a55f5 100644 --- a/Data/Tree.hs +++ b/Data/Tree.hs @@ -28,7 +28,7 @@ module Data.Tree( 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,