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