-- editorconfig-checker-disable-file
{-# LANGUAGE ConstraintKinds        #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -fno-omit-interface-pragmas #-}

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.Coerce (coerce)
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

negate :: (AdditiveGroup a) => a -> a
negate :: forall a. AdditiveGroup a => a -> a
negate a
x = a
forall a. AdditiveMonoid a => a
zero a -> a -> a
forall a. AdditiveGroup a => a -> a -> a
- a
x
{-# INLINEABLE negate #-}

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

instance (Semigroup a) => AdditiveSemigroup (Additive a) where
  {-# INLINEABLE (+) #-}
  + :: Additive a -> Additive a -> Additive a
(+) = (a -> a -> a) -> Additive a -> Additive a -> Additive a
forall a b. Coercible a b => a -> b
coerce (a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) :: a -> a -> a)

instance (Monoid a) => AdditiveMonoid (Additive a) where
  {-# INLINEABLE 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
  {-# INLINEABLE (-) #-}
  (-) = (a -> a -> a) -> Additive a -> Additive a -> Additive a
forall a b. Coercible a b => a -> b
coerce (a -> a -> a
forall a. Group a => a -> a -> a
gsub :: a -> a -> a)

-- | 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
  {-# INLINEABLE (*) #-}
  * :: Multiplicative a -> Multiplicative a -> Multiplicative a
(*) = (a -> a -> a)
-> Multiplicative a -> Multiplicative a -> Multiplicative a
forall a b. Coercible a b => a -> b
coerce (a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) :: a -> a -> a)

instance (Monoid a) => MultiplicativeMonoid (Multiplicative a) where
  {-# INLINEABLE 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
  {-# INLINEABLE (+) #-}
  + :: Integer -> Integer -> Integer
(+) = Integer -> Integer -> Integer
addInteger

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

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

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

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

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

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

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

instance MultiplicativeMonoid Bool where
  {-# INLINEABLE 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
  {-# INLINEABLE (<>) #-}
  <> :: Sum a -> Sum a -> Sum a
(<>) = (a -> a -> a) -> Sum a -> Sum a -> Sum a
forall a b. Coercible a b => a -> b
coerce (a -> a -> a
forall a. AdditiveSemigroup a => a -> a -> a
(+) :: a -> a -> a)

instance (AdditiveMonoid a) => Monoid (Sum a) where
  {-# INLINEABLE 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
  {-# INLINEABLE (<>) #-}
  <> :: Product a -> Product a -> Product a
(<>) = (a -> a -> a) -> Product a -> Product a -> Product a
forall a b. Coercible a b => a -> b
coerce (a -> a -> a
forall a. MultiplicativeSemigroup a => a -> a -> a
(*) :: a -> a -> a)

instance (MultiplicativeMonoid a) => Monoid (Product a) where
  {-# INLINEABLE 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.
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)
{-# INLINEABLE divMod #-}

-- | Simultaneous quot and rem.
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)
{-# INLINEABLE quotRem #-}

-- | Absolute value for any 'AdditiveGroup'.
abs :: (Ord n, AdditiveGroup n) => n -> n
abs :: forall n. (Ord n, AdditiveGroup n) => 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
{-# INLINEABLE abs #-}