{-# LANGUAGE TemplateHaskell #-}
{-|
    Module      :  Numeric.MixedType.Ring
    Description :  Bottom-up typed multiplication and exponent
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

    Maintainer  :  mikkonecny@gmail.com
    Stability   :  experimental
    Portability :  portable

-}

module Numeric.MixedTypes.Ring
(
  -- * Ring
  CanAddSubMulBy, Ring, OrderedRing, OrderedCertainlyRing
  -- * Multiplication
  , CanMul, CanMulAsymmetric(..), CanMulBy, CanMulSameType
  , (*), product
  -- ** Tests
  , specCanMul, specCanMulNotMixed, specCanMulSameType
  -- * Exponentiation
  , CanPow(..), CanPowBy, CanPowCNBy
  , (^), (^!)
  , powUsingMul, integerPowCN
  -- ** Tests
  , specCanPow
)
where

import Utils.TH.DeclForTypes

import Numeric.MixedTypes.PreludeHiding
import qualified Prelude as P
import Text.Printf

import qualified Data.List as List

import Test.Hspec
import Test.QuickCheck

import Numeric.CollectErrors
import Control.CollectErrors

import Numeric.MixedTypes.Literals
import Numeric.MixedTypes.Bool
import Numeric.MixedTypes.Eq
import Numeric.MixedTypes.Ord
-- import Numeric.MixedTypes.MinMaxAbs
import Numeric.MixedTypes.AddSub

{----- Ring -----}

type CanAddSubMulBy t s =
  (CanAddThis t s, CanSubThis t s, CanSub s t, SubType s t ~ t, CanMulBy t s)

type RingPre t =
  (CanNegSameType t, CanAddSameType t, CanSubSameType t, CanMulSameType t,
   CanPowCNBy t Integer, CanPowCNBy t Int,
   HasEq t t,
   HasEq t Integer, CanAddSubMulBy t Integer,
   HasEq t Int, CanAddSubMulBy t Int,
   HasIntegers t)

class
  (RingPre t,
   CanEnsureCN t,
   RingPre (EnsureCN t))
  =>
  Ring t

instance Ring Integer
instance Ring (CN Integer)
instance Ring Rational
instance Ring (CN Rational)

class
  (Ring t
  , HasEq t t
  , HasEq (EnsureCN t) t
  , HasEq t (EnsureCN t)
  , HasEq t Int, HasEq t Integer
  , HasEq (EnsureCN t) Int, HasEq (EnsureCN t) Integer
  , HasOrder t t
  , HasOrder (EnsureCN t) t
  , HasOrder t (EnsureCN t)
  , HasOrder t Int, HasOrder t Integer
  , HasOrder (EnsureCN t) Int, HasOrder (EnsureCN t) Integer)
  => OrderedRing t

instance OrderedRing Integer
instance OrderedRing (CN Integer)
instance OrderedRing Rational
instance OrderedRing (CN Rational)

class
  (Ring t
  , HasEqCertainly t t
  , HasEqCertainly (EnsureCN t) t
  , HasEqCertainly t (EnsureCN t)
  , HasEqCertainly t Int, HasEq t Integer
  , HasEqCertainly (EnsureCN t) Int, HasEq (EnsureCN t) Integer
  , HasOrderCertainly t t
  , HasOrderCertainly (EnsureCN t) t
  , HasOrderCertainly t (EnsureCN t)
  , HasOrderCertainly t Int, HasOrderCertainly t Integer
  , HasOrderCertainly (EnsureCN t) Int, HasOrderCertainly (EnsureCN t) Integer
  , CanTestPosNeg t)
  => OrderedCertainlyRing t

instance OrderedCertainlyRing Integer
instance OrderedCertainlyRing (CN Integer)
instance OrderedCertainlyRing Rational
instance OrderedCertainlyRing (CN Rational)

{---- Multiplication -----}

type CanMul t1 t2 =
  (CanMulAsymmetric t1 t2, CanMulAsymmetric t2 t1,
   MulType t1 t2 ~ MulType t2 t1)

{-|
  A replacement for Prelude's `P.*`.  If @t1 = t2@ and @Num t1@,
  then one can use the default implementation to mirror Prelude's @*@.
-}
class CanMulAsymmetric t1 t2 where
  type MulType t1 t2
  type MulType t1 t2 = t1 -- default
  mul :: t1 -> t2 -> MulType t1 t2
  default mul :: (MulType t1 t2 ~ t1, t1~t2, P.Num t1) => t1 -> t2 -> MulType t1 t2
  mul = t1 -> t2 -> MulType t1 t2
forall a. Num a => a -> a -> a
(P.*)

infixl 8  ^, ^!
infixl 7  *

(*) :: (CanMulAsymmetric t1 t2) => t1 -> t2 -> MulType t1 t2
* :: t1 -> t2 -> MulType t1 t2
(*) = t1 -> t2 -> MulType t1 t2
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul

type CanMulBy t1 t2 =
  (CanMul t1 t2, MulType t1 t2 ~ t1)
type CanMulSameType t =
  CanMulBy t t

product :: (CanMulSameType t, ConvertibleExactly Integer t) => [t] -> t
product :: [t] -> t
product [t]
xs = (t -> t -> t) -> t -> [t] -> t
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' t -> t -> t
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul (Integer -> t
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
1) [t]
xs

{-|
  HSpec properties that each implementation of CanMul should satisfy.
 -}
specCanMul ::
  (Show t1, Show t2, Show t3, Show (MulType t1 t2),
   Show (MulType t2 t1), Show (MulType t1 (MulType t2 t3)),
   Show (MulType (MulType t1 t2) t3),
   Show (MulType t1 (AddType t2 t3)),
   Show (AddType (MulType t1 t2) (MulType t1 t3)), Arbitrary t1,
   Arbitrary t2, Arbitrary t3, ConvertibleExactly Integer t2,
   CanTestCertainly (EqCompareType (MulType t1 t2) t1),
   CanTestCertainly (EqCompareType (MulType t1 t2) (MulType t2 t1)),
   CanTestCertainly
     (EqCompareType
        (MulType t1 (MulType t2 t3)) (MulType (MulType t1 t2) t3)),
   CanTestCertainly
     (EqCompareType
        (MulType t1 (AddType t2 t3))
        (AddType (MulType t1 t2) (MulType t1 t3))),
   HasEqAsymmetric (MulType t1 t2) t1,
   HasEqAsymmetric (MulType t1 t2) (MulType t2 t1),
   HasEqAsymmetric
     (MulType t1 (MulType t2 t3)) (MulType (MulType t1 t2) t3),
   HasEqAsymmetric
     (MulType t1 (AddType t2 t3))
     (AddType (MulType t1 t2) (MulType t1 t3)),
   CanAddAsymmetric t2 t3,
   CanAddAsymmetric (MulType t1 t2) (MulType t1 t3),
   CanMulAsymmetric t1 t2, CanMulAsymmetric t1 t3,
   CanMulAsymmetric t1 (MulType t2 t3),
   CanMulAsymmetric t1 (AddType t2 t3), CanMulAsymmetric t2 t1,
   CanMulAsymmetric t2 t3, CanMulAsymmetric (MulType t1 t2) t3)
  =>
  T t1 -> T t2 -> T t3 -> Spec
specCanMul :: T t1 -> T t2 -> T t3 -> Spec
specCanMul (T String
typeName1 :: T t1) (T String
typeName2 :: T t2) (T String
typeName3 :: T t3) =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String -> String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"CanMul %s %s, CanMul %s %s" String
typeName1 String
typeName2 String
typeName2 String
typeName3) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"absorbs 1" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t1 -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t1 -> Property) -> Property) -> (t1 -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) -> let one :: t2
one = (Integer -> t2
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
1 :: t2) in (t1
x t1 -> t2 -> MulType t1 t2
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* t2
one) MulType t1 t2 -> t1 -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ t1
x
    String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"is commutative" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t1 -> t2 -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t1 -> t2 -> Property) -> Property)
-> (t1 -> t2 -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) (t2
y :: t2) -> (t1
x t1 -> t2 -> MulType t1 t2
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* t2
y) MulType t1 t2 -> MulType t2 t1 -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ (t2
y t2 -> t1 -> MulType t2 t1
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* t1
x)
    String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"is associative" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t1 -> t2 -> t3 -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t1 -> t2 -> t3 -> Property) -> Property)
-> (t1 -> t2 -> t3 -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) (t2
y :: t2) (t3
z :: t3) ->
                      (t1
x t1 -> MulType t2 t3 -> MulType t1 (MulType t2 t3)
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (t2
y t2 -> t3 -> MulType t2 t3
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* t3
z)) MulType t1 (MulType t2 t3)
-> MulType (MulType t1 t2) t3 -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ ((t1
x t1 -> t2 -> MulType t1 t2
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* t2
y) MulType t1 t2 -> t3 -> MulType (MulType t1 t2) t3
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* t3
z)
    String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"distributes over addition" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t1 -> t2 -> t3 -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t1 -> t2 -> t3 -> Property) -> Property)
-> (t1 -> t2 -> t3 -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) (t2
y :: t2) (t3
z :: t3) ->
                      (t1
x t1 -> AddType t2 t3 -> MulType t1 (AddType t2 t3)
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (t2
y t2 -> t3 -> AddType t2 t3
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ t3
z)) MulType t1 (AddType t2 t3)
-> AddType (MulType t1 t2) (MulType t1 t3) -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ (t1
x t1 -> t2 -> MulType t1 t2
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* t2
y) MulType t1 t2
-> MulType t1 t3 -> AddType (MulType t1 t2) (MulType t1 t3)
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (t1
x t1 -> t3 -> MulType t1 t3
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* t3
z)
  where
  infix 4 ?==?$
  (?==?$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
  ?==?$ :: a -> b -> Property
(?==?$) = String -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
String -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 String
"?==?" a -> b -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
(?==?)

{-|
  HSpec properties that each implementation of CanMul should satisfy.
 -}
specCanMulNotMixed ::
  (Show t, Show (MulType t t), Show (MulType t (MulType t t)),
   Show (MulType (MulType t t) t), Show (MulType t (AddType t t)),
   Show (AddType (MulType t t) (MulType t t)), Arbitrary t,
   ConvertibleExactly Integer t,
   CanTestCertainly (EqCompareType (MulType t t) t),
   CanTestCertainly (EqCompareType (MulType t t) (MulType t t)),
   CanTestCertainly
     (EqCompareType
        (MulType t (MulType t t)) (MulType (MulType t t) t)),
   CanTestCertainly
     (EqCompareType
        (MulType t (AddType t t)) (AddType (MulType t t) (MulType t t))),
   HasEqAsymmetric (MulType t t) t,
   HasEqAsymmetric (MulType t t) (MulType t t),
   HasEqAsymmetric
     (MulType t (MulType t t)) (MulType (MulType t t) t),
   HasEqAsymmetric
     (MulType t (AddType t t)) (AddType (MulType t t) (MulType t t)),
   CanAddAsymmetric t t, CanAddAsymmetric (MulType t t) (MulType t t),
   CanMulAsymmetric t t, CanMulAsymmetric t (MulType t t),
   CanMulAsymmetric t (AddType t t),
   CanMulAsymmetric (MulType t t) t)
  =>
  T t -> Spec
specCanMulNotMixed :: T t -> Spec
specCanMulNotMixed (T t
t :: T t) = T t -> T t -> T t -> Spec
forall t1 t2 t3.
(Show t1, Show t2, Show t3, Show (MulType t1 t2),
 Show (MulType t2 t1), Show (MulType t1 (MulType t2 t3)),
 Show (MulType (MulType t1 t2) t3),
 Show (MulType t1 (AddType t2 t3)),
 Show (AddType (MulType t1 t2) (MulType t1 t3)), Arbitrary t1,
 Arbitrary t2, Arbitrary t3, ConvertibleExactly Integer t2,
 CanTestCertainly (EqCompareType (MulType t1 t2) t1),
 CanTestCertainly (EqCompareType (MulType t1 t2) (MulType t2 t1)),
 CanTestCertainly
   (EqCompareType
      (MulType t1 (MulType t2 t3)) (MulType (MulType t1 t2) t3)),
 CanTestCertainly
   (EqCompareType
      (MulType t1 (AddType t2 t3))
      (AddType (MulType t1 t2) (MulType t1 t3))),
 HasEqAsymmetric (MulType t1 t2) t1,
 HasEqAsymmetric (MulType t1 t2) (MulType t2 t1),
 HasEqAsymmetric
   (MulType t1 (MulType t2 t3)) (MulType (MulType t1 t2) t3),
 HasEqAsymmetric
   (MulType t1 (AddType t2 t3))
   (AddType (MulType t1 t2) (MulType t1 t3)),
 CanAddAsymmetric t2 t3,
 CanAddAsymmetric (MulType t1 t2) (MulType t1 t3),
 CanMulAsymmetric t1 t2, CanMulAsymmetric t1 t3,
 CanMulAsymmetric t1 (MulType t2 t3),
 CanMulAsymmetric t1 (AddType t2 t3), CanMulAsymmetric t2 t1,
 CanMulAsymmetric t2 t3, CanMulAsymmetric (MulType t1 t2) t3) =>
T t1 -> T t2 -> T t3 -> Spec
specCanMul T t
t T t
t T t
t

{-|
  HSpec properties that each implementation of CanMulSameType should satisfy.
 -}
specCanMulSameType ::
  (Show t, ConvertibleExactly Integer t,
   CanTestCertainly (EqCompareType t t), HasEqAsymmetric t t,
   CanMulAsymmetric t t, MulType t t ~ t)
   =>
   T t -> Spec
specCanMulSameType :: T t -> Spec
specCanMulSameType (T String
typeName :: T t) =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String -> String -> String
forall r. PrintfType r => String -> r
printf String
"CanMulSameType %s" String
typeName) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"has product working over integers" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      ([Integer] -> Property) -> Property
forall prop. Testable prop => prop -> Property
property (([Integer] -> Property) -> Property)
-> ([Integer] -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ ([Integer]
xsi :: [Integer]) ->
        ([t] -> t
forall t.
(CanMulSameType t, ConvertibleExactly Integer t) =>
[t] -> t
product ([t] -> t) -> [t] -> t
forall a b. (a -> b) -> a -> b
$ ((Integer -> t) -> [Integer] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> t
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly [Integer]
xsi :: [t])) t -> t -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ (Integer -> t
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly ([Integer] -> Integer
forall t.
(CanMulSameType t, ConvertibleExactly Integer t) =>
[t] -> t
product [Integer]
xsi) :: t)
    String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"has product [] = 1" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
        ([t] -> t
forall t.
(CanMulSameType t, ConvertibleExactly Integer t) =>
[t] -> t
product ([] :: [t])) t -> t -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ (Integer -> t
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
1 :: t)
  where
  infix 4 ?==?$
  (?==?$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
  ?==?$ :: a -> b -> Property
(?==?$) = String -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
String -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 String
"?==?" a -> b -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
(?==?)

instance CanMulAsymmetric Int Int where
  type MulType Int Int = Integer -- do not risk overflow
  mul :: Int -> Int -> MulType Int Int
mul Int
a Int
b = (Int -> Integer
forall t. CanBeInteger t => t -> Integer
integer Int
a) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
P.* (Int -> Integer
forall t. CanBeInteger t => t -> Integer
integer Int
b)
instance CanMulAsymmetric Integer Integer
instance CanMulAsymmetric Rational Rational
instance CanMulAsymmetric Double Double

instance CanMulAsymmetric Int Integer where
  type MulType Int Integer = Integer
  mul :: Int -> Integer -> MulType Int Integer
mul = (Integer -> Integer -> Integer) -> Int -> Integer -> Integer
forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst Integer -> Integer -> Integer
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul
instance CanMulAsymmetric Integer Int where
  type MulType Integer Int = Integer
  mul :: Integer -> Int -> MulType Integer Int
mul = (Integer -> Integer -> Integer) -> Integer -> Int -> Integer
forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond Integer -> Integer -> Integer
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul

instance CanMulAsymmetric Int Rational where
  type MulType Int Rational = Rational
  mul :: Int -> Rational -> MulType Int Rational
mul = (Rational -> Rational -> Rational) -> Int -> Rational -> Rational
forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst Rational -> Rational -> Rational
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul
instance CanMulAsymmetric Rational Int where
  type MulType Rational Int = Rational
  mul :: Rational -> Int -> MulType Rational Int
mul = (Rational -> Rational -> Rational) -> Rational -> Int -> Rational
forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond Rational -> Rational -> Rational
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul

instance CanMulAsymmetric Integer Rational where
  type MulType Integer Rational = Rational
  mul :: Integer -> Rational -> MulType Integer Rational
mul = (Rational -> Rational -> Rational)
-> Integer -> Rational -> Rational
forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst Rational -> Rational -> Rational
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul
instance CanMulAsymmetric Rational Integer where
  type MulType Rational Integer = Rational
  mul :: Rational -> Integer -> MulType Rational Integer
mul = (Rational -> Rational -> Rational)
-> Rational -> Integer -> Rational
forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond Rational -> Rational -> Rational
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul

instance CanMulAsymmetric Int Double where
  type MulType Int Double = Double
  mul :: Int -> Double -> MulType Int Double
mul Int
n Double
d = Double -> Double -> MulType Double Double
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul (Int -> Double
forall t. CanBeDouble t => t -> Double
double Int
n) Double
d
instance CanMulAsymmetric Double Int where
  type MulType Double Int = Double
  mul :: Double -> Int -> MulType Double Int
mul Double
d Int
n = Double -> Double -> MulType Double Double
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul Double
d (Int -> Double
forall t. CanBeDouble t => t -> Double
double Int
n)

instance CanMulAsymmetric Integer Double where
  type MulType Integer Double = Double
  mul :: Integer -> Double -> MulType Integer Double
mul Integer
n Double
d = Double -> Double -> MulType Double Double
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul (Integer -> Double
forall t. CanBeDouble t => t -> Double
double Integer
n) Double
d
instance CanMulAsymmetric Double Integer where
  type MulType Double Integer = Double
  mul :: Double -> Integer -> MulType Double Integer
mul Double
d Integer
n = Double -> Double -> MulType Double Double
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul Double
d (Integer -> Double
forall t. CanBeDouble t => t -> Double
double Integer
n)

instance CanMulAsymmetric Rational Double where
  type MulType Rational Double = Double
  mul :: Rational -> Double -> MulType Rational Double
mul Rational
n Double
d = Double -> Double -> MulType Double Double
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul (Rational -> Double
forall t. CanBeDouble t => t -> Double
double Rational
n) Double
d
instance CanMulAsymmetric Double Rational where
  type MulType Double Rational = Double
  mul :: Double -> Rational -> MulType Double Rational
mul Double
d Rational
n = Double -> Double -> MulType Double Double
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul Double
d (Rational -> Double
forall t. CanBeDouble t => t -> Double
double Rational
n)

instance (CanMulAsymmetric a b) => CanMulAsymmetric [a] [b] where
  type MulType [a] [b] = [MulType a b]
  mul :: [a] -> [b] -> MulType [a] [b]
mul (a
x:[a]
xs) (b
y:[b]
ys) = (a -> b -> MulType a b
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul a
x b
y) MulType a b -> [MulType a b] -> [MulType a b]
forall a. a -> [a] -> [a]
: ([a] -> [b] -> MulType [a] [b]
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul [a]
xs [b]
ys)
  mul [a]
_ [b]
_ = []

instance (CanMulAsymmetric a b) => CanMulAsymmetric (Maybe a) (Maybe b) where
  type MulType (Maybe a) (Maybe b) = Maybe (MulType a b)
  mul :: Maybe a -> Maybe b -> MulType (Maybe a) (Maybe b)
mul (Just a
x) (Just b
y) = MulType a b -> Maybe (MulType a b)
forall a. a -> Maybe a
Just (a -> b -> MulType a b
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul a
x b
y)
  mul Maybe a
_ Maybe b
_ = MulType (Maybe a) (Maybe b)
forall a. Maybe a
Nothing

instance
  (CanMulAsymmetric a b
  , CanEnsureCE es a, CanEnsureCE es b
  , CanEnsureCE es (MulType a b)
  , SuitableForCE es)
  =>
  CanMulAsymmetric (CollectErrors es a) (CollectErrors es  b)
  where
  type MulType (CollectErrors es a) (CollectErrors es b) =
    EnsureCE es (MulType a b)
  mul :: CollectErrors es a
-> CollectErrors es b
-> MulType (CollectErrors es a) (CollectErrors es b)
mul = (a -> b -> MulType a b)
-> CollectErrors es a
-> CollectErrors es b
-> EnsureCE es (MulType a b)
forall es a b c.
(SuitableForCE es, CanEnsureCE es a, CanEnsureCE es b,
 CanEnsureCE es c) =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> EnsureCE es c
lift2CE a -> b -> MulType a b
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul

{---- Exponentiation -----}

(^) :: (CanPow t1 t2) => t1 -> t2 -> PowType t1 t2
^ :: t1 -> t2 -> PowType t1 t2
(^) = t1 -> t2 -> PowType t1 t2
forall b e. CanPow b e => b -> e -> PowType b e
pow

{-| Like `^` but throwing an exception if the power is undefined. -}
(^!) :: (CanPow t1 t2) =>
  t1 -> t2 -> PowTypeNoCN t1 t2
^! :: t1 -> t2 -> PowTypeNoCN t1 t2
(^!) = t1 -> t2 -> PowTypeNoCN t1 t2
forall b e. CanPow b e => b -> e -> PowTypeNoCN b e
powNoCN


{-|
  A replacement for Prelude's binary `P.^` and `P.^^`.  If @Num t1@ and @Integral t2@,
  then one can use the default implementation to mirror Prelude's @^@.
-}
class CanPow b e where
  type PowTypeNoCN b e
  type PowTypeNoCN b e = b -- default
  powNoCN :: b -> e -> PowTypeNoCN b e
  type PowType b e
  type PowType b e = EnsureCN (PowTypeNoCN b e) -- default
  pow :: b -> e -> PowType b e
  default pow ::
    (HasOrderCertainly b Integer, HasOrderCertainly e Integer,
     HasEqCertainly b Integer, CanTestInteger e,
     CanEnsureCN (PowTypeNoCN b e), PowType b e~EnsureCN (PowTypeNoCN b e))
    =>
    b -> e -> PowType b e
  pow = (b -> e -> PowTypeNoCN b e) -> b -> e -> EnsureCN (PowTypeNoCN b e)
forall b e r.
(HasOrderCertainly b Integer, HasOrderCertainly e Integer,
 HasEqCertainly b Integer, CanTestInteger e, CanEnsureCN r) =>
(b -> e -> r) -> b -> e -> EnsureCN r
powCN b -> e -> PowTypeNoCN b e
forall b e. CanPow b e => b -> e -> PowTypeNoCN b e
powNoCN

integerPowCN ::
  (HasOrderCertainly b Integer, HasOrderCertainly e Integer,
   HasEqCertainly b Integer, HasEqCertainly e Integer,
   CanEnsureCN r)
  =>
  (b -> e -> r) -> b -> e -> EnsureCN r
integerPowCN :: (b -> e -> r) -> b -> e -> EnsureCN r
integerPowCN b -> e -> r
unsafeIntegerPow b
b e
n
  | e
n e -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! Integer
0 =
    Maybe r -> NumError -> EnsureCN r
forall v. CanEnsureCN v => Maybe v -> NumError -> EnsureCN v
noValueNumErrorCertainECN Maybe r
sample_v (NumError -> EnsureCN r) -> NumError -> EnsureCN r
forall a b. (a -> b) -> a -> b
$ String -> NumError
OutOfRange String
"illegal integer pow: negative exponent"
  | e
n e -> Integer -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
!==! Integer
0 Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& b
b b -> Integer -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
!==! Integer
0 =
    Maybe r -> NumError -> EnsureCN r
forall v. CanEnsureCN v => Maybe v -> NumError -> EnsureCN v
noValueNumErrorCertainECN Maybe r
sample_v (NumError -> EnsureCN r) -> NumError -> EnsureCN r
forall a b. (a -> b) -> a -> b
$ String -> NumError
OutOfRange String
"illegal integer pow: 0^0"
  | e
n e -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
?<? Integer
0 =
    Maybe r -> NumError -> EnsureCN r
forall v. CanEnsureCN v => Maybe v -> NumError -> EnsureCN v
noValueNumErrorPotentialECN Maybe r
sample_v (NumError -> EnsureCN r) -> NumError -> EnsureCN r
forall a b. (a -> b) -> a -> b
$ String -> NumError
OutOfRange String
"illegal integer pow: negative exponent"
  | e
n e -> Integer -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
?==? Integer
0 Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& b
b b -> Integer -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
?==? Integer
0 =
    Maybe r -> NumError -> EnsureCN r
forall v. CanEnsureCN v => Maybe v -> NumError -> EnsureCN v
noValueNumErrorPotentialECN Maybe r
sample_v (NumError -> EnsureCN r) -> NumError -> EnsureCN r
forall a b. (a -> b) -> a -> b
$ String -> NumError
OutOfRange String
"illegal integer pow: 0^0"
  | Bool
otherwise =
    r -> EnsureCN r
forall v. CanEnsureCN v => v -> EnsureCN v
ensureCN (r -> EnsureCN r) -> r -> EnsureCN r
forall a b. (a -> b) -> a -> b
$ b -> e -> r
unsafeIntegerPow b
b e
n
  where
  sample_v :: Maybe r
sample_v = r -> Maybe r
forall a. a -> Maybe a
Just (b -> e -> r
unsafeIntegerPow b
b e
n)

powCN ::
  (HasOrderCertainly b Integer, HasOrderCertainly e Integer,
   HasEqCertainly b Integer, CanTestInteger e,
   CanEnsureCN r)
  =>
  (b -> e -> r) -> b -> e -> EnsureCN r
powCN :: (b -> e -> r) -> b -> e -> EnsureCN r
powCN b -> e -> r
unsafePow b
b e
e
  | b
b b -> Integer -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
!==! Integer
0 Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& e
e e -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<=! Integer
0 =
    Maybe r -> NumError -> EnsureCN r
forall v. CanEnsureCN v => Maybe v -> NumError -> EnsureCN v
noValueNumErrorCertainECN Maybe r
sample_v (NumError -> EnsureCN r) -> NumError -> EnsureCN r
forall a b. (a -> b) -> a -> b
$ String -> NumError
OutOfRange String
"illegal pow: 0^e with e <= 0"
  | b
b b -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
!<! Integer
0 Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& e -> Bool
forall t. CanTestInteger t => t -> Bool
certainlyNotInteger e
e =
    Maybe r -> NumError -> EnsureCN r
forall v. CanEnsureCN v => Maybe v -> NumError -> EnsureCN v
noValueNumErrorCertainECN Maybe r
sample_v (NumError -> EnsureCN r) -> NumError -> EnsureCN r
forall a b. (a -> b) -> a -> b
$ String -> NumError
OutOfRange String
"illegal pow: b^e with b < 0 and e non-integer"
  | b
b b -> Integer -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
?==? Integer
0 Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& e
e e -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
?<=? Integer
0 =
    Maybe r -> NumError -> EnsureCN r
forall v. CanEnsureCN v => Maybe v -> NumError -> EnsureCN v
noValueNumErrorPotentialECN Maybe r
sample_v (NumError -> EnsureCN r) -> NumError -> EnsureCN r
forall a b. (a -> b) -> a -> b
$ String -> NumError
OutOfRange String
"illegal pow: 0^e with e <= 0"
  | b
b b -> Integer -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
?<? Integer
0 Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& Bool -> NegType Bool
forall t. CanNeg t => t -> NegType t
not (e -> Bool
forall t. CanTestInteger t => t -> Bool
certainlyInteger e
e) =
    Maybe r -> NumError -> EnsureCN r
forall v. CanEnsureCN v => Maybe v -> NumError -> EnsureCN v
noValueNumErrorPotentialECN Maybe r
sample_v (NumError -> EnsureCN r) -> NumError -> EnsureCN r
forall a b. (a -> b) -> a -> b
$ String -> NumError
OutOfRange String
"illegal pow: b^e with b < 0 and e non-integer"
  | Bool
otherwise =
    r -> EnsureCN r
forall v. CanEnsureCN v => v -> EnsureCN v
ensureCN (r -> EnsureCN r) -> r -> EnsureCN r
forall a b. (a -> b) -> a -> b
$ b -> e -> r
unsafePow b
b e
e
  where
  sample_v :: Maybe r
sample_v = r -> Maybe r
forall a. a -> Maybe a
Just (b -> e -> r
unsafePow b
b e
e)

powUsingMul ::
  (CanBeInteger e,
   CanMulSameType t)
   =>
   t -> t -> e -> t
powUsingMul :: t -> t -> e -> t
powUsingMul t
one t
x e
nPre
  | Integer
n Integer -> Integer -> OrderCompareType Integer Integer
forall a b.
HasOrderAsymmetric a b =>
a -> b -> OrderCompareType a b
< Integer
0 = String -> t
forall a. HasCallStack => String -> a
error (String -> t) -> String -> t
forall a b. (a -> b) -> a -> b
$ String
"powUsingMul is not defined for negative exponent " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
n
  | Integer
n Integer -> Integer -> EqCompareType Integer Integer
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Integer
0 = t
one
  | Bool
otherwise = Integer -> t
aux Integer
n
  where
    n :: Integer
n = e -> Integer
forall t. CanBeInteger t => t -> Integer
integer e
nPre
    aux :: Integer -> t
aux Integer
m
      | Integer
m Integer -> Integer -> EqCompareType Integer Integer
forall a b. HasEqAsymmetric a b => a -> b -> EqCompareType a b
== Integer
1 = t
x
      | Integer -> Bool
forall a. Integral a => a -> Bool
even Integer
m =
        let s :: t
s = Integer -> t
aux (Integer
m Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`P.div` Integer
2) in t
s t -> t -> MulType t t
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* t
s
      | Bool
otherwise =
        let s :: t
s = Integer -> t
aux ((Integer
mInteger -> Integer -> SubType Integer Integer
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
-Integer
1) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`P.div` Integer
2) in t
x t -> t -> MulType t t
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* t
s t -> t -> MulType t t
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* t
s

type CanPowBy t1 t2 =
  (CanPow t1 t2, PowType t1 t2 ~ t1, PowTypeNoCN t1 t2 ~ t1)

type CanPowCNBy t1 t2 =
  (CanPow t1 t2, PowType t1 t2 ~ EnsureCN t1, PowTypeNoCN t1 t2 ~ t1
  , CanEnsureCN t1
  , CanPow (EnsureCN t1) t2, PowType (EnsureCN t1) t2 ~ EnsureCN t1
  , PowTypeNoCN (EnsureCN t1) t2 ~ (EnsureCN t1))

{-|
  HSpec properties that each implementation of CanPow should satisfy.
 -}
specCanPow ::
  (Show t1, Show t2, Show (PowType t1 t2),
   Show (MulType t1 (PowType t1 t2)),
   Show (PowType t1 (AddType t2 Integer)), Arbitrary t1, Arbitrary t2,
   ConvertibleExactly Integer t1, ConvertibleExactly Integer t2,
   CanTestCertainly (EqCompareType (PowType t1 t2) t1),
   CanTestCertainly
     (EqCompareType
        (MulType t1 (PowType t1 t2)) (PowType t1 (AddType t2 Integer))),
   HasEqAsymmetric (PowType t1 t2) t1,
   HasEqAsymmetric
     (MulType t1 (PowType t1 t2)) (PowType t1 (AddType t2 Integer)),
   CanTestPosNeg t2, CanAddAsymmetric t2 Integer, CanPow t1 t2,
   CanPow t1 (AddType t2 Integer),
   CanMulAsymmetric t1 (PowType t1 t2))
  =>
  T t1 -> T t2 -> Spec
specCanPow :: T t1 -> T t2 -> Spec
specCanPow (T String
typeName1 :: T t1) (T String
typeName2 :: T t2) =
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"CanPow %s %s" String
typeName1 String
typeName2) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"x^0 = 1" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t1 -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t1 -> Property) -> Property) -> (t1 -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) ->
        let one :: t1
one = (Integer -> t1
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
1 :: t1) in
        let z :: t2
z = (Integer -> t2
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
0 :: t2) in
        (t1
x t1 -> t2 -> PowType t1 t2
forall b e. CanPow b e => b -> e -> PowType b e
^ t2
z) PowType t1 t2 -> t1 -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ t1
one
    String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"x^1 = x" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t1 -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t1 -> Property) -> Property) -> (t1 -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) ->
        let one :: t2
one = (Integer -> t2
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
1 :: t2) in
        (t1
x t1 -> t2 -> PowType t1 t2
forall b e. CanPow b e => b -> e -> PowType b e
^ t2
one) PowType t1 t2 -> t1 -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ t1
x
    String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"x^(y+1) = x*x^y" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t1 -> t2 -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t1 -> t2 -> Property) -> Property)
-> (t1 -> t2 -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) (t2
y :: t2) ->
        (t2 -> Bool
forall t. CanTestPosNeg t => t -> Bool
isCertainlyNonNegative t2
y) Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
          t1
x t1 -> PowType t1 t2 -> MulType t1 (PowType t1 t2)
forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (t1
x t1 -> t2 -> PowType t1 t2
forall b e. CanPow b e => b -> e -> PowType b e
^ t2
y) MulType t1 (PowType t1 t2)
-> PowType t1 (AddType t2 Integer) -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ (t1
x t1 -> AddType t2 Integer -> PowType t1 (AddType t2 Integer)
forall b e. CanPow b e => b -> e -> PowType b e
^ (t2
y t2 -> Integer -> AddType t2 Integer
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ Integer
1))
  where
  infix 4 ?==?$
  (?==?$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
  ?==?$ :: a -> b -> Property
(?==?$) = String -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
String -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 String
"?==?" a -> b -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
(?==?)

instance CanPow Integer Integer where
  powNoCN :: Integer -> Integer -> PowTypeNoCN Integer Integer
powNoCN = Integer -> Integer -> PowTypeNoCN Integer Integer
forall a b. (Num a, Integral b) => a -> b -> a
(P.^)
  pow :: Integer -> Integer -> PowType Integer Integer
pow = (Integer -> Integer -> Integer)
-> Integer -> Integer -> EnsureCN Integer
forall b e r.
(HasOrderCertainly b Integer, HasOrderCertainly e Integer,
 HasEqCertainly b Integer, HasEqCertainly e Integer,
 CanEnsureCN r) =>
(b -> e -> r) -> b -> e -> EnsureCN r
integerPowCN Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
(P.^)
instance CanPow Integer Int where
  powNoCN :: Integer -> Int -> PowTypeNoCN Integer Int
powNoCN = Integer -> Int -> PowTypeNoCN Integer Int
forall a b. (Num a, Integral b) => a -> b -> a
(P.^)
  pow :: Integer -> Int -> PowType Integer Int
pow = (Integer -> Int -> Integer) -> Integer -> Int -> EnsureCN Integer
forall b e r.
(HasOrderCertainly b Integer, HasOrderCertainly e Integer,
 HasEqCertainly b Integer, HasEqCertainly e Integer,
 CanEnsureCN r) =>
(b -> e -> r) -> b -> e -> EnsureCN r
integerPowCN Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
(P.^)
instance CanPow Int Integer where
  type PowTypeNoCN Int Integer = Integer
  powNoCN :: Int -> Integer -> PowTypeNoCN Int Integer
powNoCN Int
x Integer
n = Integer -> Integer -> PowTypeNoCN Integer Integer
forall b e. CanPow b e => b -> e -> PowTypeNoCN b e
powNoCN (Int -> Integer
forall t. CanBeInteger t => t -> Integer
integer Int
x) Integer
n
  pow :: Int -> Integer -> PowType Int Integer
pow Int
x Integer
n = Integer -> Integer -> PowType Integer Integer
forall b e. CanPow b e => b -> e -> PowType b e
pow (Int -> Integer
forall t. CanBeInteger t => t -> Integer
integer Int
x) Integer
n
instance CanPow Int Int where
  type PowTypeNoCN Int Int = Integer
  powNoCN :: Int -> Int -> PowTypeNoCN Int Int
powNoCN Int
x Int
n = Integer -> Int -> PowTypeNoCN Integer Int
forall b e. CanPow b e => b -> e -> PowTypeNoCN b e
powNoCN (Int -> Integer
forall t. CanBeInteger t => t -> Integer
integer Int
x) Int
n
  pow :: Int -> Int -> PowType Int Int
pow Int
x Int
n = Integer -> Int -> PowType Integer Int
forall b e. CanPow b e => b -> e -> PowType b e
pow (Int -> Integer
forall t. CanBeInteger t => t -> Integer
integer Int
x) Int
n
instance CanPow Rational Int where
  powNoCN :: Rational -> Int -> PowTypeNoCN Rational Int
powNoCN = Rational -> Int -> PowTypeNoCN Rational Int
forall a b. (Fractional a, Integral b) => a -> b -> a
(P.^^)
instance CanPow Rational Integer where
  powNoCN :: Rational -> Integer -> PowTypeNoCN Rational Integer
powNoCN = Rational -> Integer -> PowTypeNoCN Rational Integer
forall a b. (Fractional a, Integral b) => a -> b -> a
(P.^^)
instance CanPow Double Int where
  powNoCN :: Double -> Int -> PowTypeNoCN Double Int
powNoCN = Double -> Int -> PowTypeNoCN Double Int
forall a b. (Fractional a, Integral b) => a -> b -> a
(P.^^)
  type PowType Double Int = Double
  pow :: Double -> Int -> PowType Double Int
pow = Double -> Int -> PowType Double Int
forall a b. (Fractional a, Integral b) => a -> b -> a
(P.^^)
instance CanPow Double Integer where
  powNoCN :: Double -> Integer -> PowTypeNoCN Double Integer
powNoCN = Double -> Integer -> PowTypeNoCN Double Integer
forall a b. (Fractional a, Integral b) => a -> b -> a
(P.^^)
  type PowType Double Integer = Double
  pow :: Double -> Integer -> PowType Double Integer
pow = Double -> Integer -> PowType Double Integer
forall a b. (Fractional a, Integral b) => a -> b -> a
(P.^^)

-- instance (CanPow a b) => CanPow [a] [b] where
--   type PowType [a] [b] = [PowType a b]
--   pow (x:xs) (y:ys) = (pow x y) : (pow xs ys)
--   pow _ _ = []

instance (CanPow a b) => CanPow (Maybe a) (Maybe b) where
  type PowTypeNoCN (Maybe a) (Maybe b) = Maybe (PowTypeNoCN a b)
  powNoCN :: Maybe a -> Maybe b -> PowTypeNoCN (Maybe a) (Maybe b)
powNoCN (Just a
x) (Just b
y) = PowTypeNoCN a b -> Maybe (PowTypeNoCN a b)
forall a. a -> Maybe a
Just (a -> b -> PowTypeNoCN a b
forall b e. CanPow b e => b -> e -> PowTypeNoCN b e
powNoCN a
x b
y)
  powNoCN Maybe a
_ Maybe b
_ = PowTypeNoCN (Maybe a) (Maybe b)
forall a. Maybe a
Nothing
  type PowType (Maybe a) (Maybe b) = Maybe (PowType a b)
  pow :: Maybe a -> Maybe b -> PowType (Maybe a) (Maybe b)
pow (Just a
x) (Just b
y) = PowType a b -> Maybe (PowType a b)
forall a. a -> Maybe a
Just (a -> b -> PowType a b
forall b e. CanPow b e => b -> e -> PowType b e
pow a
x b
y)
  pow Maybe a
_ Maybe b
_ = PowType (Maybe a) (Maybe b)
forall a. Maybe a
Nothing

instance
  (CanPow a b
  , CanEnsureCE es a, CanEnsureCE es b
  , CanEnsureCE es (PowTypeNoCN a b)
  , CanEnsureCE es (PowType a b)
  , SuitableForCE es)
  =>
  CanPow (CollectErrors es a) (CollectErrors es  b)
  where
  type PowTypeNoCN (CollectErrors es a) (CollectErrors es b) =
    EnsureCE es (PowTypeNoCN a b)
  powNoCN :: CollectErrors es a
-> CollectErrors es b
-> PowTypeNoCN (CollectErrors es a) (CollectErrors es b)
powNoCN = (a -> b -> PowTypeNoCN a b)
-> CollectErrors es a
-> CollectErrors es b
-> EnsureCE es (PowTypeNoCN a b)
forall es a b c.
(SuitableForCE es, CanEnsureCE es a, CanEnsureCE es b,
 CanEnsureCE es c) =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> EnsureCE es c
lift2CE a -> b -> PowTypeNoCN a b
forall b e. CanPow b e => b -> e -> PowTypeNoCN b e
powNoCN
  type PowType (CollectErrors es a) (CollectErrors es b) =
    EnsureCE es (PowType a b)
  pow :: CollectErrors es a
-> CollectErrors es b
-> PowType (CollectErrors es a) (CollectErrors es b)
pow = (a -> b -> PowType a b)
-> CollectErrors es a
-> CollectErrors es b
-> EnsureCE es (PowType a b)
forall es a b c.
(SuitableForCE es, CanEnsureCE es a, CanEnsureCE es b,
 CanEnsureCE es c) =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> EnsureCE es c
lift2CE a -> b -> PowType a b
forall b e. CanPow b e => b -> e -> PowType b e
pow

$(declForTypes
  [[t| Integer |], [t| Int |], [t| Rational |], [t| Double |]]
  (\ t -> [d|

    instance
      (CanPow $t b
      , CanEnsureCE es b
      , CanEnsureCE es (PowType $t b)
      , CanEnsureCE es (PowTypeNoCN $t b)
      , SuitableForCE es)
      =>
      CanPow $t (CollectErrors es  b)
      where
      type PowTypeNoCN $t (CollectErrors es  b) =
        EnsureCE es (PowTypeNoCN $t b)
      powNoCN = lift2TLCE powNoCN
      type PowType $t (CollectErrors es  b) =
        EnsureCE es (PowType $t b)
      pow = lift2TLCE pow

    instance
      (CanPow a $t
      , CanEnsureCE es a
      , CanEnsureCE es (PowType a $t)
      , CanEnsureCE es (PowTypeNoCN a $t)
      , SuitableForCE es)
      =>
      CanPow (CollectErrors es a) $t
      where
      type PowTypeNoCN (CollectErrors es  a) $t =
        EnsureCE es (PowTypeNoCN a $t)
      powNoCN = lift2TCE powNoCN
      type PowType (CollectErrors es  a) $t =
        EnsureCE es (PowType a $t)
      pow = lift2TCE pow

    instance
      (CanMulAsymmetric $t b
      , CanEnsureCE es b
      , CanEnsureCE es (MulType $t b)
      , SuitableForCE es)
      =>
      CanMulAsymmetric $t (CollectErrors es  b)
      where
      type MulType $t (CollectErrors es  b) =
        EnsureCE es (MulType $t b)
      mul = lift2TLCE mul

    instance
      (CanMulAsymmetric a $t
      , CanEnsureCE es a
      , CanEnsureCE es (MulType a $t)
      , SuitableForCE es)
      =>
      CanMulAsymmetric (CollectErrors es a) $t
      where
      type MulType (CollectErrors es  a) $t =
        EnsureCE es (MulType a $t)
      mul = lift2TCE mul
  |]))