text-builder-dev 0.3.10 → 0.4
raw patch · 22 files changed
+768/−1519 lines, 22 filesdep +text-builderdep +text-builder-coredep −base-compatdep −criteriondep −deferred-foldsdep ~quickcheck-instancesdep ~tastydep ~tasty-quickcheck
Dependencies added: text-builder, text-builder-core
Dependencies removed: base-compat, criterion, deferred-folds, isomorphism-class, lawful-conversions, rerebase, tasty-hunit
Dependency ranges changed: quickcheck-instances, tasty, tasty-quickcheck, text
Files
- bench/Main.hs +0/−78
- library/TextBuilderDev.hs +33/−741
- library/TextBuilderDev/Allocator.hs +0/−315
- library/TextBuilderDev/Domains/Digits.hs +40/−0
- library/TextBuilderDev/Domains/Other.hs +101/−0
- library/TextBuilderDev/Domains/Padding.hs +59/−0
- library/TextBuilderDev/Domains/StrictBuilder.hs +29/−0
- library/TextBuilderDev/Domains/StrictTextBuilder.hs +29/−0
- library/TextBuilderDev/Domains/Time.hs +118/−0
- library/TextBuilderDev/Isomorphic.hs +48/−0
- library/TextBuilderDev/Prelude.hs +0/−6
- library/TextBuilderDev/Unicode.hs +0/−22
- library/TextBuilderDev/Utf16View.hs +0/−48
- library/TextBuilderDev/Utf8View.hs +0/−33
- test/Features.hs +44/−0
- test/Features/StrictBuilder.hs +47/−0
- test/Features/StrictTextBuilder.hs +47/−0
- test/Main.hs +26/−201
- test/TextBuilderDev/TastyExtras.hs +0/−37
- test/Util/ExtraInstances.hs +12/−0
- test/Util/TestTrees.hs +104/−0
- text-builder-dev.cabal +31/−38
− bench/Main.hs
@@ -1,78 +0,0 @@-module 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- [ bgroup- "Left-biased mappend"- let {-# NOINLINE sampleBySize #-}- sampleBySize :: (Monoid a, IsString a) => Int -> (a -> Text) -> Text- sampleBySize size compile =- "фывапролдж"- & replicate size- & foldl' (<>) mempty- & compile- in [ bgroup- "1kB"- let sample = sampleBySize 100- in [ bench "TextBuilderDev" (nf sample A.toText),- bench "Data.Text.Lazy.Builder" (nf sample (C.toStrict . B.toLazyText))- ],- bgroup- "1MB"- let sample = sampleBySize 100_000- in [ bench "TextBuilderDev" (nf sample A.toText),- bench "Data.Text.Lazy.Builder" (nf sample (C.toStrict . B.toLazyText))- ]- ],- bgroup- "Right-biased mappend"- let {-# NOINLINE sampleBySize #-}- sampleBySize :: (Monoid a, IsString a) => Int -> (a -> Text) -> Text- sampleBySize size compile =- "фывапролдж"- & replicate size- & foldl' (flip (<>)) mempty- & compile- in [ bgroup- "1kB"- let sample = sampleBySize 100- in [ bench "TextBuilderDev" (nf sample A.toText),- bench "Data.Text.Lazy.Builder" (nf sample (C.toStrict . B.toLazyText))- ],- bgroup- "1MB"- let sample = sampleBySize 100_000- in [ bench "TextBuilderDev" (nf sample A.toText),- bench "Data.Text.Lazy.Builder" (nf sample (C.toStrict . B.toLazyText))- ]- ],- bgroup- "mconcat"- let {-# NOINLINE sampleBySize #-}- sampleBySize :: (Monoid a, IsString a) => Int -> (a -> Text) -> Text- sampleBySize size compile =- "фывапролдж"- & replicate size- & mconcat- & compile- in [ bgroup- "1kB"- let sample = sampleBySize 100- in [ bench "TextBuilderDev" (nf sample A.toText),- bench "Data.Text.Lazy.Builder" (nf sample (C.toStrict . B.toLazyText))- ],- bgroup- "1MB"- let sample = sampleBySize 100_000- in [ bench "TextBuilderDev" (nf sample A.toText),- bench "Data.Text.Lazy.Builder" (nf sample (C.toStrict . B.toLazyText))- ]- ]- ]
library/TextBuilderDev.hs view
@@ -1,23 +1,14 @@-{-# LANGUAGE CPP #-}- module TextBuilderDev ( TextBuilder, -- * Accessors toText,- buildText,- length,- null,-- -- ** Output IO- putToStdOut,- putToStdErr,- putLnToStdOut,- putLnToStdErr,+ toString,+ isEmpty, -- * Constructors - -- ** Builder manipulators+ -- ** Transformations force, intercalate, intercalateMap,@@ -28,756 +19,57 @@ text, lazyText, string,- asciiByteString,- hexData,+ unsafeUtf8ByteString, -- ** Character char,+ unicodeCodepoint, - -- *** Low-level character- unicodeCodePoint,- utf16CodeUnits1,- utf16CodeUnits2,- utf8CodeUnits1,- utf8CodeUnits2,- utf8CodeUnits3,- utf8CodeUnits4,+ -- ** Data+ byteStringHexEncoding, -- ** Integers -- *** Decimal decimal,- unsignedDecimal,- fixedUnsignedDecimal,+ fixedLengthDecimal, thousandSeparatedDecimal,- thousandSeparatedUnsignedDecimal,- dataSizeInBytesInDecimal, -- *** Binary- unsignedBinary,- unsignedPaddedBinary,- finiteBitsUnsignedBinary,+ binary,+ prefixedBinary, + -- *** Octal+ octal,+ prefixedOctal,+ -- *** Hexadecimal hexadecimal,- unsignedHexadecimal,-- -- ** Digits- decimalDigit,- hexadecimalDigit,+ prefixedHexadecimal, -- ** Real- fixedDouble,- doublePercent,+ doubleFixedPoint,+ doubleFixedPointPercent, -- ** Time- utcTimeInIso8601,- utcTimestampInIso8601,- intervalInSeconds,- diffTimeCompact,- picosecondsCompact,+ utcTimeIso8601Timestamp,+ realFracDdHhMmSsInterval,+ diffTimeSeconds,+ picoseconds, + -- ** Other+ approximateDataSize,+ -- * Classes- IsomorphicToTextBuilder (..),+ Isomorphic (..), ) 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 IsomorphismClass-import qualified LawfulConversions-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---- * ------ |--- 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 . toText--instance Eq TextBuilder where- (==) = on (==) toText--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- ]---- ** Strict Text--instance IsomorphicToTextBuilder Text where- toTextBuilder = text- fromTextBuilder = toText--instance IsomorphismClass.IsomorphicTo TextBuilder Text where- to = TextBuilderDev.text--instance IsomorphismClass.IsomorphicTo Text TextBuilder where- to = TextBuilderDev.toText--instance LawfulConversions.IsSome TextBuilder Text where- to = TextBuilderDev.text--instance LawfulConversions.IsSome Text TextBuilder where- to = TextBuilderDev.toText--instance LawfulConversions.IsMany TextBuilder Text--instance LawfulConversions.IsMany Text TextBuilder--instance LawfulConversions.Is TextBuilder Text--instance LawfulConversions.Is Text TextBuilder---- ** String--instance IsomorphicToTextBuilder String where- toTextBuilder = fromString- fromTextBuilder = Text.unpack . toText--instance LawfulConversions.IsSome String TextBuilder where- to = Text.unpack . toText- maybeFrom = fmap text . LawfulConversions.maybeFrom--instance LawfulConversions.IsMany String TextBuilder where- from = text . LawfulConversions.from---- ** Lazy Text--instance IsomorphicToTextBuilder TextLazy.Text where- toTextBuilder = lazyText- fromTextBuilder = TextLazy.fromStrict . toText--instance IsomorphismClass.IsomorphicTo TextBuilder TextLazy.Text where- to = TextBuilderDev.lazyText--instance IsomorphismClass.IsomorphicTo TextLazy.Text TextBuilder where- to = IsomorphismClass.to . IsomorphismClass.to @Text--instance LawfulConversions.IsSome TextBuilder TextLazy.Text where- to = lazyText--instance LawfulConversions.IsSome TextLazy.Text TextBuilder where- to = TextLazy.fromStrict . toText--instance LawfulConversions.IsMany TextBuilder TextLazy.Text--instance LawfulConversions.IsMany TextLazy.Text TextBuilder--instance LawfulConversions.Is TextBuilder TextLazy.Text--instance LawfulConversions.Is TextLazy.Text TextBuilder---- ** Lazy Text Builder--instance IsomorphicToTextBuilder TextLazyBuilder.Builder where- toTextBuilder = text . TextLazy.toStrict . TextLazyBuilder.toLazyText- fromTextBuilder = TextLazyBuilder.fromText . toText--instance IsomorphismClass.IsomorphicTo TextBuilder TextLazyBuilder.Builder where- to = IsomorphismClass.to . IsomorphismClass.to @TextLazy.Text--instance IsomorphismClass.IsomorphicTo TextLazyBuilder.Builder TextBuilder where- to = IsomorphismClass.to . IsomorphismClass.to @Text--instance LawfulConversions.IsSome TextBuilder TextLazyBuilder.Builder where- to = text . TextLazy.toStrict . TextLazyBuilder.toLazyText--instance LawfulConversions.IsSome TextLazyBuilder.Builder TextBuilder where- to = TextLazyBuilder.fromText . toText--instance LawfulConversions.IsMany TextBuilder TextLazyBuilder.Builder--instance LawfulConversions.IsMany TextLazyBuilder.Builder TextBuilder--instance LawfulConversions.Is TextBuilder TextLazyBuilder.Builder--instance LawfulConversions.Is TextLazyBuilder.Builder TextBuilder---- ** Strict Text Builder--#if MIN_VERSION_text(2,1,2)--instance IsomorphicToTextBuilder TextEncoding.StrictTextBuilder where- toTextBuilder = toTextBuilder . TextEncoding.strictBuilderToText- fromTextBuilder = TextEncoding.textToStrictBuilder . fromTextBuilder--instance IsomorphismClass.IsomorphicTo TextBuilder TextEncoding.StrictTextBuilder where- to = IsomorphismClass.to . TextEncoding.strictBuilderToText--instance IsomorphismClass.IsomorphicTo TextEncoding.StrictTextBuilder TextBuilder where- to = TextEncoding.textToStrictBuilder . IsomorphismClass.to--instance LawfulConversions.IsSome TextBuilder TextEncoding.StrictTextBuilder where- to = toTextBuilder . TextEncoding.strictBuilderToText--instance LawfulConversions.IsSome TextEncoding.StrictTextBuilder TextBuilder where- to = TextEncoding.textToStrictBuilder . fromTextBuilder--instance LawfulConversions.IsMany TextBuilder TextEncoding.StrictTextBuilder--instance LawfulConversions.IsMany TextEncoding.StrictTextBuilder TextBuilder--instance LawfulConversions.Is TextBuilder TextEncoding.StrictTextBuilder--instance LawfulConversions.Is TextEncoding.StrictTextBuilder TextBuilder--#elif MIN_VERSION_text(2,0,2)--instance IsomorphicToTextBuilder TextEncoding.StrictBuilder where- toTextBuilder = toTextBuilder . TextEncoding.strictBuilderToText- fromTextBuilder = TextEncoding.textToStrictBuilder . fromTextBuilder--instance IsomorphismClass.IsomorphicTo TextBuilder TextEncoding.StrictBuilder where- to = IsomorphismClass.to . TextEncoding.strictBuilderToText--instance IsomorphismClass.IsomorphicTo TextEncoding.StrictBuilder TextBuilder where- to = TextEncoding.textToStrictBuilder . IsomorphismClass.to--instance LawfulConversions.IsSome TextBuilder TextEncoding.StrictBuilder where- to = toTextBuilder . TextEncoding.strictBuilderToText--instance LawfulConversions.IsSome TextEncoding.StrictBuilder TextBuilder where- to = TextEncoding.textToStrictBuilder . fromTextBuilder--instance LawfulConversions.IsMany TextBuilder TextEncoding.StrictBuilder--instance LawfulConversions.IsMany TextEncoding.StrictBuilder TextBuilder--instance LawfulConversions.Is TextBuilder TextEncoding.StrictBuilder--instance LawfulConversions.Is TextEncoding.StrictBuilder TextBuilder--#endif---- * 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 the builder producing a strict text.-toText :: TextBuilder -> Text-toText (TextBuilder allocator _) =- Allocator.allocate allocator--{-# DEPRECATED buildText "Use toText instead" #-}---- | Alias to 'toText'.-buildText :: TextBuilder -> Text-buildText = toText---- ** Output IO---- | Put builder, to stdout.-putToStdOut :: TextBuilder -> IO ()-putToStdOut = Text.hPutStr stdout . toText---- | Put builder, to stderr.-putToStdErr :: TextBuilder -> IO ()-putToStdErr = Text.hPutStr stderr . toText---- | Put builder, followed by a line, to stdout.-putLnToStdOut :: TextBuilder -> IO ()-putLnToStdOut = Text.hPutStrLn stdout . toText---- | Put builder, followed by a line, to stderr.-putLnToStdErr :: TextBuilder -> IO ()-putLnToStdErr = Text.hPutStrLn stderr . toText---- * 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 = 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 . 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 digit] (1 :: Int) 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 digit : char separatorChar : builders)- (succ index)- value- else- processAnotherDigit- (decimalDigit 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 remainder---- | Unsigned binary number.-{-# INLINE unsignedBinary #-}-unsignedBinary :: (Integral a) => a -> TextBuilder-unsignedBinary =- foldMap decimalDigit . 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 $ 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 (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.------ The format is the following:------ > DD:HH:MM:SS------ Directly applicable to 'DiffTime' and 'NominalDiffTime'.-{-# INLINEABLE intervalInSeconds #-}-intervalInSeconds :: (RealFrac seconds) => seconds -> TextBuilder-intervalInSeconds interval = flip evalState (round interval :: Int) $ 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)---- | DiffTime in a compact decimal format based on 'picosecondsCompact'.-diffTimeCompact :: DiffTime -> TextBuilder-diffTimeCompact = picosecondsCompact . diffTimeToPicoseconds---- | Amount of picoseconds represented in a compact decimal format using suffixes.------ E.g., the following is @1_230_000_000@ picoseconds or 1.23 milliseconds or 1230 microseconds:------ > 1230us-picosecondsCompact :: Integer -> TextBuilder-picosecondsCompact x =- attemptOr 1_000_000_000_000 "s"- $ attemptOr 1_000_000_000 "ms"- $ attemptOr 1_000_000 "us"- $ attemptOr 1_000 "ns"- $ decimal x- <> "ps"- where- attemptOr factor suffix alternative =- if x == divided * factor- then decimal divided <> suffix- else alternative- where- divided = div x factor---- | 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+import TextBuilder+import TextBuilderDev.Domains.Digits+import TextBuilderDev.Domains.Other+import TextBuilderDev.Domains.Padding+import TextBuilderDev.Domains.StrictBuilder ()+import TextBuilderDev.Domains.StrictTextBuilder ()+import TextBuilderDev.Domains.Time+import TextBuilderDev.Isomorphic
− library/TextBuilderDev/Allocator.hs
@@ -1,315 +0,0 @@-{-# 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 (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 (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)
+ library/TextBuilderDev/Domains/Digits.hs view
@@ -0,0 +1,40 @@+module TextBuilderDev.Domains.Digits where++import qualified Data.ByteString as ByteString+import qualified Data.List.Split as Split+import TextBuilder+import TextBuilderDev.Prelude hiding (intercalate)++-- | 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)++{-# INLINE signed #-}+signed :: (Ord a, Num a) => (a -> TextBuilder) -> a -> TextBuilder+signed onUnsigned i =+ if i >= 0+ then onUnsigned i+ else unicodeCodepoint 45 <> onUnsigned (negate i)++-- | Hexadecimal readable representation of binary data.+--+-- >>> byteStringHexEncoding "Hello"+-- "4865 6c6c 6f"+{-# INLINE byteStringHexEncoding #-}+byteStringHexEncoding :: ByteString -> TextBuilder+byteStringHexEncoding =+ intercalate " "+ . fmap mconcat+ . Split.chunksOf 2+ . fmap hexadecimal+ . ByteString.unpack
+ library/TextBuilderDev/Domains/Other.hs view
@@ -0,0 +1,101 @@+module TextBuilderDev.Domains.Other where++import TextBuilder+import TextBuilderDev.Domains.Digits+import TextBuilderDev.Prelude hiding (intercalate)++-- | Data size in decimal notation over amount of bytes.+--+-- >>> approximateDataSize 999+-- "999B"+--+-- >>> approximateDataSize 9999+-- "9.9kB"+--+-- >>> approximateDataSize (-9999)+-- "-9.9kB"+--+-- >>> approximateDataSize 1234567890+-- "1.2GB"+--+-- >>> approximateDataSize 10000000000000000000000000000000023+-- "10,000,000,000YB"+{-# INLINEABLE approximateDataSize #-}+approximateDataSize :: (Integral a) => a -> TextBuilder+approximateDataSize = signed \a ->+ if a < 1000+ then decimal a <> "B"+ else+ if a < 1000000+ then dividedDecimal 100 a <> "kB"+ else+ if a < 1000000000+ then dividedDecimal 100000 a <> "MB"+ else+ if a < 1000000000000+ then dividedDecimal 100000000 a <> "GB"+ else+ if a < 1000000000000000+ then dividedDecimal 100000000000 a <> "TB"+ else+ if a < 1000000000000000000+ then dividedDecimal 100000000000000 a <> "PB"+ else+ if a < 1000000000000000000000+ then dividedDecimal 100000000000000000 a <> "EB"+ else+ if a < 1000000000000000000000000+ then dividedDecimal 100000000000000000000 a <> "ZB"+ else dividedDecimal 100000000000000000000000 a <> "YB"+ where+ dividedDecimal divisor n =+ let byDivisor = div n divisor+ byExtraTen = div byDivisor 10+ remainder = byDivisor - byExtraTen * 10+ separatorChar = ','+ in if remainder == 0 || byExtraTen >= 10+ then thousandSeparatedDecimal separatorChar byExtraTen+ else thousandSeparatedDecimal separatorChar byExtraTen <> "." <> decimalDigit remainder++-- | Double with a fixed number of decimal places.+--+-- >>> doubleFixedPoint 4 0.123456+-- "0.1235"+--+-- >>> doubleFixedPoint 2 2.1+-- "2.10"+--+-- >>> doubleFixedPoint (-2) 2.1+-- "2"+--+-- >>> doubleFixedPoint 2 (-2.1)+-- "-2.10"+--+-- >>> doubleFixedPoint 2 0+-- "0.00"+{-# INLINE doubleFixedPoint #-}+doubleFixedPoint ::+ -- | Amount of decimals after point.+ Int ->+ Double ->+ TextBuilder+doubleFixedPoint (max 0 -> decimalPlaces) =+ fromString . printf ("%." ++ show decimalPlaces ++ "f")++-- | Double multiplied by 100 with a fixed number of decimal places applied and followed by a percent-sign.+--+-- >>> doubleFixedPointPercent 3 0.123456+-- "12.346%"+--+-- >>> doubleFixedPointPercent 0 2+-- "200%"+--+-- >>> doubleFixedPointPercent 0 (-2)+-- "-200%"+{-# INLINE doubleFixedPointPercent #-}+doubleFixedPointPercent ::+ -- | Amount of decimals after point.+ Int ->+ Double ->+ TextBuilder+doubleFixedPointPercent decimalPlaces x = doubleFixedPoint decimalPlaces (x * 100) <> "%"
+ library/TextBuilderDev/Domains/Padding.hs view
@@ -0,0 +1,59 @@+module TextBuilderDev.Domains.Padding where++import qualified Data.Text as Text+import TextBuilder+import TextBuilderDev.Prelude++-- | Pad a builder from the left side to the specified length with the specified character.+--+-- >>> padFromLeft 5 '0' "123"+-- "00123"+--+-- >>> padFromLeft 5 '0' "123456"+-- "123456"+{-# INLINEABLE padFromLeft #-}+padFromLeft :: Int -> Char -> TextBuilder -> TextBuilder+padFromLeft paddedLength paddingChar =+ textPaddedFromLeft paddedLength paddingChar . toText++-- | Pad a builder from the right side to the specified length with the specified character.+--+-- >>> padFromRight 5 ' ' "123"+-- "123 "+--+-- >>> padFromRight 5 ' ' "123456"+-- "123456"+{-# INLINEABLE padFromRight #-}+padFromRight :: Int -> Char -> TextBuilder -> TextBuilder+padFromRight paddedLength paddingChar =+ textPaddedFromRight paddedLength paddingChar . toText++-- | Pad a text from the left side to the specified length with the specified character.+--+-- >>> textPaddedFromLeft 5 '0' "123"+-- "00123"+--+-- >>> textPaddedFromLeft 5 '0' "123456"+-- "123456"+{-# INLINEABLE textPaddedFromLeft #-}+textPaddedFromLeft :: Int -> Char -> Text -> TextBuilder+textPaddedFromLeft paddedLength paddingChar input =+ let actualLength = Text.length input+ in if paddedLength <= actualLength+ then text input+ else foldMap char (replicate (paddedLength - actualLength) paddingChar) <> text input++-- | Pad a text from the right side to the specified length with the specified character.+--+-- >>> textPaddedFromRight 5 '0' "123"+-- "12300"+--+-- >>> textPaddedFromRight 5 '0' "123456"+-- "123456"+{-# INLINEABLE textPaddedFromRight #-}+textPaddedFromRight :: Int -> Char -> Text -> TextBuilder+textPaddedFromRight paddedLength paddingChar inputText =+ let actualLength = Text.length inputText+ in if paddedLength <= actualLength+ then text inputText+ else text inputText <> foldMap char (replicate (paddedLength - actualLength) paddingChar)
+ library/TextBuilderDev/Domains/StrictBuilder.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wno-orphans #-}++module TextBuilderDev.Domains.StrictBuilder where++#if MIN_VERSION_text(2,0,2) && !MIN_VERSION_text(2,1,2)++import Data.Text.Internal.StrictBuilder+import qualified TextBuilderCore as Core+import TextBuilderDev.Isomorphic+import TextBuilderDev.Prelude++instance Isomorphic StrictBuilder where+ {-# INLINE from #-}+ from (StrictBuilder size write) =+ Core.TextBuilder+ size+ ( \array offset ->+ write array offset $> offset + size+ )+ {-# INLINE to #-}+ to (Core.TextBuilder size write) =+ StrictBuilder+ size+ ( \array offset ->+ write array offset $> ()+ )++#endif
+ library/TextBuilderDev/Domains/StrictTextBuilder.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wno-orphans #-}++module TextBuilderDev.Domains.StrictTextBuilder where++#if MIN_VERSION_text(2,1,2)++import Data.Text.Internal.StrictBuilder+import qualified TextBuilderCore as Core+import TextBuilderDev.Isomorphic+import TextBuilderDev.Prelude++instance Isomorphic StrictTextBuilder where+ {-# INLINE from #-}+ from (StrictTextBuilder size write) =+ Core.TextBuilder+ size+ ( \array offset ->+ write array offset $> offset + size+ )+ {-# INLINE to #-}+ to (Core.TextBuilder size write) =+ StrictTextBuilder+ size+ ( \array offset ->+ write array offset $> ()+ )++#endif
+ library/TextBuilderDev/Domains/Time.hs view
@@ -0,0 +1,118 @@+module TextBuilderDev.Domains.Time where++import TextBuilder+import TextBuilderDev.Domains.Padding+import TextBuilderDev.Prelude++-- | UTC time in ISO8601 format.+--+-- >>> utcTimeIso8601Timestamp (read "2021-11-24 12:11:02 UTC")+-- "2021-11-24T12:11:02Z"+utcTimeIso8601Timestamp :: UTCTime -> TextBuilder+utcTimeIso8601Timestamp 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:+--+-- Integrations with various time-libraries can be easily derived from that.+--+-- >>> utcTimestampInIso8601 2021 11 24 12 11 02+-- "2021-11-24T12:11:02Z"+utcTimestampInIso8601 ::+ -- | Year.+ Int ->+ -- | Month.+ Int ->+ -- | Day.+ Int ->+ -- | Hour.+ Int ->+ -- | Minute.+ Int ->+ -- | Second.+ Int ->+ TextBuilder+utcTimestampInIso8601 y mo d h mi s =+ mconcat+ [ fixedLengthDecimal 4 y,+ "-",+ fixedLengthDecimal 2 mo,+ "-",+ fixedLengthDecimal 2 d,+ "T",+ fixedLengthDecimal 2 h,+ ":",+ fixedLengthDecimal 2 mi,+ ":",+ fixedLengthDecimal 2 s,+ "Z"+ ]++-- |+-- Time interval in seconds.+-- Directly applicable to 'DiffTime' and 'NominalDiffTime'.+--+-- The format is the following:+--+-- > DD:HH:MM:SS+--+-- >>> realFracDdHhMmSsInterval @Double 59+-- "00:00:00:59"+--+-- >>> realFracDdHhMmSsInterval @Double 90+-- "00:00:01:30"+--+-- >>> realFracDdHhMmSsInterval @Double 86401+-- "01:00:00:01"+--+-- >>> realFracDdHhMmSsInterval @Double (356 * 86400)+-- "356:00:00:00"+{-# INLINEABLE realFracDdHhMmSsInterval #-}+realFracDdHhMmSsInterval :: (RealFrac seconds) => seconds -> TextBuilder+realFracDdHhMmSsInterval interval = flip evalState (round interval :: Int) $ do+ seconds <- state (swap . flip divMod 60)+ minutes <- state (swap . flip divMod 60)+ hours <- state (swap . flip divMod 24)+ days <- get+ return+ ( mconcat+ [ padFromLeft 2 '0' (decimal days),+ ":",+ padFromLeft 2 '0' (decimal hours),+ ":",+ padFromLeft 2 '0' (decimal minutes),+ ":",+ padFromLeft 2 '0' (decimal seconds)+ ]+ )++-- | DiffTime in a compact decimal format based on 'picoseconds'.+diffTimeSeconds :: DiffTime -> TextBuilder+diffTimeSeconds = picoseconds . diffTimeToPicoseconds++-- | Amount of picoseconds represented in a compact decimal format using suffixes.+--+-- E.g., the following is @1_230_000_000@ picoseconds or 1.23 milliseconds or 1230 microseconds:+--+-- > 1230us+picoseconds :: Integer -> TextBuilder+picoseconds x =+ attemptOr 1_000_000_000_000 "s"+ $ attemptOr 1_000_000_000 "ms"+ $ attemptOr 1_000_000 "us"+ $ attemptOr 1_000 "ns"+ $ decimal x+ <> "ps"+ where+ attemptOr factor suffix alternative =+ if x == divided * factor+ then decimal divided <> suffix+ else alternative+ where+ divided = div x factor
+ library/TextBuilderDev/Isomorphic.hs view
@@ -0,0 +1,48 @@+module TextBuilderDev.Isomorphic where++import qualified Data.Text.Lazy as TextLazy+import qualified Data.Text.Lazy.Builder as TextLazyBuilder+import TextBuilder+import TextBuilderDev.Prelude++-- |+-- Evidence that there exists an unambiguous way to convert+-- a type to and from "TextBuilder".+--+-- The laws are:+--+-- - @'from' . 'to' = 'id'@+--+-- - @'to' . 'from' = '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).+class Isomorphic a where+ -- | Project the type into "TextBuilder".+ from :: a -> TextBuilder++ -- | Embed "TextBuilder" into the type.+ to :: TextBuilder -> a++instance Isomorphic TextBuilder where+ from = id+ to = id++instance Isomorphic Text where+ from = text+ to = toText++instance Isomorphic TextLazy.Text where+ from = lazyText+ to = TextLazy.fromStrict . toText++instance Isomorphic TextLazyBuilder.Builder where+ from = lazyText . TextLazyBuilder.toLazyText+ to = TextLazyBuilder.fromText . toText
library/TextBuilderDev/Prelude.hs view
@@ -1,6 +1,5 @@ module TextBuilderDev.Prelude ( module Exports,- Product2 (..), ) where @@ -52,7 +51,6 @@ 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@@ -72,11 +70,7 @@ 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
− library/TextBuilderDev/Unicode.hs
@@ -1,22 +0,0 @@--- |--- 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
− library/TextBuilderDev/Utf16View.hs
@@ -1,48 +0,0 @@-module 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)
− library/TextBuilderDev/Utf8View.hs
@@ -1,33 +0,0 @@-module 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)
+ test/Features.hs view
@@ -0,0 +1,44 @@+module Features (tests) where++import Data.Int+import Data.String+import Data.Time+import Data.Time.Format.ISO8601 (iso8601Show)+import Data.Word+import qualified Features.StrictBuilder as StrictBuilder+import qualified Features.StrictTextBuilder as StrictTextBuilder+import Numeric.Natural (Natural)+import Test.QuickCheck.Instances ()+import Test.Tasty+import Test.Tasty.QuickCheck+import TextBuilderDev+import Util.TestTrees+import Prelude++tests :: [TestTree]+tests =+ [ testGroup "StrictBuilder" StrictBuilder.tests,+ testGroup "StrictTextBuilder" StrictTextBuilder.tests,+ testGroup "doubleFixedPoint" $+ [ mapsToMonoid (doubleFixedPoint 3)+ ],+ testGroup "doubleFixedPointPercent" $+ [ mapsToMonoid (doubleFixedPointPercent 3)+ ],+ testGroup "utcTimeIso8601Timestamp" $+ [ mapsToMonoid utcTimeIso8601Timestamp,+ testProperty "Same as iso8601Show" $ \x ->+ let roundedToSecondsTime =+ x {utctDayTime = (fromIntegral @Int . round . utctDayTime) x}+ in (fromString . flip mappend "Z" . take 19 . iso8601Show) roundedToSecondsTime+ === toText (utcTimeIso8601Timestamp roundedToSecondsTime)+ ],+ testGroup "approximateDataSize" $+ [ testGroup "Word" $+ [ mapsToMonoid @Word approximateDataSize+ ],+ testGroup "Natural" $+ [ mapsToMonoid @Natural approximateDataSize+ ]+ ]+ ]
+ test/Features/StrictBuilder.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wno-orphans #-}++module Features.StrictBuilder (tests) where++#if MIN_VERSION_text(2,0,2) && !MIN_VERSION_text(2,1,2)++import Data.Function+import Data.Proxy+import qualified Data.Text.Encoding as TextEncoding+import Test.QuickCheck.Instances ()+import Test.Tasty+import Test.Tasty.QuickCheck+import TextBuilderDev+import Util.TestTrees+import Prelude++tests :: [TestTree]+tests =+ [ isomorphic $+ Proxy @TextEncoding.StrictBuilder,+ testGroup "to" $+ [ mapsToMonoid (to @TextEncoding.StrictBuilder),+ mapsToMonoid (from @TextEncoding.StrictBuilder)+ ]+ ]++instance Eq TextEncoding.StrictBuilder where+ a == b =+ on (==) TextEncoding.strictBuilderToText a b++instance Show TextEncoding.StrictBuilder where+ showsPrec d =+ showsPrec d . TextEncoding.strictBuilderToText++instance Arbitrary TextEncoding.StrictBuilder where+ arbitrary =+ TextEncoding.textToStrictBuilder <$> arbitrary++#else++import Test.Tasty++tests :: [TestTree]+tests = []++#endif
+ test/Features/StrictTextBuilder.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wno-orphans #-}++module Features.StrictTextBuilder (tests) where++#if MIN_VERSION_text(2,1,2)++import Data.Function+import Data.Proxy+import qualified Data.Text.Encoding as TextEncoding+import Test.QuickCheck.Instances ()+import Test.Tasty+import Test.Tasty.QuickCheck+import TextBuilderDev+import Util.TestTrees+import Prelude++tests :: [TestTree]+tests =+ [ isomorphic $+ Proxy @TextEncoding.StrictTextBuilder,+ testGroup "to" $+ [ mapsToMonoid (to @TextEncoding.StrictTextBuilder),+ mapsToMonoid (from @TextEncoding.StrictTextBuilder)+ ]+ ]++instance Eq TextEncoding.StrictTextBuilder where+ a == b =+ on (==) TextEncoding.strictBuilderToText a b++instance Show TextEncoding.StrictTextBuilder where+ showsPrec d =+ showsPrec d . TextEncoding.strictBuilderToText++instance Arbitrary TextEncoding.StrictTextBuilder where+ arbitrary =+ TextEncoding.textToStrictBuilder <$> arbitrary++#else++import Test.Tasty++tests :: [TestTree]+tests = []++#endif
test/Main.hs view
@@ -1,212 +1,37 @@ module Main where -import qualified Data.ByteString as ByteString-import qualified Data.Char as Char-import qualified Data.Text as Text+import Data.Proxy+import Data.Text (Text) import qualified Data.Text.Lazy as TextLazy import qualified Data.Text.Lazy.Builder as TextLazyBuilder-import qualified LawfulConversions-import Numeric.Compat+import qualified Features import Test.QuickCheck.Classes import Test.QuickCheck.Instances () import Test.Tasty-import Test.Tasty.HUnit-import Test.Tasty.QuickCheck hiding ((.&.))-import TextBuilderDev (TextBuilder) import qualified TextBuilderDev as B-import qualified TextBuilderDev.TastyExtras as Extras-import Prelude hiding (choose, showBin)+import Util.ExtraInstances ()+import Util.TestTrees+import Prelude 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.toText (foldMap B.asciiByteString chunks)),- testProperty "Intercalation has the same effect as in Text"- $ \separator texts ->- Text.intercalate separator texts- === B.toText (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.toText (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.toText (foldMap B.char chars),- testProperty "Concatting a list of texts is isomorphic to fold-mapping with builders"- $ \texts ->- mconcat texts- === B.toText (foldMap B.text texts),- testProperty "Concatting a list of texts is isomorphic to concatting a list of builders"- $ \texts ->- mconcat texts- === B.toText (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.toText (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.toText (B.unicodeCodePoint (Char.ord c) <> B.text text) === Text.cons c text,- testGroup "Time interval"- $ [ testCase "59s" $ assertEqual "" "00:00:00:59" $ B.toText $ B.intervalInSeconds @Double 59,- testCase "minute" $ assertEqual "" "00:00:01:00" $ B.toText $ B.intervalInSeconds @Double 60,- testCase "90s" $ assertEqual "" "00:00:01:30" $ B.toText $ B.intervalInSeconds @Double 90,- testCase "hour" $ assertEqual "" "00:01:00:00" $ B.toText $ B.intervalInSeconds @Double 3600,- testCase "day" $ assertEqual "" "01:00:00:00" $ B.toText $ B.intervalInSeconds @Double 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.toText (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.toText 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.toText (cuBuilder <> B.text text) === Text.cons c text- ],- testCase "thousandSeparatedUnsignedDecimal" $ do- assertEqual "" "0" (B.toText (B.thousandSeparatedUnsignedDecimal @Integer ',' 0))- assertEqual "" "123" (B.toText (B.thousandSeparatedUnsignedDecimal @Integer ',' 123))- assertEqual "" "1,234" (B.toText (B.thousandSeparatedUnsignedDecimal @Integer ',' 1234))- assertEqual "" "1,234,567" (B.toText (B.thousandSeparatedUnsignedDecimal @Integer ',' 1234567)),- testCase "padFromLeft" $ do- assertEqual "" "00" (B.toText (B.padFromLeft 2 '0' ""))- assertEqual "" "00" (B.toText (B.padFromLeft 2 '0' "0"))- assertEqual "" "01" (B.toText (B.padFromLeft 2 '0' "1"))- assertEqual "" "12" (B.toText (B.padFromLeft 2 '0' "12"))- assertEqual "" "123" (B.toText (B.padFromLeft 2 '0' "123")),- testCase "padFromRight" $ do- assertEqual "" "00" (B.toText (B.padFromRight 2 '0' ""))- assertEqual "" "00" (B.toText (B.padFromRight 2 '0' "0"))- assertEqual "" "10" (B.toText (B.padFromRight 2 '0' "1"))- assertEqual "" "12" (B.toText (B.padFromRight 2 '0' "12"))- assertEqual "" "123" (B.toText (B.padFromRight 2 '0' "123"))- assertEqual "" "1 " (B.toText (B.padFromRight 3 ' ' "1")),- testProperty "decimal" $ \(x :: Integer) ->- (fromString . show) x === (B.toText (B.decimal x)),- testGroup "hexadecimal"- $ [ testProperty "show isomorphism" $ \(x :: Integer) ->- x >= 0 ==>- (fromString . showHex x) "" === (B.toText . B.hexadecimal @Integer) x,- testCase "Positive"- $ assertEqual "" "1f23" (B.toText (B.hexadecimal @Integer 0x01f23)),- testCase "Negative"- $ assertEqual "" "-1f23" (B.toText (B.hexadecimal @Integer (-0x01f23)))- ],- testCase "dataSizeInBytesInDecimal" $ do- assertEqual "" "999B" (B.toText (B.dataSizeInBytesInDecimal @Integer ',' 999))- assertEqual "" "1kB" (B.toText (B.dataSizeInBytesInDecimal @Integer ',' 1000))- assertEqual "" "1.1kB" (B.toText (B.dataSizeInBytesInDecimal @Integer ',' 1100))- assertEqual "" "1.1MB" (B.toText (B.dataSizeInBytesInDecimal @Integer ',' 1150000))- assertEqual "" "9.9MB" (B.toText (B.dataSizeInBytesInDecimal @Integer ',' 9990000))- assertEqual "" "10MB" (B.toText (B.dataSizeInBytesInDecimal @Integer ',' 10100000))- assertEqual "" "1,000YB" (B.toText (B.dataSizeInBytesInDecimal @Integer ',' 1000000000000000000000000000)),- testCase "fixedDouble" $ do- assertEqual "" "0.0" (B.toText (B.fixedDouble 1 0.05))- assertEqual "" "0.1" (B.toText (B.fixedDouble 1 0.06))- assertEqual "" "10.0000" (B.toText (B.fixedDouble 4 10))- assertEqual "" "0.9000" (B.toText (B.fixedDouble 4 0.9)),- testCase "doublePercent" $ do- assertEqual "" "90.4%" (B.toText (B.doublePercent 1 0.904)),- testGroup "unsignedBinary"- $ [ testProperty "Produces the same output as showBin" $ \(x :: Natural) ->- fromString (showBin x "")- === B.toText (B.unsignedBinary x)- ],- testGroup "finiteBitsUnsignedBinary"- $ [ testProperty "Produces the same output as showBin" $ \(x :: Word) ->- fromString (showBin x "")- === B.toText (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.toText (B.fixedUnsignedDecimal (fromIntegral size) val)- ],- testGroup "utcTimeInIso8601"- $ [ testProperty "Same as iso8601Show" $ \x ->- let roundedToSecondsTime =- x {utctDayTime = (fromIntegral @Int . round . utctDayTime) x}- in (fromString . flip mappend "Z" . take 19 . iso8601Show) roundedToSecondsTime- === B.toText (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),- testGroup "LawfulConversions integration"- $ [ testProperties "Is Text" $ LawfulConversions.isProperties @Text @TextBuilder Proxy Proxy,- testProperties "Is Lazy Text" $ LawfulConversions.isProperties @TextLazy.Text @TextBuilder Proxy Proxy,- testProperties "Is Lazy Text Builder" $ LawfulConversions.isProperties @TextLazyBuilder.Builder @TextBuilder Proxy Proxy,- testProperties "IsMany String" $ LawfulConversions.isManyProperties @String @TextBuilder Proxy Proxy- ]- ]- where- bigTest = 10000+main = (defaultMain . testGroup "All") tests -testLaws :: Laws -> TestTree-testLaws Laws {..} =- testProperties lawsTypeclass lawsProperties+tests :: [TestTree]+tests =+ [ testGroup "Features" Features.tests,+ testGroup "Isomorphic instances" $+ [ testGroup "Text" $+ [ isomorphic $ Proxy @Text+ ],+ testGroup "Lazy Text" $+ [ isomorphic $ Proxy @TextLazy.Text+ ],+ testGroup "Lazy Text Builder" $+ [ isomorphic $ Proxy @TextLazyBuilder.Builder+ ]+ ],+ followsLaws $ showLaws (Proxy @B.TextBuilder),+ followsLaws $ eqLaws (Proxy @B.TextBuilder),+ followsLaws $ semigroupLaws (Proxy @B.TextBuilder),+ followsLaws $ monoidLaws (Proxy @B.TextBuilder)+ ]
− test/TextBuilderDev/TastyExtras.hs
@@ -1,37 +0,0 @@-{-# 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- ]
+ test/Util/ExtraInstances.hs view
@@ -0,0 +1,12 @@+{-# OPTIONS_GHC -Wno-orphans #-}++module Util.ExtraInstances where++import qualified Data.Text.Lazy.Builder as TextLazyBuilder+import Test.QuickCheck+import Test.QuickCheck.Instances ()+import Prelude++instance Arbitrary TextLazyBuilder.Builder where+ arbitrary =+ TextLazyBuilder.fromLazyText <$> arbitrary
+ test/Util/TestTrees.hs view
@@ -0,0 +1,104 @@+module Util.TestTrees where++import Data.List.NonEmpty (NonEmpty (..))+import Data.Monoid+import Data.Proxy+import Data.Semigroup+import Test.QuickCheck+import Test.QuickCheck.Classes+import Test.QuickCheck.Instances ()+import Test.Tasty+import Test.Tasty.QuickCheck+import TextBuilderDev+import Prelude++-- | Tests mapping from @a@ to @b@ to produce a valid 'Monoid'.+--+-- Tests the following properties:+--+-- [/Associative/]+-- @a '<>' (b '<>' c) ≡ (a '<>' b) '<>' c@+-- [/Semigroup Concatenation/]+-- @'sconcat' as ≡ 'foldr1' ('<>') as@+-- [/Times/]+-- @'stimes' n a ≡ 'foldr1' ('<>') ('replicate' n a)@+-- [/Left Identity/]+-- @mappend mempty a ≡ a@+-- [/Right Identity/]+-- @mappend a mempty ≡ a@+-- [/Monoid Concatenation/]+-- @mconcat as ≡ foldr mappend mempty as@+mapsToMonoid ::+ forall a b.+ (Arbitrary a, Show a, Eq a, Monoid b, Eq b, Show b) =>+ -- | Embed in monoid.+ (a -> b) ->+ TestTree+mapsToMonoid embed =+ customGenMonoid (embed <$> arbitrary)++-- | Tests mapping from @a@ to @b@ to produce a valid 'Monoid'.+--+-- Tests the following properties:+--+-- [/Associative/]+-- @a '<>' (b '<>' c) ≡ (a '<>' b) '<>' c@+-- [/Semigroup Concatenation/]+-- @'sconcat' as ≡ 'foldr1' ('<>') as@+-- [/Times/]+-- @'stimes' n a ≡ 'foldr1' ('<>') ('replicate' n a)@+-- [/Left Identity/]+-- @mappend mempty a ≡ a@+-- [/Right Identity/]+-- @mappend a mempty ≡ a@+-- [/Monoid Concatenation/]+-- @mconcat as ≡ foldr mappend mempty as@+customGenMonoid ::+ (Monoid a, Eq a, Show a) =>+ Gen a ->+ TestTree+customGenMonoid gen =+ testGroup+ "Monoid"+ [ testProperty "Is associative" do+ x <- gen+ y <- gen+ z <- gen+ pure (x <> (y <> z) === (x <> y) <> z),+ testProperty "Semigroup concatenation" do+ xs <- (:|) <$> gen <*> listOf gen+ pure (sconcat xs === foldr1 (<>) xs),+ testProperty "Times" do+ x <- gen+ Positive n <- arbitrary+ pure (stimes n x === foldr1 (<>) (replicate n x)),+ testProperty "Left identity" do+ x <- gen+ pure (mempty <> x === x),+ testProperty "Right identity" do+ x <- gen+ pure (x <> mempty === x),+ testProperty "Monoid concatenation" do+ xs <- listOf gen+ pure (mconcat xs === foldr mappend mempty xs)+ ]++isomorphic ::+ forall a.+ (Isomorphic a, Eq a, Show a, Arbitrary a) =>+ Proxy a ->+ TestTree+isomorphic proxy =+ testGroup "Isomorphic" $+ [ testProperty "to . from == id" $ \a ->+ (to . from) a === asProxyTypeOf a proxy,+ testProperty "from . to == id" $ \a ->+ (from . flip asProxyTypeOf proxy . to) a === a,+ testGroup "from" $+ [ mapsToMonoid (from @a)+ ]+ ]++followsLaws :: Laws -> TestTree+followsLaws Laws {..} =+ testProperties lawsTypeclass lawsProperties
text-builder-dev.cabal view
@@ -1,15 +1,16 @@ cabal-version: 3.0 name: text-builder-dev-version: 0.3.10+version: 0.4 category: Text, Builders synopsis: Edge of developments for "text-builder" description:- This is a development version of \"text-builder\".+ This is a development version of "[text-builder](https://hackage.haskell.org/package/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.+ For a more stable API use "text-builder". + The packages are compatible, because they both operate on the type defined in "[text-builder-core](https://hackage.haskell.org/package/text-builder-core)".+ 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>@@ -35,6 +36,7 @@ DeriveFunctor DeriveGeneric DeriveTraversable+ DerivingStrategies EmptyDataDecls FlexibleContexts FlexibleInstances@@ -57,6 +59,7 @@ RecordWildCards ScopedTypeVariables StandaloneDeriving+ StrictData TemplateHaskell TupleSections TypeApplications@@ -70,22 +73,22 @@ hs-source-dirs: library exposed-modules: TextBuilderDev other-modules:- TextBuilderDev.Allocator+ TextBuilderDev.Domains.Digits+ TextBuilderDev.Domains.Other+ TextBuilderDev.Domains.Padding+ TextBuilderDev.Domains.StrictBuilder+ TextBuilderDev.Domains.StrictTextBuilder+ TextBuilderDev.Domains.Time+ TextBuilderDev.Isomorphic TextBuilderDev.Prelude- TextBuilderDev.Unicode- TextBuilderDev.Utf16View- TextBuilderDev.Utf8View build-depends:- QuickCheck >=2.14 && <3, base >=4.11 && <5, bytestring >=0.10 && <0.13,- deferred-folds >=0.9.10.1 && <0.10,- isomorphism-class >=0.3 && <0.4,- lawful-conversions >=0.1.4 && <0.2,- quickcheck-instances >=0.3.28 && <0.4, split >=0.2.3.4 && <0.3,- text >=1.0 && <3,+ text >=1.2 && <3,+ text-builder ^>=1,+ text-builder-core ^>=0.1.1.1, time >=1.12 && <2, transformers >=0.5 && <0.7, @@ -94,30 +97,20 @@ type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Main.hs- other-modules: TextBuilderDev.TastyExtras- build-depends:- base-compat >=0.13,- lawful-conversions >=0.1.4 && <0.2,- 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.12,- text-builder-dev,--benchmark bench- import: base- type: exitcode-stdio-1.0- hs-source-dirs: bench- ghc-options:- -O2- -threaded- -with-rtsopts=-N- -funbox-strict-fields+ other-modules:+ Features+ Features.StrictBuilder+ Features.StrictTextBuilder+ Util.ExtraInstances+ Util.TestTrees - main-is: Main.hs build-depends:- criterion >=1.5.6.1 && <2,- rerebase >=1 && <2,+ QuickCheck >=2.14 && <3,+ base >=4.11 && <5,+ quickcheck-classes >=0.6.5 && <0.7,+ quickcheck-instances >=0.3.32 && <0.4,+ tasty >=1.5.3 && <2,+ tasty-quickcheck >=0.11.1 && <0.12,+ text >=1.2 && <3, text-builder-dev,+ time >=1.12 && <2,