{-# LANGUAGE CPP #-}
{-|
    Module      :  Numeric.CatchingExceptions.Num
    Description :  CatchingExceptions instances of Num etc
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

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

    CatchingExceptions instances of Num etc.
-}
module Numeric.CatchingExceptions.Num
(
)
where

import Prelude
import Text.Printf

import Control.Lens

import qualified Data.Set as Set

import Numeric.CatchingExceptions.Type
import Numeric.CatchingExceptions.Lifts

instance (Eq t, Show t) => Eq (CatchingNumExceptions t) where
  c1 == c2 =
    case liftCCtoO (==) c1 c2 of
      Just res -> res
      _ -> error $ printf "error computing values for comparison: %s == %s" (show c1) (show c2)
  c1 /= c2 =
    case liftCCtoO (/=) c1 c2 of
      Just res -> res
      _ -> error $ printf "error computing values for comparison: %s /= %s" (show c1) (show c2)

instance (Ord t, Show t) => Ord (CatchingNumExceptions t) where
  compare c1 c2 =
    case liftCCtoO compare c1 c2 of
      Just res -> res
      _ -> error $ printf "error computing values for comparison: %s >=< %s" (show c1) (show c2)

instance (Num t, CanTestValid t, Show t) => Num (CatchingNumExceptions t) where
  fromInteger = catchingNumExceptions . fromInteger
  signum = liftCtoC signum
  abs = liftCtoC abs
  negate = liftCtoC negate
  (+) = liftCCtoC (+)
  (*) = liftCCtoC (*)

testNonZero ::
    (Eq t, Num t) =>
    t -> Maybe (Set.Set NumericalException, Set.Set NumericalException)
testNonZero b
  | b == 0 = Just (Set.empty, Set.singleton DivByZero) -- certain error
  | otherwise = Nothing

instance
  (Fractional t, Eq t, CanTestValid t, Show t)
  =>
  Fractional (CatchingNumExceptions t)
  where
  fromRational = catchingNumExceptions . fromRational
  (/) = liftCCtoCwithTest (\ _a b -> testNonZero b) (/)

testPositive ::
    (Ord t, Num t) =>
    t -> Maybe (Set.Set NumericalException, Set.Set NumericalException)
testPositive b
  | b <= 0 = Just (Set.empty, Set.singleton $ OutOfRange "not positive") -- certain error
  | otherwise = Nothing

testNonNegative ::
    (Ord t, Num t) =>
    t -> Maybe (Set.Set NumericalException, Set.Set NumericalException)
testNonNegative b
  | b < 0 = Just (Set.empty, Set.singleton $ OutOfRange "not non-negative") -- certain error
  | otherwise = Nothing

testInUnit ::
    (Ord t, Num t) =>
    t -> Maybe (Set.Set NumericalException, Set.Set NumericalException)
testInUnit b
  | b < -1 || b > 1 = Just (Set.empty, Set.singleton $ OutOfRange "[-1,1]") -- certain error
  | otherwise = Nothing

instance
  (Floating t, Ord t, Eq t, CanTestValid t, Show t)
  =>
  Floating (CatchingNumExceptions t)
  where
  pi = catchingNumExceptions pi
  sqrt = liftCtoCwithTest testNonNegative sqrt
  exp = liftCtoC exp
  log = liftCtoCwithTest testPositive log
  sin = liftCtoC sin
  cos = liftCtoC cos
  asin = liftCtoCwithTest testInUnit asin
  acos = liftCtoCwithTest testInUnit acos
  atan = liftCtoC atan
  sinh = liftCtoC sinh
  cosh = liftCtoC cosh
  asinh = liftCtoC asinh
  acosh = liftCtoC acosh
  atanh = liftCtoCwithTest testInUnit atanh

instance
  (Real t, CanTestValid t, Show t)
  =>
  Real (CatchingNumExceptions t)
  where
  toRational c =
    case c ^. numEXC_maybeValue of
      Just v -> toRational v
      _ -> error $ printf "error computing argument of toRational: %s" (show c)

instance
  (RealFrac t, CanTestValid t, Show t)
  =>
  RealFrac (CatchingNumExceptions t)
  where
  properFraction c =
    case c ^. numEXC_maybeValue of
      Just v ->
        let (n,r) = properFraction v
        in (n, c & numEXC_maybeValue .~ Just r )
      _ -> error $ printf "error computing argument of properFraction: %s" (show c)
