{-# 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 :: forall a. HasResolution a => Bool -> Fixed a -> Builder
showbFixed Bool
chopTrailingZeroes fa :: Fixed a
fa@(MkFixed Integer
a) | Integer
a forall a. Ord a => a -> a -> Bool
< Integer
0
    = Char -> Builder
singleton Char
'-' forall a. Semigroup a => a -> a -> a
<> forall a. HasResolution a => Bool -> Fixed a -> Builder
showbFixed Bool
chopTrailingZeroes (forall a. a -> a -> a
asTypeOf (forall k (a :: k). Integer -> Fixed a
MkFixed (forall a. Num a => a -> a
negate Integer
a)) Fixed a
fa)
showbFixed Bool
chopTrailingZeroes fa :: Fixed a
fa@(MkFixed Integer
a)
    = forall a. TextShow a => a -> Builder
showb Integer
i 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     = forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
resolution Fixed a
fa
    (Integer
i, Integer
d)  = forall a. Integral a => a -> a -> (a, a)
divMod (forall a. Num a => Integer -> a
fromInteger Integer
a) Integer
res
    digits :: Int64
digits  = forall a b. (RealFrac a, Integral b) => a -> b
ceiling (forall a. Floating a => a -> a -> a
logBase Double
10 (forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
resolution Fixed a
fa) :: Double)
    maxnum :: Integer
maxnum  = Integer
10 forall a b. (Num a, Integral b) => a -> b -> a
^ Int64
digits
#if MIN_VERSION_base(4,8,0)
    fracNum :: Integer
fracNum = forall {a}. Integral a => a -> a -> a
divCeil (Integer
d forall a. Num a => a -> a -> a
* Integer
maxnum) Integer
res
    divCeil :: a -> a -> a
divCeil a
x a
y = (a
x forall a. Num a => a -> a -> a
+ a
y forall a. Num a => a -> a -> a
- a
1) 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 = forall a. Monoid a => a
mempty
showbIntegerZeroes Bool
chopTrailingZeroes Int64
digits Integer
a
    = forall b a. (Integral b, Monoid a) => b -> a -> a
mtimesDefault (forall a. Ord a => a -> a -> a
max Int64
0 forall a b. (a -> b) -> a -> b
$ Int64
digits forall a. Num a => a -> a -> a
- Builder -> Int64
lengthB Builder
sh) (Char -> Builder
singleton Char
'0') forall a. Semigroup a => a -> a -> a
<> Builder
sh'
  where
    sh, sh' :: Builder
    sh :: Builder
sh  = 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 = forall a. Monoid a => a
mempty
chopZeroesB Integer
a | forall {a}. Integral a => a -> a -> a
mod Integer
a Integer
10 forall a. Eq a => a -> a -> Bool
== Integer
0 = Integer -> Builder
chopZeroesB (forall {a}. Integral a => a -> a -> a
div Integer
a Integer
10)
chopZeroesB Integer
a = 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 forall a. Eq a => a -> a -> Bool
== forall a. Monoid a => a
mempty = forall a. Monoid a => a
mempty
           | Bool
otherwise   = Char -> Builder
singleton Char
'.' 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 forall a. Ord a => a -> a -> Bool
> Int
6 Bool -> Bool -> Bool
&& Fixed a
n forall a. Ord a => a -> a -> Bool
< Fixed a
0) forall a b. (a -> b) -> a -> b
$ forall a. HasResolution a => Bool -> Fixed a -> Builder
showbFixed Bool
False Fixed a
n
#else
    showb = showbFixed False
    {-# INLINE showb #-}
#endif