packages feed

text-builder-dev 0.3.3 → 0.3.3.1

raw patch · 8 files changed

+242/−199 lines, 8 files

Files

library/TextBuilderDev.hs view
@@ -1,6 +1,5 @@ module TextBuilderDev-  ( -- * ---    TextBuilder,+  ( TextBuilder,      -- * Accessors     buildText,@@ -78,20 +77,15 @@ import qualified Data.ByteString as ByteString import qualified Data.List.Split as Split import qualified Data.Text as Text-import qualified Data.Text.Array as B-import qualified Data.Text.Encoding as E-import qualified Data.Text.Encoding.Error as E+import qualified Data.Text.Array as TextArray import qualified Data.Text.IO as Text-import qualified Data.Text.Internal as C+import qualified Data.Text.Internal as TextInternal import qualified Data.Text.Lazy as TextLazy import qualified Data.Text.Lazy.Builder as TextLazyBuilder import qualified DeferredFolds.Unfoldr as Unfoldr import TextBuilderDev.Prelude hiding (intercalate, length, null)-#if MIN_VERSION_text(2,0,0)-import qualified TextBuilderDev.UTF8 as D-#else-import qualified TextBuilderDev.UTF16 as D-#endif+import qualified TextBuilderDev.Utf16View as Utf16View+import qualified TextBuilderDev.Utf8View as Utf8View  -- * -- @@ -143,6 +137,22 @@   toTextBuilder = text . TextLazy.toStrict . TextLazyBuilder.toLazyText   fromTextBuilder = TextLazyBuilder.fromText . buildText +-- * Action++newtype Action+  = Action (forall s. TextArray.MArray s -> Int -> ST s Int)++instance Semigroup Action where+  {-# INLINE (<>) #-}+  Action writeL <> Action writeR =+    Action $ \array offset -> do+      offsetAfter1 <- writeL array offset+      writeR array offsetAfter1++instance Monoid Action where+  {-# INLINE mempty #-}+  mempty = Action $ const $ return+ -- * --  -- |@@ -151,26 +161,17 @@ data TextBuilder   = TextBuilder !Action !Int !Int -newtype Action-  = Action (forall s. B.MArray s -> Int -> ST s ())- instance Semigroup TextBuilder where-  (<>) (TextBuilder (Action action1) arraySize1 charsAmount1) (TextBuilder (Action action2) arraySize2 charsAmount2) =-    TextBuilder action arraySize charsAmount+  (<>) (TextBuilder action1 estimatedArraySize1 textLength1) (TextBuilder action2 estimatedArraySize2 textLength2) =+    TextBuilder action estimatedArraySize textLength     where-      action =-        Action $ \array offset -> do-          action1 array offset-          action2 array (offset + arraySize1)-      arraySize =-        arraySize1 + arraySize2-      charsAmount =-        charsAmount1 + charsAmount2+      action = action1 <> action2+      estimatedArraySize = estimatedArraySize1 + estimatedArraySize2+      textLength = textLength1 + textLength2  instance Monoid TextBuilder where   {-# INLINE mempty #-}-  mempty =-    TextBuilder (Action (\_ _ -> return ())) 0 0+  mempty = TextBuilder mempty 0 0  instance IsString TextBuilder where   fromString = string@@ -210,42 +211,40 @@  -- * Accessors --- | Get the amount of characters+-- | Get the amount of characters. {-# INLINE length #-} length :: TextBuilder -> Int length (TextBuilder _ _ x) = x --- | Check whether the builder is empty+-- | Check whether the builder is empty. {-# INLINE null #-} null :: TextBuilder -> Bool null = (== 0) . length --- | Execute a builder producing a strict text+-- | Execute a builder producing a strict text. buildText :: TextBuilder -> Text-buildText (TextBuilder (Action action) arraySize _) =-  C.text array 0 arraySize-  where-    array =-      runST $ do-        array <- B.new arraySize-        action array 0-        B.unsafeFreeze array+buildText (TextBuilder (Action action) sizeBound _) =+  runST $ do+    array <- TextArray.new sizeBound+    offsetAfter <- action array 0+    frozenArray <- TextArray.unsafeFreeze array+    return $ TextInternal.text frozenArray 0 offsetAfter  -- ** Output IO --- | Put builder, to stdout+-- | Put builder, to stdout. putToStdOut :: TextBuilder -> IO () putToStdOut = Text.hPutStr stdout . buildText --- | Put builder, to stderr+-- | Put builder, to stderr. putToStdErr :: TextBuilder -> IO () putToStdErr = Text.hPutStr stderr . buildText --- | Put builder, followed by a line, to stdout+-- | Put builder, followed by a line, to stdout. putLnToStdOut :: TextBuilder -> IO () putLnToStdOut = Text.hPutStrLn stdout . buildText --- | Put builder, followed by a line, to stderr+-- | Put builder, followed by a line, to stderr. putLnToStdErr :: TextBuilder -> IO () putLnToStdErr = Text.hPutStrLn stderr . buildText @@ -261,48 +260,56 @@ force :: TextBuilder -> TextBuilder force = text . buildText --- | Unicode character+-- | Unicode character. {-# INLINE char #-} char :: Char -> TextBuilder-char x =-  unicodeCodePoint (ord x)+char = unicodeCodePoint . ord  #if MIN_VERSION_text(2,0,0) --- | Unicode code point+-- | Unicode code point. {-# INLINE unicodeCodePoint #-} unicodeCodePoint :: Int -> TextBuilder unicodeCodePoint x =-  D.unicodeCodePoint x utf8CodeUnits1 utf8CodeUnits2 utf8CodeUnits3 utf8CodeUnits4+  Utf8View.unicodeCodePoint x utf8CodeUnits1 utf8CodeUnits2 utf8CodeUnits3 utf8CodeUnits4  {-# INLINEABLE utf8CodeUnits1 #-} utf8CodeUnits1 :: Word8 -> TextBuilder utf8CodeUnits1 unit1 = TextBuilder action 1 1-  where action = Action $ \array offset -> B.unsafeWrite array offset unit1+  where+    action = Action $ \array offset ->+      TextArray.unsafeWrite array offset unit1+        $> succ offset  {-# INLINEABLE utf8CodeUnits2 #-} utf8CodeUnits2 :: Word8 -> Word8 -> TextBuilder utf8CodeUnits2 unit1 unit2 = TextBuilder action 2 1-  where action = Action $ \array offset -> do-          B.unsafeWrite array (offset + 0) unit1-          B.unsafeWrite array (offset + 1) unit2+  where+    action = Action $ \array offset -> do+      TextArray.unsafeWrite array (offset + 0) unit1+      TextArray.unsafeWrite array (offset + 1) unit2+      return $ offset + 2  {-# INLINEABLE utf8CodeUnits3 #-} utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> TextBuilder utf8CodeUnits3 unit1 unit2 unit3 = TextBuilder action 3 1-  where action = Action $ \array offset -> do-          B.unsafeWrite array (offset + 0) unit1-          B.unsafeWrite array (offset + 1) unit2-          B.unsafeWrite array (offset + 2) unit3+  where+    action = Action $ \array offset -> do+      TextArray.unsafeWrite array (offset + 0) unit1+      TextArray.unsafeWrite array (offset + 1) unit2+      TextArray.unsafeWrite array (offset + 2) unit3+      return $ offset + 3  {-# INLINEABLE utf8CodeUnits4 #-} utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> TextBuilder utf8CodeUnits4 unit1 unit2 unit3 unit4 = TextBuilder action 4 1-  where action = Action $ \array offset -> do-          B.unsafeWrite array (offset + 0) unit1-          B.unsafeWrite array (offset + 1) unit2-          B.unsafeWrite array (offset + 2) unit3-          B.unsafeWrite array (offset + 3) unit4+  where+    action = Action $ \array offset -> do+      TextArray.unsafeWrite array (offset + 0) unit1+      TextArray.unsafeWrite array (offset + 1) unit2+      TextArray.unsafeWrite array (offset + 2) unit3+      TextArray.unsafeWrite array (offset + 3) unit4+      return $ offset + 4  {-# INLINE utf16CodeUnits1 #-} utf16CodeUnits1 :: Word16 -> TextBuilder@@ -316,22 +323,24 @@  #else --- | Unicode code point+-- | Unicode code point. {-# INLINE unicodeCodePoint #-} unicodeCodePoint :: Int -> TextBuilder unicodeCodePoint x =-  D.unicodeCodePoint x utf16CodeUnits1 utf16CodeUnits2+  Utf16View.unicodeCodePoint x utf16CodeUnits1 utf16CodeUnits2 --- | Single code-unit UTF-16 character+-- | Single code-unit UTF-16 character. {-# INLINEABLE utf16CodeUnits1 #-} utf16CodeUnits1 :: Word16 -> TextBuilder utf16CodeUnits1 unit =   TextBuilder action 1 1   where     action =-      Action $ \array offset -> B.unsafeWrite array offset unit+      Action $ \array offset ->+        TextArray.unsafeWrite array offset unit+          $> succ offset --- | Double code-unit UTF-16 character+-- | Double code-unit UTF-16 character. {-# INLINEABLE utf16CodeUnits2 #-} utf16CodeUnits2 :: Word16 -> Word16 -> TextBuilder utf16CodeUnits2 unit1 unit2 =@@ -339,36 +348,40 @@   where     action =       Action $ \array offset -> do-        B.unsafeWrite array offset unit1-        B.unsafeWrite array (succ offset) unit2+        TextArray.unsafeWrite array offset unit1+        TextArray.unsafeWrite array (succ offset) unit2+        return $ offset + 2 --- | Single code-unit UTF-8 character+-- | Single code-unit UTF-8 character. {-# INLINE utf8CodeUnits1 #-} utf8CodeUnits1 :: Word8 -> TextBuilder utf8CodeUnits1 unit1 =-  D.utf8CodeUnits1 unit1 utf16CodeUnits1 utf16CodeUnits2+  Utf16View.utf8CodeUnits1 unit1 utf16CodeUnits1 utf16CodeUnits2 --- | Double code-unit UTF-8 character+-- | Double code-unit UTF-8 character. {-# INLINE utf8CodeUnits2 #-} utf8CodeUnits2 :: Word8 -> Word8 -> TextBuilder utf8CodeUnits2 unit1 unit2 =-  D.utf8CodeUnits2 unit1 unit2 utf16CodeUnits1 utf16CodeUnits2+  Utf16View.utf8CodeUnits2 unit1 unit2 utf16CodeUnits1 utf16CodeUnits2 --- | Triple code-unit UTF-8 character+-- | Triple code-unit UTF-8 character. {-# INLINE utf8CodeUnits3 #-} utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> TextBuilder utf8CodeUnits3 unit1 unit2 unit3 =-  D.utf8CodeUnits3 unit1 unit2 unit3 utf16CodeUnits1 utf16CodeUnits2+  Utf16View.utf8CodeUnits3 unit1 unit2 unit3 utf16CodeUnits1 utf16CodeUnits2 --- | UTF-8 character out of 4 code units+-- | UTF-8 character out of 4 code units. {-# INLINE utf8CodeUnits4 #-} utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> TextBuilder utf8CodeUnits4 unit1 unit2 unit3 unit4 =-  D.utf8CodeUnits4 unit1 unit2 unit3 unit4 utf16CodeUnits1 utf16CodeUnits2+  Utf16View.utf8CodeUnits4 unit1 unit2 unit3 unit4 utf16CodeUnits1 utf16CodeUnits2  #endif --- | ASCII byte string+-- | ASCII byte string.+--+-- It's your responsibility to ensure that the bytes are in proper range,+-- otherwise the produced text will be broken. {-# INLINEABLE asciiByteString #-} asciiByteString :: ByteString -> TextBuilder asciiByteString byteString =@@ -378,37 +391,44 @@     action =       Action $ \array ->         let step byte next index = do-              B.unsafeWrite array index (fromIntegral byte)+              TextArray.unsafeWrite array index (fromIntegral byte)               next (succ index)-         in ByteString.foldr step (const (return ())) byteString+         in ByteString.foldr step return byteString --- | Strict text+-- | Strict text. {-# INLINEABLE text #-} text :: Text -> TextBuilder-text text@(C.Text array offset length) =+#if MIN_VERSION_text(2,0,0)+text text@(TextInternal.Text array offset length) =   TextBuilder action length (Text.length text)   where     action =       Action $ \builderArray builderOffset -> do-#if MIN_VERSION_text(2,0,0)-        B.copyI length builderArray builderOffset array offset+        TextArray.copyI length builderArray builderOffset array offset+        return $ builderOffset + length #else-        B.copyI builderArray builderOffset array offset (builderOffset + length)+text text@(TextInternal.Text array offset length) =+  TextBuilder action length (Text.length text)+  where+    action =+      Action $ \builderArray builderOffset -> do+        TextArray.copyI builderArray builderOffset array offset (builderOffset + length)+        return $ builderOffset + length #endif --- | Lazy text+-- | Lazy text. {-# INLINE lazyText #-} lazyText :: TextLazy.Text -> TextBuilder lazyText =   TextLazy.foldrChunks (mappend . text) mempty --- | String+-- | String. {-# INLINE string #-} string :: String -> TextBuilder string =   foldMap char --- | Decimal representation of an integral value+-- | Decimal representation of an integral value. {-# INLINEABLE decimal #-} decimal :: Integral a => a -> TextBuilder decimal i =@@ -416,13 +436,13 @@     then unsignedDecimal i     else unicodeCodePoint 45 <> unsignedDecimal (negate i) --- | Decimal representation of an unsigned integral value+-- | Decimal representation of an unsigned integral value. {-# INLINEABLE unsignedDecimal #-} unsignedDecimal :: Integral a => a -> TextBuilder unsignedDecimal =   foldMap decimalDigit . Unfoldr.decimalDigits --- | Decimal representation of an integral value with thousands separated by the specified character+-- | Decimal representation of an integral value with thousands separated by the specified character. {-# INLINEABLE thousandSeparatedDecimal #-} thousandSeparatedDecimal :: Integral a => Char -> a -> TextBuilder thousandSeparatedDecimal separatorChar a =@@ -430,15 +450,32 @@     then thousandSeparatedUnsignedDecimal separatorChar a     else unicodeCodePoint 45 <> thousandSeparatedUnsignedDecimal separatorChar (negate a) --- | Decimal representation of an unsigned integral value with thousands separated by the specified character+-- | Decimal representation of an unsigned integral value with thousands separated by the specified character. {-# INLINEABLE thousandSeparatedUnsignedDecimal #-} thousandSeparatedUnsignedDecimal :: Integral a => Char -> a -> TextBuilder-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 separatorChar =+  processRightmostDigit+  where+    processRightmostDigit value =+      case divMod value 10 of+        (value, digit) ->+          processAnotherDigit [decimalDigit digit] 1 value+    processAnotherDigit builders index value =+      if value == 0+        then mconcat builders+        else case divMod value 10 of+          (value, digit) ->+            if mod index 3 == 0+              then+                processAnotherDigit+                  (decimalDigit digit : char separatorChar : builders)+                  (succ index)+                  value+              else+                processAnotherDigit+                  (decimalDigit digit : builders)+                  (succ index)+                  value  -- | Data size in decimal notation over amount of bytes. {-# INLINEABLE dataSizeInBytesInDecimal #-}@@ -478,19 +515,19 @@         then thousandSeparatedDecimal separatorChar byExtraTen         else thousandSeparatedDecimal separatorChar byExtraTen <> "." <> decimalDigit remainder --- | Unsigned binary number+-- | Unsigned binary number. {-# INLINE unsignedBinary #-} unsignedBinary :: Integral a => a -> TextBuilder unsignedBinary =   foldMap decimalDigit . Unfoldr.binaryDigits --- | Unsigned binary number+-- | Unsigned binary number. {-# INLINE unsignedPaddedBinary #-} unsignedPaddedBinary :: (Integral a, FiniteBits a) => a -> TextBuilder unsignedPaddedBinary a =   padFromLeft (finiteBitSize a) '0' $ foldMap decimalDigit $ Unfoldr.binaryDigits a --- | Hexadecimal representation of an integral value+-- | Hexadecimal representation of an integral value. {-# INLINE hexadecimal #-} hexadecimal :: Integral a => a -> TextBuilder hexadecimal i =@@ -498,19 +535,19 @@     then unsignedHexadecimal i     else unicodeCodePoint 45 <> unsignedHexadecimal (negate i) --- | Unsigned hexadecimal representation of an integral value+-- | Unsigned hexadecimal representation of an integral value. {-# INLINE unsignedHexadecimal #-} unsignedHexadecimal :: Integral a => a -> TextBuilder unsignedHexadecimal =   foldMap hexadecimalDigit . Unfoldr.hexadecimalDigits --- | Decimal digit+-- | Decimal digit. {-# INLINE decimalDigit #-} decimalDigit :: Integral a => a -> TextBuilder decimalDigit n =   unicodeCodePoint (fromIntegral n + 48) --- | Hexadecimal digit+-- | Hexadecimal digit. {-# INLINE hexadecimalDigit #-} hexadecimalDigit :: Integral a => a -> TextBuilder hexadecimalDigit n =@@ -518,7 +555,7 @@     then unicodeCodePoint (fromIntegral n + 48)     else unicodeCodePoint (fromIntegral n + 87) --- | Intercalate builders+-- | Intercalate builders. {-# INLINE intercalate #-} intercalate :: Foldable f => TextBuilder -> f TextBuilder -> TextBuilder intercalate separator = extract . foldl' step init@@ -531,7 +568,7 @@           else element     extract (Product2 _ builder) = builder --- | Intercalate projecting values to builder+-- | Intercalate projecting values to builder. {-# INLINE intercalateMap #-} intercalateMap :: Foldable f => TextBuilder -> (a -> TextBuilder) -> f a -> TextBuilder intercalateMap separator mapper = extract . foldl' step init@@ -543,7 +580,7 @@         Just acc -> acc <> separator <> mapper element     extract = fromMaybe mempty --- | Pad a builder from the left side to the specified length with the specified character+-- | Pad a builder from the left side to the specified length with the specified character. {-# INLINEABLE padFromLeft #-} padFromLeft :: Int -> Char -> TextBuilder -> TextBuilder padFromLeft paddedLength paddingChar builder =@@ -552,7 +589,7 @@         then builder         else foldMap char (replicate (paddedLength - builderLength) paddingChar) <> builder --- | Pad a builder from the right side to the specified length with the specified character+-- | Pad a builder from the right side to the specified length with the specified character. {-# INLINEABLE padFromRight #-} padFromRight :: Int -> Char -> TextBuilder -> TextBuilder padFromRight paddedLength paddingChar builder =@@ -609,7 +646,8 @@   hours <- state (swap . flip divMod 24)   days <- get   return $-    padFromLeft 2 '0' (decimal days) <> ":"+    padFromLeft 2 '0' (decimal days)+      <> ":"       <> padFromLeft 2 '0' (decimal hours)       <> ":"       <> padFromLeft 2 '0' (decimal minutes)@@ -638,7 +676,8 @@ {-# INLINE hexData #-} hexData :: ByteString -> TextBuilder hexData =-  intercalate " " . fmap mconcat+  intercalate " "+    . fmap mconcat     . Split.chunksOf 2     . fmap byte     . ByteString.unpack
− library/TextBuilderDev/UTF16.hs 
@@ -1,48 +0,0 @@-module TextBuilderDev.UTF16 where--import TextBuilderDev.Prelude-import qualified TextBuilderDev.Unicode as Unicode---- |--- A matching function, which chooses the continuation to run.-type UTF16View =-  forall x. (Word16 -> x) -> (Word16 -> Word16 -> x) -> x--{-# INLINE char #-}-char :: Char -> UTF16View-char x =-  unicodeCodePoint (ord x)--{-# INLINE unicodeCodePoint #-}-unicodeCodePoint :: Int -> UTF16View-unicodeCodePoint x case1 case2 =-  if x < 0x10000-    then case1 (fromIntegral x)-    else case2 case2Unit1 case2Unit2-  where-    m =-      x - 0x10000-    case2Unit1 =-      fromIntegral (shiftR m 10 + 0xD800)-    case2Unit2 =-      fromIntegral ((m .&. 0x3FF) + 0xDC00)--{-# INLINE utf8CodeUnits1 #-}-utf8CodeUnits1 :: Word8 -> UTF16View-utf8CodeUnits1 x case1 _ =-  case1 (fromIntegral x)--{-# INLINE utf8CodeUnits2 #-}-utf8CodeUnits2 :: Word8 -> Word8 -> UTF16View-utf8CodeUnits2 byte1 byte2 case1 _ =-  case1 (shiftL (fromIntegral byte1 - 0xC0) 6 + fromIntegral byte2 - 0x80)--{-# INLINE utf8CodeUnits3 #-}-utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> UTF16View-utf8CodeUnits3 byte1 byte2 byte3 =-  unicodeCodePoint (Unicode.utf8CodeUnits3 byte1 byte2 byte3)--{-# INLINE utf8CodeUnits4 #-}-utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> UTF16View-utf8CodeUnits4 byte1 byte2 byte3 byte4 =-  unicodeCodePoint (Unicode.utf8CodeUnits4 byte1 byte2 byte3 byte4)
− library/TextBuilderDev/UTF8.hs 
@@ -1,33 +0,0 @@-module TextBuilderDev.UTF8 where--import TextBuilderDev.Prelude---- |--- A matching function, which chooses the continuation to run.-type UTF8View =-  forall x.-  (Word8 -> x) ->-  (Word8 -> Word8 -> x) ->-  (Word8 -> Word8 -> Word8 -> x) ->-  (Word8 -> Word8 -> Word8 -> Word8 -> x) ->-  x--{-# INLINE unicodeCodePoint #-}-unicodeCodePoint :: Int -> UTF8View-unicodeCodePoint x case1 case2 case3 case4-  | x < 0x80 = case1 (fromIntegral x)-  | x < 0x800 =-      case2-        (fromIntegral $ x `shiftR` 6 .|. 0xC0)-        (fromIntegral $ (x .&. 0x3F) .|. 0x80)-  | x < 0x10000 =-      case3-        (fromIntegral $ x `shiftR` 12 .|. 0xE0)-        (fromIntegral $ (x `shiftR` 6) .&. 0x3F .|. 0x80)-        (fromIntegral $ (x .&. 0x3F) .|. 0x80)-  | otherwise =-      case4-        (fromIntegral $ x `shiftR` 18 .|. 0xF0)-        (fromIntegral $ (x `shiftR` 12) .&. 0x3F .|. 0x80)-        (fromIntegral $ (x `shiftR` 6) .&. 0x3F .|. 0x80)-        (fromIntegral $ (x .&. 0x3F) .|. 0x80)
library/TextBuilderDev/Unicode.hs view
@@ -9,7 +9,8 @@ utf8CodeUnits3 byte1 byte2 byte3 =   shiftL (fromIntegral byte1 - 0xE0) 12     + shiftL (fromIntegral byte2 - 0x80) 6-    + fromIntegral byte3 - 0x80+    + fromIntegral byte3+    - 0x80  {-# INLINE utf8CodeUnits4 #-} utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> Int@@ -17,4 +18,5 @@   shiftL (fromIntegral byte1 - 0xF0) 18     + shiftL (fromIntegral byte2 - 0x80) 12     + shiftL (fromIntegral byte3 - 0x80) 6-    + fromIntegral byte4 - 0x80+    + fromIntegral byte4+    - 0x80
+ library/TextBuilderDev/Utf16View.hs view
@@ -0,0 +1,48 @@+module TextBuilderDev.Utf16View where++import TextBuilderDev.Prelude+import qualified TextBuilderDev.Unicode as Unicode++-- |+-- A matching function, which chooses the continuation to run.+type Utf16View =+  forall x. (Word16 -> x) -> (Word16 -> Word16 -> x) -> x++{-# INLINE char #-}+char :: Char -> Utf16View+char x =+  unicodeCodePoint (ord x)++{-# INLINE unicodeCodePoint #-}+unicodeCodePoint :: Int -> Utf16View+unicodeCodePoint x case1 case2 =+  if x < 0x10000+    then case1 (fromIntegral x)+    else case2 case2Unit1 case2Unit2+  where+    m =+      x - 0x10000+    case2Unit1 =+      fromIntegral (shiftR m 10 + 0xD800)+    case2Unit2 =+      fromIntegral ((m .&. 0x3FF) + 0xDC00)++{-# INLINE utf8CodeUnits1 #-}+utf8CodeUnits1 :: Word8 -> Utf16View+utf8CodeUnits1 x case1 _ =+  case1 (fromIntegral x)++{-# INLINE utf8CodeUnits2 #-}+utf8CodeUnits2 :: Word8 -> Word8 -> Utf16View+utf8CodeUnits2 byte1 byte2 case1 _ =+  case1 (shiftL (fromIntegral byte1 - 0xC0) 6 + fromIntegral byte2 - 0x80)++{-# INLINE utf8CodeUnits3 #-}+utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> Utf16View+utf8CodeUnits3 byte1 byte2 byte3 =+  unicodeCodePoint (Unicode.utf8CodeUnits3 byte1 byte2 byte3)++{-# INLINE utf8CodeUnits4 #-}+utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> Utf16View+utf8CodeUnits4 byte1 byte2 byte3 byte4 =+  unicodeCodePoint (Unicode.utf8CodeUnits4 byte1 byte2 byte3 byte4)
+ library/TextBuilderDev/Utf8View.hs view
@@ -0,0 +1,33 @@+module TextBuilderDev.Utf8View where++import TextBuilderDev.Prelude++-- |+-- A matching function, which chooses the continuation to run.+type Utf8View =+  forall x.+  (Word8 -> x) ->+  (Word8 -> Word8 -> x) ->+  (Word8 -> Word8 -> Word8 -> x) ->+  (Word8 -> Word8 -> Word8 -> Word8 -> x) ->+  x++{-# INLINE unicodeCodePoint #-}+unicodeCodePoint :: Int -> Utf8View+unicodeCodePoint x case1 case2 case3 case4+  | x < 0x80 = case1 (fromIntegral x)+  | x < 0x800 =+      case2+        (fromIntegral $ x `shiftR` 6 .|. 0xC0)+        (fromIntegral $ (x .&. 0x3F) .|. 0x80)+  | x < 0x10000 =+      case3+        (fromIntegral $ x `shiftR` 12 .|. 0xE0)+        (fromIntegral $ (x `shiftR` 6) .&. 0x3F .|. 0x80)+        (fromIntegral $ (x .&. 0x3F) .|. 0x80)+  | otherwise =+      case4+        (fromIntegral $ x `shiftR` 18 .|. 0xF0)+        (fromIntegral $ (x `shiftR` 12) .&. 0x3F .|. 0x80)+        (fromIntegral $ (x `shiftR` 6) .&. 0x3F .|. 0x80)+        (fromIntegral $ (x .&. 0x3F) .|. 0x80)
test/Main.hs view
@@ -52,8 +52,8 @@         testProperty "Decimal" $ \(x :: Integer) ->           (fromString . show) x === (B.buildText (B.decimal x)),         testProperty "Hexadecimal vs std show" $ \(x :: Integer) ->-          x >= 0-            ==> (fromString . showHex x) "" === (B.buildText . B.hexadecimal) x,+          x >= 0 ==>+            (fromString . showHex x) "" === (B.buildText . B.hexadecimal) x,         testProperty "TextBuilderDev.null is isomorphic to Text.null" $ \(text :: Text) ->           B.null (B.toTextBuilder text) === Text.null text,         testProperty "(TextBuilderDev.unicodeCodePoint <>) is isomorphic to Text.cons" $
text-builder-dev.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0  name: text-builder-dev-version: 0.3.3+version: 0.3.3.1 category: Text synopsis: Edge of developments for "text-builder" description:@@ -22,19 +22,19 @@   type: git   location: git://github.com/nikita-volkov/text-builder-dev.git -common language-settings+common base-settings   default-extensions: BangPatterns, ConstraintKinds, CPP, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, InstanceSigs, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeApplications, TypeFamilies, TypeOperators, ViewPatterns   default-language: Haskell2010  library-  import: language-settings+  import: base-settings   hs-source-dirs: library   exposed-modules:     TextBuilderDev   other-modules:     TextBuilderDev.Unicode-    TextBuilderDev.UTF16-    TextBuilderDev.UTF8+    TextBuilderDev.Utf16View+    TextBuilderDev.Utf8View     TextBuilderDev.Prelude   build-depends:     base >=4.11 && <5,@@ -46,7 +46,7 @@     transformers >=0.5 && <0.7,  test-suite test-  import: language-settings+  import: base-settings   type: exitcode-stdio-1.0   hs-source-dirs: test   main-is: Main.hs@@ -62,8 +62,9 @@     text-builder-dev,  benchmark benchmark-text-  import: language-settings+  import: base-settings   type: exitcode-stdio-1.0+  ghc-options: -O2   hs-source-dirs: benchmark-text   main-is: Main.hs   build-depends:@@ -72,8 +73,9 @@     text-builder-dev,  benchmark benchmark-char-  import: language-settings+  import: base-settings   type: exitcode-stdio-1.0+  ghc-options: -O2   hs-source-dirs: benchmark-char   main-is: Main.hs   build-depends: