text-builder-dev-0.3.5/0000755000000000000000000000000007346545000013074 5ustar0000000000000000text-builder-dev-0.3.5/LICENSE0000644000000000000000000000204207346545000014077 0ustar0000000000000000Copyright (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. text-builder-dev-0.3.5/benchmark-char/0000755000000000000000000000000007346545000015741 5ustar0000000000000000text-builder-dev-0.3.5/benchmark-char/Main.hs0000644000000000000000000000270307346545000017163 0ustar0000000000000000module 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 :: IO () 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) text-builder-dev-0.3.5/benchmark-text/0000755000000000000000000000000007346545000016010 5ustar0000000000000000text-builder-dev-0.3.5/benchmark-text/Main.hs0000644000000000000000000000264207346545000017234 0ustar0000000000000000module Main where import Criterion.Main import qualified Data.Text.Lazy as C import qualified Data.Text.Lazy.Builder as B import qualified TextBuilderDev as A import Prelude main :: IO () 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 "漢" text-builder-dev-0.3.5/library/0000755000000000000000000000000007346545000014540 5ustar0000000000000000text-builder-dev-0.3.5/library/TextBuilderDev.hs0000644000000000000000000004706207346545000017777 0ustar0000000000000000{-# LANGUAGE CPP #-} 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, fixedUnsignedDecimal, thousandSeparatedDecimal, thousandSeparatedUnsignedDecimal, dataSizeInBytesInDecimal, -- *** Binary unsignedBinary, unsignedPaddedBinary, finiteBitsUnsignedBinary, -- *** Hexadecimal hexadecimal, unsignedHexadecimal, -- ** Digits decimalDigit, hexadecimalDigit, -- ** Real fixedDouble, doublePercent, -- ** Time utcTimeInIso8601, 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.IO as Text import qualified Data.Text.Lazy as TextLazy import qualified Data.Text.Lazy.Builder as TextLazyBuilder import qualified DeferredFolds.Unfoldr as Unfoldr import qualified Test.QuickCheck.Gen as QcGen import qualified TextBuilderDev.Allocator as Allocator import TextBuilderDev.Prelude hiding (intercalate, length, null) #if MIN_VERSION_text(2,0,2) import qualified Data.Text.Encoding as TextEncoding #endif -- * -- -- | -- 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 = id fromTextBuilder = id instance IsomorphicToTextBuilder Text where toTextBuilder = text fromTextBuilder = buildText instance IsomorphicToTextBuilder String where toTextBuilder = fromString fromTextBuilder = Text.unpack . buildText instance IsomorphicToTextBuilder TextLazy.Text where toTextBuilder = lazyText fromTextBuilder = TextLazy.fromStrict . buildText instance IsomorphicToTextBuilder TextLazyBuilder.Builder where toTextBuilder = text . TextLazy.toStrict . TextLazyBuilder.toLazyText fromTextBuilder = TextLazyBuilder.fromText . buildText #if MIN_VERSION_text(2,0,2) instance IsomorphicToTextBuilder TextEncoding.StrictBuilder where toTextBuilder = toTextBuilder . TextEncoding.strictBuilderToText fromTextBuilder = TextEncoding.textToStrictBuilder . fromTextBuilder #endif -- * -- -- | -- Specification of how to efficiently construct strict 'Text'. -- Provides instances of 'Semigroup' and 'Monoid', which have complexity of /O(1)/. data TextBuilder = TextBuilder {-# UNPACK #-} !Allocator.Allocator {-# UNPACK #-} !Int instance Semigroup TextBuilder where (<>) (TextBuilder allocator1 sizeInChars1) (TextBuilder allocator2 sizeInChars2) = TextBuilder (allocator1 <> allocator2) (sizeInChars1 + sizeInChars2) stimes n (TextBuilder allocator size) = TextBuilder (stimes n allocator) (size * fromIntegral n) instance Monoid TextBuilder where {-# INLINE mempty #-} mempty = TextBuilder mempty 0 instance IsString TextBuilder where fromString = string instance Show TextBuilder where show = Text.unpack . buildText instance Eq TextBuilder where (==) = on (==) buildText instance Arbitrary TextBuilder where arbitrary = QcGen.oneof [ QcGen.scale (flip div 2) $ QcGen.oneof [ (<>) <$> arbitrary <*> arbitrary, sconcat <$> arbitrary, stimes <$> arbitrary @Word8 <*> arbitrary, pure mempty, mconcat <$> arbitrary ], text <$> arbitrary, lazyText <$> arbitrary, string <$> arbitrary, asciiByteString . ByteString.filter (< 128) <$> arbitrary, hexData <$> arbitrary, char <$> arbitrary, decimal @Integer <$> arbitrary, unsignedDecimal @Natural <$> arbitrary, thousandSeparatedDecimal @Integer <$> arbitrary <*> arbitrary, thousandSeparatedUnsignedDecimal @Natural <$> arbitrary <*> arbitrary, dataSizeInBytesInDecimal @Natural <$> arbitrary <*> arbitrary, unsignedBinary @Natural <$> arbitrary, unsignedPaddedBinary @Word <$> arbitrary, finiteBitsUnsignedBinary @Word <$> arbitrary, hexadecimal @Integer <$> arbitrary, unsignedHexadecimal @Natural <$> arbitrary, decimalDigit <$> QcGen.choose @Int (0, 9), hexadecimalDigit <$> QcGen.choose @Int (0, 15), fixedDouble <$> QcGen.choose (0, 19) <*> arbitrary, doublePercent <$> QcGen.choose (0, 19) <*> arbitrary, utcTimestampInIso8601 <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary, intervalInSeconds @Double <$> arbitrary ] instance IsomorphicTo TextBuilder TextBuilder where to = id instance IsomorphicTo TextBuilder String where to = TextBuilderDev.string instance IsomorphicTo TextBuilder Text where to = TextBuilderDev.text instance IsomorphicTo TextBuilder TextLazy.Text where to = TextBuilderDev.lazyText instance IsomorphicTo TextBuilder TextLazyBuilder.Builder where to = to . to @TextLazy.Text instance IsomorphicTo String TextBuilder where to = to . to @Text instance IsomorphicTo Text TextBuilder where to = TextBuilderDev.buildText instance IsomorphicTo TextLazy.Text TextBuilder where to = to . to @Text instance IsomorphicTo TextLazyBuilder.Builder TextBuilder where to = to . to @Text -- * 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 allocator _) = Allocator.allocate allocator -- ** 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 . buildText -- | Unicode character. {-# INLINE char #-} char :: Char -> TextBuilder char = unicodeCodePoint . ord -- | Unicode code point. {-# INLINE unicodeCodePoint #-} unicodeCodePoint :: Int -> TextBuilder unicodeCodePoint a = TextBuilder (Allocator.unicodeCodePoint a) 1 -- | Single code-unit UTF-16 character. {-# INLINEABLE utf16CodeUnits1 #-} utf16CodeUnits1 :: Word16 -> TextBuilder utf16CodeUnits1 a = TextBuilder (Allocator.utf16CodeUnits1 a) 1 -- | Double code-unit UTF-16 character. {-# INLINEABLE utf16CodeUnits2 #-} utf16CodeUnits2 :: Word16 -> Word16 -> TextBuilder utf16CodeUnits2 a b = TextBuilder (Allocator.utf16CodeUnits2 a b) 1 -- | Single code-unit UTF-8 character. {-# INLINE utf8CodeUnits1 #-} utf8CodeUnits1 :: Word8 -> TextBuilder utf8CodeUnits1 a = TextBuilder (Allocator.utf8CodeUnits1 a) 1 -- | Double code-unit UTF-8 character. {-# INLINE utf8CodeUnits2 #-} utf8CodeUnits2 :: Word8 -> Word8 -> TextBuilder utf8CodeUnits2 a b = TextBuilder (Allocator.utf8CodeUnits2 a b) 1 -- | Triple code-unit UTF-8 character. {-# INLINE utf8CodeUnits3 #-} utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> TextBuilder utf8CodeUnits3 a b c = TextBuilder (Allocator.utf8CodeUnits3 a b c) 1 -- | UTF-8 character out of 4 code units. {-# INLINE utf8CodeUnits4 #-} utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> TextBuilder utf8CodeUnits4 a b c d = TextBuilder (Allocator.utf8CodeUnits4 a b c d) 1 -- | 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 (Allocator.asciiByteString byteString) (ByteString.length byteString) -- | Strict text. {-# INLINEABLE text #-} text :: Text -> TextBuilder text text = TextBuilder (Allocator.text text) (Text.length text) -- | Lazy text. {-# INLINE lazyText #-} lazyText :: TextLazy.Text -> TextBuilder lazyText = TextLazy.foldrChunks (mappend . text) mempty -- | 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 . fromIntegral) . Unfoldr.decimalDigits fixedUnsignedDecimal :: (Integral a) => Int -> a -> TextBuilder fixedUnsignedDecimal size val = TextBuilder (Allocator.fixedUnsignedDecimal size val) size -- | 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 = processRightmostDigit where processRightmostDigit value = case divMod value 10 of (value, digit) -> processAnotherDigit [decimalDigit (fromIntegral digit)] 1 value processAnotherDigit builders index value = if value == 0 then mconcat builders else case divMod value 10 of (value, digit) -> if mod index 3 == 0 then processAnotherDigit (decimalDigit (fromIntegral digit) : char separatorChar : builders) (succ index) value else processAnotherDigit (decimalDigit (fromIntegral digit) : builders) (succ index) value -- | 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 (fromIntegral remainder) -- | Unsigned binary number. {-# INLINE unsignedBinary #-} unsignedBinary :: (Integral a) => a -> TextBuilder unsignedBinary = foldMap (decimalDigit . fromIntegral) . Unfoldr.binaryDigits -- | A less general but faster alternative to 'unsignedBinary'. finiteBitsUnsignedBinary :: (FiniteBits a) => a -> TextBuilder finiteBitsUnsignedBinary a = TextBuilder allocator size where allocator = Allocator.finiteBitsUnsignedBinary a size = Allocator.sizeBound allocator -- | Unsigned binary number. {-# INLINE unsignedPaddedBinary #-} unsignedPaddedBinary :: (Integral a, FiniteBits a) => a -> TextBuilder unsignedPaddedBinary a = padFromLeft (finiteBitSize a) '0' $ foldMap (decimalDigit . fromIntegral) $ 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 . fromIntegral) . Unfoldr.hexadecimalDigits -- | Decimal digit. {-# INLINE decimalDigit #-} decimalDigit :: (Integral a) => a -> TextBuilder decimalDigit (fromIntegral -> n) = unicodeCodePoint (n + 48) -- | Hexadecimal digit. {-# INLINE hexadecimalDigit #-} hexadecimalDigit :: (Integral a) => a -> TextBuilder hexadecimalDigit (fromIntegral -> n) = if n <= 9 then unicodeCodePoint (n + 48) else unicodeCodePoint (n + 87) -- | Intercalate builders. {-# INLINE intercalate #-} intercalate :: (Foldable f) => TextBuilder -> f 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 -- | Intercalate projecting values to builder. {-# INLINE intercalateMap #-} intercalateMap :: (Foldable f) => TextBuilder -> (a -> TextBuilder) -> f a -> TextBuilder intercalateMap separator mapper = extract . foldl' step init where init = Nothing step acc element = Just $ case acc of Nothing -> mapper element Just acc -> acc <> separator <> mapper element extract = fromMaybe mempty -- | 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) utcTimeInIso8601 :: UTCTime -> TextBuilder utcTimeInIso8601 UTCTime {..} = let (year, month, day) = toGregorian utctDay daySeconds = round utctDayTime (dayMinutes, second) = divMod daySeconds 60 (hour, minute) = divMod dayMinutes 60 in utcTimestampInIso8601 (fromIntegral year) month day hour minute second -- | -- 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 [ fixedUnsignedDecimal 4 y, "-", fixedUnsignedDecimal 2 mo, "-", fixedUnsignedDecimal 2 d, "T", fixedUnsignedDecimal 2 h, ":", fixedUnsignedDecimal 2 mi, ":", fixedUnsignedDecimal 2 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 text-builder-dev-0.3.5/library/TextBuilderDev/0000755000000000000000000000000007346545000017432 5ustar0000000000000000text-builder-dev-0.3.5/library/TextBuilderDev/Allocator.hs0000644000000000000000000002313707346545000021714 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wno-unused-imports #-} module TextBuilderDev.Allocator ( -- * Execution allocate, sizeBound, -- * Definition Allocator, force, text, asciiByteString, char, unicodeCodePoint, utf8CodeUnits1, utf8CodeUnits2, utf8CodeUnits3, utf8CodeUnits4, utf16CodeUnits1, utf16CodeUnits2, finiteBitsUnsignedBinary, fixedUnsignedDecimal, ) where import qualified Data.ByteString as ByteString 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 TextBuilderDev.Prelude import qualified TextBuilderDev.Utf16View as Utf16View import qualified TextBuilderDev.Utf8View as Utf8View -- * ArrayWriter newtype ArrayWriter = ArrayWriter (forall s. TextArray.MArray s -> Int -> ST s Int) instance Semigroup ArrayWriter where {-# INLINE (<>) #-} ArrayWriter writeL <> ArrayWriter writeR = ArrayWriter $ \array offset -> do offsetAfter1 <- writeL array offset writeR array offsetAfter1 stimes n (ArrayWriter write) = ArrayWriter $ \array -> let go n offset = if n > 0 then do offset <- write array offset go (pred n) offset else return offset in go n instance Monoid ArrayWriter where {-# INLINE mempty #-} mempty = ArrayWriter $ const $ return -- * Allocator -- | Execute a builder producing a strict text. allocate :: Allocator -> Text allocate (Allocator (ArrayWriter write) sizeBound) = runST $ do array <- TextArray.new sizeBound offsetAfter <- write array 0 frozenArray <- TextArray.unsafeFreeze array return $ TextInternal.text frozenArray 0 offsetAfter sizeBound :: Allocator -> Int sizeBound (Allocator _ sizeBound) = sizeBound -- | -- Specification of how to efficiently construct strict 'Text'. -- Provides instances of 'Semigroup' and 'Monoid', which have complexity of /O(1)/. data Allocator = Allocator !ArrayWriter {-# UNPACK #-} !Int instance Semigroup Allocator where {-# INLINE (<>) #-} (<>) (Allocator writer1 estimatedArraySize1) (Allocator writer2 estimatedArraySize2) = Allocator writer estimatedArraySize where writer = writer1 <> writer2 estimatedArraySize = estimatedArraySize1 + estimatedArraySize2 stimes n (Allocator writer sizeBound) = Allocator (stimes n writer) (sizeBound * fromIntegral n) instance Monoid Allocator where {-# INLINE mempty #-} mempty = Allocator mempty 0 -- | -- 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 :: Allocator -> Allocator force = text . allocate {-# INLINE sizedWriter #-} sizedWriter :: Int -> (forall s. TextArray.MArray s -> Int -> ST s Int) -> Allocator sizedWriter size write = Allocator (ArrayWriter write) size -- | Strict text. {-# INLINEABLE text #-} text :: Text -> Allocator #if MIN_VERSION_text(2,0,0) text text@(TextInternal.Text array offset length) = Allocator writer length where writer = ArrayWriter $ \builderArray builderOffset -> do TextArray.copyI length builderArray builderOffset array offset return $ builderOffset + length #else text text@(TextInternal.Text array offset length) = Allocator writer length where writer = ArrayWriter $ \builderArray builderOffset -> do let builderOffsetAfter = builderOffset + length TextArray.copyI builderArray builderOffset array offset builderOffsetAfter return builderOffsetAfter #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 -> Allocator asciiByteString byteString = Allocator action length where length = ByteString.length byteString action = ArrayWriter $ \array -> let step byte next index = do TextArray.unsafeWrite array index (fromIntegral byte) next (succ index) in ByteString.foldr step return byteString -- | Unicode character. {-# INLINE char #-} char :: Char -> Allocator char = unicodeCodePoint . ord -- | Unicode code point. {-# INLINE unicodeCodePoint #-} unicodeCodePoint :: Int -> Allocator #if MIN_VERSION_text(2,0,0) unicodeCodePoint x = Utf8View.unicodeCodePoint x utf8CodeUnits1 utf8CodeUnits2 utf8CodeUnits3 utf8CodeUnits4 #else unicodeCodePoint x = Utf16View.unicodeCodePoint x utf16CodeUnits1 utf16CodeUnits2 #endif -- | Single code-unit UTF-8 character. utf8CodeUnits1 :: Word8 -> Allocator #if MIN_VERSION_text(2,0,0) {-# INLINEABLE utf8CodeUnits1 #-} utf8CodeUnits1 unit1 = Allocator writer 1 where writer = ArrayWriter $ \array offset -> TextArray.unsafeWrite array offset unit1 $> succ offset #else {-# INLINE utf8CodeUnits1 #-} utf8CodeUnits1 unit1 = Utf16View.utf8CodeUnits1 unit1 utf16CodeUnits1 utf16CodeUnits2 #endif -- | Double code-unit UTF-8 character. utf8CodeUnits2 :: Word8 -> Word8 -> Allocator #if MIN_VERSION_text(2,0,0) {-# INLINEABLE utf8CodeUnits2 #-} utf8CodeUnits2 unit1 unit2 = Allocator writer 2 where writer = ArrayWriter $ \array offset -> do TextArray.unsafeWrite array offset unit1 TextArray.unsafeWrite array (offset + 1) unit2 return $ offset + 2 #else {-# INLINE utf8CodeUnits2 #-} utf8CodeUnits2 unit1 unit2 = Utf16View.utf8CodeUnits2 unit1 unit2 utf16CodeUnits1 utf16CodeUnits2 #endif -- | Triple code-unit UTF-8 character. utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> Allocator #if MIN_VERSION_text(2,0,0) {-# INLINEABLE utf8CodeUnits3 #-} utf8CodeUnits3 unit1 unit2 unit3 = Allocator writer 3 where writer = ArrayWriter $ \array offset -> do TextArray.unsafeWrite array offset unit1 TextArray.unsafeWrite array (offset + 1) unit2 TextArray.unsafeWrite array (offset + 2) unit3 return $ offset + 3 #else {-# INLINE utf8CodeUnits3 #-} utf8CodeUnits3 unit1 unit2 unit3 = Utf16View.utf8CodeUnits3 unit1 unit2 unit3 utf16CodeUnits1 utf16CodeUnits2 #endif -- | UTF-8 character out of 4 code units. utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> Allocator #if MIN_VERSION_text(2,0,0) {-# INLINEABLE utf8CodeUnits4 #-} utf8CodeUnits4 unit1 unit2 unit3 unit4 = Allocator writer 4 where writer = ArrayWriter $ \array offset -> do TextArray.unsafeWrite array offset unit1 TextArray.unsafeWrite array (offset + 1) unit2 TextArray.unsafeWrite array (offset + 2) unit3 TextArray.unsafeWrite array (offset + 3) unit4 return $ offset + 4 #else {-# INLINE utf8CodeUnits4 #-} utf8CodeUnits4 unit1 unit2 unit3 unit4 = Utf16View.utf8CodeUnits4 unit1 unit2 unit3 unit4 utf16CodeUnits1 utf16CodeUnits2 #endif -- | Single code-unit UTF-16 character. utf16CodeUnits1 :: Word16 -> Allocator #if MIN_VERSION_text(2,0,0) {-# INLINE utf16CodeUnits1 #-} utf16CodeUnits1 = unicodeCodePoint . fromIntegral #else {-# INLINEABLE utf16CodeUnits1 #-} utf16CodeUnits1 unit = Allocator writer 1 where writer = ArrayWriter $ \array offset -> TextArray.unsafeWrite array offset unit $> succ offset #endif -- | Double code-unit UTF-16 character. utf16CodeUnits2 :: Word16 -> Word16 -> Allocator #if MIN_VERSION_text(2,0,0) {-# INLINE utf16CodeUnits2 #-} utf16CodeUnits2 unit1 unit2 = unicodeCodePoint cp where cp = (((fromIntegral unit1 .&. 0x3FF) `shiftL` 10) .|. (fromIntegral unit2 .&. 0x3FF)) + 0x10000 #else {-# INLINEABLE utf16CodeUnits2 #-} utf16CodeUnits2 unit1 unit2 = Allocator writer 2 where writer = ArrayWriter $ \array offset -> do TextArray.unsafeWrite array offset unit1 TextArray.unsafeWrite array (succ offset) unit2 return $ offset + 2 #endif -- | A less general but faster alternative to 'unsignedBinary'. finiteBitsUnsignedBinary :: (FiniteBits a) => a -> Allocator finiteBitsUnsignedBinary val = Allocator writer size where writer = ArrayWriter $ \array arrayStartIndex -> let go val arrayIndex = if arrayIndex >= arrayStartIndex then do TextArray.unsafeWrite array arrayIndex $ if testBit val 0 then 49 else 48 go (unsafeShiftR val 1) (pred arrayIndex) else return indexAfter indexAfter = arrayStartIndex + size in go val (pred indexAfter) size = max 1 (finiteBitSize val - countLeadingZeros val) -- | Fixed-length decimal. -- Padded with zeros or trimmed depending on whether it's shorter or longer -- than specified. fixedUnsignedDecimal :: (Integral a) => Int -> a -> Allocator fixedUnsignedDecimal size val = sizedWriter size $ \array startOffset -> let offsetAfter = startOffset + size writeValue val offset = if offset >= startOffset then if val /= 0 then case divMod val 10 of (val, digit) -> do TextArray.unsafeWrite array offset $ 48 + fromIntegral digit writeValue val (pred offset) else writePadding offset else return offsetAfter writePadding offset = if offset >= startOffset then do TextArray.unsafeWrite array offset 48 writePadding (pred offset) else return offsetAfter in writeValue val (pred offsetAfter) text-builder-dev-0.3.5/library/TextBuilderDev/Prelude.hs0000644000000000000000000000662607346545000021400 0ustar0000000000000000module 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 hiding (unzip) 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.Text as Exports (Text) import Data.Time 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 IsomorphismClass as Exports import Numeric as Exports import Numeric.Natural as Exports (Natural) 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 Test.QuickCheck.Arbitrary as Exports import Test.QuickCheck.Instances () 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 text-builder-dev-0.3.5/library/TextBuilderDev/Unicode.hs0000644000000000000000000000121407346545000021352 0ustar0000000000000000-- | -- Utilities for construction of Unicode codepoints. module TextBuilderDev.Unicode where import TextBuilderDev.Prelude {-# INLINE utf8CodeUnits3 #-} utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> Int utf8CodeUnits3 byte1 byte2 byte3 = shiftL (fromIntegral byte1 - 0xE0) 12 + shiftL (fromIntegral byte2 - 0x80) 6 + fromIntegral byte3 - 0x80 {-# INLINE utf8CodeUnits4 #-} utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> Int utf8CodeUnits4 byte1 byte2 byte3 byte4 = shiftL (fromIntegral byte1 - 0xF0) 18 + shiftL (fromIntegral byte2 - 0x80) 12 + shiftL (fromIntegral byte3 - 0x80) 6 + fromIntegral byte4 - 0x80 text-builder-dev-0.3.5/library/TextBuilderDev/Utf16View.hs0000644000000000000000000000255207346545000021532 0ustar0000000000000000module TextBuilderDev.Utf16View where import TextBuilderDev.Prelude import qualified TextBuilderDev.Unicode as Unicode -- | -- 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 = unicodeCodePoint (Unicode.utf8CodeUnits3 byte1 byte2 byte3) {-# INLINE utf8CodeUnits4 #-} utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> Utf16View utf8CodeUnits4 byte1 byte2 byte3 byte4 = unicodeCodePoint (Unicode.utf8CodeUnits4 byte1 byte2 byte3 byte4) text-builder-dev-0.3.5/library/TextBuilderDev/Utf8View.hs0000644000000000000000000000173607346545000021456 0ustar0000000000000000module TextBuilderDev.Utf8View where import TextBuilderDev.Prelude -- | -- A matching function, which chooses the continuation to run. type Utf8View = forall x. (Word8 -> x) -> (Word8 -> Word8 -> x) -> (Word8 -> Word8 -> Word8 -> x) -> (Word8 -> Word8 -> Word8 -> Word8 -> x) -> x {-# INLINE unicodeCodePoint #-} unicodeCodePoint :: Int -> Utf8View unicodeCodePoint x case1 case2 case3 case4 | x < 0x80 = case1 (fromIntegral x) | x < 0x800 = case2 (fromIntegral $ x `shiftR` 6 .|. 0xC0) (fromIntegral $ (x .&. 0x3F) .|. 0x80) | x < 0x10000 = case3 (fromIntegral $ x `shiftR` 12 .|. 0xE0) (fromIntegral $ (x `shiftR` 6) .&. 0x3F .|. 0x80) (fromIntegral $ (x .&. 0x3F) .|. 0x80) | otherwise = case4 (fromIntegral $ x `shiftR` 18 .|. 0xF0) (fromIntegral $ (x `shiftR` 12) .&. 0x3F .|. 0x80) (fromIntegral $ (x `shiftR` 6) .&. 0x3F .|. 0x80) (fromIntegral $ (x .&. 0x3F) .|. 0x80) text-builder-dev-0.3.5/test/0000755000000000000000000000000007346545000014053 5ustar0000000000000000text-builder-dev-0.3.5/test/Main.hs0000644000000000000000000002701607346545000015301 0ustar0000000000000000module Main where import qualified Data.ByteString as ByteString import qualified Data.Char as Char import qualified Data.Text as Text import qualified Data.Text.Lazy as TextLazy import qualified Data.Text.Lazy.Builder as TextLazyBuilder import Numeric.Compat import Test.QuickCheck.Classes import Test.QuickCheck.Instances () import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck hiding ((.&.)) import qualified TextBuilderDev as B import qualified TextBuilderDev.TastyExtras as Extras import Prelude hiding (choose, showBin) main :: IO () 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 -> Text.intercalate separator texts === B.buildText (B.intercalate (B.text separator) (fmap B.text texts)), testProperty "intercalateMap sep mapper == intercalate sep . fmap mapper" $ \separator ints -> Text.intercalate separator (fmap (fromString . show @Int) ints) === B.buildText (B.intercalateMap (B.text separator) B.decimal ints), testProperty "Packing a list of chars is isomorphic to appending a list of builders" $ \chars -> Text.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 (Text.drop 3) texts in mconcat trimmedTexts === B.buildText (mconcat (map B.text trimmedTexts)), testProperty "TextBuilderDev.null is isomorphic to Text.null" $ \(text :: Text) -> B.null (B.toTextBuilder text) === Text.null text, testProperty "(TextBuilderDev.unicodeCodePoint <>) is isomorphic to Text.cons" $ withMaxSuccess bigTest $ \(text :: Text) (c :: Char) -> B.buildText (B.unicodeCodePoint (Char.ord c) <> B.text text) === Text.cons c text, 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 ], testGroup "By function name" $ [ testGroup "utf8CodeUnitsN" $ [ testProperty "Text.cons isomporphism" $ withMaxSuccess bigTest $ \(text :: Text) (c :: Char) -> let cp = Char.ord c cuBuilder | cp < 0x80 = B.utf8CodeUnits1 (cuAt 0) | cp < 0x800 = B.utf8CodeUnits2 (cuAt 0) (cuAt 1) | cp < 0x10000 = B.utf8CodeUnits3 (cuAt 0) (cuAt 1) (cuAt 2) | otherwise = B.utf8CodeUnits4 (cuAt 0) (cuAt 1) (cuAt 2) (cuAt 3) where -- Use Data.Text.Encoding for comparison codeUnits = Text.encodeUtf8 $ Text.singleton c cuAt = (codeUnits `ByteString.index`) in B.buildText (cuBuilder <> B.text text) === Text.cons c text, testProperty "Text.singleton isomorphism" $ withMaxSuccess bigTest $ \(c :: Char) -> let text = Text.singleton c codeUnits = Text.encodeUtf8 text cp = Char.ord c cuBuilder | cp < 0x80 = B.utf8CodeUnits1 (cuAt 0) | cp < 0x800 = B.utf8CodeUnits2 (cuAt 0) (cuAt 1) | cp < 0x10000 = B.utf8CodeUnits3 (cuAt 0) (cuAt 1) (cuAt 2) | otherwise = B.utf8CodeUnits4 (cuAt 0) (cuAt 1) (cuAt 2) (cuAt 3) where cuAt = ByteString.index codeUnits in B.buildText cuBuilder === text ], testGroup "utf16CodeUnitsN" $ [ testProperty "is isomorphic to Text.cons" $ withMaxSuccess bigTest $ \(text :: Text) (c :: Char) -> let cp = Char.ord c cuBuilder | cp < 0x10000 = B.utf16CodeUnits1 (cuAt 0) | otherwise = B.utf16CodeUnits2 (cuAt 0) (cuAt 1) where -- Use Data.Text.Encoding for comparison codeUnits = Text.encodeUtf16LE $ Text.singleton c cuAt i = (fromIntegral $ codeUnits `ByteString.index` (2 * i)) .|. ((fromIntegral $ codeUnits `ByteString.index` (2 * i + 1)) `shiftL` 8) in B.buildText (cuBuilder <> B.text text) === Text.cons c text ], testCase "thousandSeparatedUnsignedDecimal" $ 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 "padFromLeft" $ 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 "padFromRight" $ 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")), testProperty "decimal" $ \(x :: Integer) -> (fromString . show) x === (B.buildText (B.decimal x)), testGroup "hexadecimal" $ [ testProperty "show isomorphism" $ \(x :: Integer) -> x >= 0 ==> (fromString . showHex x) "" === (B.buildText . B.hexadecimal) x, testCase "Positive" $ assertEqual "" "1f23" (B.buildText (B.hexadecimal 0x01f23)), testCase "Negative" $ assertEqual "" "-1f23" (B.buildText (B.hexadecimal (-0x01f23))) ], 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)), testCase "fixedDouble" $ do assertEqual "" "0.0" (B.buildText (B.fixedDouble 1 0.05)) assertEqual "" "0.1" (B.buildText (B.fixedDouble 1 0.06)) assertEqual "" "10.0000" (B.buildText (B.fixedDouble 4 10)) assertEqual "" "0.9000" (B.buildText (B.fixedDouble 4 0.9)), testCase "doublePercent" $ do assertEqual "" "90.4%" (B.buildText (B.doublePercent 1 0.904)), testGroup "unsignedBinary" $ [ testProperty "Produces the same output as showBin" $ \(x :: Natural) -> fromString (showBin x "") === B.buildText (B.unsignedBinary x) ], testGroup "finiteBitsUnsignedBinary" $ [ testProperty "Produces the same output as showBin" $ \(x :: Word) -> fromString (showBin x "") === B.buildText (B.finiteBitsUnsignedBinary x) ], testGroup "fixedUnsignedDecimal" $ [ testProperty "Same as printf" $ \(size :: Word8, val :: Natural) -> let rendered = show val renderedLength = length rendered intSize = fromIntegral size padded = if renderedLength > intSize then drop (renderedLength - intSize) rendered else replicate (intSize - renderedLength) '0' <> rendered in fromString padded === B.buildText (B.fixedUnsignedDecimal (fromIntegral size) val) ], testGroup "utcTimeInIso8601" $ [ testProperty "Same as iso8601Show" $ \x -> let roundedToSecondsTime = x {utctDayTime = (fromIntegral . round . utctDayTime) x} in (fromString . flip mappend "Z" . take 19 . iso8601Show) roundedToSecondsTime === B.buildText (B.utcTimeInIso8601 roundedToSecondsTime) ] ], testGroup "IsomorphicToTextBuilder instances" $ [ Extras.isomorphismLaws "Text" $ Proxy @Text, Extras.isomorphismLaws "Lazy Text" $ Proxy @TextLazy.Text, Extras.isomorphismLaws "Lazy Text Builder" $ Proxy @TextLazyBuilder.Builder, Extras.isomorphismLaws "String" $ Proxy @String ], testLaws $ showLaws (Proxy @B.TextBuilder), testLaws $ eqLaws (Proxy @B.TextBuilder), testLaws $ semigroupLaws (Proxy @B.TextBuilder), testLaws $ monoidLaws (Proxy @B.TextBuilder) ] where bigTest = 10000 testLaws :: Laws -> TestTree testLaws Laws {..} = testProperties lawsTypeclass lawsProperties text-builder-dev-0.3.5/test/TextBuilderDev/0000755000000000000000000000000007346545000016745 5ustar0000000000000000text-builder-dev-0.3.5/test/TextBuilderDev/TastyExtras.hs0000644000000000000000000000164007346545000021575 0ustar0000000000000000{-# OPTIONS_GHC -Wno-orphans #-} module TextBuilderDev.TastyExtras where import qualified Data.Text.Lazy.Builder as TextLazyBuilder import Test.Tasty import Test.Tasty.QuickCheck import qualified TextBuilderDev as B import Prelude hiding (choose) -- * -- instance Arbitrary TextLazyBuilder.Builder where arbitrary = TextLazyBuilder.fromLazyText <$> arbitrary -- * -- isomorphismLaws :: (B.IsomorphicToTextBuilder a, Eq a, Show a, Arbitrary a) => String -> Proxy a -> TestTree isomorphismLaws subject proxy = testGroup subject $ [ testProperty "fromTextBuilder . toTextBuilder == id" $ (===) <$> B.fromTextBuilder . B.toTextBuilder <*> flip asProxyTypeOf proxy, testProperty "toTextBuilder . fromTextBuilder == id" $ (===) <$> B.toTextBuilder . flip asProxyTypeOf proxy . B.fromTextBuilder <*> id ] text-builder-dev-0.3.5/text-builder-dev.cabal0000644000000000000000000000627707346545000017260 0ustar0000000000000000cabal-version: 3.0 name: text-builder-dev version: 0.3.5 category: Text, Builders 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 maintainer: Nikita Volkov 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 base-settings default-extensions: NoImplicitPrelude NoMonomorphismRestriction BangPatterns ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable EmptyDataDecls FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs LambdaCase LiberalTypeSynonyms MagicHash MultiParamTypeClasses MultiWayIf OverloadedStrings ParallelListComp PatternGuards QuasiQuotes RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators ViewPatterns default-language: Haskell2010 library import: base-settings hs-source-dirs: library exposed-modules: TextBuilderDev other-modules: TextBuilderDev.Allocator TextBuilderDev.Prelude TextBuilderDev.Unicode TextBuilderDev.Utf16View TextBuilderDev.Utf8View build-depends: , base >=4.11 && <5 , bytestring >=0.10 && <0.13 , deferred-folds >=0.9.10.1 && <0.10 , isomorphism-class >=0.1.0.1 && <0.2 , QuickCheck >=2.14 && <3 , quickcheck-instances >=0.3.28 && <0.4 , split >=0.2.3.4 && <0.3 , text >=1.0 && <3 , time >=1.12 && <2 , transformers >=0.5 && <0.7 test-suite test import: base-settings type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Main.hs other-modules: TextBuilderDev.TastyExtras build-depends: , base-compat >=0.13 , quickcheck-classes >=0.6.5 && <0.7 , quickcheck-instances >=0.3.28 && <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: base-settings type: exitcode-stdio-1.0 ghc-options: -O2 hs-source-dirs: benchmark-text main-is: Main.hs build-depends: , criterion >=1.5.13.0 && <2 , rerebase >=1 && <2 , text-builder-dev benchmark benchmark-char import: base-settings type: exitcode-stdio-1.0 ghc-options: -O2 hs-source-dirs: benchmark-char main-is: Main.hs build-depends: , criterion >=1.5.13.0 && <2 , rerebase >=1 && <2 , text-builder-dev