{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-----------------------------------------------------------------------------
-- |
-- Copyright   :  (c) Edward Kmett 2010-2021
-- License     :  BSD3
-- Maintainer  :  ekmett@gmail.com
-- Stability   :  experimental
-- Portability :  GHC only
--
-- A version of 'Double' that rounds to the twelfth digit if necessary. This
-- is useful for @ad@'s doctests since they must print out floating-point
-- numbers in their entirety, but the actual numbers that get produced can
-- vary slightly depending on machine-specific implementation details.
-- (See #73 for an example.) This works around the issue by just rounding
-- up the printed result to a point where it should be consistent across
-- all machines.
-----------------------------------------------------------------------------
module Numeric.AD.Internal.Doctest (RDouble) where

import GHC.Float
import Numeric

newtype RDouble = RDouble Double
  deriving (Fractional RDouble
RDouble
Fractional RDouble =>
RDouble
-> (RDouble -> RDouble)
-> (RDouble -> RDouble)
-> (RDouble -> RDouble)
-> (RDouble -> RDouble -> RDouble)
-> (RDouble -> RDouble -> RDouble)
-> (RDouble -> RDouble)
-> (RDouble -> RDouble)
-> (RDouble -> RDouble)
-> (RDouble -> RDouble)
-> (RDouble -> RDouble)
-> (RDouble -> RDouble)
-> (RDouble -> RDouble)
-> (RDouble -> RDouble)
-> (RDouble -> RDouble)
-> (RDouble -> RDouble)
-> (RDouble -> RDouble)
-> (RDouble -> RDouble)
-> (RDouble -> RDouble)
-> (RDouble -> RDouble)
-> (RDouble -> RDouble)
-> (RDouble -> RDouble)
-> Floating RDouble
RDouble -> RDouble
RDouble -> RDouble -> RDouble
forall a.
Fractional a =>
a
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> Floating a
$cpi :: RDouble
pi :: RDouble
$cexp :: RDouble -> RDouble
exp :: RDouble -> RDouble
$clog :: RDouble -> RDouble
log :: RDouble -> RDouble
$csqrt :: RDouble -> RDouble
sqrt :: RDouble -> RDouble
$c** :: RDouble -> RDouble -> RDouble
** :: RDouble -> RDouble -> RDouble
$clogBase :: RDouble -> RDouble -> RDouble
logBase :: RDouble -> RDouble -> RDouble
$csin :: RDouble -> RDouble
sin :: RDouble -> RDouble
$ccos :: RDouble -> RDouble
cos :: RDouble -> RDouble
$ctan :: RDouble -> RDouble
tan :: RDouble -> RDouble
$casin :: RDouble -> RDouble
asin :: RDouble -> RDouble
$cacos :: RDouble -> RDouble
acos :: RDouble -> RDouble
$catan :: RDouble -> RDouble
atan :: RDouble -> RDouble
$csinh :: RDouble -> RDouble
sinh :: RDouble -> RDouble
$ccosh :: RDouble -> RDouble
cosh :: RDouble -> RDouble
$ctanh :: RDouble -> RDouble
tanh :: RDouble -> RDouble
$casinh :: RDouble -> RDouble
asinh :: RDouble -> RDouble
$cacosh :: RDouble -> RDouble
acosh :: RDouble -> RDouble
$catanh :: RDouble -> RDouble
atanh :: RDouble -> RDouble
$clog1p :: RDouble -> RDouble
log1p :: RDouble -> RDouble
$cexpm1 :: RDouble -> RDouble
expm1 :: RDouble -> RDouble
$clog1pexp :: RDouble -> RDouble
log1pexp :: RDouble -> RDouble
$clog1mexp :: RDouble -> RDouble
log1mexp :: RDouble -> RDouble
Floating, Num RDouble
Num RDouble =>
(RDouble -> RDouble -> RDouble)
-> (RDouble -> RDouble)
-> (Rational -> RDouble)
-> Fractional RDouble
Rational -> RDouble
RDouble -> RDouble
RDouble -> RDouble -> RDouble
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: RDouble -> RDouble -> RDouble
/ :: RDouble -> RDouble -> RDouble
$crecip :: RDouble -> RDouble
recip :: RDouble -> RDouble
$cfromRational :: Rational -> RDouble
fromRational :: Rational -> RDouble
Fractional, Integer -> RDouble
RDouble -> RDouble
RDouble -> RDouble -> RDouble
(RDouble -> RDouble -> RDouble)
-> (RDouble -> RDouble -> RDouble)
-> (RDouble -> RDouble -> RDouble)
-> (RDouble -> RDouble)
-> (RDouble -> RDouble)
-> (RDouble -> RDouble)
-> (Integer -> RDouble)
-> Num RDouble
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: RDouble -> RDouble -> RDouble
+ :: RDouble -> RDouble -> RDouble
$c- :: RDouble -> RDouble -> RDouble
- :: RDouble -> RDouble -> RDouble
$c* :: RDouble -> RDouble -> RDouble
* :: RDouble -> RDouble -> RDouble
$cnegate :: RDouble -> RDouble
negate :: RDouble -> RDouble
$cabs :: RDouble -> RDouble
abs :: RDouble -> RDouble
$csignum :: RDouble -> RDouble
signum :: RDouble -> RDouble
$cfromInteger :: Integer -> RDouble
fromInteger :: Integer -> RDouble
Num)

instance Show RDouble where
  showsPrec :: Int -> RDouble -> ShowS
showsPrec Int
p (RDouble Double
d)
    | [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
is' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
limit
    = (Double -> ShowS) -> Int -> Double -> ShowS
forall a. RealFloat a => (a -> ShowS) -> Int -> a -> ShowS
showSignedFloat (Maybe Int -> Double -> ShowS
forall a. RealFloat a => Maybe Int -> a -> ShowS
showGFloat (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
limit)) Int
p Double
d
    | Bool
otherwise
    = Int -> Double -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
p Double
d
    where
      limit :: Int
limit = Int
12
      ([Int]
is, Int
e) = Integer -> Double -> ([Int], Int)
forall a. RealFloat a => Integer -> a -> ([Int], Int)
floatToDigits Integer
10 (Double -> Double
forall a. Num a => a -> a
abs Double
d)
      is' :: [Int]
is' = Int -> [Int] -> [Int]
forall a. Int -> [a] -> [a]
drop Int
e [Int]
is