text-builder 0.6.6.3 → 0.6.6.4
raw patch · 9 files changed
+294/−610 lines, 9 filesdep +base-preludedep +text-builder-devdep −basedep −deferred-foldsdep −transformersdep ~textsetup-changed
Dependencies added: base-prelude, text-builder-dev
Dependencies removed: base, deferred-folds, transformers
Dependency ranges changed: text
Files
- LICENSE +1/−1
- Setup.hs +0/−2
- benchmark-char/Main.hs +12/−20
- benchmark-text/Main.hs +16/−21
- library/Text/Builder.hs +168/−293
- library/Text/Builder/Prelude.hs +0/−97
- library/Text/Builder/UTF16.hs +0/−61
- test/Main.hs +76/−94
- text-builder.cabal +21/−21
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2015, Nikita Volkov+Copyright (c) 2017, Nikita Volkov Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
benchmark-char/Main.hs view
@@ -1,33 +1,26 @@ module Main where -import Prelude import Criterion.Main-import qualified Text.Builder as A-import qualified Data.Text.Lazy.Builder as B-import qualified Data.Text.Lazy as C 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 = defaultMain $- [- subjectBenchmark "builderSubject" builderSubject- ,- subjectBenchmark "lazyTextBuilderSubject" lazyTextBuilderSubject- ,- subjectBenchmark "plainTextPackingSubject" plainTextPackingSubject- ]+ [ 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 "Small input" smallInput subject,+ benchmark "Medium input" mediumInput subject,+ benchmark "Large input" largeInput subject+ ] benchmark :: String -> [Int] -> Subject -> Benchmark benchmark title input subject =@@ -62,4 +55,3 @@ largeInput :: [Int] largeInput = mconcat (replicate 100000 smallInput)-
benchmark-text/Main.hs view
@@ -1,36 +1,31 @@ module Main where -import Prelude import Criterion.Main-import qualified Text.Builder as A-import qualified Data.Text.Lazy.Builder as B-import qualified Data.Text.Lazy as C 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 = defaultMain $- [- subjectBenchmark "builderSubject" builderSubject- ,- subjectBenchmark "lazyTextBuilderSubject" lazyTextBuilderSubject- ]+ [ 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 "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)+data Subject+ = forall a. Subject (Text -> a) (a -> a -> a) a (a -> Text) type Sample = Subject -> Text@@ -47,12 +42,12 @@ smallSample :: Sample smallSample (Subject text (<>) mempty run) = run $- text "abcd" <> (text "ABCD" <> text "Фываолдж") <> text "漢"+ 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 "漢"-+ foldl' (<>) mempty $+ replicate 100000 $+ text "abcd" <> (text "ABCD" <> text "Фываолдж") <> text "漢"
library/Text/Builder.hs view
@@ -1,394 +1,269 @@ module Text.Builder-(- Builder,- -- * Accessors- run,- length,- null,- -- ** Output IO- putToStdOut,- putToStdErr,- putLnToStdOut,- putLnToStdErr,- -- * Constructors- -- ** Builder manipulators- intercalate,- padFromLeft,- padFromRight,- -- ** Textual- text,- string,- asciiByteString,- -- ** 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+ ( Builder, -import Text.Builder.Prelude hiding (length, null, intercalate)-import qualified Data.Text.Array as B-import qualified Data.Text.Internal as C-import qualified Data.Text.Encoding as E-import qualified Data.Text.Encoding.Error as E-import qualified Text.Builder.UTF16 as D-import qualified Data.ByteString as ByteString-import qualified DeferredFolds.Unfoldr as Unfoldr-import qualified Data.Text as Text-import qualified Data.Text.IO as Text+ -- * Accessors+ run,+ length,+ null, + -- ** Output IO+ putToStdOut,+ putToStdErr,+ putLnToStdOut,+ putLnToStdErr, -newtype Action =- Action (forall s. B.MArray s -> Int -> ST s ())+ -- * Constructors -{-|-Specification of how to efficiently construct strict 'Text'.-Provides instances of 'Semigroup' and 'Monoid', which have complexity of /O(1)/.--}-data Builder =- Builder !Action !Int !Int+ -- ** Builder manipulators+ intercalate,+ padFromLeft,+ padFromRight, -instance Monoid Builder where- {-# INLINE mempty #-}- mempty =- Builder (Action (\_ _ -> return ())) 0 0- {-# INLINABLE mappend #-}- mappend (Builder (Action action1) arraySize1 charsAmount1) (Builder (Action action2) arraySize2 charsAmount2) =- Builder action arraySize charsAmount- where- action =- Action $ \array offset -> do- action1 array offset- action2 array (offset + arraySize1)- arraySize =- arraySize1 + arraySize2- charsAmount =- charsAmount1 + charsAmount2+ -- ** Textual+ text,+ string,+ asciiByteString,+ hexData, -instance Semigroup Builder where- (<>) = mappend+ -- ** Character+ char, -instance IsString Builder where- fromString = string+ -- *** Low-level character+ unicodeCodePoint,+ utf16CodeUnits1,+ utf16CodeUnits2,+ utf8CodeUnits1,+ utf8CodeUnits2,+ utf8CodeUnits3,+ utf8CodeUnits4, -instance Show Builder where- show = Text.unpack . run+ -- ** Integers + -- *** Decimal+ decimal,+ unsignedDecimal,+ thousandSeparatedDecimal,+ thousandSeparatedUnsignedDecimal,+ dataSizeInBytesInDecimal, --- * Accessors--------------------------+ -- *** Binary+ unsignedBinary,+ unsignedPaddedBinary, -{-| Get the amount of characters -}+ -- *** Hexadecimal+ hexadecimal,+ unsignedHexadecimal,++ -- ** Digits+ decimalDigit,+ hexadecimalDigit,++ -- ** Real+ fixedDouble,+ doublePercent,++ -- ** Time+ intervalInSeconds,+ )+where++import BasePrelude hiding (intercalate, length, null)+import Data.ByteString (ByteString)+import Data.Text (Text)+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 (Builder _ _ x) = x+length = coerce Dev.length -{-| Check whether the builder is empty -}+-- | Check whether the builder is empty {-# INLINE null #-} null :: Builder -> Bool-null = (== 0) . length+null = coerce Dev.null -{-| Execute a builder producing a strict text -}+-- | Execute a builder producing a strict text run :: Builder -> Text-run (Builder (Action action) arraySize _) =- C.text array 0 arraySize- where- array =- runST $ do- array <- B.new arraySize- action array 0- B.unsafeFreeze array+run = coerce Dev.buildText -- ** Output IO-------------------------- -{-| Put builder, to stdout -}+-- | Put builder, to stdout putToStdOut :: Builder -> IO ()-putToStdOut = Text.hPutStr stdout . run+putToStdOut = coerce Dev.putToStdOut -{-| Put builder, to stderr -}+-- | Put builder, to stderr putToStdErr :: Builder -> IO ()-putToStdErr = Text.hPutStr stderr . run+putToStdErr = coerce Dev.putToStdErr -{-| Put builder, followed by a line, to stdout -}+-- | Put builder, followed by a line, to stdout putLnToStdOut :: Builder -> IO ()-putLnToStdOut = Text.hPutStrLn stdout . run+putLnToStdOut = coerce Dev.putLnToStdOut -{-| Put builder, followed by a line, to stderr -}+-- | Put builder, followed by a line, to stderr putLnToStdErr :: Builder -> IO ()-putLnToStdErr = Text.hPutStrLn stderr . run-+putLnToStdErr = coerce Dev.putLnToStdErr -- * Constructors-------------------------- -{-| Unicode character -}+-- | Unicode character {-# INLINE char #-} char :: Char -> Builder-char x =- unicodeCodePoint (ord x)+char = coerce Dev.char -{-| Unicode code point-}+-- | Unicode code point {-# INLINE unicodeCodePoint #-} unicodeCodePoint :: Int -> Builder-unicodeCodePoint x =- D.unicodeCodePoint x utf16CodeUnits1 utf16CodeUnits2+unicodeCodePoint = coerce Dev.unicodeCodePoint -{-| Single code-unit UTF-16 character -}-{-# INLINABLE utf16CodeUnits1 #-}+-- | Single code-unit UTF-16 character+{-# INLINEABLE utf16CodeUnits1 #-} utf16CodeUnits1 :: Word16 -> Builder-utf16CodeUnits1 unit =- Builder action 1 1- where- action =- Action $ \array offset -> B.unsafeWrite array offset unit+utf16CodeUnits1 = coerce Dev.utf16CodeUnits1 -{-| Double code-unit UTF-16 character -}-{-# INLINABLE utf16CodeUnits2 #-}+-- | Double code-unit UTF-16 character+{-# INLINEABLE utf16CodeUnits2 #-} utf16CodeUnits2 :: Word16 -> Word16 -> Builder-utf16CodeUnits2 unit1 unit2 =- Builder action 2 1- where- action =- Action $ \array offset -> do- B.unsafeWrite array offset unit1- B.unsafeWrite array (succ offset) unit2+utf16CodeUnits2 = coerce Dev.utf16CodeUnits2 -{-| Single code-unit UTF-8 character -}+-- | Single code-unit UTF-8 character {-# INLINE utf8CodeUnits1 #-} utf8CodeUnits1 :: Word8 -> Builder-utf8CodeUnits1 unit1 =- D.utf8CodeUnits1 unit1 utf16CodeUnits1 utf16CodeUnits2+utf8CodeUnits1 = coerce Dev.utf8CodeUnits1 -{-| Double code-unit UTF-8 character -}+-- | Double code-unit UTF-8 character {-# INLINE utf8CodeUnits2 #-} utf8CodeUnits2 :: Word8 -> Word8 -> Builder-utf8CodeUnits2 unit1 unit2 =- D.utf8CodeUnits2 unit1 unit2 utf16CodeUnits1 utf16CodeUnits2+utf8CodeUnits2 = coerce Dev.utf8CodeUnits2 -{-| Triple code-unit UTF-8 character -}+-- | Triple code-unit UTF-8 character {-# INLINE utf8CodeUnits3 #-} utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> Builder-utf8CodeUnits3 unit1 unit2 unit3 =- D.utf8CodeUnits3 unit1 unit2 unit3 utf16CodeUnits1 utf16CodeUnits2+utf8CodeUnits3 = coerce Dev.utf8CodeUnits3 -{-| UTF-8 character out of 4 code units -}+-- | UTF-8 character out of 4 code units {-# INLINE utf8CodeUnits4 #-} utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> Builder-utf8CodeUnits4 unit1 unit2 unit3 unit4 =- D.utf8CodeUnits4 unit1 unit2 unit3 unit4 utf16CodeUnits1 utf16CodeUnits2+utf8CodeUnits4 = coerce Dev.utf8CodeUnits4 -{-| ASCII byte string -}-{-# INLINABLE asciiByteString #-}+-- | ASCII byte string+{-# INLINEABLE asciiByteString #-} asciiByteString :: ByteString -> Builder-asciiByteString byteString =- Builder action length length- where- length = ByteString.length byteString- action =- Action $ \array -> let- step byte next index = do- B.unsafeWrite array index (fromIntegral byte)- next (succ index)- in ByteString.foldr step (const (return ())) byteString+asciiByteString = coerce Dev.asciiByteString -{-| Strict text -}-{-# INLINABLE text #-}+-- | Strict text+{-# INLINEABLE text #-} text :: Text -> Builder-text text@(C.Text array offset length) =- Builder action length (Text.length text)- where- action =- Action $ \builderArray builderOffset -> do- B.copyI builderArray builderOffset array offset (builderOffset + length)+text = coerce Dev.text -{-| String -}+-- | String {-# INLINE string #-} string :: String -> Builder-string =- foldMap char+string = coerce Dev.string -{-| Decimal representation of an integral value -}-{-# INLINABLE decimal #-}+-- | Decimal representation of an integral value+{-# INLINEABLE decimal #-} decimal :: Integral a => a -> Builder-decimal i =- if i >= 0- then unsignedDecimal i- else unicodeCodePoint 45 <> unsignedDecimal (negate i)+decimal = coerce . Dev.decimal -{-| Decimal representation of an unsigned integral value -}-{-# INLINABLE unsignedDecimal #-}+-- | Decimal representation of an unsigned integral value+{-# INLINEABLE unsignedDecimal #-} unsignedDecimal :: Integral a => a -> Builder-unsignedDecimal =- foldMap decimalDigit . Unfoldr.decimalDigits+unsignedDecimal = coerce . Dev.unsignedDecimal -{-| Decimal representation of an integral value with thousands separated by the specified character -}-{-# INLINABLE thousandSeparatedDecimal #-}+-- | Decimal representation of an integral value with thousands separated by the specified character+{-# INLINEABLE thousandSeparatedDecimal #-} thousandSeparatedDecimal :: Integral a => Char -> a -> Builder-thousandSeparatedDecimal separatorChar a =- if a >= 0- then thousandSeparatedUnsignedDecimal separatorChar a- else unicodeCodePoint 45 <> thousandSeparatedUnsignedDecimal separatorChar (negate a)+thousandSeparatedDecimal = fmap coerce . Dev.thousandSeparatedDecimal -{-| Decimal representation of an unsigned integral value with thousands separated by the specified character -}-{-# INLINABLE thousandSeparatedUnsignedDecimal #-}+-- | Decimal representation of an unsigned integral value with thousands separated by the specified character+{-# INLINEABLE thousandSeparatedUnsignedDecimal #-} thousandSeparatedUnsignedDecimal :: Integral a => Char -> a -> Builder-thousandSeparatedUnsignedDecimal separatorChar a =- fold $ do- (index, digit) <- Unfoldr.zipWithReverseIndex $ Unfoldr.decimalDigits a- if mod index 3 == 0 && index /= 0- then return (decimalDigit digit <> char separatorChar)- else return (decimalDigit digit)+thousandSeparatedUnsignedDecimal = fmap coerce . Dev.thousandSeparatedUnsignedDecimal -{-| Data size in decimal notation over amount of bytes. -}-{-# INLINABLE dataSizeInBytesInDecimal #-}+-- | Data size in decimal notation over amount of bytes.+{-# INLINEABLE dataSizeInBytesInDecimal #-} dataSizeInBytesInDecimal :: Integral a => Char -> a -> Builder-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 -> Builder-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+dataSizeInBytesInDecimal = fmap coerce . Dev.dataSizeInBytesInDecimal -{-| Unsigned binary number -}+-- | Unsigned binary number {-# INLINE unsignedBinary #-} unsignedBinary :: Integral a => a -> Builder-unsignedBinary =- foldMap decimalDigit . Unfoldr.binaryDigits+unsignedBinary = coerce . Dev.unsignedBinary -{-| Unsigned binary number -}+-- | Unsigned binary number {-# INLINE unsignedPaddedBinary #-} unsignedPaddedBinary :: (Integral a, FiniteBits a) => a -> Builder-unsignedPaddedBinary a =- padFromLeft (finiteBitSize a) '0' $ foldMap decimalDigit $ Unfoldr.binaryDigits a+unsignedPaddedBinary = coerce . Dev.unsignedPaddedBinary -{-| Hexadecimal representation of an integral value -}+-- | Hexadecimal representation of an integral value {-# INLINE hexadecimal #-} hexadecimal :: Integral a => a -> Builder-hexadecimal i =- if i >= 0- then unsignedHexadecimal i- else unicodeCodePoint 45 <> unsignedHexadecimal (negate i)+hexadecimal = coerce . Dev.hexadecimal -{-| Unsigned hexadecimal representation of an integral value -}+-- | Unsigned hexadecimal representation of an integral value {-# INLINE unsignedHexadecimal #-} unsignedHexadecimal :: Integral a => a -> Builder-unsignedHexadecimal =- foldMap hexadecimalDigit . Unfoldr.hexadecimalDigits+unsignedHexadecimal = coerce . Dev.unsignedHexadecimal -{-| Decimal digit -}+-- | Decimal digit {-# INLINE decimalDigit #-} decimalDigit :: Integral a => a -> Builder-decimalDigit n =- unicodeCodePoint (fromIntegral n + 48)+decimalDigit = coerce . Dev.decimalDigit -{-| Hexadecimal digit -}+-- | Hexadecimal digit {-# INLINE hexadecimalDigit #-} hexadecimalDigit :: Integral a => a -> Builder-hexadecimalDigit n =- if n <= 9- then unicodeCodePoint (fromIntegral n + 48)- else unicodeCodePoint (fromIntegral n + 87)+hexadecimalDigit = coerce . Dev.hexadecimalDigit -{-| Intercalate builders -}+-- | Intercalate builders {-# INLINE intercalate #-} intercalate :: Foldable foldable => Builder -> foldable Builder -> Builder-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 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 -}-{-# INLINABLE padFromLeft #-}+-- | Pad a builder from the left side to the specified length with the specified character+{-# INLINEABLE padFromLeft #-} padFromLeft :: Int -> Char -> Builder -> Builder-padFromLeft paddedLength paddingChar builder = let- builderLength = length builder- in if paddedLength <= builderLength- then builder- else foldMap char (replicate (paddedLength - builderLength) paddingChar) <> builder+padFromLeft = coerce Dev.padFromLeft -{-| Pad a builder from the right side to the specified length with the specified character -}-{-# INLINABLE padFromRight #-}+-- | Pad a builder from the right side to the specified length with the specified character+{-# INLINEABLE padFromRight #-} padFromRight :: Int -> Char -> Builder -> Builder-padFromRight paddedLength paddingChar builder = let- builderLength = length builder- in if paddedLength <= builderLength- then builder- else builder <> foldMap char (replicate (paddedLength - builderLength) paddingChar)+padFromRight = coerce Dev.padFromRight -{-|-Time interval in seconds.-Directly applicable to 'DiffTime' and 'NominalDiffTime'.--}-{-# INLINABLE intervalInSeconds #-}+-- |+-- Time interval in seconds.+-- Directly applicable to 'DiffTime' and 'NominalDiffTime'.+{-# INLINEABLE intervalInSeconds #-} intervalInSeconds :: RealFrac seconds => seconds -> Builder-intervalInSeconds interval = flip evalState (round interval) $ do- seconds <- state (swap . flip divMod 60)- minutes <- state (swap . flip divMod 60)- hours <- state (swap . flip divMod 24)- days <- get- return $- padFromLeft 2 '0' (decimal days) <> ":" <>- padFromLeft 2 '0' (decimal hours) <> ":" <>- padFromLeft 2 '0' (decimal minutes) <> ":" <>- padFromLeft 2 '0' (decimal seconds)+intervalInSeconds = coerce . Dev.intervalInSeconds -{-| Double with a fixed number of decimal places. -}+-- | Double with a fixed number of decimal places. {-# INLINE fixedDouble #-}-fixedDouble :: Int {-^ Amount of decimals after point. -} -> Double -> Builder-fixedDouble decimalPlaces = fromString . printf ("%." ++ show decimalPlaces ++ "f")+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. -}+-- | Double multiplied by 100 with a fixed number of decimal places applied and followed by a percent-sign. {-# INLINE doublePercent #-}-doublePercent :: Int {-^ Amount of decimals after point. -} -> Double -> Builder-doublePercent decimalPlaces x = fixedDouble decimalPlaces (x * 100) <> "%"+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
− library/Text/Builder/Prelude.hs
@@ -1,97 +0,0 @@-module Text.Builder.Prelude-( - module Exports,- Product2(..),-)-where---- base---------------------------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 (mapM_, sequence_, forM_, msum, mapM, sequence, forM)-import Control.Monad.IO.Class as Exports-import Control.Monad.Fix as Exports hiding (fix)-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.Char as Exports-import Data.Coerce as Exports-import Data.Complex as Exports-import Data.Data as Exports-import Data.Dynamic as Exports-import Data.Either as Exports-import Data.Fixed as Exports-import Data.Foldable as Exports-import Data.Function as Exports hiding (id, (.))-import Data.Functor as Exports-import Data.Functor.Identity as Exports-import Data.Int as Exports-import Data.IORef as Exports-import Data.Ix as Exports-import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')-import Data.Maybe as Exports-import Data.Monoid as Exports hiding (Last(..), First(..), (<>))-import Data.Ord as Exports-import Data.Proxy as Exports-import Data.Ratio as Exports-import Data.Semigroup as Exports-import Data.STRef as Exports-import Data.String as Exports-import Data.Traversable as Exports-import Data.Tuple as Exports-import Data.Unique as Exports-import Data.Version as Exports-import Data.Word as Exports-import Debug.Trace as Exports-import Foreign.ForeignPtr.Unsafe as Exports-import Foreign.ForeignPtr as Exports-import Foreign.Ptr as Exports-import Foreign.StablePtr as Exports-import Foreign.Storable as Exports hiding (sizeOf, alignment)-import GHC.Conc as Exports hiding (withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead)-import GHC.Exts as Exports (lazy, inline, sortWith, groupWith)-import GHC.Generics as Exports (Generic)-import GHC.IO.Exception as Exports-import Numeric as Exports-import Prelude as Exports hiding (concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.))-import System.Environment as Exports-import System.Exit as Exports-import System.IO as Exports-import System.IO.Error as Exports-import System.IO.Unsafe as Exports-import System.Mem as Exports-import System.Mem.StableName as Exports-import System.Timeout as Exports-import Text.ParserCombinators.ReadP as Exports (ReadP, ReadS, readP_to_S, readS_to_P)-import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec)-import Text.Printf as Exports (printf, hPrintf)-import Text.Read as Exports (Read(..), readMaybe, readEither)-import Unsafe.Coerce as Exports---- bytestring---------------------------import Data.ByteString as Exports (ByteString)---- text---------------------------import Data.Text as Exports (Text)---- deferred-folds---------------------------import DeferredFolds.Unfoldr as Exports (Unfoldr(..))---- transformers---------------------------import Control.Monad.IO.Class as Exports-import Control.Monad.Trans.Class as Exports-import Control.Monad.Trans.Maybe as Exports hiding (liftListen, liftPass)-import Control.Monad.Trans.Reader as Exports hiding (liftCallCC, liftCatch)-import Control.Monad.Trans.State.Strict as Exports hiding (liftCallCC, liftCatch, liftListen, liftPass)---data Product2 a b = Product2 !a !b
− library/Text/Builder/UTF16.hs
@@ -1,61 +0,0 @@-module Text.Builder.UTF16-where--import Text.Builder.Prelude---{-|-A matching function, which chooses the continuation to run.--}-type UTF16View =- forall x. (Word16 -> x) -> (Word16 -> Word16 -> x) -> x--{-# INLINE char #-}-char :: Char -> UTF16View-char x =- unicodeCodePoint (ord x)--{-# INLINE unicodeCodePoint #-}-unicodeCodePoint :: Int -> UTF16View-unicodeCodePoint x case1 case2 =- if x < 0x10000- then case1 (fromIntegral x)- else case2 case2Unit1 case2Unit2- where- m =- x - 0x10000- case2Unit1 =- fromIntegral (shiftR m 10 + 0xD800)- case2Unit2 =- fromIntegral ((m .&. 0x3FF) + 0xDC00)--{-# INLINE utf8CodeUnits1 #-}-utf8CodeUnits1 :: Word8 -> UTF16View-utf8CodeUnits1 x case1 _ =- case1 (fromIntegral x)--{-# INLINE utf8CodeUnits2 #-}-utf8CodeUnits2 :: Word8 -> Word8 -> UTF16View-utf8CodeUnits2 byte1 byte2 case1 _ =- case1 (shiftL (fromIntegral byte1 - 0xC0) 6 + fromIntegral byte2 - 0x80)--{-# INLINE utf8CodeUnits3 #-}-utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> UTF16View-utf8CodeUnits3 byte1 byte2 byte3 case1 case2 =- unicodeCodePoint unicode case1 case2- where- unicode =- shiftL (fromIntegral byte1 - 0xE0) 12 +- shiftL (fromIntegral byte2 - 0x80) 6 +- fromIntegral byte3 - 0x80--{-# INLINE utf8CodeUnits4 #-}-utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> UTF16View-utf8CodeUnits4 byte1 byte2 byte3 byte4 case1 case2 =- unicodeCodePoint unicode case1 case2- where- unicode =- shiftL (fromIntegral byte1 - 0xE0) 18 +- shiftL (fromIntegral byte2 - 0x80) 12 +- shiftL (fromIntegral byte3 - 0x80) 6 +- fromIntegral byte4 - 0x80
test/Main.hs view
@@ -1,104 +1,86 @@ module Main where -import Prelude hiding (choose)+import qualified Data.ByteString as ByteString+import qualified Data.Text as A+import qualified Data.Text.Encoding as Text import Test.QuickCheck.Instances import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck-import qualified Data.Text as A import qualified Text.Builder as B-import qualified Data.ByteString as ByteString-import qualified Data.Text.Encoding as Text-+import Prelude hiding (choose) main = defaultMain $- testGroup "All tests" $- [- testProperty "ASCII ByteString" $ let- gen = listOf $ do- list <- listOf (choose (0, 127))- return (ByteString.pack list)- in forAll gen $ \ chunks ->- mconcat chunks ===- Text.encodeUtf8 (B.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))- ]+ 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.cabal view
@@ -1,5 +1,7 @@+cabal-version: 3.0+ name: text-builder-version: 0.6.6.3+version: 0.6.6.4 category: Text synopsis: An efficient strict text builder homepage: https://github.com/nikita-volkov/text-builder@@ -9,30 +11,30 @@ copyright: (c) 2017, Nikita Volkov license: MIT license-file: LICENSE-build-type: Simple-cabal-version: >=1.10 +source-repository head+ type: git+ location: git://github.com/nikita-volkov/text-builder.git++common language-settings+ default-extensions: BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+ default-language: Haskell2010+ library+ import: language-settings hs-source-dirs: library- default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples- default-language: Haskell2010 exposed-modules: Text.Builder- other-modules:- Text.Builder.UTF16- Text.Builder.Prelude build-depends:- base >=4.10 && <5,+ base-prelude >=1.6 && <2, bytestring >=0.10 && <0.12,- deferred-folds >=0.9.10.1 && <0.10,- text >=1 && <2,- transformers >=0.5 && <0.6+ text >=1.2 && <3,+ text-builder-dev >=0.2 && <0.3, test-suite test+ import: language-settings type: exitcode-stdio-1.0 hs-source-dirs: test- default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples- default-language: Haskell2010 main-is: Main.hs build-depends: QuickCheck >=2.13 && <3,@@ -41,28 +43,26 @@ tasty >=1.2.3 && <2, tasty-hunit >=0.10.0.2 && <0.11, tasty-quickcheck >=0.10.1 && <0.11,- text-builder+ text-builder, benchmark benchmark-text+ import: language-settings type: exitcode-stdio-1.0 hs-source-dirs: benchmark-text- default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveTraversable, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples- default-language: Haskell2010 ghc-options: -O2 -threaded "-with-rtsopts=-N" -funbox-strict-fields main-is: Main.hs build-depends: criterion >=1.5.6.1 && <2, rerebase ==1.*,- text-builder+ text-builder, benchmark benchmark-char+ import: language-settings type: exitcode-stdio-1.0 hs-source-dirs: benchmark-char- default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveTraversable, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples- default-language: Haskell2010 ghc-options: -O2 -threaded "-with-rtsopts=-N" -funbox-strict-fields main-is: Main.hs build-depends: criterion >=1.5.6.1 && <2, rerebase ==1.*,- text-builder+ text-builder,