packages feed

text-builder-dev (empty) → 0.1

raw patch · 8 files changed

+947/−0 lines, 8 filesdep +QuickCheckdep +basedep +bytestring

Dependencies added: QuickCheck, base, bytestring, criterion, deferred-folds, quickcheck-instances, rerebase, split, tasty, tasty-hunit, tasty-quickcheck, text, text-builder-dev, text-conversions, tostring, transformers

Files

+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2022, Nikita Volkov++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.
+ benchmark-char/Main.hs view
@@ -0,0 +1,57 @@+module Main where++import Criterion.Main+import qualified Data.Text as D+import qualified Data.Text.Lazy as C+import qualified Data.Text.Lazy.Builder as B+import qualified TextBuilderDev as A+import Prelude++main =+  defaultMain $+    [ subjectBenchmark "builderSubject" builderSubject,+      subjectBenchmark "lazyTextBuilderDevSubject" lazyTextBuilderDevSubject,+      subjectBenchmark "plainTextPackingSubject" plainTextPackingSubject+    ]++subjectBenchmark :: String -> Subject -> Benchmark+subjectBenchmark title subject =+  bgroup title $+    [ benchmark "Small input" smallInput subject,+      benchmark "Medium input" mediumInput subject,+      benchmark "Large input" largeInput subject+    ]++benchmark :: String -> [Int] -> Subject -> Benchmark+benchmark title input subject =+  bench title $ nf subject $ input++type Subject =+  [Int] -> Text++builderSubject :: Subject+builderSubject =+  A.buildText . A.string . map chr++lazyTextBuilderDevSubject :: Subject+lazyTextBuilderDevSubject =+  C.toStrict . B.toLazyText . B.fromString . map chr++plainTextPackingSubject :: Subject+plainTextPackingSubject =+  D.pack . map chr++{-# NOINLINE smallInput #-}+smallInput :: [Int]+smallInput =+  map ord ['a', 'b', 'Ф', '漢', chr 0x11000]++{-# NOINLINE mediumInput #-}+mediumInput :: [Int]+mediumInput =+  mconcat (replicate 1000 smallInput)++{-# NOINLINE largeInput #-}+largeInput :: [Int]+largeInput =+  mconcat (replicate 100000 smallInput)
+ benchmark-text/Main.hs view
@@ -0,0 +1,53 @@+module Main where++import Criterion.Main+import qualified Data.Text as D+import qualified Data.Text.Lazy as C+import qualified Data.Text.Lazy.Builder as B+import qualified TextBuilderDev as A+import Prelude++main =+  defaultMain $+    [ subjectBenchmark "builderSubject" builderSubject,+      subjectBenchmark "lazyTextBuilderDevSubject" lazyTextBuilderDevSubject+    ]++subjectBenchmark :: String -> Subject -> Benchmark+subjectBenchmark title subject =+  bgroup title $+    [ benchmark "Small input" smallSample subject,+      benchmark "Large input" largeSample subject+    ]++benchmark :: String -> Sample -> Subject -> Benchmark+benchmark title sample subject =+  bench title $ nf sample $ subject++data Subject+  = forall a. Subject (Text -> a) (a -> a -> a) a (a -> Text)++type Sample =+  Subject -> Text++builderSubject :: Subject+builderSubject =+  Subject A.text mappend mempty A.buildText++lazyTextBuilderDevSubject :: Subject+lazyTextBuilderDevSubject =+  Subject B.fromText mappend mempty (C.toStrict . B.toLazyText)++{-# NOINLINE smallSample #-}+smallSample :: Sample+smallSample (Subject text (<>) mempty run) =+  run $+    text "abcd" <> (text "ABCD" <> text "Фываолдж") <> text "漢"++{-# NOINLINE largeSample #-}+largeSample :: Sample+largeSample (Subject text (<>) mempty run) =+  run $+    foldl' (<>) mempty $+      replicate 100000 $+        text "abcd" <> (text "ABCD" <> text "Фываолдж") <> text "漢"
+ library/TextBuilderDev.hs view
@@ -0,0 +1,510 @@+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+  toTextBuilderDev :: a -> TextBuilder++instance ToTextBuilder TextBuilder where+  toTextBuilderDev = id++instance ToTextBuilder Text where+  toTextBuilderDev = text++instance ToTextBuilder String where+  toTextBuilderDev = 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 (Action action1) arraySize1 charsAmount1) (TextBuilder (Action action2) arraySize2 charsAmount2) =+    TextBuilder action arraySize charsAmount+    where+      action =+        Action $ \array offset -> do+          action1 array offset+          action2 array (offset + arraySize1)+      arraySize =+        arraySize1 + arraySize2+      charsAmount =+        charsAmount1 + charsAmount2++instance Monoid TextBuilder where+  {-# INLINE mempty #-}+  mempty =+    TextBuilder (Action (\_ _ -> return ())) 0 0++instance IsString TextBuilder where+  fromString = string++instance Show TextBuilder where+  show = Text.unpack . buildText++instance FromText TextBuilder where+  fromText = text++instance ToText TextBuilder where+  toText = buildText++instance ToString TextBuilder where+  toString = toString . buildText++-- * Accessors++-- | Get the amount of characters+{-# INLINE length #-}+length :: TextBuilder -> Int+length (TextBuilder _ _ x) = x++-- | Check whether the builder is empty+{-# INLINE null #-}+null :: TextBuilder -> Bool+null = (== 0) . length++-- | Execute a builder producing a strict text+buildText :: TextBuilder -> Text+buildText (TextBuilder (Action action) arraySize _) =+  C.text array 0 arraySize+  where+    array =+      runST $ do+        array <- B.new arraySize+        action array 0+        B.unsafeFreeze array++-- ** Output IO++-- | Put builder, to stdout+putToStdOut :: TextBuilder -> IO ()+putToStdOut = Text.hPutStr stdout . buildText++-- | Put builder, to stderr+putToStdErr :: TextBuilder -> IO ()+putToStdErr = Text.hPutStr stderr . buildText++-- | Put builder, followed by a line, to stdout+putLnToStdOut :: TextBuilder -> IO ()+putLnToStdOut = Text.hPutStrLn stdout . buildText++-- | Put builder, followed by a line, to stderr+putLnToStdErr :: TextBuilder -> IO ()+putLnToStdErr = Text.hPutStrLn stderr . 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 = text . toText++-- | Unicode character+{-# INLINE char #-}+char :: Char -> TextBuilder+char x =+  unicodeCodePoint (ord x)++-- | Unicode code point+{-# INLINE unicodeCodePoint #-}+unicodeCodePoint :: Int -> TextBuilder+unicodeCodePoint x =+  D.unicodeCodePoint x utf16CodeUnits1 utf16CodeUnits2++-- | Single code-unit UTF-16 character+{-# INLINEABLE utf16CodeUnits1 #-}+utf16CodeUnits1 :: Word16 -> TextBuilder+utf16CodeUnits1 unit =+  TextBuilder action 1 1+  where+    action =+      Action $ \array offset -> B.unsafeWrite array offset unit++-- | Double code-unit UTF-16 character+{-# INLINEABLE utf16CodeUnits2 #-}+utf16CodeUnits2 :: Word16 -> Word16 -> TextBuilder+utf16CodeUnits2 unit1 unit2 =+  TextBuilder action 2 1+  where+    action =+      Action $ \array offset -> do+        B.unsafeWrite array offset unit1+        B.unsafeWrite array (succ offset) unit2++-- | Single code-unit UTF-8 character+{-# INLINE utf8CodeUnits1 #-}+utf8CodeUnits1 :: Word8 -> TextBuilder+utf8CodeUnits1 unit1 =+  D.utf8CodeUnits1 unit1 utf16CodeUnits1 utf16CodeUnits2++-- | Double code-unit UTF-8 character+{-# INLINE utf8CodeUnits2 #-}+utf8CodeUnits2 :: Word8 -> Word8 -> TextBuilder+utf8CodeUnits2 unit1 unit2 =+  D.utf8CodeUnits2 unit1 unit2 utf16CodeUnits1 utf16CodeUnits2++-- | Triple code-unit UTF-8 character+{-# INLINE utf8CodeUnits3 #-}+utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> TextBuilder+utf8CodeUnits3 unit1 unit2 unit3 =+  D.utf8CodeUnits3 unit1 unit2 unit3 utf16CodeUnits1 utf16CodeUnits2++-- | UTF-8 character out of 4 code units+{-# INLINE utf8CodeUnits4 #-}+utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> TextBuilder+utf8CodeUnits4 unit1 unit2 unit3 unit4 =+  D.utf8CodeUnits4 unit1 unit2 unit3 unit4 utf16CodeUnits1 utf16CodeUnits2++-- | ASCII byte string+{-# INLINEABLE asciiByteString #-}+asciiByteString :: ByteString -> TextBuilder+asciiByteString byteString =+  TextBuilder action length length+  where+    length = ByteString.length byteString+    action =+      Action $ \array ->+        let step byte next index = do+              B.unsafeWrite array index (fromIntegral byte)+              next (succ index)+         in ByteString.foldr step (const (return ())) byteString++-- | Strict text+{-# INLINEABLE text #-}+text :: Text -> TextBuilder+text text@(C.Text array offset length) =+  TextBuilder action length (Text.length text)+  where+    action =+      Action $ \builderArray builderOffset -> do+        B.copyI builderArray builderOffset array offset (builderOffset + length)++-- | String+{-# INLINE string #-}+string :: String -> TextBuilder+string =+  foldMap char++-- | Decimal representation of an integral value+{-# INLINEABLE decimal #-}+decimal :: Integral a => a -> TextBuilder+decimal i =+  if i >= 0+    then unsignedDecimal i+    else unicodeCodePoint 45 <> unsignedDecimal (negate i)++-- | Decimal representation of an unsigned integral value+{-# INLINEABLE unsignedDecimal #-}+unsignedDecimal :: Integral a => a -> TextBuilder+unsignedDecimal =+  foldMap decimalDigit . Unfoldr.decimalDigits++-- | Decimal representation of an integral value with thousands separated by the specified character+{-# INLINEABLE thousandSeparatedDecimal #-}+thousandSeparatedDecimal :: Integral a => Char -> a -> TextBuilder+thousandSeparatedDecimal separatorChar a =+  if a >= 0+    then thousandSeparatedUnsignedDecimal separatorChar a+    else unicodeCodePoint 45 <> thousandSeparatedUnsignedDecimal separatorChar (negate a)++-- | Decimal representation of an unsigned integral value with thousands separated by the specified character+{-# INLINEABLE thousandSeparatedUnsignedDecimal #-}+thousandSeparatedUnsignedDecimal :: Integral a => Char -> a -> TextBuilder+thousandSeparatedUnsignedDecimal separatorChar a =+  fold $ do+    (index, digit) <- Unfoldr.zipWithReverseIndex $ Unfoldr.decimalDigits a+    if mod index 3 == 0 && index /= 0+      then return (decimalDigit digit <> char separatorChar)+      else return (decimalDigit digit)++-- | Data size in decimal notation over amount of bytes.+{-# INLINEABLE dataSizeInBytesInDecimal #-}+dataSizeInBytesInDecimal :: Integral a => Char -> a -> TextBuilder+dataSizeInBytesInDecimal separatorChar amount =+  if amount < 1000+    then unsignedDecimal amount <> "B"+    else+      if amount < 1000000+        then dividedDecimal separatorChar 100 amount <> "kB"+        else+          if amount < 1000000000+            then dividedDecimal separatorChar 100000 amount <> "MB"+            else+              if amount < 1000000000000+                then dividedDecimal separatorChar 100000000 amount <> "GB"+                else+                  if amount < 1000000000000000+                    then dividedDecimal separatorChar 100000000000 amount <> "TB"+                    else+                      if amount < 1000000000000000000+                        then dividedDecimal separatorChar 100000000000000 amount <> "PB"+                        else+                          if amount < 1000000000000000000000+                            then dividedDecimal separatorChar 100000000000000000 amount <> "EB"+                            else+                              if amount < 1000000000000000000000000+                                then dividedDecimal separatorChar 100000000000000000000 amount <> "ZB"+                                else dividedDecimal separatorChar 100000000000000000000000 amount <> "YB"++dividedDecimal :: Integral a => Char -> a -> a -> TextBuilder+dividedDecimal separatorChar divisor n =+  let byDivisor = div n divisor+      byExtraTen = div byDivisor 10+      remainder = byDivisor - byExtraTen * 10+   in if remainder == 0 || byExtraTen >= 10+        then thousandSeparatedDecimal separatorChar byExtraTen+        else thousandSeparatedDecimal separatorChar byExtraTen <> "." <> decimalDigit remainder++-- | Unsigned binary number+{-# INLINE unsignedBinary #-}+unsignedBinary :: Integral a => a -> TextBuilder+unsignedBinary =+  foldMap decimalDigit . Unfoldr.binaryDigits++-- | Unsigned binary number+{-# INLINE unsignedPaddedBinary #-}+unsignedPaddedBinary :: (Integral a, FiniteBits a) => a -> TextBuilder+unsignedPaddedBinary a =+  padFromLeft (finiteBitSize a) '0' $ foldMap decimalDigit $ Unfoldr.binaryDigits a++-- | Hexadecimal representation of an integral value+{-# INLINE hexadecimal #-}+hexadecimal :: Integral a => a -> TextBuilder+hexadecimal i =+  if i >= 0+    then unsignedHexadecimal i+    else unicodeCodePoint 45 <> unsignedHexadecimal (negate i)++-- | Unsigned hexadecimal representation of an integral value+{-# INLINE unsignedHexadecimal #-}+unsignedHexadecimal :: Integral a => a -> TextBuilder+unsignedHexadecimal =+  foldMap hexadecimalDigit . Unfoldr.hexadecimalDigits++-- | Decimal digit+{-# INLINE decimalDigit #-}+decimalDigit :: Integral a => a -> TextBuilder+decimalDigit n =+  unicodeCodePoint (fromIntegral n + 48)++-- | Hexadecimal digit+{-# INLINE hexadecimalDigit #-}+hexadecimalDigit :: Integral a => a -> TextBuilder+hexadecimalDigit n =+  if n <= 9+    then unicodeCodePoint (fromIntegral n + 48)+    else unicodeCodePoint (fromIntegral n + 87)++-- | Intercalate builders+{-# INLINE intercalate #-}+intercalate :: Foldable foldable => TextBuilder -> foldable TextBuilder -> TextBuilder+intercalate separator = extract . foldl' step init+  where+    init = Product2 False mempty+    step (Product2 isNotFirst builder) element =+      Product2 True $+        if isNotFirst+          then builder <> separator <> element+          else element+    extract (Product2 _ builder) = builder++-- | Pad a builder from the left side to the specified length with the specified character+{-# INLINEABLE padFromLeft #-}+padFromLeft :: Int -> Char -> TextBuilder -> TextBuilder+padFromLeft paddedLength paddingChar builder =+  let builderLength = length builder+   in if paddedLength <= builderLength+        then builder+        else foldMap char (replicate (paddedLength - builderLength) paddingChar) <> builder++-- | Pad a builder from the right side to the specified length with the specified character+{-# INLINEABLE padFromRight #-}+padFromRight :: Int -> Char -> TextBuilder -> TextBuilder+padFromRight paddedLength paddingChar builder =+  let builderLength = length builder+   in if paddedLength <= builderLength+        then builder+        else builder <> foldMap char (replicate (paddedLength - builderLength) 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 y mo d h mi s =+  mconcat+    [ padFromLeft 4 '0' $ decimal y,+      "-",+      padFromLeft 2 '0' $ decimal mo,+      "-",+      padFromLeft 2 '0' $ decimal d,+      "T",+      padFromLeft 2 '0' $ decimal h,+      ":",+      padFromLeft 2 '0' $ decimal mi,+      ":",+      padFromLeft 2 '0' $ decimal s,+      "Z"+    ]++-- |+-- Time interval in seconds.+-- Directly applicable to 'DiffTime' and 'NominalDiffTime'.+{-# INLINEABLE intervalInSeconds #-}+intervalInSeconds :: RealFrac seconds => seconds -> TextBuilder+intervalInSeconds interval = flip evalState (round interval) $ do+  seconds <- state (swap . flip divMod 60)+  minutes <- state (swap . flip divMod 60)+  hours <- state (swap . flip divMod 24)+  days <- get+  return $+    padFromLeft 2 '0' (decimal days) <> ":"+      <> padFromLeft 2 '0' (decimal hours)+      <> ":"+      <> padFromLeft 2 '0' (decimal minutes)+      <> ":"+      <> padFromLeft 2 '0' (decimal seconds)++-- | Double with a fixed number of decimal places.+{-# INLINE fixedDouble #-}+fixedDouble ::+  -- | Amount of decimals after point.+  Int ->+  Double ->+  TextBuilder+fixedDouble decimalPlaces = fromString . printf ("!." ++ show decimalPlaces ++ "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 decimalPlaces x = fixedDouble decimalPlaces (x * 100) <> "!"++-- | Hexadecimal readable representation of binary data.+{-# INLINE hexData #-}+hexData :: ByteString -> TextBuilder+hexData =+  intercalate " " . fmap mconcat+    . Split.chunksOf 2+    . fmap byte+    . ByteString.unpack+  where+    byte =+      padFromLeft 2 '0' . unsignedHexadecimal
+ library/TextBuilderDev/Prelude.hs view
@@ -0,0 +1,82 @@+module TextBuilderDev.Prelude+  ( module Exports,+    Product2 (..),+  )+where++import Control.Applicative as Exports+import Control.Arrow as Exports+import Control.Category as Exports+import Control.Concurrent as Exports+import Control.Exception as Exports+import Control.Monad as Exports hiding (forM, forM_, mapM, mapM_, msum, sequence, sequence_)+import Control.Monad.Fix as Exports hiding (fix)+import Control.Monad.IO.Class as Exports+import Control.Monad.ST as Exports+import Control.Monad.ST.Unsafe as Exports+import Control.Monad.Trans.Class as Exports+import Control.Monad.Trans.Maybe as Exports hiding (liftListen, liftPass)+import Control.Monad.Trans.Reader as Exports hiding (liftCallCC, liftCatch)+import Control.Monad.Trans.State.Strict as Exports hiding (liftCallCC, liftCatch, liftListen, liftPass)+import Data.Bits as Exports+import Data.Bool as Exports+import Data.ByteString as Exports (ByteString)+import Data.Char as Exports+import Data.Coerce as Exports+import Data.Complex as Exports+import Data.Data as Exports+import Data.Dynamic as Exports+import Data.Either as Exports+import Data.Fixed as Exports+import Data.Foldable as Exports+import Data.Function as Exports hiding (id, (.))+import Data.Functor as Exports+import Data.Functor.Identity as Exports+import Data.IORef as Exports+import Data.Int as Exports+import Data.Ix as Exports+import Data.List as Exports hiding (all, and, any, concat, concatMap, elem, find, foldl, foldl', foldl1, foldr, foldr1, isSubsequenceOf, mapAccumL, mapAccumR, maximum, maximumBy, minimum, minimumBy, notElem, or, product, sortOn, sum, uncons)+import Data.Maybe as Exports+import Data.Monoid as Exports hiding (First (..), Last (..), (<>))+import Data.Ord as Exports+import Data.Proxy as Exports+import Data.Ratio as Exports+import Data.STRef as Exports+import Data.Semigroup as Exports+import Data.String as Exports+import Data.String.ToString as Exports+import Data.Text as Exports (Text)+import Data.Text.Conversions as Exports+import Data.Traversable as Exports+import Data.Tuple as Exports+import Data.Unique as Exports+import Data.Version as Exports+import Data.Word as Exports+import Debug.Trace as Exports+import DeferredFolds.Unfoldr as Exports (Unfoldr (..))+import Foreign.ForeignPtr as Exports+import Foreign.ForeignPtr.Unsafe as Exports+import Foreign.Ptr as Exports+import Foreign.StablePtr as Exports+import Foreign.Storable as Exports hiding (alignment, sizeOf)+import GHC.Conc as Exports hiding (threadWaitRead, threadWaitReadSTM, threadWaitWrite, threadWaitWriteSTM, withMVar)+import GHC.Exts as Exports (groupWith, inline, lazy, sortWith)+import GHC.Generics as Exports (Generic)+import GHC.IO.Exception as Exports+import Numeric as Exports+import System.Environment as Exports+import System.Exit as Exports+import System.IO as Exports+import System.IO.Error as Exports+import System.IO.Unsafe as Exports+import System.Mem as Exports+import System.Mem.StableName as Exports+import System.Timeout as Exports+import Text.ParserCombinators.ReadP as Exports (ReadP, ReadS, readP_to_S, readS_to_P)+import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readP_to_Prec, readPrec_to_P, readPrec_to_S, readS_to_Prec)+import Text.Printf as Exports (hPrintf, printf)+import Text.Read as Exports (Read (..), readEither, readMaybe)+import Unsafe.Coerce as Exports+import Prelude as Exports hiding (all, and, any, concat, concatMap, elem, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.))++data Product2 a b = Product2 !a !b
+ library/TextBuilderDev/UTF16.hs view
@@ -0,0 +1,58 @@+module TextBuilderDev.UTF16 where++import TextBuilderDev.Prelude++-- |+-- A matching function, which chooses the continuation to run.+type UTF16View =+  forall x. (Word16 -> x) -> (Word16 -> Word16 -> x) -> x++{-# INLINE char #-}+char :: Char -> UTF16View+char x =+  unicodeCodePoint (ord x)++{-# INLINE unicodeCodePoint #-}+unicodeCodePoint :: Int -> UTF16View+unicodeCodePoint x case1 case2 =+  if x < 0x10000+    then case1 (fromIntegral x)+    else case2 case2Unit1 case2Unit2+  where+    m =+      x - 0x10000+    case2Unit1 =+      fromIntegral (shiftR m 10 + 0xD800)+    case2Unit2 =+      fromIntegral ((m .&. 0x3FF) + 0xDC00)++{-# INLINE utf8CodeUnits1 #-}+utf8CodeUnits1 :: Word8 -> UTF16View+utf8CodeUnits1 x case1 _ =+  case1 (fromIntegral x)++{-# INLINE utf8CodeUnits2 #-}+utf8CodeUnits2 :: Word8 -> Word8 -> UTF16View+utf8CodeUnits2 byte1 byte2 case1 _ =+  case1 (shiftL (fromIntegral byte1 - 0xC0) 6 + fromIntegral byte2 - 0x80)++{-# INLINE utf8CodeUnits3 #-}+utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> UTF16View+utf8CodeUnits3 byte1 byte2 byte3 case1 case2 =+  unicodeCodePoint unicode case1 case2+  where+    unicode =+      shiftL (fromIntegral byte1 - 0xE0) 12+        + shiftL (fromIntegral byte2 - 0x80) 6+        + fromIntegral byte3 - 0x80++{-# INLINE utf8CodeUnits4 #-}+utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> UTF16View+utf8CodeUnits4 byte1 byte2 byte3 byte4 case1 case2 =+  unicodeCodePoint unicode case1 case2+  where+    unicode =+      shiftL (fromIntegral byte1 - 0xE0) 18+        + shiftL (fromIntegral byte2 - 0x80) 12+        + shiftL (fromIntegral byte3 - 0x80) 6+        + fromIntegral byte4 - 0x80
+ test/Main.hs view
@@ -0,0 +1,86 @@+module Main where++import qualified Data.ByteString as ByteString+import qualified Data.Text as A+import qualified Data.Text.Encoding as Text+import Test.QuickCheck.Instances+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+import qualified TextBuilderDev as B+import Prelude hiding (choose)++main =+  defaultMain $+    testGroup "All tests" $+      [ testProperty "ASCII ByteString" $+          let gen = listOf $ do+                list <- listOf (choose (0, 127))+                return (ByteString.pack list)+           in forAll gen $ \chunks ->+                mconcat chunks+                  === Text.encodeUtf8 (B.buildText (foldMap B.asciiByteString chunks)),+        testProperty "Intercalation has the same effect as in Text" $+          \separator texts ->+            A.intercalate separator texts+              === B.buildText (B.intercalate (B.text separator) (fmap B.text texts)),+        testProperty "Packing a list of chars is isomorphic to appending a list of builders" $+          \chars ->+            A.pack chars+              === B.buildText (foldMap B.char chars),+        testProperty "Concatting a list of texts is isomorphic to fold-mapping with builders" $+          \texts ->+            mconcat texts+              === B.buildText (foldMap B.text texts),+        testProperty "Concatting a list of texts is isomorphic to concatting a list of builders" $+          \texts ->+            mconcat texts+              === B.buildText (mconcat (map B.text texts)),+        testProperty "Concatting a list of trimmed texts is isomorphic to concatting a list of builders" $+          \texts ->+            let trimmedTexts = fmap (A.drop 3) texts+             in mconcat trimmedTexts+                  === B.buildText (mconcat (map B.text trimmedTexts)),+        testProperty "Decimal" $ \(x :: Integer) ->+          (fromString . show) x === (B.buildText (B.decimal x)),+        testProperty "Hexadecimal vs std show" $ \(x :: Integer) ->+          x >= 0+            ==> (fromString . showHex x) "" === (B.buildText . B.hexadecimal) x,+        testCase "Separated thousands" $ do+          assertEqual "" "0" (B.buildText (B.thousandSeparatedUnsignedDecimal ',' 0))+          assertEqual "" "123" (B.buildText (B.thousandSeparatedUnsignedDecimal ',' 123))+          assertEqual "" "1,234" (B.buildText (B.thousandSeparatedUnsignedDecimal ',' 1234))+          assertEqual "" "1,234,567" (B.buildText (B.thousandSeparatedUnsignedDecimal ',' 1234567)),+        testCase "Pad from left" $ do+          assertEqual "" "00" (B.buildText (B.padFromLeft 2 '0' ""))+          assertEqual "" "00" (B.buildText (B.padFromLeft 2 '0' "0"))+          assertEqual "" "01" (B.buildText (B.padFromLeft 2 '0' "1"))+          assertEqual "" "12" (B.buildText (B.padFromLeft 2 '0' "12"))+          assertEqual "" "123" (B.buildText (B.padFromLeft 2 '0' "123")),+        testCase "Pad from right" $ do+          assertEqual "" "00" (B.buildText (B.padFromRight 2 '0' ""))+          assertEqual "" "00" (B.buildText (B.padFromRight 2 '0' "0"))+          assertEqual "" "10" (B.buildText (B.padFromRight 2 '0' "1"))+          assertEqual "" "12" (B.buildText (B.padFromRight 2 '0' "12"))+          assertEqual "" "123" (B.buildText (B.padFromRight 2 '0' "123"))+          assertEqual "" "1  " (B.buildText (B.padFromRight 3 ' ' "1")),+        testCase "Hexadecimal" $+          assertEqual "" "1f23" (B.buildText (B.hexadecimal 0x01f23)),+        testCase "Negative Hexadecimal" $+          assertEqual "" "-1f23" (B.buildText (B.hexadecimal (-0x01f23))),+        testGroup "Time interval" $+          [ testCase "59s" $ assertEqual "" "00:00:00:59" $ B.buildText $ B.intervalInSeconds 59,+            testCase "minute" $ assertEqual "" "00:00:01:00" $ B.buildText $ B.intervalInSeconds 60,+            testCase "90s" $ assertEqual "" "00:00:01:30" $ B.buildText $ B.intervalInSeconds 90,+            testCase "hour" $ assertEqual "" "00:01:00:00" $ B.buildText $ B.intervalInSeconds 3600,+            testCase "day" $ assertEqual "" "01:00:00:00" $ B.buildText $ B.intervalInSeconds 86400+          ],+        testCase "dataSizeInBytesInDecimal" $ do+          assertEqual "" "999B" (B.buildText (B.dataSizeInBytesInDecimal ',' 999))+          assertEqual "" "1kB" (B.buildText (B.dataSizeInBytesInDecimal ',' 1000))+          assertEqual "" "1.1kB" (B.buildText (B.dataSizeInBytesInDecimal ',' 1100))+          assertEqual "" "1.1MB" (B.buildText (B.dataSizeInBytesInDecimal ',' 1150000))+          assertEqual "" "9.9MB" (B.buildText (B.dataSizeInBytesInDecimal ',' 9990000))+          assertEqual "" "10MB" (B.buildText (B.dataSizeInBytesInDecimal ',' 10100000))+          assertEqual "" "1,000YB" (B.buildText (B.dataSizeInBytesInDecimal ',' 1000000000000000000000000000))+      ]
+ text-builder-dev.cabal view
@@ -0,0 +1,79 @@+cabal-version: 3.0++name: text-builder-dev+version: 0.1+category: Text+synopsis: Edge of developments for "text-builder"+description:+  This is a development version of \"text-builder\".+  All experimentation and feature development happens here.+  The API can change drastically.+  For a more stable API use \"text-builder\",+  which is now just a wrapper over this package.+homepage: https://github.com/nikita-volkov/text-builder-dev+bug-reports: https://github.com/nikita-volkov/text-builder-dev/issues+author: Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer: Nikita Volkov <nikita.y.volkov@mail.ru>+copyright: (c) 2022, Nikita Volkov+license: MIT+license-file: LICENSE++source-repository head+  type: git+  location: git://github.com/nikita-volkov/text-builder-dev.git++common language-settings+  default-extensions: BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, InstanceSigs, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeApplications, TypeFamilies, TypeOperators, ViewPatterns+  default-language: Haskell2010++library+  import: language-settings+  hs-source-dirs: library+  exposed-modules:+    TextBuilderDev+  other-modules:+    TextBuilderDev.UTF16+    TextBuilderDev.Prelude+  build-depends:+    base >=4.11 && <5,+    bytestring >=0.10 && <0.12,+    deferred-folds >=0.9.10.1 && <0.10,+    split >=0.2.3.4 && <0.3,+    text >=1 && <2,+    text-conversions >=0.3.1 && <0.4,+    tostring >=0.2.1.1 && <0.3,+    transformers >=0.5 && <0.7,++test-suite test+  import: language-settings+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Main.hs+  build-depends:+    QuickCheck >=2.13 && <3,+    quickcheck-instances >=0.3.22 && <0.4,+    rerebase <2,+    tasty >=1.2.3 && <2,+    tasty-hunit >=0.10.0.2 && <0.11,+    tasty-quickcheck >=0.10.1 && <0.11,+    text-builder-dev,++benchmark benchmark-text+  import: language-settings+  type: exitcode-stdio-1.0+  hs-source-dirs: benchmark-text+  main-is: Main.hs+  build-depends:+    criterion >=1.5.13.0 && <2,+    rerebase ==1.*,+    text-builder-dev,++benchmark benchmark-char+  import: language-settings+  type: exitcode-stdio-1.0+  hs-source-dirs: benchmark-char+  main-is: Main.hs+  build-depends:+    criterion >=1.5.13.0 && <2,+    rerebase ==1.*,+    text-builder-dev,