{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Numeric.CollectErrors.PreludeInstances where

import Prelude

import Control.CollectErrors ( CollectErrors(CollectErrors), lift, lift2 )
import Control.CollectErrors.PreludeInstances ( liftGotValue )
import Numeric.CollectErrors.Type

instance (Fractional v, Eq v) => Fractional (CN v) where
  fromRational :: Rational -> CN v
fromRational = v -> CN v
forall (f :: * -> *) a. Applicative f => a -> f a
pure (v -> CN v) -> (Rational -> v) -> Rational -> CN v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> v
forall a. Fractional a => Rational -> a
fromRational
  recip :: CN v -> CN v
recip = (v -> Bool) -> (v -> NumError) -> (v -> v) -> CN v -> CN v
forall a v.
(a -> Bool) -> (a -> NumError) -> (a -> v) -> CN a -> CN v
liftAcheck (v -> v -> Bool
forall a. Eq a => a -> a -> Bool
==v
0) (\v
_ -> NumError
DivByZero) v -> v
forall a. Fractional a => a -> a
recip
  / :: CN v -> CN v -> CN v
(/) = (v -> Bool)
-> (v -> NumError) -> (v -> v -> v) -> CN v -> CN v -> CN v
forall b a v.
(b -> Bool)
-> (b -> NumError) -> (a -> b -> v) -> CN a -> CN b -> CN v
liftA2checkB (v -> v -> Bool
forall a. Eq a => a -> a -> Bool
==v
0) (\v
_ -> NumError
DivByZero) v -> v -> v
forall a. Fractional a => a -> a -> a
(/)

instance (Integral v, Ord v, Show v) => Integral (CN v) where
  quotRem :: CN v -> CN v -> (CN v, CN v)
quotRem (CollectErrors (Just v
a) NumErrors
ae) (CollectErrors (Just v
b) NumErrors
be) 
    | v
b v -> v -> Bool
forall a. Ord a => a -> a -> Bool
<= v
0 = (CN v
forall v. CN v
e,CN v
forall v. CN v
e)
    | Bool
otherwise = (Maybe v -> NumErrors -> CN v
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors (v -> Maybe v
forall a. a -> Maybe a
Just v
q) NumErrors
es, Maybe v -> NumErrors -> CN v
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors (v -> Maybe v
forall a. a -> Maybe a
Just v
r) NumErrors
es)
    where
    (v
q,v
r) = v -> v -> (v, v)
forall a. Integral a => a -> a -> (a, a)
quotRem v
a v
b
    es :: NumErrors
es = NumErrors
ae NumErrors -> NumErrors -> NumErrors
forall a. Semigroup a => a -> a -> a
<> NumErrors
be
    e :: CN v
e = NumError -> CN v
forall v. NumError -> CN v
noValueNumErrorCertain (String -> NumError
OutOfDomain (String -> NumError) -> String -> NumError
forall a b. (a -> b) -> a -> b
$ String
"quotRem with non-positive denominator " String -> String -> String
forall a. [a] -> [a] -> [a]
++ v -> String
forall a. Show a => a -> String
show v
b)
  quotRem (CollectErrors Maybe v
_ NumErrors
ae) (CollectErrors Maybe v
_ NumErrors
be) = (CN v
forall v. CN v
e,CN v
forall v. CN v
e)
    where
    e :: CollectErrors NumErrors v
e = Maybe v -> NumErrors -> CollectErrors NumErrors v
forall es v. Maybe v -> es -> CollectErrors es v
CollectErrors Maybe v
forall a. Maybe a
Nothing (NumErrors
ae NumErrors -> NumErrors -> NumErrors
forall a. Semigroup a => a -> a -> a
<> NumErrors
be)
  toInteger :: CN v -> Integer
toInteger = String -> (v -> Integer) -> CN v -> Integer
forall es t1 t.
CanBeErrors es =>
String -> (t1 -> t) -> CollectErrors es t1 -> t
liftGotValue String
"toInteger" v -> Integer
forall a. Integral a => a -> Integer
toInteger

instance (Floating v, Ord v, Show v) => Floating (CN v) where
  pi :: CN v
pi = v -> CN v
forall (f :: * -> *) a. Applicative f => a -> f a
pure v
forall a. Floating a => a
pi
  exp :: CN v -> CN v
exp = (v -> v) -> CN v -> CN v
forall es a b.
Monoid es =>
(a -> b) -> CollectErrors es a -> CollectErrors es b
lift v -> v
forall a. Floating a => a -> a
exp
  log :: CN v -> CN v
log = String -> (v -> v) -> CN v -> CN v
forall a v.
(Ord a, Num a, Show a) =>
String -> (a -> v) -> CN a -> CN v
liftAcheckPositive String
"log" v -> v
forall a. Floating a => a -> a
log
  sqrt :: CN v -> CN v
sqrt = String -> (v -> v) -> CN v -> CN v
forall a v.
(Ord a, Num a, Show a) =>
String -> (a -> v) -> CN a -> CN v
liftAcheckNonnegative String
"sqrt" v -> v
forall a. Floating a => a -> a
sqrt
  ** :: CN v -> CN v -> CN v
(**) = (v -> v -> v) -> CN v -> CN v -> CN v
forall es a b c.
Monoid es =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
lift2 v -> v -> v
forall a. Floating a => a -> a -> a
(**) -- TODO: domain check
  logBase :: CN v -> CN v -> CN v
logBase = (v -> v -> v) -> CN v -> CN v -> CN v
forall es a b c.
Monoid es =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
lift2 v -> v -> v
forall a. Floating a => a -> a -> a
logBase -- TODO: domain check
  sin :: CN v -> CN v
sin = (v -> v) -> CN v -> CN v
forall es a b.
Monoid es =>
(a -> b) -> CollectErrors es a -> CollectErrors es b
lift v -> v
forall a. Floating a => a -> a
sin
  cos :: CN v -> CN v
cos = (v -> v) -> CN v -> CN v
forall es a b.
Monoid es =>
(a -> b) -> CollectErrors es a -> CollectErrors es b
lift v -> v
forall a. Floating a => a -> a
cos
  asin :: CN v -> CN v
asin = String -> (v -> v) -> CN v -> CN v
forall a v.
(Ord a, Num a, Show a) =>
String -> (a -> v) -> CN a -> CN v
liftAcheckPlusMinusOne String
"asin" v -> v
forall a. Floating a => a -> a
asin
  acos :: CN v -> CN v
acos = String -> (v -> v) -> CN v -> CN v
forall a v.
(Ord a, Num a, Show a) =>
String -> (a -> v) -> CN a -> CN v
liftAcheckPlusMinusOne String
"acos" v -> v
forall a. Floating a => a -> a
acos
  atan :: CN v -> CN v
atan = (v -> v) -> CN v -> CN v
forall es a b.
Monoid es =>
(a -> b) -> CollectErrors es a -> CollectErrors es b
lift v -> v
forall a. Floating a => a -> a
atan
  sinh :: CN v -> CN v
sinh = (v -> v) -> CN v -> CN v
forall es a b.
Monoid es =>
(a -> b) -> CollectErrors es a -> CollectErrors es b
lift v -> v
forall a. Floating a => a -> a
sinh
  cosh :: CN v -> CN v
cosh = (v -> v) -> CN v -> CN v
forall es a b.
Monoid es =>
(a -> b) -> CollectErrors es a -> CollectErrors es b
lift v -> v
forall a. Floating a => a -> a
cosh
  asinh :: CN v -> CN v
asinh = (v -> v) -> CN v -> CN v
forall es a b.
Monoid es =>
(a -> b) -> CollectErrors es a -> CollectErrors es b
lift v -> v
forall a. Floating a => a -> a
asinh
  acosh :: CN v -> CN v
acosh = (v -> v) -> CN v -> CN v
forall es a b.
Monoid es =>
(a -> b) -> CollectErrors es a -> CollectErrors es b
lift v -> v
forall a. Floating a => a -> a
acosh
  atanh :: CN v -> CN v
atanh = (v -> v) -> CN v -> CN v
forall es a b.
Monoid es =>
(a -> b) -> CollectErrors es a -> CollectErrors es b
lift v -> v
forall a. Floating a => a -> a
atanh

liftAcheck :: 
  (a -> Bool) -> 
  (a -> NumError) -> 
  (a -> v) -> CN a -> CN v
liftAcheck :: (a -> Bool) -> (a -> NumError) -> (a -> v) -> CN a -> CN v
liftAcheck a -> Bool
check a -> NumError
err a -> v
_op (CollectErrors (Just a
a) NumErrors
_)
  | a -> Bool
check a
a = NumError -> CN v
forall v. NumError -> CN v
noValueNumErrorCertain (a -> NumError
err a
a)
liftAcheck a -> Bool
_ a -> NumError
_ a -> v
op CN a
aCN = (a -> v) -> CN a -> CN v
forall es a b.
Monoid es =>
(a -> b) -> CollectErrors es a -> CollectErrors es b
lift a -> v
op CN a
aCN

liftAcheckPositive :: (Ord a, Num a, Show a) => String -> (a -> v) -> CN a -> CN v
liftAcheckPositive :: String -> (a -> v) -> CN a -> CN v
liftAcheckPositive String
fnName =
  (a -> Bool) -> (a -> NumError) -> (a -> v) -> CN a -> CN v
forall a v.
(a -> Bool) -> (a -> NumError) -> (a -> v) -> CN a -> CN v
liftAcheck (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<=a
0) (\a
x -> String -> NumError
OutOfDomain (String -> NumError) -> String -> NumError
forall a b. (a -> b) -> a -> b
$ String
fnName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for non-positive arg " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x)

liftAcheckNonnegative :: (Ord a, Num a, Show a) => String -> (a -> v) -> CN a -> CN v
liftAcheckNonnegative :: String -> (a -> v) -> CN a -> CN v
liftAcheckNonnegative String
fnName =
  (a -> Bool) -> (a -> NumError) -> (a -> v) -> CN a -> CN v
forall a v.
(a -> Bool) -> (a -> NumError) -> (a -> v) -> CN a -> CN v
liftAcheck (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
0) (\a
x -> String -> NumError
OutOfDomain (String -> NumError) -> String -> NumError
forall a b. (a -> b) -> a -> b
$ String
fnName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for negative arg " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x)

liftAcheckPlusMinusOne :: (Ord a, Num a, Show a) => String -> (a -> v) -> CN a -> CN v
liftAcheckPlusMinusOne :: String -> (a -> v) -> CN a -> CN v
liftAcheckPlusMinusOne String
fnName =
  (a -> Bool) -> (a -> NumError) -> (a -> v) -> CN a -> CN v
forall a v.
(a -> Bool) -> (a -> NumError) -> (a -> v) -> CN a -> CN v
liftAcheck (\a
x -> -a
1 a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x Bool -> Bool -> Bool
&& a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
1) (\a
x -> String -> NumError
OutOfDomain (String -> NumError) -> String -> NumError
forall a b. (a -> b) -> a -> b
$ String
fnName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" for illegal arg " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x)

liftA2checkB :: 
  (b -> Bool) -> 
  (b -> NumError) -> 
  (a -> b -> v) -> 
  CN a -> CN b -> CN v
liftA2checkB :: (b -> Bool)
-> (b -> NumError) -> (a -> b -> v) -> CN a -> CN b -> CN v
liftA2checkB b -> Bool
checkB b -> NumError
errB a -> b -> v
_op CN a
_a (CollectErrors (Just b
b) NumErrors
_)
  | b -> Bool
checkB b
b = NumError -> CN v
forall v. NumError -> CN v
noValueNumErrorCertain (b -> NumError
errB b
b)
liftA2checkB b -> Bool
_ b -> NumError
_ a -> b -> v
op CN a
a CN b
bCN = (a -> b -> v) -> CN a -> CN b -> CN v
forall es a b c.
Monoid es =>
(a -> b -> c)
-> CollectErrors es a -> CollectErrors es b -> CollectErrors es c
lift2 a -> b -> v
op CN a
a CN b
bCN