text-builder-0.6.7.2/0000755000000000000000000000000007346545000012465 5ustar0000000000000000text-builder-0.6.7.2/LICENSE0000644000000000000000000000204207346545000013470 0ustar0000000000000000Copyright (c) 2017, 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-0.6.7.2/benchmark-char/0000755000000000000000000000000007346545000015332 5ustar0000000000000000text-builder-0.6.7.2/benchmark-char/Main.hs0000644000000000000000000000265707346545000016564 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 Text.Builder as A import Prelude main :: IO () main = defaultMain $ [ subjectBenchmark "builderSubject" builderSubject, subjectBenchmark "lazyTextBuilderSubject" lazyTextBuilderSubject, 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.run . A.string . map chr lazyTextBuilderSubject :: Subject lazyTextBuilderSubject = 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-0.6.7.2/benchmark-text/0000755000000000000000000000000007346545000015401 5ustar0000000000000000text-builder-0.6.7.2/benchmark-text/Main.hs0000644000000000000000000000261607346545000016626 0ustar0000000000000000module Main where import Criterion.Main import qualified Data.Text.Lazy as C import qualified Data.Text.Lazy.Builder as B import qualified Text.Builder as A import Prelude main :: IO () main = defaultMain $ [ subjectBenchmark "builderSubject" builderSubject, subjectBenchmark "lazyTextBuilderSubject" lazyTextBuilderSubject ] 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.run lazyTextBuilderSubject :: Subject lazyTextBuilderSubject = 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-0.6.7.2/library/Text/0000755000000000000000000000000007346545000015055 5ustar0000000000000000text-builder-0.6.7.2/library/Text/Builder.hs0000644000000000000000000001653507346545000017011 0ustar0000000000000000module Text.Builder ( Builder, -- * Accessors run, length, null, -- ** Output IO putToStdOut, putToStdErr, putLnToStdOut, putLnToStdErr, -- * Constructors -- ** Builder manipulators intercalate, padFromLeft, padFromRight, -- ** Textual text, lazyText, string, asciiByteString, hexData, -- ** Character char, -- *** Low-level character unicodeCodePoint, utf16CodeUnits1, utf16CodeUnits2, utf8CodeUnits1, utf8CodeUnits2, utf8CodeUnits3, utf8CodeUnits4, -- ** Integers -- *** Decimal decimal, unsignedDecimal, thousandSeparatedDecimal, thousandSeparatedUnsignedDecimal, dataSizeInBytesInDecimal, -- *** Binary unsignedBinary, unsignedPaddedBinary, -- *** Hexadecimal hexadecimal, unsignedHexadecimal, -- ** Digits decimalDigit, hexadecimalDigit, -- ** Real fixedDouble, doublePercent, -- ** Time intervalInSeconds, ) where import qualified Data.Text.Lazy as TextLazy import Text.Builder.Prelude hiding (intercalate, length, null) import qualified TextBuilderDev as Dev -- | -- Specification of how to efficiently construct strict 'Text'. -- Provides instances of 'Semigroup' and 'Monoid', which have complexity of /O(1)/. newtype Builder = Builder Dev.TextBuilder deriving (Show, IsString, Semigroup, Monoid) -- | Get the amount of characters {-# INLINE length #-} length :: Builder -> Int length = coerce Dev.length -- | Check whether the builder is empty {-# INLINE null #-} null :: Builder -> Bool null = coerce Dev.null -- | Execute a builder producing a strict text run :: Builder -> Text run = coerce Dev.buildText -- ** Output IO -- | Put builder, to stdout putToStdOut :: Builder -> IO () putToStdOut = coerce Dev.putToStdOut -- | Put builder, to stderr putToStdErr :: Builder -> IO () putToStdErr = coerce Dev.putToStdErr -- | Put builder, followed by a line, to stdout putLnToStdOut :: Builder -> IO () putLnToStdOut = coerce Dev.putLnToStdOut -- | Put builder, followed by a line, to stderr putLnToStdErr :: Builder -> IO () putLnToStdErr = coerce Dev.putLnToStdErr -- * Constructors -- | Unicode character {-# INLINE char #-} char :: Char -> Builder char = coerce Dev.char -- | Unicode code point {-# INLINE unicodeCodePoint #-} unicodeCodePoint :: Int -> Builder unicodeCodePoint = coerce Dev.unicodeCodePoint -- | Single code-unit UTF-16 character {-# INLINEABLE utf16CodeUnits1 #-} utf16CodeUnits1 :: Word16 -> Builder utf16CodeUnits1 = coerce Dev.utf16CodeUnits1 -- | Double code-unit UTF-16 character {-# INLINEABLE utf16CodeUnits2 #-} utf16CodeUnits2 :: Word16 -> Word16 -> Builder utf16CodeUnits2 = coerce Dev.utf16CodeUnits2 -- | Single code-unit UTF-8 character {-# INLINE utf8CodeUnits1 #-} utf8CodeUnits1 :: Word8 -> Builder utf8CodeUnits1 = coerce Dev.utf8CodeUnits1 -- | Double code-unit UTF-8 character {-# INLINE utf8CodeUnits2 #-} utf8CodeUnits2 :: Word8 -> Word8 -> Builder utf8CodeUnits2 = coerce Dev.utf8CodeUnits2 -- | Triple code-unit UTF-8 character {-# INLINE utf8CodeUnits3 #-} utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> Builder utf8CodeUnits3 = coerce Dev.utf8CodeUnits3 -- | UTF-8 character out of 4 code units {-# INLINE utf8CodeUnits4 #-} utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> Builder utf8CodeUnits4 = coerce Dev.utf8CodeUnits4 -- | ASCII byte string {-# INLINE asciiByteString #-} asciiByteString :: ByteString -> Builder asciiByteString = coerce Dev.asciiByteString -- | Strict text {-# INLINE text #-} text :: Text -> Builder text = coerce Dev.text -- | Lazy text {-# INLINE lazyText #-} lazyText :: TextLazy.Text -> Builder lazyText = coerce Dev.lazyText -- | String {-# INLINE string #-} string :: String -> Builder string = coerce Dev.string -- | Decimal representation of an integral value {-# INLINEABLE decimal #-} decimal :: (Integral a) => a -> Builder decimal = coerce . Dev.decimal -- | Decimal representation of an unsigned integral value {-# INLINEABLE unsignedDecimal #-} unsignedDecimal :: (Integral a) => a -> Builder unsignedDecimal = coerce . Dev.unsignedDecimal -- | Decimal representation of an integral value with thousands separated by the specified character {-# INLINEABLE thousandSeparatedDecimal #-} thousandSeparatedDecimal :: (Integral a) => Char -> a -> Builder thousandSeparatedDecimal = fmap coerce . Dev.thousandSeparatedDecimal -- | Decimal representation of an unsigned integral value with thousands separated by the specified character {-# INLINEABLE thousandSeparatedUnsignedDecimal #-} thousandSeparatedUnsignedDecimal :: (Integral a) => Char -> a -> Builder thousandSeparatedUnsignedDecimal = fmap coerce . Dev.thousandSeparatedUnsignedDecimal -- | Data size in decimal notation over amount of bytes. {-# INLINEABLE dataSizeInBytesInDecimal #-} dataSizeInBytesInDecimal :: (Integral a) => Char -> a -> Builder dataSizeInBytesInDecimal = fmap coerce . Dev.dataSizeInBytesInDecimal -- | Unsigned binary number {-# INLINE unsignedBinary #-} unsignedBinary :: (Integral a) => a -> Builder unsignedBinary = coerce . Dev.unsignedBinary -- | Unsigned binary number {-# INLINE unsignedPaddedBinary #-} unsignedPaddedBinary :: (Integral a, FiniteBits a) => a -> Builder unsignedPaddedBinary = coerce . Dev.unsignedPaddedBinary -- | Hexadecimal representation of an integral value {-# INLINE hexadecimal #-} hexadecimal :: (Integral a) => a -> Builder hexadecimal = coerce . Dev.hexadecimal -- | Unsigned hexadecimal representation of an integral value {-# INLINE unsignedHexadecimal #-} unsignedHexadecimal :: (Integral a) => a -> Builder unsignedHexadecimal = coerce . Dev.unsignedHexadecimal -- | Decimal digit {-# INLINE decimalDigit #-} decimalDigit :: (Integral a) => a -> Builder decimalDigit = coerce . Dev.decimalDigit -- | Hexadecimal digit {-# INLINE hexadecimalDigit #-} hexadecimalDigit :: (Integral a) => a -> Builder hexadecimalDigit = coerce . Dev.hexadecimalDigit -- | Intercalate builders {-# INLINE intercalate #-} intercalate :: (Foldable foldable) => Builder -> foldable Builder -> Builder intercalate a b = coerce (Dev.intercalate (coerce a) (foldr ((:) . coerce) [] b)) -- | Pad a builder from the left side to the specified length with the specified character {-# INLINEABLE padFromLeft #-} padFromLeft :: Int -> Char -> Builder -> Builder padFromLeft = coerce Dev.padFromLeft -- | Pad a builder from the right side to the specified length with the specified character {-# INLINEABLE padFromRight #-} padFromRight :: Int -> Char -> Builder -> Builder padFromRight = coerce Dev.padFromRight -- | -- Time interval in seconds. -- Directly applicable to 'DiffTime' and 'NominalDiffTime'. {-# INLINEABLE intervalInSeconds #-} intervalInSeconds :: (RealFrac seconds) => seconds -> Builder intervalInSeconds = coerce . Dev.intervalInSeconds -- | Double with a fixed number of decimal places. {-# INLINE fixedDouble #-} fixedDouble :: -- | Amount of decimals after point. Int -> Double -> Builder fixedDouble = coerce Dev.fixedDouble -- | 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 -> Builder doublePercent = coerce Dev.doublePercent -- | Hexadecimal readable representation of binary data. {-# INLINE hexData #-} hexData :: ByteString -> Builder hexData = coerce Dev.hexData text-builder-0.6.7.2/library/Text/Builder/0000755000000000000000000000000007346545000016443 5ustar0000000000000000text-builder-0.6.7.2/library/Text/Builder/Prelude.hs0000644000000000000000000000550107346545000020400 0ustar0000000000000000module Text.Builder.Prelude ( module Exports, ) 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 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.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 Foreign.ForeignPtr as Exports import Foreign.ForeignPtr.Unsafe as Exports import Foreign.Ptr as Exports import Foreign.StablePtr as Exports import Foreign.Storable as Exports hiding (alignment, sizeOf) import GHC.Conc as Exports hiding (threadWaitRead, threadWaitReadSTM, threadWaitWrite, threadWaitWriteSTM, withMVar) import GHC.Exts as Exports (groupWith, inline, lazy, sortWith) import GHC.Generics as Exports (Generic) import GHC.IO.Exception as Exports import Numeric as Exports import System.Environment as Exports import System.Exit as Exports import System.IO as Exports import System.IO.Error as Exports import System.IO.Unsafe as Exports import System.Mem as Exports import System.Mem.StableName as Exports import System.Timeout as Exports import Text.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, (.)) text-builder-0.6.7.2/test/0000755000000000000000000000000007346545000013444 5ustar0000000000000000text-builder-0.6.7.2/test/Main.hs0000644000000000000000000001075407346545000014673 0ustar0000000000000000module Main where import qualified Data.ByteString as ByteString import qualified Data.Text as A import qualified Data.Text.Encoding as Text import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck import qualified Text.Builder as B import Prelude hiding (choose) 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.run (foldMap B.asciiByteString chunks)), testProperty "Intercalation has the same effect as in Text" $ \separator texts -> A.intercalate separator texts === B.run (B.intercalate (B.text separator) (fmap B.text texts)), testProperty "Packing a list of chars is isomorphic to appending a list of builders" $ \chars -> A.pack chars === B.run (foldMap B.char chars), testProperty "Concatting a list of texts is isomorphic to fold-mapping with builders" $ \texts -> mconcat texts === B.run (foldMap B.text texts), testProperty "Concatting a list of texts is isomorphic to concatting a list of builders" $ \texts -> mconcat texts === B.run (mconcat (map B.text texts)), testProperty "Concatting a list of trimmed texts is isomorphic to concatting a list of builders" $ \texts -> let trimmedTexts = fmap (A.drop 3) texts in mconcat trimmedTexts === B.run (mconcat (map B.text trimmedTexts)), testProperty "Decimal" $ \(x :: Integer) -> (fromString . show) x === (B.run (B.decimal x)), testProperty "Hexadecimal vs std show" $ \(x :: Integer) -> x >= 0 ==> (fromString . showHex x) "" === (B.run . B.hexadecimal) x, testCase "Separated thousands" $ do assertEqual "" "0" (B.run (B.thousandSeparatedUnsignedDecimal ',' 0)) assertEqual "" "123" (B.run (B.thousandSeparatedUnsignedDecimal ',' 123)) assertEqual "" "1,234" (B.run (B.thousandSeparatedUnsignedDecimal ',' 1234)) assertEqual "" "1,234,567" (B.run (B.thousandSeparatedUnsignedDecimal ',' 1234567)), testCase "Pad from left" $ do assertEqual "" "00" (B.run (B.padFromLeft 2 '0' "")) assertEqual "" "00" (B.run (B.padFromLeft 2 '0' "0")) assertEqual "" "01" (B.run (B.padFromLeft 2 '0' "1")) assertEqual "" "12" (B.run (B.padFromLeft 2 '0' "12")) assertEqual "" "123" (B.run (B.padFromLeft 2 '0' "123")), testCase "Pad from right" $ do assertEqual "" "00" (B.run (B.padFromRight 2 '0' "")) assertEqual "" "00" (B.run (B.padFromRight 2 '0' "0")) assertEqual "" "10" (B.run (B.padFromRight 2 '0' "1")) assertEqual "" "12" (B.run (B.padFromRight 2 '0' "12")) assertEqual "" "123" (B.run (B.padFromRight 2 '0' "123")) assertEqual "" "1 " (B.run (B.padFromRight 3 ' ' "1")), testCase "Hexadecimal" $ assertEqual "" "1f23" (B.run (B.hexadecimal 0x01f23)), testCase "Negative Hexadecimal" $ assertEqual "" "-1f23" (B.run (B.hexadecimal (-0x01f23))), testGroup "Time interval" $ [ testCase "59s" $ assertEqual "" "00:00:00:59" $ B.run $ B.intervalInSeconds 59, testCase "minute" $ assertEqual "" "00:00:01:00" $ B.run $ B.intervalInSeconds 60, testCase "90s" $ assertEqual "" "00:00:01:30" $ B.run $ B.intervalInSeconds 90, testCase "hour" $ assertEqual "" "00:01:00:00" $ B.run $ B.intervalInSeconds 3600, testCase "day" $ assertEqual "" "01:00:00:00" $ B.run $ B.intervalInSeconds 86400 ], testCase "dataSizeInBytesInDecimal" $ do assertEqual "" "999B" (B.run (B.dataSizeInBytesInDecimal ',' 999)) assertEqual "" "1kB" (B.run (B.dataSizeInBytesInDecimal ',' 1000)) assertEqual "" "1.1kB" (B.run (B.dataSizeInBytesInDecimal ',' 1100)) assertEqual "" "1.1MB" (B.run (B.dataSizeInBytesInDecimal ',' 1150000)) assertEqual "" "9.9MB" (B.run (B.dataSizeInBytesInDecimal ',' 9990000)) assertEqual "" "10MB" (B.run (B.dataSizeInBytesInDecimal ',' 10100000)) assertEqual "" "1,000YB" (B.run (B.dataSizeInBytesInDecimal ',' 1000000000000000000000000000)) ] text-builder-0.6.7.2/text-builder.cabal0000644000000000000000000000502007346545000016056 0ustar0000000000000000cabal-version: 3.0 name: text-builder version: 0.6.7.2 category: Text, Builders synopsis: Efficient strict text builder description: Text formatting library and efficient builder library. homepage: https://github.com/nikita-volkov/text-builder bug-reports: https://github.com/nikita-volkov/text-builder/issues author: Nikita Volkov maintainer: Nikita Volkov copyright: (c) 2017, Nikita Volkov license: MIT license-file: LICENSE source-repository head type: git location: git://github.com/nikita-volkov/text-builder.git common base default-language: Haskell2010 default-extensions: NoImplicitPrelude NoMonomorphismRestriction BangPatterns ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable EmptyDataDecls FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving LambdaCase LiberalTypeSynonyms MagicHash MultiParamTypeClasses MultiWayIf OverloadedStrings ParallelListComp PatternGuards QuasiQuotes RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TemplateHaskell TupleSections TypeFamilies TypeOperators UnboxedTuples library import: base hs-source-dirs: library exposed-modules: Text.Builder other-modules: Text.Builder.Prelude build-depends: , base >=4.11 && <5 , bytestring >=0.10 && <0.13 , text >=1.2 && <3 , text-builder-dev >=0.3.4.1 && <0.4 test-suite test import: base type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Main.hs build-depends: , rerebase <2 , tasty >=1.2.3 && <2 , tasty-hunit >=0.10.0.2 && <0.11 , tasty-quickcheck >=0.10.1 && <0.11 , text-builder benchmark benchmark-text import: base type: exitcode-stdio-1.0 hs-source-dirs: benchmark-text ghc-options: -O2 -threaded -with-rtsopts=-N -funbox-strict-fields main-is: Main.hs build-depends: , criterion >=1.5.6.1 && <2 , rerebase >=1 && <2 , text-builder benchmark benchmark-char import: base type: exitcode-stdio-1.0 hs-source-dirs: benchmark-char ghc-options: -O2 -threaded -with-rtsopts=-N -funbox-strict-fields main-is: Main.hs build-depends: , criterion >=1.5.6.1 && <2 , rerebase >=1 && <2 , text-builder