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

import qualified Number.ResidueClass as Res

import qualified Algebra.PrincipalIdealDomain as PID
import qualified Algebra.IntegralDomain as Integral
import qualified Algebra.Ring           as Ring
import qualified Algebra.Additive       as Additive

import NumericPrelude.Base
import NumericPrelude.Numeric

import Control.Monad (liftM, liftM2, liftM4, ap)
import Control.Applicative (Applicative(pure, (<*>)))

import qualified NumericPrelude.Numeric as NP


{- |
T is a Reader monad but does not need functional dependencies
like that from the Monad Transformer Library.
-}
newtype T a b = Cons {T a b -> a -> b
toFunc :: a -> b}

concrete :: a -> T a b -> b
concrete :: a -> T a b -> b
concrete a
m (Cons a -> b
r) = a -> b
r a
m

fromRepresentative :: (Integral.C a) => a -> T a a
fromRepresentative :: a -> T a a
fromRepresentative = (a -> a) -> T a a
forall a b. (a -> b) -> T a b
Cons ((a -> a) -> T a a) -> (a -> a -> a) -> a -> T a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a. C a => a -> a -> a
mod


getZero :: (Additive.C a) => T a a
getZero :: T a a
getZero = (a -> a) -> T a a
forall a b. (a -> b) -> T a b
Cons ((a -> a) -> T a a) -> (a -> a) -> T a a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a b. a -> b -> a
const a
forall a. C a => a
Additive.zero

getOne :: (Ring.C a) => T a a
getOne :: T a a
getOne  = (a -> a) -> T a a
forall a b. (a -> b) -> T a b
Cons ((a -> a) -> T a a) -> (a -> a) -> T a a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a b. a -> b -> a
const a
forall a. C a => a
NP.one

fromInteger :: (Integral.C a) => Integer -> T a a
fromInteger :: Integer -> T a a
fromInteger = a -> T a a
forall a. C a => a -> T a a
fromRepresentative (a -> T a a) -> (Integer -> a) -> Integer -> T a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. C a => Integer -> a
NP.fromInteger


instance Functor (T a) where
   fmap :: (a -> b) -> T a a -> T a b
fmap = (a -> b) -> T a a -> T a b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM

instance Applicative (T a) where
   <*> :: T a (a -> b) -> T a a -> T a b
(<*>) = T a (a -> b) -> T a a -> T a b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap
   pure :: a -> T a a
pure = a -> T a a
forall (m :: * -> *) a. Monad m => a -> m a
return

instance Monad (T a) where
   (Cons a -> a
x) >>= :: T a a -> (a -> T a b) -> T a b
>>= a -> T a b
y  =  (a -> b) -> T a b
forall a b. (a -> b) -> T a b
Cons (\a
r -> T a b -> a -> b
forall a b. T a b -> a -> b
toFunc (a -> T a b
y (a -> a
x a
r)) a
r)
   return :: a -> T a a
return = (a -> a) -> T a a
forall a b. (a -> b) -> T a b
Cons ((a -> a) -> T a a) -> (a -> a -> a) -> a -> T a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a b. a -> b -> a
const



getAdd :: Integral.C a => T a (a -> a -> a)
getAdd :: T a (a -> a -> a)
getAdd = (a -> a -> a -> a) -> T a (a -> a -> a)
forall a b. (a -> b) -> T a b
Cons a -> a -> a -> a
forall a. C a => a -> a -> a -> a
Res.add

getSub :: Integral.C a => T a (a -> a -> a)
getSub :: T a (a -> a -> a)
getSub = (a -> a -> a -> a) -> T a (a -> a -> a)
forall a b. (a -> b) -> T a b
Cons a -> a -> a -> a
forall a. C a => a -> a -> a -> a
Res.sub

getNeg :: Integral.C a => T a (a -> a)
getNeg :: T a (a -> a)
getNeg = (a -> a -> a) -> T a (a -> a)
forall a b. (a -> b) -> T a b
Cons a -> a -> a
forall a. C a => a -> a -> a
Res.neg

getAdditiveVars :: Integral.C a => T a (a, a -> a -> a, a -> a -> a, a -> a)
getAdditiveVars :: T a (a, a -> a -> a, a -> a -> a, a -> a)
getAdditiveVars = (a
 -> (a -> a -> a)
 -> (a -> a -> a)
 -> (a -> a)
 -> (a, a -> a -> a, a -> a -> a, a -> a))
-> T a a
-> T a (a -> a -> a)
-> T a (a -> a -> a)
-> T a (a -> a)
-> T a (a, a -> a -> a, a -> a -> a, a -> a)
forall (m :: * -> *) a1 a2 a3 a4 r.
Monad m =>
(a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
liftM4 (,,,) T a a
forall a. C a => T a a
getZero T a (a -> a -> a)
forall a. C a => T a (a -> a -> a)
getAdd T a (a -> a -> a)
forall a. C a => T a (a -> a -> a)
getSub T a (a -> a)
forall a. C a => T a (a -> a)
getNeg



getMul :: Integral.C a => T a (a -> a -> a)
getMul :: T a (a -> a -> a)
getMul = (a -> a -> a -> a) -> T a (a -> a -> a)
forall a b. (a -> b) -> T a b
Cons a -> a -> a -> a
forall a. C a => a -> a -> a -> a
Res.mul

getRingVars :: Integral.C a => T a (a, a -> a -> a)
getRingVars :: T a (a, a -> a -> a)
getRingVars = (a -> (a -> a -> a) -> (a, a -> a -> a))
-> T a a -> T a (a -> a -> a) -> T a (a, a -> a -> a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) T a a
forall a. C a => T a a
getOne T a (a -> a -> a)
forall a. C a => T a (a -> a -> a)
getMul



getDivide :: PID.C a => T a (a -> a -> a)
getDivide :: T a (a -> a -> a)
getDivide = (a -> a -> a -> a) -> T a (a -> a -> a)
forall a b. (a -> b) -> T a b
Cons a -> a -> a -> a
forall a. C a => a -> a -> a -> a
Res.divide

getRecip :: PID.C a => T a (a -> a)
getRecip :: T a (a -> a)
getRecip = (a -> a -> a) -> T a (a -> a)
forall a b. (a -> b) -> T a b
Cons a -> a -> a
forall a. C a => a -> a -> a
Res.recip

getFieldVars :: PID.C a => T a (a -> a -> a, a -> a)
getFieldVars :: T a (a -> a -> a, a -> a)
getFieldVars = ((a -> a -> a) -> (a -> a) -> (a -> a -> a, a -> a))
-> T a (a -> a -> a) -> T a (a -> a) -> T a (a -> a -> a, a -> a)
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 (,) T a (a -> a -> a)
forall a. C a => T a (a -> a -> a)
getDivide T a (a -> a)
forall a. C a => T a (a -> a)
getRecip

monadExample :: PID.C a => T a [a]
monadExample :: T a [a]
monadExample =
   do (a
zero',a -> a -> a
(+~),a -> a -> a
(-~),a -> a
negate') <- T a (a, a -> a -> a, a -> a -> a, a -> a)
forall a. C a => T a (a, a -> a -> a, a -> a -> a, a -> a)
getAdditiveVars
      (a
one',a -> a -> a
(*~)) <- T a (a, a -> a -> a)
forall a. C a => T a (a, a -> a -> a)
getRingVars
      (a -> a -> a
(/~),a -> a
recip') <- T a (a -> a -> a, a -> a)
forall a. C a => T a (a -> a -> a, a -> a)
getFieldVars
      let three :: a
three = a
one'a -> a -> a
forall a. C a => a -> a -> a
+a
one'a -> a -> a
forall a. C a => a -> a -> a
+a
one'  -- is easier if only NP.fromInteger is visible
      let seven :: a
seven = a
threea -> a -> a
forall a. C a => a -> a -> a
+a
threea -> a -> a
forall a. C a => a -> a -> a
+a
one'
      [a] -> T a [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a
zero'a -> a -> a
*~a
three, a
one'a -> a -> a
/~a
three, a -> a
recip' a
three,
              a
three a -> a -> a
*~ a
seven, a
one' a -> a -> a
+~ a
three a -> a -> a
+~ a
seven,
              a
zero' a -> a -> a
-~ a
three, a -> a
negate' a
three a -> a -> a
+~ a
seven]

runExample :: [Integer]
runExample :: [Integer]
runExample =
   let three :: Integer
three = Integer
forall a. C a => a
oneInteger -> Integer -> Integer
forall a. C a => a -> a -> a
+Integer
forall a. C a => a
oneInteger -> Integer -> Integer
forall a. C a => a -> a -> a
+Integer
forall a. C a => a
one
       eleven :: Integer
eleven = Integer
threeInteger -> Integer -> Integer
forall a. C a => a -> a -> a
+Integer
threeInteger -> Integer -> Integer
forall a. C a => a -> a -> a
+Integer
three Integer -> Integer -> Integer
forall a. C a => a -> a -> a
+ Integer
forall a. C a => a
oneInteger -> Integer -> Integer
forall a. C a => a -> a -> a
+Integer
forall a. C a => a
one
   in  Integer -> T Integer [Integer] -> [Integer]
forall a b. a -> T a b -> b
concrete Integer
eleven T Integer [Integer]
forall a. C a => T a [a]
monadExample