{-# 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 (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

-- | 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
#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)
-- | 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 #-}
#endif

-- | /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