{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-|
Module:      TextShow.Data.Fixed
Copyright:   (C) 2014-2017 Ryan Scott
License:     BSD-style (see the file LICENSE)
Maintainer:  Ryan Scott
Stability:   Provisional
Portability: GHC

Provides 'TextShow' instance for 'Fixed', as well as the 'showbFixed' function.

/Since: 2/
-}
module TextShow.Data.Fixed (showbFixed) where

import Data.Fixed (Fixed(..), HasResolution(..))
import Data.Int (Int64)
import Data.Semigroup.Compat (mtimesDefault)
import Data.Text.Lazy.Builder (Builder, singleton)

import Prelude ()
import Prelude.Compat

import TextShow.Classes (TextShow(..))
import TextShow.Data.Integral ()
import TextShow.Utils (lengthB)

#if MIN_VERSION_base(4,13,0)
import TextShow.Classes (showbParen)
#endif

-- | Convert a 'Fixed' value to a 'Builder', where the first argument indicates
-- whether to chop off trailing zeroes.
--
-- /Since: 2/
showbFixed :: HasResolution a => Bool -> Fixed a -> Builder
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

-- | Only works for positive 'Integer's.
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

-- | Chops off the trailing zeroes of an 'Integer'.
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

-- | Prepends a dot to a non-empty 'Builder'.
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 #-}

-- | /Since: 2/
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