array-builder 0.1.1.0 → 0.1.2.0

raw patch · 7 files changed

+295/−31 lines, 7 filesdep +bytebuilddep +byteslicedep +text-shortdep ~primitivePVP ok

version bump matches the API change (PVP)

Dependencies added: bytebuild, byteslice, text-short

Dependency ranges changed: primitive

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• array-builder.cabal +7/−1
• src/Data/Builder/Catenable.hs +95/−0
• src/Data/Builder/Catenable/Bytes.hs +65/−0
• src/Data/Builder/Catenable/Text.hs +75/−0
• src/Data/Builder/ST.hs +1/−1
• test/Main.hs +46/−29

@@ -1,5 +1,11 @@ # Revision history for array-builder +## 0.1.2.0 -- 2022-08-09++* Add `Data.Builder.Catenable` module.+* Add `Data.Builder.Catenable.Bytes` module.+* Add `Data.Builder.Catenable.Text` module.+ ## 0.1.1.0 -- 2020-11-18  * Add `new1`.

@@ -1,6 +1,6 @@ cabal-version: 2.2 name: array-builder-version: 0.1.1.0+version: 0.1.2.0 synopsis: Builders for arrays homepage: https://github.com/andrewthad/array-builder bug-reports: https://github.com/andrewthad/array-builder/issues@@ -15,14 +15,20 @@ library   exposed-modules:     Data.Builder+    Data.Builder.Catenable+    Data.Builder.Catenable.Bytes+    Data.Builder.Catenable.Text     Data.Builder.ST   other-modules:     Compat   build-depends:     , array-chunks >=0.1 && <0.2     , base >=4.12 && <5+    , bytebuild >=0.3.5+    , byteslice >=0.2.7     , primitive >=0.6.4 && <0.8     , run-st >=0.1 && <0.2+    , text-short >=0.1.3   hs-source-dirs: src   if impl(ghc >= 8.9)     hs-source-dirs: src-post-8.9

@@ -0,0 +1,95 @@+{-# 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.+module Data.Builder.Catenable+  ( -- * Type+    Builder(..)+    -- * Convenient infix operators+  , pattern (:<)+  , pattern (:>)+    -- * Run+  , run+  ) where++import Control.Monad.ST (ST,runST)+import Data.Chunks (Chunks)+import Data.Foldable (foldl')+import GHC.Exts (IsList(..))++import qualified Data.Builder.ST as STB+import qualified Data.Chunks as Chunks++infixr 5 :<+infixl 5 :>++data Builder a+  = Empty+  | Cons a !(Builder a)+  | Snoc !(Builder a) a+  | Append !(Builder a) !(Builder a)++instance Monoid (Builder a) where+  {-# inline mempty #-}+  mempty = Empty++instance Semigroup (Builder a) where+  {-# inline (<>) #-}+  (<>) = Append++instance IsList (Builder a) where+  type Item (Builder a) = a+  toList = toList . Chunks.concat . run+  fromList = foldl' (\acc x -> acc :> x) Empty++pattern (:<) :: a -> Builder a -> Builder a+pattern (:<) x y = Cons x y++pattern (:>) :: Builder a -> a -> Builder a+pattern (:>) x y = Snoc x y++run :: Builder a -> Chunks a+{-# noinline run #-}+run b = runST $ do+  bldr0 <- STB.new+  bldr1 <- pushCatenable bldr0 b+  STB.freeze bldr1++pushCatenable :: STB.Builder s a -> Builder a -> ST s (STB.Builder s a)+pushCatenable !bldr0 b = case b of+  Empty -> pure bldr0+  Cons x b1 -> do+    bldr1 <- STB.push x bldr0+    pushCatenable bldr1 b1+  Snoc b1 x -> do+    bldr1 <- pushCatenable bldr0 b1+    STB.push x bldr1+  Append x y -> do+    bldr1 <- pushCatenable bldr0 x+    pushCatenable bldr1 y

@@ -0,0 +1,65 @@+{-# language BangPatterns #-}+{-# language PatternSynonyms #-}++-- | @Data.Builder.Bytes@ specialized to @Bytes@.+module Data.Builder.Catenable.Bytes+  ( -- * Type+    Builder(..)+    -- * Convenient infix operators+  , pattern (:<)+  , pattern (:>)+    -- * Run+  , run+  ) where++import Control.Monad.ST (ST,runST)+import Data.Bytes (Bytes)+import Data.Bytes.Chunks (Chunks(ChunksNil))++import qualified Data.Bytes.Builder as BB+import qualified Data.Bytes.Builder.Unsafe as BBU++infixr 5 :<+infixl 5 :>++data Builder+  = Empty+  | Cons {-# UNPACK #-} !Bytes !Builder+  | Snoc !Builder {-# UNPACK #-} !Bytes+  | Append !Builder !Builder++instance Monoid Builder where+  {-# inline mempty #-}+  mempty = Empty++instance Semigroup Builder where+  {-# inline (<>) #-}+  (<>) = Append++pattern (:<) :: Bytes -> Builder -> Builder+pattern (:<) x y = Cons x y++pattern (:>) :: Builder -> Bytes -> Builder+pattern (:>) x y = Snoc x y++run :: Builder -> Chunks+{-# noinline run #-}+run b = runST $ do+  bldr0 <- BBU.newBuilderState 128+  bldr1 <- pushCatenable bldr0 b+  BBU.reverseCommitsOntoChunks ChunksNil (BBU.closeBuilderState bldr1)++pushCatenable :: BBU.BuilderState s -> Builder -> ST s (BBU.BuilderState s)+pushCatenable !bldr0 b = case b of+  Empty -> pure bldr0+  Cons x b1 -> do+    bldr1 <- BBU.pasteST (BB.bytes x) bldr0+    pushCatenable bldr1 b1+  Snoc b1 x -> do+    bldr1 <- pushCatenable bldr0 b1+    BBU.pasteST (BB.bytes x) bldr1+  Append x y -> do+    bldr1 <- pushCatenable bldr0 x+    pushCatenable bldr1 y++

@@ -0,0 +1,75 @@+{-# language BangPatterns #-}+{-# language PatternSynonyms #-}++-- | @Data.Builder.Catenable@ specialized to @ShortText@.+module Data.Builder.Catenable.Text+  ( -- * Type+    Builder(..)+    -- * Convenient infix operators+  , pattern (:<)+  , pattern (:>)+    -- * Run+  , run+  ) where++import Control.Monad.ST (ST,runST)+import Data.Text.Short (ShortText)+import Data.Bytes.Chunks (Chunks(ChunksNil))+import Data.String (IsString(fromString))++import qualified Data.Text.Short as TS+import qualified Data.Bytes.Builder as BB+import qualified Data.Bytes.Builder.Unsafe as BBU++infixr 5 :<+infixl 5 :>++data Builder+  = Empty+  | Cons !ShortText !Builder+  | Snoc !Builder !ShortText+  | Append !Builder !Builder++-- | 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 #-}+  mempty = Empty++instance Semigroup Builder where+  {-# inline (<>) #-}+  (<>) = Append++pattern (:<) :: ShortText -> Builder -> Builder+pattern (:<) x y = Cons x y++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@.+run :: Builder -> Chunks+{-# noinline run #-}+run b = runST $ do+  bldr0 <- BBU.newBuilderState 128+  bldr1 <- pushCatenable bldr0 b+  BBU.reverseCommitsOntoChunks ChunksNil (BBU.closeBuilderState bldr1)++pushCatenable :: BBU.BuilderState s -> Builder -> ST s (BBU.BuilderState s)+pushCatenable !bldr0 b = case b of+  Empty -> pure bldr0+  Cons x b1 -> do+    bldr1 <- BBU.pasteST (BB.shortTextUtf8 x) bldr0+    pushCatenable bldr1 b1+  Snoc b1 x -> do+    bldr1 <- pushCatenable bldr0 b1+    BBU.pasteST (BB.shortTextUtf8 x) bldr1+  Append x y -> do+    bldr1 <- pushCatenable bldr0 x+    pushCatenable bldr1 y+

@@ -5,7 +5,7 @@   , new   , new1   , push-  , freeze +  , freeze   ) where  import Compat (unsafeShrinkAndFreeze)

@@ -1,4 +1,5 @@ {-# language BangPatterns #-}+{-# language PatternSynonyms #-} {-# language ScopedTypeVariables #-} {-# language TypeApplications #-} @@ -6,6 +7,9 @@ import Test.Tasty (defaultMain,testGroup,TestTree) import Test.Tasty.HUnit ((@=?)) import Data.Semigroup (stimes)+import Data.Builder.Catenable (pattern (:<), pattern (:>))++import qualified Data.Builder.Catenable as Cat import qualified Data.List as L import qualified Data.Foldable as F import qualified Test.Tasty.HUnit as THU@@ -15,37 +19,50 @@  tests :: TestTree tests = testGroup "Tests"-  [ THU.testCase "A" $ "ABCDEF" @=?-    ( F.toList $ run-      (  singleton 'A'-      <> singleton 'B'-      <> singleton 'C'-      <> singleton 'D'-      <> singleton 'E'-      <> singleton 'F'+  [ 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 "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 "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'+    , 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'))+    ]   ]