{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeOperators #-}
-----------------------------------------------------------------------------

-- |

-- Copyright   :  (C) 2011-2015 Edward Kmett

-- License     :  BSD-style (see the file LICENSE)

--

-- Maintainer  :  Edward Kmett <ekmett@gmail.com>

-- Stability   :  provisional

-- Portability :  portable

--

----------------------------------------------------------------------------

module Data.Functor.Plus
  ( Plus(..)
  , psum
  , gzero
  , module Data.Functor.Alt
  ) where

import Control.Applicative hiding (some, many)
import Control.Applicative.Backwards
import Control.Applicative.Lift
import Control.Arrow
import Control.Monad
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Except
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Reader
#if MIN_VERSION_transformers(0,5,6)
import qualified Control.Monad.Trans.RWS.CPS as CPS
import qualified Control.Monad.Trans.Writer.CPS as CPS
import Semigroupoids.Internal
#endif
import qualified Control.Monad.Trans.RWS.Strict as Strict
import qualified Control.Monad.Trans.State.Strict as Strict
import qualified Control.Monad.Trans.Writer.Strict as Strict
import qualified Control.Monad.Trans.RWS.Lazy as Lazy
import qualified Control.Monad.Trans.State.Lazy as Lazy
import qualified Control.Monad.Trans.Writer.Lazy as Lazy
import Data.Foldable hiding (asum)
import Data.Functor.Apply
import Data.Functor.Alt
import Data.Functor.Compose
import Data.Functor.Product
import Data.Functor.Reverse
import qualified Data.Monoid as Monoid
import Data.Proxy
import Data.Semigroup hiding (Product)
import GHC.Generics
import Prelude hiding (id, (.), foldr)

#if !(MIN_VERSION_transformers(0,6,0))
import Control.Monad.Trans.Error
import Control.Monad.Trans.List
#endif

#ifdef MIN_VERSION_containers
import qualified Data.IntMap as IntMap
import Data.IntMap (IntMap)
import Data.Sequence (Seq)
import qualified Data.Map as Map
import Data.Map (Map)
#endif

#ifdef MIN_VERSION_unordered_containers
import Data.Hashable
import Data.HashMap.Lazy (HashMap)
import qualified Data.HashMap.Lazy as HashMap
#endif

-- | Laws:

--

-- > zero <!> m = m

-- > m <!> zero = m

--

-- If extended to an 'Alternative' then 'zero' should equal 'empty'.

class Alt f => Plus f where
  zero :: f a

-- | The sum of a collection of actions, generalizing 'concat'.

--

-- >>> psum [Just "Hello", Nothing, Just "World"]

-- Just "Hello"

--

-- @since 5.3.6

psum :: (Foldable t, Plus f) => t (f a) -> f a
psum :: forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Plus f) =>
t (f a) -> f a
psum = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (f :: * -> *) a. Alt f => f a -> f a -> f a
(<!>) forall (f :: * -> *) a. Plus f => f a
zero

-- | Generic 'zero'. Caveats:

--

--   1. Will not compile if @f@ is a sum type.

--   2. Any types where the @a@ does not appear must have a 'Monoid' instance.

--

-- @since 5.3.8

gzero :: (Plus (Rep1 f), Generic1 f) => f a
gzero :: forall (f :: * -> *) a. (Plus (Rep1 f), Generic1 f) => f a
gzero = forall k (f :: k -> *) (a :: k). Generic1 f => Rep1 f a -> f a
to1 forall (f :: * -> *) a. Plus f => f a
zero

instance Plus Proxy where
  zero :: forall a. Proxy a
zero = forall {k} (t :: k). Proxy t
Proxy

instance Plus U1 where
  zero :: forall a. U1 a
zero = forall k (p :: k). U1 p
U1

-- | @since 5.3.8

instance (Monoid c
#if !(MIN_VERSION_base(4,11,0))
         , Semigroup c
#endif
  ) => Plus (K1 i c) where
  zero :: forall a. K1 i c a
zero = forall k i c (p :: k). c -> K1 i c p
K1 forall a. Monoid a => a
mempty

instance (Plus f, Plus g) => Plus (f :*: g) where
  zero :: forall a. (:*:) f g a
zero = forall (f :: * -> *) a. Plus f => f a
zero forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: forall (f :: * -> *) a. Plus f => f a
zero

-- | @since 5.3.8

instance (Plus f, Functor g) => Plus (f :.: g) where
  zero :: forall a. (:.:) f g a
zero = forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 forall (f :: * -> *) a. Plus f => f a
zero

instance Plus f => Plus (M1 i c f) where
  zero :: forall a. M1 i c f a
zero = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 forall (f :: * -> *) a. Plus f => f a
zero

instance Plus f => Plus (Rec1 f) where
  zero :: forall a. Rec1 f a
zero = forall k (f :: k -> *) (p :: k). f p -> Rec1 f p
Rec1 forall (f :: * -> *) a. Plus f => f a
zero

instance Plus IO where
  zero :: forall a. IO a
zero = forall a. HasCallStack => [Char] -> a
error [Char]
"zero"

instance Plus [] where
  zero :: forall a. [a]
zero = []

instance Plus Maybe where
  zero :: forall a. Maybe a
zero = forall a. Maybe a
Nothing

#if !(MIN_VERSION_base(4,16,0))
instance Plus Option where
  zero = empty
#endif

instance MonadPlus m => Plus (WrappedMonad m) where
  zero :: forall a. WrappedMonad m a
zero = forall (f :: * -> *) a. Alternative f => f a
empty

instance ArrowPlus a => Plus (WrappedArrow a b) where
  zero :: forall a. WrappedArrow a b a
zero = forall (f :: * -> *) a. Alternative f => f a
empty

#ifdef MIN_VERSION_containers
instance Ord k => Plus (Map k) where
  zero :: forall a. Map k a
zero = forall k a. Map k a
Map.empty

instance Plus IntMap where
  zero :: forall a. IntMap a
zero = forall a. IntMap a
IntMap.empty

instance Plus Seq where
  zero :: forall a. Seq a
zero = forall a. Monoid a => a
mempty
#endif

#ifdef MIN_VERSION_unordered_containers
instance (Hashable k, Eq k) => Plus (HashMap k) where
  zero :: forall a. HashMap k a
zero = forall k v. HashMap k v
HashMap.empty
#endif

instance Alternative f => Plus (WrappedApplicative f) where
  zero :: forall a. WrappedApplicative f a
zero = forall (f :: * -> *) a. Alternative f => f a
empty

instance Plus f => Plus (IdentityT f) where
  zero :: forall a. IdentityT f a
zero = forall {k} (f :: k -> *) (a :: k). f a -> IdentityT f a
IdentityT forall (f :: * -> *) a. Plus f => f a
zero

instance Plus f => Plus (ReaderT e f) where
  zero :: forall a. ReaderT e f a
zero = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \e
_ -> forall (f :: * -> *) a. Plus f => f a
zero

instance (Functor f, Monad f) => Plus (MaybeT f) where
  zero :: forall a. MaybeT f a
zero = forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall (f :: * -> *) a. Plus f => f a
zero

#if !(MIN_VERSION_transformers(0,6,0))
instance (Functor f, Monad f, Error e) => Plus (ErrorT e f) where
  zero :: forall a. ErrorT e f a
zero = forall e (m :: * -> *) a. m (Either e a) -> ErrorT e m a
ErrorT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a. Error a => a
noMsg

instance (Apply f, Applicative f) => Plus (ListT f) where
  zero :: forall a. ListT f a
zero = forall (m :: * -> *) a. m [a] -> ListT m a
ListT forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure []
#endif

instance (Functor f, Monad f, Semigroup e, Monoid e) => Plus (ExceptT e f) where
  zero :: forall a. ExceptT e f a
zero = forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a. Monoid a => a
mempty

instance Plus f => Plus (Strict.StateT e f) where
  zero :: forall a. StateT e f a
zero = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Strict.StateT forall a b. (a -> b) -> a -> b
$ \e
_ -> forall (f :: * -> *) a. Plus f => f a
zero

instance Plus f => Plus (Lazy.StateT e f) where
  zero :: forall a. StateT e f a
zero = forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
Lazy.StateT forall a b. (a -> b) -> a -> b
$ \e
_ -> forall (f :: * -> *) a. Plus f => f a
zero

instance Plus f => Plus (Strict.WriterT w f) where
  zero :: forall a. WriterT w f a
zero = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Strict.WriterT forall (f :: * -> *) a. Plus f => f a
zero

instance Plus f => Plus (Lazy.WriterT w f) where
  zero :: forall a. WriterT w f a
zero = forall w (m :: * -> *) a. m (a, w) -> WriterT w m a
Lazy.WriterT forall (f :: * -> *) a. Plus f => f a
zero

#if MIN_VERSION_transformers(0,5,6)
-- | @since 5.3.6

instance (Plus f) => Plus (CPS.WriterT w f) where
  zero :: forall a. WriterT w f a
zero = forall w (m :: * -> *) a. (w -> m (a, w)) -> WriterT w m a
mkWriterT forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall (f :: * -> *) a. Plus f => f a
zero
#endif

instance Plus f => Plus (Strict.RWST r w s f) where
  zero :: forall a. RWST r w s f a
zero = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Strict.RWST forall a b. (a -> b) -> a -> b
$ \r
_ s
_ -> forall (f :: * -> *) a. Plus f => f a
zero

instance Plus f => Plus (Lazy.RWST r w s f) where
  zero :: forall a. RWST r w s f a
zero = forall r w s (m :: * -> *) a.
(r -> s -> m (a, s, w)) -> RWST r w s m a
Lazy.RWST forall a b. (a -> b) -> a -> b
$ \r
_ s
_ -> forall (f :: * -> *) a. Plus f => f a
zero

#if MIN_VERSION_transformers(0,5,6)
-- | @since 5.3.6

instance (Plus f) => Plus (CPS.RWST r w s f) where
  zero :: forall a. RWST r w s f a
zero = forall r s w (m :: * -> *) a.
(r -> s -> w -> m (a, s, w)) -> RWST r w s m a
mkRWST forall a b. (a -> b) -> a -> b
$ \r
_ s
_ w
_ -> forall (f :: * -> *) a. Plus f => f a
zero
#endif

instance Plus f => Plus (Backwards f) where
  zero :: forall a. Backwards f a
zero = forall {k} (f :: k -> *) (a :: k). f a -> Backwards f a
Backwards forall (f :: * -> *) a. Plus f => f a
zero

instance (Plus f, Functor g) => Plus (Compose f g) where
  zero :: forall a. Compose f g a
zero = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall (f :: * -> *) a. Plus f => f a
zero

instance Plus f => Plus (Lift f) where
  zero :: forall a. Lift f a
zero = forall (f :: * -> *) a. f a -> Lift f a
Other forall (f :: * -> *) a. Plus f => f a
zero

instance (Plus f, Plus g) => Plus (Product f g) where
  zero :: forall a. Product f g a
zero = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
Pair forall (f :: * -> *) a. Plus f => f a
zero forall (f :: * -> *) a. Plus f => f a
zero

instance Plus f => Plus (Reverse f) where
  zero :: forall a. Reverse f a
zero = forall {k} (f :: k -> *) (a :: k). f a -> Reverse f a
Reverse forall (f :: * -> *) a. Plus f => f a
zero

instance Plus Monoid.First where
  zero :: forall a. First a
zero = forall a. Maybe a -> First a
Monoid.First forall a. Maybe a
Nothing

instance Plus Monoid.Last where
  zero :: forall a. Last a
zero = forall a. Maybe a -> Last a
Monoid.Last forall a. Maybe a
Nothing