{-# LANGUAGE DerivingStrategies, DerivingVia #-}

module FlatParse.Common.Position
  ( Pos(..), endPos, addrToPos#, posToAddr#
  , Span(..), unsafeSlice, leftPos, rightPos
  ) where

import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B
import GHC.Int
import GHC.ForeignPtr ( ForeignPtr(..) )
import GHC.Exts

-- | Byte offset counted backwards from the end of the buffer.
--   Note: the `Ord` instance for `Pos` considers the earlier positions to be
--   smaller.
newtype Pos = Pos { Pos -> Int
unPos :: Int }
    deriving stock (Int -> Pos -> ShowS
[Pos] -> ShowS
Pos -> String
(Int -> Pos -> ShowS)
-> (Pos -> String) -> ([Pos] -> ShowS) -> Show Pos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Pos -> ShowS
showsPrec :: Int -> Pos -> ShowS
$cshow :: Pos -> String
show :: Pos -> String
$cshowList :: [Pos] -> ShowS
showList :: [Pos] -> ShowS
Show)
    deriving Pos -> Pos -> Bool
(Pos -> Pos -> Bool) -> (Pos -> Pos -> Bool) -> Eq Pos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Pos -> Pos -> Bool
== :: Pos -> Pos -> Bool
$c/= :: Pos -> Pos -> Bool
/= :: Pos -> Pos -> Bool
Eq via Int

instance Ord Pos where
  <= :: Pos -> Pos -> Bool
(<=) (Pos Int
x) (Pos Int
y) = Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
x
  {-# inline (<=) #-}
  compare :: Pos -> Pos -> Ordering
compare (Pos Int
x) (Pos Int
y) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
y Int
x
  {-# inline compare #-}

-- | A pair of positions.
data Span = Span !Pos !Pos
    deriving stock (Span -> Span -> Bool
(Span -> Span -> Bool) -> (Span -> Span -> Bool) -> Eq Span
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Span -> Span -> Bool
== :: Span -> Span -> Bool
$c/= :: Span -> Span -> Bool
/= :: Span -> Span -> Bool
Eq, Int -> Span -> ShowS
[Span] -> ShowS
Span -> String
(Int -> Span -> ShowS)
-> (Span -> String) -> ([Span] -> ShowS) -> Show Span
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Span -> ShowS
showsPrec :: Int -> Span -> ShowS
$cshow :: Span -> String
show :: Span -> String
$cshowList :: [Span] -> ShowS
showList :: [Span] -> ShowS
Show)

-- | Very unsafe conversion between a primitive address and a position.  The
--   first argument points to the end of the buffer, the second argument is
--   being converted.
addrToPos# :: Addr# -> Addr# -> Pos
addrToPos# :: Addr# -> Addr# -> Pos
addrToPos# Addr#
eob Addr#
s = Int -> Pos
Pos (Int# -> Int
I# (Addr# -> Addr# -> Int#
minusAddr# Addr#
eob Addr#
s))
{-# inline addrToPos# #-}

-- | Very unsafe conversion between a primitive address and a position.  The
--   first argument points to the end of the buffer.
posToAddr# :: Addr# -> Pos -> Addr#
posToAddr# :: Addr# -> Pos -> Addr#
posToAddr# Addr#
eob (Pos (I# Int#
n)) = Int# -> Addr#
forall a b. a -> b
unsafeCoerce# (Addr# -> Addr# -> Int#
minusAddr# Addr#
eob (Int# -> Addr#
forall a b. a -> b
unsafeCoerce# Int#
n))
{-# inline posToAddr# #-}

-- | Slice into a `B.ByteString` using a `Span`. The result is invalid if the `Span`
--   is not a valid slice of the first argument.
unsafeSlice :: B.ByteString -> Span -> B.ByteString
unsafeSlice :: ByteString -> Span -> ByteString
unsafeSlice (B.PS (ForeignPtr Addr#
addr ForeignPtrContents
fp) (I# Int#
start) (I# Int#
len))
            (Span (Pos (I# Int#
o1)) (Pos (I# Int#
o2))) =
  let end :: Addr#
end = Addr#
addr Addr# -> Int# -> Addr#
`plusAddr#` Int#
start Addr# -> Int# -> Addr#
`plusAddr#` Int#
len
  in ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS (Addr# -> ForeignPtrContents -> ForeignPtr Word8
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr (Addr# -> Int# -> Addr#
plusAddr# Addr#
end (Int# -> Int#
negateInt# Int#
o1)) ForeignPtrContents
fp) (Int# -> Int
I# Int#
0#) (Int# -> Int
I# (Int#
o1 Int# -> Int# -> Int#
-# Int#
o2))
{-# inline unsafeSlice #-}

-- | The end of the input.
endPos :: Pos
endPos :: Pos
endPos = Int -> Pos
Pos Int
0
{-# inline endPos #-}

leftPos :: Span -> Pos
leftPos :: Span -> Pos
leftPos (Span Pos
p Pos
_) = Pos
p
{-# inline leftPos #-}

rightPos :: Span -> Pos
rightPos :: Span -> Pos
rightPos (Span Pos
_ Pos
p) = Pos
p
{-# inline rightPos #-}