diff --git a/benchmark-char/Main.hs b/benchmark-char/Main.hs new file mode 100644 --- /dev/null +++ b/benchmark-char/Main.hs @@ -0,0 +1,65 @@ +module Main where + +import Prelude +import Criterion.Main +import qualified Text.Builder as A +import qualified Data.Text.Lazy.Builder as B +import qualified Data.Text.Lazy as C +import qualified Data.Text as D + + +main = + defaultMain $ + [ + subjectBenchmark "builderSubject" builderSubject + , + subjectBenchmark "lazyTextBuilderSubject" lazyTextBuilderSubject + , + subjectBenchmark "plainTextPackingSubject" plainTextPackingSubject + ] + +subjectBenchmark :: String -> Subject -> Benchmark +subjectBenchmark title subject = + bgroup title $ + [ + benchmark "Small input" smallInput subject + , + benchmark "Medium input" mediumInput subject + , + benchmark "Large input" largeInput subject + ] + +benchmark :: String -> [Int] -> Subject -> Benchmark +benchmark title input subject = + bench title $ nf subject $ input + +type Subject = + [Int] -> Text + +builderSubject :: Subject +builderSubject = + A.run . A.string . map chr + +lazyTextBuilderSubject :: Subject +lazyTextBuilderSubject = + C.toStrict . B.toLazyText . B.fromString . map chr + +plainTextPackingSubject :: Subject +plainTextPackingSubject = + D.pack . map chr + +{-# NOINLINE smallInput #-} +smallInput :: [Int] +smallInput = + map ord ['a', 'b', 'Ф', '漢', chr 0x11000] + +{-# NOINLINE mediumInput #-} +mediumInput :: [Int] +mediumInput = + mconcat (replicate 1000 smallInput) + +{-# NOINLINE largeInput #-} +largeInput :: [Int] +largeInput = + mconcat (replicate 100000 smallInput) + diff --git a/benchmark-text/Main.hs b/benchmark-text/Main.hs new file mode 100644 --- /dev/null +++ b/benchmark-text/Main.hs @@ -0,0 +1,58 @@ +module Main where + +import Prelude +import Criterion.Main +import qualified Text.Builder as A +import qualified Data.Text.Lazy.Builder as B +import qualified Data.Text.Lazy as C +import qualified Data.Text as D + + +main = + defaultMain $ + [ + subjectBenchmark "builderSubject" builderSubject + , + subjectBenchmark "lazyTextBuilderSubject" lazyTextBuilderSubject + ] + +subjectBenchmark :: String -> Subject -> Benchmark +subjectBenchmark title subject = + bgroup title $ + [ + benchmark "Small input" smallSample subject + , + benchmark "Large input" largeSample subject + ] + +benchmark :: String -> Sample -> Subject -> Benchmark +benchmark title sample subject = + bench title $ nf sample $ subject + +data Subject = + forall a. Subject (Text -> a) (a -> a -> a) a (a -> Text) + +type Sample = + Subject -> Text + +builderSubject :: Subject +builderSubject = + Subject A.text mappend mempty A.run + +lazyTextBuilderSubject :: Subject +lazyTextBuilderSubject = + Subject B.fromText mappend mempty (C.toStrict . B.toLazyText) + +{-# NOINLINE smallSample #-} +smallSample :: Sample +smallSample (Subject text (<>) mempty run) = + run $ + text "abcd" <> (text "ABCD" <> text "Фываолдж") <> text "漢" + +{-# NOINLINE largeSample #-} +largeSample :: Sample +largeSample (Subject text (<>) mempty run) = + run $ + foldl' (<>) mempty $ replicate 100000 $ + text "abcd" <> (text "ABCD" <> text "Фываолдж") <> text "漢" + diff --git a/char-benchmark/Main.hs b/char-benchmark/Main.hs deleted file mode 100644 --- a/char-benchmark/Main.hs +++ /dev/null @@ -1,65 +0,0 @@ -module Main where - -import Prelude -import Criterion.Main -import qualified Text.Builder as A -import qualified Data.Text.Lazy.Builder as B -import qualified Data.Text.Lazy as C -import qualified Data.Text as D - - -main = - defaultMain $ - [ - subjectBenchmark "builderSubject" builderSubject - , - subjectBenchmark "lazyTextBuilderSubject" lazyTextBuilderSubject - , - subjectBenchmark "plainTextPackingSubject" plainTextPackingSubject - ] - -subjectBenchmark :: String -> Subject -> Benchmark -subjectBenchmark title subject = - bgroup title $ - [ - benchmark "Small input" smallInput subject - , - benchmark "Medium input" mediumInput subject - , - benchmark "Large input" largeInput subject - ] - -benchmark :: String -> [Int] -> Subject -> Benchmark -benchmark title input subject = - bench title $ nf subject $ input - -type Subject = - [Int] -> Text - -builderSubject :: Subject -builderSubject = - A.run . A.string . map chr - -lazyTextBuilderSubject :: Subject -lazyTextBuilderSubject = - C.toStrict . B.toLazyText . B.fromString . map chr - -plainTextPackingSubject :: Subject -plainTextPackingSubject = - D.pack . map chr - -{-# NOINLINE smallInput #-} -smallInput :: [Int] -smallInput = - map ord ['a', 'b', 'Ф', '漢', chr 0x11000] - -{-# NOINLINE mediumInput #-} -mediumInput :: [Int] -mediumInput = - mconcat (replicate 1000 smallInput) - -{-# NOINLINE largeInput #-} -largeInput :: [Int] -largeInput = - mconcat (replicate 100000 smallInput) - diff --git a/library/Text/Builder.hs b/library/Text/Builder.hs --- a/library/Text/Builder.hs +++ b/library/Text/Builder.hs @@ -4,6 +4,7 @@ run, length, null, + intercalate, char, text, string, @@ -23,7 +24,7 @@ ) where -import Text.Builder.Prelude hiding (length, null) +import Text.Builder.Prelude hiding (length, null, intercalate) import qualified Data.Text.Array as B import qualified Data.Text.Internal as C import qualified Data.Text.Encoding as E @@ -178,6 +179,13 @@ {-# INLINE null #-} null :: Builder -> Bool null = (== 0) . length + +{-# INLINE intercalate #-} +intercalate :: Foldable foldable => Builder -> foldable Builder -> Builder +intercalate separator = foldl' step mempty where + step builder element = if null builder + then element + else builder <> separator <> element run :: Builder -> Text run (Builder (Action action) size) = diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,55 @@ +module Main where + +import Prelude +import Test.QuickCheck.Instances +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck +import qualified Data.Text as A +import qualified Text.Builder as B + + +main = + defaultMain $ + testGroup "All tests" $ + [ + testProperty "Intercalation has the same effect as in Text" $ + \ separator texts -> + A.intercalate separator texts === + B.run (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 === + B.run (foldMap B.char chars) + , + testProperty "Concatting a list of texts is isomorphic to fold-mapping with builders" $ + \ texts -> + mconcat texts === + B.run (foldMap B.text texts) + , + testProperty "Concatting a list of texts is isomorphic to concatting a list of builders" $ + \ texts -> + mconcat texts === + B.run (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 + in + mconcat trimmedTexts === + B.run (mconcat (map B.text trimmedTexts)) + , + testProperty "Decimal" $ \ (x :: Integer) -> + (fromString . show) x === (B.run (B.decimal x)) + , + testProperty "Hexadecimal vs std show" $ \ (x :: Integer) -> x >= 0 ==> + (fromString . showHex x) "" === (B.run . B.hexadecimal) x + , + testCase "Hexadecimal" $ + assertEqual "" "1f23" (B.run (B.hexadecimal 0x01f23)) + , + testCase "Negative Hexadecimal" $ + assertEqual "" "-1f23" (B.run (B.hexadecimal (-0x01f23))) + ] diff --git a/tests/Main.hs b/tests/Main.hs deleted file mode 100644 --- a/tests/Main.hs +++ /dev/null @@ -1,50 +0,0 @@ -module Main where - -import Prelude -import Test.QuickCheck.Instances -import Test.Tasty -import Test.Tasty.HUnit -import Test.Tasty.QuickCheck -import qualified Data.Text as A -import qualified Text.Builder as B - - -main = - defaultMain $ - testGroup "All tests" $ - [ - testProperty "Packing a list of chars is isomorphic to appending a list of builders" $ - \ chars -> - A.pack chars === - B.run (foldMap B.char chars) - , - testProperty "Concatting a list of texts is isomorphic to fold-mapping with builders" $ - \ texts -> - mconcat texts === - B.run (foldMap B.text texts) - , - testProperty "Concatting a list of texts is isomorphic to concatting a list of builders" $ - \ texts -> - mconcat texts === - B.run (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 - in - mconcat trimmedTexts === - B.run (mconcat (map B.text trimmedTexts)) - , - testProperty "Decimal" $ \ (x :: Integer) -> - (fromString . show) x === (B.run (B.decimal x)) - , - testProperty "Hexadecimal vs std show" $ \ (x :: Integer) -> x >= 0 ==> - (fromString . showHex x) "" === (B.run . B.hexadecimal) x - , - testCase "Hexadecimal" $ - assertEqual "" "1f23" (B.run (B.hexadecimal 0x01f23)) - , - testCase "Negative Hexadecimal" $ - assertEqual "" "-1f23" (B.run (B.hexadecimal (-0x01f23))) - ] diff --git a/text-benchmark/Main.hs b/text-benchmark/Main.hs deleted file mode 100644 --- a/text-benchmark/Main.hs +++ /dev/null @@ -1,58 +0,0 @@ -module Main where - -import Prelude -import Criterion.Main -import qualified Text.Builder as A -import qualified Data.Text.Lazy.Builder as B -import qualified Data.Text.Lazy as C -import qualified Data.Text as D - - -main = - defaultMain $ - [ - subjectBenchmark "builderSubject" builderSubject - , - subjectBenchmark "lazyTextBuilderSubject" lazyTextBuilderSubject - ] - -subjectBenchmark :: String -> Subject -> Benchmark -subjectBenchmark title subject = - bgroup title $ - [ - benchmark "Small input" smallSample subject - , - benchmark "Large input" largeSample subject - ] - -benchmark :: String -> Sample -> Subject -> Benchmark -benchmark title sample subject = - bench title $ nf sample $ subject - -data Subject = - forall a. Subject (Text -> a) (a -> a -> a) a (a -> Text) - -type Sample = - Subject -> Text - -builderSubject :: Subject -builderSubject = - Subject A.text mappend mempty A.run - -lazyTextBuilderSubject :: Subject -lazyTextBuilderSubject = - Subject B.fromText mappend mempty (C.toStrict . B.toLazyText) - -{-# NOINLINE smallSample #-} -smallSample :: Sample -smallSample (Subject text (<>) mempty run) = - run $ - text "abcd" <> (text "ABCD" <> text "Фываолдж") <> text "漢" - -{-# NOINLINE largeSample #-} -largeSample :: Sample -largeSample (Subject text (<>) mempty run) = - run $ - foldl' (<>) mempty $ replicate 100000 $ - text "abcd" <> (text "ABCD" <> text "Фываолдж") <> text "漢" - diff --git a/text-builder.cabal b/text-builder.cabal --- a/text-builder.cabal +++ b/text-builder.cabal @@ -1,122 +1,68 @@ -name: - text-builder -version: - 0.5.1.1 -category: - Text -synopsis: - An efficient strict text builder -homepage: - https://github.com/nikita-volkov/text-builder -bug-reports: - https://github.com/nikita-volkov/text-builder/issues -author: - Nikita Volkov -maintainer: - Nikita Volkov -copyright: - (c) 2017, Nikita Volkov -license: - MIT -license-file: - LICENSE -build-type: - Simple -cabal-version: - >=1.10 - -source-repository head - type: - git - location: - git://github.com/nikita-volkov/text-builder.git +name: text-builder +version: 0.5.2 +category: Text +synopsis: An efficient strict text builder +homepage: https://github.com/nikita-volkov/text-builder +bug-reports: https://github.com/nikita-volkov/text-builder/issues +author: Nikita Volkov +maintainer: Nikita Volkov +copyright: (c) 2017, Nikita Volkov +license: MIT +license-file: LICENSE +build-type: Simple +cabal-version: >=1.10 library - hs-source-dirs: - library - ghc-options: - default-extensions: - Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples - default-language: - Haskell2010 + hs-source-dirs: library + default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples + default-language: Haskell2010 exposed-modules: Text.Builder other-modules: Text.Builder.UTF16 Text.Builder.Prelude build-depends: - semigroups >= 0.18 && < 0.19, - bytestring >= 0.10 && < 0.11, - text >= 1 && < 2, - base-prelude < 2, - base >= 4.6 && < 5 + base >=4.6 && <5, + base-prelude <2, + bytestring >=0.10 && <0.11, + semigroups >=0.18 && <0.19, + text >=1 && <2 -test-suite tests - type: - exitcode-stdio-1.0 - hs-source-dirs: - tests - main-is: - Main.hs - default-extensions: - Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples - default-language: - Haskell2010 +test-suite test + type: exitcode-stdio-1.0 + hs-source-dirs: test + default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples + default-language: Haskell2010 + main-is: Main.hs build-depends: - text-builder, - -- testing: - tasty >=0.12 && <0.13, - tasty-quickcheck >=0.9 && <0.10, - tasty-hunit >=0.9 && <0.10, - quickcheck-instances >=0.3.11 && <0.4, QuickCheck >=2.8.1 && <3, - -- general: - rerebase == 1.* + quickcheck-instances >=0.3.11 && <0.4, + rerebase <2, + tasty >=0.12 && <2, + tasty-hunit >=0.9 && <0.11, + tasty-quickcheck >=0.9 && <0.11, + text-builder -benchmark text-benchmark - type: - exitcode-stdio-1.0 - hs-source-dirs: - text-benchmark - main-is: - Main.hs - ghc-options: - -O2 - -threaded - "-with-rtsopts=-N" - -funbox-strict-fields - default-extensions: - Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveTraversable, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples - default-language: - Haskell2010 +benchmark benchmark-text + type: exitcode-stdio-1.0 + hs-source-dirs: benchmark-text + default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveTraversable, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples + default-language: Haskell2010 + ghc-options: -O2 -threaded "-with-rtsopts=-N" -funbox-strict-fields + main-is: Main.hs build-depends: - -- - text-builder, - -- benchmarking: - criterion >= 1.1 && < 1.5, - -- general: - rerebase == 1.* + criterion >=1.1 && <2, + rerebase ==1.*, + text-builder -benchmark char-benchmark - type: - exitcode-stdio-1.0 - hs-source-dirs: - char-benchmark - main-is: - Main.hs - ghc-options: - -O2 - -threaded - "-with-rtsopts=-N" - -funbox-strict-fields - default-extensions: - Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveTraversable, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples - default-language: - Haskell2010 +benchmark benchmark-char + type: exitcode-stdio-1.0 + hs-source-dirs: benchmark-char + default-extensions: Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveTraversable, DeriveGeneric, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples + default-language: Haskell2010 + ghc-options: -O2 -threaded "-with-rtsopts=-N" -funbox-strict-fields + main-is: Main.hs build-depends: - -- - text-builder, - -- benchmarking: - criterion >= 1.1 && < 1.5, - -- general: - rerebase == 1.* + criterion >=1.1 && <2, + rerebase ==1.*, + text-builder