text-builder (empty) → 0.4

raw patch · 9 files changed

+506/−0 lines, 9 filesdep +basedep +base-preludedep +bytestringsetup-changed

Dependencies added: base, base-prelude, bytestring, criterion, quickcheck-instances, rerebase, semigroups, tasty, tasty-hunit, tasty-quickcheck, tasty-smallcheck, text, text-builder

Files

• LICENSE +22/−0
• Setup.hs +2/−0
• char-benchmark/Main.hs +65/−0
• library/Text/Builder.hs +129/−0
• library/Text/Builder/Prelude.hs +22/−0
• library/Text/Builder/UTF16.hs +61/−0
• tests/Main.hs +25/−0
• text-benchmark/Main.hs +58/−0
• text-builder.cabal +122/−0

@@ -0,0 +1,22 @@+Copyright (c) 2015, 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.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -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)+

@@ -0,0 +1,129 @@+module Text.Builder+(+  Builder,+  run,+  char,+  text,+  string,+  utf16CodeUnits1,+  utf16CodeUnits2,+  utf8CodeUnits1,+  utf8CodeUnits2,+  utf8CodeUnits3,+  utf8CodeUnits4,+)+where++import Text.Builder.Prelude+import qualified Data.Text.Array as B+import qualified Data.Text.Internal as C+import qualified Text.Builder.UTF16 as D+++newtype Action =+  Action (forall s. B.MArray s -> Int -> ST s ())++data Builder =+  Builder !Action !Int++instance Monoid Builder where+  {-# INLINE mempty #-}+  mempty =+    Builder (Action (\_ _ -> return ())) 0+  {-# INLINABLE mappend #-}+  mappend (Builder (Action action1) size1) (Builder (Action action2) size2) =+    Builder action size+    where+      action =+        Action $ \array offset -> do+          action1 array offset+          action2 array (offset + size1)+      size =+        size1 + size2+  {-# INLINE mconcat #-}+  mconcat list =+    Builder action size+    where+      action =+        Action $ \array offset -> foldlM (step array) offset list $> ()+        where+          step array offset (Builder (Action action) size) =+            action array offset $> offset + size+      size =+        sum (map (\(Builder _ x) -> x) list)++instance Semigroup Builder++{-# INLINE char #-}+char :: Char -> Builder+char x =+  unicodeCodePoint (ord x)++{-# INLINE unicodeCodePoint #-}+unicodeCodePoint :: Int -> Builder+unicodeCodePoint x =+  D.unicodeCodePoint x utf16CodeUnits1 utf16CodeUnits2++{-# INLINABLE utf16CodeUnits1 #-}+utf16CodeUnits1 :: Word16 -> Builder+utf16CodeUnits1 unit =+  Builder action 1+  where+    action =+      Action $ \array offset -> B.unsafeWrite array offset unit++{-# INLINABLE utf16CodeUnits2 #-}+utf16CodeUnits2 :: Word16 -> Word16 -> Builder+utf16CodeUnits2 unit1 unit2 =+  Builder action 2+  where+    action =+      Action $ \array offset -> do+        B.unsafeWrite array offset unit1+        B.unsafeWrite array (succ offset) unit2++{-# INLINE utf8CodeUnits1 #-}+utf8CodeUnits1 :: Word8 -> Builder+utf8CodeUnits1 unit1 =+  D.utf8CodeUnits1 unit1 utf16CodeUnits1 utf16CodeUnits2++{-# INLINE utf8CodeUnits2 #-}+utf8CodeUnits2 :: Word8 -> Word8 -> Builder+utf8CodeUnits2 unit1 unit2 =+  D.utf8CodeUnits2 unit1 unit2 utf16CodeUnits1 utf16CodeUnits2++{-# INLINE utf8CodeUnits3 #-}+utf8CodeUnits3 :: Word8 -> Word8 -> Word8 -> Builder+utf8CodeUnits3 unit1 unit2 unit3 =+  D.utf8CodeUnits3 unit1 unit2 unit3 utf16CodeUnits1 utf16CodeUnits2++{-# INLINE utf8CodeUnits4 #-}+utf8CodeUnits4 :: Word8 -> Word8 -> Word8 -> Word8 -> Builder+utf8CodeUnits4 unit1 unit2 unit3 unit4 =+  D.utf8CodeUnits4 unit1 unit2 unit3 unit4 utf16CodeUnits1 utf16CodeUnits2++{-# INLINABLE text #-}+text :: Text -> Builder+text (C.Text array offset length) =+  Builder action actualLength+  where+    action =+      Action $ \builderArray builderOffset -> do+        B.copyI builderArray builderOffset array offset (builderOffset + actualLength)+    actualLength =+      length - offset++{-# INLINE string #-}+string :: String -> Builder+string =+  foldMap char++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

@@ -0,0 +1,22 @@+module Text.Builder.Prelude+( +  module Exports,+)+where+++-- base-prelude+-------------------------+import BasePrelude as Exports hiding (assert, left, right, isLeft, isRight, error, First(..), Last(..), (<>))++-- semigroup+-------------------------+import Data.Semigroup as Exports++-- bytestring+-------------------------+import Data.ByteString as Exports (ByteString)++-- text+-------------------------+import Data.Text as Exports (Text)

@@ -0,0 +1,61 @@+module Text.Builder.UTF16+where++import Text.Builder.Prelude+++{-|+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 =+  unicodeCodePoint . ord++{-# 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 case1 case2 =+  unicodeCodePoint unicode case1 case2+  where+    unicode =+      shiftL (fromIntegral byte1 - 0xE0) 12 ++      shiftL (fromIntegral byte2 - 0x80) 6 ++      fromIntegral byte3 - 0x80++{-# 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

@@ -0,0 +1,25 @@+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 concatting a list of builders" $+    \texts ->+      mconcat texts ===+      B.run (foldMap B.text texts)+  ]

@@ -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 "漢"+

@@ -0,0 +1,122 @@+name:+  text-builder+version:+  0.4+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 <nikita.y.volkov@mail.ru>+maintainer:+  Nikita Volkov <nikita.y.volkov@mail.ru>+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++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+  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++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+  build-depends:+    text-builder,+    -- testing:+    tasty == 0.11.*,+    tasty-quickcheck == 0.8.*,+    tasty-smallcheck == 0.8.*,+    tasty-hunit == 0.9.*,+    quickcheck-instances >= 0.3.11 && < 0.4,+    -- general:+    rerebase == 1.*++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+  build-depends:+    -- +    text-builder,+    -- benchmarking:+    criterion == 1.1.*,+    -- general:+    rerebase == 1.*++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+  build-depends:+    -- +    text-builder,+    -- benchmarking:+    criterion == 1.1.*,+    -- general:+    rerebase == 1.*