{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, FlexibleContexts #-}
{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif

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

module Data.Semigroup.Alt
    ( Alter(..)
    ) where

import Data.Functor.Plus
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 'Alter' turns any 'Alt' instance into a 'Semigroup'.

newtype Alter f a = Alter { Alter f a -> f a
getAlter :: f a }
    deriving (a -> Alter f b -> Alter f a
(a -> b) -> Alter f a -> Alter f b
(forall a b. (a -> b) -> Alter f a -> Alter f b)
-> (forall a b. a -> Alter f b -> Alter f a) -> Functor (Alter f)
forall a b. a -> Alter f b -> Alter f a
forall a b. (a -> b) -> Alter f a -> Alter f b
forall (f :: * -> *) a b. Functor f => a -> Alter f b -> Alter f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> Alter f a -> Alter f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Alter f b -> Alter f a
$c<$ :: forall (f :: * -> *) a b. Functor f => a -> Alter f b -> Alter f a
fmap :: (a -> b) -> Alter f a -> Alter f b
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> Alter f a -> Alter f b
Functor,Alt (Alter f)
Alter f a
Alt (Alter f) -> (forall a. Alter f a) -> Plus (Alter f)
forall a. Alter f a
forall (f :: * -> *). Plus f => Alt (Alter f)
forall (f :: * -> *) a. Plus f => Alter f a
forall (f :: * -> *). Alt f -> (forall a. f a) -> Plus f
zero :: Alter f a
$czero :: forall (f :: * -> *) a. Plus f => Alter f a
$cp1Plus :: forall (f :: * -> *). Plus f => Alt (Alter f)
Plus)

instance Alt f => Alt (Alter f) where
    Alter f a
a <!> :: Alter f a -> Alter f a -> Alter f a
<!> Alter f a
b = f a -> Alter f a
forall (f :: * -> *) a. f a -> Alter f a
Alter (f a
a f a -> f a -> f a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> f a
b)

instance Alt f => Semigroup (Alter f a) where
    Alter f a
a <> :: Alter f a -> Alter f a -> Alter f a
<> Alter f a
b = f a -> Alter f a
forall (f :: * -> *) a. f a -> Alter f a
Alter (f a
a f a -> f a -> f a
forall (f :: * -> *) a. Alt f => f a -> f a -> f a
<!> f a
b)

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

instance Alt f => Reducer (f a) (Alter f a) where
    unit :: f a -> Alter f a
unit = f a -> Alter f a
forall (f :: * -> *) a. f a -> Alter f a
Alter