content: {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE CPP #-}
  
  
  module Fmt.Internal.Numeric where
  
  
  import           Data.CallStack
  #if __GLASGOW_HASKELL__ < 804
  import           Data.Monoid ((<>))
  #endif
  import           Numeric
  import           Data.Char
  import           Data.Text.Lazy.Builder hiding (fromString)
  import           Formatting.Buildable (Buildable(..))
  import qualified Formatting.Internal.Raw as F
  import qualified Data.Text.Lazy as TL
  
  
  -- $setup
  -- >>> import Fmt
  
  ----------------------------------------------------------------------------
  -- Integer
  ----------------------------------------------------------------------------
  
  {- |
  Format a number as octal:
  
  >>> listF' octF [7,8,9,10]
  "[7, 10, 11, 12]"
  -}
  octF :: Integral a => a -> Builder
  octF = baseF 8
  
  {- |
  Format a number as binary:
  
  >>> listF' binF [7,8,9,10]
  "[111, 1000, 1001, 1010]"
  -}
  binF :: Integral a => a -> Builder
  binF = baseF 2
  
  {- |
  Format a number in arbitrary base (up to 36):
  
  >>> baseF 3 10000
  "111201101"
  >>> baseF 7 10000
  "41104"
  >>> baseF 36 10000
  "7ps"
  -}
  baseF :: (HasCallStack, Integral a) => Int -> a -> Builder
  baseF numBase = build . atBase numBase
  
  ----------------------------------------------------------------------------
  -- Floating-point
  ----------------------------------------------------------------------------
  
  {- |
  Format a floating-point number:
  
  >>> floatF 3.1415
  "3.1415"
  
  Numbers smaller than 1e-6 or bigger-or-equal to 1e21 will be displayed using
  scientific notation:
  
  >>> listF' floatF [-1.2,-12.2]
  "[-1.2, -12.2]"
  >>> listF' floatF [1e-6,9e-7]
  "[0.000001, 9.0e-7]"
  >>> listF' floatF [9e20,1e21]
  "[900000000000000000000.0, 1.0e21]"
  -}
  floatF :: Real a => a -> Builder
  floatF a | d < 0                 = "-" <> floatF (-d)
           | d < 1e-6 || d >= 1e21 = build $ showEFloat Nothing d ""
           | otherwise             = build $ showFFloat Nothing d ""
    where d = realToFrac a :: Double
  
  {- | Format a floating-point number using scientific notation, with the given
  amount of decimal places.
  
  >>> listF' (exptF 5) [pi,0.1,10]
  "[3.14159e0, 1.00000e-1, 1.00000e1]"
  -}
  exptF :: Real a => Int -> a -> Builder
  exptF decs a = build $ showEFloat (Just decs) (realToFrac a :: Double) ""
  
  {- |
  Format a floating-point number without scientific notation:
  
  >>> listF' (fixedF 5) [pi,0.1,10]
  "[3.14159, 0.10000, 10.00000]"
  -}
  fixedF :: Real a => Int -> a -> Builder
  fixedF = F.fixed
  
  ----------------------------------------------------------------------------
  -- Other
  ----------------------------------------------------------------------------
  
  {- |
  Break digits in a number:
  
  >>> commaizeF 15830000
  "15,830,000"
  -}
  commaizeF :: (Buildable a, Integral a) => a -> Builder
  commaizeF = groupInt 3 ','
  
  {- |
  Add an ordinal suffix to a number:
  
  >>> ordinalF 15
  "15th"
  >>> ordinalF 22
  "22nd"
  -}
  ordinalF :: (Buildable a, Integral a) => a -> Builder
  ordinalF n
    | tens > 3 && tens < 21 = build n <> "th"
    | otherwise = build n <> case n `mod` 10 of
                               1 -> "st"
                               2 -> "nd"
                               3 -> "rd"
                               _ -> "th"
    where
      tens = n `mod` 100
  
  ----------------------------------------------------------------------------
  -- Helpers
  ----------------------------------------------------------------------------
  
  groupInt :: (Buildable a, Integral a) => Int -> Char -> a -> Builder
  groupInt 0 _ n = build n
  groupInt i c n =
      fromLazyText . TL.reverse .
      foldr merge "" .
      TL.zip (zeros <> cycle' zeros') .
      TL.reverse .
      toLazyText . build
        $ n
    where
      zeros = TL.replicate (fromIntegral i) (TL.singleton '0')
      zeros' = TL.singleton c <> TL.tail zeros
      merge (f, c') rest
        | f == c = TL.singleton c <> TL.singleton c' <> rest
        | otherwise = TL.singleton c' <> rest
      cycle' xs = xs <> cycle' xs
      -- Suppress the warning about redundant Integral constraint
      _ = toInteger n
  
  atBase :: Integral a => Int -> a -> String
  atBase b _ | b < 2 || b > 36 = error ("baseF: Invalid base " ++ show b)
  atBase b n =
    showSigned' (showIntAtBase (toInteger b) intToDigit') (toInteger n) ""
  {-# INLINE atBase #-}
  
  showSigned' :: Real a => (a -> ShowS) -> a -> ShowS
  showSigned' f n
    | n < 0     = showChar '-' . f (negate n)
    | otherwise = f n
  
  intToDigit' :: Int -> Char
  intToDigit' i
    | i >= 0  && i < 10 = chr (ord '0' + i)
    | i >= 10 && i < 36 = chr (ord 'a' + i - 10)
    | otherwise = error ("intToDigit': Invalid int " ++ show i)
  