{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts, TypeOperators #-}
{-# LANGUAGE CPP #-}
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif

-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Semigroup.Alternative
-- Copyright   :  (c) Edward Kmett 2009-2011
-- License     :  BSD-style
-- Maintainer  :  ekmett@gmail.com
-- Stability   :  experimental
-- Portability :  non-portable (MPTCs)
--
-- A semigroup for working with 'Alternative' 'Functor's.
--
-----------------------------------------------------------------------------

module Data.Semigroup.Alternative
    ( Alternate(..)
    ) where

import Control.Applicative
import Data.Semigroup.Reducer (Reducer(..))

#if !(MIN_VERSION_base(4,8,0))
import Data.Monoid (Monoid(..))
#endif

#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..))
#endif

-- | A 'Alternate' turns any 'Alternative' instance into a 'Monoid'.

newtype Alternate f a = Alternate { Alternate f a -> f a
getAlternate :: f a }
  deriving (a -> Alternate f b -> Alternate f a
(a -> b) -> Alternate f a -> Alternate f b
(forall a b. (a -> b) -> Alternate f a -> Alternate f b)
-> (forall a b. a -> Alternate f b -> Alternate f a)
-> Functor (Alternate f)
forall a b. a -> Alternate f b -> Alternate f a
forall a b. (a -> b) -> Alternate f a -> Alternate f b
forall (f :: * -> *) a b.
Functor f =>
a -> Alternate f b -> Alternate f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> Alternate f a -> Alternate f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Alternate f b -> Alternate f a
$c<$ :: forall (f :: * -> *) a b.
Functor f =>
a -> Alternate f b -> Alternate f a
fmap :: (a -> b) -> Alternate f a -> Alternate f b
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> Alternate f a -> Alternate f b
Functor,Functor (Alternate f)
a -> Alternate f a
Functor (Alternate f)
-> (forall a. a -> Alternate f a)
-> (forall a b.
    Alternate f (a -> b) -> Alternate f a -> Alternate f b)
-> (forall a b c.
    (a -> b -> c) -> Alternate f a -> Alternate f b -> Alternate f c)
-> (forall a b. Alternate f a -> Alternate f b -> Alternate f b)
-> (forall a b. Alternate f a -> Alternate f b -> Alternate f a)
-> Applicative (Alternate f)
Alternate f a -> Alternate f b -> Alternate f b
Alternate f a -> Alternate f b -> Alternate f a
Alternate f (a -> b) -> Alternate f a -> Alternate f b
(a -> b -> c) -> Alternate f a -> Alternate f b -> Alternate f c
forall a. a -> Alternate f a
forall a b. Alternate f a -> Alternate f b -> Alternate f a
forall a b. Alternate f a -> Alternate f b -> Alternate f b
forall a b. Alternate f (a -> b) -> Alternate f a -> Alternate f b
forall a b c.
(a -> b -> c) -> Alternate f a -> Alternate f b -> Alternate f c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (f :: * -> *). Applicative f => Functor (Alternate f)
forall (f :: * -> *) a. Applicative f => a -> Alternate f a
forall (f :: * -> *) a b.
Applicative f =>
Alternate f a -> Alternate f b -> Alternate f a
forall (f :: * -> *) a b.
Applicative f =>
Alternate f a -> Alternate f b -> Alternate f b
forall (f :: * -> *) a b.
Applicative f =>
Alternate f (a -> b) -> Alternate f a -> Alternate f b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> Alternate f a -> Alternate f b -> Alternate f c
<* :: Alternate f a -> Alternate f b -> Alternate f a
$c<* :: forall (f :: * -> *) a b.
Applicative f =>
Alternate f a -> Alternate f b -> Alternate f a
*> :: Alternate f a -> Alternate f b -> Alternate f b
$c*> :: forall (f :: * -> *) a b.
Applicative f =>
Alternate f a -> Alternate f b -> Alternate f b
liftA2 :: (a -> b -> c) -> Alternate f a -> Alternate f b -> Alternate f c
$cliftA2 :: forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> Alternate f a -> Alternate f b -> Alternate f c
<*> :: Alternate f (a -> b) -> Alternate f a -> Alternate f b
$c<*> :: forall (f :: * -> *) a b.
Applicative f =>
Alternate f (a -> b) -> Alternate f a -> Alternate f b
pure :: a -> Alternate f a
$cpure :: forall (f :: * -> *) a. Applicative f => a -> Alternate f a
$cp1Applicative :: forall (f :: * -> *). Applicative f => Functor (Alternate f)
Applicative,Applicative (Alternate f)
Alternate f a
Applicative (Alternate f)
-> (forall a. Alternate f a)
-> (forall a. Alternate f a -> Alternate f a -> Alternate f a)
-> (forall a. Alternate f a -> Alternate f [a])
-> (forall a. Alternate f a -> Alternate f [a])
-> Alternative (Alternate f)
Alternate f a -> Alternate f a -> Alternate f a
Alternate f a -> Alternate f [a]
Alternate f a -> Alternate f [a]
forall a. Alternate f a
forall a. Alternate f a -> Alternate f [a]
forall a. Alternate f a -> Alternate f a -> Alternate f a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall (f :: * -> *). Alternative f => Applicative (Alternate f)
forall (f :: * -> *) a. Alternative f => Alternate f a
forall (f :: * -> *) a.
Alternative f =>
Alternate f a -> Alternate f [a]
forall (f :: * -> *) a.
Alternative f =>
Alternate f a -> Alternate f a -> Alternate f a
many :: Alternate f a -> Alternate f [a]
$cmany :: forall (f :: * -> *) a.
Alternative f =>
Alternate f a -> Alternate f [a]
some :: Alternate f a -> Alternate f [a]
$csome :: forall (f :: * -> *) a.
Alternative f =>
Alternate f a -> Alternate f [a]
<|> :: Alternate f a -> Alternate f a -> Alternate f a
$c<|> :: forall (f :: * -> *) a.
Alternative f =>
Alternate f a -> Alternate f a -> Alternate f a
empty :: Alternate f a
$cempty :: forall (f :: * -> *) a. Alternative f => Alternate f a
$cp1Alternative :: forall (f :: * -> *). Alternative f => Applicative (Alternate f)
Alternative)

instance Alternative f => Semigroup (Alternate f a) where
  Alternate f a
a <> :: Alternate f a -> Alternate f a -> Alternate f a
<> Alternate f a
b = f a -> Alternate f a
forall (f :: * -> *) a. f a -> Alternate f a
Alternate (f a
a f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> f a
b)

instance Alternative f => Monoid (Alternate f a) where
  mempty :: Alternate f a
mempty = Alternate f a
forall (f :: * -> *) a. Alternative f => f a
empty
#if !(MIN_VERSION_base(4,11,0))
  Alternate a `mappend` Alternate b = Alternate (a <|> b)
#endif

instance Alternative f => Reducer (f a) (Alternate f a) where
  unit :: f a -> Alternate f a
unit = f a -> Alternate f a
forall (f :: * -> *) a. f a -> Alternate f a
Alternate