{-# LANGUAGE CPP           #-}
#if MIN_VERSION_base(4,12,0)
{-# LANGUAGE TypeOperators #-}
#endif

module Data.Group where

import Data.Monoid
#if MIN_VERSION_base(4,7,0)
import Data.Proxy
#endif
#if MIN_VERSION_base(4,9,0)
import Data.Functor.Const
import Data.Functor.Identity
#endif
#if MIN_VERSION_base(4,12,0)
import Data.Functor.Contravariant (Op(Op))
import GHC.Generics
#endif

-- |A 'Group' is a 'Monoid' plus a function, 'invert', such that:
--
-- @a \<> invert a == mempty@
--
-- @invert a \<> a == mempty@
class Monoid m => Group m where
  invert :: m -> m

  -- | Group subtraction: @x ~~ y == x \<> invert y@
  (~~) :: m -> m -> m
  m
x ~~ m
y = m
x m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` m -> m
forall m. Group m => m -> m
invert m
y

  -- |@'pow' a n == a \<> a \<> ... \<> a @
  --
  -- @ (n lots of a) @
  --
  -- If n is negative, the result is inverted.
  pow :: Integral x => m -> x -> m
  pow m
x0 x
n0 = case x -> x -> Ordering
forall a. Ord a => a -> a -> Ordering
compare x
n0 x
0 of
    Ordering
LT -> m -> m
forall m. Group m => m -> m
invert (m -> m) -> (x -> m) -> x -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m -> x -> m
forall a a. (Integral a, Monoid a) => a -> a -> a
f m
x0 (x -> m) -> x -> m
forall a b. (a -> b) -> a -> b
$ x -> x
forall a. Num a => a -> a
negate x
n0
    Ordering
EQ -> m
forall a. Monoid a => a
mempty
    Ordering
GT -> m -> x -> m
forall a a. (Integral a, Monoid a) => a -> a -> a
f m
x0 x
n0
    where
      f :: a -> a -> a
f a
x a
n
        | a -> Bool
forall a. Integral a => a -> Bool
even a
n = a -> a -> a
f (a
x a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
x) (a
n a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
2)
        | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 = a
x
        | Bool
otherwise = a -> a -> a -> a
forall a a. (Integral a, Monoid a) => a -> a -> a -> a
g (a
x a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
x) (a
n a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
2) a
x
      g :: a -> a -> a -> a
g a
x a
n a
c
        | a -> Bool
forall a. Integral a => a -> Bool
even a
n = a -> a -> a -> a
g (a
x a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
x) (a
n a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
2) a
c
        | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
1 = a
x a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
c
        | Bool
otherwise = a -> a -> a -> a
g (a
x a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
x) (a
n a -> a -> a
forall a. Integral a => a -> a -> a
`quot` a
2) (a
x a -> a -> a
forall a. Monoid a => a -> a -> a
`mappend` a
c)

infixl 7 ~~

instance Group () where
  invert :: () -> ()
invert () = ()
  pow :: () -> x -> ()
pow ()
_ x
_ = ()

instance Num a => Group (Sum a) where
  invert :: Sum a -> Sum a
invert = a -> Sum a
forall a. a -> Sum a
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. Num a => a -> a
negate (a -> a) -> (Sum a -> a) -> Sum a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sum a -> a
forall a. Sum a -> a
getSum
  {-# INLINE invert #-}
  pow :: Sum a -> x -> Sum a
pow (Sum a
a) x
b = a -> Sum a
forall a. a -> Sum a
Sum (a
a a -> a -> a
forall a. Num a => a -> a -> a
* x -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral x
b)

instance Fractional a => Group (Product a) where
  invert :: Product a -> Product a
invert = a -> Product a
forall a. a -> Product a
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. Fractional a => a -> a
recip (a -> a) -> (Product a -> a) -> Product a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Product a -> a
forall a. Product a -> a
getProduct
  {-# INLINE invert #-}
  pow :: Product a -> x -> Product a
pow (Product a
a) x
b = a -> Product a
forall a. a -> Product a
Product (a
a a -> x -> a
forall a b. (Fractional a, Integral b) => a -> b -> a
^^ x
b)

instance Group a => Group (Dual a) where
  invert :: Dual a -> Dual a
invert = a -> Dual a
forall a. a -> Dual a
Dual (a -> Dual a) -> (Dual a -> a) -> Dual a -> Dual a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
forall m. Group m => m -> m
invert (a -> a) -> (Dual a -> a) -> Dual a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dual a -> a
forall a. Dual a -> a
getDual
  {-# INLINE invert #-}
  pow :: Dual a -> x -> Dual a
pow (Dual a
a) x
n = a -> Dual a
forall a. a -> Dual a
Dual (a -> x -> a
forall m x. (Group m, Integral x) => m -> x -> m
pow a
a x
n)

instance Group b => Group (a -> b) where
  invert :: (a -> b) -> a -> b
invert a -> b
f = b -> b
forall m. Group m => m -> m
invert (b -> b) -> (a -> b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
  pow :: (a -> b) -> x -> a -> b
pow a -> b
f x
n a
e = b -> x -> b
forall m x. (Group m, Integral x) => m -> x -> m
pow (a -> b
f a
e) x
n

instance (Group a, Group b) => Group (a, b) where
  invert :: (a, b) -> (a, b)
invert (a
a, b
b) = (a -> a
forall m. Group m => m -> m
invert a
a, b -> b
forall m. Group m => m -> m
invert b
b)
  pow :: (a, b) -> x -> (a, b)
pow (a
a, b
b) x
n = (a -> x -> a
forall m x. (Group m, Integral x) => m -> x -> m
pow a
a x
n, b -> x -> b
forall m x. (Group m, Integral x) => m -> x -> m
pow b
b x
n)

instance (Group a, Group b, Group c) => Group (a, b, c) where
  invert :: (a, b, c) -> (a, b, c)
invert (a
a, b
b, c
c) = (a -> a
forall m. Group m => m -> m
invert a
a, b -> b
forall m. Group m => m -> m
invert b
b, c -> c
forall m. Group m => m -> m
invert c
c)
  pow :: (a, b, c) -> x -> (a, b, c)
pow (a
a, b
b, c
c) x
n = (a -> x -> a
forall m x. (Group m, Integral x) => m -> x -> m
pow a
a x
n, b -> x -> b
forall m x. (Group m, Integral x) => m -> x -> m
pow b
b x
n, c -> x -> c
forall m x. (Group m, Integral x) => m -> x -> m
pow c
c x
n)

instance (Group a, Group b, Group c, Group d) => Group (a, b, c, d) where
  invert :: (a, b, c, d) -> (a, b, c, d)
invert (a
a, b
b, c
c, d
d) = (a -> a
forall m. Group m => m -> m
invert a
a, b -> b
forall m. Group m => m -> m
invert b
b, c -> c
forall m. Group m => m -> m
invert c
c, d -> d
forall m. Group m => m -> m
invert d
d)
  pow :: (a, b, c, d) -> x -> (a, b, c, d)
pow (a
a, b
b, c
c, d
d) x
n = (a -> x -> a
forall m x. (Group m, Integral x) => m -> x -> m
pow a
a x
n, b -> x -> b
forall m x. (Group m, Integral x) => m -> x -> m
pow b
b x
n, c -> x -> c
forall m x. (Group m, Integral x) => m -> x -> m
pow c
c x
n, d -> x -> d
forall m x. (Group m, Integral x) => m -> x -> m
pow d
d x
n)

instance (Group a, Group b, Group c, Group d, Group e) => Group (a, b, c, d, e) where
  invert :: (a, b, c, d, e) -> (a, b, c, d, e)
invert (a
a, b
b, c
c, d
d, e
e) = (a -> a
forall m. Group m => m -> m
invert a
a, b -> b
forall m. Group m => m -> m
invert b
b, c -> c
forall m. Group m => m -> m
invert c
c, d -> d
forall m. Group m => m -> m
invert d
d, e -> e
forall m. Group m => m -> m
invert e
e)
  pow :: (a, b, c, d, e) -> x -> (a, b, c, d, e)
pow (a
a, b
b, c
c, d
d, e
e) x
n = (a -> x -> a
forall m x. (Group m, Integral x) => m -> x -> m
pow a
a x
n, b -> x -> b
forall m x. (Group m, Integral x) => m -> x -> m
pow b
b x
n, c -> x -> c
forall m x. (Group m, Integral x) => m -> x -> m
pow c
c x
n, d -> x -> d
forall m x. (Group m, Integral x) => m -> x -> m
pow d
d x
n, e -> x -> e
forall m x. (Group m, Integral x) => m -> x -> m
pow e
e x
n)


-- |An 'Abelian' group is a 'Group' that follows the rule:
--
-- @a \<> b == b \<> a@
class Group g => Abelian g

instance Abelian ()

instance Num a => Abelian (Sum a)

instance Fractional a => Abelian (Product a)

instance Abelian a => Abelian (Dual a)

instance Abelian b => Abelian (a -> b)

instance (Abelian a, Abelian b) => Abelian (a, b)

instance (Abelian a, Abelian b, Abelian c) => Abelian (a, b, c)

instance (Abelian a, Abelian b, Abelian c, Abelian d) => Abelian (a, b, c, d)

instance (Abelian a, Abelian b, Abelian c, Abelian d, Abelian e) => Abelian (a, b, c, d, e)


-- | A 'Group' G is 'Cyclic' if there exists an element x of G such that for all y in G, there exists an n, such that
--
-- @y = pow x n@
class Group a => Cyclic a where
  generator :: a

generated :: Cyclic a => [a]
generated :: [a]
generated =
  (a -> a) -> a -> [a]
forall a. (a -> a) -> a -> [a]
iterate (a -> a -> a
forall a. Monoid a => a -> a -> a
mappend a
forall a. Cyclic a => a
generator) a
forall a. Monoid a => a
mempty

instance Cyclic () where
  generator :: ()
generator = ()

instance Integral a => Cyclic (Sum a) where
  generator :: Sum a
generator = a -> Sum a
forall a. a -> Sum a
Sum a
1
#if MIN_VERSION_base(4,7,0)
-- | Trivial group, Functor style.
instance Group (Proxy x) where
  invert :: Proxy x -> Proxy x
invert Proxy x
_ = Proxy x
forall k (t :: k). Proxy t
Proxy
  Proxy x
_ ~~ :: Proxy x -> Proxy x -> Proxy x
~~ Proxy x
_ = Proxy x
forall k (t :: k). Proxy t
Proxy
  pow :: Proxy x -> x -> Proxy x
pow Proxy x
_ x
_ = Proxy x
forall k (t :: k). Proxy t
Proxy

instance Abelian (Proxy x)

instance Cyclic (Proxy x) where
  generator :: Proxy x
generator = Proxy x
forall k (t :: k). Proxy t
Proxy
#endif

-- 'Const' has existed for a long time, but the Monoid instance
-- arrives in base-4.9.0.0. Similarly, 'Identity' was defined in
-- base-4.8.0.0 but doesn't get the Monoid instance until base-4.9.0.0
#if MIN_VERSION_base(4,9,0)
-- | 'Const' lifts groups into a functor.
instance Group a => Group (Const a x) where
  invert :: Const a x -> Const a x
invert (Const a
a) = a -> Const a x
forall k a (b :: k). a -> Const a b
Const (a -> a
forall m. Group m => m -> m
invert a
a)
  Const a
a ~~ :: Const a x -> Const a x -> Const a x
~~ Const a
b = a -> Const a x
forall k a (b :: k). a -> Const a b
Const (a
a a -> a -> a
forall m. Group m => m -> m -> m
~~ a
b)

-- | 'Identity' lifts groups pointwise (at only one point).
instance Group a => Group (Identity a) where
  invert :: Identity a -> Identity a
invert (Identity a
a) = a -> Identity a
forall a. a -> Identity a
Identity (a -> a
forall m. Group m => m -> m
invert a
a)
  Identity a
a ~~ :: Identity a -> Identity a -> Identity a
~~ Identity a
b = a -> Identity a
forall a. a -> Identity a
Identity (a
a a -> a -> a
forall m. Group m => m -> m -> m
~~ a
b)

instance Abelian a => Abelian (Const a x)

instance Abelian a => Abelian (Identity a)

instance Cyclic a => Cyclic (Const a x) where
  generator :: Const a x
generator = a -> Const a x
forall k a (b :: k). a -> Const a b
Const a
forall a. Cyclic a => a
generator

instance Cyclic a => Cyclic (Identity a) where
  generator :: Identity a
generator = a -> Identity a
forall a. a -> Identity a
Identity a
forall a. Cyclic a => a
generator
#endif

-- (:*:) and (:.:) exist since base-4.6.0.0 but the Monoid instances
-- arrive in base-4.12.0.0.
-- Also, contravariant was moved into base in this version.
#if MIN_VERSION_base(4,12,0)
-- | Product of groups, Functor style.
instance (Group (f a), Group (g a)) => Group ((f :*: g) a) where
  invert :: (:*:) f g a -> (:*:) f g a
invert (f a
a :*: g a
b) = f a -> f a
forall m. Group m => m -> m
invert f a
a f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g a -> g a
forall m. Group m => m -> m
invert g a
b
  (f a
a :*: g a
b) ~~ :: (:*:) f g a -> (:*:) f g a -> (:*:) f g a
~~ (f a
c :*: g a
d) = (f a
a f a -> f a -> f a
forall m. Group m => m -> m -> m
~~ f a
c) f a -> g a -> (:*:) f g a
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (g a
b g a -> g a -> g a
forall m. Group m => m -> m -> m
~~ g a
d)

-- See https://gitlab.haskell.org/ghc/ghc/issues/11135#note_111802 for the reason Compose is not also provided.
-- Base does not define Monoid (Compose f g a) so this is the best we can
-- really do for functor composition.
instance Group (f (g a)) => Group ((f :.: g) a) where
  invert :: (:.:) f g a -> (:.:) f g a
invert (Comp1 f (g a)
xs) = f (g a) -> (:.:) f g a
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (f (g a) -> f (g a)
forall m. Group m => m -> m
invert f (g a)
xs)
  Comp1 f (g a)
xs ~~ :: (:.:) f g a -> (:.:) f g a -> (:.:) f g a
~~ Comp1 f (g a)
ys = f (g a) -> (:.:) f g a
forall k2 k1 (f :: k2 -> *) (g :: k1 -> k2) (p :: k1).
f (g p) -> (:.:) f g p
Comp1 (f (g a)
xs f (g a) -> f (g a) -> f (g a)
forall m. Group m => m -> m -> m
~~ f (g a)
ys)

instance (Abelian (f a), Abelian (g a)) => Abelian ((f :*: g) a)

instance Abelian (f (g a)) => Abelian ((f :.: g) a)

instance Group a => Group (Op a b) where
  invert :: Op a b -> Op a b
invert (Op b -> a
f) = (b -> a) -> Op a b
forall a b. (b -> a) -> Op a b
Op ((b -> a) -> b -> a
forall m. Group m => m -> m
invert b -> a
f)
  pow :: Op a b -> x -> Op a b
pow (Op b -> a
f) x
n = (b -> a) -> Op a b
forall a b. (b -> a) -> Op a b
Op (\b
e -> a -> x -> a
forall m x. (Group m, Integral x) => m -> x -> m
pow (b -> a
f b
e) x
n)

instance Abelian a => Abelian (Op a b)
#endif