{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Defines an buffer type.
module Zenacy.HTML.Internal.Buffer
  ( Buffer(..)
  , bufferNew
  , bufferCapacity
  , bufferSize
  , bufferReset
  , bufferAppend
  , bufferApply
  , bufferTake
  , bufferContains
  , bufferPack
  , bufferString
  ) where

import Zenacy.HTML.Internal.BS
-- import Foreign
--   ( castPtr
--   , withForeignPtr
--   )
import Control.Monad.ST
  ( ST
  )
import Data.STRef
  ( STRef
  , newSTRef
  , readSTRef
  , writeSTRef
  )
import qualified Data.DList as D
  ( empty
  , snoc
  , toList
  )
-- import Data.Vector.Storable.Mutable
import qualified Data.Vector.Unboxed as U
  ( freeze
  , slice
  , toList
  )
import Data.Vector.Unboxed.Mutable
  ( MVector
  )
import qualified Data.Vector.Unboxed.Mutable as U
-- import qualified Data.Vector.Storable.Mutable as U
  ( new
  , length
  , read
  , write
  , grow
  -- , unsafeToForeignPtr0
  )
import Data.Word
  ( Word8
  )
-- import System.IO.Unsafe
--   ( unsafePerformIO
--   )

-- | A type of buffer used to hold bytes.
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
  }

-- | Makes a new buffer.
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

-- | Gets the capacity of the buffer.
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)

-- | Gets the size of the buffer.
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

-- | Resets a buffer.
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

-- | Appends a word to a buffer.
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)

-- | Applies an action to each word in the buffer.
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

-- | Takes elements from the front of the buffer.
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

-- | Determines if a buffer has the specified contents.
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

-- | Packs a buffer into a byte string.
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

-- | Converts a storable vector to a byte string.
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
  -- pure $ unsafePerformIO $ do
  --   let (f, _) = U.unsafeToForeignPtr0 v
  --   withForeignPtr f $ \p ->
  --     S.packCStringLen (castPtr p, n)