{-# LANGUAGE ConstraintKinds        #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module PlutusTx.Numeric (
  -- * Type classes
  AdditiveSemigroup (..),
  AdditiveMonoid (..),
  AdditiveGroup (..),
  MultiplicativeSemigroup (..),
  MultiplicativeMonoid (..),
  Semiring,
  Ring,
  Module (..),
  -- * Helper newtypes
  Additive (..),
  Multiplicative (..),
  -- * Helper functions
  negate,
  divMod,
  quotRem,
  abs,
  ) where

import Data.Semigroup (Product (Product), Sum (Sum))
import PlutusTx.Bool (Bool (False, True), (&&), (||))
import PlutusTx.Builtins (Integer, addInteger, divideInteger, modInteger, multiplyInteger, quotientInteger,
                          remainderInteger, subtractInteger)
import PlutusTx.Monoid (Group, Monoid (mempty), gsub)
import PlutusTx.Ord (Ord ((<)))
import PlutusTx.Semigroup (Semigroup ((<>)))

infixl 7 *
infixl 6 +, -

-- | A 'Semigroup' that it is sensible to describe using addition.
class AdditiveSemigroup a where
    (+) :: a -> a -> a

-- | A 'Monoid' that it is sensible to describe using addition and zero.
class AdditiveSemigroup a => AdditiveMonoid a where
    zero :: a

-- | A 'Group' that it is sensible to describe using addition, zero, and subtraction.
class AdditiveMonoid a => AdditiveGroup a where
    (-) :: a -> a -> a

{-# INLINABLE negate #-}
negate :: AdditiveGroup a => a -> a
negate :: a -> a
negate a
x = a
forall a. AdditiveMonoid a => a
zero a -> a -> a
forall a. AdditiveGroup a => a -> a -> a
- a
x

-- | A newtype wrapper to derive 'Additive' classes via.
newtype Additive a = Additive a

instance Semigroup a => AdditiveSemigroup (Additive a) where
    {-# INLINABLE (+) #-}
    Additive a
x + :: Additive a -> Additive a -> Additive a
+ Additive a
y = a -> Additive a
forall a. a -> Additive a
Additive (a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y)

instance Monoid a => AdditiveMonoid (Additive a) where
    {-# INLINABLE zero #-}
    zero :: Additive a
zero = a -> Additive a
forall a. a -> Additive a
Additive a
forall a. Monoid a => a
mempty

instance Group a => AdditiveGroup (Additive a) where
    {-# INLINABLE (-) #-}
    Additive a
x - :: Additive a -> Additive a -> Additive a
- Additive a
y = a -> Additive a
forall a. a -> Additive a
Additive (a
x a -> a -> a
forall a. Group a => a -> a -> a
`gsub` a
y)

-- | A 'Semigroup' that it is sensible to describe using multiplication.
class MultiplicativeSemigroup a where
    (*) :: a -> a -> a

-- | A 'Semigroup' that it is sensible to describe using multiplication and one.
class MultiplicativeSemigroup a => MultiplicativeMonoid a where
    one :: a

-- TODO: multiplicative group? I haven't added any since for e.g. integers division
-- is not a proper inverse, so it's of limited use.

-- | A newtype wrapper to derive 'Multiplicative' classes via.
newtype Multiplicative a = Multiplicative a

instance Semigroup a => MultiplicativeSemigroup (Multiplicative a) where
    {-# INLINABLE (*) #-}
    Multiplicative a
x * :: Multiplicative a -> Multiplicative a -> Multiplicative a
* Multiplicative a
y = a -> Multiplicative a
forall a. a -> Multiplicative a
Multiplicative (a
x a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
y)

instance Monoid a => MultiplicativeMonoid (Multiplicative a) where
    {-# INLINABLE one #-}
    one :: Multiplicative a
one = a -> Multiplicative a
forall a. a -> Multiplicative a
Multiplicative a
forall a. Monoid a => a
mempty

-- | A semiring.
type Semiring a = (AdditiveMonoid a, MultiplicativeMonoid a)
-- | A ring.
type Ring a = (AdditiveGroup a, MultiplicativeMonoid a)

instance AdditiveSemigroup Integer where
    {-# INLINABLE (+) #-}
    + :: Integer -> Integer -> Integer
(+) = Integer -> Integer -> Integer
addInteger

instance AdditiveMonoid Integer where
    {-# INLINABLE zero #-}
    zero :: Integer
zero = Integer
0

instance AdditiveGroup Integer where
    {-# INLINABLE (-) #-}
    (-) = Integer -> Integer -> Integer
subtractInteger

instance MultiplicativeSemigroup Integer where
    {-# INLINABLE (*) #-}
    * :: Integer -> Integer -> Integer
(*) = Integer -> Integer -> Integer
multiplyInteger

instance MultiplicativeMonoid Integer where
    {-# INLINABLE one #-}
    one :: Integer
one = Integer
1

instance AdditiveSemigroup Bool where
    {-# INLINABLE (+) #-}
    + :: Bool -> Bool -> Bool
(+) = Bool -> Bool -> Bool
(||)

instance AdditiveMonoid Bool where
    {-# INLINABLE zero #-}
    zero :: Bool
zero = Bool
False

instance MultiplicativeSemigroup Bool where
    {-# INLINABLE (*) #-}
    * :: Bool -> Bool -> Bool
(*) = Bool -> Bool -> Bool
(&&)

instance MultiplicativeMonoid Bool where
    {-# INLINABLE one #-}
    one :: Bool
one = Bool
True

-- | A module, with a type of scalars which can be used to scale the values.
class (Ring s, AdditiveGroup v) => Module s v | v -> s where
    scale :: s -> v -> v

instance AdditiveSemigroup a => Semigroup (Sum a) where
    {-# INLINABLE (<>) #-}
    Sum a
a1 <> :: Sum a -> Sum a -> Sum a
<> Sum a
a2 = a -> Sum a
forall a. a -> Sum a
Sum (a
a1 a -> a -> a
forall a. AdditiveSemigroup a => a -> a -> a
+ a
a2)

instance AdditiveMonoid a => Monoid (Sum a) where
    {-# INLINABLE mempty #-}
    mempty :: Sum a
mempty = a -> Sum a
forall a. a -> Sum a
Sum a
forall a. AdditiveMonoid a => a
zero

instance MultiplicativeSemigroup a => Semigroup (Product a) where
    {-# INLINABLE (<>) #-}
    Product a
a1 <> :: Product a -> Product a -> Product a
<> Product a
a2 = a -> Product a
forall a. a -> Product a
Product (a
a1 a -> a -> a
forall a. MultiplicativeSemigroup a => a -> a -> a
* a
a2)

instance MultiplicativeMonoid a => Monoid (Product a) where
    {-# INLINABLE mempty #-}
    mempty :: Product a
mempty = a -> Product a
forall a. a -> Product a
Product a
forall a. MultiplicativeMonoid a => a
one

-- | Simultaneous div and mod.
{-# INLINABLE divMod #-}
divMod :: Integer -> Integer -> (Integer, Integer)
divMod :: Integer -> Integer -> (Integer, Integer)
divMod Integer
x Integer
y = ( Integer
x Integer -> Integer -> Integer
`divideInteger` Integer
y, Integer
x Integer -> Integer -> Integer
`modInteger` Integer
y)

-- | Simultaneous quot and rem.
{-# INLINABLE quotRem #-}
quotRem :: Integer -> Integer -> (Integer, Integer)
quotRem :: Integer -> Integer -> (Integer, Integer)
quotRem Integer
x Integer
y = ( Integer
x Integer -> Integer -> Integer
`quotientInteger` Integer
y, Integer
x Integer -> Integer -> Integer
`remainderInteger` Integer
y)

-- | Absolute value for any 'AdditiveGroup'.
{-# INLINABLE abs #-}
abs :: (Ord n, AdditiveGroup n) => n -> n
abs :: n -> n
abs n
x = if n
x n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
forall a. AdditiveMonoid a => a
zero then n -> n
forall a. AdditiveGroup a => a -> a
negate n
x else n
x