-- |
-- Bidirectional transforms for "Data.Monoid".
{-# LANGUAGE CPP #-}
{-# LANGUAGE Safe, TypeOperators, QuasiQuotes #-}
module Data.Invertible.Monoid
  ( BiEndo(..)
  , dual
  , endo
  , biEndo
  , all
  , any
  , sum
  , product
  , first
  , last
  , alt
  ) where

import Prelude hiding (fmap, (<$>), all, any, sum, product, last)
import qualified Control.Category as C
import Data.Monoid

import Data.Invertible.Bijection
import Data.Invertible.TH

-- |(Un)wrap the 'Dual' monoid.
dual :: a <-> Dual a
dual :: forall a. a <-> Dual a
dual = [biCase|a <-> Dual a|]

-- |(Un)wrap the 'Endo' monoid.
endo :: (a -> a) <-> Endo a
endo :: forall a. (a -> a) <-> Endo a
endo = [biCase|a <-> Endo a|]

-- | The monoid of endomorphisms under composition.
newtype BiEndo a = BiEndo { forall a. BiEndo a -> a <-> a
appBiEndo :: a <-> a }

#if MIN_VERSION_base(4,11,0)
instance Semigroup (BiEndo a) where
  BiEndo a <-> a
f <> :: BiEndo a -> BiEndo a -> BiEndo a
<> BiEndo a <-> a
g = (a <-> a) -> BiEndo a
forall a. (a <-> a) -> BiEndo a
BiEndo (a <-> a
f (a <-> a) -> (a <-> a) -> a <-> a
forall b c a.
Bijection (->) b c -> Bijection (->) a b -> Bijection (->) a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
C.. a <-> a
g)
#endif

instance Monoid (BiEndo a) where
  mempty :: BiEndo a
mempty = (a <-> a) -> BiEndo a
forall a. (a <-> a) -> BiEndo a
BiEndo a <-> a
forall a. Bijection (->) a a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
C.id
  BiEndo a <-> a
f mappend :: BiEndo a -> BiEndo a -> BiEndo a
`mappend` BiEndo a <-> a
g = (a <-> a) -> BiEndo a
forall a. (a <-> a) -> BiEndo a
BiEndo (a <-> a
f (a <-> a) -> (a <-> a) -> a <-> a
forall b c a.
Bijection (->) b c -> Bijection (->) a b -> Bijection (->) a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
C.. a <-> a
g)

-- |(Un)wrap the 'BiEndo' monoid.
biEndo :: (a <-> a) <-> BiEndo a
biEndo :: forall a. (a <-> a) <-> BiEndo a
biEndo = [biCase|a <-> BiEndo a|]

-- |(Un)wrap the 'All' monoid.
all :: Bool <-> All
all :: Bool <-> All
all = [biCase|a <-> All a|]

-- |(Un)wrap the 'Any' monoid.
any :: Bool <-> Any
any :: Bool <-> Any
any = [biCase|a <-> Any a|]

-- |(Un)wrap the 'Sum' monoid.
sum :: a <-> Sum a
sum :: forall a. a <-> Sum a
sum = [biCase|a <-> Sum a|]

-- |(Un)wrap the 'Product' monoid.
product :: a <-> Product a
product :: forall a. a <-> Product a
product = [biCase|a <-> Product a|]

-- |(Un)wrap the 'First' monoid.
first :: Maybe a <-> First a
first :: forall a. Maybe a <-> First a
first = [biCase|a <-> First a|]

-- |(Un)wrap the 'Last' monoid.
last :: Maybe a <-> Last a
last :: forall a. Maybe a <-> Last a
last = [biCase|a <-> Last a|]

-- |(Un)wrap the 'Last' monoid.
alt :: f a <-> Alt f a
alt :: forall (f :: * -> *) a. f a <-> Alt f a
alt = [biCase|a <-> Alt a|]