{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE PatternSynonyms #-}

-- | @Data.Builder.Bytes@ specialized to @Bytes@.
module Data.Builder.Catenable.Bytes
  ( -- * Type
    Builder (..)

    -- * Convenient infix operators
  , pattern (:<)
  , pattern (:>)

    -- * Run
  , run

    -- * Properties
  , length

    -- * Create
  , bytes
  , byteArray

    -- * Mimic data constructors
  , cons
  , snoc
  , append
  , empty
  ) where

import Prelude hiding (length)

import Control.Monad.ST (ST, runST)
import Data.Bytes (Bytes)
import Data.Bytes.Chunks (Chunks (ChunksNil))
import Data.Primitive (ByteArray)

import qualified Data.Bytes as Bytes
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 $m:< :: forall {r}. Builder -> (Bytes -> Builder -> r) -> ((# #) -> r) -> r
$b:< :: Bytes -> Builder -> Builder
(:<) x y = Cons x y

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

-- | Number of bytes in the sequence.
length :: Builder -> Int
length :: Builder -> Int
length Builder
b0 = case Builder
b0 of
  Builder
Empty -> Int
0
  Cons Bytes
x Builder
b1 -> Bytes -> Int
Bytes.length Bytes
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Builder -> Int
length Builder
b1
  Snoc Builder
b1 Bytes
x -> Bytes -> Int
Bytes.length Bytes
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Builder -> Int
length Builder
b1
  Append Builder
x Builder
y -> Builder -> Int
length Builder
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Builder -> Int
length Builder
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 :: forall s. 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 a. a -> ST s a
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

bytes :: Bytes -> Builder
bytes :: Bytes -> Builder
bytes !Bytes
b = Bytes -> Builder -> Builder
Cons Bytes
b Builder
Empty

byteArray :: ByteArray -> Builder
byteArray :: ByteArray -> Builder
byteArray !ByteArray
b = Bytes -> Builder -> Builder
Cons (ByteArray -> Bytes
Bytes.fromByteArray ByteArray
b) Builder
Empty

snoc :: Builder -> Bytes -> Builder
{-# INLINE snoc #-}
snoc :: Builder -> Bytes -> Builder
snoc = Builder -> Bytes -> Builder
Snoc

cons :: Bytes -> Builder -> Builder
{-# INLINE cons #-}
cons :: Bytes -> Builder -> Builder
cons = Bytes -> Builder -> Builder
Cons

empty :: Builder
{-# INLINE empty #-}
empty :: Builder
empty = Builder
Empty

append :: Builder -> Builder -> Builder
{-# INLINE append #-}
append :: Builder -> Builder -> Builder
append = Builder -> Builder -> Builder
Append