text-builder-core-0.1.1.1/0000755000000000000000000000000007346545000013377 5ustar0000000000000000text-builder-core-0.1.1.1/LICENSE0000644000000000000000000000204207346545000014402 0ustar0000000000000000Copyright (c) 2022, Nikita Volkov Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. text-builder-core-0.1.1.1/bench/0000755000000000000000000000000007346545000014456 5ustar0000000000000000text-builder-core-0.1.1.1/bench/Main.hs0000644000000000000000000000525607346545000015706 0ustar0000000000000000module Main where import Data.Function import qualified Data.Text.Builder.Linear import qualified Data.Text.Encoding as D import qualified Data.Text.Lazy as C import qualified Data.Text.Lazy.Builder as B import Test.Tasty.Bench import qualified TextBuilderCore as A import Prelude main :: IO () main = defaultMain [ bgroup "Features" features, bgroup "Competition" competition ] where features = [ bench "string" $ whnf (A.toText . A.string) "фывапролдж", bench "text" $ whnf (A.toText . A.text) "фывапролдж", bench "lazyText" $ whnf (A.toText . A.lazyText) "фывапролдж", bench "char" $ whnf (A.toText . A.char) 'ф', bench "unicodeCodepoint" $ whnf (A.toText . A.unicodeCodepoint) 1092 ] competition = [ bgroup "Left-biased mappend" $ byConcat $ foldl' (<>) mempty, bgroup "Right-biased mappend" $ byConcat $ foldl' (flip (<>)) mempty, bgroup "mconcat" $ byConcat $ mconcat ] where byConcat (concat :: forall a. (Monoid a) => [a] -> a) = [ bgroup "100B" $ byTexts $ replicate 10 "фывапролдж", bgroup "1kB" $ byTexts $ replicate 100 "фывапролдж", bgroup "10kB" $ byTexts $ replicate 1_000 "фывапролдж", bgroup "100kB" $ byTexts $ replicate 10_000 "фывапролдж" ] where byTexts texts = [ bench "TextBuilderCore.TextBuilder" ( whnf (A.toText . concat) (fmap A.text texts) ), bench "Data.Text.Encoding.StrictTextBuilder" ( whnf (D.strictBuilderToText . concat) (fmap D.textToStrictBuilder texts) ), bench "Data.Text.Lazy.Builder.Builder" ( whnf (C.toStrict . B.toLazyText . concat) (fmap B.fromText texts) ), bench "Data.Text.Text" ( whnf concat texts ), bench "Data.Text.Lazy.Text" ( whnf (C.toStrict . concat) (fmap C.fromStrict texts) ), bench "Data.Text.Builder.Linear" ( whnf (Data.Text.Builder.Linear.runBuilder . concat) (fmap Data.Text.Builder.Linear.fromText texts) ) ] text-builder-core-0.1.1.1/library/0000755000000000000000000000000007346545000015043 5ustar0000000000000000text-builder-core-0.1.1.1/library/TextBuilderCore.hs0000644000000000000000000003561507346545000020455 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wno-unused-top-binds #-} module TextBuilderCore ( TextBuilder (..), -- * Destructors isEmpty, toText, -- * Constructors -- ** Text string, text, lazyText, -- ** Character char, unicodeCodepoint, -- ** Primitives unsafeChars, unsafeSeptets, unsafeReverseSeptets, ) where import qualified Data.Text as Text import qualified Data.Text.Array as TextArray import qualified Data.Text.Internal as TextInternal import qualified Data.Text.Lazy as TextLazy import TextBuilderCore.Prelude #if MIN_VERSION_text(2,0,0) import qualified TextBuilderCore.Utf8View as Utf8View #else import qualified TextBuilderCore.Utf16View as Utf16View #endif -- | -- Composable specification of how to efficiently construct strict 'Text'. -- -- Provides instances of 'Semigroup' and 'Monoid', which have complexity of /O(1)/. data TextBuilder = TextBuilder -- | Estimated maximum size of the byte array to allocate. -- -- If the builder is empty it must be 0. -- Otherwise it must be greater than or equal to the amount of bytes to be written. -- -- __Warning:__ Due to \"text\" switching from UTF-16 to UTF-8 since version 2, 'Word16' is used as the byte when the \"text\" version is @<2@ and 'Word8' is used when it's @>=2@. Int -- | Function that populates a preallocated byte array of the estimated maximum size specified above provided an offset into it and producing the offset after. -- -- __Warning:__ The function must not write outside of the allocated array or bad things will happen to the running app. -- -- __Warning:__ Keep in mind that the array is operating on 'Word8' values starting from @text-2.0@, but prior to it it operates on 'Word16'. This is due to the \"text\" library switching from UTF-16 to UTF-8 after version 2. To deal with this you have the following options: -- -- 1. Restrict the version of the \"text\" library in your package to @>=2@. -- -- 2. Use helpers provided by this library, such as 'unsafeSeptets' and 'unsafeReverseSeptets', which abstract over the differences in the underlying representation. -- -- 3. Use CPP to conditionally compile your code for different versions of \"text\". (forall s. TextArray.MArray s -> Int -> ST s Int) instance IsString TextBuilder where fromString = string instance Show TextBuilder where show = show . toText instance Eq TextBuilder where (==) = on (==) toText instance Semigroup TextBuilder where {-# INLINE (<>) #-} (<>) (TextBuilder estimatedArraySizeL writeL) (TextBuilder estimatedArraySizeR writeR) = TextBuilder (estimatedArraySizeL + estimatedArraySizeR) ( \array offset -> do offsetAfter1 <- writeL array offset writeR array offsetAfter1 ) stimes n (TextBuilder maxSize write) = TextBuilder (maxSize * fromIntegral n) ( \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 TextBuilder where {-# INLINE mempty #-} mempty = TextBuilder 0 (const return) {-# INLINE mconcat #-} mconcat list = TextBuilder (foldl' (\acc (TextBuilder maxSize _) -> acc + maxSize) 0 list) ( \array -> let go [] offset = return offset go (TextBuilder _ write : xs) offset = do offsetAfter <- write array offset go xs offsetAfter in go list ) instance Arbitrary TextBuilder where arbitrary = text . Text.pack <$> arbitrary shrink a = text . Text.pack <$> shrink (Text.unpack (toText a)) -- * Destructors -- | Execute the builder producing a strict text. toText :: TextBuilder -> Text toText (TextBuilder maxSize write) = runST $ do array <- TextArray.new maxSize offsetAfter <- write array 0 frozenArray <- TextArray.unsafeFreeze array return $ TextInternal.text frozenArray 0 offsetAfter -- | Check whether the builder is empty. {-# INLINE isEmpty #-} isEmpty :: TextBuilder -> Bool isEmpty (TextBuilder maxSize _) = maxSize == 0 -- * Constructors -- | Construct from a list of characters. {-# INLINE string #-} string :: String -> TextBuilder string string = unsafeChars (length string) string -- | Strict text. {-# INLINEABLE text #-} text :: Text -> TextBuilder #if MIN_VERSION_text(2,0,0) text (TextInternal.Text array offset length) = TextBuilder length \builderArray builderOffset -> do TextArray.copyI length builderArray builderOffset array offset return $ builderOffset + length #else text (TextInternal.Text array offset length) = TextBuilder length \builderArray builderOffset -> do let builderOffsetAfter = builderOffset + length TextArray.copyI builderArray builderOffset array offset builderOffsetAfter return builderOffsetAfter #endif -- | Lazy text. {-# INLINE lazyText #-} lazyText :: TextLazy.Text -> TextBuilder lazyText = TextLazy.foldrChunks (mappend . text) mempty -- ** Codepoint -- | Unicode character. {-# INLINE char #-} char :: Char -> TextBuilder char = unicodeCodepoint . ord -- | Safe Unicode codepoint with invalid values replaced by the @�@ char (codepoint @0xfffd@), -- which is the same as what @Data.Text.'Data.Text.pack'@ does. {-# INLINE unicodeCodepoint #-} unicodeCodepoint :: Int -> TextBuilder unicodeCodepoint = unsafeUnicodeCodepoint . project where project x = if x .&. 0x1ff800 /= 0xd800 then x else 0xfffd -- | Unicode codepoint. -- -- __Warning:__ It is your responsibility to ensure that the codepoint is in proper range, -- otherwise the produced text will be broken. -- It must be in the range of 0x0000 to 0x10FFFF. {-# INLINE unsafeUnicodeCodepoint #-} unsafeUnicodeCodepoint :: Int -> TextBuilder #if MIN_VERSION_text(2,0,0) unsafeUnicodeCodepoint x = Utf8View.unicodeCodepoint x unsafeUtf8CodeUnits1 unsafeUtf8CodeUnits2 unsafeUtf8CodeUnits3 unsafeUtf8CodeUnits4 #else unsafeUnicodeCodepoint x = Utf16View.unicodeCodepoint x unsafeUtf16CodeUnits1 unsafeUtf16CodeUnits2 #endif -- | Single code-unit UTF-8 character. unsafeUtf8CodeUnits1 :: Word8 -> TextBuilder #if MIN_VERSION_text(2,0,0) {-# INLINEABLE unsafeUtf8CodeUnits1 #-} unsafeUtf8CodeUnits1 unit1 = TextBuilder 1 \array offset -> TextArray.unsafeWrite array offset unit1 $> succ offset #else {-# INLINE unsafeUtf8CodeUnits1 #-} unsafeUtf8CodeUnits1 unit1 = Utf16View.utf8CodeUnits1 unit1 unsafeUtf16CodeUnits1 unsafeUtf16CodeUnits2 #endif -- | Double code-unit UTF-8 character. unsafeUtf8CodeUnits2 :: Word8 -> Word8 -> TextBuilder #if MIN_VERSION_text(2,0,0) {-# INLINEABLE unsafeUtf8CodeUnits2 #-} unsafeUtf8CodeUnits2 unit1 unit2 = TextBuilder 2 \array offset -> do TextArray.unsafeWrite array offset unit1 TextArray.unsafeWrite array (offset + 1) unit2 return $ offset + 2 #else {-# INLINE unsafeUtf8CodeUnits2 #-} unsafeUtf8CodeUnits2 unit1 unit2 = Utf16View.utf8CodeUnits2 unit1 unit2 unsafeUtf16CodeUnits1 unsafeUtf16CodeUnits2 #endif -- | Triple code-unit UTF-8 character. unsafeUtf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> TextBuilder #if MIN_VERSION_text(2,0,0) {-# INLINEABLE unsafeUtf8CodeUnits3 #-} unsafeUtf8CodeUnits3 unit1 unit2 unit3 = TextBuilder 3 \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 unsafeUtf8CodeUnits3 #-} unsafeUtf8CodeUnits3 unit1 unit2 unit3 = Utf16View.utf8CodeUnits3 unit1 unit2 unit3 unsafeUtf16CodeUnits1 unsafeUtf16CodeUnits2 #endif -- | UTF-8 character out of 4 code units. unsafeUtf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> TextBuilder #if MIN_VERSION_text(2,0,0) {-# INLINEABLE unsafeUtf8CodeUnits4 #-} unsafeUtf8CodeUnits4 unit1 unit2 unit3 unit4 = TextBuilder 4 \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 unsafeUtf8CodeUnits4 #-} unsafeUtf8CodeUnits4 unit1 unit2 unit3 unit4 = Utf16View.utf8CodeUnits4 unit1 unit2 unit3 unit4 unsafeUtf16CodeUnits1 unsafeUtf16CodeUnits2 #endif -- | Single code-unit UTF-16 character. unsafeUtf16CodeUnits1 :: Word16 -> TextBuilder #if MIN_VERSION_text(2,0,0) {-# INLINE unsafeUtf16CodeUnits1 #-} unsafeUtf16CodeUnits1 = unsafeUnicodeCodepoint . fromIntegral #else {-# INLINEABLE unsafeUtf16CodeUnits1 #-} unsafeUtf16CodeUnits1 unit = TextBuilder 1 \array offset -> TextArray.unsafeWrite array offset unit $> succ offset #endif -- | Double code-unit UTF-16 character. unsafeUtf16CodeUnits2 :: Word16 -> Word16 -> TextBuilder #if MIN_VERSION_text(2,0,0) {-# INLINE unsafeUtf16CodeUnits2 #-} unsafeUtf16CodeUnits2 unit1 unit2 = unsafeUnicodeCodepoint cp where cp = (((fromIntegral unit1 .&. 0x3FF) `shiftL` 10) .|. (fromIntegral unit2 .&. 0x3FF)) + 0x10000 #else {-# INLINEABLE unsafeUtf16CodeUnits2 #-} unsafeUtf16CodeUnits2 unit1 unit2 = TextBuilder 2 \array offset -> do TextArray.unsafeWrite array offset unit1 TextArray.unsafeWrite array (succ offset) unit2 return $ offset + 2 #endif -- * Basic Unsafe Primitives -- | -- Helper for constructing from char producers a bit more efficiently than via @(text . fromString)@. -- -- >>> unsafeChars 3 "123" -- "123" -- -- >>> unsafeChars 4 "123" -- "123" {-# INLINE unsafeChars #-} unsafeChars :: -- | Maximum size of the provided list of characters. -- -- __Warning__: Must be greater than or equal to the length of the list. Int -> [Char] -> TextBuilder #if MIN_VERSION_text(2,0,0) unsafeChars maxChars chars = TextBuilder (maxChars * 4) ( \array -> foldr ( \char next offset -> Utf8View.unicodeCodepoint (ord char) ( \byte -> do TextArray.unsafeWrite array offset byte next (succ offset) ) ( \byte1 byte2 -> do TextArray.unsafeWrite array offset byte1 TextArray.unsafeWrite array (succ offset) byte2 next (offset + 2) ) ( \byte1 byte2 byte3 -> do TextArray.unsafeWrite array offset byte1 TextArray.unsafeWrite array (succ offset) byte2 TextArray.unsafeWrite array (offset + 2) byte3 next (offset + 3) ) ( \byte1 byte2 byte3 byte4 -> do TextArray.unsafeWrite array offset byte1 TextArray.unsafeWrite array (succ offset) byte2 TextArray.unsafeWrite array (offset + 2) byte3 TextArray.unsafeWrite array (offset + 3) byte4 next (offset + 4) ) ) return chars ) #else unsafeChars maxChars chars = TextBuilder (maxChars * 2) ( \array -> foldr ( \char next offset -> Utf16View.unicodeCodepoint (ord char) ( \byte -> do TextArray.unsafeWrite array offset byte next (succ offset) ) ( \byte1 byte2 -> do TextArray.unsafeWrite array offset byte1 TextArray.unsafeWrite array (succ offset) byte2 next (offset + 2) ) ) return chars ) #endif -- | -- Provides a unified way to deal with the byte array regardless of the version of the @text@ library. -- -- Keep in mind that prior to @text-2.0@, the array was operating on 'Word16' values due to the library abstracting over @UTF-16@. -- Starting from @text-2.0@, the array operates on 'Word8' values and the library abstracts over @UTF-8@. -- -- This function is useful for building ASCII values. -- -- >>> unsafeSeptets 3 (fmap (+48) [1, 2, 3]) -- "123" -- -- >>> unsafeSeptets 4 (fmap (+48) [1, 2, 3]) -- "123" {-# INLINE unsafeSeptets #-} unsafeSeptets :: -- | Maximum size of the byte array to allocate. -- -- Must be greater than or equal to the length of the list. -- -- __Warning:__ If it is smaller, bad things will happen. -- We'll be writing outside of the allocated array. Int -> -- | List of bytes to write. -- -- __Warning:__ It is your responsibility to ensure that the bytes are smaller than 128. -- Otherwise the produced text will have a broken encoding. -- -- To ensure of optimization kicking in it is advised to construct the list using 'GHC.List.build'. [Word8] -> TextBuilder #if MIN_VERSION_text(2,0,0) unsafeSeptets maxSize bytes = TextBuilder maxSize ( \array -> foldr ( \byte next offset -> do TextArray.unsafeWrite array offset byte next (succ offset) ) return bytes ) #else unsafeSeptets maxSize bytes = TextBuilder maxSize ( \array -> foldr ( \byte next offset -> do TextArray.unsafeWrite array offset (fromIntegral byte) next (succ offset) ) return bytes ) #endif -- | Same as 'unsafeSeptets', but writes the bytes in reverse order and requires the size to be precise. -- -- >>> unsafeReverseSeptets 3 (fmap (+48) [1, 2, 3]) -- "321" {-# INLINE unsafeReverseSeptets #-} unsafeReverseSeptets :: -- | Precise amount of bytes in the list. -- -- Needs to be precise, because writing happens in reverse order. -- -- __Warning:__ If it is smaller, bad things will happen. -- We'll be writing outside of the allocated array. Int -> -- | List of bytes to write in reverse order. -- -- __Warning:__ It is your responsibility to ensure that the bytes are smaller than 128. -- Otherwise the produced text will have a broken encoding. -- -- To ensure of optimization kicking in it is advised to construct the list using 'GHC.List.build'. [Word8] -> TextBuilder #if MIN_VERSION_text(2,0,0) unsafeReverseSeptets preciseSize bytes = TextBuilder preciseSize ( \array startOffset -> let endOffset = startOffset + preciseSize in foldr ( \byte next offset -> do TextArray.unsafeWrite array offset byte next (pred offset) ) (\_ -> return endOffset) bytes (pred endOffset) ) #else unsafeReverseSeptets preciseSize bytes = TextBuilder preciseSize ( \array startOffset -> let endOffset = startOffset + preciseSize in foldr ( \byte next offset -> do TextArray.unsafeWrite array offset (fromIntegral byte) next (pred offset) ) (\_ -> return endOffset) bytes (pred endOffset) ) #endif text-builder-core-0.1.1.1/library/TextBuilderCore/0000755000000000000000000000000007346545000020107 5ustar0000000000000000text-builder-core-0.1.1.1/library/TextBuilderCore/Prelude.hs0000644000000000000000000000555507346545000022055 0ustar0000000000000000module TextBuilderCore.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.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 Numeric.Natural as Exports (Natural) import System.Environment as Exports import System.Exit as Exports import System.IO as Exports import System.IO.Error as Exports import System.IO.Unsafe as Exports import System.Mem as Exports import System.Mem.StableName as Exports import System.Timeout as Exports import Test.QuickCheck.Arbitrary as Exports import 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-core-0.1.1.1/library/TextBuilderCore/Utf16View.hs0000644000000000000000000000256707346545000022215 0ustar0000000000000000module TextBuilderCore.Utf16View where import TextBuilderCore.Prelude import qualified TextBuilderCore.Utf16View.Unicode as Unicode -- | -- A matching function, which chooses the continuation to run. type Utf16View = forall x. (Word16 -> x) -> (Word16 -> Word16 -> x) -> x {-# INLINE char #-} char :: Char -> Utf16View char x = unicodeCodepoint (ord x) {-# INLINE unicodeCodepoint #-} unicodeCodepoint :: Int -> Utf16View unicodeCodepoint x case1 case2 = if x < 0x10000 then case1 (fromIntegral x) else case2 case2Unit1 case2Unit2 where m = x - 0x10000 case2Unit1 = fromIntegral (shiftR m 10 + 0xD800) case2Unit2 = fromIntegral ((m .&. 0x3FF) + 0xDC00) {-# INLINE utf8CodeUnits1 #-} utf8CodeUnits1 :: Word8 -> Utf16View utf8CodeUnits1 x case1 _ = case1 (fromIntegral x) {-# INLINE utf8CodeUnits2 #-} utf8CodeUnits2 :: Word8 -> Word8 -> Utf16View utf8CodeUnits2 byte1 byte2 case1 _ = case1 (shiftL (fromIntegral byte1 - 0xC0) 6 + fromIntegral byte2 - 0x80) {-# INLINE utf8CodeUnits3 #-} utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> Utf16View utf8CodeUnits3 byte1 byte2 byte3 = unicodeCodepoint (Unicode.utf8CodeUnits3 byte1 byte2 byte3) {-# INLINE utf8CodeUnits4 #-} utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> Utf16View utf8CodeUnits4 byte1 byte2 byte3 byte4 = unicodeCodepoint (Unicode.utf8CodeUnits4 byte1 byte2 byte3 byte4) text-builder-core-0.1.1.1/library/TextBuilderCore/Utf16View/0000755000000000000000000000000007346545000021647 5ustar0000000000000000text-builder-core-0.1.1.1/library/TextBuilderCore/Utf16View/Unicode.hs0000644000000000000000000000123007346545000023565 0ustar0000000000000000-- | -- Utilities for construction of Unicode codepoints. module TextBuilderCore.Utf16View.Unicode where import TextBuilderCore.Prelude {-# INLINE utf8CodeUnits3 #-} utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> Int utf8CodeUnits3 byte1 byte2 byte3 = shiftL (fromIntegral byte1 - 0xE0) 12 + shiftL (fromIntegral byte2 - 0x80) 6 + fromIntegral byte3 - 0x80 {-# INLINE utf8CodeUnits4 #-} utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> Int utf8CodeUnits4 byte1 byte2 byte3 byte4 = shiftL (fromIntegral byte1 - 0xF0) 18 + shiftL (fromIntegral byte2 - 0x80) 12 + shiftL (fromIntegral byte3 - 0x80) 6 + fromIntegral byte4 - 0x80 text-builder-core-0.1.1.1/library/TextBuilderCore/Utf8View.hs0000644000000000000000000000174007346545000022126 0ustar0000000000000000module TextBuilderCore.Utf8View where import TextBuilderCore.Prelude -- | -- A matching function, which chooses the continuation to run. type Utf8View = forall x. (Word8 -> x) -> (Word8 -> Word8 -> x) -> (Word8 -> Word8 -> Word8 -> x) -> (Word8 -> Word8 -> Word8 -> Word8 -> x) -> x {-# INLINE unicodeCodepoint #-} unicodeCodepoint :: Int -> Utf8View unicodeCodepoint x case1 case2 case3 case4 | x < 0x80 = case1 (fromIntegral x) | x < 0x800 = case2 (fromIntegral $ x `shiftR` 6 .|. 0xC0) (fromIntegral $ (x .&. 0x3F) .|. 0x80) | x < 0x10000 = case3 (fromIntegral $ x `shiftR` 12 .|. 0xE0) (fromIntegral $ (x `shiftR` 6) .&. 0x3F .|. 0x80) (fromIntegral $ (x .&. 0x3F) .|. 0x80) | otherwise = case4 (fromIntegral $ x `shiftR` 18 .|. 0xF0) (fromIntegral $ (x `shiftR` 12) .&. 0x3F .|. 0x80) (fromIntegral $ (x `shiftR` 6) .&. 0x3F .|. 0x80) (fromIntegral $ (x .&. 0x3F) .|. 0x80) text-builder-core-0.1.1.1/test/0000755000000000000000000000000007346545000014356 5ustar0000000000000000text-builder-core-0.1.1.1/test/Features.hs0000644000000000000000000000463707346545000016502 0ustar0000000000000000module Features (tests) where import Control.Monad import Data.Char import Data.String import qualified Data.Text as Text import qualified Data.Text.Lazy as Text.Lazy import Test.QuickCheck.Instances () import Test.Tasty import Test.Tasty.QuickCheck import TextBuilderCore import Util.TestTrees import Prelude tests :: [TestTree] tests = [ testGroup "isEmpty" $ [ testProperty "Is True for empty string" $ isEmpty (fromString ""), testProperty "Is True for mempty" $ isEmpty (fromString mempty), testProperty "Is True for (mempty <> mempty)" $ isEmpty (fromString (mempty <> mempty)), testProperty "Is isomorphic to Text.null" $ \a -> isEmpty (text a) === Text.null a ], testGroup "toText" $ [ mapsToMonoid toText, testProperty "Roundtrips" \textValue -> toText (text textValue) === textValue ], testGroup "string" $ [ mapsToMonoid string, testProperty "Roundtrips" \builder -> string (Text.unpack (toText builder)) === builder ], testGroup "text" $ [ mapsToMonoid text, testProperty "Roundtrips" \builder -> text (toText builder) === builder ], testGroup "lazyText" $ [ mapsToMonoid lazyText, testProperty "Roundtrips" \builder -> lazyText (Text.Lazy.fromStrict (toText builder)) === builder ], testGroup "char" $ [ mapsToMonoid char, testProperty "Is isomorphic to Text.singleton" \a -> toText (char a) === Text.singleton a ], testGroup "unicodeCodepoint" $ [ mapsToMonoid unicodeCodepoint, testProperty "Is isomorphic to Text.singleton" \a -> toText (unicodeCodepoint (ord a)) === Text.singleton a ], testGroup "unsafeSeptets" $ [ isMonoidWithCustomGen do maxGenSize <- getSize maxSize <- chooseInt (0, maxGenSize) actualSize <- chooseInt (0, maxSize) septets <- replicateM actualSize $ fromIntegral <$> chooseInt (0, 127) pure (unsafeSeptets maxSize septets) ], testGroup "unsafeReverseSeptets" $ [ isMonoidWithCustomGen do maxGenSize <- getSize maxSize <- chooseInt (0, maxGenSize) septets <- replicateM maxSize $ fromIntegral <$> chooseInt (0, 127) pure (unsafeReverseSeptets maxSize septets) ] ] text-builder-core-0.1.1.1/test/Main.hs0000644000000000000000000000313707346545000015602 0ustar0000000000000000module Main where import Data.Proxy import qualified Data.Text as Text import qualified Features import Test.QuickCheck.Classes import Test.QuickCheck.Instances () import Test.Tasty import Test.Tasty.QuickCheck hiding ((.&.)) import qualified TextBuilderCore as B import Util.ExtraInstances () import Util.TestTrees import Prelude main :: IO () main = (defaultMain . testGroup "All") tests tests :: [TestTree] tests = [ testGroup "Legacy" $ [ 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)) ], testGroup "Laws" $ [ followsLaws $ showLaws (Proxy @B.TextBuilder), followsLaws $ eqLaws (Proxy @B.TextBuilder), followsLaws $ semigroupLaws (Proxy @B.TextBuilder), followsLaws $ monoidLaws (Proxy @B.TextBuilder) ], testGroup "Features" Features.tests ] text-builder-core-0.1.1.1/test/Util/0000755000000000000000000000000007346545000015273 5ustar0000000000000000text-builder-core-0.1.1.1/test/Util/ExtraInstances.hs0000644000000000000000000000047007346545000020563 0ustar0000000000000000{-# 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 text-builder-core-0.1.1.1/test/Util/TestTrees.hs0000644000000000000000000000453307346545000017556 0ustar0000000000000000module Util.TestTrees where import Data.List.NonEmpty (NonEmpty (..)) import Data.Monoid import Data.Semigroup import Test.QuickCheck import Test.QuickCheck.Classes import Test.QuickCheck.Instances () import Test.Tasty import Test.Tasty.QuickCheck 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, Monoid b, Eq b, Show b) => -- | Embed in monoid. (a -> b) -> TestTree mapsToMonoid embed = isMonoidWithCustomGen (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@ isMonoidWithCustomGen :: (Monoid a, Eq a, Show a) => Gen a -> TestTree isMonoidWithCustomGen 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) ] followsLaws :: Laws -> TestTree followsLaws Laws {..} = testProperties lawsTypeclass lawsProperties text-builder-core-0.1.1.1/text-builder-core.cabal0000644000000000000000000000543407346545000017727 0ustar0000000000000000cabal-version: 3.0 name: text-builder-core version: 0.1.1.1 category: Text, Builders synopsis: Internals of "text-builder" description: Core functionality of \"text-builder\" with guts exposed for efficient custom integrations. Consider this to be what you'll find in the \"Internal\" modules of packages violating PVP. You'll find more on this in [a blog post](https://nikita-volkov.github.io/internal-convention-is-a-mistake/). homepage: https://github.com/nikita-volkov/text-builder-core bug-reports: https://github.com/nikita-volkov/text-builder-core/issues author: Nikita Volkov maintainer: Nikita Volkov copyright: (c) 2022, Nikita Volkov license: MIT license-file: LICENSE source-repository head type: git location: https://github.com/nikita-volkov/text-builder-core common base default-language: Haskell2010 default-extensions: BangPatterns BlockArguments ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DerivingStrategies EmptyDataDecls FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving LambdaCase LiberalTypeSynonyms MagicHash MultiParamTypeClasses MultiWayIf NoImplicitPrelude NoMonomorphismRestriction NumericUnderscores OverloadedStrings ParallelListComp PatternGuards QuasiQuotes RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving StrictData TemplateHaskell TupleSections TypeApplications TypeFamilies TypeOperators UnboxedTuples ViewPatterns library import: base hs-source-dirs: library exposed-modules: TextBuilderCore other-modules: TextBuilderCore.Prelude TextBuilderCore.Utf16View TextBuilderCore.Utf16View.Unicode TextBuilderCore.Utf8View build-depends: QuickCheck >=2.14 && <3, base >=4.11 && <5, text >=1.2 && <3, test-suite test import: base type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Main.hs other-modules: Features Util.ExtraInstances Util.TestTrees build-depends: QuickCheck >=2.14 && <3, base >=4.11 && <5, quickcheck-classes >=0.6.5 && <0.7, quickcheck-instances >=0.3.32 && <0.4, tasty >=1.2.3 && <2, tasty-quickcheck ^>=0.11, text >=1.2 && <3, text-builder-core, benchmark bench import: base type: exitcode-stdio-1.0 hs-source-dirs: bench ghc-options: -O2 -threaded -with-rtsopts=-N -with-rtsopts=-A32m -with-rtsopts=-T -fproc-alignment=64 main-is: Main.hs build-depends: base >=4.11 && <5, tasty-bench ^>=0.4.1, text >=2.1.2 && <3, text-builder-core, text-builder-linear ^>=0.1.3,