{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
{-|
    Module      :  Numeric.MixedType.MinMaxAbs
    Description :  Bottom-up typed min, max and abs
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

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

-}

module Numeric.MixedTypes.MinMaxAbs
(
  -- * Minimum and maximum
  CanMinMax, CanMinMaxAsymmetric(..), CanMinMaxThis, CanMinMaxSameType
  , minimum, maximum
  -- ** Tests
  , specCanMinMax, specCanMinMaxNotMixed
  -- * Absolute value
  , CanAbs(..), CanAbsSameType
  -- ** Tests
  , specCanNegNum, specCanAbs
)
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

{---- Min and max -----}

type CanMinMax t1 t2 =
  (CanMinMaxAsymmetric t1 t2, CanMinMaxAsymmetric t2 t1,
   MinMaxType t1 t2 ~ MinMaxType t2 t1)

{-|
  A replacement for Prelude's `P.min` and `P.max`.  If @t1 = t2@ and @Ord t1@,
  then one can use the default implementation to mirror Prelude's @min@ and @max@.
-}
class CanMinMaxAsymmetric t1 t2 where
  type MinMaxType t1 t2
  type MinMaxType t1 t2 = t1 -- default
  min :: t1 -> t2 -> MinMaxType t1 t2
  max :: t1 -> t2 -> MinMaxType t1 t2
  default min :: (MinMaxType t1 t2 ~ t1, t1~t2, P.Ord t1) => t1 -> t2 -> MinMaxType t1 t2
  min = t1 -> t2 -> MinMaxType t1 t2
forall a. Ord a => a -> a -> a
P.min
  default max :: (MinMaxType t1 t2 ~ t1, t1~t2, P.Ord t1) => t1 -> t2 -> MinMaxType t1 t2
  max = t1 -> t2 -> MinMaxType t1 t2
forall a. Ord a => a -> a -> a
P.max

type CanMinMaxThis t1 t2 =
  (CanMinMax t1 t2, MinMaxType t1 t2 ~ t1)
type CanMinMaxSameType t =
  CanMinMaxThis t t

maximum :: (CanMinMaxSameType t) => [t] -> t
maximum :: [t] -> t
maximum (t
x:[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.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max t
x [t]
xs
maximum [] = [Char] -> t
forall a. HasCallStack => [Char] -> a
error ([Char] -> t) -> [Char] -> t
forall a b. (a -> b) -> a -> b
$ [Char]
"maximum: empty list"

minimum :: (CanMinMaxSameType t) => [t] -> t
minimum :: [t] -> t
minimum (t
x:[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.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min t
x [t]
xs
minimum [] = [Char] -> t
forall a. HasCallStack => [Char] -> a
error ([Char] -> t) -> [Char] -> t
forall a b. (a -> b) -> a -> b
$ [Char]
"minimum: empty list"

{-|
  HSpec properties that each implementation of CanMinMax should satisfy.
 -}
specCanMinMax ::
  _ => T t1 -> T t2 -> T t3 -> Spec
specCanMinMax :: T t1 -> T t2 -> T t3 -> Spec
specCanMinMax (T [Char]
typeName1 :: T t1) (T [Char]
typeName2 :: T t2) (T [Char]
typeName3 :: T t3) =
  [Char] -> Spec -> Spec
forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe ([Char] -> [Char] -> [Char] -> [Char] -> [Char] -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"CanMinMax %s %s, CanMinMax %s %s" [Char]
typeName1 [Char]
typeName2 [Char]
typeName2 [Char]
typeName3) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    [Char] -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"`min` is not larger than its arguments" (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) ->
        -- (x ?==? x) && (y ?==? y) ==> -- avoid NaN
        (t1 -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t1
x) Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& (t2 -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t2
y) Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
          let m :: MinMaxType t1 t2
m = t1
x t1 -> t2 -> MinMaxType t1 t2
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`min` t2
y in (MinMaxType t1 t2
m MinMaxType t1 t2 -> t2 -> Property
forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?<=?$ t2
y) Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. (MinMaxType t1 t2
m MinMaxType t1 t2 -> t1 -> Property
forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?<=?$ t1
x)
    [Char] -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"`max` is not smaller than its arguments" (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) ->
        -- (x ?==? x) && (y ?==? y) ==> -- avoid NaN
        (t1 -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t1
x) Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& (t2 -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t2
y) Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
          let m :: MinMaxType t1 t2
m = t1
x t1 -> t2 -> MinMaxType t1 t2
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`max` t2
y in (MinMaxType t1 t2
m MinMaxType t1 t2 -> t2 -> Property
forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?>=?$ t2
y) Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. (MinMaxType t1 t2
m MinMaxType t1 t2 -> t1 -> Property
forall a b.
(HasOrderCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?>=?$ t1
x)
    [Char] -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"has idempotent `min`" (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) ->
        -- (x ?==? x) ==> -- avoid NaN
        (t1 -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t1
x) Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
          (t1
x t1 -> t1 -> MinMaxType t1 t1
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`min` t1
x) MinMaxType t1 t1 -> t1 -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ t1
x
    [Char] -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"has idempotent `max`" (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) ->
        -- (x ?==? x) ==> -- avoid NaN
        (t1 -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t1
x) Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
          (t1
x t1 -> t1 -> MinMaxType t1 t1
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`max` t1
x) MinMaxType t1 t1 -> t1 -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ t1
x
    [Char] -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"has commutative `min`" (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) ->
        -- (x ?==? x) && (y ?==? y) ==> -- avoid NaN
        (t1 -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t1
x) Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& (t2 -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t2
y) Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
          (t1
x t1 -> t2 -> MinMaxType t1 t2
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`min` t2
y) MinMaxType t1 t2 -> MinMaxType t2 t1 -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ (t2
y t2 -> t1 -> MinMaxType t2 t1
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`min` t1
x)
    [Char] -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"has commutative `max`" (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) ->
        -- (x ?==? x) && (y ?==? y) ==> -- avoid NaN
        (t1 -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t1
x) Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& (t2 -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t2
y) Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
          (t1
x t1 -> t2 -> MinMaxType t1 t2
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`max` t2
y) MinMaxType t1 t2 -> MinMaxType t2 t1 -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ (t2
y t2 -> t1 -> MinMaxType t2 t1
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`max` t1
x)
    [Char] -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"has associative `min`" (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) ->
        -- (x ?==? x) && (y ?==? y) && (z ?==? z) ==> -- avoid NaN
        (t1 -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t1
x) Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& (t2 -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t2
y) Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& (t3 -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t3
z) Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
            (t1
x t1 -> MinMaxType t2 t3 -> MinMaxType t1 (MinMaxType t2 t3)
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`min` (t2
y t2 -> t3 -> MinMaxType t2 t3
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`min` t3
z)) MinMaxType t1 (MinMaxType t2 t3)
-> MinMaxType (MinMaxType t1 t2) t3 -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ ((t1
x t1 -> t2 -> MinMaxType t1 t2
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`min` t2
y) MinMaxType t1 t2 -> t3 -> MinMaxType (MinMaxType t1 t2) t3
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`min` t3
z)
    [Char] -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"has associative `max`" (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) ->
        -- (x ?==? x) && (y ?==? y) && (z ?==? z) ==> -- avoid NaN
        (t1 -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t1
x) Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& (t2 -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t2
y) Bool -> Bool -> AndOrType Bool Bool
forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& (t3 -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t3
z) Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
            (t1
x t1 -> MinMaxType t2 t3 -> MinMaxType t1 (MinMaxType t2 t3)
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`max` (t2
y t2 -> t3 -> MinMaxType t2 t3
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`max` t3
z)) MinMaxType t1 (MinMaxType t2 t3)
-> MinMaxType (MinMaxType t1 t2) t3 -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ ((t1
x t1 -> t2 -> MinMaxType t1 t2
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`max` t2
y) MinMaxType t1 t2 -> t3 -> MinMaxType (MinMaxType t1 t2) t3
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
`max` t3
z)
  where
  (?==?$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
  ?==?$ :: a -> b -> Property
(?==?$) = [Char] -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
[Char] -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 [Char]
"?==?" 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
(?>=?$) = [Char] -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
[Char] -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 [Char]
"?>=?" 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
(?<=?$) = [Char] -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
[Char] -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 [Char]
"?<=?" a -> b -> Bool
forall a b. HasOrderCertainlyAsymmetric a b => a -> b -> Bool
(?<=?)
--
{-|
  HSpec properties that each implementation of CanMinMax should satisfy.
 -}
specCanMinMaxNotMixed ::
  _ => T t -> Spec
specCanMinMaxNotMixed :: T t -> Spec
specCanMinMaxNotMixed T t
t = T t -> T t -> T t -> Spec
forall t1 t2 t3.
(HasOrderAsymmetric (MinMaxType t1 t2) t2,
 HasOrderAsymmetric (MinMaxType t1 t2) t1, Arbitrary t1,
 Arbitrary t2, Arbitrary t3, CanTestFinite t1, CanTestFinite t2,
 CanTestFinite t3, HasEqAsymmetric (MinMaxType t1 t1) t1,
 HasEqAsymmetric (MinMaxType t1 t2) (MinMaxType t2 t1),
 HasEqAsymmetric
   (MinMaxType t1 (MinMaxType t2 t3))
   (MinMaxType (MinMaxType t1 t2) t3),
 CanTestCertainly (OrderCompareType (MinMaxType t1 t2) t2),
 CanTestCertainly (OrderCompareType (MinMaxType t1 t2) t1),
 CanTestCertainly (EqCompareType (MinMaxType t1 t1) t1),
 CanTestCertainly
   (EqCompareType (MinMaxType t1 t2) (MinMaxType t2 t1)),
 CanTestCertainly
   (EqCompareType
      (MinMaxType t1 (MinMaxType t2 t3))
      (MinMaxType (MinMaxType t1 t2) t3)),
 Show t1, Show t2, Show (MinMaxType t1 t2), Show (MinMaxType t1 t1),
 Show (MinMaxType t2 t1), Show t3,
 Show (MinMaxType t1 (MinMaxType t2 t3)),
 Show (MinMaxType (MinMaxType t1 t2) t3), CanMinMaxAsymmetric t1 t2,
 CanMinMaxAsymmetric t1 t1,
 CanMinMaxAsymmetric t1 (MinMaxType t2 t3),
 CanMinMaxAsymmetric t2 t1, CanMinMaxAsymmetric t2 t3,
 CanMinMaxAsymmetric (MinMaxType t1 t2) t3) =>
T t1 -> T t2 -> T t3 -> Spec
specCanMinMax T t
t T t
t T t
t

instance CanMinMaxAsymmetric Int Int
instance CanMinMaxAsymmetric Integer Integer
instance CanMinMaxAsymmetric Rational Rational
instance CanMinMaxAsymmetric Double Double

instance CanMinMaxAsymmetric Int Integer where
  type MinMaxType Int Integer = Integer
  min :: Int -> Integer -> MinMaxType Int Integer
min = (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.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min
  max :: Int -> Integer -> MinMaxType Int Integer
max = (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.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max
instance CanMinMaxAsymmetric Integer Int where
  type MinMaxType Integer Int = Integer
  min :: Integer -> Int -> MinMaxType Integer Int
min = (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.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min
  max :: Integer -> Int -> MinMaxType Integer Int
max = (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.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max

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

  instance CanMinMaxAsymmetric $t Rational where
    type MinMaxType $t Rational = Rational
    min = convertFirst min
    max = convertFirst max
  instance CanMinMaxAsymmetric Rational $t where
    type MinMaxType Rational $t = Rational
    min = convertSecond min
    max = convertSecond max
  |]))

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

  instance
    CanMinMaxAsymmetric $t Double
    where
    type MinMaxType $t Double = Double
    min a b = min (double a) b
    max a b = max (double a) b

  instance
    CanMinMaxAsymmetric Double $t
    where
    type MinMaxType Double $t = Double
    min a b = min a (double b)
    max a b = max a (double b)

  |]))

instance (CanMinMaxAsymmetric a b) => CanMinMaxAsymmetric [a] [b] where
  type MinMaxType [a] [b] = [MinMaxType a b]
  min :: [a] -> [b] -> MinMaxType [a] [b]
min (a
x:[a]
xs) (b
y:[b]
ys) = (a -> b -> MinMaxType a b
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min a
x b
y) MinMaxType a b -> [MinMaxType a b] -> [MinMaxType a b]
forall a. a -> [a] -> [a]
: ([a] -> [b] -> MinMaxType [a] [b]
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min [a]
xs [b]
ys)
  min [a]
_ [b]
_ = []
  max :: [a] -> [b] -> MinMaxType [a] [b]
max (a
x:[a]
xs) (b
y:[b]
ys) = (a -> b -> MinMaxType a b
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max a
x b
y) MinMaxType a b -> [MinMaxType a b] -> [MinMaxType a b]
forall a. a -> [a] -> [a]
: ([a] -> [b] -> MinMaxType [a] [b]
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max [a]
xs [b]
ys)
  max [a]
_ [b]
_ = []

instance (CanMinMaxAsymmetric a b) => CanMinMaxAsymmetric (Maybe a) (Maybe b) where
  type MinMaxType (Maybe a) (Maybe b) = Maybe (MinMaxType a b)
  min :: Maybe a -> Maybe b -> MinMaxType (Maybe a) (Maybe b)
min (Just a
x) (Just b
y) = MinMaxType a b -> Maybe (MinMaxType a b)
forall a. a -> Maybe a
Just (a -> b -> MinMaxType a b
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min a
x b
y)
  min Maybe a
_ Maybe b
_ = MinMaxType (Maybe a) (Maybe b)
forall a. Maybe a
Nothing
  max :: Maybe a -> Maybe b -> MinMaxType (Maybe a) (Maybe b)
max (Just a
x) (Just b
y) = MinMaxType a b -> Maybe (MinMaxType a b)
forall a. a -> Maybe a
Just (a -> b -> MinMaxType a b
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max a
x b
y)
  max Maybe a
_ Maybe b
_ = MinMaxType (Maybe a) (Maybe b)
forall a. Maybe a
Nothing

instance
  (CanMinMaxAsymmetric a b, CanBeErrors es)
  =>
  CanMinMaxAsymmetric (CollectErrors es a) (CollectErrors es  b)
  where
  type MinMaxType (CollectErrors es a) (CollectErrors es b) =
    CollectErrors es (MinMaxType a b)
  min :: CollectErrors es a
-> CollectErrors es b
-> MinMaxType (CollectErrors es a) (CollectErrors es b)
min = (a -> b -> MinMaxType a b)
-> CollectErrors es a
-> CollectErrors es b
-> CollectErrors es (MinMaxType 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 -> MinMaxType a b
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
min
  max :: CollectErrors es a
-> CollectErrors es b
-> MinMaxType (CollectErrors es a) (CollectErrors es b)
max = (a -> b -> MinMaxType a b)
-> CollectErrors es a
-> CollectErrors es b
-> CollectErrors es (MinMaxType 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 -> MinMaxType a b
forall t1 t2.
CanMinMaxAsymmetric t1 t2 =>
t1 -> t2 -> MinMaxType t1 t2
max

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

    instance
      (CanMinMaxAsymmetric $t b, CanBeErrors es)
      =>
      CanMinMaxAsymmetric $t (CollectErrors es  b)
      where
      type MinMaxType $t (CollectErrors es  b) =
        CollectErrors es (MinMaxType $t b)
      min = CE.liftT1 min
      max = CE.liftT1 max

    instance
      (CanMinMaxAsymmetric a $t, CanBeErrors es)
      =>
      CanMinMaxAsymmetric (CollectErrors es a) $t
      where
      type MinMaxType (CollectErrors es  a) $t =
        CollectErrors es (MinMaxType a $t)
      min = CE.lift1T min
      max = CE.lift1T max

  |]))


{----  numeric negation tests and instances -----}

{-|
  HSpec properties that each numeric implementation of CanNeg should satisfy.
 -}
specCanNegNum ::
  _ => T t -> Spec
specCanNegNum :: T t -> Spec
specCanNegNum (T [Char]
typeName :: T t) =
  [Char] -> Spec -> Spec
forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe ([Char] -> [Char] -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"CanNeg %s" [Char]
typeName) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    [Char] -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"ignores double negation" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> Property) -> Property) -> (t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) ->
        (t
x t -> t -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
?==? t
x) Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> -- avoid NaN
          (NegType t -> NegType (NegType t)
forall t. CanNeg t => t -> NegType t
negate (t -> NegType t
forall t. CanNeg t => t -> NegType t
negate t
x)) NegType (NegType t) -> t -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ t
x
    [Char] -> Bool -> SpecWith (Arg Bool)
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"takes 0 to 0" (Bool -> SpecWith (Arg Bool)) -> Bool -> SpecWith (Arg Bool)
forall a b. (a -> b) -> a -> b
$ do
      let z :: t
z = Integer -> t
forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
0 :: t in t -> NegType t
forall t. CanNeg t => t -> NegType t
negate t
z NegType t -> t -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
?==? t
z
    [Char] -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"takes positive to negative" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> Property) -> Property) -> (t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) ->
        (t -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t
x) Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> -- avoid NaN
        (t -> Bool
forall t. CanTestPosNeg t => t -> Bool
isCertainlyPositive t
x) Bool -> Bool -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> (NegType t -> Bool
forall t. CanTestPosNeg t => t -> Bool
isCertainlyNegative (t -> NegType t
forall t. CanNeg t => t -> NegType t
negate t
x))
    [Char] -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"takes negative to positive" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> Property) -> Property) -> (t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) ->
        (t -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t
x) Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> -- avoid NaN
        (t -> Bool
forall t. CanTestPosNeg t => t -> Bool
isCertainlyNegative t
x) Bool -> Bool -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> (NegType t -> Bool
forall t. CanTestPosNeg t => t -> Bool
isCertainlyPositive (t -> NegType t
forall t. CanNeg t => t -> NegType t
negate t
x))
  where
  (?==?$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
  ?==?$ :: a -> b -> Property
(?==?$) = [Char] -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
[Char] -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 [Char]
"?==?" a -> b -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
(?==?)

instance CanNeg Int where negate :: Int -> NegType Int
negate = Int -> NegType Int
forall a. Num a => a -> a
P.negate
instance CanNeg Integer where negate :: Integer -> NegType Integer
negate = Integer -> NegType Integer
forall a. Num a => a -> a
P.negate
instance CanNeg Rational where negate :: Rational -> NegType Rational
negate = Rational -> NegType Rational
forall a. Num a => a -> a
P.negate
instance CanNeg Double where negate :: Double -> NegType Double
negate = Double -> NegType Double
forall a. Num a => a -> a
P.negate

{----  abs -----}

{-|
  A replacement for Prelude's `P.abs`.  If @Num t@,
  then one can use the default implementation to mirror Prelude's @abs@.
-}
class CanAbs t where
  type AbsType t
  type AbsType t = t -- default
  abs :: t -> AbsType t
  default abs :: (AbsType t ~ t, P.Num t) => t -> AbsType t
  abs = t -> AbsType t
forall a. Num a => a -> a
P.abs

type CanAbsSameType t = (CanAbs t, AbsType t ~ t)

instance CanAbs Int
instance CanAbs Integer
instance CanAbs Rational
instance CanAbs Double

instance
  (CanAbs a, CanBeErrors es)
  =>
  CanAbs (CollectErrors es a)
  where
  type AbsType (CollectErrors es a) = CollectErrors es (AbsType a)
  abs :: CollectErrors es a -> AbsType (CollectErrors es a)
abs = (a -> AbsType a)
-> CollectErrors es a -> CollectErrors es (AbsType a)
forall es a b.
Monoid es =>
(a -> b) -> CollectErrors es a -> CollectErrors es b
CE.lift a -> AbsType a
forall t. CanAbs t => t -> AbsType t
abs

{-|
  HSpec properties that each implementation of CanAbs should satisfy.
 -}
specCanAbs ::
  _ => T t -> Spec
specCanAbs :: T t -> Spec
specCanAbs (T [Char]
typeName :: T t) =
  [Char] -> Spec -> Spec
forall a. HasCallStack => [Char] -> SpecWith a -> SpecWith a
describe ([Char] -> [Char] -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"CanAbs %s" [Char]
typeName) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    [Char] -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"is idempotent" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> Property) -> Property) -> (t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) ->
        (t
x t -> t -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
?==? t
x) Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> -- avoid NaN
          (AbsType t -> AbsType (AbsType t)
forall t. CanAbs t => t -> AbsType t
abs (t -> AbsType t
forall t. CanAbs t => t -> AbsType t
abs t
x)) AbsType (AbsType t) -> AbsType t -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ (t -> AbsType t
forall t. CanAbs t => t -> AbsType t
abs t
x)
    [Char] -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"is identity on non-negative arguments" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> Property) -> Property) -> (t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) ->
        (t -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t
x) Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
        t -> Bool
forall t. CanTestPosNeg t => t -> Bool
isCertainlyNonNegative t
x  Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> t
x t -> AbsType t -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ (t -> AbsType t
forall t. CanAbs t => t -> AbsType t
abs t
x)
    [Char] -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"is negation on non-positive arguments" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> Property) -> Property) -> (t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) ->
        (t -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t
x) Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
        t -> Bool
forall t. CanTestPosNeg t => t -> Bool
isCertainlyNonPositive t
x  Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> (t -> NegType t
forall t. CanNeg t => t -> NegType t
negate t
x) NegType t -> AbsType t -> Property
forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ (t -> AbsType t
forall t. CanAbs t => t -> AbsType t
abs t
x)
    [Char] -> Property -> SpecWith (Arg Property)
forall a.
(HasCallStack, Example a) =>
[Char] -> a -> SpecWith (Arg a)
it [Char]
"does not give negative results" (Property -> SpecWith (Arg Property))
-> Property -> SpecWith (Arg Property)
forall a b. (a -> b) -> a -> b
$ do
      (t -> Property) -> Property
forall prop. Testable prop => prop -> Property
property ((t -> Property) -> Property) -> (t -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ (t
x :: t) -> 
        (t -> Bool
forall t. CanTestFinite t => t -> Bool
isFinite t
x) Bool -> Bool -> Property
forall prop. Testable prop => Bool -> prop -> Property
==>
        Bool -> NegType Bool
forall t. CanNeg t => t -> NegType t
not (Bool -> NegType Bool) -> Bool -> NegType Bool
forall a b. (a -> b) -> a -> b
$ AbsType t -> Bool
forall t. CanTestPosNeg t => t -> Bool
isCertainlyNegative (t -> AbsType t
forall t. CanAbs t => t -> AbsType t
abs t
x)
  where
  (?==?$) :: (HasEqCertainlyAsymmetric a b, Show a, Show b) => a -> b -> Property
  ?==?$ :: a -> b -> Property
(?==?$) = [Char] -> (a -> b -> Bool) -> a -> b -> Property
forall prop a b.
(Testable prop, Show a, Show b) =>
[Char] -> (a -> b -> prop) -> a -> b -> Property
printArgsIfFails2 [Char]
"?==?" a -> b -> Bool
forall a b. HasEqCertainlyAsymmetric a b => a -> b -> Bool
(?==?)