{-# language BangPatterns #-}
{-# language BinaryLiterals #-}
{-# language DataKinds #-}
{-# language DeriveFunctor #-}
{-# language DerivingStrategies #-}
{-# language DuplicateRecordFields #-}
{-# language GADTSyntax #-}
{-# language KindSignatures #-}
{-# language LambdaCase #-}
{-# language MagicHash #-}
{-# language MultiWayIf #-}
{-# language NamedFieldPuns #-}
{-# language PolyKinds #-}
{-# language RankNTypes #-}
{-# language ScopedTypeVariables #-}
{-# language StandaloneDeriving #-}
{-# language TypeApplications #-}
{-# language UnboxedSums #-}
{-# 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(..),uneffectful,uneffectfulInt#)
import Data.Bytes.Parser.Internal (Result(..))
import Data.Bytes.Types (Bytes(..))
import Data.Primitive (ByteArray)
import GHC.Exts (Int#,Int(I#))


-- | 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 :: 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
$sel:offset:Bytes :: Bytes -> Int
offset :: Int
offset,Int
$sel:length:Bytes :: Bytes -> Int
length :: 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# :: 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 :: 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
length :: Int
$sel:length:Bytes :: Bytes -> Int
length,Int
offset :: Int
$sel:offset:Bytes :: Bytes -> Int
offset,ByteArray
$sel:array:Bytes :: Bytes -> ByteArray
array :: 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 :: 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
length :: Int
$sel:length:Bytes :: Bytes -> Int
length,Int
offset :: Int
$sel:offset:Bytes :: Bytes -> 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 :: 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
length :: Int
$sel:length:Bytes :: Bytes -> Int
length,Int
offset :: Int
$sel:offset:Bytes :: Bytes -> 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))