From ae5ae0b98d49556f26b5813b92f3e886076dd13c Mon Sep 17 00:00:00 2001 From: Don Stewart Date: Sat, 8 Mar 2008 01:42:56 +0000 Subject: [PATCH] untabify --- Control/Applicative.hs | 114 ++++++++++++++++++++++++------------------------ 1 file changed, 57 insertions(+), 57 deletions(-) diff --git a/Control/Applicative.hs b/Control/Applicative.hs index 3bae2ac..20df23d 100644 --- a/Control/Applicative.hs +++ b/Control/Applicative.hs @@ -23,24 +23,24 @@ -- 'Data.Traversable.Traversable' class. module Control.Applicative ( - -- * Applicative functors - Applicative(..), - -- * Alternatives - Alternative(..), - -- * Instances - Const(..), WrappedMonad(..), WrappedArrow(..), ZipList(..), - -- * Utility functions - (<$>), (<$), (*>), (<*), (<**>), - liftA, liftA2, liftA3, - optional, some, many - ) where + -- * Applicative functors + Applicative(..), + -- * Alternatives + Alternative(..), + -- * Instances + Const(..), WrappedMonad(..), WrappedArrow(..), ZipList(..), + -- * Utility functions + (<$>), (<$), (*>), (<*), (<**>), + liftA, liftA2, liftA3, + optional, some, many + ) where import Prelude hiding (id,(.)) import qualified Prelude import Control.Category import Control.Arrow - (Arrow(arr, (&&&)), ArrowZero(zeroArrow), ArrowPlus((<+>))) + (Arrow(arr, (&&&)), ArrowZero(zeroArrow), ArrowPlus((<+>))) import Control.Monad (liftM, ap, MonadPlus(..)) import Control.Monad.Instances () import Data.Monoid (Monoid(..)) @@ -54,106 +54,106 @@ infixl 4 <*>, <*, *>, <**> -- Instances should satisfy the following laws: -- -- [/identity/] --- @'pure' 'id' '<*>' v = v@ +-- @'pure' 'id' '<*>' v = v@ -- -- [/composition/] --- @'pure' (.) '<*>' u '<*>' v '<*>' w = u '<*>' (v '<*>' w)@ +-- @'pure' (.) '<*>' u '<*>' v '<*>' w = u '<*>' (v '<*>' w)@ -- -- [/homomorphism/] --- @'pure' f '<*>' 'pure' x = 'pure' (f x)@ +-- @'pure' f '<*>' 'pure' x = 'pure' (f x)@ -- -- [/interchange/] --- @u '<*>' 'pure' y = 'pure' ('$' y) '<*>' u@ +-- @u '<*>' 'pure' y = 'pure' ('$' y) '<*>' u@ -- -- The 'Functor' instance should satisfy -- -- @ --- 'fmap' f x = 'pure' f '<*>' x +-- 'fmap' f x = 'pure' f '<*>' x -- @ -- -- If @f@ is also a 'Monad', define @'pure' = 'return'@ and @('<*>') = 'ap'@. 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 + (<*>) :: f (a -> b) -> f a -> f b -- | A monoid on applicative functors. class Applicative f => Alternative f where - -- | The identity of '<|>' - empty :: f a - -- | An associative binary operation - (<|>) :: f a -> f a -> f a + -- | The identity of '<|>' + empty :: f a + -- | An associative binary operation + (<|>) :: f a -> f a -> f a -- 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 ((->) 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) -- 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 -- @@ -162,11 +162,11 @@ instance (ArrowZero a, ArrowPlus a) => Alternative (WrappedArrow a b) where 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 @@ -211,10 +211,10 @@ optional v = Just <$> v <|> pure Nothing some :: Alternative f => f a -> f [a] some v = some_v where many_v = some_v <|> pure [] - some_v = (:) <$> v <*> many_v + some_v = (:) <$> v <*> many_v -- | Zero or more. many :: Alternative f => f a -> f [a] many v = many_v where many_v = some_v <|> pure [] - some_v = (:) <$> v <*> many_v + some_v = (:) <$> v <*> many_v -- 1.7.10.4