{-# 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 :: Builder
mempty = Builder
Empty

instance Semigroup Builder where
  {-# inline (<>) #-}
  <> :: Builder -> Builder -> Builder
(<>) = Builder -> Builder -> Builder
Append

pattern (:<) :: Bytes -> Builder -> Builder
pattern $b:< :: Bytes -> Builder -> Builder
$m:< :: forall r. Builder -> (Bytes -> Builder -> r) -> (Void# -> r) -> r
(:<) x y = Cons x y

pattern (:>) :: Builder -> Bytes -> Builder
pattern $b:> :: Builder -> Bytes -> Builder
$m:> :: forall r. Builder -> (Builder -> Bytes -> r) -> (Void# -> r) -> r
(:>) x y = Snoc x y

run :: Builder -> Chunks
{-# noinline run #-}
run :: Builder -> Chunks
run Builder
b = (forall s. ST s Chunks) -> Chunks
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s Chunks) -> Chunks)
-> (forall s. ST s Chunks) -> Chunks
forall a b. (a -> b) -> a -> b
$ do
  BuilderState s
bldr0 <- Int -> ST s (BuilderState s)
forall s. Int -> ST s (BuilderState s)
BBU.newBuilderState Int
128
  BuilderState s
bldr1 <- BuilderState s -> Builder -> ST s (BuilderState s)
forall s. BuilderState s -> Builder -> ST s (BuilderState s)
pushCatenable BuilderState s
bldr0 Builder
b
  Chunks -> Commits s -> ST s Chunks
forall s. Chunks -> Commits s -> ST s Chunks
BBU.reverseCommitsOntoChunks Chunks
ChunksNil (BuilderState s -> Commits s
forall s. BuilderState s -> Commits s
BBU.closeBuilderState BuilderState s
bldr1)

pushCatenable :: BBU.BuilderState s -> Builder -> ST s (BBU.BuilderState s)
pushCatenable :: BuilderState s -> Builder -> ST s (BuilderState s)
pushCatenable !BuilderState s
bldr0 Builder
b = case Builder
b of
  Builder
Empty -> BuilderState s -> ST s (BuilderState s)
forall (f :: * -> *) a. Applicative f => a -> f a
pure BuilderState s
bldr0
  Cons Bytes
x Builder
b1 -> do
    BuilderState s
bldr1 <- Builder -> BuilderState s -> ST s (BuilderState s)
forall s. Builder -> BuilderState s -> ST s (BuilderState s)
BBU.pasteST (Bytes -> Builder
BB.bytes Bytes
x) BuilderState s
bldr0
    BuilderState s -> Builder -> ST s (BuilderState s)
forall s. BuilderState s -> Builder -> ST s (BuilderState s)
pushCatenable BuilderState s
bldr1 Builder
b1
  Snoc Builder
b1 Bytes
x -> do
    BuilderState s
bldr1 <- BuilderState s -> Builder -> ST s (BuilderState s)
forall s. BuilderState s -> Builder -> ST s (BuilderState s)
pushCatenable BuilderState s
bldr0 Builder
b1
    Builder -> BuilderState s -> ST s (BuilderState s)
forall s. Builder -> BuilderState s -> ST s (BuilderState s)
BBU.pasteST (Bytes -> Builder
BB.bytes Bytes
x) BuilderState s
bldr1
  Append Builder
x Builder
y -> do
    BuilderState s
bldr1 <- BuilderState s -> Builder -> ST s (BuilderState s)
forall s. BuilderState s -> Builder -> ST s (BuilderState s)
pushCatenable BuilderState s
bldr0 Builder
x
    BuilderState s -> Builder -> ST s (BuilderState s)
forall s. BuilderState s -> Builder -> ST s (BuilderState s)
pushCatenable BuilderState s
bldr1 Builder
y