module Text.Builder
(
  Builder,
  -- * Accessors
  run,
  length,
  null,
  -- ** Output IO
  putToStdOut,
  putToStdErr,
  putLnToStdOut,
  putLnToStdErr,
  -- * Constructors
  -- ** Builder manipulators
  intercalate,
  padFromLeft,
  padFromRight,
  -- ** Textual
  text,
  string,
  asciiByteString,
  -- ** Character
  char,
  -- *** Low-level character
  unicodeCodePoint,
  utf16CodeUnits1,
  utf16CodeUnits2,
  utf8CodeUnits1,
  utf8CodeUnits2,
  utf8CodeUnits3,
  utf8CodeUnits4,
  -- ** Integers
  -- *** Decimal
  decimal,
  unsignedDecimal,
  thousandSeparatedDecimal,
  thousandSeparatedUnsignedDecimal,
  dataSizeInBytesInDecimal,
  -- *** Binary
  unsignedBinary,
  unsignedPaddedBinary,
  -- *** Hexadecimal
  hexadecimal,
  unsignedHexadecimal,
  -- ** Digits
  decimalDigit,
  hexadecimalDigit,
  -- ** Real
  fixedDouble,
  doublePercent,
  -- ** Time
  intervalInSeconds,
)
where

import Text.Builder.Prelude hiding (length, null, intercalate)
import qualified Data.Text.Array as B
import qualified Data.Text.Internal as C
import qualified Data.Text.Encoding as E
import qualified Data.Text.Encoding.Error as E
import qualified Text.Builder.UTF16 as D
import qualified Data.ByteString as ByteString
import qualified DeferredFolds.Unfoldr as Unfoldr
import qualified Data.Text as Text
import qualified Data.Text.IO as Text


newtype Action =
  Action (forall s. B.MArray s -> Int -> ST s ())

{-|
Specification of how to efficiently construct strict 'Text'.
Provides instances of 'Semigroup' and 'Monoid', which have complexity of /O(1)/.
-}
data Builder =
  Builder !Action !Int !Int

instance Monoid Builder where
  {-# INLINE mempty #-}
  mempty :: Builder
mempty =
    Action -> Int -> Int -> Builder
Builder ((forall s. MArray s -> Int -> ST s ()) -> Action
Action (\MArray s
_ Int
_ -> () -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())) Int
0 Int
0
  {-# INLINABLE mappend #-}
  mappend :: Builder -> Builder -> Builder
mappend (Builder (Action forall s. MArray s -> Int -> ST s ()
action1) Int
arraySize1 Int
charsAmount1) (Builder (Action forall s. MArray s -> Int -> ST s ()
action2) Int
arraySize2 Int
charsAmount2) =
    Action -> Int -> Int -> Builder
Builder Action
action Int
arraySize Int
charsAmount
    where
      action :: Action
action =
        (forall s. MArray s -> Int -> ST s ()) -> Action
Action ((forall s. MArray s -> Int -> ST s ()) -> Action)
-> (forall s. MArray s -> Int -> ST s ()) -> Action
forall a b. (a -> b) -> a -> b
$ \MArray s
array Int
offset -> do
          MArray s -> Int -> ST s ()
forall s. MArray s -> Int -> ST s ()
action1 MArray s
array Int
offset
          MArray s -> Int -> ST s ()
forall s. MArray s -> Int -> ST s ()
action2 MArray s
array (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
arraySize1)
      arraySize :: Int
arraySize =
        Int
arraySize1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
arraySize2
      charsAmount :: Int
charsAmount =
        Int
charsAmount1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
charsAmount2

instance Semigroup Builder where
  <> :: Builder -> Builder -> Builder
(<>) = Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
mappend

instance IsString Builder where
  fromString :: String -> Builder
fromString = String -> Builder
string

instance Show Builder where
  show :: Builder -> String
show = Text -> String
Text.unpack (Text -> String) -> (Builder -> Text) -> Builder -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Builder -> Text
run


-- * Accessors
-------------------------

{-| Get the amount of characters -}
{-# INLINE length #-}
length :: Builder -> Int
length :: Builder -> Int
length (Builder Action
_ Int
_ Int
x) = Int
x

{-| Check whether the builder is empty -}
{-# INLINE null #-}
null :: Builder -> Bool
null :: Builder -> Bool
null = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int -> Bool) -> (Builder -> Int) -> Builder -> Bool
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Builder -> Int
length

{-| Execute a builder producing a strict text -}
run :: Builder -> Text
run :: Builder -> Text
run (Builder (Action forall s. MArray s -> Int -> ST s ()
action) Int
arraySize Int
_) =
  Array -> Int -> Int -> Text
C.text Array
array Int
0 Int
arraySize
  where
    array :: Array
array =
      (forall s. ST s Array) -> Array
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Array) -> Array)
-> (forall s. ST s Array) -> Array
forall a b. (a -> b) -> a -> b
$ do
        MArray s
array <- Int -> ST s (MArray s)
forall s. Int -> ST s (MArray s)
B.new Int
arraySize
        MArray s -> Int -> ST s ()
forall s. MArray s -> Int -> ST s ()
action MArray s
array Int
0
        MArray s -> ST s Array
forall s. MArray s -> ST s Array
B.unsafeFreeze MArray s
array

-- ** Output IO
-------------------------

{-| Put builder, to stdout -}
putToStdOut :: Builder -> IO ()
putToStdOut :: Builder -> IO ()
putToStdOut = Handle -> Text -> IO ()
Text.hPutStr Handle
stdout (Text -> IO ()) -> (Builder -> Text) -> Builder -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Builder -> Text
run

{-| Put builder, to stderr -}
putToStdErr :: Builder -> IO ()
putToStdErr :: Builder -> IO ()
putToStdErr = Handle -> Text -> IO ()
Text.hPutStr Handle
stderr (Text -> IO ()) -> (Builder -> Text) -> Builder -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Builder -> Text
run

{-| Put builder, followed by a line, to stdout -}
putLnToStdOut :: Builder -> IO ()
putLnToStdOut :: Builder -> IO ()
putLnToStdOut = Handle -> Text -> IO ()
Text.hPutStrLn Handle
stdout (Text -> IO ()) -> (Builder -> Text) -> Builder -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Builder -> Text
run

{-| Put builder, followed by a line, to stderr -}
putLnToStdErr :: Builder -> IO ()
putLnToStdErr :: Builder -> IO ()
putLnToStdErr = Handle -> Text -> IO ()
Text.hPutStrLn Handle
stderr (Text -> IO ()) -> (Builder -> Text) -> Builder -> IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Builder -> Text
run


-- * Constructors
-------------------------

{-| Unicode character -}
{-# INLINE char #-}
char :: Char -> Builder
char :: Char -> Builder
char Char
x =
  Int -> Builder
unicodeCodePoint (Char -> Int
ord Char
x)

{-| Unicode code point-}
{-# INLINE unicodeCodePoint #-}
unicodeCodePoint :: Int -> Builder
unicodeCodePoint :: Int -> Builder
unicodeCodePoint Int
x =
  Int
-> (Word16 -> Builder) -> (Word16 -> Word16 -> Builder) -> Builder
Int -> UTF16View
D.unicodeCodePoint Int
x Word16 -> Builder
utf16CodeUnits1 Word16 -> Word16 -> Builder
utf16CodeUnits2

{-| Single code-unit UTF-16 character -}
{-# INLINABLE utf16CodeUnits1 #-}
utf16CodeUnits1 :: Word16 -> Builder
utf16CodeUnits1 :: Word16 -> Builder
utf16CodeUnits1 Word16
unit =
  Action -> Int -> Int -> Builder
Builder Action
action Int
1 Int
1
  where
    action :: Action
action =
      (forall s. MArray s -> Int -> ST s ()) -> Action
Action ((forall s. MArray s -> Int -> ST s ()) -> Action)
-> (forall s. MArray s -> Int -> ST s ()) -> Action
forall a b. (a -> b) -> a -> b
$ \MArray s
array Int
offset -> MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
B.unsafeWrite MArray s
array Int
offset Word16
unit

{-| Double code-unit UTF-16 character -}
{-# INLINABLE utf16CodeUnits2 #-}
utf16CodeUnits2 :: Word16 -> Word16 -> Builder
utf16CodeUnits2 :: Word16 -> Word16 -> Builder
utf16CodeUnits2 Word16
unit1 Word16
unit2 =
  Action -> Int -> Int -> Builder
Builder Action
action Int
2 Int
1
  where
    action :: Action
action =
      (forall s. MArray s -> Int -> ST s ()) -> Action
Action ((forall s. MArray s -> Int -> ST s ()) -> Action)
-> (forall s. MArray s -> Int -> ST s ()) -> Action
forall a b. (a -> b) -> a -> b
$ \MArray s
array Int
offset -> do
        MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
B.unsafeWrite MArray s
array Int
offset Word16
unit1
        MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
B.unsafeWrite MArray s
array (Int -> Int
forall a. Enum a => a -> a
succ Int
offset) Word16
unit2

{-| Single code-unit UTF-8 character -}
{-# INLINE utf8CodeUnits1 #-}
utf8CodeUnits1 :: Word8 -> Builder
utf8CodeUnits1 :: Word8 -> Builder
utf8CodeUnits1 Word8
unit1 =
  Word8
-> (Word16 -> Builder) -> (Word16 -> Word16 -> Builder) -> Builder
Word8 -> UTF16View
D.utf8CodeUnits1 Word8
unit1 Word16 -> Builder
utf16CodeUnits1 Word16 -> Word16 -> Builder
utf16CodeUnits2

{-| Double code-unit UTF-8 character -}
{-# INLINE utf8CodeUnits2 #-}
utf8CodeUnits2 :: Word8 -> Word8 -> Builder
utf8CodeUnits2 :: Word8 -> Word8 -> Builder
utf8CodeUnits2 Word8
unit1 Word8
unit2 =
  Word8
-> Word8
-> (Word16 -> Builder)
-> (Word16 -> Word16 -> Builder)
-> Builder
Word8 -> Word8 -> UTF16View
D.utf8CodeUnits2 Word8
unit1 Word8
unit2 Word16 -> Builder
utf16CodeUnits1 Word16 -> Word16 -> Builder
utf16CodeUnits2

{-| Triple code-unit UTF-8 character -}
{-# INLINE utf8CodeUnits3 #-}
utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> Builder
utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> Builder
utf8CodeUnits3 Word8
unit1 Word8
unit2 Word8
unit3 =
  Word8
-> Word8
-> Word8
-> (Word16 -> Builder)
-> (Word16 -> Word16 -> Builder)
-> Builder
Word8 -> Word8 -> Word8 -> UTF16View
D.utf8CodeUnits3 Word8
unit1 Word8
unit2 Word8
unit3 Word16 -> Builder
utf16CodeUnits1 Word16 -> Word16 -> Builder
utf16CodeUnits2

{-| UTF-8 character out of 4 code units -}
{-# INLINE utf8CodeUnits4 #-}
utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> Builder
utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> Builder
utf8CodeUnits4 Word8
unit1 Word8
unit2 Word8
unit3 Word8
unit4 =
  Word8
-> Word8
-> Word8
-> Word8
-> (Word16 -> Builder)
-> (Word16 -> Word16 -> Builder)
-> Builder
Word8 -> Word8 -> Word8 -> Word8 -> UTF16View
D.utf8CodeUnits4 Word8
unit1 Word8
unit2 Word8
unit3 Word8
unit4 Word16 -> Builder
utf16CodeUnits1 Word16 -> Word16 -> Builder
utf16CodeUnits2

{-| ASCII byte string -}
{-# INLINABLE asciiByteString #-}
asciiByteString :: ByteString -> Builder
asciiByteString :: ByteString -> Builder
asciiByteString ByteString
byteString =
  Action -> Int -> Int -> Builder
Builder Action
action Int
length Int
length
  where
    length :: Int
length = ByteString -> Int
ByteString.length ByteString
byteString
    action :: Action
action =
      (forall s. MArray s -> Int -> ST s ()) -> Action
Action ((forall s. MArray s -> Int -> ST s ()) -> Action)
-> (forall s. MArray s -> Int -> ST s ()) -> Action
forall a b. (a -> b) -> a -> b
$ \MArray s
array -> let
        step :: Word8 -> (Int -> ST s ()) -> Int -> ST s ()
step Word8
byte Int -> ST s ()
next Int
index = do
          MArray s -> Int -> Word16 -> ST s ()
forall s. MArray s -> Int -> Word16 -> ST s ()
B.unsafeWrite MArray s
array Int
index (Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte)
          Int -> ST s ()
next (Int -> Int
forall a. Enum a => a -> a
succ Int
index)
        in (Word8 -> (Int -> ST s ()) -> Int -> ST s ())
-> (Int -> ST s ()) -> ByteString -> Int -> ST s ()
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
ByteString.foldr Word8 -> (Int -> ST s ()) -> Int -> ST s ()
step (ST s () -> Int -> ST s ()
forall a b. a -> b -> a
const (() -> ST s ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())) ByteString
byteString

{-| Strict text -}
{-# INLINABLE text #-}
text :: Text -> Builder
text :: Text -> Builder
text text :: Text
text@(C.Text Array
array Int
offset Int
length) =
  Action -> Int -> Int -> Builder
Builder Action
action Int
length (Text -> Int
Text.length Text
text)
  where
    action :: Action
action =
      (forall s. MArray s -> Int -> ST s ()) -> Action
Action ((forall s. MArray s -> Int -> ST s ()) -> Action)
-> (forall s. MArray s -> Int -> ST s ()) -> Action
forall a b. (a -> b) -> a -> b
$ \MArray s
builderArray Int
builderOffset -> do
        MArray s -> Int -> Array -> Int -> Int -> ST s ()
forall s. MArray s -> Int -> Array -> Int -> Int -> ST s ()
B.copyI MArray s
builderArray Int
builderOffset Array
array Int
offset (Int
builderOffset Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
length)

{-| String -}
{-# INLINE string #-}
string :: String -> Builder
string :: String -> Builder
string =
  (Char -> Builder) -> String -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Char -> Builder
char

{-| Decimal representation of an integral value -}
{-# INLINABLE decimal #-}
decimal :: Integral a => a -> Builder
decimal :: a -> Builder
decimal a
i =
  if a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0
    then a -> Builder
forall a. Integral a => a -> Builder
unsignedDecimal a
i
    else Int -> Builder
unicodeCodePoint Int
45 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
forall a. Integral a => a -> Builder
unsignedDecimal (a -> a
forall a. Num a => a -> a
negate a
i)

{-| Decimal representation of an unsigned integral value -}
{-# INLINABLE unsignedDecimal #-}
unsignedDecimal :: Integral a => a -> Builder
unsignedDecimal :: a -> Builder
unsignedDecimal =
  (a -> Builder) -> Unfoldr a -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Builder
forall a. Integral a => a -> Builder
decimalDigit (Unfoldr a -> Builder) -> (a -> Unfoldr a) -> a -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Unfoldr a
forall a. Integral a => a -> Unfoldr a
Unfoldr.decimalDigits

{-| Decimal representation of an integral value with thousands separated by the specified character -}
{-# INLINABLE thousandSeparatedDecimal #-}
thousandSeparatedDecimal :: Integral a => Char -> a -> Builder
thousandSeparatedDecimal :: Char -> a -> Builder
thousandSeparatedDecimal Char
separatorChar a
a =
  if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0
    then Char -> a -> Builder
forall a. Integral a => Char -> a -> Builder
thousandSeparatedUnsignedDecimal Char
separatorChar a
a
    else Int -> Builder
unicodeCodePoint Int
45 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> a -> Builder
forall a. Integral a => Char -> a -> Builder
thousandSeparatedUnsignedDecimal Char
separatorChar (a -> a
forall a. Num a => a -> a
negate a
a)

{-| Decimal representation of an unsigned integral value with thousands separated by the specified character -}
{-# INLINABLE thousandSeparatedUnsignedDecimal #-}
thousandSeparatedUnsignedDecimal :: Integral a => Char -> a -> Builder
thousandSeparatedUnsignedDecimal :: Char -> a -> Builder
thousandSeparatedUnsignedDecimal Char
separatorChar a
a =
  Unfoldr Builder -> Builder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Unfoldr Builder -> Builder) -> Unfoldr Builder -> Builder
forall a b. (a -> b) -> a -> b
$ do
    (Int
index, a
digit) <- Unfoldr a -> Unfoldr (Int, a)
forall a. Unfoldr a -> Unfoldr (Int, a)
Unfoldr.zipWithReverseIndex (Unfoldr a -> Unfoldr (Int, a)) -> Unfoldr a -> Unfoldr (Int, a)
forall a b. (a -> b) -> a -> b
$ a -> Unfoldr a
forall a. Integral a => a -> Unfoldr a
Unfoldr.decimalDigits a
a
    if Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
index Int
3 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int
index Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
      then Builder -> Unfoldr Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Builder
forall a. Integral a => a -> Builder
decimalDigit a
digit Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char Char
separatorChar)
      else Builder -> Unfoldr Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Builder
forall a. Integral a => a -> Builder
decimalDigit a
digit)

{-| Data size in decimal notation over amount of bytes. -}
{-# INLINABLE dataSizeInBytesInDecimal #-}
dataSizeInBytesInDecimal :: Integral a => Char -> a -> Builder
dataSizeInBytesInDecimal :: Char -> a -> Builder
dataSizeInBytesInDecimal Char
separatorChar a
amount =
  if a
amount a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
1000
    then a -> Builder
forall a. Integral a => a -> Builder
unsignedDecimal a
amount Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"B"
    else if a
amount a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
1000000
      then Char -> a -> a -> Builder
forall a. Integral a => Char -> a -> a -> Builder
dividedDecimal Char
separatorChar a
100 a
amount Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"kB"
      else if a
amount a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
1000000000
        then Char -> a -> a -> Builder
forall a. Integral a => Char -> a -> a -> Builder
dividedDecimal Char
separatorChar a
100000 a
amount Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"MB"
        else if a
amount a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
1000000000000
          then Char -> a -> a -> Builder
forall a. Integral a => Char -> a -> a -> Builder
dividedDecimal Char
separatorChar a
100000000 a
amount Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"GB"
        else if a
amount a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
1000000000000000
          then Char -> a -> a -> Builder
forall a. Integral a => Char -> a -> a -> Builder
dividedDecimal Char
separatorChar a
100000000000 a
amount Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"TB"
        else if a
amount a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
1000000000000000000
          then Char -> a -> a -> Builder
forall a. Integral a => Char -> a -> a -> Builder
dividedDecimal Char
separatorChar a
100000000000000 a
amount Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"PB"
        else if a
amount a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
1000000000000000000000
          then Char -> a -> a -> Builder
forall a. Integral a => Char -> a -> a -> Builder
dividedDecimal Char
separatorChar a
100000000000000000 a
amount Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"EB"
          else if a
amount a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
1000000000000000000000000
            then Char -> a -> a -> Builder
forall a. Integral a => Char -> a -> a -> Builder
dividedDecimal Char
separatorChar a
100000000000000000000 a
amount Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"ZB"
            else Char -> a -> a -> Builder
forall a. Integral a => Char -> a -> a -> Builder
dividedDecimal Char
separatorChar a
100000000000000000000000 a
amount Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"YB"

dividedDecimal :: Integral a => Char -> a -> a -> Builder
dividedDecimal :: Char -> a -> a -> Builder
dividedDecimal Char
separatorChar a
divisor a
n = let
  byDivisor :: a
byDivisor = a -> a -> a
forall a. Integral a => a -> a -> a
div a
n a
divisor
  byExtraTen :: a
byExtraTen = a -> a -> a
forall a. Integral a => a -> a -> a
div a
byDivisor a
10
  remainder :: a
remainder = a
byDivisor a -> a -> a
forall a. Num a => a -> a -> a
- a
byExtraTen a -> a -> a
forall a. Num a => a -> a -> a
* a
10
  in if a
remainder a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 Bool -> Bool -> Bool
|| a
byExtraTen a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
10
    then Char -> a -> Builder
forall a. Integral a => Char -> a -> Builder
thousandSeparatedDecimal Char
separatorChar a
byExtraTen
    else Char -> a -> Builder
forall a. Integral a => Char -> a -> Builder
thousandSeparatedDecimal Char
separatorChar a
byExtraTen Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"." Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
forall a. Integral a => a -> Builder
decimalDigit a
remainder

{-| Unsigned binary number -}
{-# INLINE unsignedBinary #-}
unsignedBinary :: Integral a => a -> Builder
unsignedBinary :: a -> Builder
unsignedBinary =
  (a -> Builder) -> Unfoldr a -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Builder
forall a. Integral a => a -> Builder
decimalDigit (Unfoldr a -> Builder) -> (a -> Unfoldr a) -> a -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Unfoldr a
forall a. Integral a => a -> Unfoldr a
Unfoldr.binaryDigits

{-| Unsigned binary number -}
{-# INLINE unsignedPaddedBinary #-}
unsignedPaddedBinary :: (Integral a, FiniteBits a) => a -> Builder
unsignedPaddedBinary :: a -> Builder
unsignedPaddedBinary a
a =
  Int -> Char -> Builder -> Builder
padFromLeft (a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize a
a) Char
'0' (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ (a -> Builder) -> Unfoldr a -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Builder
forall a. Integral a => a -> Builder
decimalDigit (Unfoldr a -> Builder) -> Unfoldr a -> Builder
forall a b. (a -> b) -> a -> b
$ a -> Unfoldr a
forall a. Integral a => a -> Unfoldr a
Unfoldr.binaryDigits a
a

{-| Hexadecimal representation of an integral value -}
{-# INLINE hexadecimal #-}
hexadecimal :: Integral a => a -> Builder
hexadecimal :: a -> Builder
hexadecimal a
i =
  if a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0
    then a -> Builder
forall a. Integral a => a -> Builder
unsignedHexadecimal a
i
    else Int -> Builder
unicodeCodePoint Int
45 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> a -> Builder
forall a. Integral a => a -> Builder
unsignedHexadecimal (a -> a
forall a. Num a => a -> a
negate a
i)

{-| Unsigned hexadecimal representation of an integral value -}
{-# INLINE unsignedHexadecimal #-}
unsignedHexadecimal :: Integral a => a -> Builder
unsignedHexadecimal :: a -> Builder
unsignedHexadecimal =
  (a -> Builder) -> Unfoldr a -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> Builder
forall a. Integral a => a -> Builder
hexadecimalDigit (Unfoldr a -> Builder) -> (a -> Unfoldr a) -> a -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> Unfoldr a
forall a. Integral a => a -> Unfoldr a
Unfoldr.hexadecimalDigits

{-| Decimal digit -}
{-# INLINE decimalDigit #-}
decimalDigit :: Integral a => a -> Builder
decimalDigit :: a -> Builder
decimalDigit a
n =
  Int -> Builder
unicodeCodePoint (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
48)

{-| Hexadecimal digit -}
{-# INLINE hexadecimalDigit #-}
hexadecimalDigit :: Integral a => a -> Builder
hexadecimalDigit :: a -> Builder
hexadecimalDigit a
n =
  if a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
9
    then Int -> Builder
unicodeCodePoint (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
48)
    else Int -> Builder
unicodeCodePoint (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
87)

{-| Intercalate builders -}
{-# INLINE intercalate #-}
intercalate :: Foldable foldable => Builder -> foldable Builder -> Builder
intercalate :: Builder -> foldable Builder -> Builder
intercalate Builder
separator = Product2 Bool Builder -> Builder
forall a b. Product2 a b -> b
extract (Product2 Bool Builder -> Builder)
-> (foldable Builder -> Product2 Bool Builder)
-> foldable Builder
-> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Product2 Bool Builder -> Builder -> Product2 Bool Builder)
-> Product2 Bool Builder
-> foldable Builder
-> Product2 Bool Builder
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Product2 Bool Builder -> Builder -> Product2 Bool Builder
step Product2 Bool Builder
forall b. Monoid b => Product2 Bool b
init where
  init :: Product2 Bool b
init = Bool -> b -> Product2 Bool b
forall a b. a -> b -> Product2 a b
Product2 Bool
False b
forall a. Monoid a => a
mempty
  step :: Product2 Bool Builder -> Builder -> Product2 Bool Builder
step (Product2 Bool
isNotFirst Builder
builder) Builder
element = Bool -> Builder -> Product2 Bool Builder
forall a b. a -> b -> Product2 a b
Product2 Bool
True (Builder -> Product2 Bool Builder)
-> Builder -> Product2 Bool Builder
forall a b. (a -> b) -> a -> b
$ if Bool
isNotFirst
    then Builder
builder Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
separator Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
element
    else Builder
element
  extract :: Product2 a b -> b
extract (Product2 a
_ b
builder) = b
builder

{-| Pad a builder from the left side to the specified length with the specified character -}
{-# INLINABLE padFromLeft #-}
padFromLeft :: Int -> Char -> Builder -> Builder
padFromLeft :: Int -> Char -> Builder -> Builder
padFromLeft Int
paddedLength Char
paddingChar Builder
builder = let
  builderLength :: Int
builderLength = Builder -> Int
length Builder
builder
  in if Int
paddedLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
builderLength
    then Builder
builder
    else (Char -> Builder) -> String -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Char -> Builder
char (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
paddedLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
builderLength) Char
paddingChar) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
builder

{-| Pad a builder from the right side to the specified length with the specified character -}
{-# INLINABLE padFromRight #-}
padFromRight :: Int -> Char -> Builder -> Builder
padFromRight :: Int -> Char -> Builder -> Builder
padFromRight Int
paddedLength Char
paddingChar Builder
builder = let
  builderLength :: Int
builderLength = Builder -> Int
length Builder
builder
  in if Int
paddedLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
builderLength
    then Builder
builder
    else Builder
builder Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Char -> Builder) -> String -> Builder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Char -> Builder
char (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
paddedLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
builderLength) Char
paddingChar)

{-|
Time interval in seconds.
Directly applicable to 'DiffTime' and 'NominalDiffTime'.
-}
{-# INLINABLE intervalInSeconds #-}
intervalInSeconds :: RealFrac seconds => seconds -> Builder
intervalInSeconds :: seconds -> Builder
intervalInSeconds seconds
interval = (State Integer Builder -> Integer -> Builder)
-> Integer -> State Integer Builder -> Builder
forall a b c. (a -> b -> c) -> b -> a -> c
flip State Integer Builder -> Integer -> Builder
forall s a. State s a -> s -> a
evalState (seconds -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round seconds
interval) (State Integer Builder -> Builder)
-> State Integer Builder -> Builder
forall a b. (a -> b) -> a -> b
$ do
  Integer
seconds <- (Integer -> (Integer, Integer)) -> StateT Integer Identity Integer
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((Integer, Integer) -> (Integer, Integer)
forall a b. (a, b) -> (b, a)
swap ((Integer, Integer) -> (Integer, Integer))
-> (Integer -> (Integer, Integer)) -> Integer -> (Integer, Integer)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Integer -> Integer -> (Integer, Integer))
-> Integer -> Integer -> (Integer, Integer)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod Integer
60)
  Integer
minutes <- (Integer -> (Integer, Integer)) -> StateT Integer Identity Integer
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((Integer, Integer) -> (Integer, Integer)
forall a b. (a, b) -> (b, a)
swap ((Integer, Integer) -> (Integer, Integer))
-> (Integer -> (Integer, Integer)) -> Integer -> (Integer, Integer)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Integer -> Integer -> (Integer, Integer))
-> Integer -> Integer -> (Integer, Integer)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod Integer
60)
  Integer
hours <- (Integer -> (Integer, Integer)) -> StateT Integer Identity Integer
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((Integer, Integer) -> (Integer, Integer)
forall a b. (a, b) -> (b, a)
swap ((Integer, Integer) -> (Integer, Integer))
-> (Integer -> (Integer, Integer)) -> Integer -> (Integer, Integer)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Integer -> Integer -> (Integer, Integer))
-> Integer -> Integer -> (Integer, Integer)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
divMod Integer
24)
  Integer
days <- StateT Integer Identity Integer
forall (m :: * -> *) s. Monad m => StateT s m s
get
  Builder -> State Integer Builder
forall (m :: * -> *) a. Monad m => a -> m a
return (Builder -> State Integer Builder)
-> Builder -> State Integer Builder
forall a b. (a -> b) -> a -> b
$
    Int -> Char -> Builder -> Builder
padFromLeft Int
2 Char
'0' (Integer -> Builder
forall a. Integral a => a -> Builder
decimal Integer
days) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Int -> Char -> Builder -> Builder
padFromLeft Int
2 Char
'0' (Integer -> Builder
forall a. Integral a => a -> Builder
decimal Integer
hours) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Int -> Char -> Builder -> Builder
padFromLeft Int
2 Char
'0' (Integer -> Builder
forall a. Integral a => a -> Builder
decimal Integer
minutes) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
":" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
    Int -> Char -> Builder -> Builder
padFromLeft Int
2 Char
'0' (Integer -> Builder
forall a. Integral a => a -> Builder
decimal Integer
seconds)

{-| Double with a fixed number of decimal places. -}
{-# INLINE fixedDouble #-}
fixedDouble :: Int {-^ Amount of decimals after point. -} -> Double -> Builder
fixedDouble :: Int -> Double -> Builder
fixedDouble Int
decimalPlaces = String -> Builder
forall a. IsString a => String -> a
fromString (String -> Builder) -> (Double -> String) -> Double -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Double -> String
forall r. PrintfType r => String -> r
printf (String
"%." String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
decimalPlaces String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"f")

{-| Double multiplied by 100 with a fixed number of decimal places applied and followed by a percent-sign. -}
{-# INLINE doublePercent #-}
doublePercent :: Int {-^ Amount of decimals after point. -} -> Double -> Builder
doublePercent :: Int -> Double -> Builder
doublePercent Int
decimalPlaces Double
x = Int -> Double -> Builder
fixedDouble Int
decimalPlaces (Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"%"