{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeFamilies #-}
module Data.Builder.Catenable
(
Builder (..)
, pattern (:<)
, pattern (:>)
, singleton
, doubleton
, tripleton
, 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 = Builder a
forall a. Builder a
Empty
instance Semigroup (Builder a) where
{-# INLINE (<>) #-}
<> :: Builder a -> Builder a -> Builder a
(<>) = 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 = SmallArray a -> [a]
SmallArray a -> [Item (SmallArray a)]
forall l. IsList l => l -> [Item l]
toList (SmallArray a -> [a])
-> (Builder a -> SmallArray a) -> Builder a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chunks a -> SmallArray a
forall a. Chunks a -> SmallArray a
Chunks.concat (Chunks a -> SmallArray a)
-> (Builder a -> Chunks a) -> Builder a -> SmallArray a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder a -> Chunks a
forall a. Builder a -> Chunks a
run
fromList :: [Item (Builder a)] -> Builder a
fromList = (Builder a -> a -> Builder a) -> Builder a -> [a] -> Builder a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Builder a
acc a
x -> Builder a
acc Builder a -> a -> Builder a
forall a. Builder a -> a -> Builder a
:> a
x) Builder a
forall a. Builder a
Empty
pattern (:<) :: a -> Builder a -> Builder a
pattern $m:< :: forall {r} {a}.
Builder a -> (a -> Builder a -> r) -> ((# #) -> r) -> r
$b:< :: forall a. a -> Builder a -> Builder a
(:<) x y = Cons x y
pattern (:>) :: Builder a -> a -> Builder a
pattern $m:> :: forall {r} {a}.
Builder a -> (Builder a -> a -> r) -> ((# #) -> r) -> r
$b:> :: forall a. Builder a -> a -> Builder a
(:>) x y = Snoc x y
run :: Builder a -> Chunks a
{-# NOINLINE run #-}
run :: forall a. Builder a -> Chunks a
run Builder a
b = (forall s. ST s (Chunks a)) -> Chunks a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Chunks a)) -> Chunks a)
-> (forall s. ST s (Chunks a)) -> Chunks a
forall a b. (a -> b) -> a -> b
$ do
Builder s a
bldr0 <- ST s (Builder s a)
forall s a. ST s (Builder s a)
STB.new
Builder s a
bldr1 <- Builder s a -> Builder a -> ST s (Builder s a)
forall s a. Builder s a -> Builder a -> ST s (Builder s a)
pushCatenable Builder s a
bldr0 Builder a
b
Builder s a -> ST s (Chunks a)
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 -> Builder s a -> ST s (Builder s a)
forall a. a -> ST s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder s a
bldr0
Cons a
x Builder a
b1 -> do
Builder s a
bldr1 <- a -> Builder s a -> ST s (Builder s a)
forall a s. a -> Builder s a -> ST s (Builder s a)
STB.push a
x Builder s a
bldr0
Builder s a -> Builder a -> ST s (Builder s a)
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 <- Builder s a -> Builder a -> ST s (Builder s a)
forall s a. Builder s a -> Builder a -> ST s (Builder s a)
pushCatenable Builder s a
bldr0 Builder a
b1
a -> Builder s a -> ST s (Builder s a)
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 <- Builder s a -> Builder a -> ST s (Builder s a)
forall s a. Builder s a -> Builder a -> ST s (Builder s a)
pushCatenable Builder s a
bldr0 Builder a
x
Builder s a -> Builder a -> ST s (Builder s a)
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 = a -> Builder a -> Builder a
forall a. a -> Builder a -> Builder a
Cons a
a Builder 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 = a -> Builder a -> Builder a
forall a. a -> Builder a -> Builder a
Cons a
a (a -> Builder a -> Builder a
forall a. a -> Builder a -> Builder a
Cons a
b Builder a
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 = Builder a -> Builder a -> Builder a
forall a. Builder a -> Builder a -> Builder a
Append (a -> Builder a -> Builder a
forall a. a -> Builder a -> Builder a
Cons a
a (a -> Builder a -> Builder a
forall a. a -> Builder a -> Builder a
Cons a
b Builder a
forall a. Builder a
Empty)) (a -> Builder a -> Builder a
forall a. a -> Builder a -> Builder a
Cons a
c Builder a
forall a. Builder a
Empty)