{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
module Numeric.MixedTypes.Mul
(
CanMul, CanMulAsymmetric(..), CanMulBy, CanMulSameType
, (*), product
, specCanMul, specCanMulNotMixed, specCanMulSameType
)
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 qualified Numeric.CollectErrors as CN
import Numeric.CollectErrors ( CN )
import Numeric.MixedTypes.Literals
import Numeric.MixedTypes.Bool
import Numeric.MixedTypes.Eq
import Numeric.MixedTypes.AddSub
import Numeric.MixedTypes.Reduce
type CanMul t1 t2 =
(CanMulAsymmetric t1 t2, CanMulAsymmetric t2 t1,
MulType t1 t2 ~ MulType t2 t1)
class CanMulAsymmetric t1 t2 where
type MulType t1 t2
type MulType t1 t2 = t1
mul :: t1 -> t2 -> MulType t1 t2
default mul :: (MulType t1 t2 ~ t1, t1~t2, P.Num t1) => t1 -> t2 -> MulType t1 t2
mul = forall a. Num a => a -> a -> a
(P.*)
infixl 7 *
(*) :: (CanMulAsymmetric t1 t2) => t1 -> t2 -> MulType t1 t2
* :: forall t1 t2. CanMulAsymmetric 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 :: forall t.
(CanMulSameType t, ConvertibleExactly Integer t) =>
[t] -> t
product [t]
xs = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul (forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
1) [t]
xs
specCanMul ::
_ => 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) =
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (forall r. PrintfType r => String -> r
printf String
"CanMul %s %s, CanMul %s %s" String
typeName1 String
typeName2 String
typeName2 String
typeName3) forall a b. (a -> b) -> a -> b
$ do
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"absorbs 1" forall a b. (a -> b) -> a -> b
$ do
forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) -> let one :: t2
one = (forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
1 :: t2) in (t1
x forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* t2
one) forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ t1
x
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"is commutative" forall a b. (a -> b) -> a -> b
$ do
forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) (t2
y :: t2) -> (t1
x forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* t2
y) forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ (t2
y forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* t1
x)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"is associative" forall a b. (a -> b) -> a -> b
$ do
forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) (t2
y :: t2) (t3
z :: t3) ->
(t1
x forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (t2
y forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* t3
z)) forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ ((t1
x forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* t2
y) forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* t3
z)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"distributes over addition" forall a b. (a -> b) -> a -> b
$ do
forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ (t1
x :: t1) (t2
y :: t2) (t3
z :: t3) ->
(t1
x forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* (t2
y forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ t3
z)) forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ (t1
x forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
* t2
y) forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (t1
x 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
?==?$ :: forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
(?==?$) = forall prop a b.
(Testable prop, Show a, Show b) =>
String -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 String
"?==?" forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
(?==?)
specCanMulNotMixed ::
_ => T t -> Spec
specCanMulNotMixed :: T t -> Spec
specCanMulNotMixed (T t
t :: T t) = forall t1 t2 t3.
(Arbitrary t1, Arbitrary t2, Arbitrary 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)),
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))),
Show t1, Show t2, Show t3, Show (MulType t2 t1),
Show (MulType t1 t2), Show (MulType t1 (MulType t2 t3)),
Show (MulType t1 (AddType t2 t3)),
Show (MulType (MulType t1 t2) t3),
Show (AddType (MulType t1 t2) (MulType t1 t3)),
CanAddAsymmetric t2 t3,
CanAddAsymmetric (MulType t1 t2) (MulType t1 t3),
CanMulAsymmetric t2 t1, CanMulAsymmetric t2 t3,
CanMulAsymmetric t1 t2, CanMulAsymmetric t1 t3,
CanMulAsymmetric t1 (MulType t2 t3),
CanMulAsymmetric t1 (AddType t2 t3),
CanMulAsymmetric (MulType t1 t2) t3,
ConvertibleExactly Integer t2) =>
T t1 -> T t2 -> T t3 -> Spec
specCanMul T t
t T t
t T t
t
specCanMulSameType ::
(Show t, ConvertibleExactly Integer t,
CanTestCertainly (EqCompareType t t), HasEqAsymmetric t t,
CanMulAsymmetric t t, MulType t t ~ t)
=>
T t -> Spec
specCanMulSameType :: forall t.
(Show t, ConvertibleExactly Integer t,
CanTestCertainly (EqCompareType t t), HasEqAsymmetric t t,
CanMulAsymmetric t t, MulType t t ~ t) =>
T t -> Spec
specCanMulSameType (T String
typeName :: T t) =
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (forall r. PrintfType r => String -> r
printf String
"CanMulSameType %s" String
typeName) forall a b. (a -> b) -> a -> b
$ do
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"has product working over integers" forall a b. (a -> b) -> a -> b
$ do
forall prop. Testable prop => prop -> Property
property forall a b. (a -> b) -> a -> b
$ \ ([Integer]
xsi :: [Integer]) ->
(forall t.
(CanMulSameType t, ConvertibleExactly Integer t) =>
[t] -> t
product forall a b. (a -> b) -> a -> b
$ (forall a b. (a -> b) -> [a] -> [b]
map forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly [Integer]
xsi :: [t])) forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ (forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly (forall t.
(CanMulSameType t, ConvertibleExactly Integer t) =>
[t] -> t
product [Integer]
xsi) :: t)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"has product [] = 1" forall a b. (a -> b) -> a -> b
$ do
(forall t.
(CanMulSameType t, ConvertibleExactly Integer t) =>
[t] -> t
product ([] :: [t])) forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ (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
?==?$ :: forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
(?==?$) = forall prop a b.
(Testable prop, Show a, Show b) =>
String -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 String
"?==?" forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
(?==?)
instance CanMulAsymmetric Int Int where
type MulType Int Int = Integer
mul :: Int -> Int -> MulType Int Int
mul Int
a Int
b = (forall t. CanBeInteger t => t -> Integer
integer Int
a) forall a. Num a => a -> a -> a
P.* (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 = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst 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 = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond 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 = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst 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 = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond 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 = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst 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 = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond 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 = forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul (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 = forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul Double
d (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 = forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul (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 = forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul Double
d (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 = forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul (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 = forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul Double
d (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) = (forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul a
x b
y) forall a. a -> [a] -> [a]
: (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) = forall a. a -> Maybe a
Just (forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul a
x b
y)
mul Maybe a
_ Maybe b
_ = forall a. Maybe a
Nothing
instance
(CanMulAsymmetric a b, CanGiveUpIfVeryInaccurate (MulType a b))
=>
CanMulAsymmetric (CN a) (CN b)
where
type MulType (CN a) (CN b) = CN (MulType a b)
mul :: CN a -> CN b -> MulType (CN a) (CN b)
mul CN a
a CN b
b = forall t. CanGiveUpIfVeryInaccurate t => CN t -> CN t
giveUpIfVeryInaccurate forall a b. (a -> b) -> a -> b
$ forall es a b c.
Monoid es =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
CN.lift2 forall t1 t2. CanMulAsymmetric t1 t2 => t1 -> t2 -> MulType t1 t2
mul CN a
a CN b
b
$(declForTypes
[[t| Integer |], [t| Int |], [t| Rational |], [t| Double |]]
(\ t -> [d|
instance
(CanMulAsymmetric $t b, CanGiveUpIfVeryInaccurate (MulType $t b))
=>
CanMulAsymmetric $t (CN b)
where
type MulType $t (CN b) = CN (MulType $t b)
mul a b = giveUpIfVeryInaccurate $ CN.liftT1 mul a b
instance
(CanMulAsymmetric a $t, CanGiveUpIfVeryInaccurate (MulType a $t))
=>
CanMulAsymmetric (CN a) $t
where
type MulType (CN a) $t = CN (MulType a $t)
mul a b = giveUpIfVeryInaccurate $ CN.lift1T mul a b
|]))