{-# Language TypeOperators, MultiParamTypeClasses #-}
{-|
Module      : Advent.Group
Description : Support for abstract algebraic groups
Copyright   : (c) Eric Mertens, 2021
License     : ISC
Maintainer  : emertens@gmail.com

-}
module Advent.Group
  ( Group(inverse)
  , RightAction(rightAction)
  , type (><|)((:><|))
  ) where

import Data.Semigroup (Sum(Sum), Product(Product))

class Monoid a => Group a where
  inverse :: a -> a

instance Num a => Group (Sum a) where
  inverse :: Sum a -> Sum a
inverse (Sum a
n) = a -> Sum a
forall a. a -> Sum a
Sum (a -> a
forall a. Num a => a -> a
negate a
n)

instance Fractional a => Group (Product a) where
  inverse :: Product a -> Product a
inverse (Product a
n) = a -> Product a
forall a. a -> Product a
Product (a -> a
forall a. Fractional a => a -> a
recip a
n)

-- | Outer semi-direct product
data a ><| b = a :><| b deriving Int -> (a ><| b) -> ShowS
[a ><| b] -> ShowS
(a ><| b) -> String
(Int -> (a ><| b) -> ShowS)
-> ((a ><| b) -> String) -> ([a ><| b] -> ShowS) -> Show (a ><| b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> (a ><| b) -> ShowS
forall a b. (Show a, Show b) => [a ><| b] -> ShowS
forall a b. (Show a, Show b) => (a ><| b) -> String
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> (a ><| b) -> ShowS
showsPrec :: Int -> (a ><| b) -> ShowS
$cshow :: forall a b. (Show a, Show b) => (a ><| b) -> String
show :: (a ><| b) -> String
$cshowList :: forall a b. (Show a, Show b) => [a ><| b] -> ShowS
showList :: [a ><| b] -> ShowS
Show

instance (Semigroup a, Semigroup b, Group b, RightAction a b) => Semigroup (a ><| b)
  where
  (a
n1 :><| b
h1) <> :: (a ><| b) -> (a ><| b) -> a ><| b
<> (a
n2 :><| b
h2) = (a -> b -> a
forall a b. RightAction a b => a -> b -> a
rightAction a
n1 b
h1 a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a -> b -> a
forall a b. RightAction a b => a -> b -> a
rightAction a
n2 (b -> b
forall a. Group a => a -> a
inverse b
h1))
                            a -> b -> a ><| b
forall a b. a -> b -> a ><| b
:><| (b
h1 b -> b -> b
forall a. Semigroup a => a -> a -> a
<> b
h2)

instance (Semigroup a, Monoid a, Group b, RightAction a b) => Monoid (a ><| b) where
  mempty :: a ><| b
mempty  = a
forall a. Monoid a => a
mempty a -> b -> a ><| b
forall a b. a -> b -> a ><| b
:><| b
forall a. Monoid a => a
mempty
  mappend :: (a ><| b) -> (a ><| b) -> a ><| b
mappend = (a ><| b) -> (a ><| b) -> a ><| b
forall a. Semigroup a => a -> a -> a
(<>)

class Semigroup b => RightAction a b where
  rightAction :: a -> b -> a