Make Applicative a superclass of Monad
[ghc.git] / libraries / base / Control / Applicative.hs
1 {-# LANGUAGE Trustworthy #-}
2 {-# LANGUAGE AutoDeriveTypeable #-}
3 {-# LANGUAGE DeriveGeneric #-}
4
5 -----------------------------------------------------------------------------
6 -- |
7 -- Module : Control.Applicative
8 -- Copyright : Conor McBride and Ross Paterson 2005
9 -- License : BSD-style (see the LICENSE file in the distribution)
10 --
11 -- Maintainer : libraries@haskell.org
12 -- Stability : experimental
13 -- Portability : portable
14 --
15 -- This module describes a structure intermediate between a functor and
16 -- a monad (technically, a strong lax monoidal functor). Compared with
17 -- monads, this interface lacks the full power of the binding operation
18 -- '>>=', but
19 --
20 -- * it has more instances.
21 --
22 -- * it is sufficient for many uses, e.g. context-free parsing, or the
23 -- 'Data.Traversable.Traversable' class.
24 --
25 -- * instances can perform analysis of computations before they are
26 -- executed, and thus produce shared optimizations.
27 --
28 -- This interface was introduced for parsers by Niklas Röjemo, because
29 -- it admits more sharing than the monadic interface. The names here are
30 -- mostly based on parsing work by Doaitse Swierstra.
31 --
32 -- For more details, see
33 -- <http://www.soi.city.ac.uk/~ross/papers/Applicative.html Applicative Programming with Effects>,
34 -- by Conor McBride and Ross Paterson.
35
36 module Control.Applicative (
37 -- * Applicative functors
38 Applicative(..),
39 -- * Alternatives
40 Alternative(..),
41 -- * Instances
42 Const(..), WrappedMonad(..), WrappedArrow(..), ZipList(..),
43 -- * Utility functions
44 (<$>), (<$), (<**>),
45 liftA, liftA2, liftA3,
46 optional,
47 ) where
48
49 import Prelude hiding (id,(.))
50
51 import GHC.Base (liftA, liftA2, liftA3, (<**>))
52 import Control.Category
53 import Control.Arrow
54 import Control.Monad (liftM, ap, MonadPlus(..), Alternative(..))
55 import Data.Functor ((<$>), (<$))
56 import Data.Monoid (Monoid(..))
57
58 import GHC.Generics
59
60 newtype Const a b = Const { getConst :: a }
61 deriving (Generic, Generic1)
62
63 instance Functor (Const m) where
64 fmap _ (Const v) = Const v
65
66 -- Added in base-4.7.0.0
67 instance Monoid a => Monoid (Const a b) where
68 mempty = Const mempty
69 mappend (Const a) (Const b) = Const (mappend a b)
70
71 instance Monoid m => Applicative (Const m) where
72 pure _ = Const mempty
73 Const f <*> Const v = Const (f `mappend` v)
74
75 newtype WrappedMonad m a = WrapMonad { unwrapMonad :: m a }
76 deriving (Generic, Generic1)
77
78 instance Monad m => Functor (WrappedMonad m) where
79 fmap f (WrapMonad v) = WrapMonad (liftM f v)
80
81 instance Monad m => Applicative (WrappedMonad m) where
82 pure = WrapMonad . return
83 WrapMonad f <*> WrapMonad v = WrapMonad (f `ap` v)
84
85 -- Added in base-4.7.0.0 (GHC Trac #8218)
86 instance Monad m => Monad (WrappedMonad m) where
87 return = WrapMonad . return
88 a >>= f = WrapMonad (unwrapMonad a >>= unwrapMonad . f)
89
90 instance MonadPlus m => Alternative (WrappedMonad m) where
91 empty = WrapMonad mzero
92 WrapMonad u <|> WrapMonad v = WrapMonad (u `mplus` v)
93
94 newtype WrappedArrow a b c = WrapArrow { unwrapArrow :: a b c }
95 deriving (Generic, Generic1)
96
97 instance Arrow a => Functor (WrappedArrow a b) where
98 fmap f (WrapArrow a) = WrapArrow (a >>> arr f)
99
100 instance Arrow a => Applicative (WrappedArrow a b) where
101 pure x = WrapArrow (arr (const x))
102 WrapArrow f <*> WrapArrow v = WrapArrow (f &&& v >>> arr (uncurry id))
103
104 instance (ArrowZero a, ArrowPlus a) => Alternative (WrappedArrow a b) where
105 empty = WrapArrow zeroArrow
106 WrapArrow u <|> WrapArrow v = WrapArrow (u <+> v)
107
108 -- | Lists, but with an 'Applicative' functor based on zipping, so that
109 --
110 -- @f '<$>' 'ZipList' xs1 '<*>' ... '<*>' 'ZipList' xsn = 'ZipList' (zipWithn f xs1 ... xsn)@
111 --
112 newtype ZipList a = ZipList { getZipList :: [a] }
113 deriving (Show, Eq, Ord, Read, Generic, Generic1)
114
115 instance Functor ZipList where
116 fmap f (ZipList xs) = ZipList (map f xs)
117
118 instance Applicative ZipList where
119 pure x = ZipList (repeat x)
120 ZipList fs <*> ZipList xs = ZipList (zipWith id fs xs)
121
122 -- extra functions
123
124 -- | One or none.
125 optional :: Alternative f => f a -> f (Maybe a)
126 optional v = Just <$> v <|> pure Nothing