module ByteString.TreeBuilder
( Builder,
byteString,
byte,
asciiIntegral,
asciiChar,
utf8Char,
utf8Ord,
utf8Text,
utf8LazyText,
intercalate,
length,
toByteString,
toLazyByteString,
)
where
import qualified ByteString.TreeBuilder.Poker as D
import ByteString.TreeBuilder.Prelude hiding (foldl, foldr, intercalate, length)
import qualified ByteString.TreeBuilder.Tree as A
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as C
import qualified Data.ByteString.Lazy.Internal as E
import qualified Data.Text
import qualified Data.Text.Lazy
data Builder
= Builder !Int !A.Tree
instance Monoid Builder where
{-# INLINE mempty #-}
mempty :: Builder
mempty =
Int -> Tree -> Builder
Builder Int
0 Tree
A.Empty
{-# INLINE mconcat #-}
mconcat :: [Builder] -> Builder
mconcat =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Monoid a => a -> a -> a
mappend forall a. Monoid a => a
mempty
instance Semigroup Builder where
{-# INLINE sconcat #-}
sconcat :: NonEmpty Builder -> Builder
sconcat =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Monoid a => a -> a -> a
mappend forall a. Monoid a => a
mempty
{-# INLINEABLE (<>) #-}
(Builder Int
length1 Tree
tree1) <> :: Builder -> Builder -> Builder
<> (Builder Int
length2 Tree
tree2) =
Int -> Tree -> Builder
Builder (Int
length1 forall a. Num a => a -> a -> a
+ Int
length2) (Tree -> Tree -> Tree
A.Branch Tree
tree1 Tree
tree2)
instance IsString Builder where
{-# INLINE fromString #-}
fromString :: String -> Builder
fromString String
string =
Int -> Tree -> Builder
Builder (ByteString -> Int
B.length ByteString
bytes) (ByteString -> Tree
A.Leaf ByteString
bytes)
where
bytes :: ByteString
bytes =
forall a. IsString a => String -> a
fromString String
string
{-# INLINE byteString #-}
byteString :: ByteString -> Builder
byteString :: ByteString -> Builder
byteString ByteString
bytes =
Int -> Tree -> Builder
Builder (ByteString -> Int
B.length ByteString
bytes) (ByteString -> Tree
A.Leaf ByteString
bytes)
{-# INLINE byte #-}
byte :: Word8 -> Builder
byte :: Word8 -> Builder
byte Word8
byte =
Int -> Tree -> Builder
Builder Int
1 (ByteString -> Tree
A.Leaf (Word8 -> ByteString
B.singleton Word8
byte))
{-# INLINEABLE asciiIntegral #-}
asciiIntegral :: (Integral a) => a -> Builder
asciiIntegral :: forall a. Integral a => a -> Builder
asciiIntegral =
\case
a
0 ->
Word8 -> Builder
byte Word8
48
a
x ->
forall a. a -> a -> Bool -> a
bool (forall a. Semigroup a => a -> a -> a
(<>) (Word8 -> Builder
byte Word8
45)) forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id (a
x forall a. Ord a => a -> a -> Bool
>= a
0)
forall a b. (a -> b) -> a -> b
$ forall {t}. Integral t => Builder -> t -> Builder
loop forall a. Monoid a => a
mempty
forall a b. (a -> b) -> a -> b
$ forall a. Num a => a -> a
abs a
x
where
loop :: Builder -> t -> Builder
loop Builder
builder t
remainder =
case t
remainder of
t
0 ->
Builder
builder
t
_ ->
case forall a. Integral a => a -> a -> (a, a)
quotRem t
remainder t
10 of
(t
quot, t
rem) ->
Builder -> t -> Builder
loop (Word8 -> Builder
byte (Word8
48 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral t
rem) forall a. Semigroup a => a -> a -> a
<> Builder
builder) t
quot
{-# INLINE asciiChar #-}
asciiChar :: Char -> Builder
asciiChar :: Char -> Builder
asciiChar =
Word8 -> Builder
byte forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> Int
ord
{-# INLINE utf8Char #-}
utf8Char :: Char -> Builder
utf8Char :: Char -> Builder
utf8Char =
Int -> Builder
utf8Ord forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> Int
ord
{-# INLINE utf8Ord #-}
utf8Ord :: Int -> Builder
utf8Ord :: Int -> Builder
utf8Ord Int
x =
if Int
x forall a. Ord a => a -> a -> Bool
<= Int
0x7F
then Word8 -> Builder
byte (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
else
if Int
x forall a. Ord a => a -> a -> Bool
<= Int
0x07FF
then
Word8 -> Builder
byte (forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int
x forall a. Bits a => a -> Int -> a
`shiftR` Int
6) forall a. Num a => a -> a -> a
+ Int
0xC0))
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
byte (forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int
x forall a. Bits a => a -> a -> a
.&. Int
0x3F) forall a. Num a => a -> a -> a
+ Int
0x80))
else
if Int
x forall a. Ord a => a -> a -> Bool
<= Int
0xFFFF
then
Word8 -> Builder
byte (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x forall a. Bits a => a -> Int -> a
`shiftR` Int
12) forall a. Num a => a -> a -> a
+ Word8
0xE0)
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
byte (forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int
x forall a. Bits a => a -> Int -> a
`shiftR` Int
6) forall a. Bits a => a -> a -> a
.&. Int
0x3F) forall a. Num a => a -> a -> a
+ Word8
0x80)
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
byte (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x forall a. Bits a => a -> a -> a
.&. Int
0x3F) forall a. Num a => a -> a -> a
+ Word8
0x80)
else
Word8 -> Builder
byte (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x forall a. Bits a => a -> Int -> a
`shiftR` Int
18) forall a. Num a => a -> a -> a
+ Word8
0xF0)
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
byte (forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int
x forall a. Bits a => a -> Int -> a
`shiftR` Int
12) forall a. Bits a => a -> a -> a
.&. Int
0x3F) forall a. Num a => a -> a -> a
+ Word8
0x80)
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
byte (forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Int
x forall a. Bits a => a -> Int -> a
`shiftR` Int
6) forall a. Bits a => a -> a -> a
.&. Int
0x3F) forall a. Num a => a -> a -> a
+ Word8
0x80)
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
byte (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
x forall a. Bits a => a -> a -> a
.&. Int
0x3F) forall a. Num a => a -> a -> a
+ Word8
0x80)
{-# INLINE utf8Text #-}
utf8Text :: Data.Text.Text -> Builder
utf8Text :: Text -> Builder
utf8Text =
forall a. (a -> Char -> a) -> a -> Text -> a
Data.Text.foldl' (\Builder
builder -> forall a. Monoid a => a -> a -> a
mappend Builder
builder forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> Builder
utf8Char) forall a. Monoid a => a
mempty
{-# INLINE utf8LazyText #-}
utf8LazyText :: Data.Text.Lazy.Text -> Builder
utf8LazyText :: Text -> Builder
utf8LazyText =
forall a. (a -> Char -> a) -> a -> Text -> a
Data.Text.Lazy.foldl' (\Builder
builder -> forall a. Monoid a => a -> a -> a
mappend Builder
builder forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> Builder
utf8Char) forall a. Monoid a => a
mempty
{-# INLINEABLE intercalate #-}
intercalate :: (Foldable f, Monoid m) => m -> f m -> m
intercalate :: forall (f :: * -> *) m. (Foldable f, Monoid m) => m -> f m -> m
intercalate m
incut =
forall a b. (a, b) -> a
fst
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\(m
acc, m -> m
incutFn) m
x -> (m -> m
incutFn (forall a. Monoid a => a -> a -> a
mappend m
x m
acc), forall a. Monoid a => a -> a -> a
mappend m
incut)) (forall a. Monoid a => a
mempty, forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id)
{-# INLINE foldr #-}
foldr :: (ByteString -> a -> a) -> a -> Builder -> a
foldr :: forall a. (ByteString -> a -> a) -> a -> Builder -> a
foldr ByteString -> a -> a
step a
init (Builder Int
length Tree
tree) =
forall a. (ByteString -> a -> a) -> a -> Tree -> a
A.foldr ByteString -> a -> a
step a
init Tree
tree
{-# INLINE length #-}
length :: Builder -> Int
length :: Builder -> Int
length (Builder Int
length Tree
tree) =
Int
length
{-# INLINEABLE toByteString #-}
toByteString :: Builder -> ByteString
toByteString :: Builder -> ByteString
toByteString (Builder Int
length Tree
tree) =
Int -> (Ptr Word8 -> IO ()) -> ByteString
C.unsafeCreate Int
length forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Tree -> Ptr Word8 -> IO (Ptr Word8)
D.pokeTree Tree
tree Ptr Word8
ptr
{-# INLINEABLE toLazyByteString #-}
toLazyByteString :: Builder -> E.ByteString
toLazyByteString :: Builder -> ByteString
toLazyByteString =
forall a. (ByteString -> a -> a) -> a -> Builder -> a
foldr ByteString -> ByteString -> ByteString
E.Chunk ByteString
E.Empty