text-builder 0.5.4.3 → 0.6
raw patch · 4 files changed
+91/−40 lines, 4 filesdep +deferred-folds
Dependencies added: deferred-folds
Files
- library/Text/Builder.hs +72/−39
- library/Text/Builder/Prelude.hs +4/−0
- test/Main.hs +13/−0
- text-builder.cabal +2/−1
library/Text/Builder.hs view
@@ -1,9 +1,11 @@ module Text.Builder ( Builder,+ -- * Accessors run, length, null,+ -- * Constructors intercalate, char, text,@@ -18,10 +20,13 @@ utf8CodeUnits4, decimal, unsignedDecimal,+ thousandSeparatedDecimal,+ thousandSeparatedUnsignedDecimal, decimalDigit, hexadecimal, unsignedHexadecimal, hexadecimalDigit,+ padFromLeft, ) where @@ -32,28 +37,32 @@ 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 newtype Action = Action (forall s. B.MArray s -> Int -> ST s ()) data Builder =- Builder !Action !Int+ Builder !Action !Int !Int instance Monoid Builder where {-# INLINE mempty #-} mempty =- Builder (Action (\_ _ -> return ())) 0+ Builder (Action (\_ _ -> return ())) 0 0 {-# INLINABLE mappend #-}- mappend (Builder (Action action1) size1) (Builder (Action action2) size2) =- Builder action size+ 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 + size1)- size =- size1 + size2+ action2 array (offset + arraySize1)+ arraySize =+ arraySize1 + arraySize2+ charsAmount =+ charsAmount1 + charsAmount2 instance Semigroup Builder where (<>) = mappend@@ -61,6 +70,32 @@ instance IsString Builder where fromString = string ++-- * Accessors+-------------------------++{-# INLINE length #-}+length :: Builder -> Int+length (Builder _ _ x) = x++{-# INLINE null #-}+null :: Builder -> Bool+null = (== 0) . length++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+++-- * Constructors+-------------------------+ {-# INLINE char #-} char :: Char -> Builder char x =@@ -74,7 +109,7 @@ {-# INLINABLE utf16CodeUnits1 #-} utf16CodeUnits1 :: Word16 -> Builder utf16CodeUnits1 unit =- Builder action 1+ Builder action 1 1 where action = Action $ \array offset -> B.unsafeWrite array offset unit@@ -82,7 +117,7 @@ {-# INLINABLE utf16CodeUnits2 #-} utf16CodeUnits2 :: Word16 -> Word16 -> Builder utf16CodeUnits2 unit1 unit2 =- Builder action 2+ Builder action 2 1 where action = Action $ \array offset -> do@@ -112,8 +147,9 @@ {-# INLINABLE asciiByteString #-} asciiByteString :: ByteString -> Builder asciiByteString byteString =- Builder action (ByteString.length byteString)+ Builder action length length where+ length = ByteString.length byteString action = Action $ \array -> let step byte next index = do@@ -123,8 +159,8 @@ {-# INLINABLE text #-} text :: Text -> Builder-text (C.Text array offset length) =- Builder action length+text text@(C.Text array offset length) =+ Builder action length (Text.length text) where action = Action $ \builderArray builderOffset -> do@@ -145,17 +181,24 @@ {-# INLINABLE unsignedDecimal #-} unsignedDecimal :: Integral a => a -> Builder unsignedDecimal =- loop mempty- where- loop builder !i =- case quotRem i 10 of- (quot, !rem) ->- case hexadecimalDigit rem <> builder of- newBuilder ->- if quot /= 0- then loop newBuilder quot- else newBuilder+ foldMap decimalDigit . Unfoldr.digits +{-# INLINABLE thousandSeparatedDecimal #-}+thousandSeparatedDecimal :: Integral a => Char -> a -> Builder+thousandSeparatedDecimal separatorChar a =+ if a >= 0+ then thousandSeparatedUnsignedDecimal separatorChar a+ else unicodeCodePoint 45 <> thousandSeparatedUnsignedDecimal separatorChar (negate a)++{-# INLINABLE thousandSeparatedUnsignedDecimal #-}+thousandSeparatedUnsignedDecimal :: Integral a => Char -> a -> Builder+thousandSeparatedUnsignedDecimal separatorChar a =+ fold $ do+ (index, digit) <- Unfoldr.zipWithReverseIndex $ Unfoldr.digits a+ if mod index 3 == 0 && index /= 0+ then return (decimalDigit digit <> char separatorChar)+ else return (decimalDigit digit)+ {-# INLINE hexadecimal #-} hexadecimal :: Integral a => a -> Builder hexadecimal i =@@ -189,14 +232,6 @@ then unicodeCodePoint (fromIntegral n + 48) else unicodeCodePoint (fromIntegral n + 87) -{-# INLINE length #-}-length :: Builder -> Int-length (Builder _ x) = x--{-# INLINE null #-}-null :: Builder -> Bool-null = (== 0) . length- {-# INLINE intercalate #-} intercalate :: Foldable foldable => Builder -> foldable Builder -> Builder intercalate separator = extract . foldl' step init where@@ -206,12 +241,10 @@ else element extract (Product2 _ builder) = builder -run :: Builder -> Text-run (Builder (Action action) size) =- C.text array 0 size- where- array =- runST $ do- array <- B.new size- action array 0- B.unsafeFreeze array+{-# INLINABLE 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
library/Text/Builder/Prelude.hs view
@@ -81,4 +81,8 @@ ------------------------- import Data.Text as Exports (Text) +-- deferred-folds+-------------------------+import DeferredFolds.Unfoldr as Exports (Unfoldr(..))+ data Product2 a b = Product2 !a !b
test/Main.hs view
@@ -57,6 +57,19 @@ 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 "Hexadecimal" $ assertEqual "" "1f23" (B.run (B.hexadecimal 0x01f23)) ,
text-builder.cabal view
@@ -1,5 +1,5 @@ name: text-builder-version: 0.5.4.3+version: 0.6 category: Text synopsis: An efficient strict text builder homepage: https://github.com/nikita-volkov/text-builder@@ -25,6 +25,7 @@ base >=4.9 && <5, base-prelude <2, bytestring >=0.10 && <0.11,+ deferred-folds >=0.8 && <0.9, semigroups >=0.18 && <0.19, text >=1 && <2