1{-# LANGUAGE CPP #-}
2{-# LANGUAGE TypeOperators #-}
3
4#if __GLASGOW_HASKELL__ >= 702
5{-# LANGUAGE Trustworthy #-}
6#endif
7-----------------------------------------------------------------------------
8-- |
9-- Copyright   :  (C) 2011-2015 Edward Kmett
10-- License     :  BSD-style (see the file LICENSE)
11--
12-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
13-- Stability   :  provisional
14-- Portability :  portable
15--
16----------------------------------------------------------------------------
17module Data.Functor.Plus
18  ( Plus(..)
19  , module Data.Functor.Alt
20  ) where
21
22import Control.Applicative hiding (some, many)
23import Control.Applicative.Backwards
24import Control.Applicative.Lift
25import Control.Arrow
26-- import Control.Exception
27import Control.Monad
28import Control.Monad.Trans.Identity
29-- import Control.Monad.Trans.Cont
30import Control.Monad.Trans.Error
31import Control.Monad.Trans.Except
32import Control.Monad.Trans.List
33import Control.Monad.Trans.Maybe
34import Control.Monad.Trans.Reader
35import qualified Control.Monad.Trans.RWS.Strict as Strict
36import qualified Control.Monad.Trans.State.Strict as Strict
37import qualified Control.Monad.Trans.Writer.Strict as Strict
38import qualified Control.Monad.Trans.RWS.Lazy as Lazy
39import qualified Control.Monad.Trans.State.Lazy as Lazy
40import qualified Control.Monad.Trans.Writer.Lazy as Lazy
41import Data.Functor.Apply
42import Data.Functor.Alt
43import Data.Functor.Bind
44import Data.Functor.Compose
45import Data.Functor.Product
46import Data.Functor.Reverse
47import qualified Data.Monoid as Monoid
48import Data.Semigroup hiding (Product)
49import Prelude hiding (id, (.))
50
51#ifdef MIN_VERSION_containers
52import qualified Data.IntMap as IntMap
53import Data.IntMap (IntMap)
54import Data.Sequence (Seq)
55import qualified Data.Map as Map
56import Data.Map (Map)
57#endif
58
59#if defined(MIN_VERSION_tagged) || (MIN_VERSION_base(4,7,0))
60import Data.Proxy
61#endif
62
63#ifdef MIN_VERSION_unordered_containers
64import Data.Hashable
65import Data.HashMap.Lazy (HashMap)
66import qualified Data.HashMap.Lazy as HashMap
67#endif
68
69#ifdef MIN_VERSION_generic_deriving
70import Generics.Deriving.Base
71#else
72import GHC.Generics
73#endif
74
75-- | Laws:
76--
77-- > zero <!> m = m
78-- > m <!> zero = m
79--
80-- If extended to an 'Alternative' then 'zero' should equal 'empty'.
81
82class Alt f => Plus f where
83  zero :: f a
84
85instance Plus Proxy where
86  zero = Proxy
87
88instance Plus U1 where
89  zero = U1
90
91instance (Plus f, Plus g) => Plus (f :*: g) where
92  zero = zero :*: zero
93
94instance Plus f => Plus (M1 i c f) where
95  zero = M1 zero
96
97instance Plus f => Plus (Rec1 f) where
98  zero = Rec1 zero
99
100instance Plus IO where
101  zero = error "zero"
102
103instance Plus [] where
104  zero = []
105
106instance Plus Maybe where
107  zero = Nothing
108
109instance Plus Option where
110  zero = empty
111
112instance MonadPlus m => Plus (WrappedMonad m) where
113  zero = empty
114
115instance ArrowPlus a => Plus (WrappedArrow a b) where
116  zero = empty
117
118#ifdef MIN_VERSION_containers
119instance Ord k => Plus (Map k) where
120  zero = Map.empty
121
122instance Plus IntMap where
123  zero = IntMap.empty
124
125instance Plus Seq where
126  zero = mempty
127#endif
128
129#ifdef MIN_VERSION_unordered_containers
130instance (Hashable k, Eq k) => Plus (HashMap k) where
131  zero = HashMap.empty
132#endif
133
134instance Alternative f => Plus (WrappedApplicative f) where
135  zero = empty
136
137instance Plus f => Plus (IdentityT f) where
138  zero = IdentityT zero
139
140instance Plus f => Plus (ReaderT e f) where
141  zero = ReaderT $ \_ -> zero
142
143instance (Bind f, Monad f) => Plus (MaybeT f) where
144  zero = MaybeT $ return zero
145
146instance (Bind f, Monad f, Error e) => Plus (ErrorT e f) where
147  zero = ErrorT $ return $ Left noMsg
148
149instance (Bind f, Monad f, Semigroup e, Monoid e) => Plus (ExceptT e f) where
150  zero = ExceptT $ return $ Left mempty
151
152instance (Apply f, Applicative f) => Plus (ListT f) where
153  zero = ListT $ pure []
154
155instance Plus f => Plus (Strict.StateT e f) where
156  zero = Strict.StateT $ \_ -> zero
157
158instance Plus f => Plus (Lazy.StateT e f) where
159  zero = Lazy.StateT $ \_ -> zero
160
161instance Plus f => Plus (Strict.WriterT w f) where
162  zero = Strict.WriterT zero
163
164instance Plus f => Plus (Lazy.WriterT w f) where
165  zero = Lazy.WriterT zero
166
167instance Plus f => Plus (Strict.RWST r w s f) where
168  zero = Strict.RWST $ \_ _ -> zero
169
170instance Plus f => Plus (Lazy.RWST r w s f) where
171  zero = Lazy.RWST $ \_ _ -> zero
172
173instance Plus f => Plus (Backwards f) where
174  zero = Backwards zero
175
176instance (Plus f, Functor g) => Plus (Compose f g) where
177  zero = Compose zero
178
179instance Plus f => Plus (Lift f) where
180  zero = Other zero
181
182instance (Plus f, Plus g) => Plus (Product f g) where
183  zero = Pair zero zero
184
185instance Plus f => Plus (Reverse f) where
186  zero = Reverse zero
187
188instance Plus Monoid.First where
189  zero = Monoid.First Nothing
190
191instance Plus Monoid.Last where
192  zero = Monoid.Last Nothing
193