{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
module Numeric.MixedTypes.AddSub
(
CanAdd, CanAddAsymmetric(..), CanAddThis, CanAddSameType
, (+), sum
, specCanAdd, specCanAddNotMixed, specCanAddSameType
, CanSub(..), CanSubThis, CanSubSameType
, (-)
, specCanSub, specCanSubNotMixed
)
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 Control.CollectErrors ( CollectErrors, CanBeErrors )
import qualified Control.CollectErrors as CE
import Numeric.MixedTypes.Literals
import Numeric.MixedTypes.Bool
import Numeric.MixedTypes.Eq
import Numeric.MixedTypes.Ord
import Numeric.MixedTypes.MinMaxAbs ()
type CanAdd t1 t2 =
(CanAddAsymmetric t1 t2, CanAddAsymmetric t2 t1,
AddType t1 t2 ~ AddType t2 t1)
class CanAddAsymmetric t1 t2 where
type AddType t1 t2
type AddType t1 t2 = t1
add :: t1 -> t2 -> AddType t1 t2
default add :: (AddType t1 t2 ~ t1, t1~t2, P.Num t1) => t1 -> t2 -> AddType t1 t2
add = t1 -> t2 -> AddType t1 t2
forall a. Num a => a -> a -> a
(P.+)
infixl 6 +, -
(+) :: (CanAddAsymmetric t1 t2) => t1 -> t2 -> AddType t1 t2
+ :: t1 -> t2 -> AddType t1 t2
(+) = t1 -> t2 -> AddType t1 t2
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add
(-) :: (CanSub t1 t2) => t1 -> t2 -> SubType t1 t2
(-) = t1 -> t2 -> SubType t1 t2
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub
type CanAddThis t1 t2 =
(CanAdd t1 t2, AddType t1 t2 ~ t1)
type CanAddSameType t =
CanAddThis t t
sum :: (CanAddSameType t, ConvertibleExactly Integer t) => [t] -> t
sum :: [t] -> t
sum [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. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add (Integer -> t
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
0) [t]
xs
specCanAdd ::
_ => T t1 -> T t2 -> T t3 -> Spec
specCanAdd :: T t1 -> T t2 -> T t3 -> Spec
specCanAdd (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
"CanAdd %s %s, CanAdd %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 0" (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 z :: t1
z = (Integer -> t1
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
0 :: t1) in (t1
x t1 -> t1 -> AddType t1 t1
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ t1
z) AddType t1 t1 -> 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 -> AddType t1 t2
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ t2
y) AddType t1 t2 -> AddType t2 t1 -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ (t2
y t2 -> t1 -> AddType t2 t1
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType 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 -> AddType t2 t3 -> AddType t1 (AddType t2 t3)
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (t2
y t2 -> t3 -> AddType t2 t3
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ t3
z)) AddType t1 (AddType t2 t3)
-> AddType (AddType t1 t2) t3 -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ ((t1
x t1 -> t2 -> AddType t1 t2
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ t2
y) AddType t1 t2 -> t3 -> AddType (AddType t1 t2) t3
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ t3
z)
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"increases when positive" (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 -> Bool
forall t. CanTestPosNeg t => t -> Bool
isCertainlyPositive t1
x) Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> (t1
x t1 -> t2 -> AddType t1 t2
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ t2
y) AddType t1 t2 -> t2 -> Property
forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?>?$ t2
y
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"decreases when negative" (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 -> Bool
forall t. CanTestPosNeg t => t -> Bool
isCertainlyNegative t1
x) Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> (t1
x t1 -> t2 -> AddType t1 t2
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ t2
y) AddType t1 t2 -> t2 -> Property
forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?<?$ t2
y
where
(?==?$) :: (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
(?==?)
(?>?$) :: (HasOrderCertainlyAsymmetric 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. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
(?>?)
(?<?$) :: (HasOrderCertainlyAsymmetric 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. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
(?<?)
specCanAddNotMixed ::
_ => T t -> Spec
specCanAddNotMixed :: T t -> Spec
specCanAddNotMixed (T t
t :: T t) = T t -> T t -> T t -> Spec
forall t1 t2 t3.
(Arbitrary t1, Arbitrary t2, Arbitrary t3,
HasEqAsymmetric (AddType t1 t1) t1,
HasEqAsymmetric (AddType t1 t2) (AddType t2 t1),
HasEqAsymmetric
(AddType t1 (AddType t2 t3)) (AddType (AddType t1 t2) t3),
Show t1, Show (AddType t1 t1), Show t2, Show (AddType t1 t2),
Show (AddType t2 t1), Show t3, Show (AddType t1 (AddType t2 t3)),
Show (AddType (AddType t1 t2) t3), CanAddAsymmetric t1 t1,
CanAddAsymmetric t1 t2, CanAddAsymmetric t1 (AddType t2 t3),
CanAddAsymmetric t2 t1, CanAddAsymmetric t2 t3,
CanAddAsymmetric (AddType t1 t2) t3, CanTestPosNeg t1,
HasOrderAsymmetric (AddType t1 t2) t2,
CanTestCertainly (EqCompareType (AddType t1 t1) t1),
CanTestCertainly (EqCompareType (AddType t1 t2) (AddType t2 t1)),
CanTestCertainly
(EqCompareType
(AddType t1 (AddType t2 t3)) (AddType (AddType t1 t2) t3)),
CanTestCertainly (OrderCompareType (AddType t1 t2) t2),
ConvertibleExactly Integer t1) =>
T t1 -> T t2 -> T t3 -> Spec
specCanAdd T t
t T t
t T t
t
specCanAddSameType ::
(ConvertibleExactly Integer t, Show t,
HasEqCertainly t t, CanAddSameType t)
=>
T t -> Spec
specCanAddSameType :: T t -> Spec
specCanAddSameType (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
"CanAddSameType %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 sum 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.
(CanAddSameType t, ConvertibleExactly Integer t) =>
[t] -> t
sum ([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.
(CanAddSameType t, ConvertibleExactly Integer t) =>
[t] -> t
sum [Integer]
xsi) :: t)
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"has sum [] = 0" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
([t] -> t
forall t.
(CanAddSameType t, ConvertibleExactly Integer t) =>
[t] -> t
sum ([] :: [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
0 :: t)
where
(?==?$) :: (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 CanAddAsymmetric Int Int where
type AddType Int Int = Integer
add :: Int -> Int -> AddType Int Int
add 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 CanAddAsymmetric Integer Integer
instance CanAddAsymmetric Rational Rational
instance CanAddAsymmetric Double Double
instance CanAddAsymmetric Int Integer where
type AddType Int Integer = Integer
add :: Int -> Integer -> AddType Int Integer
add = (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. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add
instance CanAddAsymmetric Integer Int where
type AddType Integer Int = Integer
add :: Integer -> Int -> AddType Integer Int
add = (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. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add
instance CanAddAsymmetric Int Rational where
type AddType Int Rational = Rational
add :: Int -> Rational -> AddType Int Rational
add = (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. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add
instance CanAddAsymmetric Rational Int where
type AddType Rational Int = Rational
add :: Rational -> Int -> AddType Rational Int
add = (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. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add
instance CanAddAsymmetric Integer Rational where
type AddType Integer Rational = Rational
add :: Integer -> Rational -> AddType Integer Rational
add = (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. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add
instance CanAddAsymmetric Rational Integer where
type AddType Rational Integer = Rational
add :: Rational -> Integer -> AddType Rational Integer
add = (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. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add
instance CanAddAsymmetric Int Double where
type AddType Int Double = Double
add :: Int -> Double -> AddType Int Double
add Int
n Double
d = Double -> Double -> AddType Double Double
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add (Int -> Double
forall t. CanBeDouble t => t -> Double
double Int
n) Double
d
instance CanAddAsymmetric Double Int where
type AddType Double Int = Double
add :: Double -> Int -> AddType Double Int
add Double
d Int
n = Double -> Double -> AddType Double Double
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add Double
d (Int -> Double
forall t. CanBeDouble t => t -> Double
double Int
n)
instance CanAddAsymmetric Integer Double where
type AddType Integer Double = Double
add :: Integer -> Double -> AddType Integer Double
add Integer
n Double
d = Double -> Double -> AddType Double Double
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add (Integer -> Double
forall t. CanBeDouble t => t -> Double
double Integer
n) Double
d
instance CanAddAsymmetric Double Integer where
type AddType Double Integer = Double
add :: Double -> Integer -> AddType Double Integer
add Double
d Integer
n = Double -> Double -> AddType Double Double
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add Double
d (Integer -> Double
forall t. CanBeDouble t => t -> Double
double Integer
n)
instance CanAddAsymmetric Rational Double where
type AddType Rational Double = Double
add :: Rational -> Double -> AddType Rational Double
add Rational
n Double
d = Double -> Double -> AddType Double Double
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add (Rational -> Double
forall t. CanBeDouble t => t -> Double
double Rational
n) Double
d
instance CanAddAsymmetric Double Rational where
type AddType Double Rational = Double
add :: Double -> Rational -> AddType Double Rational
add Double
d Rational
n = Double -> Double -> AddType Double Double
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add Double
d (Rational -> Double
forall t. CanBeDouble t => t -> Double
double Rational
n)
instance (CanAddAsymmetric a b) => CanAddAsymmetric [a] [b] where
type AddType [a] [b] = [AddType a b]
add :: [a] -> [b] -> AddType [a] [b]
add (a
x:[a]
xs) (b
y:[b]
ys) = (a -> b -> AddType a b
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add a
x b
y) AddType a b -> [AddType a b] -> [AddType a b]
forall a. a -> [a] -> [a]
: ([a] -> [b] -> AddType [a] [b]
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add [a]
xs [b]
ys)
add [a]
_ [b]
_ = []
instance (CanAddAsymmetric a b) => CanAddAsymmetric (Maybe a) (Maybe b) where
type AddType (Maybe a) (Maybe b) = Maybe (AddType a b)
add :: Maybe a -> Maybe b -> AddType (Maybe a) (Maybe b)
add (Just a
x) (Just b
y) = AddType a b -> Maybe (AddType a b)
forall a. a -> Maybe a
Just (a -> b -> AddType a b
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add a
x b
y)
add Maybe a
_ Maybe b
_ = AddType (Maybe a) (Maybe b)
forall a. Maybe a
Nothing
instance
(CanAddAsymmetric a b, CanBeErrors es)
=>
CanAddAsymmetric (CollectErrors es a) (CollectErrors es b)
where
type AddType (CollectErrors es a) (CollectErrors es b) =
CollectErrors es (AddType a b)
add :: CollectErrors es a
-> CollectErrors es b
-> AddType (CollectErrors es a) (CollectErrors es b)
add = (a -> b -> AddType a b)
-> CollectErrors es a
-> CollectErrors es b
-> CollectErrors es (AddType a b)
forall es a b c.
Monoid es =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
CE.lift2 a -> b -> AddType a b
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
add
class CanSub t1 t2 where
type SubType t1 t2
type SubType t1 t2 = AddType t1 (NegType t2)
sub :: t1 -> t2 -> SubType t1 t2
default sub ::
(SubType t1 t2 ~ AddType t1 (NegType t2),
CanNeg t2, CanAdd t1 (NegType t2))
=>
t1 -> t2 -> SubType t1 t2
t1
a `sub` t2
b = t1
a t1 -> NegType t2 -> AddType t1 (NegType t2)
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (t2 -> NegType t2
forall t. CanNeg t => t -> NegType t
negate t2
b)
type CanSubThis t1 t2 =
(CanSub t1 t2, SubType t1 t2 ~ t1)
type CanSubSameType t =
CanSubThis t t
specCanSub ::
_ => T t1 -> T t2 -> Spec
specCanSub :: T t1 -> T t2 -> Spec
specCanSub (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
"CanSub %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 = 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 z :: t1
z = (Integer -> t1
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
0 :: t1) in (t1
x t1 -> t1 -> SubType t1 t1
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- t1
z) SubType t1 t1 -> 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-x = 0" (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 z :: t1
z = (Integer -> t1
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
0 :: t1) in (t1
x t1 -> t1 -> SubType t1 t1
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- t1
x) SubType t1 t1 -> t1 -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ t1
z
String -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"x-y = 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) ->
(t1
x t1 -> t2 -> SubType t1 t2
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
- t2
y) SubType t1 t2 -> AddType t1 (NegType t2) -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ (t1
x t1 -> NegType t2 -> AddType t1 (NegType t2)
forall t1 t2. CanAddAsymmetric t1 t2 => t1 -> t2 -> AddType t1 t2
+ (t2 -> NegType t2
forall t. CanNeg t => t -> NegType t
negate t2
y))
where
(?==?$) :: (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
(?==?)
specCanSubNotMixed ::
_ => T t -> Spec
specCanSubNotMixed :: T t -> Spec
specCanSubNotMixed (T t
t :: T t) = T t -> T t -> Spec
forall t1 t2.
(Arbitrary t1, Arbitrary t2, HasEqAsymmetric (SubType t1 t1) t1,
HasEqAsymmetric (SubType t1 t2) (AddType t1 (NegType t2)),
CanTestCertainly (EqCompareType (SubType t1 t1) t1),
CanTestCertainly
(EqCompareType (SubType t1 t2) (AddType t1 (NegType t2))),
Show t1, Show (SubType t1 t1), Show t2, Show (SubType t1 t2),
Show (AddType t1 (NegType t2)), CanSub t1 t1, CanSub t1 t2,
CanAddAsymmetric t1 (NegType t2), ConvertibleExactly Integer t1,
CanNeg t2) =>
T t1 -> T t2 -> Spec
specCanSub T t
t T t
t
instance CanSub Int Int where
type SubType Int Int = Integer
sub :: Int -> Int -> SubType Int Int
sub 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 CanSub Integer Integer
instance CanSub Rational Rational
instance CanSub Double Double
instance CanSub Int Integer where
type SubType Int Integer = Integer
sub :: Int -> Integer -> SubType Int Integer
sub = (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. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub
instance CanSub Integer Int where
type SubType Integer Int = Integer
sub :: Integer -> Int -> SubType Integer Int
sub = (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. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub
instance CanSub Int Rational where
type SubType Int Rational = Rational
sub :: Int -> Rational -> SubType Int Rational
sub = (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. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub
instance CanSub Rational Int where
type SubType Rational Int = Rational
sub :: Rational -> Int -> SubType Rational Int
sub = (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. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub
instance CanSub Integer Rational where
type SubType Integer Rational = Rational
sub :: Integer -> Rational -> SubType Integer Rational
sub = (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. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub
instance CanSub Rational Integer where
type SubType Rational Integer = Rational
sub :: Rational -> Integer -> SubType Rational Integer
sub = (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. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub
instance CanSub Int Double where
type SubType Int Double = Double
sub :: Int -> Double -> SubType Int Double
sub Int
n Double
d = Double -> Double -> SubType Double Double
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub (Int -> Double
forall t. CanBeDouble t => t -> Double
double Int
n) Double
d
instance CanSub Double Int where
type SubType Double Int = Double
sub :: Double -> Int -> SubType Double Int
sub Double
d Int
n = Double -> Double -> SubType Double Double
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub Double
d (Int -> Double
forall t. CanBeDouble t => t -> Double
double Int
n)
instance CanSub Integer Double where
type SubType Integer Double = Double
sub :: Integer -> Double -> SubType Integer Double
sub Integer
n Double
d = Double -> Double -> SubType Double Double
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub (Integer -> Double
forall t. CanBeDouble t => t -> Double
double Integer
n) Double
d
instance CanSub Double Integer where
type SubType Double Integer = Double
sub :: Double -> Integer -> SubType Double Integer
sub Double
d Integer
n = Double -> Double -> SubType Double Double
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub Double
d (Integer -> Double
forall t. CanBeDouble t => t -> Double
double Integer
n)
instance CanSub Rational Double where
type SubType Rational Double = Double
sub :: Rational -> Double -> SubType Rational Double
sub Rational
n Double
d = Double -> Double -> SubType Double Double
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub (Rational -> Double
forall t. CanBeDouble t => t -> Double
double Rational
n) Double
d
instance CanSub Double Rational where
type SubType Double Rational = Double
sub :: Double -> Rational -> SubType Double Rational
sub Double
d Rational
n = Double -> Double -> SubType Double Double
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub Double
d (Rational -> Double
forall t. CanBeDouble t => t -> Double
double Rational
n)
instance (CanSub a b) => CanSub [a] [b] where
type SubType [a] [b] = [SubType a b]
sub :: [a] -> [b] -> SubType [a] [b]
sub (a
x:[a]
xs) (b
y:[b]
ys) = (a -> b -> SubType a b
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub a
x b
y) SubType a b -> [SubType a b] -> [SubType a b]
forall a. a -> [a] -> [a]
: ([a] -> [b] -> SubType [a] [b]
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub [a]
xs [b]
ys)
sub [a]
_ [b]
_ = []
instance (CanSub a b) => CanSub (Maybe a) (Maybe b) where
type SubType (Maybe a) (Maybe b) = Maybe (SubType a b)
sub :: Maybe a -> Maybe b -> SubType (Maybe a) (Maybe b)
sub (Just a
x) (Just b
y) = SubType a b -> Maybe (SubType a b)
forall a. a -> Maybe a
Just (a -> b -> SubType a b
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub a
x b
y)
sub Maybe a
_ Maybe b
_ = SubType (Maybe a) (Maybe b)
forall a. Maybe a
Nothing
instance
(CanSub a b, CanBeErrors es)
=>
CanSub (CollectErrors es a) (CollectErrors es b)
where
type SubType (CollectErrors es a) (CollectErrors es b) =
CollectErrors es (SubType a b)
sub :: CollectErrors es a
-> CollectErrors es b
-> SubType (CollectErrors es a) (CollectErrors es b)
sub = (a -> b -> SubType a b)
-> CollectErrors es a
-> CollectErrors es b
-> CollectErrors es (SubType a b)
forall es a b c.
Monoid es =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
CE.lift2 a -> b -> SubType a b
forall t1 t2. CanSub t1 t2 => t1 -> t2 -> SubType t1 t2
sub
$(declForTypes
[[t| Integer |], [t| Int |], [t| Rational |], [t| Double |]]
(\ t -> [d|
instance
(CanSub $t b, CanBeErrors es)
=>
CanSub $t (CollectErrors es b)
where
type SubType $t (CollectErrors es b) =
CollectErrors es (SubType $t b)
sub = CE.liftT1 sub
instance
(CanSub a $t, CanBeErrors es)
=>
CanSub (CollectErrors es a) $t
where
type SubType (CollectErrors es a) $t =
CollectErrors es (SubType a $t)
sub = CE.lift1T sub
instance
(CanAddAsymmetric $t b, CanBeErrors es)
=>
CanAddAsymmetric $t (CollectErrors es b)
where
type AddType $t (CollectErrors es b) =
CollectErrors es (AddType $t b)
add = CE.liftT1 add
instance
(CanAddAsymmetric a $t, CanBeErrors es)
=>
CanAddAsymmetric (CollectErrors es a) $t
where
type AddType (CollectErrors es a) $t =
CollectErrors es (AddType a $t)
add = CE.lift1T add
|]))