{-# language DataKinds #-}
{-# language GADTSyntax #-}
{-# language KindSignatures #-}
{-# language MagicHash #-}
{-# language RankNTypes #-}
{-# language ScopedTypeVariables #-}
{-# language UnboxedTuples #-}

module Data.Bytes.Builder.Bounded.Unsafe
  ( -- * Types
    Builder(..)
    -- * Construct
  , construct
    -- * Run
  , pasteST
  , pasteIO
  ) where

import Data.Kind (Type)
import Data.Primitive (MutableByteArray(..))
import GHC.Exts (Int(I#),RealWorld,Int#,State#,MutableByteArray#)
import GHC.IO (stToIO)
import GHC.ST (ST(ST))
import GHC.TypeLits (Nat)

-- | A builder parameterized by the maximum number of bytes it uses
-- when executed.
newtype Builder :: Nat -> Type where
   Builder ::
        (forall s. MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)) 
        -- ^ This function takes a buffer, an offset, and a number of remaining bytes.
        --   It returns the new offset.
     -> Builder n
   

-- | Constructor for 'Builder' that works on a function with lifted
-- arguments instead of unlifted ones. This is just as unsafe as the
-- actual constructor.
construct :: (forall s. MutableByteArray s -> Int -> ST s Int) -> Builder n
{-# inline construct #-}
construct :: (forall s. MutableByteArray s -> Int -> ST s Int) -> Builder n
construct forall s. MutableByteArray s -> Int -> ST s Int
f = (forall s.
 MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #))
-> Builder n
forall (n :: Nat).
(forall s.
 MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #))
-> Builder n
Builder
  ((forall s.
  MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #))
 -> Builder n)
-> (forall s.
    MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #))
-> Builder n
forall a b. (a -> b) -> a -> b
$ \MutableByteArray# s
arr Int#
off State# s
s0 ->
    case ST s Int -> State# s -> (# State# s, Int #)
forall s a. ST s a -> State# s -> (# State# s, a #)
unST (MutableByteArray s -> Int -> ST s Int
forall s. MutableByteArray s -> Int -> ST s Int
f (MutableByteArray# s -> MutableByteArray s
forall s. MutableByteArray# s -> MutableByteArray s
MutableByteArray MutableByteArray# s
arr) (Int# -> Int
I# Int#
off)) State# s
s0 of
      (# State# s
s1, (I# Int#
n) #) -> (# State# s
s1, Int#
n #)

-- | This function does not enforce the known upper bound on the
-- size. It is up to the user to do this.
pasteST :: Builder n -> MutableByteArray s -> Int -> ST s Int
{-# inline pasteST #-}
pasteST :: Builder n -> MutableByteArray s -> Int -> ST s Int
pasteST (Builder forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
f) (MutableByteArray MutableByteArray# s
arr) (I# Int#
off) =
  STRep s Int -> ST s Int
forall s a. STRep s a -> ST s a
ST (STRep s Int -> ST s Int) -> STRep s Int -> ST s Int
forall a b. (a -> b) -> a -> b
$ \State# s
s0 -> case MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
forall s.
MutableByteArray# s -> Int# -> State# s -> (# State# s, Int# #)
f MutableByteArray# s
arr Int#
off State# s
s0 of
    (# State# s
s1, Int#
r #) -> (# State# s
s1, (Int# -> Int
I# Int#
r) #)

-- | This function does not enforce the known upper bound on the
-- size. It is up to the user to do this.
pasteIO :: Builder n -> MutableByteArray RealWorld -> Int -> IO Int
{-# inline pasteIO #-}
pasteIO :: Builder n -> MutableByteArray RealWorld -> Int -> IO Int
pasteIO Builder n
b MutableByteArray RealWorld
m Int
off = ST RealWorld Int -> IO Int
forall a. ST RealWorld a -> IO a
stToIO (Builder n -> MutableByteArray RealWorld -> Int -> ST RealWorld Int
forall (n :: Nat) s.
Builder n -> MutableByteArray s -> Int -> ST s Int
pasteST Builder n
b MutableByteArray RealWorld
m Int
off)

unST :: ST s a -> State# s -> (# State# s, a #)
unST :: ST s a -> State# s -> (# State# s, a #)
unST (ST State# s -> (# State# s, a #)
f) = State# s -> (# State# s, a #)
f