{-# 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
  { Buffer s -> MVector s Int
bfCntl :: MVector s Int
  , Buffer s -> MVector s Word8
bfData :: MVector s Word8
  }

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

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

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

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

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

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

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

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

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

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