packages feed

text-builder-core (empty) → 0.1

raw patch · 12 files changed

+996/−0 lines, 12 filesdep +QuickCheckdep +basedep +quickcheck-classes

Dependencies added: QuickCheck, base, quickcheck-classes, quickcheck-instances, tasty, tasty-bench, tasty-quickcheck, text, text-builder-core, text-builder-linear

Files

+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (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.
+ bench/Main.hs view
@@ -0,0 +1,76 @@+module 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 "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)+                  )+              ]
+ library/TextBuilderCore.hs view
@@ -0,0 +1,392 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wno-unused-top-binds #-}++module TextBuilderCore+  ( TextBuilder (..),++    -- * Destructors+    isEmpty,+    toText,++    -- * Constructors++    -- ** Text+    text,+    lazyText,++    -- ** Character+    char,+    unicodeCodepoint,++    -- ** Primitives+    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++-- |+-- Specification of how to efficiently construct strict 'Text'.+--+-- For this task it is much more efficient than @Data.Text.Lazy.Builder.'Data.Text.Lazy.Builder.Builder'@ and even the recently introduced @Data.Text.Encoding.'Data.Text.Encoding.StrictTextBuilder'@.+--+-- 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 \"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 = text . fromString++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++-- | 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++-- |+-- 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
+ library/TextBuilderCore/Prelude.hs view
@@ -0,0 +1,71 @@+module 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, (.))
+ library/TextBuilderCore/Utf16View.hs view
@@ -0,0 +1,48 @@+module 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)
+ library/TextBuilderCore/Utf16View/Unicode.hs view
@@ -0,0 +1,22 @@+-- |+-- 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
+ library/TextBuilderCore/Utf8View.hs view
@@ -0,0 +1,33 @@+module 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)
+ test/Features.hs view
@@ -0,0 +1,59 @@+module Features (tests) where++import Control.Monad+import Data.String+import qualified Data.Text as Text+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+      ],+    testGroup "text" $+      [ mapsToMonoid text+      ],+    testGroup "lazyText" $+      [ mapsToMonoid lazyText+      ],+    testGroup "char" $+      [ mapsToMonoid char+      ],+    testGroup "unicodeCodepoint" $+      [ mapsToMonoid unicodeCodepoint+      ],+    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)+      ]+  ]
+ test/Main.hs view
@@ -0,0 +1,54 @@+module Main where++import qualified Data.Char as Char+import Data.Proxy+import Data.Text (Text)+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)),+        testProperty "(TextBuilderCore.unicodeCodepoint <>) is isomorphic to Text.cons" $+          withMaxSuccess bigTest $+            \(text :: Text) (c :: Char) ->+              B.toText (B.unicodeCodepoint (Char.ord c) <> B.text text) === Text.cons c text+      ],+    testGroup "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+  ]+  where+    bigTest = 10000
+ test/Util/ExtraInstances.hs view
@@ -0,0 +1,12 @@+{-# OPTIONS_GHC -Wno-orphans #-}++module Util.ExtraInstances where++import qualified Data.Text.Lazy.Builder as TextLazyBuilder+import Test.QuickCheck+import Test.QuickCheck.Instances ()+import Prelude++instance Arbitrary TextLazyBuilder.Builder where+  arbitrary =+    TextLazyBuilder.fromLazyText <$> arbitrary
+ test/Util/TestTrees.hs view
@@ -0,0 +1,86 @@+module 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.cabal view
@@ -0,0 +1,121 @@+cabal-version: 3.0+name: text-builder-core+version: 0.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 <nikita.y.volkov@mail.ru>+maintainer: Nikita Volkov <nikita.y.volkov@mail.ru>+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,