text-builder-dev 0.2.1 → 0.3
raw patch · 7 files changed
+218/−47 lines, 7 filesdep −text-conversionsdep −tostringdep ~text
Dependencies removed: text-conversions, tostring
Dependency ranges changed: text
Files
- library/TextBuilderDev.hs +103/−20
- library/TextBuilderDev/Prelude.hs +0/−2
- library/TextBuilderDev/UTF16.hs +5/−15
- library/TextBuilderDev/UTF8.hs +33/−0
- library/TextBuilderDev/Unicode.hs +20/−0
- test/Main.hs +52/−5
- text-builder-dev.cabal +5/−5
library/TextBuilderDev.hs view
@@ -12,10 +12,10 @@ putLnToStdOut, putLnToStdErr, - -- * Constructors+ -- * Classes+ IsomorphicToTextBuilder (..), - -- ** Helper class- ToTextBuilder (..),+ -- * Constructors -- ** Builder manipulators force,@@ -82,27 +82,64 @@ import qualified Data.Text.Internal as C 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 Data.Text.Lazy as TextLazy+import qualified Data.Text.Lazy.Builder as TextLazyBuilder -- * -- |--- Default conversion to text builder.-class ToTextBuilder a where+-- Evidence that there exists an unambiguous way to convert+-- a type to and from "TextBuilder".+--+-- Unlike typical conversion classes this class is lawful.+-- The law is:+--+-- @a == "fromTextBuilder" ("toTextBuilder" a)@+--+-- This class does not provide implicit rendering,+-- such as from integer to its decimal representation.+-- It should already be evident that there is multiple ways of+-- how an integer can be represented in a textual form (e.g., hexadecimal).+-- The non-ambiguity is further enforced by the presence of+-- the inverse conversion.+-- In the integer case there is no way to read it+-- from a textual form without a possibility of failing.+-- So that is enough to prove that it's not sufficient.+--+-- If you're looking for such conversion classes,+-- this library is not a place for them,+-- since there can be infinite amount of flavours of+-- conversions. IOW, they are context-dependent and as such+-- should be defined as part of the domain.+class IsomorphicToTextBuilder a where toTextBuilder :: a -> TextBuilder+ fromTextBuilder :: TextBuilder -> a -instance ToTextBuilder TextBuilder where+instance IsomorphicToTextBuilder TextBuilder where toTextBuilder = id+ fromTextBuilder = id -instance ToTextBuilder Text where+instance IsomorphicToTextBuilder Text where toTextBuilder = text+ fromTextBuilder = buildText -instance ToTextBuilder String where+instance IsomorphicToTextBuilder String where toTextBuilder = fromString+ fromTextBuilder = Text.unpack . buildText -instance ToTextBuilder Char where- toTextBuilder = char+instance IsomorphicToTextBuilder TextLazy.Text where+ toTextBuilder = text . TextLazy.toStrict+ fromTextBuilder = TextLazy.fromStrict . buildText +instance IsomorphicToTextBuilder TextLazyBuilder.Builder where+ toTextBuilder = text . TextLazy.toStrict . TextLazyBuilder.toLazyText+ fromTextBuilder = TextLazyBuilder.fromText . buildText+ -- * -- |@@ -138,15 +175,6 @@ instance Show TextBuilder where show = Text.unpack . buildText -instance FromText TextBuilder where- fromText = text--instance ToText TextBuilder where- toText = buildText--instance ToString TextBuilder where- toString = toString . buildText- -- * Accessors -- | Get the amount of characters@@ -198,7 +226,7 @@ -- since it's virtually a single call @memcopy@. {-# INLINE force #-} force :: TextBuilder -> TextBuilder-force = text . toText+force = text . buildText -- | Unicode character {-# INLINE char #-}@@ -206,10 +234,59 @@ char x = unicodeCodePoint (ord x) +#if MIN_VERSION_text(2,0,0)+ -- | Unicode code point {-# INLINE unicodeCodePoint #-} unicodeCodePoint :: Int -> TextBuilder unicodeCodePoint x =+ D.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++{-# 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++{-# 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++{-# 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++{-# INLINE utf16CodeUnits1 #-}+utf16CodeUnits1 :: Word16 -> TextBuilder+utf16CodeUnits1 = unicodeCodePoint . fromIntegral++{-# INLINE utf16CodeUnits2 #-}+utf16CodeUnits2 :: Word16 -> Word16 -> TextBuilder+utf16CodeUnits2 unit1 unit2 = unicodeCodePoint cp+ where+ cp = (((fromIntegral unit1 .&. 0x3FF) `shiftL` 10) .|. (fromIntegral unit2 .&. 0x3FF)) + 0x10000++#else++-- | Unicode code point+{-# INLINE unicodeCodePoint #-}+unicodeCodePoint :: Int -> TextBuilder+unicodeCodePoint x = D.unicodeCodePoint x utf16CodeUnits1 utf16CodeUnits2 -- | Single code-unit UTF-16 character@@ -256,6 +333,8 @@ utf8CodeUnits4 unit1 unit2 unit3 unit4 = D.utf8CodeUnits4 unit1 unit2 unit3 unit4 utf16CodeUnits1 utf16CodeUnits2 +#endif+ -- | ASCII byte string {-# INLINEABLE asciiByteString #-} asciiByteString :: ByteString -> TextBuilder@@ -278,7 +357,11 @@ where action = Action $ \builderArray builderOffset -> do+#if MIN_VERSION_text(2,0,0)+ B.copyI length builderArray builderOffset array offset+#else B.copyI builderArray builderOffset array offset (builderOffset + length)+#endif -- | String {-# INLINE string #-}
library/TextBuilderDev/Prelude.hs view
@@ -44,9 +44,7 @@ import Data.STRef as Exports import Data.Semigroup as Exports import Data.String as Exports-import Data.String.ToString as Exports import Data.Text as Exports (Text)-import Data.Text.Conversions as Exports import Data.Traversable as Exports import Data.Tuple as Exports import Data.Unique as Exports
library/TextBuilderDev/UTF16.hs view
@@ -1,6 +1,7 @@ module TextBuilderDev.UTF16 where import TextBuilderDev.Prelude+import qualified TextBuilderDev.Unicode as Unicode -- | -- A matching function, which chooses the continuation to run.@@ -38,21 +39,10 @@ {-# INLINE utf8CodeUnits3 #-} utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> UTF16View-utf8CodeUnits3 byte1 byte2 byte3 case1 case2 =- unicodeCodePoint unicode case1 case2- where- unicode =- shiftL (fromIntegral byte1 - 0xE0) 12- + shiftL (fromIntegral byte2 - 0x80) 6- + fromIntegral byte3 - 0x80+utf8CodeUnits3 byte1 byte2 byte3 =+ unicodeCodePoint (Unicode.utf8CodeUnits3 byte1 byte2 byte3) {-# INLINE utf8CodeUnits4 #-} utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> UTF16View-utf8CodeUnits4 byte1 byte2 byte3 byte4 case1 case2 =- unicodeCodePoint unicode case1 case2- where- unicode =- shiftL (fromIntegral byte1 - 0xE0) 18- + shiftL (fromIntegral byte2 - 0x80) 12- + shiftL (fromIntegral byte3 - 0x80) 6- + fromIntegral byte4 - 0x80+utf8CodeUnits4 byte1 byte2 byte3 byte4 =+ unicodeCodePoint (Unicode.utf8CodeUnits4 byte1 byte2 byte3 byte4)
+ library/TextBuilderDev/UTF8.hs view
@@ -0,0 +1,33 @@+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
@@ -0,0 +1,20 @@+-- |+-- Utilities for construction of Unicode codepoints.+module TextBuilderDev.Unicode where++import TextBuilderDev.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
test/Main.hs view
@@ -1,12 +1,13 @@ module Main where import qualified Data.ByteString as ByteString-import qualified Data.Text as A+import qualified Data.Char as Char+import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import Test.QuickCheck.Instances import Test.Tasty import Test.Tasty.HUnit-import Test.Tasty.QuickCheck+import Test.Tasty.QuickCheck hiding ((.&.)) import qualified TextBuilderDev as B import Prelude hiding (choose) @@ -22,11 +23,11 @@ === Text.encodeUtf8 (B.buildText (foldMap B.asciiByteString chunks)), testProperty "Intercalation has the same effect as in Text" $ \separator texts ->- A.intercalate separator texts+ Text.intercalate separator texts === B.buildText (B.intercalate (B.text separator) (fmap B.text texts)), testProperty "Packing a list of chars is isomorphic to appending a list of builders" $ \chars ->- A.pack chars+ Text.pack chars === B.buildText (foldMap B.char chars), testProperty "Concatting a list of texts is isomorphic to fold-mapping with builders" $ \texts ->@@ -38,7 +39,7 @@ === B.buildText (mconcat (map B.text texts)), testProperty "Concatting a list of trimmed texts is isomorphic to concatting a list of builders" $ \texts ->- let trimmedTexts = fmap (A.drop 3) texts+ let trimmedTexts = fmap (Text.drop 3) texts in mconcat trimmedTexts === B.buildText (mconcat (map B.text trimmedTexts)), testProperty "Decimal" $ \(x :: Integer) ->@@ -46,6 +47,50 @@ testProperty "Hexadecimal vs std show" $ \(x :: Integer) -> 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" $+ withMaxSuccess bigTest $ \(text :: Text) (c :: Char) ->+ B.buildText (B.unicodeCodePoint (Char.ord c) <> B.text text) === Text.cons c text,+ testProperty "(TextBuilderDev.utf8CodeUnitsN <>) is isomorphic to Text.cons" $+ withMaxSuccess bigTest $ \(text :: Text) (c :: Char) ->+ let cp = Char.ord c+ cuBuilder+ | cp < 0x80 = B.utf8CodeUnits1 (cuAt 0)+ | cp < 0x800 = B.utf8CodeUnits2 (cuAt 0) (cuAt 1)+ | cp < 0x10000 = B.utf8CodeUnits3 (cuAt 0) (cuAt 1) (cuAt 2)+ | otherwise = B.utf8CodeUnits4 (cuAt 0) (cuAt 1) (cuAt 2) (cuAt 3)+ where+ -- Use Data.Text.Encoding for comparison+ codeUnits = Text.encodeUtf8 $ Text.singleton c+ cuAt = (codeUnits `ByteString.index`)+ in B.buildText (cuBuilder <> B.text text) === Text.cons c text,+ testProperty "TextBuilderDev.utf8CodeUnitsN is isomorphic to Text.singleton" $+ withMaxSuccess bigTest $ \(c :: Char) ->+ let text = Text.singleton c+ codeUnits = Text.encodeUtf8 text+ cp = Char.ord c+ cuBuilder+ | cp < 0x80 = B.utf8CodeUnits1 (cuAt 0)+ | cp < 0x800 = B.utf8CodeUnits2 (cuAt 0) (cuAt 1)+ | cp < 0x10000 = B.utf8CodeUnits3 (cuAt 0) (cuAt 1) (cuAt 2)+ | otherwise = B.utf8CodeUnits4 (cuAt 0) (cuAt 1) (cuAt 2) (cuAt 3)+ where+ cuAt = ByteString.index codeUnits+ in B.buildText cuBuilder === text,+ testProperty "(TextBuilderDev.utf16CodeUnitsN <>) is isomorphic to Text.cons" $+ withMaxSuccess bigTest $ \(text :: Text) (c :: Char) ->+ let cp = Char.ord c+ cuBuilder+ | cp < 0x10000 = B.utf16CodeUnits1 (cuAt 0)+ | otherwise = B.utf16CodeUnits2 (cuAt 0) (cuAt 1)+ where+ -- Use Data.Text.Encoding for comparison+ codeUnits = Text.encodeUtf16LE $ Text.singleton c+ cuAt i =+ (fromIntegral $ codeUnits `ByteString.index` (2 * i))+ .|. ((fromIntegral $ codeUnits `ByteString.index` (2 * i + 1)) `shiftL` 8)+ in B.buildText (cuBuilder <> B.text text) === Text.cons c text, testCase "Separated thousands" $ do assertEqual "" "0" (B.buildText (B.thousandSeparatedUnsignedDecimal ',' 0)) assertEqual "" "123" (B.buildText (B.thousandSeparatedUnsignedDecimal ',' 123))@@ -91,3 +136,5 @@ testCase "doublePercent" $ do assertEqual "" "90.4%" (B.buildText (B.doublePercent 1 0.904)) ]+ where+ bigTest = 10000
text-builder-dev.cabal view
@@ -1,7 +1,7 @@ cabal-version: 3.0 name: text-builder-dev-version: 0.2.1+version: 0.3 category: Text synopsis: Edge of developments for "text-builder" description:@@ -23,7 +23,7 @@ location: git://github.com/nikita-volkov/text-builder-dev.git common language-settings- default-extensions: BangPatterns, ConstraintKinds, 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-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@@ -32,16 +32,16 @@ exposed-modules: TextBuilderDev other-modules:+ TextBuilderDev.Unicode TextBuilderDev.UTF16+ TextBuilderDev.UTF8 TextBuilderDev.Prelude build-depends: base >=4.11 && <5, bytestring >=0.10 && <0.12, deferred-folds >=0.9.10.1 && <0.10, split >=0.2.3.4 && <0.3,- text >=1 && <2,- text-conversions >=0.3.1 && <0.4,- tostring >=0.2.1.1 && <0.3,+ text >=1.0 && <3, transformers >=0.5 && <0.7, test-suite test