{-# OPTIONS_GHC -Wno-orphans #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE StandaloneDeriving #-}
{-|
    Module      :  AERN2.MP.WithCurrentPrec.PreludeInstances
    Description :  WithCurrentPrec instances of Prelude classes
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

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

    WithCurrentPrec instances of Prelude classes
-}
module AERN2.MP.WithCurrentPrec.PreludeInstances
(
    _example1P , _example2P , _example3P
)
where

import Prelude
-- import Text.Printf

import Numeric.CollectErrors (cn, CN)

import GHC.TypeLits

import AERN2.MP.Precision
import AERN2.MP.Ball

import AERN2.MP.WithCurrentPrec.Type

{-
********************************
Instances of Prelude classes
********************************
-}

instance Eq t => Eq (WithCurrentPrec p t) where
    == :: WithCurrentPrec p t -> WithCurrentPrec p t -> Bool
(==) = forall {k} (p1 :: k) (p2 :: k) t1 t2 t3.
(p1 ~ p2) =>
(t1 -> t2 -> t3)
-> WithCurrentPrec p1 t1 -> WithCurrentPrec p2 t2 -> t3
lift2P forall a. Eq a => a -> a -> Bool
(==)
instance Ord t => Ord (WithCurrentPrec p t) where
    compare :: WithCurrentPrec p t -> WithCurrentPrec p t -> Ordering
compare = forall {k} (p1 :: k) (p2 :: k) t1 t2 t3.
(p1 ~ p2) =>
(t1 -> t2 -> t3)
-> WithCurrentPrec p1 t1 -> WithCurrentPrec p2 t2 -> t3
lift2P forall a. Ord a => a -> a -> Ordering
compare

instance 
    (KnownNat p, Num t, ConvertibleWithPrecision Integer t) 
    => 
    Num (WithCurrentPrec p t) 
    where
    fromInteger :: Integer -> WithCurrentPrec p t
fromInteger Integer
n = WithCurrentPrec p t
r
        where   
        r :: WithCurrentPrec p t
r = forall {k} (p :: k) t. t -> WithCurrentPrec p t
WithCurrentPrec forall a b. (a -> b) -> a -> b
$ forall t1 t2.
ConvertibleWithPrecision t1 t2 =>
Precision -> t1 -> t2
convertP (forall (p :: Nat) t. KnownNat p => WithCurrentPrec p t -> Precision
getCurrentPrecision WithCurrentPrec p t
r) Integer
n
    negate :: WithCurrentPrec p t -> WithCurrentPrec p t
negate = forall {k} t1 t2 (p :: k).
(t1 -> t2) -> WithCurrentPrec p t1 -> WithCurrentPrec p t2
lift1 forall a. Num a => a -> a
negate
    abs :: WithCurrentPrec p t -> WithCurrentPrec p t
abs = forall {k} t1 t2 (p :: k).
(t1 -> t2) -> WithCurrentPrec p t1 -> WithCurrentPrec p t2
lift1 forall a. Num a => a -> a
abs
    + :: WithCurrentPrec p t -> WithCurrentPrec p t -> WithCurrentPrec p t
(+) = forall {k} (p1 :: k) (p2 :: k) t1 t2 t3.
(p1 ~ p2) =>
(t1 -> t2 -> t3)
-> WithCurrentPrec p1 t1
-> WithCurrentPrec p2 t2
-> WithCurrentPrec p1 t3
lift2 forall a. Num a => a -> a -> a
(+)
    * :: WithCurrentPrec p t -> WithCurrentPrec p t -> WithCurrentPrec p t
(*) = forall {k} (p1 :: k) (p2 :: k) t1 t2 t3.
(p1 ~ p2) =>
(t1 -> t2 -> t3)
-> WithCurrentPrec p1 t1
-> WithCurrentPrec p2 t2
-> WithCurrentPrec p1 t3
lift2 forall a. Num a => a -> a -> a
(*)
    signum :: WithCurrentPrec p t -> WithCurrentPrec p t
signum = forall {k} t1 t2 (p :: k).
(t1 -> t2) -> WithCurrentPrec p t1 -> WithCurrentPrec p t2
lift1 forall a. Num a => a -> a
signum

instance 
    (KnownNat p, Fractional t
    , ConvertibleWithPrecision Integer t, ConvertibleWithPrecision Rational t) 
    => 
    Fractional (WithCurrentPrec p t) 
    where
    fromRational :: Rational -> WithCurrentPrec p t
fromRational Rational
q = WithCurrentPrec p t
r
        where   
        r :: WithCurrentPrec p t
r = forall {k} (p :: k) t. t -> WithCurrentPrec p t
WithCurrentPrec forall a b. (a -> b) -> a -> b
$ forall t1 t2.
ConvertibleWithPrecision t1 t2 =>
Precision -> t1 -> t2
convertP (forall (p :: Nat) t. KnownNat p => WithCurrentPrec p t -> Precision
getCurrentPrecision WithCurrentPrec p t
r) Rational
q
    recip :: WithCurrentPrec p t -> WithCurrentPrec p t
recip = forall {k} t1 t2 (p :: k).
(t1 -> t2) -> WithCurrentPrec p t1 -> WithCurrentPrec p t2
lift1 forall a. Fractional a => a -> a
recip
    / :: WithCurrentPrec p t -> WithCurrentPrec p t -> WithCurrentPrec p t
(/) = forall {k} (p1 :: k) (p2 :: k) t1 t2 t3.
(p1 ~ p2) =>
(t1 -> t2 -> t3)
-> WithCurrentPrec p1 t1
-> WithCurrentPrec p2 t2
-> WithCurrentPrec p1 t3
lift2 forall a. Fractional a => a -> a -> a
(/)

instance (KnownNat p) => Floating (WithCurrentPrec p (CN MPBall)) where
    pi :: WithCurrentPrec p (CN MPBall)
pi = WithCurrentPrec p (CN MPBall)
r 
        where
        r :: WithCurrentPrec p (CN MPBall)
r = forall {k} (p :: k) t. t -> WithCurrentPrec p t
WithCurrentPrec forall a b. (a -> b) -> a -> b
$ forall v. v -> CN v
cn forall a b. (a -> b) -> a -> b
$ Precision -> MPBall
piBallP (forall (p :: Nat) t. KnownNat p => WithCurrentPrec p t -> Precision
getCurrentPrecision WithCurrentPrec p (CN MPBall)
r)
    sqrt :: WithCurrentPrec p (CN MPBall) -> WithCurrentPrec p (CN MPBall)
sqrt = forall {k} t1 t2 (p :: k).
(t1 -> t2) -> WithCurrentPrec p t1 -> WithCurrentPrec p t2
lift1 forall a. Floating a => a -> a
sqrt
    exp :: WithCurrentPrec p (CN MPBall) -> WithCurrentPrec p (CN MPBall)
exp = forall {k} t1 t2 (p :: k).
(t1 -> t2) -> WithCurrentPrec p t1 -> WithCurrentPrec p t2
lift1 forall a. Floating a => a -> a
exp
    log :: WithCurrentPrec p (CN MPBall) -> WithCurrentPrec p (CN MPBall)
log = forall {k} t1 t2 (p :: k).
(t1 -> t2) -> WithCurrentPrec p t1 -> WithCurrentPrec p t2
lift1 forall a. Floating a => a -> a
log
    sin :: WithCurrentPrec p (CN MPBall) -> WithCurrentPrec p (CN MPBall)
sin = forall {k} t1 t2 (p :: k).
(t1 -> t2) -> WithCurrentPrec p t1 -> WithCurrentPrec p t2
lift1 forall a. Floating a => a -> a
sin
    cos :: WithCurrentPrec p (CN MPBall) -> WithCurrentPrec p (CN MPBall)
cos = forall {k} t1 t2 (p :: k).
(t1 -> t2) -> WithCurrentPrec p t1 -> WithCurrentPrec p t2
lift1 forall a. Floating a => a -> a
cos
    asin :: WithCurrentPrec p (CN MPBall) -> WithCurrentPrec p (CN MPBall)
asin = forall {k} t1 t2 (p :: k).
(t1 -> t2) -> WithCurrentPrec p t1 -> WithCurrentPrec p t2
lift1 forall a. Floating a => a -> a
asin
    acos :: WithCurrentPrec p (CN MPBall) -> WithCurrentPrec p (CN MPBall)
acos = forall {k} t1 t2 (p :: k).
(t1 -> t2) -> WithCurrentPrec p t1 -> WithCurrentPrec p t2
lift1 forall a. Floating a => a -> a
acos
    atan :: WithCurrentPrec p (CN MPBall) -> WithCurrentPrec p (CN MPBall)
atan = forall {k} t1 t2 (p :: k).
(t1 -> t2) -> WithCurrentPrec p t1 -> WithCurrentPrec p t2
lift1 forall a. Floating a => a -> a
atan
    sinh :: WithCurrentPrec p (CN MPBall) -> WithCurrentPrec p (CN MPBall)
sinh = forall {k} t1 t2 (p :: k).
(t1 -> t2) -> WithCurrentPrec p t1 -> WithCurrentPrec p t2
lift1 forall a. Floating a => a -> a
sinh
    cosh :: WithCurrentPrec p (CN MPBall) -> WithCurrentPrec p (CN MPBall)
cosh = forall {k} t1 t2 (p :: k).
(t1 -> t2) -> WithCurrentPrec p t1 -> WithCurrentPrec p t2
lift1 forall a. Floating a => a -> a
cosh
    asinh :: WithCurrentPrec p (CN MPBall) -> WithCurrentPrec p (CN MPBall)
asinh = forall {k} t1 t2 (p :: k).
(t1 -> t2) -> WithCurrentPrec p t1 -> WithCurrentPrec p t2
lift1 forall a. Floating a => a -> a
asinh
    acosh :: WithCurrentPrec p (CN MPBall) -> WithCurrentPrec p (CN MPBall)
acosh = forall {k} t1 t2 (p :: k).
(t1 -> t2) -> WithCurrentPrec p t1 -> WithCurrentPrec p t2
lift1 forall a. Floating a => a -> a
acosh
    atanh :: WithCurrentPrec p (CN MPBall) -> WithCurrentPrec p (CN MPBall)
atanh = forall {k} t1 t2 (p :: k).
(t1 -> t2) -> WithCurrentPrec p t1 -> WithCurrentPrec p t2
lift1 forall a. Floating a => a -> a
atanh

_example1P :: CN MPBall
_example1P :: CN MPBall
_example1P = forall t.
Precision
-> (forall (p :: Nat). KnownNat p => WithCurrentPrec p t) -> t
runWithPrec (Integer -> Precision
prec Integer
1000) forall a. Floating a => a
pi

_example2P :: CN MPBall
_example2P :: CN MPBall
_example2P = forall t.
Precision
-> (forall (p :: Nat). KnownNat p => WithCurrentPrec p t) -> t
runWithPrec (Integer -> Precision
prec Integer
1000) forall a b. (a -> b) -> a -> b
$ forall a. Floating a => a
pi forall a. Num a => a -> a -> a
- forall a. Floating a => a
pi

_example3P :: CN MPBall
_example3P :: CN MPBall
_example3P = forall t.
Precision
-> (forall (p :: Nat). KnownNat p => WithCurrentPrec p t) -> t
runWithPrec (Integer -> Precision
prec Integer
1000) forall a b. (a -> b) -> a -> b
$ forall a. Floating a => a -> a
sqrt WithCurrentPrec p (CN MPBall)
2