{-# LANGUAGE RebindableSyntax #-}
module Number.ResidueClass.Maybe where

import qualified Number.ResidueClass as Res

import qualified Algebra.IntegralDomain as Integral
import qualified Algebra.Ring           as Ring
import qualified Algebra.Additive       as Additive
import qualified Algebra.ZeroTestable   as ZeroTestable

import NumericPrelude.Base
import NumericPrelude.Numeric

infix 7 /:, `Cons`


{- |
Here we try to provide implementations for 'zero' and 'one'
by making the modulus optional.
We have to provide non-modulus operations for the cases
where both operands have Nothing modulus.
This is problematic since operations like '(\/)'
depend essentially on the modulus.

A working version with disabled 'zero' and 'one' can be found ResidueClass.
-}
data T a
  = Cons {T a -> Maybe a
modulus        :: !(Maybe a)  -- ^ the modulus can be Nothing to denote a generic constant like 'zero' and 'one' which could not be bound to a specific modulus so far
         ,T a -> a
representative :: !a
         }
  deriving (Int -> T a -> ShowS
[T a] -> ShowS
T a -> String
(Int -> T a -> ShowS)
-> (T a -> String) -> ([T a] -> ShowS) -> Show (T a)
forall a. Show a => Int -> T a -> ShowS
forall a. Show a => [T a] -> ShowS
forall a. Show a => T a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [T a] -> ShowS
$cshowList :: forall a. Show a => [T a] -> ShowS
show :: T a -> String
$cshow :: forall a. Show a => T a -> String
showsPrec :: Int -> T a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> T a -> ShowS
Show, ReadPrec [T a]
ReadPrec (T a)
Int -> ReadS (T a)
ReadS [T a]
(Int -> ReadS (T a))
-> ReadS [T a] -> ReadPrec (T a) -> ReadPrec [T a] -> Read (T a)
forall a. Read a => ReadPrec [T a]
forall a. Read a => ReadPrec (T a)
forall a. Read a => Int -> ReadS (T a)
forall a. Read a => ReadS [T a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [T a]
$creadListPrec :: forall a. Read a => ReadPrec [T a]
readPrec :: ReadPrec (T a)
$creadPrec :: forall a. Read a => ReadPrec (T a)
readList :: ReadS [T a]
$creadList :: forall a. Read a => ReadS [T a]
readsPrec :: Int -> ReadS (T a)
$creadsPrec :: forall a. Read a => Int -> ReadS (T a)
Read)


-- | @r \/: m@ is the residue class containing @r@ with respect to the modulus @m@
(/:) :: (Integral.C a) => a -> a -> T a
/: :: a -> a -> T a
(/:) a
r a
m = Maybe a -> a -> T a
forall a. Maybe a -> a -> T a
Cons (a -> Maybe a
forall a. a -> Maybe a
Just a
m) (a -> a -> a
forall a. C a => a -> a -> a
mod a
r a
m)


matchMaybe :: Maybe a -> Maybe a -> Maybe a
matchMaybe :: Maybe a -> Maybe a -> Maybe a
matchMaybe Maybe a
Nothing Maybe a
y = Maybe a
y
matchMaybe Maybe a
x       Maybe a
_ = Maybe a
x

isCompatibleMaybe :: (Eq a) => Maybe a -> Maybe a -> Bool
isCompatibleMaybe :: Maybe a -> Maybe a -> Bool
isCompatibleMaybe Maybe a
Nothing Maybe a
_ = Bool
True
isCompatibleMaybe Maybe a
_ Maybe a
Nothing = Bool
True
isCompatibleMaybe (Just a
x) (Just a
y) = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y

-- | Check if two residue classes share the same modulus
isCompatible :: (Eq a) => T a -> T a -> Bool
isCompatible :: T a -> T a -> Bool
isCompatible T a
x T a
y  =  Maybe a -> Maybe a -> Bool
forall a. Eq a => Maybe a -> Maybe a -> Bool
isCompatibleMaybe (T a -> Maybe a
forall a. T a -> Maybe a
modulus T a
x) (T a -> Maybe a
forall a. T a -> Maybe a
modulus T a
y)


lift2 :: (Eq a) => (a -> a -> a -> a) -> (a -> a -> a) -> (T a -> T a -> T a)
lift2 :: (a -> a -> a -> a) -> (a -> a -> a) -> T a -> T a -> T a
lift2 a -> a -> a -> a
f a -> a -> a
g T a
x T a
y =
  if T a -> T a -> Bool
forall a. Eq a => T a -> T a -> Bool
isCompatible T a
x T a
y
    then let m :: Maybe a
m = Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
matchMaybe (T a -> Maybe a
forall a. T a -> Maybe a
modulus T a
x) (T a -> Maybe a
forall a. T a -> Maybe a
modulus T a
y)
         in  Maybe a -> a -> T a
forall a. Maybe a -> a -> T a
Cons Maybe a
m
                  ((a -> a -> a) -> (a -> a -> a -> a) -> Maybe a -> a -> a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a -> a -> a
g a -> a -> a -> a
f Maybe a
m (T a -> a
forall a. T a -> a
representative T a
x) (T a -> a
forall a. T a -> a
representative T a
y))
    else String -> T a
forall a. HasCallStack => String -> a
error String
"ResidueClass: Incompatible operands"


instance  (Eq a, ZeroTestable.C a, Integral.C a) => Eq (T a)  where
    == :: T a -> T a -> Bool
(==) T a
x T a
y =
      if T a -> T a -> Bool
forall a. Eq a => T a -> T a -> Bool
isCompatible T a
x T a
y
        then (a -> a -> Bool)
-> (a -> a -> a -> Bool) -> Maybe a -> a -> a -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
                   (\a
m a
x' a
y' -> a -> Bool
forall a. C a => a -> Bool
isZero (a -> a -> a
forall a. C a => a -> a -> a
mod (a
x'a -> a -> a
forall a. C a => a -> a -> a
-a
y') a
m))
                   (Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
matchMaybe (T a -> Maybe a
forall a. T a -> Maybe a
modulus T a
x) (T a -> Maybe a
forall a. T a -> Maybe a
modulus T a
y))
                   (T a -> a
forall a. T a -> a
representative T a
x) (T a -> a
forall a. T a -> a
representative T a
y)
        else String -> Bool
forall a. HasCallStack => String -> a
error String
"ResidueClass.(==): Incompatible operands"

instance  (Eq a, Integral.C a) => Additive.C (T a)  where
    zero :: T a
zero                =  Maybe a -> a -> T a
forall a. Maybe a -> a -> T a
Cons Maybe a
forall a. Maybe a
Nothing a
forall a. C a => a
zero
    + :: T a -> T a -> T a
(+)                 =  (a -> a -> a -> a) -> (a -> a -> a) -> T a -> T a -> T a
forall a.
Eq a =>
(a -> a -> a -> a) -> (a -> a -> a) -> T a -> T a -> T a
lift2 a -> a -> a -> a
forall a. C a => a -> a -> a -> a
Res.add a -> a -> a
forall a. C a => a -> a -> a
(+)
    (-)                 =  (a -> a -> a -> a) -> (a -> a -> a) -> T a -> T a -> T a
forall a.
Eq a =>
(a -> a -> a -> a) -> (a -> a -> a) -> T a -> T a -> T a
lift2 a -> a -> a -> a
forall a. C a => a -> a -> a -> a
Res.sub (-)
    negate :: T a -> T a
negate (Cons Maybe a
m a
r)   =  Maybe a -> a -> T a
forall a. Maybe a -> a -> T a
Cons Maybe a
m (a -> a
forall a. C a => a -> a
negate a
r)

instance  (Eq a, Integral.C a) => Ring.C (T a)  where
    one :: T a
one                 =  Maybe a -> a -> T a
forall a. Maybe a -> a -> T a
Cons Maybe a
forall a. Maybe a
Nothing a
forall a. C a => a
one
    * :: T a -> T a -> T a
(*)                 =  (a -> a -> a -> a) -> (a -> a -> a) -> T a -> T a -> T a
forall a.
Eq a =>
(a -> a -> a -> a) -> (a -> a -> a) -> T a -> T a -> T a
lift2 a -> a -> a -> a
forall a. C a => a -> a -> a -> a
Res.mul a -> a -> a
forall a. C a => a -> a -> a
(*)
    fromInteger :: Integer -> T a
fromInteger         =  Maybe a -> a -> T a
forall a. Maybe a -> a -> T a
Cons Maybe a
forall a. Maybe a
Nothing (a -> T a) -> (Integer -> a) -> Integer -> T a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. C a => Integer -> a
fromInteger