{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE KindSignatures #-}

{-|
Module      : Data.JoinSemilattice.Class.Integral
Description : Relationships between values and their (integral) division results.
Copyright   : (c) Tom Harding, 2020
License     : MIT
-}
module Data.JoinSemilattice.Class.Integral where

import Data.Hashable (Hashable)
import Data.JoinSemilattice.Defined (Defined (..))
import Data.JoinSemilattice.Intersect (Intersect)
import qualified Data.JoinSemilattice.Intersect as Intersect
import Data.JoinSemilattice.Class.Sum (SumR)
import Data.Kind (Type)

-- | A four-way 'divMod' relationship between two values, the result of
-- integral division, and the result of the first modulo the second.
class SumR x => IntegralR (x :: Type) where
  divModR :: ( x, x, x, x ) -> ( x, x, x, x )

-- | Integral multiplication implemented as a 'divModR' relationship in which
-- the remainder is fixed to be @0@.
timesR :: (IntegralR x, Num x) => ( x, x, x ) -> ( x, x, x )
timesR :: (x, x, x) -> (x, x, x)
timesR ( x
x, x
y, x
z ) = let ( x
z', x
y', x
x', x
_ ) = (x, x, x, x) -> (x, x, x, x)
forall x. IntegralR x => (x, x, x, x) -> (x, x, x, x)
divModR ( x
z, x
y, x
x, x
0 ) in ( x
x', x
y', x
z' )

-- | Integal division as a three-value relationship.
divR :: IntegralR x => ( x, x, x ) -> ( x, x, x )
divR :: (x, x, x) -> (x, x, x)
divR ( x
x, x
y, x
z ) = let ( x
x', x
y', x
z', x
_ ) = (x, x, x, x) -> (x, x, x, x)
forall x. IntegralR x => (x, x, x, x) -> (x, x, x, x)
divModR ( x
x, x
y, x
z, x
forall a. Monoid a => a
mempty ) in ( x
x', x
y', x
z' )

-- | Modulo operator implemented as a three-value relationship.
modR :: IntegralR x => ( x, x, x ) -> ( x, x, x )
modR :: (x, x, x) -> (x, x, x)
modR ( x
x, x
y, x
z ) = let ( x
x', x
y', x
_, x
z' ) = (x, x, x, x) -> (x, x, x, x)
forall x. IntegralR x => (x, x, x, x) -> (x, x, x, x)
divModR ( x
x, x
y, x
forall a. Monoid a => a
mempty, x
z ) in ( x
x', x
y', x
z' )

instance (Eq x, Integral x) => IntegralR (Defined x) where
  divModR :: (Defined x, Defined x, Defined x, Defined x)
-> (Defined x, Defined x, Defined x, Defined x)
divModR ( Defined x
x, Defined x
y, Defined x
z, Defined x
w )
    = (  Defined x
y Defined x -> Defined x -> Defined x
forall a. Num a => a -> a -> a
* Defined x
z Defined x -> Defined x -> Defined x
forall a. Num a => a -> a -> a
+ Defined x
w
      , (Defined x
x Defined x -> Defined x -> Defined x
forall a. Num a => a -> a -> a
- Defined x
w) Defined x -> Defined x -> Defined x
forall a. Integral a => a -> a -> a
`div` Defined x
z
      , (Defined x
x Defined x -> Defined x -> Defined x
forall a. Num a => a -> a -> a
- Defined x
w) Defined x -> Defined x -> Defined x
forall a. Integral a => a -> a -> a
`div` Defined x
y
      ,  Defined x
x Defined x -> Defined x -> Defined x
forall a. Num a => a -> a -> a
- (Defined x
y Defined x -> Defined x -> Defined x
forall a. Num a => a -> a -> a
* Defined x
z)
      )

instance (Bounded x, Enum x, Ord x, Hashable x, Integral x)
    => IntegralR (Intersect x) where
  divModR :: (Intersect x, Intersect x, Intersect x, Intersect x)
-> (Intersect x, Intersect x, Intersect x, Intersect x)
divModR ( Intersect x
x, Intersect x
y, Intersect x
z, Intersect x
w )
    = ( Intersect x
y Intersect x -> Intersect x -> Intersect x
forall a. Num a => a -> a -> a
* Intersect x
z Intersect x -> Intersect x -> Intersect x
forall a. Num a => a -> a -> a
+ Intersect x
w
      , (x -> x -> x) -> Intersect x -> Intersect x -> Intersect x
forall this that result.
(Intersectable this, Intersectable that, Intersectable result) =>
(this -> that -> result)
-> Intersect this -> Intersect that -> Intersect result
Intersect.lift2 x -> x -> x
forall a. Integral a => a -> a -> a
div (Intersect x
x Intersect x -> Intersect x -> Intersect x
forall a. Num a => a -> a -> a
- Intersect x
w) Intersect x
z
      , (x -> x -> x) -> Intersect x -> Intersect x -> Intersect x
forall this that result.
(Intersectable this, Intersectable that, Intersectable result) =>
(this -> that -> result)
-> Intersect this -> Intersect that -> Intersect result
Intersect.lift2 x -> x -> x
forall a. Integral a => a -> a -> a
div (Intersect x
x Intersect x -> Intersect x -> Intersect x
forall a. Num a => a -> a -> a
- Intersect x
w) Intersect x
y
      , Intersect x
x Intersect x -> Intersect x -> Intersect x
forall a. Num a => a -> a -> a
- (Intersect x
y Intersect x -> Intersect x -> Intersect x
forall a. Num a => a -> a -> a
* Intersect x
z)
      )