array-builder 0.1.4.0 → 0.1.4.1
raw patch · 11 files changed
+396/−332 lines, 11 filesdep ~bytebuilddep ~byteslicedep ~bytestringsetup-changednew-uploaderPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: bytebuild, byteslice, bytestring, natural-arithmetic, text-short
API changes (from Hackage documentation)
- Data.Builder.Catenable: instance GHC.Exts.IsList (Data.Builder.Catenable.Builder a)
+ Data.Builder.Catenable: instance GHC.IsList.IsList (Data.Builder.Catenable.Builder a)
Files
- CHANGELOG.md +4/−0
- Setup.hs +0/−2
- array-builder.cabal +40/−31
- src-post-8.9/Compat.hs +20/−20
- src-pre-8.9/Compat.hs +13/−13
- src/Data/Builder.hs +115/−98
- src/Data/Builder/Catenable.hs +42/−38
- src/Data/Builder/Catenable/Bytes.hs +17/−12
- src/Data/Builder/Catenable/Text.hs +29/−22
- src/Data/Builder/ST.hs +47/−40
- test/Main.hs +69/−56
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for array-builder +## 0.1.4.1 -- 2024-02-01++* Update package metadata.+ ## 0.1.4.0 -- 2023-08-30 * Add `constructN` functions to Data.Builder.Catenable.Bytes.
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
array-builder.cabal view
@@ -1,16 +1,17 @@-cabal-version: 2.2-name: array-builder-version: 0.1.4.0-synopsis: Builders for arrays-homepage: https://github.com/andrewthad/array-builder-bug-reports: https://github.com/andrewthad/array-builder/issues-license: BSD-3-Clause-license-file: LICENSE-author: Andrew Martin-maintainer: andrew.thaddeus@gmail.com-copyright: 2019 Andrew Martin-category: Data-extra-source-files: CHANGELOG.md+cabal-version: 2.2+name: array-builder+version: 0.1.4.1+synopsis: Builders for arrays+description: Builders for arrays.+homepage: https://github.com/byteverse/array-builder+bug-reports: https://github.com/byteverse/array-builder/issues+license: BSD-3-Clause+license-file: LICENSE+author: Andrew Martin+maintainer: amartin@layer3com.com+copyright: 2019 Andrew Martin+category: Data+extra-doc-files: CHANGELOG.md library exposed-modules:@@ -19,35 +20,43 @@ Data.Builder.Catenable.Bytes Data.Builder.Catenable.Text Data.Builder.ST- other-modules:- Compat++ other-modules: Compat build-depends:- , array-chunks >=0.1 && <0.2- , base >=4.12 && <5- , bytebuild >=0.3.5- , byteslice >=0.2.7- , bytestring- , natural-arithmetic >=0.1.3- , primitive >=0.6.4 && <0.10- , run-st >=0.1 && <0.2- , text-short >=0.1.3- hs-source-dirs: src- if impl(ghc >= 8.9)+ , array-chunks >=0.1 && <0.2+ , base >=4.12 && <5+ , bytebuild >=0.3.5 && <0.4+ , byteslice >=0.2.7 && <0.3+ , bytestring >=0.11.5 && <0.12+ , natural-arithmetic >=0.1.3 && <0.3+ , primitive >=0.6.4 && <0.10+ , run-st >=0.1 && <0.2+ , text-short >=0.1.3 && <0.2++ hs-source-dirs: src++ if impl(ghc >=8.9) hs-source-dirs: src-post-8.9+ else hs-source-dirs: src-pre-8.9+ default-language: Haskell2010- ghc-options: -Wall -O2+ ghc-options: -Wall -O2 test-suite test- type: exitcode-stdio-1.0- hs-source-dirs: test- main-is: Main.hs+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs build-depends: , array-builder , base , tasty , tasty-hunit- ghc-options: -Wall -O2++ ghc-options: -Wall -O2 default-language: Haskell2010 +source-repository head+ type: git+ location: git://github.com/byteverse/array-builder.git
src-post-8.9/Compat.hs view
@@ -1,15 +1,14 @@-{-# language MagicHash #-}-{-# language UnboxedTuples #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-} module Compat ( unsafeShrinkAndFreeze , unsafeShrinkAndFreeze# ) where -import Data.Primitive (SmallArray(..),SmallMutableArray(..))-import GHC.Exts (SmallArray#,SmallMutableArray#,Int(I#))-import GHC.Exts (State#,Int#)-import GHC.ST (ST(ST))+import Data.Primitive (SmallArray (..), SmallMutableArray (..))+import GHC.Exts (Int (I#), Int#, SmallArray#, SmallMutableArray#, State#)+import GHC.ST (ST (ST)) import qualified GHC.Exts as Exts @@ -17,22 +16,23 @@ -- The argument must not be reused after being passed to -- this function. unsafeShrinkAndFreeze ::- SmallMutableArray s a- -> Int- -> ST s (SmallArray a)-{-# inline unsafeShrinkAndFreeze #-}-unsafeShrinkAndFreeze (SmallMutableArray x) (I# n) = ST- (\s0 -> case Exts.shrinkSmallMutableArray# x n s0 of- s1 -> case Exts.unsafeFreezeSmallArray# x s1 of- (# s2, r #) -> (# s2, SmallArray r #)- )+ SmallMutableArray s a ->+ Int ->+ ST s (SmallArray a)+{-# INLINE unsafeShrinkAndFreeze #-}+unsafeShrinkAndFreeze (SmallMutableArray x) (I# n) =+ ST+ ( \s0 -> case Exts.shrinkSmallMutableArray# x n s0 of+ s1 -> case Exts.unsafeFreezeSmallArray# x s1 of+ (# s2, r #) -> (# s2, SmallArray r #)+ ) unsafeShrinkAndFreeze# ::- SmallMutableArray# s a- -> Int#- -> State# s- -> (# State# s, SmallArray# a #)-{-# inline unsafeShrinkAndFreeze# #-}+ SmallMutableArray# s a ->+ Int# ->+ State# s ->+ (# State# s, SmallArray# a #)+{-# INLINE unsafeShrinkAndFreeze# #-} unsafeShrinkAndFreeze# x n s0 = case Exts.shrinkSmallMutableArray# x n s0 of s1 -> Exts.unsafeFreezeSmallArray# x s1
src-pre-8.9/Compat.hs view
@@ -1,5 +1,5 @@-{-# language MagicHash #-}-{-# language UnboxedTuples #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnboxedTuples #-} module Compat ( unsafeShrinkAndFreeze@@ -7,8 +7,8 @@ ) where import Control.Monad.ST (ST)-import Data.Primitive (SmallArray,SmallMutableArray)-import GHC.Exts (SmallArray#,SmallMutableArray#,Int#,State#)+import Data.Primitive (SmallArray, SmallMutableArray)+import GHC.Exts (Int#, SmallArray#, SmallMutableArray#, State#) import qualified Data.Primitive as PM import qualified GHC.Exts as Exts@@ -17,17 +17,17 @@ -- The argument must not be reused after being passed to -- this function. unsafeShrinkAndFreeze ::- SmallMutableArray s a- -> Int- -> ST s (SmallArray a)-{-# inline unsafeShrinkAndFreeze #-}+ SmallMutableArray s a ->+ Int ->+ ST s (SmallArray a)+{-# INLINE unsafeShrinkAndFreeze #-} unsafeShrinkAndFreeze arr = PM.freezeSmallArray arr 0 unsafeShrinkAndFreeze# ::- SmallMutableArray# s a- -> Int#- -> State# s- -> (# State# s, SmallArray# a #)-{-# inline unsafeShrinkAndFreeze# #-}+ SmallMutableArray# s a ->+ Int# ->+ State# s ->+ (# State# s, SmallArray# a #)+{-# INLINE unsafeShrinkAndFreeze# #-} unsafeShrinkAndFreeze# x n s0 = Exts.freezeSmallArray# x 0# n s0
src/Data/Builder.hs view
@@ -1,140 +1,157 @@-{-# language RankNTypes #-}-{-# language BangPatterns #-}-{-# language UnboxedTuples #-}-{-# language MagicHash #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE UnboxedTuples #-} module Data.Builder ( -- * Builder- Builder(..)+ Builder (..) , cons , singleton , doubleton , tripleton+ -- * Run , run ) where import Compat (unsafeShrinkAndFreeze#)-import Data.Chunks (Chunks(ChunksNil,ChunksCons))-import Data.Primitive (SmallArray(SmallArray))-import GHC.Exts ((*#),(+#),(-#),(>#))-import GHC.Exts (SmallMutableArray#)-import GHC.Exts (State#,Int#,runRW#)-import GHC.Exts (newSmallArray#)-import GHC.Exts (writeSmallArray#,unsafeFreezeSmallArray#)+import Data.Chunks (Chunks (ChunksCons, ChunksNil))+import Data.Primitive (SmallArray (SmallArray))+import GHC.Exts (Int#, SmallMutableArray#, State#, newSmallArray#, runRW#, unsafeFreezeSmallArray#, writeSmallArray#, (*#), (+#), (-#), (>#)) import qualified Data.Chunks as C -- | Builder for an array of boxed elements.-newtype Builder a = Builder- -- The chunks being built up are in reverse order.- -- Consequently, functions that run a builder must- -- reverse the chunks at the end.- (forall s. SmallMutableArray# s a -> Int# -> Int# -> Chunks a -> State# s- -> (# State# s, SmallMutableArray# s a, Int#, Int#, Chunks a #)- )+newtype Builder a+ = Builder+ -- The chunks being built up are in reverse order.+ -- Consequently, functions that run a builder must+ -- reverse the chunks at the end.+ ( forall s.+ SmallMutableArray# s a ->+ Int# ->+ Int# ->+ Chunks a ->+ State# s ->+ (# State# s, SmallMutableArray# s a, Int#, Int#, Chunks a #)+ ) run :: Builder a -> Chunks a run (Builder f) = case runRW# -- The initial size of 16 elements is chosen somewhat -- arbitrarily. It is more than enough to saturate a -- cache line.- (\s0 -> case newSmallArray# 16# errorThunk s0 of- (# s1, marr0 #) -> case f marr0 0# 16# ChunksNil s1 of- (# s2, marr, off, _, cs #) ->- -- Recall that freezeSmallArray copies a slice.- -- If resize functions ever become available for- -- SmallArray, we should use that instead.- case unsafeShrinkAndFreeze# marr off s2 of- (# s3, arr #) ->- let !r = C.reverseOnto- (ChunksCons (SmallArray arr) ChunksNil)- cs- in (# s3, r #)- ) of (# _, cs #) -> cs+ ( \s0 -> case newSmallArray# 16# errorThunk s0 of+ (# s1, marr0 #) -> case f marr0 0# 16# ChunksNil s1 of+ (# s2, marr, off, _, cs #) ->+ -- Recall that freezeSmallArray copies a slice.+ -- If resize functions ever become available for+ -- SmallArray, we should use that instead.+ case unsafeShrinkAndFreeze# marr off s2 of+ (# s3, arr #) ->+ let !r =+ C.reverseOnto+ (ChunksCons (SmallArray arr) ChunksNil)+ cs+ in (# s3, r #)+ ) of+ (# _, cs #) -> cs errorThunk :: a-{-# noinline errorThunk #-}+{-# NOINLINE errorThunk #-} errorThunk = error "array-builder:Data.Builder: error" instance Monoid (Builder a) where- {-# inline mempty #-}- mempty = Builder- (\marr0 off0 len0 cs0 s0 ->- (# s0, marr0, off0, len0, cs0 #)- )+ {-# INLINE mempty #-}+ mempty =+ Builder+ ( \marr0 off0 len0 cs0 s0 ->+ (# s0, marr0, off0, len0, cs0 #)+ ) instance Semigroup (Builder a) where- {-# inline (<>) #-}- Builder f <> Builder g = Builder- (\marr0 off0 len0 cs0 s0 -> case f marr0 off0 len0 cs0 s0 of- (# s1, marr1, off1, len1, cs1 #) ->- g marr1 off1 len1 cs1 s1- )+ {-# INLINE (<>) #-}+ Builder f <> Builder g =+ Builder+ ( \marr0 off0 len0 cs0 s0 -> case f marr0 off0 len0 cs0 s0 of+ (# s1, marr1, off1, len1, cs1 #) ->+ g marr1 off1 len1 cs1 s1+ ) cons :: a -> Builder a -> Builder a-{-# inline cons #-}+{-# INLINE cons #-} cons a b = singleton a <> b -- | A builder with one element. singleton :: a -> Builder a-{-# noinline singleton #-}-singleton a = Builder- (\marr off len cs s0 -> case len ># 0# of- 1# -> case writeSmallArray# marr off a s0 of- s1 -> (# s1, marr, off +# 1#, len -# 1#, cs #)- _ -> case unsafeFreezeSmallArray# marr s0 of- (# s1, arr #) -> let !lenNew = nextLength off in- -- Since we feed the element to newSmallArray#, we do not- -- need to write it to the 0 index.- case newSmallArray# lenNew a s1 of- (# s2, marrNew #) ->- let !csNew = ChunksCons (SmallArray arr) cs in- (# s2, marrNew, 1#, lenNew -# 1#, csNew #)- )+{-# NOINLINE singleton #-}+singleton a =+ Builder+ ( \marr off len cs s0 -> case len ># 0# of+ 1# -> case writeSmallArray# marr off a s0 of+ s1 -> (# s1, marr, off +# 1#, len -# 1#, cs #)+ _ -> case unsafeFreezeSmallArray# marr s0 of+ (# s1, arr #) ->+ let !lenNew = nextLength off+ in -- Since we feed the element to newSmallArray#, we do not+ -- need to write it to the 0 index.+ case newSmallArray# lenNew a s1 of+ (# s2, marrNew #) ->+ let !csNew = ChunksCons (SmallArray arr) cs+ in (# s2, marrNew, 1#, lenNew -# 1#, csNew #)+ ) --- | A builder with two elements.------ @since 0.1.1.0+{- | A builder with two elements.++@since 0.1.1.0+-} doubleton :: a -> a -> Builder a-{-# noinline doubleton #-}-doubleton a b = Builder- (\marr off len cs s0 -> case len ># 1# of- 1# -> case writeSmallArray# marr off a s0 of- s1 -> case writeSmallArray# marr (off +# 1#) b s1 of- s2 -> (# s2, marr, off +# 2#, len -# 2#, cs #)- _ -> case unsafeShrinkAndFreeze# marr off s0 of- (# s1, arr #) -> let !lenNew = nextLength off in- -- Since we feed the element to newSmallArray#, we do not- -- need to write element a to the 0 index.- case newSmallArray# lenNew a s1 of- (# s2, marrNew #) -> case writeSmallArray# marrNew 1# b s2 of- s3 -> let !csNew = ChunksCons (SmallArray arr) cs in- (# s3, marrNew, 2#, lenNew -# 2#, csNew #)- )+{-# NOINLINE doubleton #-}+doubleton a b =+ Builder+ ( \marr off len cs s0 -> case len ># 1# of+ 1# -> case writeSmallArray# marr off a s0 of+ s1 -> case writeSmallArray# marr (off +# 1#) b s1 of+ s2 -> (# s2, marr, off +# 2#, len -# 2#, cs #)+ _ -> case unsafeShrinkAndFreeze# marr off s0 of+ (# s1, arr #) ->+ let !lenNew = nextLength off+ in -- Since we feed the element to newSmallArray#, we do not+ -- need to write element a to the 0 index.+ case newSmallArray# lenNew a s1 of+ (# s2, marrNew #) -> case writeSmallArray# marrNew 1# b s2 of+ s3 ->+ let !csNew = ChunksCons (SmallArray arr) cs+ in (# s3, marrNew, 2#, lenNew -# 2#, csNew #)+ ) --- | A builder with three elements.------ @since 0.1.1.0+{- | A builder with three elements.++@since 0.1.1.0+-} tripleton :: a -> a -> a -> Builder a-{-# noinline tripleton #-}-tripleton a b c = Builder- (\marr off len cs s0 -> case len ># 1# of- 1# -> case writeSmallArray# marr off a s0 of- s1 -> case writeSmallArray# marr (off +# 1#) b s1 of- s2 -> case writeSmallArray# marr (off +# 2#) c s2 of- s3 -> (# s3, marr, off +# 3#, len -# 3#, cs #)- _ -> case unsafeShrinkAndFreeze# marr off s0 of- (# s1, arr #) -> let !lenNew = nextLength off in- -- Since we feed the element to newSmallArray#, we do not- -- need to write element a to the 0 index.- case newSmallArray# lenNew a s1 of- (# s2, marrNew #) -> case writeSmallArray# marrNew 1# b s2 of- s3 -> case writeSmallArray# marrNew 2# c s3 of- s4 -> let !csNew = ChunksCons (SmallArray arr) cs in- (# s4, marrNew, 3#, lenNew -# 3#, csNew #)- )+{-# NOINLINE tripleton #-}+tripleton a b c =+ Builder+ ( \marr off len cs s0 -> case len ># 1# of+ 1# -> case writeSmallArray# marr off a s0 of+ s1 -> case writeSmallArray# marr (off +# 1#) b s1 of+ s2 -> case writeSmallArray# marr (off +# 2#) c s2 of+ s3 -> (# s3, marr, off +# 3#, len -# 3#, cs #)+ _ -> case unsafeShrinkAndFreeze# marr off s0 of+ (# s1, arr #) ->+ let !lenNew = nextLength off+ in -- Since we feed the element to newSmallArray#, we do not+ -- need to write element a to the 0 index.+ case newSmallArray# lenNew a s1 of+ (# s2, marrNew #) -> case writeSmallArray# marrNew 1# b s2 of+ s3 -> case writeSmallArray# marrNew 2# c s3 of+ s4 ->+ let !csNew = ChunksCons (SmallArray arr) cs+ in (# s4, marrNew, 3#, lenNew -# 3#, csNew #)+ ) nextLength :: Int# -> Int#-{-# inline nextLength #-}+{-# INLINE nextLength #-} nextLength i = i *# 2#
src/Data/Builder/Catenable.hs view
@@ -1,51 +1,55 @@-{-# language BangPatterns #-}-{-# language PatternSynonyms #-}-{-# language TypeFamilies #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TypeFamilies #-} --- | Builder with cheap concatenation. Like the builder type from--- @Data.Builder.ST@, this builder can be stored somewhere and this used--- again later. However, this builder type has several advantages:------ * Supports both cons and snoc (@Data.Builder.ST@ only supports snoc)--- * No linear-use restriction--- * Extremely cheap concatenation (not supported by @Data.Builder.ST@ at all)------ In exchange for all of these, this implementation trades performance.--- Performance is degraded for two reasons:------ * Evaluation of the builder is deferred, and the evaluation requires walking--- a tree of nodes.--- * This builder stores individual elements rather than chunks. There is--- no fundamental reason for this. It is possible to store a SmallArray--- in each Cons and Snoc instead, but this makes the implementation a--- little more simple.------ One reason to prefer this module instead of @Data.Builder.ST@ is that--- this module lets the user works with builder in a more monoidal style--- rather than a stateful style. Consider a data type with several fields--- that is being converted to a builder. Here, @Data.Builder.ST@--- would require that @Builder@ appear as both an argument and an result for--- each field\'s encode function. The linearly-used builder must be threaded--- through by hand or by clever use of @StateT@. With @Data.Builder.Catenable@,--- the encode functions only need return the builder.+{- | Builder with cheap concatenation. Like the builder type from+@Data.Builder.ST@, this builder can be stored somewhere and this used+again later. However, this builder type has several advantages:++* Supports both cons and snoc (@Data.Builder.ST@ only supports snoc)+* No linear-use restriction+* Extremely cheap concatenation (not supported by @Data.Builder.ST@ at all)++In exchange for all of these, this implementation trades performance.+Performance is degraded for two reasons:++* Evaluation of the builder is deferred, and the evaluation requires walking+ a tree of nodes.+* This builder stores individual elements rather than chunks. There is+ no fundamental reason for this. It is possible to store a SmallArray+ in each Cons and Snoc instead, but this makes the implementation a+ little more simple.++One reason to prefer this module instead of @Data.Builder.ST@ is that+this module lets the user works with builder in a more monoidal style+rather than a stateful style. Consider a data type with several fields+that is being converted to a builder. Here, @Data.Builder.ST@+would require that @Builder@ appear as both an argument and an result for+each field\'s encode function. The linearly-used builder must be threaded+through by hand or by clever use of @StateT@. With @Data.Builder.Catenable@,+the encode functions only need return the builder.+-} module Data.Builder.Catenable ( -- * Type- Builder(..)+ Builder (..)+ -- * Convenient infix operators , pattern (:<) , pattern (:>)+ -- * Functions , singleton , doubleton , tripleton+ -- * Run , run ) where -import Control.Monad.ST (ST,runST)+import Control.Monad.ST (ST, runST) import Data.Chunks (Chunks) import Data.Foldable (foldl')-import GHC.Exts (IsList(..))+import GHC.Exts (IsList (..)) import qualified Data.Builder.ST as STB import qualified Data.Chunks as Chunks@@ -60,11 +64,11 @@ | Append !(Builder a) !(Builder a) instance Monoid (Builder a) where- {-# inline mempty #-}+ {-# INLINE mempty #-} mempty = Empty instance Semigroup (Builder a) where- {-# inline (<>) #-}+ {-# INLINE (<>) #-} (<>) = Append instance IsList (Builder a) where@@ -79,7 +83,7 @@ pattern (:>) x y = Snoc x y run :: Builder a -> Chunks a-{-# noinline run #-}+{-# NOINLINE run #-} run b = runST $ do bldr0 <- STB.new bldr1 <- pushCatenable bldr0 b@@ -99,13 +103,13 @@ pushCatenable bldr1 y singleton :: a -> Builder a-{-# inline singleton #-}+{-# INLINE singleton #-} singleton a = Cons a Empty doubleton :: a -> a -> Builder a-{-# inline doubleton #-}+{-# INLINE doubleton #-} doubleton a b = Cons a (Cons b Empty) tripleton :: a -> a -> a -> Builder a-{-# inline tripleton #-}+{-# INLINE tripleton #-} tripleton a b c = Append (Cons a (Cons b Empty)) (Cons c Empty)
src/Data/Builder/Catenable/Bytes.hs view
@@ -1,20 +1,25 @@-{-# language BangPatterns #-}-{-# language PatternSynonyms #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE PatternSynonyms #-} -- | @Data.Builder.Bytes@ specialized to @Bytes@. module Data.Builder.Catenable.Bytes ( -- * Type- Builder(..)+ Builder (..)+ -- * Convenient infix operators , pattern (:<) , pattern (:>)+ -- * Run , run+ -- * Properties , length+ -- * Create , bytes , byteArray+ -- * Mimic data constructors , cons , snoc@@ -24,9 +29,9 @@ import Prelude hiding (length) -import Control.Monad.ST (ST,runST)+import Control.Monad.ST (ST, runST) import Data.Bytes (Bytes)-import Data.Bytes.Chunks (Chunks(ChunksNil))+import Data.Bytes.Chunks (Chunks (ChunksNil)) import Data.Primitive (ByteArray) import qualified Data.Bytes as Bytes@@ -43,11 +48,11 @@ | Append !Builder !Builder instance Monoid Builder where- {-# inline mempty #-}+ {-# INLINE mempty #-} mempty = Empty instance Semigroup Builder where- {-# inline (<>) #-}+ {-# INLINE (<>) #-} (<>) = Append pattern (:<) :: Bytes -> Builder -> Builder@@ -65,7 +70,7 @@ Append x y -> length x + length y run :: Builder -> Chunks-{-# noinline run #-}+{-# NOINLINE run #-} run b = runST $ do bldr0 <- BBU.newBuilderState 128 bldr1 <- pushCatenable bldr0 b@@ -91,17 +96,17 @@ byteArray !b = Cons (Bytes.fromByteArray b) Empty snoc :: Builder -> Bytes -> Builder-{-# inline snoc #-}+{-# INLINE snoc #-} snoc = Snoc cons :: Bytes -> Builder -> Builder-{-# inline cons #-}+{-# INLINE cons #-} cons = Cons empty :: Builder-{-# inline empty #-}+{-# INLINE empty #-} empty = Empty append :: Builder -> Builder -> Builder-{-# inline append #-}+{-# INLINE append #-} append = Append
src/Data/Builder/Catenable/Text.hs view
@@ -1,17 +1,21 @@-{-# language BangPatterns #-}-{-# language PatternSynonyms #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE PatternSynonyms #-} -- | @Data.Builder.Catenable@ specialized to @ShortText@. module Data.Builder.Catenable.Text ( -- * Type- Builder(..)+ Builder (..)+ -- * Convenient infix operators , pattern (:<) , pattern (:>)+ -- * Run , run+ -- * Properties , length+ -- * Create , shortText , char@@ -23,14 +27,14 @@ import Prelude hiding (length) -import Control.Monad.ST (ST,runST)-import Data.ByteString.Short.Internal (ShortByteString(SBS))-import Data.Bytes.Chunks (Chunks(ChunksNil))-import Data.Int (Int32,Int64)-import Data.Primitive (ByteArray(ByteArray))-import Data.String (IsString(fromString))+import Control.Monad.ST (ST, runST)+import Data.ByteString.Short.Internal (ShortByteString (SBS))+import Data.Bytes.Chunks (Chunks (ChunksNil))+import Data.Int (Int32, Int64)+import Data.Primitive (ByteArray (ByteArray))+import Data.String (IsString (fromString)) import Data.Text.Short (ShortText)-import Data.Word (Word32,Word64)+import Data.Word (Word32, Word64) import qualified Arithmetic.Nat as Nat import qualified Data.Bytes.Builder as BB@@ -75,22 +79,24 @@ Snoc b1 x -> TS.length x + length b1 Append x y -> length x + length y --- | Note: The choice of appending to the left side of @Empty@ instead--- of the right side of arbitrary. Under ordinary use, this difference--- cannot be observed by the user.+{- | Note: The choice of appending to the left side of @Empty@ instead+of the right side of arbitrary. Under ordinary use, this difference+cannot be observed by the user.+-} instance IsString Builder where fromString t = Cons (TS.pack t) Empty instance Monoid Builder where- {-# inline mempty #-}+ {-# INLINE mempty #-} mempty = Empty instance Semigroup Builder where- {-# inline (<>) #-}+ {-# INLINE (<>) #-} (<>) = Append --- | Not structural equality. Converts builders to chunks and then--- compares the chunks.+{- | Not structural equality. Converts builders to chunks and then+compares the chunks.+-} instance Eq Builder where a == b = run a == run b @@ -98,7 +104,7 @@ show b = TS.unpack (ba2st (Chunks.concatU (run b))) ba2st :: ByteArray -> ShortText-{-# inline ba2st #-}+{-# INLINE ba2st #-} ba2st (ByteArray x) = TS.fromShortByteStringUnsafe (SBS x) pattern (:<) :: ShortText -> Builder -> Builder@@ -107,11 +113,12 @@ pattern (:>) :: Builder -> ShortText -> Builder pattern (:>) x y = Snoc x y --- | The result is chunks, but this is guaranteed to be UTF-8 encoded--- text, so if needed, you can flatten out the chunks and convert back--- to @ShortText@.+{- | The result is chunks, but this is guaranteed to be UTF-8 encoded+text, so if needed, you can flatten out the chunks and convert back+to @ShortText@.+-} run :: Builder -> Chunks-{-# noinline run #-}+{-# NOINLINE run #-} run b = runST $ do bldr0 <- BBU.newBuilderState 128 bldr1 <- pushCatenable bldr0 b
src/Data/Builder/ST.hs view
@@ -1,7 +1,7 @@-{-# language BangPatterns #-}+{-# LANGUAGE BangPatterns #-} module Data.Builder.ST- ( Builder(..)+ ( Builder (..) , new , new1 , push@@ -10,52 +10,57 @@ import Compat (unsafeShrinkAndFreeze) import Control.Monad.ST (ST)-import Data.Chunks (Chunks(ChunksNil,ChunksCons))-import Data.Primitive (SmallMutableArray)-import Data.Primitive (newSmallArray,writeSmallArray,unsafeFreezeSmallArray)-import Data.Primitive (sizeofSmallArray)+import Data.Chunks (Chunks (ChunksCons, ChunksNil))+import Data.Primitive (SmallMutableArray, newSmallArray, sizeofSmallArray, unsafeFreezeSmallArray, writeSmallArray) import Foreign.Storable (sizeOf) import qualified Data.Chunks as C --- | Builder for an array of boxed elements. This type is appropriate--- when constructing an array of unknown size in an effectful--- (@ST@ or @IO@) setting. In a non-effectful setting, consider--- the @Builder@ from @Data.Builder@ instead.------ A 'Builder' must be used linearly. The type system does not--- enforce this, so users must be careful when handling a 'Builder'.-data Builder s a = Builder- !(SmallMutableArray s a)- !Int- !Int- !(Chunks a)+{- | Builder for an array of boxed elements. This type is appropriate+when constructing an array of unknown size in an effectful+(@ST@ or @IO@) setting. In a non-effectful setting, consider+the @Builder@ from @Data.Builder@ instead. +A 'Builder' must be used linearly. The type system does not+enforce this, so users must be careful when handling a 'Builder'.+-}+data Builder s a+ = Builder+ !(SmallMutableArray s a)+ !Int+ !Int+ !(Chunks a)+ -- | Create a new 'Builder' with no elements in it. new :: ST s (Builder s a) new = do marr <- newSmallArray initialLength errorThunk pure (Builder marr 0 initialLength ChunksNil) --- | Create a new 'Builder' with a single element. Useful when builder--- creation is immidiately followed by 'push'. Note that:------ > new >>= push x ≡ new1 x------ But 'new1' performs slightly better.+{- | Create a new 'Builder' with a single element. Useful when builder+creation is immidiately followed by 'push'. Note that:++> new >>= push x ≡ new1 x++But 'new1' performs slightly better.+-} new1 :: a -> ST s (Builder s a) new1 a0 = do marr <- newSmallArray initialLength a0 pure (Builder marr 1 initialLength ChunksNil) --- | Push an element onto the end of the builder. This--- is not strict in the element, so force it before pushing--- it on to the builder if doing so is needed to prevent--- space leaks.+{- | Push an element onto the end of the builder. This+is not strict in the element, so force it before pushing+it on to the builder if doing so is needed to prevent+space leaks.+-} push ::- a -- ^ Element to push onto the end- -> Builder s a -- ^ Builder, do not reuse this after pushing onto it- -> ST s (Builder s a) -- ^ New builder+ -- | Element to push onto the end+ a ->+ -- | Builder, do not reuse this after pushing onto it+ Builder s a ->+ -- | New builder+ ST s (Builder s a) push a (Builder marr off len cs) = case len > 0 of True -> do writeSmallArray marr off a@@ -75,9 +80,10 @@ -- A 254-element SmallArray on a 64-bit platform uses -- exactly 4KB (header + ptrs + payload). nextLength :: Int -> Int-nextLength i = if i < maxElementCount - smallArrayHeaderWords- then i * 2 + smallArrayHeaderWords- else maxElementCount - smallArrayHeaderWords+nextLength i =+ if i < maxElementCount - smallArrayHeaderWords+ then i * 2 + smallArrayHeaderWords+ else maxElementCount - smallArrayHeaderWords maxElementCount :: Int maxElementCount = div 4096 (sizeOf (undefined :: Int))@@ -88,16 +94,17 @@ smallArrayHeaderWords :: Int smallArrayHeaderWords = 2 --- | Convert a 'Builder' to 'Chunks'. The 'Builder' must not--- be reused after this operation.+{- | Convert a 'Builder' to 'Chunks'. The 'Builder' must not+be reused after this operation.+-} freeze ::- Builder s a -- ^ Builder, do not reuse after freezing- -> ST s (Chunks a)+ -- | Builder, do not reuse after freezing+ Builder s a ->+ ST s (Chunks a) freeze (Builder marr off _ cs) = do arr <- unsafeShrinkAndFreeze marr off pure $! C.reverseOnto (ChunksCons arr ChunksNil) cs errorThunk :: a-{-# noinline errorThunk #-}+{-# NOINLINE errorThunk #-} errorThunk = error "array-builder:Data.Builder.ST: error"-
test/Main.hs view
@@ -1,68 +1,81 @@-{-# language BangPatterns #-}-{-# language PatternSynonyms #-}-{-# language ScopedTypeVariables #-}-{-# language TypeApplications #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ScopedTypeVariables #-} -import Data.Builder (singleton,doubleton,tripleton,run)-import Test.Tasty (defaultMain,testGroup,TestTree)-import Test.Tasty.HUnit ((@=?))-import Data.Semigroup (stimes)+import Data.Builder (doubleton, run, singleton, tripleton) import Data.Builder.Catenable (pattern (:<), pattern (:>))+import Data.Semigroup (stimes)+import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.HUnit ((@=?)) import qualified Data.Builder.Catenable as Cat-import qualified Data.List as L import qualified Data.Foldable as F+import qualified Data.List as L import qualified Test.Tasty.HUnit as THU main :: IO () main = defaultMain tests tests :: TestTree-tests = testGroup "Tests"- [ testGroup "Data.Builder"- [ THU.testCase "A" $ "ABCDEF" @=?- ( F.toList $ run- ( singleton 'A'- <> singleton 'B'- <> singleton 'C'- <> singleton 'D'- <> singleton 'E'- <> singleton 'F'- )- )- , THU.testCase "B" $ "ABCCCCCCCCCCCCCCCD" @=?- ( F.toList $ run- ( singleton 'A'- <> singleton 'B'- <> stimes (15 :: Int) (singleton 'C')- <> singleton 'D'- )- )- , THU.testCase "C" $ (L.replicate 500 'X') @=?- (F.toList $ run (stimes (500 :: Int) (singleton 'X')))- , THU.testCase "D" $ "ACDCDCDCDCDCDCDCDCDX" @=?- ( F.toList $ run- ( singleton 'A'- <> stimes (9 :: Int) (doubleton 'C' 'D')- <> singleton 'X'- )- )- , THU.testCase "E" $ "ABCABCABCABCABCABCABCX" @=?- ( F.toList $ run- ( stimes (7 :: Int) (tripleton 'A' 'B' 'C')- <> singleton 'X'- )- )- ]- , testGroup "Data.Builder.Catenable"- [ THU.testCase "A" $ "ABCDEF" @=?- ( F.toList $ Cat.run- ( ('A' :< 'B' :< 'C' :< mempty)- <>- (mempty :> 'D' :> 'E' :> 'F')- )- )- , THU.testCase "B" $ "DEF" @=?- (F.toList $ Cat.run (mempty :> 'D' :> 'E' :> 'F'))+tests =+ testGroup+ "Tests"+ [ testGroup+ "Data.Builder"+ [ THU.testCase "A" $+ "ABCDEF"+ @=? ( F.toList $+ run+ ( singleton 'A'+ <> singleton 'B'+ <> singleton 'C'+ <> singleton 'D'+ <> singleton 'E'+ <> singleton 'F'+ )+ )+ , THU.testCase "B" $+ "ABCCCCCCCCCCCCCCCD"+ @=? ( F.toList $+ run+ ( singleton 'A'+ <> singleton 'B'+ <> stimes (15 :: Int) (singleton 'C')+ <> singleton 'D'+ )+ )+ , THU.testCase "C" $+ (L.replicate 500 'X')+ @=? (F.toList $ run (stimes (500 :: Int) (singleton 'X')))+ , THU.testCase "D" $+ "ACDCDCDCDCDCDCDCDCDX"+ @=? ( F.toList $+ run+ ( singleton 'A'+ <> stimes (9 :: Int) (doubleton 'C' 'D')+ <> singleton 'X'+ )+ )+ , THU.testCase "E" $+ "ABCABCABCABCABCABCABCX"+ @=? ( F.toList $+ run+ ( stimes (7 :: Int) (tripleton 'A' 'B' 'C')+ <> singleton 'X'+ )+ )+ ]+ , testGroup+ "Data.Builder.Catenable"+ [ THU.testCase "A" $+ "ABCDEF"+ @=? ( F.toList $+ Cat.run+ ( ('A' :< 'B' :< 'C' :< mempty)+ <> (mempty :> 'D' :> 'E' :> 'F')+ )+ )+ , THU.testCase "B" $+ "DEF"+ @=? (F.toList $ Cat.run (mempty :> 'D' :> 'E' :> 'F'))+ ] ]- ]