module TextBuilder
  ( TextBuilder,
    Builder,

    -- * Accessors
    toText,
    run,
    length,
    null,

    -- ** Output IO
    putToStdOut,
    putToStdErr,
    putLnToStdOut,
    putLnToStdErr,

    -- * Constructors

    -- ** Builder manipulators
    intercalate,
    padFromLeft,
    padFromRight,

    -- ** Textual
    text,
    lazyText,
    string,
    asciiByteString,
    hexData,

    -- ** 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 qualified Data.Text.Lazy as TextLazy
import TextBuilder.Prelude hiding (intercalate, length, null)
import qualified TextBuilderDev as Dev

-- |
-- Specification of how to efficiently construct strict 'Text'.
-- Provides instances of 'Semigroup' and 'Monoid', which have complexity of /O(1)/.
newtype TextBuilder
  = TextBuilder Dev.TextBuilder
  deriving (Int -> TextBuilder -> ShowS
[TextBuilder] -> ShowS
TextBuilder -> String
(Int -> TextBuilder -> ShowS)
-> (TextBuilder -> String)
-> ([TextBuilder] -> ShowS)
-> Show TextBuilder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TextBuilder -> ShowS
showsPrec :: Int -> TextBuilder -> ShowS
$cshow :: TextBuilder -> String
show :: TextBuilder -> String
$cshowList :: [TextBuilder] -> ShowS
showList :: [TextBuilder] -> ShowS
Show, String -> TextBuilder
(String -> TextBuilder) -> IsString TextBuilder
forall a. (String -> a) -> IsString a
$cfromString :: String -> TextBuilder
fromString :: String -> TextBuilder
IsString, NonEmpty TextBuilder -> TextBuilder
TextBuilder -> TextBuilder -> TextBuilder
(TextBuilder -> TextBuilder -> TextBuilder)
-> (NonEmpty TextBuilder -> TextBuilder)
-> (forall b. Integral b => b -> TextBuilder -> TextBuilder)
-> Semigroup TextBuilder
forall b. Integral b => b -> TextBuilder -> TextBuilder
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: TextBuilder -> TextBuilder -> TextBuilder
<> :: TextBuilder -> TextBuilder -> TextBuilder
$csconcat :: NonEmpty TextBuilder -> TextBuilder
sconcat :: NonEmpty TextBuilder -> TextBuilder
$cstimes :: forall b. Integral b => b -> TextBuilder -> TextBuilder
stimes :: forall b. Integral b => b -> TextBuilder -> TextBuilder
Semigroup, Semigroup TextBuilder
TextBuilder
Semigroup TextBuilder =>
TextBuilder
-> (TextBuilder -> TextBuilder -> TextBuilder)
-> ([TextBuilder] -> TextBuilder)
-> Monoid TextBuilder
[TextBuilder] -> TextBuilder
TextBuilder -> TextBuilder -> TextBuilder
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: TextBuilder
mempty :: TextBuilder
$cmappend :: TextBuilder -> TextBuilder -> TextBuilder
mappend :: TextBuilder -> TextBuilder -> TextBuilder
$cmconcat :: [TextBuilder] -> TextBuilder
mconcat :: [TextBuilder] -> TextBuilder
Monoid)

{-# DEPRECATED Builder "Use TextBuilder instead" #-}

type Builder = TextBuilder

-- | Get the amount of characters
{-# INLINE length #-}
length :: TextBuilder -> Int
length :: TextBuilder -> Int
length = (TextBuilder -> Int) -> TextBuilder -> Int
forall a b. Coercible a b => a -> b
coerce TextBuilder -> Int
Dev.length

-- | Check whether the builder is empty
{-# INLINE null #-}
null :: TextBuilder -> Bool
null :: TextBuilder -> Bool
null = (TextBuilder -> Bool) -> TextBuilder -> Bool
forall a b. Coercible a b => a -> b
coerce TextBuilder -> Bool
Dev.null

-- | Execute a builder producing a strict text
toText :: TextBuilder -> Text
toText :: TextBuilder -> Text
toText = (TextBuilder -> Text) -> TextBuilder -> Text
forall a b. Coercible a b => a -> b
coerce TextBuilder -> Text
Dev.toText

{-# DEPRECATED run "Use toText instead" #-}

-- | Alias to 'toText'
run :: TextBuilder -> Text
run :: TextBuilder -> Text
run = TextBuilder -> Text
toText

-- ** Output IO

-- | Put builder, to stdout
putToStdOut :: TextBuilder -> IO ()
putToStdOut :: TextBuilder -> IO ()
putToStdOut = (TextBuilder -> IO ()) -> TextBuilder -> IO ()
forall a b. Coercible a b => a -> b
coerce TextBuilder -> IO ()
Dev.putToStdOut

-- | Put builder, to stderr
putToStdErr :: TextBuilder -> IO ()
putToStdErr :: TextBuilder -> IO ()
putToStdErr = (TextBuilder -> IO ()) -> TextBuilder -> IO ()
forall a b. Coercible a b => a -> b
coerce TextBuilder -> IO ()
Dev.putToStdErr

-- | Put builder, followed by a line, to stdout
putLnToStdOut :: TextBuilder -> IO ()
putLnToStdOut :: TextBuilder -> IO ()
putLnToStdOut = (TextBuilder -> IO ()) -> TextBuilder -> IO ()
forall a b. Coercible a b => a -> b
coerce TextBuilder -> IO ()
Dev.putLnToStdOut

-- | Put builder, followed by a line, to stderr
putLnToStdErr :: TextBuilder -> IO ()
putLnToStdErr :: TextBuilder -> IO ()
putLnToStdErr = (TextBuilder -> IO ()) -> TextBuilder -> IO ()
forall a b. Coercible a b => a -> b
coerce TextBuilder -> IO ()
Dev.putLnToStdErr

-- * Constructors

-- | Unicode character
{-# INLINE char #-}
char :: Char -> TextBuilder
char :: Char -> TextBuilder
char = (Char -> TextBuilder) -> Char -> TextBuilder
forall a b. Coercible a b => a -> b
coerce Char -> TextBuilder
Dev.char

-- | Unicode code point
{-# INLINE unicodeCodePoint #-}
unicodeCodePoint :: Int -> TextBuilder
unicodeCodePoint :: Int -> TextBuilder
unicodeCodePoint = (Int -> TextBuilder) -> Int -> TextBuilder
forall a b. Coercible a b => a -> b
coerce Int -> TextBuilder
Dev.unicodeCodePoint

-- | Single code-unit UTF-16 character
{-# INLINEABLE utf16CodeUnits1 #-}
utf16CodeUnits1 :: Word16 -> TextBuilder
utf16CodeUnits1 :: Word16 -> TextBuilder
utf16CodeUnits1 = (Word16 -> TextBuilder) -> Word16 -> TextBuilder
forall a b. Coercible a b => a -> b
coerce Word16 -> TextBuilder
Dev.utf16CodeUnits1

-- | Double code-unit UTF-16 character
{-# INLINEABLE utf16CodeUnits2 #-}
utf16CodeUnits2 :: Word16 -> Word16 -> TextBuilder
utf16CodeUnits2 :: Word16 -> Word16 -> TextBuilder
utf16CodeUnits2 = (Word16 -> Word16 -> TextBuilder)
-> Word16 -> Word16 -> TextBuilder
forall a b. Coercible a b => a -> b
coerce Word16 -> Word16 -> TextBuilder
Dev.utf16CodeUnits2

-- | Single code-unit UTF-8 character
{-# INLINE utf8CodeUnits1 #-}
utf8CodeUnits1 :: Word8 -> TextBuilder
utf8CodeUnits1 :: Word8 -> TextBuilder
utf8CodeUnits1 = (Word8 -> TextBuilder) -> Word8 -> TextBuilder
forall a b. Coercible a b => a -> b
coerce Word8 -> TextBuilder
Dev.utf8CodeUnits1

-- | Double code-unit UTF-8 character
{-# INLINE utf8CodeUnits2 #-}
utf8CodeUnits2 :: Word8 -> Word8 -> TextBuilder
utf8CodeUnits2 :: Word8 -> Word8 -> TextBuilder
utf8CodeUnits2 = (Word8 -> Word8 -> TextBuilder) -> Word8 -> Word8 -> TextBuilder
forall a b. Coercible a b => a -> b
coerce Word8 -> Word8 -> TextBuilder
Dev.utf8CodeUnits2

-- | Triple code-unit UTF-8 character
{-# INLINE utf8CodeUnits3 #-}
utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> TextBuilder
utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> TextBuilder
utf8CodeUnits3 = (Word8 -> Word8 -> Word8 -> TextBuilder)
-> Word8 -> Word8 -> Word8 -> TextBuilder
forall a b. Coercible a b => a -> b
coerce Word8 -> Word8 -> Word8 -> TextBuilder
Dev.utf8CodeUnits3

-- | UTF-8 character out of 4 code units
{-# INLINE utf8CodeUnits4 #-}
utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> TextBuilder
utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> TextBuilder
utf8CodeUnits4 = (Word8 -> Word8 -> Word8 -> Word8 -> TextBuilder)
-> Word8 -> Word8 -> Word8 -> Word8 -> TextBuilder
forall a b. Coercible a b => a -> b
coerce Word8 -> Word8 -> Word8 -> Word8 -> TextBuilder
Dev.utf8CodeUnits4

-- | ASCII byte string
{-# INLINE asciiByteString #-}
asciiByteString :: ByteString -> TextBuilder
asciiByteString :: ByteString -> TextBuilder
asciiByteString = (ByteString -> TextBuilder) -> ByteString -> TextBuilder
forall a b. Coercible a b => a -> b
coerce ByteString -> TextBuilder
Dev.asciiByteString

-- | Strict text
{-# INLINE text #-}
text :: Text -> TextBuilder
text :: Text -> TextBuilder
text = (Text -> TextBuilder) -> Text -> TextBuilder
forall a b. Coercible a b => a -> b
coerce Text -> TextBuilder
Dev.text

-- | Lazy text
{-# INLINE lazyText #-}
lazyText :: TextLazy.Text -> TextBuilder
lazyText :: Text -> TextBuilder
lazyText = (Text -> TextBuilder) -> Text -> TextBuilder
forall a b. Coercible a b => a -> b
coerce Text -> TextBuilder
Dev.lazyText

-- | String
{-# INLINE string #-}
string :: String -> TextBuilder
string :: String -> TextBuilder
string = (String -> TextBuilder) -> String -> TextBuilder
forall a b. Coercible a b => a -> b
coerce String -> TextBuilder
Dev.string

-- | Decimal representation of an integral value
{-# INLINEABLE decimal #-}
decimal :: (Integral a) => a -> TextBuilder
decimal :: forall a. Integral a => a -> TextBuilder
decimal = TextBuilder -> TextBuilder
forall a b. Coercible a b => a -> b
coerce (TextBuilder -> TextBuilder)
-> (a -> TextBuilder) -> a -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> TextBuilder
forall a. Integral a => a -> TextBuilder
Dev.decimal

-- | Decimal representation of an unsigned integral value
{-# INLINEABLE unsignedDecimal #-}
unsignedDecimal :: (Integral a) => a -> TextBuilder
unsignedDecimal :: forall a. Integral a => a -> TextBuilder
unsignedDecimal = TextBuilder -> TextBuilder
forall a b. Coercible a b => a -> b
coerce (TextBuilder -> TextBuilder)
-> (a -> TextBuilder) -> a -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> TextBuilder
forall a. Integral a => a -> TextBuilder
Dev.unsignedDecimal

-- | Decimal representation of an integral value with thousands separated by the specified character
{-# INLINEABLE thousandSeparatedDecimal #-}
thousandSeparatedDecimal :: (Integral a) => Char -> a -> TextBuilder
thousandSeparatedDecimal :: forall a. Integral a => Char -> a -> TextBuilder
thousandSeparatedDecimal = (TextBuilder -> TextBuilder)
-> (a -> TextBuilder) -> a -> TextBuilder
forall a b. (a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextBuilder -> TextBuilder
forall a b. Coercible a b => a -> b
coerce ((a -> TextBuilder) -> a -> TextBuilder)
-> (Char -> a -> TextBuilder) -> Char -> a -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> a -> TextBuilder
forall a. Integral a => Char -> a -> TextBuilder
Dev.thousandSeparatedDecimal

-- | Decimal representation of an unsigned integral value with thousands separated by the specified character
{-# INLINEABLE thousandSeparatedUnsignedDecimal #-}
thousandSeparatedUnsignedDecimal :: (Integral a) => Char -> a -> TextBuilder
thousandSeparatedUnsignedDecimal :: forall a. Integral a => Char -> a -> TextBuilder
thousandSeparatedUnsignedDecimal = (TextBuilder -> TextBuilder)
-> (a -> TextBuilder) -> a -> TextBuilder
forall a b. (a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextBuilder -> TextBuilder
forall a b. Coercible a b => a -> b
coerce ((a -> TextBuilder) -> a -> TextBuilder)
-> (Char -> a -> TextBuilder) -> Char -> a -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> a -> TextBuilder
forall a. Integral a => Char -> a -> TextBuilder
Dev.thousandSeparatedUnsignedDecimal

-- | Data size in decimal notation over amount of bytes.
{-# INLINEABLE dataSizeInBytesInDecimal #-}
dataSizeInBytesInDecimal :: (Integral a) => Char -> a -> TextBuilder
dataSizeInBytesInDecimal :: forall a. Integral a => Char -> a -> TextBuilder
dataSizeInBytesInDecimal = (TextBuilder -> TextBuilder)
-> (a -> TextBuilder) -> a -> TextBuilder
forall a b. (a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TextBuilder -> TextBuilder
forall a b. Coercible a b => a -> b
coerce ((a -> TextBuilder) -> a -> TextBuilder)
-> (Char -> a -> TextBuilder) -> Char -> a -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> a -> TextBuilder
forall a. Integral a => Char -> a -> TextBuilder
Dev.dataSizeInBytesInDecimal

-- | Unsigned binary number
{-# INLINE unsignedBinary #-}
unsignedBinary :: (Integral a) => a -> TextBuilder
unsignedBinary :: forall a. Integral a => a -> TextBuilder
unsignedBinary = TextBuilder -> TextBuilder
forall a b. Coercible a b => a -> b
coerce (TextBuilder -> TextBuilder)
-> (a -> TextBuilder) -> a -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> TextBuilder
forall a. Integral a => a -> TextBuilder
Dev.unsignedBinary

-- | Unsigned binary number
{-# INLINE unsignedPaddedBinary #-}
unsignedPaddedBinary :: (Integral a, FiniteBits a) => a -> TextBuilder
unsignedPaddedBinary :: forall a. (Integral a, FiniteBits a) => a -> TextBuilder
unsignedPaddedBinary = TextBuilder -> TextBuilder
forall a b. Coercible a b => a -> b
coerce (TextBuilder -> TextBuilder)
-> (a -> TextBuilder) -> a -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> TextBuilder
forall a. (Integral a, FiniteBits a) => a -> TextBuilder
Dev.unsignedPaddedBinary

-- | Hexadecimal representation of an integral value
{-# INLINE hexadecimal #-}
hexadecimal :: (Integral a) => a -> TextBuilder
hexadecimal :: forall a. Integral a => a -> TextBuilder
hexadecimal = TextBuilder -> TextBuilder
forall a b. Coercible a b => a -> b
coerce (TextBuilder -> TextBuilder)
-> (a -> TextBuilder) -> a -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> TextBuilder
forall a. Integral a => a -> TextBuilder
Dev.hexadecimal

-- | Unsigned hexadecimal representation of an integral value
{-# INLINE unsignedHexadecimal #-}
unsignedHexadecimal :: (Integral a) => a -> TextBuilder
unsignedHexadecimal :: forall a. Integral a => a -> TextBuilder
unsignedHexadecimal = TextBuilder -> TextBuilder
forall a b. Coercible a b => a -> b
coerce (TextBuilder -> TextBuilder)
-> (a -> TextBuilder) -> a -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> TextBuilder
forall a. Integral a => a -> TextBuilder
Dev.unsignedHexadecimal

-- | Decimal digit
{-# INLINE decimalDigit #-}
decimalDigit :: (Integral a) => a -> TextBuilder
decimalDigit :: forall a. Integral a => a -> TextBuilder
decimalDigit = TextBuilder -> TextBuilder
forall a b. Coercible a b => a -> b
coerce (TextBuilder -> TextBuilder)
-> (a -> TextBuilder) -> a -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> TextBuilder
forall a. Integral a => a -> TextBuilder
Dev.decimalDigit

-- | Hexadecimal digit
{-# INLINE hexadecimalDigit #-}
hexadecimalDigit :: (Integral a) => a -> TextBuilder
hexadecimalDigit :: forall a. Integral a => a -> TextBuilder
hexadecimalDigit = TextBuilder -> TextBuilder
forall a b. Coercible a b => a -> b
coerce (TextBuilder -> TextBuilder)
-> (a -> TextBuilder) -> a -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> TextBuilder
forall a. Integral a => a -> TextBuilder
Dev.hexadecimalDigit

-- | Intercalate builders
{-# INLINE intercalate #-}
intercalate :: (Foldable foldable) => TextBuilder -> foldable TextBuilder -> TextBuilder
intercalate :: forall (foldable :: * -> *).
Foldable foldable =>
TextBuilder -> foldable TextBuilder -> TextBuilder
intercalate TextBuilder
a foldable TextBuilder
b = TextBuilder -> TextBuilder
forall a b. Coercible a b => a -> b
coerce (TextBuilder -> [TextBuilder] -> TextBuilder
forall (f :: * -> *).
Foldable f =>
TextBuilder -> f TextBuilder -> TextBuilder
Dev.intercalate (TextBuilder -> TextBuilder
forall a b. Coercible a b => a -> b
coerce TextBuilder
a) ((TextBuilder -> [TextBuilder] -> [TextBuilder])
-> [TextBuilder] -> foldable TextBuilder -> [TextBuilder]
forall a b. (a -> b -> b) -> b -> foldable a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((:) (TextBuilder -> [TextBuilder] -> [TextBuilder])
-> (TextBuilder -> TextBuilder)
-> TextBuilder
-> [TextBuilder]
-> [TextBuilder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TextBuilder -> TextBuilder
forall a b. Coercible a b => a -> b
coerce) [] foldable TextBuilder
b))

-- | Pad a builder from the left side to the specified length with the specified character
{-# INLINEABLE padFromLeft #-}
padFromLeft :: Int -> Char -> TextBuilder -> TextBuilder
padFromLeft :: Int -> Char -> TextBuilder -> TextBuilder
padFromLeft = (Int -> Char -> TextBuilder -> TextBuilder)
-> Int -> Char -> TextBuilder -> TextBuilder
forall a b. Coercible a b => a -> b
coerce Int -> Char -> TextBuilder -> TextBuilder
Dev.padFromLeft

-- | Pad a builder from the right side to the specified length with the specified character
{-# INLINEABLE padFromRight #-}
padFromRight :: Int -> Char -> TextBuilder -> TextBuilder
padFromRight :: Int -> Char -> TextBuilder -> TextBuilder
padFromRight = (Int -> Char -> TextBuilder -> TextBuilder)
-> Int -> Char -> TextBuilder -> TextBuilder
forall a b. Coercible a b => a -> b
coerce Int -> Char -> TextBuilder -> TextBuilder
Dev.padFromRight

-- |
-- Time interval in seconds.
-- Directly applicable to 'DiffTime' and 'NominalDiffTime'.
{-# INLINEABLE intervalInSeconds #-}
intervalInSeconds :: (RealFrac seconds) => seconds -> TextBuilder
intervalInSeconds :: forall seconds. RealFrac seconds => seconds -> TextBuilder
intervalInSeconds = TextBuilder -> TextBuilder
forall a b. Coercible a b => a -> b
coerce (TextBuilder -> TextBuilder)
-> (seconds -> TextBuilder) -> seconds -> TextBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. seconds -> TextBuilder
forall seconds. RealFrac seconds => seconds -> TextBuilder
Dev.intervalInSeconds

-- | Double with a fixed number of decimal places.
{-# INLINE fixedDouble #-}
fixedDouble ::
  -- | Amount of decimals after point.
  Int ->
  Double ->
  TextBuilder
fixedDouble :: Int -> Double -> TextBuilder
fixedDouble = (Int -> Double -> TextBuilder) -> Int -> Double -> TextBuilder
forall a b. Coercible a b => a -> b
coerce Int -> Double -> TextBuilder
Dev.fixedDouble

-- | Double multiplied by 100 with a fixed number of decimal places applied and followed by a percent-sign.
{-# INLINE doublePercent #-}
doublePercent ::
  -- | Amount of decimals after point.
  Int ->
  Double ->
  TextBuilder
doublePercent :: Int -> Double -> TextBuilder
doublePercent = (Int -> Double -> TextBuilder) -> Int -> Double -> TextBuilder
forall a b. Coercible a b => a -> b
coerce Int -> Double -> TextBuilder
Dev.doublePercent

-- | Hexadecimal readable representation of binary data.
{-# INLINE hexData #-}
hexData :: ByteString -> TextBuilder
hexData :: ByteString -> TextBuilder
hexData = (ByteString -> TextBuilder) -> ByteString -> TextBuilder
forall a b. Coercible a b => a -> b
coerce ByteString -> TextBuilder
Dev.hexData