{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
{-|
    Module      :  Numeric.MixedType.Div
    Description :  Bottom-up typed division
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

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

-}

module Numeric.MixedTypes.Div
(
  -- * Division
    CanDiv(..), CanDivBy, CanDivSameType
  , CanRecip, CanRecipSameType
  , (/), recip
  -- ** Tests
  , specCanDiv, specCanDivNotMixed
)
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 ( CN, cn )
import qualified Numeric.CollectErrors as CN

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

{---- Division -----}

{-|
  A replacement for Prelude's binary `P./`.  If @t1 = t2@ and @Fractional t1@,
  then one can use the default implementation to mirror Prelude's @/@.
-}
class CanDiv t1 t2 where
  type DivType t1 t2
  type DivType t1 t2 = t1
  divide :: t1 -> t2 -> DivType t1 t2

divideCN ::
  (CanTestZero t2)
  =>
  (t1 -> t2 -> t3) ->
  CN t1 -> CN t2 -> CN t3
divideCN :: forall t2 t1 t3.
CanTestZero t2 =>
(t1 -> t2 -> t3) -> CN t1 -> CN t2 -> CN t3
divideCN t1 -> t2 -> t3
unsafeDivide CN t1
a CN t2
b
  | forall t. CanTestZero t => t -> Bool
isCertainlyZero CN t2
b = forall t. CN t -> NumError -> CN t
CN.removeValueErrorCertain CollectErrors NumErrors t3
r NumError
e
  | forall t. CanTestZero t => t -> Bool
isCertainlyNonZero CN t2
b = CollectErrors NumErrors t3
r
  | Bool
otherwise = forall t. CN t -> NumError -> CN t
CN.removeValueErrorPotential CollectErrors NumErrors t3
r NumError
e
  where
  r :: CollectErrors NumErrors t3
r = forall es a b c.
Monoid es =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
CN.lift2 t1 -> t2 -> t3
unsafeDivide CN t1
a CN t2
b
  e :: CN.NumError
  e :: NumError
e = NumError
CN.DivByZero

infixl 7  /

(/) :: (CanDiv t1 t2) => t1 -> t2 -> DivType t1 t2
/ :: forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
(/) = forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide

type CanRecip t =
  (CanDiv Integer t)

type CanRecipSameType t =
  (CanDiv Integer t, DivType Integer t ~ t)

recip :: (CanRecip t) => t -> DivType Integer t
recip :: forall t. CanRecip t => t -> DivType Integer t
recip = forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide Integer
1

type CanDivBy t1 t2 =
  (CanDiv t1 t2, DivType t1 t2 ~ t1)
type CanDivSameType t =
  CanDivBy t t

{-|
  HSpec properties that each implementation of CanDiv should satisfy.
 -}
specCanDiv ::
  _ => T t1 -> T t2 -> Spec
specCanDiv :: T t1 -> T t2 -> Spec
specCanDiv (T String
typeName1 :: T t1) (T String
typeName2 :: T t2) =
  forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (forall r. PrintfType r => String -> r
printf String
"CanDiv %s %s" String
typeName1 String
typeName2) forall a b. (a -> b) -> a -> b
$ do
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"recip(recip x) = x" 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) ->
        (forall t. CanTestZero t => t -> Bool
isCertainlyNonZero t1
x forall a b. CanAndOrAsymmetric a b => a -> b -> AndOrType a b
&& forall t. CanTestZero t => t -> Bool
isCertainlyNonZero (forall t. CanRecip t => t -> DivType Integer t
recip t1
x)) forall prop. Testable prop => Bool -> prop -> Property
==>
          forall t. CanRecip t => t -> DivType Integer t
recip (forall t. CanRecip t => t -> DivType Integer t
recip t1
x) 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
"x/1 = x" 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. CanDiv t1 t2 => t1 -> t2 -> DivType 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
"x/x = 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) ->
        (forall t. CanTestZero t => t -> Bool
isCertainlyNonZero t1
x) forall prop. Testable prop => Bool -> prop -> Property
==>
          let one :: t1
one = (forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
1 :: t1) in (t1
x forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/ t1
x) forall a b.
(HasEqCertainlyAsymmetric a b, Show a, Show b) =>
a -> b -> Property
?==?$ t1
one
    forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"x/y = x*(1/y)" 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) ->
        (forall t. CanTestZero t => t -> Bool
isCertainlyNonZero t2
y) forall prop. Testable prop => Bool -> prop -> Property
==>
          let one :: t1
one = (forall t1 t2. ConvertibleExactly t1 t2 => t1 -> t2
convertExactly Integer
1 :: t1) in (t1
x forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/ t2
y) 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
* (t1
oneforall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
/t2
y)
  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
(?==?)

{-|
  HSpec properties that each implementation of CanDiv should satisfy.
 -}
specCanDivNotMixed ::
  _ => T t -> Spec
specCanDivNotMixed :: T t -> Spec
specCanDivNotMixed (T t
t :: T t) = forall t1 t2.
(CanDiv t1 t2, CanDiv t1 t1, CanDiv Integer t1,
 CanDiv Integer (DivType Integer t1), Arbitrary t1, Arbitrary t2,
 CanTestZero t1, CanTestZero t2, CanTestZero (DivType Integer t1),
 HasEqAsymmetric (DivType t1 t1) t1,
 HasEqAsymmetric (DivType t1 t2) t1,
 HasEqAsymmetric (DivType t1 t2) (MulType t1 (DivType t1 t2)),
 HasEqAsymmetric (DivType Integer (DivType Integer t1)) t1,
 CanTestCertainly (EqCompareType (DivType t1 t1) t1),
 CanTestCertainly (EqCompareType (DivType t1 t2) t1),
 CanTestCertainly
   (EqCompareType (DivType t1 t2) (MulType t1 (DivType t1 t2))),
 CanTestCertainly
   (EqCompareType (DivType Integer (DivType Integer t1)) t1),
 Show t1, Show t2, Show (DivType t1 t2), Show (DivType t1 t1),
 Show (DivType Integer (DivType Integer t1)),
 Show (MulType t1 (DivType t1 t2)),
 CanMulAsymmetric t1 (DivType t1 t2), ConvertibleExactly Integer t2,
 ConvertibleExactly Integer t1) =>
T t1 -> T t2 -> Spec
specCanDiv T t
t T t
t

instance CanDiv Int Int where
  type DivType Int Int = Rational
  divide :: Int -> Int -> DivType Int Int
divide Int
a Int
b = forall a. Fractional a => a -> a -> a
(P./) (forall t. CanBeRational t => t -> Rational
rational Int
a) (forall t. CanBeRational t => t -> Rational
rational Int
b)

instance CanDiv Integer Integer where
  type DivType Integer Integer = Rational
  divide :: Integer -> Integer -> DivType Integer Integer
divide Integer
a Integer
b = forall a. Fractional a => a -> a -> a
(P./) (forall t. CanBeRational t => t -> Rational
rational Integer
a) (forall t. CanBeRational t => t -> Rational
rational Integer
b)
instance CanDiv Rational Rational where
  type DivType Rational Rational = Rational
  divide :: Rational -> Rational -> DivType Rational Rational
divide = forall a. Fractional a => a -> a -> a
(P./)

instance CanDiv Int Integer where
  type DivType Int Integer = Rational
  divide :: Int -> Integer -> DivType Int Integer
divide Int
a Integer
b = forall a. Fractional a => a -> a -> a
(P./) (forall t. CanBeRational t => t -> Rational
rational Int
a) (forall t. CanBeRational t => t -> Rational
rational Integer
b)
instance CanDiv Integer Int where
  type DivType Integer Int = Rational
  divide :: Integer -> Int -> DivType Integer Int
divide Integer
a Int
b = forall a. Fractional a => a -> a -> a
(P./) (forall t. CanBeRational t => t -> Rational
rational Integer
a) (forall t. CanBeRational t => t -> Rational
rational Int
b)

instance CanDiv Int Rational where
  type DivType Int Rational = Rational
  divide :: Int -> Rational -> DivType Int Rational
divide = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide
instance CanDiv Rational Int where
  divide :: Rational -> Int -> DivType Rational Int
divide = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide

instance CanDiv Integer Rational where
  type DivType Integer Rational = Rational
  divide :: Integer -> Rational -> DivType Integer Rational
divide = forall a b c.
ConvertibleExactly a b =>
(b -> b -> c) -> a -> b -> c
convertFirst forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide
instance CanDiv Rational Integer where
  divide :: Rational -> Integer -> DivType Rational Integer
divide = forall b a c.
ConvertibleExactly b a =>
(a -> a -> c) -> a -> b -> c
convertSecond forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide

instance CanDiv Double Double where
  divide :: Double -> Double -> DivType Double Double
divide = forall a. Fractional a => a -> a -> a
(P./)

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

    instance CanDiv $t Double where
      type DivType $t Double = Double
      divide n d = divide (double n) d
    instance CanDiv Double $t where
      type DivType Double $t = Double
      divide d n = divide d (double n)
  |]))

instance (CanDiv a b) => CanDiv [a] [b] where
  type DivType [a] [b] = [DivType a b]
  divide :: [a] -> [b] -> DivType [a] [b]
divide (a
x:[a]
xs) (b
y:[b]
ys) = (forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide a
x b
y) forall a. a -> [a] -> [a]
: (forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide [a]
xs [b]
ys)
  divide [a]
_ [b]
_ = []

instance (CanDiv a b) => CanDiv (Maybe a) (Maybe b) where
  type DivType (Maybe a) (Maybe b) = Maybe (DivType a b)
  divide :: Maybe a -> Maybe b -> DivType (Maybe a) (Maybe b)
divide (Just a
x) (Just b
y) = forall a. a -> Maybe a
Just (forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide a
x b
y)
  divide Maybe a
_ Maybe b
_ = forall a. Maybe a
Nothing

instance
  (CanDiv a b, CanTestZero b)
  =>
  CanDiv (CN a) (CN  b)
  where
  type DivType (CN a) (CN b) = CN (DivType a b)
  divide :: CN a -> CN b -> DivType (CN a) (CN b)
divide  = forall t2 t1 t3.
CanTestZero t2 =>
(t1 -> t2 -> t3) -> CN t1 -> CN t2 -> CN t3
divideCN forall t1 t2. CanDiv t1 t2 => t1 -> t2 -> DivType t1 t2
divide

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

    instance
      (CanDiv $t b, CanTestZero b)
      =>
      CanDiv $t (CN  b)
      where
      type DivType $t (CN b) = CN (DivType $t b)
      divide a b = divideCN divide (cn a) b

    instance
      (CanDiv a $t)
      =>
      CanDiv (CN a) $t
      where
      type DivType (CN a) $t = CN (DivType a $t)
      divide a b = divideCN divide a (cn b)
  |]))