{-# language Safe #-}
{-# language FlexibleInstances #-}
{-# language PatternSynonyms #-}
{-# language ViewPatterns #-}
-- |
-- Module       : Data.Group.Order
-- Copyright    : (c) 2020-2021 Emily Pillmore,
--                Koji Miyazato <viercc@gmail.com>
-- License      : BSD-style
--
-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>,
--                Reed Mullanix <reedmullanix@gmail.com>
-- Stability    : stable
-- Portability  : non-portable
--
-- This module contains definitions for 'GroupOrder'.
module Data.Group.Order
( -- * Group order
  GroupOrder(..)
  -- ** Order
, Order(..)
, pattern Infinitary
, pattern Finitary
, orderForBits
, lcmOrder
, FiniteGroup
, finiteOrder
) where


import Data.Bits
import Data.Functor.Const (Const(..))
import Data.Functor.Identity (Identity(..))
import Data.Group
import Data.Group.Finite (FiniteGroup, finiteOrder)
import Data.Int
import Data.Monoid
import Data.Ord (Down(..))
import Data.Proxy (Proxy)
import Data.Word


import Numeric.Natural (Natural)


-- -------------------------------------------------------------------- --
-- Group order

-- | The order of a group element.
--
-- The order of a group element can either be infinite,
-- as in the case of @Sum Integer@, or finite, as in the
-- case of @Sum Word8@.
--
data Order = Infinite | Finite !Natural
  deriving (Order -> Order -> Bool
(Order -> Order -> Bool) -> (Order -> Order -> Bool) -> Eq Order
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Order -> Order -> Bool
$c/= :: Order -> Order -> Bool
== :: Order -> Order -> Bool
$c== :: Order -> Order -> Bool
Eq, Int -> Order -> ShowS
[Order] -> ShowS
Order -> String
(Int -> Order -> ShowS)
-> (Order -> String) -> ([Order] -> ShowS) -> Show Order
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Order] -> ShowS
$cshowList :: [Order] -> ShowS
show :: Order -> String
$cshow :: Order -> String
showsPrec :: Int -> Order -> ShowS
$cshowsPrec :: Int -> Order -> ShowS
Show)

-- | Unidirectional pattern synonym for the infinite order of a
-- group element.
--
pattern Infinitary :: (GroupOrder g) => g
pattern $mInfinitary :: forall r g. GroupOrder g => g -> (Void# -> r) -> (Void# -> r) -> r
Infinitary <- (order -> Infinite)

-- | Unidirectional pattern synonym for the finite order of a
-- group element.
--
pattern Finitary :: (GroupOrder g) => Natural -> g
pattern $mFinitary :: forall r g.
GroupOrder g =>
g -> (Natural -> r) -> (Void# -> r) -> r
Finitary n <- (order -> Finite n)

-- | @lcmOrder x y@ calculates the least common multiple of two 'Order's.
--
--   If both @x@ and @y@ are finite, it returns @'Finite' r@ where @r@
--   is the least common multiple of them. Otherwise, it returns 'Infinite'.
--
-- === __Examples__:
--
-- >>> lcmOrder (Finite 2) (Finite 5)
-- Finite 10
-- >>> lcmOrder (Finite 2) (Finite 10)
-- Finite 10
-- >>> lcmOrder (Finite 1) Infinite
-- Infinite
--
lcmOrder :: Order -> Order -> Order
lcmOrder :: Order -> Order -> Order
lcmOrder (Finite Natural
m) (Finite Natural
n) = Natural -> Order
Finite (Natural -> Natural -> Natural
forall a. Integral a => a -> a -> a
lcm Natural
m Natural
n)
lcmOrder Order
_          Order
_          = Order
Infinite

-- | The typeclass of groups, equipped with the function
-- computing the order of a specific element of a group.
--
-- The order of @x@ is the smallest positive integer @k@
-- such that @'Data.Group.gtimes' k x == 'mempty'@. If there are no such
-- integers, the order of @x@ is defined to be infinity.
--
-- /Note:/ For any valid instances of 'GroupOrder',
-- @order x == Finite 1@ holds if and only if @x == mempty@.
--
-- === __Examples__:
--
-- >>> order (3 :: Sum Word8)
-- Finite 256
-- >>> order (16 :: Sum Word8)
-- Finite 16
-- >>> order (0 :: Sum Integer)
-- Finite 1
-- >>> order (1 :: Sum Integer)
-- Infinite
--
class (Eq g, Group g) => GroupOrder g where
    -- | The order of an element of a group.
    --
    -- @order x@ must be @Finite k@ if the order of @x@ is
    -- finite @k@, and must be @Infinite@ otherwise.
    --
    -- For a type which is also 'FiniteGroup',
    -- @'Finite' . 'finiteOrder'@ is a valid implementation of 'order',
    -- if not efficient.
    order :: g -> Order

instance GroupOrder () where
    order :: () -> Order
order ()
_ = Natural -> Order
Finite Natural
1

instance GroupOrder (Proxy a) where
    order :: Proxy a -> Order
order Proxy a
_ = Natural -> Order
Finite Natural
1

instance GroupOrder (Sum Integer) where
    order :: Sum Integer -> Order
order Sum Integer
0 = Natural -> Order
Finite Natural
1
    order Sum Integer
_ = Order
Infinite

instance GroupOrder (Sum Rational) where
    order :: Sum Rational -> Order
order Sum Rational
0 = Natural -> Order
Finite Natural
1
    order Sum Rational
_ = Order
Infinite

instance GroupOrder (Sum Int) where order :: Sum Int -> Order
order = Sum Int -> Order
forall a. (Integral a, FiniteBits a) => Sum a -> Order
orderForBits
instance GroupOrder (Sum Int8) where order :: Sum Int8 -> Order
order = Sum Int8 -> Order
forall a. (Integral a, FiniteBits a) => Sum a -> Order
orderForBits
instance GroupOrder (Sum Int16) where order :: Sum Int16 -> Order
order = Sum Int16 -> Order
forall a. (Integral a, FiniteBits a) => Sum a -> Order
orderForBits
instance GroupOrder (Sum Int32) where order :: Sum Int32 -> Order
order = Sum Int32 -> Order
forall a. (Integral a, FiniteBits a) => Sum a -> Order
orderForBits
instance GroupOrder (Sum Int64) where order :: Sum Int64 -> Order
order = Sum Int64 -> Order
forall a. (Integral a, FiniteBits a) => Sum a -> Order
orderForBits
instance GroupOrder (Sum Word) where order :: Sum Word -> Order
order = Sum Word -> Order
forall a. (Integral a, FiniteBits a) => Sum a -> Order
orderForBits
instance GroupOrder (Sum Word8) where order :: Sum Word8 -> Order
order = Sum Word8 -> Order
forall a. (Integral a, FiniteBits a) => Sum a -> Order
orderForBits
instance GroupOrder (Sum Word16) where order :: Sum Word16 -> Order
order = Sum Word16 -> Order
forall a. (Integral a, FiniteBits a) => Sum a -> Order
orderForBits
instance GroupOrder (Sum Word32) where order :: Sum Word32 -> Order
order = Sum Word32 -> Order
forall a. (Integral a, FiniteBits a) => Sum a -> Order
orderForBits
instance GroupOrder (Sum Word64) where order :: Sum Word64 -> Order
order = Sum Word64 -> Order
forall a. (Integral a, FiniteBits a) => Sum a -> Order
orderForBits


-- | Given a number @x :: a@ represented by fixed-width binary integers,
-- return the minimum positive integer @2^n@ such that
-- @(fromInteger (2^n) * x :: a) == 0@.
--
zeroFactor :: FiniteBits a => a -> Natural
zeroFactor :: a -> Natural
zeroFactor a
a = Int -> Natural
forall a. Bits a => Int -> a
bit (a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize a
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros a
a)

-- | An efficient implementation of 'order' for additive group of
--   fixed-width integers, like 'Int' or 'Word8'.
--
orderForBits :: (Integral a, FiniteBits a) => Sum a -> Order
orderForBits :: Sum a -> Order
orderForBits (Sum a
a) = Natural -> Order
Finite (a -> Natural
forall a. FiniteBits a => a -> Natural
zeroFactor a
a)

instance GroupOrder (Product Rational) where
    order :: Product Rational -> Order
order Product Rational
1 = Natural -> Order
Finite Natural
1
    order Product Rational
_ = Order
Infinite

instance (GroupOrder a, GroupOrder b) => GroupOrder (a,b) where
    order :: (a, b) -> Order
order (a
a,b
b) = a -> Order
forall g. GroupOrder g => g -> Order
order a
a Order -> Order -> Order
`lcmOrder` b -> Order
forall g. GroupOrder g => g -> Order
order b
b

instance (GroupOrder a, GroupOrder b, GroupOrder c) => GroupOrder (a,b,c) where
    order :: (a, b, c) -> Order
order (a
a,b
b,c
c) = ((a, b), c) -> Order
forall g. GroupOrder g => g -> Order
order ((a
a,b
b),c
c)

instance (GroupOrder a, GroupOrder b, GroupOrder c, GroupOrder d)
        => GroupOrder (a,b,c,d) where
    order :: (a, b, c, d) -> Order
order (a
a,b
b,c
c,d
d) = ((a, b), (c, d)) -> Order
forall g. GroupOrder g => g -> Order
order ((a
a,b
b),(c
c,d
d))
instance (GroupOrder a, GroupOrder b, GroupOrder c, GroupOrder d, GroupOrder e)
        => GroupOrder (a,b,c,d,e) where
    order :: (a, b, c, d, e) -> Order
order (a
a,b
b,c
c,d
d,e
e) = ((a, b, c), (d, e)) -> Order
forall g. GroupOrder g => g -> Order
order ((a
a,b
b,c
c),(d
d,e
e))

{- Safe Haskell doesn't allow GND, at least for now.
{-# language
  GeneralizedNewtypeDeriving,
  StandaloneDeriving,
  DerivingStrategies
#-}
deriving newtype instance GroupOrder a => GroupOrder (Down a)
deriving newtype instance GroupOrder a => GroupOrder (Dual a)
deriving newtype instance GroupOrder a => GroupOrder (Const a b)
deriving newtype instance GroupOrder a => GroupOrder (Identity a)
-}
instance GroupOrder a => GroupOrder (Down a) where
    order :: Down a -> Order
order (Down a
a) = a -> Order
forall g. GroupOrder g => g -> Order
order a
a

instance GroupOrder a => GroupOrder (Dual a) where
    order :: Dual a -> Order
order = a -> Order
forall g. GroupOrder g => g -> Order
order (a -> Order) -> (Dual a -> a) -> Dual a -> Order
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dual a -> a
forall a. Dual a -> a
getDual

instance GroupOrder a => GroupOrder (Const a b) where
    order :: Const a b -> Order
order = a -> Order
forall g. GroupOrder g => g -> Order
order (a -> Order) -> (Const a b -> a) -> Const a b -> Order
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const a b -> a
forall a k (b :: k). Const a b -> a
getConst

instance GroupOrder a => GroupOrder (Identity a) where
    order :: Identity a -> Order
order = a -> Order
forall g. GroupOrder g => g -> Order
order (a -> Order) -> (Identity a -> a) -> Identity a -> Order
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity