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 37module 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 50import Control.Category hiding ((.), id) 51import Control.Arrow 52import Data.Maybe 53import Data.Tuple 54import Data.Eq 55import Data.Ord 56import Data.Foldable (Foldable(..)) 57import Data.Functor ((<$>)) 58import Data.Functor.Const (Const(..)) 59 60import GHC.Base 61import GHC.Generics 62import GHC.List (repeat, zipWith, drop) 63import GHC.Read (Read) 64import GHC.Show (Show) 65 66newtype WrappedMonad m a = WrapMonad { unwrapMonad :: m a } 67 deriving ( Generic -- ^ @since 4.7.0.0 68 , Generic1 -- ^ @since 4.7.0.0 69 , Monad -- ^ @since 4.7.0.0 70 ) 71 72-- | @since 2.01 73instance Monad m => Functor (WrappedMonad m) where 74 fmap f (WrapMonad v) = WrapMonad (liftM f v) 75 76-- | @since 2.01 77instance Monad m => Applicative (WrappedMonad m) where 78 pure = WrapMonad . pure 79 WrapMonad f <*> WrapMonad v = WrapMonad (f `ap` v) 80 liftA2 f (WrapMonad x) (WrapMonad y) = WrapMonad (liftM2 f x y) 81 82-- | @since 2.01 83instance MonadPlus m => Alternative (WrappedMonad m) where 84 empty = WrapMonad mzero 85 WrapMonad u <|> WrapMonad v = WrapMonad (u `mplus` v) 86 87newtype WrappedArrow a b c = WrapArrow { unwrapArrow :: a b c } 88 deriving ( Generic -- ^ @since 4.7.0.0 89 , Generic1 -- ^ @since 4.7.0.0 90 ) 91 92-- | @since 2.01 93instance Arrow a => Functor (WrappedArrow a b) where 94 fmap f (WrapArrow a) = WrapArrow (a >>> arr f) 95 96-- | @since 2.01 97instance Arrow a => Applicative (WrappedArrow a b) where 98 pure x = WrapArrow (arr (const x)) 99 liftA2 f (WrapArrow u) (WrapArrow v) = 100 WrapArrow (u &&& v >>> arr (uncurry f)) 101 102-- | @since 2.01 103instance (ArrowZero a, ArrowPlus a) => Alternative (WrappedArrow a b) where 104 empty = WrapArrow zeroArrow 105 WrapArrow u <|> WrapArrow v = WrapArrow (u <+> v) 106 107-- | Lists, but with an 'Applicative' functor based on zipping. 108newtype ZipList a = ZipList { getZipList :: [a] } 109 deriving ( Show -- ^ @since 4.7.0.0 110 , Eq -- ^ @since 4.7.0.0 111 , Ord -- ^ @since 4.7.0.0 112 , Read -- ^ @since 4.7.0.0 113 , Functor -- ^ @since 2.01 114 , Foldable -- ^ @since 4.9.0.0 115 , Generic -- ^ @since 4.7.0.0 116 , Generic1 -- ^ @since 4.7.0.0 117 ) 118-- See Data.Traversable for Traversable instance due to import loops 119 120-- | 121-- > f <$> ZipList xs1 <*> ... <*> ZipList xsN 122-- > = ZipList (zipWithN f xs1 ... xsN) 123-- 124-- where @zipWithN@ refers to the @zipWith@ function of the appropriate arity 125-- (@zipWith@, @zipWith3@, @zipWith4@, ...). For example: 126-- 127-- > (\a b c -> stimes c [a, b]) <$> ZipList "abcd" <*> ZipList "567" <*> ZipList [1..] 128-- > = ZipList (zipWith3 (\a b c -> stimes c [a, b]) "abcd" "567" [1..]) 129-- > = ZipList {getZipList = ["a5","b6b6","c7c7c7"]} 130-- 131-- @since 2.01 132instance Applicative ZipList where 133 pure x = ZipList (repeat x) 134 liftA2 f (ZipList xs) (ZipList ys) = ZipList (zipWith f xs ys) 135 136-- | @since 4.11.0.0 137instance Alternative ZipList where 138 empty = ZipList [] 139 ZipList xs <|> ZipList ys = ZipList (xs ++ drop (length xs) ys) 140 141-- extra functions 142 143-- | One or none. 144optional :: Alternative f => f a -> f (Maybe a) 145optional v = Just <$> v <|> pure Nothing 146