    {-# 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 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
    forall (p :: * -> *). 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 b. Integral b => Double -> b
    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
    forall (p :: * -> *). 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