{-# 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 (:>)
    -- * Functions
  , singleton
  , doubleton
  , tripleton
    -- * 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 :: Builder a
mempty = forall a. Builder a
Empty

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

instance IsList (Builder a) where
  type Item (Builder a) = a
  toList :: Builder a -> [Item (Builder a)]
toList = forall l. IsList l => l -> [Item l]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Chunks a -> SmallArray a
Chunks.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Builder a -> Chunks a
run
  fromList :: [Item (Builder a)] -> Builder a
fromList = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Builder a
acc a
x -> Builder a
acc forall a. Builder a -> a -> Builder a
:> a
x) forall a. Builder a
Empty

pattern (:<) :: a -> Builder a -> Builder a
pattern $b:< :: forall a. a -> Builder a -> Builder a
$m:< :: forall {r} {a}.
Builder a -> (a -> Builder a -> r) -> ((# #) -> r) -> r
(:<) x y = Cons x y

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

run :: Builder a -> Chunks a
{-# noinline run #-}
run :: forall a. Builder a -> Chunks a
run Builder a
b = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
  Builder s a
bldr0 <- forall s a. ST s (Builder s a)
STB.new
  Builder s a
bldr1 <- forall s a. Builder s a -> Builder a -> ST s (Builder s a)
pushCatenable Builder s a
bldr0 Builder a
b
  forall s a. Builder s a -> ST s (Chunks a)
STB.freeze Builder s a
bldr1

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

singleton :: a -> Builder a
{-# inline singleton #-}
singleton :: forall a. a -> Builder a
singleton a
a = forall a. a -> Builder a -> Builder a
Cons a
a forall a. Builder a
Empty

doubleton :: a -> a -> Builder a
{-# inline doubleton #-}
doubleton :: forall a. a -> a -> Builder a
doubleton a
a a
b = forall a. a -> Builder a -> Builder a
Cons a
a (forall a. a -> Builder a -> Builder a
Cons a
b forall a. Builder a
Empty)

tripleton :: a -> a -> a -> Builder a
{-# inline tripleton #-}
tripleton :: forall a. a -> a -> a -> Builder a
tripleton a
a a
b a
c = forall a. Builder a -> Builder a -> Builder a
Append (forall a. a -> Builder a -> Builder a
Cons a
a (forall a. a -> Builder a -> Builder a
Cons a
b forall a. Builder a
Empty)) (forall a. a -> Builder a -> Builder a
Cons a
c forall a. Builder a
Empty)