{- |
Copyright    :   (c) Henning Thielemann 2009-2010, Mikael Johansson 2006
Maintainer   :   numericprelude@henning-thielemann.de
Stability    :   provisional
Portability  :

Abstract concept of a Monoid.
Will be used in order to generate type classes for generic algebras.
An algebra is a vector space that also is a monoid.
Should we use the Monoid class from base library
despite its unfortunate method name @mappend@?
-}

module Algebra.Monoid where

import qualified Algebra.Additive as Additive
import qualified Algebra.Ring as Ring

import Data.Monoid as Mn

import Data.Function ((.))
import Data.List (foldr, reverse, map)
import Prelude ()


{- |
We expect a monoid to adher to associativity and
the identity behaving decently.
Nothing more, really.
-}
class C a where
  idt   :: a
  (<*>) :: a -> a -> a
  cumulate :: [a] -> a
  cumulate = (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> a -> a
forall a. C a => a -> a -> a
(<*>) a
forall a. C a => a
idt


instance C All where
  idt :: All
idt = All
forall a. Monoid a => a
mempty
  <*> :: All -> All -> All
(<*>) = All -> All -> All
forall a. Monoid a => a -> a -> a
mappend
  cumulate :: [All] -> All
cumulate = [All] -> All
forall a. Monoid a => [a] -> a
mconcat

instance C Any where
  idt :: Any
idt = Any
forall a. Monoid a => a
mempty
  <*> :: Any -> Any -> Any
(<*>) = Any -> Any -> Any
forall a. Monoid a => a -> a -> a
mappend
  cumulate :: [Any] -> Any
cumulate = [Any] -> Any
forall a. Monoid a => [a] -> a
mconcat

instance C a => C (Dual a) where
  idt :: Dual a
idt = a -> Dual a
forall a. a -> Dual a
Mn.Dual a
forall a. C a => a
idt
  (Mn.Dual a
x) <*> :: Dual a -> Dual a -> Dual a
<*> (Mn.Dual a
y) = a -> Dual a
forall a. a -> Dual a
Mn.Dual (a
y a -> a -> a
forall a. C a => a -> a -> a
<*> a
x)
  cumulate :: [Dual a] -> Dual a
cumulate = a -> Dual a
forall a. a -> Dual a
Mn.Dual (a -> Dual a) -> ([Dual a] -> a) -> [Dual a] -> Dual a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> a
forall a. C a => [a] -> a
cumulate ([a] -> a) -> ([Dual a] -> [a]) -> [Dual a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> ([Dual a] -> [a]) -> [Dual a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Dual a -> a) -> [Dual a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Dual a -> a
forall a. Dual a -> a
Mn.getDual

instance C (Endo a) where
  idt :: Endo a
idt = Endo a
forall a. Monoid a => a
mempty
  <*> :: Endo a -> Endo a -> Endo a
(<*>) = Endo a -> Endo a -> Endo a
forall a. Monoid a => a -> a -> a
mappend
  cumulate :: [Endo a] -> Endo a
cumulate = [Endo a] -> Endo a
forall a. Monoid a => [a] -> a
mconcat

instance C (First a) where
  idt :: First a
idt = First a
forall a. Monoid a => a
mempty
  <*> :: First a -> First a -> First a
(<*>) = First a -> First a -> First a
forall a. Monoid a => a -> a -> a
mappend
  cumulate :: [First a] -> First a
cumulate = [First a] -> First a
forall a. Monoid a => [a] -> a
mconcat

instance C (Last a) where
  idt :: Last a
idt = Last a
forall a. Monoid a => a
mempty
  <*> :: Last a -> Last a -> Last a
(<*>) = Last a -> Last a -> Last a
forall a. Monoid a => a -> a -> a
mappend
  cumulate :: [Last a] -> Last a
cumulate = [Last a] -> Last a
forall a. Monoid a => [a] -> a
mconcat


instance Ring.C a => C (Product a) where
  idt :: Product a
idt = a -> Product a
forall a. a -> Product a
Mn.Product a
forall a. C a => a
Ring.one
  (Mn.Product a
x) <*> :: Product a -> Product a -> Product a
<*> (Mn.Product a
y) = a -> Product a
forall a. a -> Product a
Mn.Product (a
x a -> a -> a
forall a. C a => a -> a -> a
Ring.* a
y)
  cumulate :: [Product a] -> Product a
cumulate = a -> Product a
forall a. a -> Product a
Mn.Product (a -> Product a) -> ([Product a] -> a) -> [Product a] -> Product a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> a
forall a. C a => [a] -> a
Ring.product ([a] -> a) -> ([Product a] -> [a]) -> [Product a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Product a -> a) -> [Product a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Product a -> a
forall a. Product a -> a
Mn.getProduct

instance Additive.C a => C (Sum a) where
  idt :: Sum a
idt = a -> Sum a
forall a. a -> Sum a
Mn.Sum a
forall a. C a => a
Additive.zero
  (Mn.Sum a
x) <*> :: Sum a -> Sum a -> Sum a
<*> (Mn.Sum a
y) = a -> Sum a
forall a. a -> Sum a
Mn.Sum (a
x a -> a -> a
forall a. C a => a -> a -> a
Additive.+ a
y)
  cumulate :: [Sum a] -> Sum a
cumulate = a -> Sum a
forall a. a -> Sum a
Mn.Sum (a -> Sum a) -> ([Sum a] -> a) -> [Sum a] -> Sum a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> a
forall a. C a => [a] -> a
Additive.sum ([a] -> a) -> ([Sum a] -> [a]) -> [Sum a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sum a -> a) -> [Sum a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Sum a -> a
forall a. Sum a -> a
Mn.getSum