{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTSyntax #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UnboxedTuples #-}

{- | Everything in this module is unsafe and can lead to
nondeterministic output or segfaults if used incorrectly.
-}
module Data.Bytes.Parser.Unsafe
  ( -- * Types
    Parser (..)

    -- * Functions
  , cursor
  , cursor#
  , expose
  , unconsume
  , jump
  , uneffectful
  ) where

import Prelude hiding (length)

import Data.Bytes.Parser.Internal (Parser (..), Result (..), uneffectful, uneffectfulInt#)
import Data.Bytes.Types (Bytes (..))
import Data.Primitive (ByteArray)
import GHC.Exts (Int (I#), Int#)

{- | Get the current offset into the chunk. Using this makes
it possible to observe the internal difference between 'Bytes'
that refer to equivalent slices. Be careful.
-}
cursor :: Parser e s Int
cursor :: forall e s. Parser e s Int
cursor = (Bytes -> Result e Int) -> Parser e s Int
forall e a s. (Bytes -> Result e a) -> Parser e s a
uneffectful ((Bytes -> Result e Int) -> Parser e s Int)
-> (Bytes -> Result e Int) -> Parser e s Int
forall a b. (a -> b) -> a -> b
$ \Bytes {Int
offset :: Int
$sel:offset:Bytes :: Bytes -> Int
offset, Int
length :: Int
$sel:length:Bytes :: Bytes -> Int
length} ->
  Int -> Int -> Int -> Result e Int
forall e a. a -> Int -> Int -> Result e a
Success Int
offset Int
offset Int
length

-- | Variant of 'cursor' with unboxed result.
cursor# :: Parser e s Int#
cursor# :: forall e s. Parser e s Int#
cursor# = (Bytes -> Result# e Int#) -> Parser e s Int#
forall e s. (Bytes -> Result# e Int#) -> Parser e s Int#
uneffectfulInt# ((Bytes -> Result# e Int#) -> Parser e s Int#)
-> (Bytes -> Result# e Int#) -> Parser e s Int#
forall a b. (a -> b) -> a -> b
$ \Bytes {$sel:offset:Bytes :: Bytes -> Int
offset = I# Int#
off, $sel:length:Bytes :: Bytes -> Int
length = I# Int#
len} -> (# | (# Int#
off, Int#
off, Int#
len #) #)

{- | Return the byte array being parsed. This includes bytes
that preceed the current offset and may include bytes that
go beyond the length. This is somewhat dangerous, so only
use this is you know what you're doing.
-}
expose :: Parser e s ByteArray
expose :: forall e s. Parser e s ByteArray
expose = (Bytes -> Result e ByteArray) -> Parser e s ByteArray
forall e a s. (Bytes -> Result e a) -> Parser e s a
uneffectful ((Bytes -> Result e ByteArray) -> Parser e s ByteArray)
-> (Bytes -> Result e ByteArray) -> Parser e s ByteArray
forall a b. (a -> b) -> a -> b
$ \Bytes {Int
$sel:length:Bytes :: Bytes -> Int
length :: Int
length, Int
$sel:offset:Bytes :: Bytes -> Int
offset :: Int
offset, ByteArray
array :: ByteArray
$sel:array:Bytes :: Bytes -> ByteArray
array} ->
  ByteArray -> Int -> Int -> Result e ByteArray
forall e a. a -> Int -> Int -> Result e a
Success ByteArray
array Int
offset Int
length

{- | Move the cursor back by @n@ bytes. Precondition: you
must have previously consumed at least @n@ bytes.
-}
unconsume :: Int -> Parser e s ()
unconsume :: forall e s. Int -> Parser e s ()
unconsume Int
n = (Bytes -> Result e ()) -> Parser e s ()
forall e a s. (Bytes -> Result e a) -> Parser e s a
uneffectful ((Bytes -> Result e ()) -> Parser e s ())
-> (Bytes -> Result e ()) -> Parser e s ()
forall a b. (a -> b) -> a -> b
$ \Bytes {Int
$sel:length:Bytes :: Bytes -> Int
length :: Int
length, Int
$sel:offset:Bytes :: Bytes -> Int
offset :: Int
offset} ->
  () -> Int -> Int -> Result e ()
forall e a. a -> Int -> Int -> Result e a
Success () (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n) (Int
length Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)

{- | Set the position to the given index. Precondition: the index
must be valid. It should be the result of an earlier call to
'cursor'.
-}
jump :: Int -> Parser e s ()
jump :: forall e s. Int -> Parser e s ()
jump Int
ix = (Bytes -> Result e ()) -> Parser e s ()
forall e a s. (Bytes -> Result e a) -> Parser e s a
uneffectful ((Bytes -> Result e ()) -> Parser e s ())
-> (Bytes -> Result e ()) -> Parser e s ()
forall a b. (a -> b) -> a -> b
$ \(Bytes {Int
$sel:length:Bytes :: Bytes -> Int
length :: Int
length, Int
$sel:offset:Bytes :: Bytes -> Int
offset :: Int
offset}) ->
  () -> Int -> Int -> Result e ()
forall e a. a -> Int -> Int -> Result e a
Success () Int
ix (Int
length Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
offset Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
ix))