{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module TextShow.Data.Fixed (showbFixed) where
import Data.Fixed (HasResolution(..))
import Data.Text.Lazy.Builder (Builder)
import Prelude ()
import Prelude.Compat
import TextShow.Classes (TextShow(..))
#if MIN_VERSION_base(4,7,0)
import Data.Fixed (Fixed(..))
import Data.Int (Int64)
import Data.Semigroup.Compat (mtimesDefault)
import Data.Text.Lazy.Builder (singleton)
import TextShow.Data.Integral ()
import TextShow.Utils (lengthB)
#else
import Data.Fixed (Fixed, showFixed)
import Data.Text.Lazy.Builder (fromString)
#endif
#if MIN_VERSION_base(4,13,0)
import TextShow.Classes (showbParen)
#endif
showbFixed :: HasResolution a => Bool -> Fixed a -> Builder
#if MIN_VERSION_base(4,7,0)
showbFixed :: Bool -> Fixed a -> Builder
showbFixed Bool
chopTrailingZeroes fa :: Fixed a
fa@(MkFixed Integer
a) | Integer
a Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
= Char -> Builder
singleton Char
'-' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> Fixed a -> Builder
forall a. HasResolution a => Bool -> Fixed a -> Builder
showbFixed Bool
chopTrailingZeroes (Fixed a -> Fixed a -> Fixed a
forall a. a -> a -> a
asTypeOf (Integer -> Fixed a
forall k (a :: k). Integer -> Fixed a
MkFixed (Integer -> Integer
forall a. Num a => a -> a
negate Integer
a)) Fixed a
fa)
showbFixed Bool
chopTrailingZeroes fa :: Fixed a
fa@(MkFixed Integer
a)
= Integer -> Builder
forall a. TextShow a => a -> Builder
showb Integer
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
withDotB (Bool -> Int64 -> Integer -> Builder
showbIntegerZeroes Bool
chopTrailingZeroes Int64
digits Integer
fracNum)
where
res :: Integer
res = Integer -> Integer
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Fixed a -> Integer
forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
resolution Fixed a
fa
(Integer
i, Integer
d) = Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod (Integer -> Integer
forall a. Num a => Integer -> a
fromInteger Integer
a) Integer
res
digits :: Int64
digits = Double -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Double -> Double
forall a. Floating a => a -> a -> a
logBase Double
10 (Integer -> Double
forall a. Num a => Integer -> a
fromInteger (Integer -> Double) -> Integer -> Double
forall a b. (a -> b) -> a -> b
$ Fixed a -> Integer
forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
resolution Fixed a
fa) :: Double)
maxnum :: Integer
maxnum = Integer
10 Integer -> Int64 -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int64
digits
# if MIN_VERSION_base(4,8,0)
fracNum :: Integer
fracNum = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
divCeil (Integer
d Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
maxnum) Integer
res
divCeil :: a -> a -> a
divCeil a
x a
y = (a
x a -> a -> a
forall a. Num a => a -> a -> a
+ a
y a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
y
# else
fracNum = div (d * maxnum) res
# endif
#else
showbFixed chopTrailingZeroes = fromString . showFixed chopTrailingZeroes
{-# INLINE showbFixed #-}
#endif
#if MIN_VERSION_base(4,7,0)
showbIntegerZeroes :: Bool -> Int64 -> Integer -> Builder
showbIntegerZeroes :: Bool -> Int64 -> Integer -> Builder
showbIntegerZeroes Bool
True Int64
_ Integer
0 = Builder
forall a. Monoid a => a
mempty
showbIntegerZeroes Bool
chopTrailingZeroes Int64
digits Integer
a
= Int64 -> Builder -> Builder
forall b a. (Integral b, Monoid a) => b -> a -> a
mtimesDefault (Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max Int64
0 (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ Int64
digits Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Builder -> Int64
lengthB Builder
sh) (Char -> Builder
singleton Char
'0') Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
sh'
where
sh, sh' :: Builder
sh :: Builder
sh = Integer -> Builder
forall a. TextShow a => a -> Builder
showb Integer
a
sh' :: Builder
sh' = if Bool
chopTrailingZeroes then Integer -> Builder
chopZeroesB Integer
a else Builder
sh
chopZeroesB :: Integer -> Builder
chopZeroesB :: Integer -> Builder
chopZeroesB Integer
0 = Builder
forall a. Monoid a => a
mempty
chopZeroesB Integer
a | Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod Integer
a Integer
10 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 = Integer -> Builder
chopZeroesB (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
div Integer
a Integer
10)
chopZeroesB Integer
a = Integer -> Builder
forall a. TextShow a => a -> Builder
showb Integer
a
withDotB :: Builder -> Builder
withDotB :: Builder -> Builder
withDotB Builder
b | Builder
b Builder -> Builder -> Bool
forall a. Eq a => a -> a -> Bool
== Builder
forall a. Monoid a => a
mempty = Builder
forall a. Monoid a => a
mempty
| Bool
otherwise = Char -> Builder
singleton Char
'.' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
b
{-# INLINE withDotB #-}
#endif
instance HasResolution a => TextShow (Fixed a) where
#if MIN_VERSION_base(4,13,0)
showbPrec :: Int -> Fixed a -> Builder
showbPrec Int
p Fixed a
n = Bool -> Builder -> Builder
showbParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
6 Bool -> Bool -> Bool
&& Fixed a
n Fixed a -> Fixed a -> Bool
forall a. Ord a => a -> a -> Bool
< Fixed a
0) (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Bool -> Fixed a -> Builder
forall a. HasResolution a => Bool -> Fixed a -> Builder
showbFixed Bool
False Fixed a
n
#else
showb = showbFixed False
{-# INLINE showb #-}
#endif