module TextBuilderDev
  ( TextBuilder,

    -- * Accessors
    buildText,
    length,
    null,

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

    -- * Constructors

    -- ** Builder manipulators
    force,
    intercalate,
    intercalateMap,
    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
    utcTimestampInIso8601,
    intervalInSeconds,

    -- * Classes
    IsomorphicToTextBuilder (..),
  )
where

import qualified Data.ByteString as ByteString
import qualified Data.List.Split as Split
import qualified Data.Text as Text
import qualified Data.Text.Array as TextArray
import qualified Data.Text.IO as Text
import qualified Data.Text.Internal as TextInternal
import qualified Data.Text.Lazy as TextLazy
import qualified Data.Text.Lazy.Builder as TextLazyBuilder
import qualified DeferredFolds.Unfoldr as Unfoldr
import TextBuilderDev.Prelude hiding (intercalate, length, null)
import qualified TextBuilderDev.Utf16View as Utf16View
import qualified TextBuilderDev.Utf8View as Utf8View

-- * --

-- |
-- Evidence that there exists an unambiguous way to convert
-- a type to and from "TextBuilder".
--
-- Unlike conversion classes from other libs this class is lawful.
-- The law is:
--
-- @'fromTextBuilder' . 'toTextBuilder' = 'id'@
--
-- This class does not provide implicit rendering,
-- such as from integer to its decimal representation.
-- There are multiple ways of representing an integer
-- as text (e.g., hexadecimal, binary).
-- The non-ambiguity is further enforced by the presence of
-- the inverse conversion.
-- In the integer case there is no way to read it
-- from a textual form without a possibility of failing
-- (e.g., when the input string cannot be parsed as an integer).
--
-- If you're looking for such conversion classes,
-- this library is not a place for them,
-- since there can be infinite amount of flavours of
-- conversions. They are context-dependent and as such
-- should be defined as part of the domain.
class IsomorphicToTextBuilder a where
  toTextBuilder :: a -> TextBuilder
  fromTextBuilder :: TextBuilder -> a

instance IsomorphicToTextBuilder TextBuilder where
  toTextBuilder :: TextBuilder -> TextBuilder
toTextBuilder = forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  fromTextBuilder :: TextBuilder -> TextBuilder
fromTextBuilder = forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

instance IsomorphicToTextBuilder Text where
  toTextBuilder :: Text -> TextBuilder
toTextBuilder = Text -> TextBuilder
text
  fromTextBuilder :: TextBuilder -> Text
fromTextBuilder = TextBuilder -> Text
buildText

instance IsomorphicToTextBuilder String where
  toTextBuilder :: String -> TextBuilder
toTextBuilder = forall a. IsString a => String -> a
fromString
  fromTextBuilder :: TextBuilder -> String
fromTextBuilder = Text -> String
Text.unpack forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TextBuilder -> Text
buildText

instance IsomorphicToTextBuilder TextLazy.Text where
  toTextBuilder :: Text -> TextBuilder
toTextBuilder = Text -> TextBuilder
lazyText
  fromTextBuilder :: TextBuilder -> Text
fromTextBuilder = Text -> Text
TextLazy.fromStrict forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TextBuilder -> Text
buildText

instance IsomorphicToTextBuilder TextLazyBuilder.Builder where
  toTextBuilder :: Builder -> TextBuilder
toTextBuilder = Text -> TextBuilder
text forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Text
TextLazy.toStrict forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Builder -> Text
TextLazyBuilder.toLazyText
  fromTextBuilder :: TextBuilder -> Builder
fromTextBuilder = Text -> Builder
TextLazyBuilder.fromText forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TextBuilder -> Text
buildText

-- * Action

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

instance Semigroup Action where
  {-# INLINE (<>) #-}
  Action forall s. MArray s -> Int -> ST s Int
writeL <> :: Action -> Action -> Action
<> Action forall s. MArray s -> Int -> ST s Int
writeR =
    (forall s. MArray s -> Int -> ST s Int) -> Action
Action forall a b. (a -> b) -> a -> b
$ \MArray s
array Int
offset -> do
      Int
offsetAfter1 <- forall s. MArray s -> Int -> ST s Int
writeL MArray s
array Int
offset
      forall s. MArray s -> Int -> ST s Int
writeR MArray s
array Int
offsetAfter1

instance Monoid Action where
  {-# INLINE mempty #-}
  mempty :: Action
mempty = (forall s. MArray s -> Int -> ST s Int) -> Action
Action forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return

-- * --

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

instance Semigroup TextBuilder where
  <> :: TextBuilder -> TextBuilder -> TextBuilder
(<>) (TextBuilder Action
action1 Int
estimatedArraySize1 Int
textLength1) (TextBuilder Action
action2 Int
estimatedArraySize2 Int
textLength2) =
    Action -> Int -> Int -> TextBuilder
TextBuilder Action
action Int
estimatedArraySize Int
textLength
    where
      action :: Action
action = Action
action1 forall a. Semigroup a => a -> a -> a
<> Action
action2
      estimatedArraySize :: Int
estimatedArraySize = Int
estimatedArraySize1 forall a. Num a => a -> a -> a
+ Int
estimatedArraySize2
      textLength :: Int
textLength = Int
textLength1 forall a. Num a => a -> a -> a
+ Int
textLength2

instance Monoid TextBuilder where
  {-# INLINE mempty #-}
  mempty :: TextBuilder
mempty = Action -> Int -> Int -> TextBuilder
TextBuilder forall a. Monoid a => a
mempty Int
0 Int
0

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

instance Show TextBuilder where
  show :: TextBuilder -> String
show = Text -> String
Text.unpack forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TextBuilder -> Text
buildText

instance Eq TextBuilder where
  == :: TextBuilder -> TextBuilder -> Bool
(==) = forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Eq a => a -> a -> Bool
(==) TextBuilder -> Text
buildText

instance IsomorphicTo TextBuilder TextBuilder where
  to :: TextBuilder -> TextBuilder
to = forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

instance IsomorphicTo TextBuilder String where
  to :: String -> TextBuilder
to = String -> TextBuilder
TextBuilderDev.string

instance IsomorphicTo TextBuilder Text where
  to :: Text -> TextBuilder
to = Text -> TextBuilder
TextBuilderDev.text

instance IsomorphicTo TextBuilder TextLazy.Text where
  to :: Text -> TextBuilder
to = Text -> TextBuilder
TextBuilderDev.lazyText

instance IsomorphicTo TextBuilder TextLazyBuilder.Builder where
  to :: Builder -> TextBuilder
to = forall a b. IsomorphicTo a b => b -> a
to forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. IsomorphicTo a b => b -> a
to @TextLazy.Text

instance IsomorphicTo String TextBuilder where
  to :: TextBuilder -> String
to = forall a b. IsomorphicTo a b => b -> a
to forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. IsomorphicTo a b => b -> a
to @Text

instance IsomorphicTo Text TextBuilder where
  to :: TextBuilder -> Text
to = TextBuilder -> Text
TextBuilderDev.buildText

instance IsomorphicTo TextLazy.Text TextBuilder where
  to :: TextBuilder -> Text
to = forall a b. IsomorphicTo a b => b -> a
to forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. IsomorphicTo a b => b -> a
to @Text

instance IsomorphicTo TextLazyBuilder.Builder TextBuilder where
  to :: TextBuilder -> Builder
to = forall a b. IsomorphicTo a b => b -> a
to forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. IsomorphicTo a b => b -> a
to @Text

-- * Accessors

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

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

-- | Execute a builder producing a strict text.
buildText :: TextBuilder -> Text
buildText :: TextBuilder -> Text
buildText (TextBuilder (Action forall s. MArray s -> Int -> ST s Int
action) Int
sizeBound Int
_) =
  forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
    MArray s
array <- forall s. Int -> ST s (MArray s)
TextArray.new Int
sizeBound
    Int
offsetAfter <- forall s. MArray s -> Int -> ST s Int
action MArray s
array Int
0
    Array
frozenArray <- forall s. MArray s -> ST s Array
TextArray.unsafeFreeze MArray s
array
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Array -> Int -> Int -> Text
TextInternal.text Array
frozenArray Int
0 Int
offsetAfter

-- ** Output IO

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

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

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

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

-- * Constructors

-- |
-- Run the builder and pack the produced text into a new builder.
--
-- Useful to have around builders that you reuse,
-- because a forced builder is much faster,
-- since it's virtually a single call @memcopy@.
{-# INLINE force #-}
force :: TextBuilder -> TextBuilder
force :: TextBuilder -> TextBuilder
force = Text -> TextBuilder
text forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TextBuilder -> Text
buildText

-- | Unicode character.
{-# INLINE char #-}
char :: Char -> TextBuilder
char :: Char -> TextBuilder
char = Int -> TextBuilder
unicodeCodePoint forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> Int
ord

#if MIN_VERSION_text(2,0,0)

-- | Unicode code point.
{-# INLINE unicodeCodePoint #-}
unicodeCodePoint :: Int -> TextBuilder
unicodeCodePoint x =
  Utf8View.unicodeCodePoint x utf8CodeUnits1 utf8CodeUnits2 utf8CodeUnits3 utf8CodeUnits4

{-# INLINEABLE utf8CodeUnits1 #-}
utf8CodeUnits1 :: Word8 -> TextBuilder
utf8CodeUnits1 unit1 = TextBuilder action 1 1
  where
    action = Action $ \array offset ->
      TextArray.unsafeWrite array offset unit1
        $> succ offset

{-# INLINEABLE utf8CodeUnits2 #-}
utf8CodeUnits2 :: Word8 -> Word8 -> TextBuilder
utf8CodeUnits2 unit1 unit2 = TextBuilder action 2 1
  where
    action = Action $ \array offset -> do
      TextArray.unsafeWrite array (offset + 0) unit1
      TextArray.unsafeWrite array (offset + 1) unit2
      return $ offset + 2

{-# INLINEABLE utf8CodeUnits3 #-}
utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> TextBuilder
utf8CodeUnits3 unit1 unit2 unit3 = TextBuilder action 3 1
  where
    action = Action $ \array offset -> do
      TextArray.unsafeWrite array (offset + 0) unit1
      TextArray.unsafeWrite array (offset + 1) unit2
      TextArray.unsafeWrite array (offset + 2) unit3
      return $ offset + 3

{-# INLINEABLE utf8CodeUnits4 #-}
utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> TextBuilder
utf8CodeUnits4 unit1 unit2 unit3 unit4 = TextBuilder action 4 1
  where
    action = Action $ \array offset -> do
      TextArray.unsafeWrite array (offset + 0) unit1
      TextArray.unsafeWrite array (offset + 1) unit2
      TextArray.unsafeWrite array (offset + 2) unit3
      TextArray.unsafeWrite array (offset + 3) unit4
      return $ offset + 4

{-# INLINE utf16CodeUnits1 #-}
utf16CodeUnits1 :: Word16 -> TextBuilder
utf16CodeUnits1 = unicodeCodePoint . fromIntegral

{-# INLINE utf16CodeUnits2 #-}
utf16CodeUnits2 :: Word16 -> Word16 -> TextBuilder
utf16CodeUnits2 unit1 unit2 = unicodeCodePoint cp
  where
    cp = (((fromIntegral unit1 .&. 0x3FF) `shiftL` 10) .|. (fromIntegral unit2 .&. 0x3FF)) + 0x10000

#else

-- | Unicode code point.
{-# INLINE unicodeCodePoint #-}
unicodeCodePoint :: Int -> TextBuilder
unicodeCodePoint :: Int -> TextBuilder
unicodeCodePoint Int
x =
  Int -> Utf16View
Utf16View.unicodeCodePoint Int
x Word16 -> TextBuilder
utf16CodeUnits1 Word16 -> Word16 -> TextBuilder
utf16CodeUnits2

-- | Single code-unit UTF-16 character.
{-# INLINEABLE utf16CodeUnits1 #-}
utf16CodeUnits1 :: Word16 -> TextBuilder
utf16CodeUnits1 :: Word16 -> TextBuilder
utf16CodeUnits1 Word16
unit =
  Action -> Int -> Int -> TextBuilder
TextBuilder Action
action Int
1 Int
1
  where
    action :: Action
action =
      (forall s. MArray s -> Int -> ST s Int) -> Action
Action forall a b. (a -> b) -> a -> b
$ \MArray s
array Int
offset ->
        forall s. MArray s -> Int -> Word16 -> ST s ()
TextArray.unsafeWrite MArray s
array Int
offset Word16
unit
          forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Enum a => a -> a
succ Int
offset

-- | Double code-unit UTF-16 character.
{-# INLINEABLE utf16CodeUnits2 #-}
utf16CodeUnits2 :: Word16 -> Word16 -> TextBuilder
utf16CodeUnits2 :: Word16 -> Word16 -> TextBuilder
utf16CodeUnits2 Word16
unit1 Word16
unit2 =
  Action -> Int -> Int -> TextBuilder
TextBuilder Action
action Int
2 Int
1
  where
    action :: Action
action =
      (forall s. MArray s -> Int -> ST s Int) -> Action
Action forall a b. (a -> b) -> a -> b
$ \MArray s
array Int
offset -> do
        forall s. MArray s -> Int -> Word16 -> ST s ()
TextArray.unsafeWrite MArray s
array Int
offset Word16
unit1
        forall s. MArray s -> Int -> Word16 -> ST s ()
TextArray.unsafeWrite MArray s
array (forall a. Enum a => a -> a
succ Int
offset) Word16
unit2
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int
offset forall a. Num a => a -> a -> a
+ Int
2

-- | Single code-unit UTF-8 character.
{-# INLINE utf8CodeUnits1 #-}
utf8CodeUnits1 :: Word8 -> TextBuilder
utf8CodeUnits1 :: Word8 -> TextBuilder
utf8CodeUnits1 Word8
unit1 =
  Word8 -> Utf16View
Utf16View.utf8CodeUnits1 Word8
unit1 Word16 -> TextBuilder
utf16CodeUnits1 Word16 -> Word16 -> TextBuilder
utf16CodeUnits2

-- | Double code-unit UTF-8 character.
{-# INLINE utf8CodeUnits2 #-}
utf8CodeUnits2 :: Word8 -> Word8 -> TextBuilder
utf8CodeUnits2 :: Word8 -> Word8 -> TextBuilder
utf8CodeUnits2 Word8
unit1 Word8
unit2 =
  Word8 -> Word8 -> Utf16View
Utf16View.utf8CodeUnits2 Word8
unit1 Word8
unit2 Word16 -> TextBuilder
utf16CodeUnits1 Word16 -> Word16 -> TextBuilder
utf16CodeUnits2

-- | Triple code-unit UTF-8 character.
{-# INLINE utf8CodeUnits3 #-}
utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> TextBuilder
utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> TextBuilder
utf8CodeUnits3 Word8
unit1 Word8
unit2 Word8
unit3 =
  Word8 -> Word8 -> Word8 -> Utf16View
Utf16View.utf8CodeUnits3 Word8
unit1 Word8
unit2 Word8
unit3 Word16 -> TextBuilder
utf16CodeUnits1 Word16 -> Word16 -> TextBuilder
utf16CodeUnits2

-- | UTF-8 character out of 4 code units.
{-# INLINE utf8CodeUnits4 #-}
utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> TextBuilder
utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> TextBuilder
utf8CodeUnits4 Word8
unit1 Word8
unit2 Word8
unit3 Word8
unit4 =
  Word8 -> Word8 -> Word8 -> Word8 -> Utf16View
Utf16View.utf8CodeUnits4 Word8
unit1 Word8
unit2 Word8
unit3 Word8
unit4 Word16 -> TextBuilder
utf16CodeUnits1 Word16 -> Word16 -> TextBuilder
utf16CodeUnits2

#endif

-- | ASCII byte string.
--
-- It's your responsibility to ensure that the bytes are in proper range,
-- otherwise the produced text will be broken.
{-# INLINEABLE asciiByteString #-}
asciiByteString :: ByteString -> TextBuilder
asciiByteString :: ByteString -> TextBuilder
asciiByteString ByteString
byteString =
  Action -> Int -> Int -> TextBuilder
TextBuilder 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 Int) -> Action
Action forall a b. (a -> b) -> a -> b
$ \MArray s
array ->
        let step :: Word8 -> (Int -> ST s Int) -> Int -> ST s Int
step Word8
byte Int -> ST s Int
next Int
index = do
              forall s. MArray s -> Int -> Word16 -> ST s ()
TextArray.unsafeWrite MArray s
array Int
index (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
byte)
              Int -> ST s Int
next (forall a. Enum a => a -> a
succ Int
index)
         in forall a. (Word8 -> a -> a) -> a -> ByteString -> a
ByteString.foldr Word8 -> (Int -> ST s Int) -> Int -> ST s Int
step forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
byteString

-- | Strict text.
{-# INLINEABLE text #-}
text :: Text -> TextBuilder
#if MIN_VERSION_text(2,0,0)
text text@(TextInternal.Text array offset length) =
  TextBuilder action length (Text.length text)
  where
    action =
      Action $ \builderArray builderOffset -> do
        TextArray.copyI length builderArray builderOffset array offset
        return $ builderOffset + length
#else
text :: Text -> TextBuilder
text text :: Text
text@(TextInternal.Text Array
array Int
offset Int
length) =
  Action -> Int -> Int -> TextBuilder
TextBuilder Action
action Int
length (Text -> Int
Text.length Text
text)
  where
    action :: Action
action =
      (forall s. MArray s -> Int -> ST s Int) -> Action
Action forall a b. (a -> b) -> a -> b
$ \MArray s
builderArray Int
builderOffset -> do
        forall s. MArray s -> Int -> Array -> Int -> Int -> ST s ()
TextArray.copyI MArray s
builderArray Int
builderOffset Array
array Int
offset (Int
builderOffset forall a. Num a => a -> a -> a
+ Int
length)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int
builderOffset forall a. Num a => a -> a -> a
+ Int
length
#endif

-- | Lazy text.
{-# INLINE lazyText #-}
lazyText :: TextLazy.Text -> TextBuilder
lazyText :: Text -> TextBuilder
lazyText =
  forall a. (Text -> a -> a) -> a -> Text -> a
TextLazy.foldrChunks (forall a. Monoid a => a -> a -> a
mappend forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> TextBuilder
text) forall a. Monoid a => a
mempty

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

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

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

-- | 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 Char
separatorChar a
a =
  if a
a forall a. Ord a => a -> a -> Bool
>= a
0
    then forall a. Integral a => Char -> a -> TextBuilder
thousandSeparatedUnsignedDecimal Char
separatorChar a
a
    else Int -> TextBuilder
unicodeCodePoint Int
45 forall a. Semigroup a => a -> a -> a
<> forall a. Integral a => Char -> a -> TextBuilder
thousandSeparatedUnsignedDecimal Char
separatorChar (forall a. Num a => a -> a
negate a
a)

-- | 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 Char
separatorChar =
  a -> TextBuilder
processRightmostDigit
  where
    processRightmostDigit :: a -> TextBuilder
processRightmostDigit a
value =
      case forall a. Integral a => a -> a -> (a, a)
divMod a
value a
10 of
        (a
value, a
digit) ->
          [TextBuilder] -> Integer -> a -> TextBuilder
processAnotherDigit [forall a. Integral a => a -> TextBuilder
decimalDigit a
digit] Integer
1 a
value
    processAnotherDigit :: [TextBuilder] -> Integer -> a -> TextBuilder
processAnotherDigit [TextBuilder]
builders Integer
index a
value =
      if a
value forall a. Eq a => a -> a -> Bool
== a
0
        then forall a. Monoid a => [a] -> a
mconcat [TextBuilder]
builders
        else case forall a. Integral a => a -> a -> (a, a)
divMod a
value a
10 of
          (a
value, a
digit) ->
            if forall a. Integral a => a -> a -> a
mod Integer
index Integer
3 forall a. Eq a => a -> a -> Bool
== Integer
0
              then
                [TextBuilder] -> Integer -> a -> TextBuilder
processAnotherDigit
                  (forall a. Integral a => a -> TextBuilder
decimalDigit a
digit forall a. a -> [a] -> [a]
: Char -> TextBuilder
char Char
separatorChar forall a. a -> [a] -> [a]
: [TextBuilder]
builders)
                  (forall a. Enum a => a -> a
succ Integer
index)
                  a
value
              else
                [TextBuilder] -> Integer -> a -> TextBuilder
processAnotherDigit
                  (forall a. Integral a => a -> TextBuilder
decimalDigit a
digit forall a. a -> [a] -> [a]
: [TextBuilder]
builders)
                  (forall a. Enum a => a -> a
succ Integer
index)
                  a
value

-- | 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 Char
separatorChar a
amount =
  if a
amount forall a. Ord a => a -> a -> Bool
< a
1000
    then forall a. Integral a => a -> TextBuilder
unsignedDecimal a
amount forall a. Semigroup a => a -> a -> a
<> TextBuilder
"B"
    else
      if a
amount forall a. Ord a => a -> a -> Bool
< a
1000000
        then forall a. Integral a => Char -> a -> a -> TextBuilder
dividedDecimal Char
separatorChar a
100 a
amount forall a. Semigroup a => a -> a -> a
<> TextBuilder
"kB"
        else
          if a
amount forall a. Ord a => a -> a -> Bool
< a
1000000000
            then forall a. Integral a => Char -> a -> a -> TextBuilder
dividedDecimal Char
separatorChar a
100000 a
amount forall a. Semigroup a => a -> a -> a
<> TextBuilder
"MB"
            else
              if a
amount forall a. Ord a => a -> a -> Bool
< a
1000000000000
                then forall a. Integral a => Char -> a -> a -> TextBuilder
dividedDecimal Char
separatorChar a
100000000 a
amount forall a. Semigroup a => a -> a -> a
<> TextBuilder
"GB"
                else
                  if a
amount forall a. Ord a => a -> a -> Bool
< a
1000000000000000
                    then forall a. Integral a => Char -> a -> a -> TextBuilder
dividedDecimal Char
separatorChar a
100000000000 a
amount forall a. Semigroup a => a -> a -> a
<> TextBuilder
"TB"
                    else
                      if a
amount forall a. Ord a => a -> a -> Bool
< a
1000000000000000000
                        then forall a. Integral a => Char -> a -> a -> TextBuilder
dividedDecimal Char
separatorChar a
100000000000000 a
amount forall a. Semigroup a => a -> a -> a
<> TextBuilder
"PB"
                        else
                          if a
amount forall a. Ord a => a -> a -> Bool
< a
1000000000000000000000
                            then forall a. Integral a => Char -> a -> a -> TextBuilder
dividedDecimal Char
separatorChar a
100000000000000000 a
amount forall a. Semigroup a => a -> a -> a
<> TextBuilder
"EB"
                            else
                              if a
amount forall a. Ord a => a -> a -> Bool
< a
1000000000000000000000000
                                then forall a. Integral a => Char -> a -> a -> TextBuilder
dividedDecimal Char
separatorChar a
100000000000000000000 a
amount forall a. Semigroup a => a -> a -> a
<> TextBuilder
"ZB"
                                else forall a. Integral a => Char -> a -> a -> TextBuilder
dividedDecimal Char
separatorChar a
100000000000000000000000 a
amount forall a. Semigroup a => a -> a -> a
<> TextBuilder
"YB"

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

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

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

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

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

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

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

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

-- | Intercalate projecting values to builder.
{-# INLINE intercalateMap #-}
intercalateMap :: Foldable f => TextBuilder -> (a -> TextBuilder) -> f a -> TextBuilder
intercalateMap :: forall (f :: * -> *) a.
Foldable f =>
TextBuilder -> (a -> TextBuilder) -> f a -> TextBuilder
intercalateMap TextBuilder
separator a -> TextBuilder
mapper = forall {a}. Monoid a => Maybe a -> a
extract forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Maybe TextBuilder -> a -> Maybe TextBuilder
step forall {a}. Maybe a
init
  where
    init :: Maybe a
init = forall {a}. Maybe a
Nothing
    step :: Maybe TextBuilder -> a -> Maybe TextBuilder
step Maybe TextBuilder
acc a
element =
      forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ case Maybe TextBuilder
acc of
        Maybe TextBuilder
Nothing -> a -> TextBuilder
mapper a
element
        Just TextBuilder
acc -> TextBuilder
acc forall a. Semigroup a => a -> a -> a
<> TextBuilder
separator forall a. Semigroup a => a -> a -> a
<> a -> TextBuilder
mapper a
element
    extract :: Maybe a -> a
extract = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty

-- | 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
paddedLength Char
paddingChar TextBuilder
builder =
  let builderLength :: Int
builderLength = TextBuilder -> Int
length TextBuilder
builder
   in if Int
paddedLength forall a. Ord a => a -> a -> Bool
<= Int
builderLength
        then TextBuilder
builder
        else forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Char -> TextBuilder
char (forall a. Int -> a -> [a]
replicate (Int
paddedLength forall a. Num a => a -> a -> a
- Int
builderLength) Char
paddingChar) forall a. Semigroup a => a -> a -> a
<> TextBuilder
builder

-- | 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
paddedLength Char
paddingChar TextBuilder
builder =
  let builderLength :: Int
builderLength = TextBuilder -> Int
length TextBuilder
builder
   in if Int
paddedLength forall a. Ord a => a -> a -> Bool
<= Int
builderLength
        then TextBuilder
builder
        else TextBuilder
builder forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Char -> TextBuilder
char (forall a. Int -> a -> [a]
replicate (Int
paddedLength forall a. Num a => a -> a -> a
- Int
builderLength) Char
paddingChar)

-- |
-- General template for formatting date values according to the ISO8601 standard.
-- The format is the following:
--
-- > 2021-11-24T12:11:02Z
--
-- Integrations with various time-libraries can be easily derived from that.
utcTimestampInIso8601 ::
  -- | Year.
  Int ->
  -- | Month.
  Int ->
  -- | Day.
  Int ->
  -- | Hour.
  Int ->
  -- | Minute.
  Int ->
  -- | Second.
  Int ->
  TextBuilder
utcTimestampInIso8601 :: Int -> Int -> Int -> Int -> Int -> Int -> TextBuilder
utcTimestampInIso8601 Int
y Int
mo Int
d Int
h Int
mi Int
s =
  forall a. Monoid a => [a] -> a
mconcat
    [ Int -> Char -> TextBuilder -> TextBuilder
padFromLeft Int
4 Char
'0' forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> TextBuilder
decimal Int
y,
      TextBuilder
"-",
      Int -> Char -> TextBuilder -> TextBuilder
padFromLeft Int
2 Char
'0' forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> TextBuilder
decimal Int
mo,
      TextBuilder
"-",
      Int -> Char -> TextBuilder -> TextBuilder
padFromLeft Int
2 Char
'0' forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> TextBuilder
decimal Int
d,
      TextBuilder
"T",
      Int -> Char -> TextBuilder -> TextBuilder
padFromLeft Int
2 Char
'0' forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> TextBuilder
decimal Int
h,
      TextBuilder
":",
      Int -> Char -> TextBuilder -> TextBuilder
padFromLeft Int
2 Char
'0' forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> TextBuilder
decimal Int
mi,
      TextBuilder
":",
      Int -> Char -> TextBuilder -> TextBuilder
padFromLeft Int
2 Char
'0' forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> TextBuilder
decimal Int
s,
      TextBuilder
"Z"
    ]

-- |
-- 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 seconds
interval = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> a
evalState (forall a b. (RealFrac a, Integral b) => a -> b
round seconds
interval) forall a b. (a -> b) -> a -> b
$ do
  Integer
seconds <- forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state (forall a b. (a, b) -> (b, a)
swap forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Integral a => a -> a -> (a, a)
divMod Integer
60)
  Integer
minutes <- forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state (forall a b. (a, b) -> (b, a)
swap forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Integral a => a -> a -> (a, a)
divMod Integer
60)
  Integer
hours <- forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state (forall a b. (a, b) -> (b, a)
swap forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Integral a => a -> a -> (a, a)
divMod Integer
24)
  Integer
days <- forall (m :: * -> *) s. Monad m => StateT s m s
get
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    Int -> Char -> TextBuilder -> TextBuilder
padFromLeft Int
2 Char
'0' (forall a. Integral a => a -> TextBuilder
decimal Integer
days)
      forall a. Semigroup a => a -> a -> a
<> TextBuilder
":"
      forall a. Semigroup a => a -> a -> a
<> Int -> Char -> TextBuilder -> TextBuilder
padFromLeft Int
2 Char
'0' (forall a. Integral a => a -> TextBuilder
decimal Integer
hours)
      forall a. Semigroup a => a -> a -> a
<> TextBuilder
":"
      forall a. Semigroup a => a -> a -> a
<> Int -> Char -> TextBuilder -> TextBuilder
padFromLeft Int
2 Char
'0' (forall a. Integral a => a -> TextBuilder
decimal Integer
minutes)
      forall a. Semigroup a => a -> a -> a
<> TextBuilder
":"
      forall a. Semigroup a => a -> a -> a
<> Int -> Char -> TextBuilder -> TextBuilder
padFromLeft Int
2 Char
'0' (forall a. Integral a => a -> TextBuilder
decimal Integer
seconds)

-- | 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
decimalPlaces = forall a. IsString a => String -> a
fromString forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall r. PrintfType r => String -> r
printf (String
"%." forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
decimalPlaces 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 ::
  -- | Amount of decimals after point.
  Int ->
  Double ->
  TextBuilder
doublePercent :: Int -> Double -> TextBuilder
doublePercent Int
decimalPlaces Double
x = Int -> Double -> TextBuilder
fixedDouble Int
decimalPlaces (Double
x forall a. Num a => a -> a -> a
* Double
100) forall a. Semigroup a => a -> a -> a
<> TextBuilder
"%"

-- | Hexadecimal readable representation of binary data.
{-# INLINE hexData #-}
hexData :: ByteString -> TextBuilder
hexData :: ByteString -> TextBuilder
hexData =
  forall (f :: * -> *).
Foldable f =>
TextBuilder -> f TextBuilder -> TextBuilder
intercalate TextBuilder
" "
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Monoid a => [a] -> a
mconcat
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall e. Int -> [e] -> [[e]]
Split.chunksOf Int
2
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Integral a => a -> TextBuilder
byte
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> [Word8]
ByteString.unpack
  where
    byte :: a -> TextBuilder
byte =
      Int -> Char -> TextBuilder -> TextBuilder
padFromLeft Int
2 Char
'0' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Integral a => a -> TextBuilder
unsignedHexadecimal