-- Copyright : Conor McBride and Ross Paterson 2005
-- License : BSD-style (see the LICENSE file in the distribution)
--
--- Maintainer : ross@soi.city.ac.uk
+-- Maintainer : libraries@haskell.org
-- Stability : experimental
-- Portability : portable
--
-- * Instances
Const(..), WrappedMonad(..), WrappedArrow(..), ZipList(..),
-- * Utility functions
- (<$>), (<$), (*>), (<*), (<**>),
+ (<$>), (<$), (<**>),
liftA, liftA2, liftA3,
- optional, some, many
+ optional,
) where
import Prelude hiding (id,(.))
-import qualified Prelude
import Control.Category
import Control.Arrow
(Arrow(arr, (&&&)), ArrowZero(zeroArrow), ArrowPlus((<+>)))
import Control.Monad (liftM, ap, MonadPlus(..))
import Control.Monad.Instances ()
+import Data.Functor ((<$>), (<$))
import Data.Monoid (Monoid(..))
+#ifdef __GLASGOW_HASKELL__
+import GHC.Conc (STM, retry, orElse)
+#endif
+
infixl 3 <|>
-infixl 4 <$>, <$
infixl 4 <*>, <*, *>, <**>
-- | A functor with application.
-- [/interchange/]
-- @u '<*>' 'pure' y = 'pure' ('$' y) '<*>' u@
--
+-- [/ignore left value/]
+-- @u '*>' v = 'pure' ('const' 'id') '<*>' u '<*>' v@
+--
+-- [/ignore right value/]
+-- @u '<*' v = 'pure' 'const' '<*>' u '<*>' v@
+--
-- The 'Functor' instance should satisfy
--
-- @
-- @
--
-- If @f@ is also a 'Monad', define @'pure' = 'return'@ and @('<*>') = 'ap'@.
+--
+-- Minimal complete definition: 'pure' and '<*>'.
class Functor f => Applicative f where
-- | Lift a value.
-- | 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 second argument.
+ (<*) :: f a -> f b -> f a
+ (<*) = liftA2 const
+
-- | A monoid on applicative functors.
+--
+-- Minimal complete definition: 'empty' and '<|>'.
+--
+-- 'some' and 'many' should be the least solutions of the equations:
+--
+-- * @some v = (:) '<$>' v '<*>' many v@
+--
+-- * @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
+
-- instances for Prelude types
instance Applicative Maybe where
pure = return
(<*>) = ap
+#ifdef __GLASGOW_HASKELL__
+instance Applicative STM where
+ pure = return
+ (<*>) = ap
+
+instance Alternative STM where
+ empty = retry
+ (<|>) = orElse
+#endif
+
instance Applicative ((->) a) where
pure = const
(<*>) f g x = f x (g 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
+
-- new instances
newtype Const a b = Const { getConst :: a }
-- extra functions
--- | A synonym for 'fmap'.
-(<$>) :: Functor f => (a -> b) -> f a -> f b
-f <$> a = fmap f a
-
--- | Replace the value.
-(<$) :: Functor f => a -> f b -> f a
-(<$) = (<$>) . const
-
--- | Sequence actions, discarding the value of the first argument.
-(*>) :: Applicative f => f a -> f b -> f b
-(*>) = liftA2 (const id)
-
--- | Sequence actions, discarding the value of the second argument.
-(<*) :: Applicative f => f a -> f b -> f a
-(<*) = liftA2 const
-
-- | A variant of '<*>' with the arguments reversed.
(<**>) :: Applicative f => f a -> f (a -> b) -> f b
(<**>) = liftA2 (flip ($))
-- | One or none.
optional :: Alternative f => f a -> f (Maybe a)
optional v = Just <$> v <|> pure Nothing
-
--- | One or more.
-some :: Alternative f => f a -> f [a]
-some v = some_v
- where many_v = some_v <|> pure []
- 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