{-
    Copyright 2011-2020 Mario Blazevic
-}

-- | This module defines the 'MonoidApplicative' and 'MonoidAlternative' type classes. Their methods are specialized
-- forms of the standard 'Applicative' and 'Alternative' class methods. Instances of these classes should override the
-- default method implementations with more efficient ones.

module Control.Applicative.Monoid (
   MonoidApplicative(..), MonoidAlternative(..)
   )
where

import Control.Applicative (Applicative (pure, (<*>)), Alternative ((<|>)), (<$>))
import Data.Monoid (Monoid, mempty)
import Data.Semigroup (Semigroup, (<>))


class Applicative f => MonoidApplicative f where
   -- | A variant of the Applicative's '<*>' operator specialized for endomorphic functions.
   infixl 4 +<*>
   (+<*>) :: f (a -> a) -> f a -> f a
   (+<*>) = forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)

   -- | Lifted and potentially optimized monoid `Data.Monoid.mappend` operation from the parameter type.
   infixl 5 ><
   (><) :: Semigroup a => f a -> f a -> f a
   f a
a >< f a
b = forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
a forall (f :: * -> *) a.
MonoidApplicative f =>
f (a -> a) -> f a -> f a
+<*> f a
b

class (Alternative f, MonoidApplicative f) => MonoidAlternative f where
   -- | Like 'optional', but restricted to 'Monoid' results.
   moptional :: (Semigroup a, Monoid a) => f a -> f a
   moptional f a
x = f a
x forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty

   -- | Zero or more argument occurrences like 'Control.Applicative.many', but concatenated.
   concatMany :: (Semigroup a, Monoid a) => f a -> f a
   concatMany f a
x = f a
many'
      where many' :: f a
many' = f a
some' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
            some' :: f a
some' = f a
x forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< f a
many'

   -- | One or more argument occurrences like 'Control.Applicative.some', but concatenated.
   concatSome :: (Semigroup a, Monoid a) => f a -> f a
   concatSome f a
x = f a
some'
      where many' :: f a
many' = f a
some' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
            some' :: f a
some' = f a
x forall (f :: * -> *) a.
(MonoidApplicative f, Semigroup a) =>
f a -> f a -> f a
>< f a
many'