content: {-# 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 (Eq,Ord,Show)
  
  pattern Mk :: Addr# -> Mark s
  pattern Mk a = Mark (Ptr a)
  {-# complete Mk #-} -- if only...
  
  instance KnownBase s => Bounded (Mark s) where
    minBound = Mk (start @s)
    maxBound = Mk (end @s)
    {-# inline minBound #-}
    {-# inline maxBound #-}
  
  instance KnownBase s => Enum (Mark s) where
    fromEnum p = minusMark p minBound
    toEnum = case reflectBase @s of
      !(Base _ _ l h) -> \(I# i) -> if isTrue# (0# <=# i) && isTrue# (i <=# minusAddr# h l)
        then Mk (plusAddr# l i)
        else error "Mark.toEnum: Out of bounds"
    succ (Mk p) = if isTrue# (ltAddr# p (end @s))
        then Mk (plusAddr# p 1#)
        else error "Mark.succ: Out of bounds"
    pred (Mk p) = if isTrue# (ltAddr# (start @s) p)
        then Mk (plusAddr# p (negateInt# 1#))
        else error "Mark.pred: Out of bounds"
    enumFrom (Mk p) = ptrs1 p (end @s)
    enumFromTo (Mk p) (Mk q) = ptrs1 p q
    enumFromThen = case reflectBase @s of
      !(Base _ _ l h) -> \(Mk p) (Mk q) -> if isTrue# (gtAddr# p q)
        then dptrs p (minusAddr# q p) l
        else ptrs p (minusAddr# q p) h
    enumFromThenTo (Mk p) (Mk q) (Mk r) = if isTrue# (gtAddr# p q)
      then dptrs p (minusAddr# q p) r
      else ptrs p (minusAddr# q p) r
    {-# inline fromEnum #-}
    {-# inline toEnum #-}
    {-# inline succ #-}
    {-# inline pred #-}
    {-# inline enumFrom #-}
    {-# inline enumFromTo #-}
    {-# inline enumFromThen #-}
    {-# inline enumFromThenTo #-}
  
  instance Ix (Mark s) where
    range (Mk p, Mk q) = ptrs1 p q
    unsafeIndex (p,_) r = minusMark r p
    inRange (Mk p, Mk q) (Mk r) = isTrue# (leAddr# p r) && isTrue# (leAddr# r q)
    unsafeRangeSize = uncurry minusMark
    {-# inline range #-}
    {-# inline unsafeIndex #-}
    {-# inline inRange #-}
    {-# inline unsafeRangeSize #-}
  
  ptrs1 :: Addr# -> Addr# -> [Mark s]
  ptrs1 l h
    | isTrue# (leAddr# l h) = Mk l : ptrs1 (plusAddr# l 1#) h
    | otherwise = []
  {-# inline ptrs1 #-}
  
  ptrs :: Addr# -> Int# -> Addr# -> [Mark s]
  ptrs l d h
    | isTrue# (leAddr# l h) = Mk l : ptrs (plusAddr# l d) d h
    | otherwise = []
  {-# inline ptrs #-}
  
  dptrs :: Addr# -> Int# -> Addr# -> [Mark s]
  dptrs h d l
    | isTrue# (leAddr# l h) = Mark (Ptr h) : ptrs (plusAddr# h d) d l
    | otherwise = []
  {-# inline dptrs #-}
  
  minusMark :: Mark s -> Mark s -> Int
  minusMark (Mk p) (Mk q) = I# (minusAddr# p q)
  {-# inline minusMark #-}
  
  -- | Record the current position
  mark :: Parser s (Mark s)
  mark = Parser \p s -> OK (Mk p) p s
  {-# inline mark #-}
  
  -- | Return to a previous location.
  release :: Mark s -> Parser s ()
  release (Mk q) = Parser \_ s -> OK () q 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 = case reflectBase @s of
    !(Base x g _ _) -> \(Mk i) (Mk j) ->
      if isTrue# (geAddr# i j)
      then mkBS x g (minusAddr# i j)
      else B.empty
  {-# inline snip #-}
  
  snipping :: forall s a. KnownBase s => Parser s a -> Parser s ByteString
  snipping = case reflectBase @s of
    !(Base b g r _) -> \(Parser m) -> Parser \p s -> case m p s of
      (# o, q, t #) ->
        (# setOption
          ( if isTrue# (geAddr# q p)
            then mkBS (b `plusAddr#` minusAddr# p r) g (minusAddr# q p)
            else B.empty
          ) o
        , q, t #)
  {-# inline snipping #-}
  