{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Zenacy.HTML.Internal.Buffer
( Buffer(..)
, bufferNew
, bufferCapacity
, bufferSize
, bufferReset
, bufferAppend
, bufferApply
, bufferTake
, bufferContains
, bufferPack
, bufferString
) where
import Zenacy.HTML.Internal.BS
import Control.Monad.ST
( ST
)
import Data.STRef
( STRef
, newSTRef
, readSTRef
, writeSTRef
)
import qualified Data.DList as D
( empty
, snoc
, toList
)
import qualified Data.Vector.Unboxed as U
( freeze
, slice
, toList
)
import Data.Vector.Unboxed.Mutable
( MVector
)
import qualified Data.Vector.Unboxed.Mutable as U
( new
, length
, read
, write
, grow
)
import Data.Word
( Word8
)
data Buffer s = Buffer
{ Buffer s -> MVector s Int
bfCntl :: MVector s Int
, Buffer s -> MVector s Word8
bfData :: MVector s Word8
}
bufferNew :: ST s (STRef s (Buffer s))
bufferNew :: ST s (STRef s (Buffer s))
bufferNew = do
MVector s Int
c <- Int -> ST s (MVector (PrimState (ST s)) Int)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
U.new Int
1
MVector s Word8
d <- Int -> ST s (MVector (PrimState (ST s)) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
U.new Int
100
STRef s (Buffer s)
r <- Buffer s -> ST s (STRef s (Buffer s))
forall a s. a -> ST s (STRef s a)
newSTRef (MVector s Int -> MVector s Word8 -> Buffer s
forall s. MVector s Int -> MVector s Word8 -> Buffer s
Buffer MVector s Int
c MVector s Word8
d)
STRef s (Buffer s) -> ST s ()
forall s. STRef s (Buffer s) -> ST s ()
bufferReset STRef s (Buffer s)
r
STRef s (Buffer s) -> ST s (STRef s (Buffer s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure STRef s (Buffer s)
r
bufferCapacity :: STRef s (Buffer s) -> ST s (Int, Int)
bufferCapacity :: STRef s (Buffer s) -> ST s (Int, Int)
bufferCapacity STRef s (Buffer s)
r = do
Buffer{MVector s Int
MVector s Word8
bfData :: MVector s Word8
bfCntl :: MVector s Int
bfData :: forall s. Buffer s -> MVector s Word8
bfCntl :: forall s. Buffer s -> MVector s Int
..} <- STRef s (Buffer s) -> ST s (Buffer s)
forall s a. STRef s a -> ST s a
readSTRef STRef s (Buffer s)
r
(Int, Int) -> ST s (Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MVector s Int -> Int
forall a s. Unbox a => MVector s a -> Int
U.length MVector s Int
bfCntl, MVector s Word8 -> Int
forall a s. Unbox a => MVector s a -> Int
U.length MVector s Word8
bfData)
bufferSize :: STRef s (Buffer s) -> ST s Int
bufferSize :: STRef s (Buffer s) -> ST s Int
bufferSize STRef s (Buffer s)
r = do
Buffer{MVector s Int
MVector s Word8
bfData :: MVector s Word8
bfCntl :: MVector s Int
bfData :: forall s. Buffer s -> MVector s Word8
bfCntl :: forall s. Buffer s -> MVector s Int
..} <- STRef s (Buffer s) -> ST s (Buffer s)
forall s a. STRef s a -> ST s a
readSTRef STRef s (Buffer s)
r
MVector (PrimState (ST s)) Int -> Int -> ST s Int
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
U.read MVector s Int
MVector (PrimState (ST s)) Int
bfCntl Int
0
bufferReset :: STRef s (Buffer s) -> ST s ()
bufferReset :: STRef s (Buffer s) -> ST s ()
bufferReset STRef s (Buffer s)
r = do
Buffer{MVector s Int
MVector s Word8
bfData :: MVector s Word8
bfCntl :: MVector s Int
bfData :: forall s. Buffer s -> MVector s Word8
bfCntl :: forall s. Buffer s -> MVector s Int
..} <- STRef s (Buffer s) -> ST s (Buffer s)
forall s a. STRef s a -> ST s a
readSTRef STRef s (Buffer s)
r
MVector (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
U.write MVector s Int
MVector (PrimState (ST s)) Int
bfCntl Int
0 Int
0
bufferAppend :: Word8 -> STRef s (Buffer s) -> ST s ()
bufferAppend :: Word8 -> STRef s (Buffer s) -> ST s ()
bufferAppend Word8
word STRef s (Buffer s)
r = do
Buffer{MVector s Int
MVector s Word8
bfData :: MVector s Word8
bfCntl :: MVector s Int
bfData :: forall s. Buffer s -> MVector s Word8
bfCntl :: forall s. Buffer s -> MVector s Int
..} <- STRef s (Buffer s) -> ST s (Buffer s)
forall s a. STRef s a -> ST s a
readSTRef STRef s (Buffer s)
r
Int
i <- MVector (PrimState (ST s)) Int -> Int -> ST s Int
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
U.read MVector s Int
MVector (PrimState (ST s)) Int
bfCntl Int
0
MVector s Word8
d <- if Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< MVector s Word8 -> Int
forall a s. Unbox a => MVector s a -> Int
U.length MVector s Word8
bfData
then MVector s Word8 -> ST s (MVector s Word8)
forall (f :: * -> *) a. Applicative f => a -> f a
pure MVector s Word8
bfData
else do
MVector s Word8
v <- MVector (PrimState (ST s)) Word8
-> Int -> ST s (MVector (PrimState (ST s)) Word8)
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
U.grow MVector s Word8
MVector (PrimState (ST s)) Word8
bfData (Int -> ST s (MVector (PrimState (ST s)) Word8))
-> Int -> ST s (MVector (PrimState (ST s)) Word8)
forall a b. (a -> b) -> a -> b
$ MVector s Word8 -> Int
forall a s. Unbox a => MVector s a -> Int
U.length MVector s Word8
bfData
STRef s (Buffer s) -> Buffer s -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (Buffer s)
r (Buffer s -> ST s ()) -> Buffer s -> ST s ()
forall a b. (a -> b) -> a -> b
$ MVector s Int -> MVector s Word8 -> Buffer s
forall s. MVector s Int -> MVector s Word8 -> Buffer s
Buffer MVector s Int
bfCntl MVector s Word8
v
MVector s Word8 -> ST s (MVector s Word8)
forall (f :: * -> *) a. Applicative f => a -> f a
pure MVector s Word8
v
MVector (PrimState (ST s)) Word8 -> Int -> Word8 -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
U.write MVector s Word8
MVector (PrimState (ST s)) Word8
d Int
i Word8
word
MVector (PrimState (ST s)) Int -> Int -> Int -> ST s ()
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
U.write MVector s Int
MVector (PrimState (ST s)) Int
bfCntl Int
0 (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
bufferApply :: (Word8 -> ST s ()) -> STRef s (Buffer s) -> ST s ()
bufferApply :: (Word8 -> ST s ()) -> STRef s (Buffer s) -> ST s ()
bufferApply Word8 -> ST s ()
f STRef s (Buffer s)
r = do
Buffer{MVector s Int
MVector s Word8
bfData :: MVector s Word8
bfCntl :: MVector s Int
bfData :: forall s. Buffer s -> MVector s Word8
bfCntl :: forall s. Buffer s -> MVector s Int
..} <- STRef s (Buffer s) -> ST s (Buffer s)
forall s a. STRef s a -> ST s a
readSTRef STRef s (Buffer s)
r
Int
n <- MVector (PrimState (ST s)) Int -> Int -> ST s Int
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
U.read MVector s Int
MVector (PrimState (ST s)) Int
bfCntl Int
0
let go :: Int -> ST s ()
go Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n =
MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
U.read MVector s Word8
MVector (PrimState (ST s)) Word8
bfData Int
i ST s Word8 -> (Word8 -> ST s ()) -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> ST s ()
f ST s () -> ST s () -> ST s ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s ()
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
| Bool
otherwise =
() -> ST s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Int -> ST s ()
go Int
0
bufferTake :: Int -> STRef s (Buffer s) -> ST s [Word8]
bufferTake :: Int -> STRef s (Buffer s) -> ST s [Word8]
bufferTake Int
x STRef s (Buffer s)
r = do
Buffer{MVector s Int
MVector s Word8
bfData :: MVector s Word8
bfCntl :: MVector s Int
bfData :: forall s. Buffer s -> MVector s Word8
bfCntl :: forall s. Buffer s -> MVector s Int
..} <- STRef s (Buffer s) -> ST s (Buffer s)
forall s a. STRef s a -> ST s a
readSTRef STRef s (Buffer s)
r
Int
n <- Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
x (Int -> Int) -> ST s Int -> ST s Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState (ST s)) Int -> Int -> ST s Int
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
U.read MVector s Int
MVector (PrimState (ST s)) Int
bfCntl Int
0
let go :: Int -> DList Word8 -> ST s [Word8]
go Int
i DList Word8
y
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = do
Word8
a <- MVector (PrimState (ST s)) Word8 -> Int -> ST s Word8
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
U.read MVector s Word8
MVector (PrimState (ST s)) Word8
bfData Int
i
Int -> DList Word8 -> ST s [Word8]
go (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (DList Word8 -> ST s [Word8]) -> DList Word8 -> ST s [Word8]
forall a b. (a -> b) -> a -> b
$ DList Word8 -> Word8 -> DList Word8
forall a. DList a -> a -> DList a
D.snoc DList Word8
y Word8
a
| Bool
otherwise =
[Word8] -> ST s [Word8]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Word8] -> ST s [Word8]) -> [Word8] -> ST s [Word8]
forall a b. (a -> b) -> a -> b
$ DList Word8 -> [Word8]
forall a. DList a -> [a]
D.toList DList Word8
y
Int -> DList Word8 -> ST s [Word8]
go Int
0 DList Word8
forall a. DList a
D.empty
bufferContains :: [Word8] -> STRef s (Buffer s) -> ST s Bool
bufferContains :: [Word8] -> STRef s (Buffer s) -> ST s Bool
bufferContains [Word8]
x STRef s (Buffer s)
r = do
Int
n <- STRef s (Buffer s) -> ST s Int
forall s. STRef s (Buffer s) -> ST s Int
bufferSize STRef s (Buffer s)
r
if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Word8] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
x
then Bool -> ST s Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
else do
[Word8]
a <- Int -> STRef s (Buffer s) -> ST s [Word8]
forall s. Int -> STRef s (Buffer s) -> ST s [Word8]
bufferTake Int
n STRef s (Buffer s)
r
Bool -> ST s Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> ST s Bool) -> Bool -> ST s Bool
forall a b. (a -> b) -> a -> b
$ [Word8]
x [Word8] -> [Word8] -> Bool
forall a. Eq a => a -> a -> Bool
== [Word8]
a
bufferPack :: STRef s (Buffer s) -> ST s BS
bufferPack :: STRef s (Buffer s) -> ST s BS
bufferPack STRef s (Buffer s)
r = do
Buffer{MVector s Int
MVector s Word8
bfData :: MVector s Word8
bfCntl :: MVector s Int
bfData :: forall s. Buffer s -> MVector s Word8
bfCntl :: forall s. Buffer s -> MVector s Int
..} <- STRef s (Buffer s) -> ST s (Buffer s)
forall s a. STRef s a -> ST s a
readSTRef STRef s (Buffer s)
r
Int
n <- MVector (PrimState (ST s)) Int -> Int -> ST s Int
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
U.read MVector s Int
MVector (PrimState (ST s)) Int
bfCntl Int
0
MVector s Word8 -> Int -> ST s BS
forall s. MVector s Word8 -> Int -> ST s BS
bufferString MVector s Word8
bfData Int
n
bufferString :: MVector s Word8 -> Int -> ST s BS
bufferString :: MVector s Word8 -> Int -> ST s BS
bufferString MVector s Word8
v Int
n =
MVector (PrimState (ST s)) Word8 -> ST s (Vector Word8)
forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
U.freeze MVector s Word8
MVector (PrimState (ST s)) Word8
v ST s (Vector Word8) -> (Vector Word8 -> ST s BS) -> ST s BS
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BS -> ST s BS
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BS -> ST s BS) -> (Vector Word8 -> BS) -> Vector Word8 -> ST s BS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> BS
bsPack ([Word8] -> BS) -> (Vector Word8 -> [Word8]) -> Vector Word8 -> BS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Word8 -> [Word8]
forall a. Unbox a => Vector a -> [a]
U.toList (Vector Word8 -> [Word8])
-> (Vector Word8 -> Vector Word8) -> Vector Word8 -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Vector Word8 -> Vector Word8
forall a. Unbox a => Int -> Int -> Vector a -> Vector a
U.slice Int
0 Int
n