{-# 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
{ forall s. Buffer s -> MVector s Int
bfCntl :: MVector s Int
, forall s. Buffer s -> MVector s Word8
bfData :: MVector s Word8
}
bufferNew :: ST s (STRef s (Buffer s))
bufferNew :: forall s. ST s (STRef s (Buffer s))
bufferNew = do
MVector s Int
c <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
U.new Int
1
MVector s Word8
d <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> m (MVector (PrimState m) a)
U.new Int
100
STRef s (Buffer s)
r <- forall a s. a -> ST s (STRef s a)
newSTRef (forall s. MVector s Int -> MVector s Word8 -> Buffer s
Buffer MVector s Int
c MVector s Word8
d)
forall s. STRef s (Buffer s) -> ST s ()
bufferReset STRef s (Buffer s)
r
forall (f :: * -> *) a. Applicative f => a -> f a
pure STRef s (Buffer s)
r
bufferCapacity :: STRef s (Buffer s) -> ST s (Int, Int)
bufferCapacity :: forall s. 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
..} <- forall s a. STRef s a -> ST s a
readSTRef STRef s (Buffer s)
r
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a s. Unbox a => MVector s a -> Int
U.length MVector s Int
bfCntl, forall a s. Unbox a => MVector s a -> Int
U.length MVector s Word8
bfData)
bufferSize :: STRef s (Buffer s) -> ST s Int
bufferSize :: forall s. 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
..} <- forall s a. STRef s a -> ST s a
readSTRef STRef s (Buffer s)
r
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
U.read MVector s Int
bfCntl Int
0
bufferReset :: STRef s (Buffer s) -> ST s ()
bufferReset :: forall s. 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
..} <- forall s a. STRef s a -> ST s a
readSTRef STRef s (Buffer s)
r
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
U.write MVector s Int
bfCntl Int
0 Int
0
bufferAppend :: Word8 -> STRef s (Buffer s) -> ST s ()
bufferAppend :: forall s. 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
..} <- forall s a. STRef s a -> ST s a
readSTRef STRef s (Buffer s)
r
Int
i <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
U.read MVector s Int
bfCntl Int
0
MVector s Word8
d <- if Int
i forall a. Num a => a -> a -> a
+ Int
1 forall a. Ord a => a -> a -> Bool
< forall a s. Unbox a => MVector s a -> Int
U.length MVector s Word8
bfData
then forall (f :: * -> *) a. Applicative f => a -> f a
pure MVector s Word8
bfData
else do
MVector s Word8
v <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m (MVector (PrimState m) a)
U.grow MVector s Word8
bfData forall a b. (a -> b) -> a -> b
$ forall a s. Unbox a => MVector s a -> Int
U.length MVector s Word8
bfData
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s (Buffer s)
r forall a b. (a -> b) -> a -> b
$ forall s. MVector s Int -> MVector s Word8 -> Buffer s
Buffer MVector s Int
bfCntl MVector s Word8
v
forall (f :: * -> *) a. Applicative f => a -> f a
pure MVector s Word8
v
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
U.write MVector s Word8
d Int
i Word8
word
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
U.write MVector s Int
bfCntl Int
0 (Int
i forall a. Num a => a -> a -> a
+ Int
1)
bufferApply :: (Word8 -> ST s ()) -> STRef s (Buffer s) -> ST s ()
bufferApply :: forall s. (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
..} <- forall s a. STRef s a -> ST s a
readSTRef STRef s (Buffer s)
r
Int
n <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
U.read MVector s Int
bfCntl Int
0
let go :: Int -> ST s ()
go Int
i
| Int
i forall a. Ord a => a -> a -> Bool
< Int
n =
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
U.read MVector s Word8
bfData Int
i forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> ST s ()
f forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> ST s ()
go (Int
i forall a. Num a => a -> a -> a
+ Int
1)
| Bool
otherwise =
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 :: forall s. 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
..} <- forall s a. STRef s a -> ST s a
readSTRef STRef s (Buffer s)
r
Int
n <- forall a. Ord a => a -> a -> a
min Int
x forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
U.read MVector s Int
bfCntl Int
0
let go :: Int -> DList Word8 -> ST s [Word8]
go Int
i DList Word8
y
| Int
i forall a. Ord a => a -> a -> Bool
< Int
n = do
Word8
a <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
U.read MVector s Word8
bfData Int
i
Int -> DList Word8 -> ST s [Word8]
go (Int
i forall a. Num a => a -> a -> a
+ Int
1) forall a b. (a -> b) -> a -> b
$ forall a. DList a -> a -> DList a
D.snoc DList Word8
y Word8
a
| Bool
otherwise =
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. DList a -> [a]
D.toList DList Word8
y
Int -> DList Word8 -> ST s [Word8]
go Int
0 forall a. DList a
D.empty
bufferContains :: [Word8] -> STRef s (Buffer s) -> ST s Bool
bufferContains :: forall s. [Word8] -> STRef s (Buffer s) -> ST s Bool
bufferContains [Word8]
x STRef s (Buffer s)
r = do
Int
n <- forall s. STRef s (Buffer s) -> ST s Int
bufferSize STRef s (Buffer s)
r
if Int
n forall a. Eq a => a -> a -> Bool
/= forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
x
then forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
else do
[Word8]
a <- forall s. Int -> STRef s (Buffer s) -> ST s [Word8]
bufferTake Int
n STRef s (Buffer s)
r
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ [Word8]
x forall a. Eq a => a -> a -> Bool
== [Word8]
a
bufferPack :: STRef s (Buffer s) -> ST s BS
bufferPack :: forall s. 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
..} <- forall s a. STRef s a -> ST s a
readSTRef STRef s (Buffer s)
r
Int
n <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
U.read MVector s Int
bfCntl Int
0
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 :: forall s. MVector s Word8 -> Int -> ST s BS
bufferString MVector s Word8
v Int
n =
forall a (m :: * -> *).
(Unbox a, PrimMonad m) =>
MVector (PrimState m) a -> m (Vector a)
U.freeze MVector s Word8
v forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> BS
bsPack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Unbox a => Vector a -> [a]
U.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Unbox a => Int -> Int -> Vector a -> Vector a
U.slice Int
0 Int
n