{-# language MagicHash #-}
{-# language TypeApplications #-}
{-# language ScopedTypeVariables #-}
{-# language PatternSynonyms #-}
{-# language BlockArguments #-}
{-# language BangPatterns #-}
{-# language UnboxedTuples #-}
module Text.Parsnip.Internal.Mark
( Mark(Mark,Mk)
, minusMark
, mark, release
, snip, snipping
) where

import Data.ByteString as B
import Data.Word
import GHC.Arr
import GHC.Prim
import GHC.Ptr
import GHC.Types
import Text.Parsnip.Internal.Parser
import Text.Parsnip.Internal.Private

---------------------------------------------------------------------------------------
-- * Marks
---------------------------------------------------------------------------------------

newtype Mark s = Mark (Ptr Word8) -- unexposed, so known valid addresses
  deriving (Mark s -> Mark s -> Bool
(Mark s -> Mark s -> Bool)
-> (Mark s -> Mark s -> Bool) -> Eq (Mark s)
forall s. Mark s -> Mark s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mark s -> Mark s -> Bool
$c/= :: forall s. Mark s -> Mark s -> Bool
== :: Mark s -> Mark s -> Bool
$c== :: forall s. Mark s -> Mark s -> Bool
Eq,Eq (Mark s)
Eq (Mark s)
-> (Mark s -> Mark s -> Ordering)
-> (Mark s -> Mark s -> Bool)
-> (Mark s -> Mark s -> Bool)
-> (Mark s -> Mark s -> Bool)
-> (Mark s -> Mark s -> Bool)
-> (Mark s -> Mark s -> Mark s)
-> (Mark s -> Mark s -> Mark s)
-> Ord (Mark s)
Mark s -> Mark s -> Bool
Mark s -> Mark s -> Ordering
Mark s -> Mark s -> Mark s
forall s. Eq (Mark s)
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall s. Mark s -> Mark s -> Bool
forall s. Mark s -> Mark s -> Ordering
forall s. Mark s -> Mark s -> Mark s
min :: Mark s -> Mark s -> Mark s
$cmin :: forall s. Mark s -> Mark s -> Mark s
max :: Mark s -> Mark s -> Mark s
$cmax :: forall s. Mark s -> Mark s -> Mark s
>= :: Mark s -> Mark s -> Bool
$c>= :: forall s. Mark s -> Mark s -> Bool
> :: Mark s -> Mark s -> Bool
$c> :: forall s. Mark s -> Mark s -> Bool
<= :: Mark s -> Mark s -> Bool
$c<= :: forall s. Mark s -> Mark s -> Bool
< :: Mark s -> Mark s -> Bool
$c< :: forall s. Mark s -> Mark s -> Bool
compare :: Mark s -> Mark s -> Ordering
$ccompare :: forall s. Mark s -> Mark s -> Ordering
Ord,Int -> Mark s -> ShowS
[Mark s] -> ShowS
Mark s -> String
(Int -> Mark s -> ShowS)
-> (Mark s -> String) -> ([Mark s] -> ShowS) -> Show (Mark s)
forall s. Int -> Mark s -> ShowS
forall s. [Mark s] -> ShowS
forall s. Mark s -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mark s] -> ShowS
$cshowList :: forall s. [Mark s] -> ShowS
show :: Mark s -> String
$cshow :: forall s. Mark s -> String
showsPrec :: Int -> Mark s -> ShowS
$cshowsPrec :: forall s. Int -> Mark s -> ShowS
Show)

pattern Mk :: Addr# -> Mark s
pattern $bMk :: forall s. Addr# -> Mark s
$mMk :: forall {r} {s}. Mark s -> (Addr# -> r) -> (Void# -> r) -> r
Mk a = Mark (Ptr a)
{-# complete Mk #-} -- if only...

instance KnownBase s => Bounded (Mark s) where
  minBound :: Mark s
minBound = Addr# -> Mark s
forall s. Addr# -> Mark s
Mk (forall s. KnownBase s => Addr#
start @s)
  maxBound :: Mark s
maxBound = Addr# -> Mark s
forall s. Addr# -> Mark s
Mk (forall s. KnownBase s => Addr#
end @s)
  {-# inline minBound #-}
  {-# inline maxBound #-}

instance KnownBase s => Enum (Mark s) where
  fromEnum :: Mark s -> Int
fromEnum Mark s
p = Mark s -> Mark s -> Int
forall s. Mark s -> Mark s -> Int
minusMark Mark s
p Mark s
forall a. Bounded a => a
minBound
  toEnum :: Int -> Mark s
toEnum = case forall s. KnownBase s => Base s
reflectBase @s of
    !(Base Addr#
_ ForeignPtrContents
_ Addr#
l Addr#
h) -> \(I# Int#
i) -> if Int# -> Bool
isTrue# (Int#
0# Int# -> Int# -> Int#
<=# Int#
i) Bool -> Bool -> Bool
&& Int# -> Bool
isTrue# (Int#
i Int# -> Int# -> Int#
<=# Addr# -> Addr# -> Int#
minusAddr# Addr#
h Addr#
l)
      then Addr# -> Mark s
forall s. Addr# -> Mark s
Mk (Addr# -> Int# -> Addr#
plusAddr# Addr#
l Int#
i)
      else String -> Mark s
forall a. HasCallStack => String -> a
error String
"Mark.toEnum: Out of bounds"
  succ :: Mark s -> Mark s
succ (Mk Addr#
p) = if Int# -> Bool
isTrue# (Addr# -> Addr# -> Int#
ltAddr# Addr#
p (forall s. KnownBase s => Addr#
end @s))
      then Addr# -> Mark s
forall s. Addr# -> Mark s
Mk (Addr# -> Int# -> Addr#
plusAddr# Addr#
p Int#
1#)
      else String -> Mark s
forall a. HasCallStack => String -> a
error String
"Mark.succ: Out of bounds"
  pred :: Mark s -> Mark s
pred (Mk Addr#
p) = if Int# -> Bool
isTrue# (Addr# -> Addr# -> Int#
ltAddr# (forall s. KnownBase s => Addr#
start @s) Addr#
p)
      then Addr# -> Mark s
forall s. Addr# -> Mark s
Mk (Addr# -> Int# -> Addr#
plusAddr# Addr#
p (Int# -> Int#
negateInt# Int#
1#))
      else String -> Mark s
forall a. HasCallStack => String -> a
error String
"Mark.pred: Out of bounds"
  enumFrom :: Mark s -> [Mark s]
enumFrom (Mk Addr#
p) = Addr# -> Addr# -> [Mark s]
forall s. Addr# -> Addr# -> [Mark s]
ptrs1 Addr#
p (forall s. KnownBase s => Addr#
end @s)
  enumFromTo :: Mark s -> Mark s -> [Mark s]
enumFromTo (Mk Addr#
p) (Mk Addr#
q) = Addr# -> Addr# -> [Mark s]
forall s. Addr# -> Addr# -> [Mark s]
ptrs1 Addr#
p Addr#
q
  enumFromThen :: Mark s -> Mark s -> [Mark s]
enumFromThen = case forall s. KnownBase s => Base s
reflectBase @s of
    !(Base Addr#
_ ForeignPtrContents
_ Addr#
l Addr#
h) -> \(Mk Addr#
p) (Mk Addr#
q) -> if Int# -> Bool
isTrue# (Addr# -> Addr# -> Int#
gtAddr# Addr#
p Addr#
q)
      then Addr# -> Int# -> Addr# -> [Mark s]
forall s. Addr# -> Int# -> Addr# -> [Mark s]
dptrs Addr#
p (Addr# -> Addr# -> Int#
minusAddr# Addr#
q Addr#
p) Addr#
l
      else Addr# -> Int# -> Addr# -> [Mark s]
forall s. Addr# -> Int# -> Addr# -> [Mark s]
ptrs Addr#
p (Addr# -> Addr# -> Int#
minusAddr# Addr#
q Addr#
p) Addr#
h
  enumFromThenTo :: Mark s -> Mark s -> Mark s -> [Mark s]
enumFromThenTo (Mk Addr#
p) (Mk Addr#
q) (Mk Addr#
r) = if Int# -> Bool
isTrue# (Addr# -> Addr# -> Int#
gtAddr# Addr#
p Addr#
q)
    then Addr# -> Int# -> Addr# -> [Mark s]
forall s. Addr# -> Int# -> Addr# -> [Mark s]
dptrs Addr#
p (Addr# -> Addr# -> Int#
minusAddr# Addr#
q Addr#
p) Addr#
r
    else Addr# -> Int# -> Addr# -> [Mark s]
forall s. Addr# -> Int# -> Addr# -> [Mark s]
ptrs Addr#
p (Addr# -> Addr# -> Int#
minusAddr# Addr#
q Addr#
p) Addr#
r
  {-# inline fromEnum #-}
  {-# inline toEnum #-}
  {-# inline succ #-}
  {-# inline pred #-}
  {-# inline enumFrom #-}
  {-# inline enumFromTo #-}
  {-# inline enumFromThen #-}
  {-# inline enumFromThenTo #-}

instance Ix (Mark s) where
  range :: (Mark s, Mark s) -> [Mark s]
range (Mk Addr#
p, Mk Addr#
q) = Addr# -> Addr# -> [Mark s]
forall s. Addr# -> Addr# -> [Mark s]
ptrs1 Addr#
p Addr#
q
  unsafeIndex :: (Mark s, Mark s) -> Mark s -> Int
unsafeIndex (Mark s
p,Mark s
_) Mark s
r = Mark s -> Mark s -> Int
forall s. Mark s -> Mark s -> Int
minusMark Mark s
r Mark s
p
  inRange :: (Mark s, Mark s) -> Mark s -> Bool
inRange (Mk Addr#
p, Mk Addr#
q) (Mk Addr#
r) = Int# -> Bool
isTrue# (Addr# -> Addr# -> Int#
leAddr# Addr#
p Addr#
r) Bool -> Bool -> Bool
&& Int# -> Bool
isTrue# (Addr# -> Addr# -> Int#
leAddr# Addr#
r Addr#
q)
  unsafeRangeSize :: (Mark s, Mark s) -> Int
unsafeRangeSize = (Mark s -> Mark s -> Int) -> (Mark s, Mark s) -> Int
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Mark s -> Mark s -> Int
forall s. Mark s -> Mark s -> Int
minusMark
  {-# inline range #-}
  {-# inline unsafeIndex #-}
  {-# inline inRange #-}
  {-# inline unsafeRangeSize #-}

ptrs1 :: Addr# -> Addr# -> [Mark s]
ptrs1 :: forall s. Addr# -> Addr# -> [Mark s]
ptrs1 Addr#
l Addr#
h
  | Int# -> Bool
isTrue# (Addr# -> Addr# -> Int#
leAddr# Addr#
l Addr#
h) = Addr# -> Mark s
forall s. Addr# -> Mark s
Mk Addr#
l Mark s -> [Mark s] -> [Mark s]
forall a. a -> [a] -> [a]
: Addr# -> Addr# -> [Mark s]
forall s. Addr# -> Addr# -> [Mark s]
ptrs1 (Addr# -> Int# -> Addr#
plusAddr# Addr#
l Int#
1#) Addr#
h
  | Bool
otherwise = []
{-# inline ptrs1 #-}

ptrs :: Addr# -> Int# -> Addr# -> [Mark s]
ptrs :: forall s. Addr# -> Int# -> Addr# -> [Mark s]
ptrs Addr#
l Int#
d Addr#
h
  | Int# -> Bool
isTrue# (Addr# -> Addr# -> Int#
leAddr# Addr#
l Addr#
h) = Addr# -> Mark s
forall s. Addr# -> Mark s
Mk Addr#
l Mark s -> [Mark s] -> [Mark s]
forall a. a -> [a] -> [a]
: Addr# -> Int# -> Addr# -> [Mark s]
forall s. Addr# -> Int# -> Addr# -> [Mark s]
ptrs (Addr# -> Int# -> Addr#
plusAddr# Addr#
l Int#
d) Int#
d Addr#
h
  | Bool
otherwise = []
{-# inline ptrs #-}

dptrs :: Addr# -> Int# -> Addr# -> [Mark s]
dptrs :: forall s. Addr# -> Int# -> Addr# -> [Mark s]
dptrs Addr#
h Int#
d Addr#
l
  | Int# -> Bool
isTrue# (Addr# -> Addr# -> Int#
leAddr# Addr#
l Addr#
h) = Ptr Word8 -> Mark s
forall s. Ptr Word8 -> Mark s
Mark (Addr# -> Ptr Word8
forall a. Addr# -> Ptr a
Ptr Addr#
h) Mark s -> [Mark s] -> [Mark s]
forall a. a -> [a] -> [a]
: Addr# -> Int# -> Addr# -> [Mark s]
forall s. Addr# -> Int# -> Addr# -> [Mark s]
ptrs (Addr# -> Int# -> Addr#
plusAddr# Addr#
h Int#
d) Int#
d Addr#
l
  | Bool
otherwise = []
{-# inline dptrs #-}

minusMark :: Mark s -> Mark s -> Int
minusMark :: forall s. Mark s -> Mark s -> Int
minusMark (Mk Addr#
p) (Mk Addr#
q) = Int# -> Int
I# (Addr# -> Addr# -> Int#
minusAddr# Addr#
p Addr#
q)
{-# inline minusMark #-}

-- | Record the current position
mark :: Parser s (Mark s)
mark :: forall s. Parser s (Mark s)
mark = (Addr# -> State# s -> Result s (Mark s)) -> Parser s (Mark s)
forall s a. (Addr# -> State# s -> Result s a) -> Parser s a
Parser \Addr#
p State# s
s -> Mark s -> Addr# -> State# s -> Result s (Mark s)
forall a s. a -> Addr# -> State# s -> Result s a
OK (Addr# -> Mark s
forall s. Addr# -> Mark s
Mk Addr#
p) Addr#
p State# s
s
{-# inline mark #-}

-- | Return to a previous location.
release :: Mark s -> Parser s ()
release :: forall s. Mark s -> Parser s ()
release (Mk Addr#
q) = (Addr# -> State# s -> Result s ()) -> Parser s ()
forall s a. (Addr# -> State# s -> Result s a) -> Parser s a
Parser \Addr#
_ State# s
s -> () -> Addr# -> State# s -> Result s ()
forall a s. a -> Addr# -> State# s -> Result s a
OK () Addr#
q State# s
s
{-# inline release #-}

-- | To grab all the text covered by a given parser, consider using @snipping@
-- and applying it to a combinator simply recognizes the content rather than returns
-- it. 'snipping' a 'ByteString' is significantly cheaper than assembling one from
-- smaller fragments.
snip :: forall s. KnownBase s => Mark s -> Mark s -> ByteString
snip :: forall s. KnownBase s => Mark s -> Mark s -> ByteString
snip = case forall s. KnownBase s => Base s
reflectBase @s of
  !(Base Addr#
x ForeignPtrContents
g Addr#
_ Addr#
_) -> \(Mk Addr#
i) (Mk Addr#
j) ->
    if Int# -> Bool
isTrue# (Addr# -> Addr# -> Int#
geAddr# Addr#
i Addr#
j)
    then Addr# -> ForeignPtrContents -> Int# -> ByteString
mkBS Addr#
x ForeignPtrContents
g (Addr# -> Addr# -> Int#
minusAddr# Addr#
i Addr#
j)
    else ByteString
B.empty
{-# inline snip #-}

snipping :: forall s a. KnownBase s => Parser s a -> Parser s ByteString
snipping :: forall s a. KnownBase s => Parser s a -> Parser s ByteString
snipping = case forall s. KnownBase s => Base s
reflectBase @s of
  !(Base Addr#
b ForeignPtrContents
g Addr#
r Addr#
_) -> \(Parser Addr# -> State# s -> Result s a
m) -> (Addr# -> State# s -> Result s ByteString) -> Parser s ByteString
forall s a. (Addr# -> State# s -> Result s a) -> Parser s a
Parser \Addr#
p State# s
s -> case Addr# -> State# s -> Result s a
m Addr#
p State# s
s of
    (# Option a
o, Addr#
q, State# s
t #) ->
      (# ByteString -> Option a -> Option ByteString
forall b a. b -> Option a -> Option b
setOption
        ( if Int# -> Bool
isTrue# (Addr# -> Addr# -> Int#
geAddr# Addr#
q Addr#
p)
          then Addr# -> ForeignPtrContents -> Int# -> ByteString
mkBS (Addr#
b Addr# -> Int# -> Addr#
`plusAddr#` Addr# -> Addr# -> Int#
minusAddr# Addr#
p Addr#
r) ForeignPtrContents
g (Addr# -> Addr# -> Int#
minusAddr# Addr#
q Addr#
p)
          else ByteString
B.empty
        ) Option a
o
      , Addr#
q, State# s
t #)
{-# inline snipping #-}