    {-# LANGUAGE OverloadedStrings, Safe #-}

    module Data.Text.Lazy.Builder.Scientific
        ( scientificBuilder
        , formatScientificBuilder
        , FPFormat(..)
        ) where

    import           Data.Scientific   (Scientific)
    import qualified Data.Scientific as Scientific

    import Data.Text.Lazy.Builder.RealFloat (FPFormat(..))

    import Data.Text.Lazy.Builder       (Builder, fromString, singleton, fromText)
    import Data.Text.Lazy.Builder.Int   (decimal)
    import qualified Data.Text as T     (replicate)
    import Utils (roundTo, i2d)

    import Data.Monoid                  ((<>))

    -- | A @Text@ @Builder@ which renders a scientific number to full
    -- precision, using standard decimal notation for arguments whose
    -- absolute value lies between @0.1@ and @9,999,999@, and scientific
    -- notation otherwise.
    scientificBuilder :: Scientific -> Builder
    scientificBuilder :: Scientific -> Builder
    scientificBuilder = FPFormat -> Maybe Int -> Scientific -> Builder
    formatScientificBuilder FPFormat
    Generic Maybe Int
    forall a. Maybe a
    Nothing

    -- | Like 'scientificBuilder' but provides rendering options.
    formatScientificBuilder :: FPFormat
                            -> Maybe Int  -- ^ Number of decimal places to render.
                            -> Scientific
                            -> Builder
    formatScientificBuilder :: FPFormat -> Maybe Int -> Scientific -> Builder
    formatScientificBuilder FPFormat
    fmt Maybe Int
    decs Scientific
    scntfc
       | Scientific
    scntfc Scientific -> Scientific -> Bool
    forall a. Ord a => a -> a -> Bool
    < Scientific
    0 = Char -> Builder
    singleton Char
    '-' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> FPFormat -> ([Int], Int) -> Builder
    doFmt FPFormat
    fmt (Scientific -> ([Int], Int)
    Scientific.toDecimalDigits (-Scientific
    scntfc))
       | Bool
    otherwise  =                  FPFormat -> ([Int], Int) -> Builder
    doFmt FPFormat
    fmt (Scientific -> ([Int], Int)
    Scientific.toDecimalDigits   Scientific
    scntfc)
     where
      doFmt :: FPFormat -> ([Int], Int) -> Builder
    doFmt FPFormat
    format ([Int]
    is, Int
    e) =
        let ds :: [Char]
    ds = (Int -> Char) -> [Int] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> Char
    i2d [Int]
    is in
        case FPFormat
    format of
         FPFormat
    Generic ->
          FPFormat -> ([Int], Int) -> Builder
    doFmt (if Int
    e Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0 Bool -> Bool -> Bool
    || Int
    e Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    7 then FPFormat
    Exponent else FPFormat
    Fixed)
                ([Int]
    is,Int
    e)
         FPFormat
    Exponent ->
          case Maybe Int
    decs of
           Maybe Int
    Nothing ->
            let show_e' :: Builder
    show_e' = Int -> Builder
    forall a. Integral a => a -> Builder
    decimal (Int
    eInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) in
            case [Char]
    ds of
              [Char]
    "0"     -> Builder
    "0.0e0"
              [Char
    d]     -> Char -> Builder
    singleton Char
    d Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    ".0e" Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    show_e'
              (Char
    d:[Char]
    ds') -> Char -> Builder
    singleton Char
    d Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    singleton Char
    '.' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> [Char] -> Builder
    fromString [Char]
    ds' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    singleton Char
    'e' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    show_e'
              []      -> [Char] -> Builder
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Builder) -> [Char] -> Builder
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Data.Text.Lazy.Builder.Scientific.formatScientificBuilder" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                                 [Char]
    "/doFmt/Exponent: []"
           Just Int
    dec ->
            let dec' :: Int
    dec' = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    dec Int
    1 in
            case [Int]
    is of
             [Int
    0] -> Builder
    "0." Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Builder
    fromText (Int -> Text -> Text
    T.replicate Int
    dec' Text
    "0") Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    "e0"
             [Int]
    _ ->
              let
               (Int
    ei,[Int]
    is') = Int -> [Int] -> (Int, [Int])
    roundTo (Int
    dec'Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) [Int]
    is
               (Char
    d:[Char]
    ds') = (Int -> Char) -> [Int] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> Char
    i2d (if Int
    ei Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 then [Int] -> [Int]
    forall a. HasCallStack => [a] -> [a]
    init [Int]
    is' else [Int]
    is')
              in
              Char -> Builder
    singleton Char
    d Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    singleton Char
    '.' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> [Char] -> Builder
    fromString [Char]
    ds' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    singleton Char
    'e' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Int -> Builder
    forall a. Integral a => a -> Builder
    decimal (Int
    eInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    ei)
         FPFormat
    Fixed ->
          let
           mk0 :: [Char] -> Builder
    mk0 [Char]
    ls = case [Char]
    ls of { [Char]
    "" -> Builder
    "0" ; [Char]
    _ -> [Char] -> Builder
    fromString [Char]
    ls}
          in
          case Maybe Int
    decs of
           Maybe Int
    Nothing
              | Int
    e Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0    -> Builder
    "0." Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Text -> Builder
    fromText (Int -> Text -> Text
    T.replicate (-Int
    e) Text
    "0") Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> [Char] -> Builder
    fromString [Char]
    ds
              | Bool
    otherwise ->
                 let
                    f :: t -> [Char] -> [Char] -> Builder
    f t
    0 [Char]
    s    [Char]
    rs  = [Char] -> Builder
    mk0 ([Char] -> [Char]
    forall a. [a] -> [a]
    reverse [Char]
    s) Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Char -> Builder
    singleton Char
    '.' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> [Char] -> Builder
    mk0 [Char]
    rs
                    f t
    n [Char]
    s    [Char]
    ""  = t -> [Char] -> [Char] -> Builder
    f (t
    nt -> t -> t
    forall a. Num a => a -> a -> a
    -t
    1) (Char
    '0'Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    :[Char]
    s) [Char]
    ""
                    f t
    n [Char]
    s (Char
    r:[Char]
    rs) = t -> [Char] -> [Char] -> Builder
    f (t
    nt -> t -> t
    forall a. Num a => a -> a -> a
    -t
    1) (Char
    rChar -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    :[Char]
    s) [Char]
    rs
                 in
                    Int -> [Char] -> [Char] -> Builder
    forall {t}. (Eq t, Num t) => t -> [Char] -> [Char] -> Builder
    f Int
    e [Char]
    "" [Char]
    ds
           Just Int
    dec ->
            let dec' :: Int
    dec' = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    dec Int
    0 in
            if Int
    e Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0 then
             let
              (Int
    ei,[Int]
    is') = Int -> [Int] -> (Int, [Int])
    roundTo (Int
    dec' Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    e) [Int]
    is
              ([Char]
    ls,[Char]
    rs)  = Int -> [Char] -> ([Char], [Char])
    forall a. Int -> [a] -> ([a], [a])
    splitAt (Int
    eInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    ei) ((Int -> Char) -> [Int] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> Char
    i2d [Int]
    is')
             in
             [Char] -> Builder
    mk0 [Char]
    ls Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> (if [Char] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Char]
    rs then Builder
    "" else Char -> Builder
    singleton Char
    '.' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> [Char] -> Builder
    fromString [Char]
    rs)
            else
             let
              (Int
    ei,[Int]
    is') = Int -> [Int] -> (Int, [Int])
    roundTo Int
    dec' (Int -> Int -> [Int]
    forall a. Int -> a -> [a]
    replicate (-Int
    e) Int
    0 [Int] -> [Int] -> [Int]
    forall a. [a] -> [a] -> [a]
    ++ [Int]
    is)
              Char
    d:[Char]
    ds' = (Int -> Char) -> [Int] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Int -> Char
    i2d (if Int
    ei Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0 then [Int]
    is' else Int
    0Int -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    :[Int]
    is')
             in
             Char -> Builder
    singleton Char
    d Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> (if [Char] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Char]
    ds' then Builder
    "" else Char -> Builder
    singleton Char
    '.' Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> [Char] -> Builder
    fromString [Char]
    ds')