module TextBuilderDev
  ( TextBuilder,

    -- * Accessors
    buildText,
    length,
    null,

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

    -- * Constructors

    -- ** Helper class
    ToTextBuilder (..),

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

    -- ** Textual
    text,
    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,
  )
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 B
import qualified Data.Text.Encoding as E
import qualified Data.Text.Encoding.Error as E
import qualified Data.Text.IO as Text
import qualified Data.Text.Internal as C
import qualified DeferredFolds.Unfoldr as Unfoldr
import TextBuilderDev.Prelude hiding (intercalate, length, null)
import qualified TextBuilderDev.UTF16 as D

-- *

-- |
-- Default conversion to text builder.
class ToTextBuilder a where
  toTextBuilder :: a -> TextBuilder

instance ToTextBuilder TextBuilder where
  toTextBuilder :: TextBuilder -> TextBuilder
toTextBuilder = TextBuilder -> TextBuilder
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id

instance ToTextBuilder Text where
  toTextBuilder :: Text -> TextBuilder
toTextBuilder = Text -> TextBuilder
text

instance ToTextBuilder String where
  toTextBuilder :: String -> TextBuilder
toTextBuilder = String -> TextBuilder
forall a. IsString a => String -> a
fromString

-- *

-- |
-- 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

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

instance Semigroup TextBuilder where
  <> :: TextBuilder -> TextBuilder -> TextBuilder
(<>) (TextBuilder (Action forall s. MArray s -> Int -> ST s ()
action1) Int
arraySize1 Int
charsAmount1) (TextBuilder (Action forall s. MArray s -> Int -> ST s ()
action2) Int
arraySize2 Int
charsAmount2) =
    Action -> Int -> Int -> TextBuilder
TextBuilder 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 Monoid TextBuilder where
  {-# INLINE mempty #-}
  mempty :: TextBuilder
mempty =
    Action -> Int -> Int -> TextBuilder
TextBuilder ((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

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

instance Show TextBuilder where
  show :: TextBuilder -> String
show = Text -> String
Text.unpack (Text -> String) -> (TextBuilder -> Text) -> TextBuilder -> String
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 FromText TextBuilder where
  fromText :: Text -> TextBuilder
fromText = Text -> TextBuilder
text

instance ToText TextBuilder where
  toText :: TextBuilder -> Text
toText = TextBuilder -> Text
buildText

instance ToString TextBuilder where
  toString :: TextBuilder -> String
toString = Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> (TextBuilder -> Text) -> TextBuilder -> String
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

-- * 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 = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int -> Bool) -> (TextBuilder -> Int) -> TextBuilder -> Bool
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 ()
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 :: TextBuilder -> IO ()
putToStdOut :: TextBuilder -> IO ()
putToStdOut = Handle -> Text -> IO ()
Text.hPutStr Handle
stdout (Text -> IO ()) -> (TextBuilder -> Text) -> TextBuilder -> IO ()
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 (Text -> IO ()) -> (TextBuilder -> Text) -> TextBuilder -> IO ()
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 (Text -> IO ()) -> (TextBuilder -> Text) -> TextBuilder -> IO ()
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 (Text -> IO ()) -> (TextBuilder -> Text) -> TextBuilder -> IO ()
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 (Text -> TextBuilder)
-> (TextBuilder -> Text) -> TextBuilder -> TextBuilder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TextBuilder -> Text
forall a. ToText a => a -> Text
toText

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

-- | Unicode code point
{-# INLINE unicodeCodePoint #-}
unicodeCodePoint :: Int -> TextBuilder
unicodeCodePoint :: Int -> TextBuilder
unicodeCodePoint Int
x =
  Int
-> (Word16 -> TextBuilder)
-> (Word16 -> Word16 -> TextBuilder)
-> TextBuilder
Int -> UTF16View
D.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 ()) -> 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
{-# 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 ()) -> 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 -> TextBuilder
utf8CodeUnits1 :: Word8 -> TextBuilder
utf8CodeUnits1 Word8
unit1 =
  Word8
-> (Word16 -> TextBuilder)
-> (Word16 -> Word16 -> TextBuilder)
-> TextBuilder
Word8 -> UTF16View
D.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
-> (Word16 -> TextBuilder)
-> (Word16 -> Word16 -> TextBuilder)
-> TextBuilder
Word8 -> Word8 -> UTF16View
D.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
-> (Word16 -> TextBuilder)
-> (Word16 -> Word16 -> TextBuilder)
-> TextBuilder
Word8 -> Word8 -> Word8 -> UTF16View
D.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
-> (Word16 -> TextBuilder)
-> (Word16 -> Word16 -> TextBuilder)
-> TextBuilder
Word8 -> Word8 -> Word8 -> Word8 -> UTF16View
D.utf8CodeUnits4 Word8
unit1 Word8
unit2 Word8
unit3 Word8
unit4 Word16 -> TextBuilder
utf16CodeUnits1 Word16 -> Word16 -> TextBuilder
utf16CodeUnits2

-- | ASCII byte string
{-# 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 ()) -> 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
{-# INLINEABLE text #-}
text :: Text -> TextBuilder
text :: Text -> TextBuilder
text text :: Text
text@(C.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 ()) -> 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 -> TextBuilder
string :: String -> TextBuilder
string =
  (Char -> TextBuilder) -> String -> TextBuilder
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 :: a -> TextBuilder
decimal a
i =
  if a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0
    then a -> TextBuilder
forall a. Integral a => a -> TextBuilder
unsignedDecimal a
i
    else Int -> TextBuilder
unicodeCodePoint Int
45 TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> a -> TextBuilder
forall a. Integral a => a -> TextBuilder
unsignedDecimal (a -> a
forall a. Num a => a -> a
negate a
i)

-- | Decimal representation of an unsigned integral value
{-# INLINEABLE unsignedDecimal #-}
unsignedDecimal :: Integral a => a -> TextBuilder
unsignedDecimal :: a -> TextBuilder
unsignedDecimal =
  (a -> TextBuilder) -> Unfoldr a -> TextBuilder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimalDigit (Unfoldr a -> TextBuilder) -> (a -> Unfoldr a) -> a -> TextBuilder
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
{-# INLINEABLE thousandSeparatedDecimal #-}
thousandSeparatedDecimal :: Integral a => Char -> a -> TextBuilder
thousandSeparatedDecimal :: Char -> a -> TextBuilder
thousandSeparatedDecimal Char
separatorChar a
a =
  if a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0
    then Char -> a -> TextBuilder
forall a. Integral a => Char -> a -> TextBuilder
thousandSeparatedUnsignedDecimal Char
separatorChar a
a
    else Int -> TextBuilder
unicodeCodePoint Int
45 TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> Char -> a -> TextBuilder
forall a. Integral a => Char -> a -> TextBuilder
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
{-# INLINEABLE thousandSeparatedUnsignedDecimal #-}
thousandSeparatedUnsignedDecimal :: Integral a => Char -> a -> TextBuilder
thousandSeparatedUnsignedDecimal :: Char -> a -> TextBuilder
thousandSeparatedUnsignedDecimal Char
separatorChar a
a =
  Unfoldr TextBuilder -> TextBuilder
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Unfoldr TextBuilder -> TextBuilder)
-> Unfoldr TextBuilder -> TextBuilder
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 TextBuilder -> Unfoldr TextBuilder
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimalDigit a
digit TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> Char -> TextBuilder
char Char
separatorChar)
      else TextBuilder -> Unfoldr TextBuilder
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimalDigit a
digit)

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

dividedDecimal :: Integral a => Char -> a -> a -> TextBuilder
dividedDecimal :: Char -> a -> a -> TextBuilder
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 -> TextBuilder
forall a. Integral a => Char -> a -> TextBuilder
thousandSeparatedDecimal Char
separatorChar a
byExtraTen
        else Char -> a -> TextBuilder
forall a. Integral a => Char -> a -> TextBuilder
thousandSeparatedDecimal Char
separatorChar a
byExtraTen TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
"." TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> a -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimalDigit a
remainder

-- | Unsigned binary number
{-# INLINE unsignedBinary #-}
unsignedBinary :: Integral a => a -> TextBuilder
unsignedBinary :: a -> TextBuilder
unsignedBinary =
  (a -> TextBuilder) -> Unfoldr a -> TextBuilder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimalDigit (Unfoldr a -> TextBuilder) -> (a -> Unfoldr a) -> a -> TextBuilder
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 -> TextBuilder
unsignedPaddedBinary :: a -> TextBuilder
unsignedPaddedBinary a
a =
  Int -> Char -> TextBuilder -> TextBuilder
padFromLeft (a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize a
a) Char
'0' (TextBuilder -> TextBuilder) -> TextBuilder -> TextBuilder
forall a b. (a -> b) -> a -> b
$ (a -> TextBuilder) -> Unfoldr a -> TextBuilder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimalDigit (Unfoldr a -> TextBuilder) -> Unfoldr a -> TextBuilder
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 -> TextBuilder
hexadecimal :: a -> TextBuilder
hexadecimal a
i =
  if a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0
    then a -> TextBuilder
forall a. Integral a => a -> TextBuilder
unsignedHexadecimal a
i
    else Int -> TextBuilder
unicodeCodePoint Int
45 TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> a -> TextBuilder
forall a. Integral a => a -> TextBuilder
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 -> TextBuilder
unsignedHexadecimal :: a -> TextBuilder
unsignedHexadecimal =
  (a -> TextBuilder) -> Unfoldr a -> TextBuilder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> TextBuilder
forall a. Integral a => a -> TextBuilder
hexadecimalDigit (Unfoldr a -> TextBuilder) -> (a -> Unfoldr a) -> a -> TextBuilder
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 -> TextBuilder
decimalDigit :: a -> TextBuilder
decimalDigit a
n =
  Int -> TextBuilder
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 -> TextBuilder
hexadecimalDigit :: a -> TextBuilder
hexadecimalDigit a
n =
  if a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
9
    then Int -> TextBuilder
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 -> TextBuilder
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 => TextBuilder -> foldable TextBuilder -> TextBuilder
intercalate :: TextBuilder -> foldable TextBuilder -> TextBuilder
intercalate TextBuilder
separator = Product2 Bool TextBuilder -> TextBuilder
forall a b. Product2 a b -> b
extract (Product2 Bool TextBuilder -> TextBuilder)
-> (foldable TextBuilder -> Product2 Bool TextBuilder)
-> foldable TextBuilder
-> TextBuilder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Product2 Bool TextBuilder
 -> TextBuilder -> Product2 Bool TextBuilder)
-> Product2 Bool TextBuilder
-> foldable TextBuilder
-> Product2 Bool TextBuilder
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Product2 Bool TextBuilder
-> TextBuilder -> Product2 Bool TextBuilder
step Product2 Bool TextBuilder
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 TextBuilder
-> TextBuilder -> Product2 Bool TextBuilder
step (Product2 Bool
isNotFirst TextBuilder
builder) TextBuilder
element =
      Bool -> TextBuilder -> Product2 Bool TextBuilder
forall a b. a -> b -> Product2 a b
Product2 Bool
True (TextBuilder -> Product2 Bool TextBuilder)
-> TextBuilder -> Product2 Bool TextBuilder
forall a b. (a -> b) -> a -> b
$
        if Bool
isNotFirst
          then TextBuilder
builder TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
separator TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
element
          else TextBuilder
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
{-# 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
builderLength
        then TextBuilder
builder
        else (Char -> TextBuilder) -> String -> TextBuilder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Char -> TextBuilder
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) TextBuilder -> TextBuilder -> TextBuilder
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
builderLength
        then TextBuilder
builder
        else TextBuilder
builder TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> (Char -> TextBuilder) -> String -> TextBuilder
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Char -> TextBuilder
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)

-- |
-- 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 =
  [TextBuilder] -> TextBuilder
forall a. Monoid a => [a] -> a
mconcat
    [ Int -> Char -> TextBuilder -> TextBuilder
padFromLeft Int
4 Char
'0' (TextBuilder -> TextBuilder) -> TextBuilder -> TextBuilder
forall a b. (a -> b) -> a -> b
$ Int -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal Int
y,
      TextBuilder
"-",
      Int -> Char -> TextBuilder -> TextBuilder
padFromLeft Int
2 Char
'0' (TextBuilder -> TextBuilder) -> TextBuilder -> TextBuilder
forall a b. (a -> b) -> a -> b
$ Int -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal Int
mo,
      TextBuilder
"-",
      Int -> Char -> TextBuilder -> TextBuilder
padFromLeft Int
2 Char
'0' (TextBuilder -> TextBuilder) -> TextBuilder -> TextBuilder
forall a b. (a -> b) -> a -> b
$ Int -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal Int
d,
      TextBuilder
"T",
      Int -> Char -> TextBuilder -> TextBuilder
padFromLeft Int
2 Char
'0' (TextBuilder -> TextBuilder) -> TextBuilder -> TextBuilder
forall a b. (a -> b) -> a -> b
$ Int -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal Int
h,
      TextBuilder
":",
      Int -> Char -> TextBuilder -> TextBuilder
padFromLeft Int
2 Char
'0' (TextBuilder -> TextBuilder) -> TextBuilder -> TextBuilder
forall a b. (a -> b) -> a -> b
$ Int -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal Int
mi,
      TextBuilder
":",
      Int -> Char -> TextBuilder -> TextBuilder
padFromLeft Int
2 Char
'0' (TextBuilder -> TextBuilder) -> TextBuilder -> TextBuilder
forall a b. (a -> b) -> a -> b
$ Int -> TextBuilder
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 :: seconds -> TextBuilder
intervalInSeconds seconds
interval = (State Integer TextBuilder -> Integer -> TextBuilder)
-> Integer -> State Integer TextBuilder -> TextBuilder
forall a b c. (a -> b -> c) -> b -> a -> c
flip State Integer TextBuilder -> Integer -> TextBuilder
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 TextBuilder -> TextBuilder)
-> State Integer TextBuilder -> TextBuilder
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
  TextBuilder -> State Integer TextBuilder
forall (m :: * -> *) a. Monad m => a -> m a
return (TextBuilder -> State Integer TextBuilder)
-> TextBuilder -> State Integer TextBuilder
forall a b. (a -> b) -> a -> b
$
    Int -> Char -> TextBuilder -> TextBuilder
padFromLeft Int
2 Char
'0' (Integer -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal Integer
days) TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
":"
      TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> TextBuilder -> TextBuilder
padFromLeft Int
2 Char
'0' (Integer -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal Integer
hours)
      TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
":"
      TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> TextBuilder -> TextBuilder
padFromLeft Int
2 Char
'0' (Integer -> TextBuilder
forall a. Integral a => a -> TextBuilder
decimal Integer
minutes)
      TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
":"
      TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> TextBuilder -> TextBuilder
padFromLeft Int
2 Char
'0' (Integer -> TextBuilder
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 = String -> TextBuilder
forall a. IsString a => String -> a
fromString (String -> TextBuilder)
-> (Double -> String) -> Double -> TextBuilder
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 ::
  -- | 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 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100) TextBuilder -> TextBuilder -> TextBuilder
forall a. Semigroup a => a -> a -> a
<> TextBuilder
"%"

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