{-# language BlockArguments #-}
{-# language MagicHash #-}
{-# language UnboxedTuples #-}
{-# language ScopedTypeVariables #-}
{-# language UnliftedFFITypes #-}
{-# language BangPatterns #-}
{-# language RankNTypes #-}
{-# language TypeApplications #-}
{-# language LambdaCase #-}
{-# language AllowAmbiguousTypes #-}
{-# language PolyKinds #-}
{-# language CPP #-}
module Text.Parsnip.Parser
( Parser, KnownBase
, parse
----------------------------
, try
, atEnd
, endOfInput
----------------------------
, tillSubstring
, skipTillSubstring
, skip
, skip0
, take
----------------------------
, Mark
, mark
, release
, snip
, snipping
----------------------------
, input
, pos
, betwixt
, rest
----------------------------
, loc
) where

import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Internal as B
import qualified Data.ByteString.Unsafe as B
import Foreign.C.Types
import GHC.ForeignPtr
import GHC.Prim
import GHC.Ptr
import GHC.Types
import Prelude hiding (take)
import Text.Parsnip.Internal.Mark
import Text.Parsnip.Internal.Parser
import Text.Parsnip.Internal.Private
import Text.Parsnip.Internal.Simple
import Text.Parsnip.Location

--------------------------------------------------------------------------------
-- * Combinators
--------------------------------------------------------------------------------

atEnd :: Parser s Bool
atEnd :: forall s. Parser s Bool
atEnd = (Addr# -> State# s -> Result s Bool) -> Parser s Bool
forall s a. (Addr# -> State# s -> Result s a) -> Parser s a
Parser \Addr#
p State# s
s -> case Addr# -> Int# -> State# s -> (# State# s, Char# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Char# #)
readCharOffAddr# Addr#
p Int#
0# State# s
s of
  (# State# s
t, Char#
c #) -> Bool -> Addr# -> State# s -> Result s Bool
forall a s. a -> Addr# -> State# s -> Result s a
OK (Int# -> Bool
isTrue# do Int# -> Char#
chr# Int#
0# Char# -> Char# -> Int#
`eqChar#` Char#
c) Addr#
p State# s
t

endOfInput :: Parser s ()
endOfInput :: forall s. Parser s ()
endOfInput = (Addr# -> State# s -> Result s ()) -> Parser s ()
forall s a. (Addr# -> State# s -> Result s a) -> Parser s a
Parser \Addr#
p State# s
s -> case Addr# -> Int# -> State# s -> (# State# s, Char# #)
forall d. Addr# -> Int# -> State# d -> (# State# d, Char# #)
readCharOffAddr# Addr#
p Int#
0# State# s
s of
  (# State# s
t, Char#
c #) -> (# if Int# -> Bool
isTrue# do Int# -> Char#
chr# Int#
0# Char# -> Char# -> Int#
`eqChar#` Char#
c then () -> Option ()
forall a. a -> Option a
Some () else Option ()
forall a. Option a
None, Addr#
p, State# s
t #)

take :: forall s. KnownBase s => Int -> Parser s ByteString
take :: forall s. KnownBase s => Int -> Parser s ByteString
take = case forall s. KnownBase s => Base s
reflectBase @s of
  !(Base Addr#
b ForeignPtrContents
g Addr#
q Addr#
r) -> \(I# Int#
i) -> (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 ->
    if Int# -> Bool
isTrue# (Addr# -> Addr# -> Int#
minusAddr# Addr#
r Addr#
p Int# -> Int# -> Int#
<# Int#
i)
    then Addr# -> State# s -> Result s ByteString
forall s a. Addr# -> State# s -> Result s a
Fail Addr#
p State# s
s
    else ByteString -> Addr# -> State# s -> Result s ByteString
forall a s. a -> Addr# -> State# s -> Result s a
OK (ForeignPtr Word8 -> Int -> Int -> ByteString
B.PS (Addr# -> ForeignPtrContents -> ForeignPtr Word8
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr (Addr#
b Addr# -> Int# -> Addr#
`plusAddr#` Addr# -> Addr# -> Int#
minusAddr# Addr#
p Addr#
q) ForeignPtrContents
g) Int
0 (Int# -> Int
I# Int#
i)) (Addr# -> Int# -> Addr#
plusAddr# Addr#
p Int#
i) State# s
s

-- | We can do this two ways, this way is O(1) but needs KnownBase.
skip :: forall s. KnownBase s => Int -> Parser s ()
skip :: forall s. KnownBase s => Int -> Parser s ()
skip = \(I# Int#
i) -> (Addr# -> State# s -> Result s ()) -> Parser s ()
forall s a. (Addr# -> State# s -> Result s a) -> Parser s a
Parser \Addr#
p State# s
s ->
    if Int# -> Bool
isTrue# (Addr# -> Addr# -> Int#
minusAddr# Addr#
r Addr#
p Int# -> Int# -> Int#
<# Int#
i)
    then Addr# -> State# s -> Result s ()
forall s a. Addr# -> State# s -> Result s a
Fail Addr#
p State# s
s
    else () -> Addr# -> State# s -> Result s ()
forall a s. a -> Addr# -> State# s -> Result s a
OK () (Addr# -> Int# -> Addr#
plusAddr# Addr#
p Int#
i) State# s
s
  where r :: Addr#
r = forall s. KnownBase s => Addr#
end @s

-- | Linear time, but no @KnownBase@ dependency.
skip0 :: Int -> Parser s ()
skip0 :: forall s. Int -> Parser s ()
skip0 n :: Int
n@(I# Int#
i) = (Addr# -> State# s -> Result s ()) -> Parser s ()
forall s a. (Addr# -> State# s -> Result s a) -> Parser s a
Parser \Addr#
p State# s
s -> case IO (Ptr ()) -> State# s -> (# State# s, Ptr () #)
forall a s. IO a -> State# s -> (# State# s, a #)
io (Addr# -> CInt -> CSize -> IO (Ptr ())
c_memchr Addr#
p CInt
0 (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)) State# s
s of
  (# State# s
t, Ptr Addr#
q #) -> if Int# -> Bool
isTrue# (Addr#
q Addr# -> Addr# -> Int#
`eqAddr#` Addr#
nullAddr#)
    then () -> Addr# -> State# s -> Result s ()
forall a s. a -> Addr# -> State# s -> Result s a
OK () (Addr# -> Int# -> Addr#
plusAddr# Addr#
p Int#
i) State# s
t
    else Addr# -> State# s -> Result s ()
forall s a. Addr# -> State# s -> Result s a
Fail Addr#
p State# s
s

tillSubstring :: KnownBase s => ByteString -> Parser s ByteString
tillSubstring :: forall s. KnownBase s => ByteString -> Parser s ByteString
tillSubstring ByteString
needle = (ByteString -> SimpleResult ByteString) -> Parser s ByteString
forall s a.
KnownBase s =>
(ByteString -> SimpleResult a) -> Parser s a
relative \ByteString
bs -> case ByteString -> (ByteString, ByteString)
p ByteString
bs of
    (ByteString
r, ByteString
_) -> ByteString -> Int -> SimpleResult ByteString
forall a. a -> Int -> SimpleResult a
SimpleOK ByteString
r (ByteString -> Int
B.length ByteString
r)
  where p :: ByteString -> (ByteString, ByteString)
p = ByteString -> ByteString -> (ByteString, ByteString)
B.breakSubstring ByteString
needle

foreign import ccall unsafe "string.h" strstr :: Addr# -> Addr# -> IO (Ptr ())
foreign import ccall unsafe "string.h" strlen :: Addr# -> IO CSize

skipTillSubstring :: ByteString -> Parser s ()
skipTillSubstring :: forall s. ByteString -> Parser s ()
skipTillSubstring ByteString
bneedle = case ByteString -> Int
B.length ByteString
bneedle of
  Int
0 -> () -> Parser s ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  Int
1 -> () () -> Parser s Word8 -> Parser s ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Word8 -> Parser s Word8
forall s. Word8 -> Parser s Word8
word8 (ByteString -> Word8
B.unsafeHead ByteString
bneedle)
  Int
_ -> let fneedle :: ForeignString
fneedle = ByteString -> ForeignString
packForeignString ByteString
bneedle
    in (Addr# -> State# s -> Result s ()) -> Parser s ()
forall s a. (Addr# -> State# s -> Result s a) -> Parser s a
Parser \Addr#
p State# s
s -> case IO (Ptr ()) -> State# s -> (# State# s, Ptr () #)
forall a s. IO a -> State# s -> (# State# s, a #)
io
      ( ForeignString -> (CString -> IO (Ptr ())) -> IO (Ptr ())
forall r. ForeignString -> (CString -> IO r) -> IO r
withForeignString ForeignString
fneedle \(Ptr Addr#
cneedle)->
          Addr# -> Addr# -> IO (Ptr ())
strstr Addr#
p Addr#
cneedle IO (Ptr ()) -> (Ptr () -> IO (Ptr ())) -> IO (Ptr ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr ()
q -> if Ptr ()
q Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
nullPtr
            then Ptr Any -> Int -> Ptr ()
forall a b. Ptr a -> Int -> Ptr b
plusPtr (Addr# -> Ptr Any
forall a. Addr# -> Ptr a
Ptr Addr#
p) (Int -> Ptr ()) -> (CSize -> Int) -> CSize -> Ptr ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Ptr ()) -> IO CSize -> IO (Ptr ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Addr# -> IO CSize
strlen Addr#
p
            else Ptr () -> IO (Ptr ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ptr ()
q
      ) State# s
s of (# State# s
t, Ptr Addr#
r #) -> () -> Addr# -> State# s -> Result s ()
forall a s. a -> Addr# -> State# s -> Result s a
OK () Addr#
r State# s
t


--skipTillSubstring :: ByteString -> Parser s ()
--skipTillSubstring needle = relative \bs -> case p bs of
--    (r, _) -> SimpleOK r (B.length r)
--  where p = B.breakSubstring needle


-- | @input = snip minBound maxBound@
input :: KnownBase s => Parser s ByteString
input :: forall s. KnownBase s => Parser s ByteString
input = (ByteString -> Int -> SimpleResult ByteString)
-> Parser s ByteString
forall s a.
KnownBase s =>
(ByteString -> Int -> SimpleResult a) -> Parser s a
absolute \ByteString
b Int
_ -> ByteString -> Int -> SimpleResult ByteString
forall a. a -> Int -> SimpleResult a
SimpleOK ByteString
b Int
0

-- | @rest = mark >>= \p -> snip p maxBound@
rest :: KnownBase s => Parser s ByteString
rest :: forall s. KnownBase s => Parser s ByteString
rest = (ByteString -> SimpleResult ByteString) -> Parser s ByteString
forall s a.
KnownBase s =>
(ByteString -> SimpleResult a) -> Parser s a
relative \ByteString
b -> ByteString -> Int -> SimpleResult ByteString
forall a. a -> Int -> SimpleResult a
SimpleOK ByteString
b Int
0

-- | 'snip' is a smidge faster, easier to type, if less fun to say, and
-- doesn't need you to fiddle with explicit type application to actually
-- apply.
--
-- The benefit of this combinator is that it is easy to come up with numbers
-- of bytes into a file, and this combinator will automatically trim the
-- result to the actual range of bytes available, whereas constructing an
-- illegal 'Mark' will error in 'toEnum'/'fromEnum'/'succ' or whatever other
-- combinator tries to produce one out of range to maintain the invariant
-- that a mark is always a well formed location in the content.
betwixt :: forall s. KnownBase s => Int -> Int -> ByteString
betwixt :: forall s. KnownBase s => Int -> Int -> ByteString
betwixt Int
i Int
j = Int -> ByteString -> ByteString
B.take (Int
jInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.drop Int
i (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ forall s. KnownBase s => ByteString
bytes @s

-- | 'mark' is generally faster
pos :: forall s. KnownBase s => Parser s Int
pos :: forall s. KnownBase s => Parser s Int
pos = (Addr# -> State# s -> Result s Int) -> Parser s Int
forall s a. (Addr# -> State# s -> Result s a) -> Parser s a
Parser \ Addr#
p State# s
s -> Int -> Addr# -> State# s -> Result s Int
forall a s. a -> Addr# -> State# s -> Result s a
OK (Int# -> Int
I# (Addr# -> Addr# -> Int#
minusAddr# Addr#
p (forall s. KnownBase s => Addr#
start @s))) Addr#
p State# s
s
{-# inline pos #-}

loc :: KnownBase s => Parser s Location
loc :: forall s. KnownBase s => Parser s Location
loc = Mark s -> Location
forall s. KnownBase s => Mark s -> Location
markLocation (Mark s -> Location) -> Parser s (Mark s) -> Parser s Location
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser s (Mark s)
forall s. Parser s (Mark s)
mark
{-# inline loc #-}

-- | Actually looking at one of these is pretty slow, as it has to do a linear
-- scan to figure out its line number for display.
markLocation :: forall s. KnownBase s => Mark s -> Location
markLocation :: forall s. KnownBase s => Mark s -> Location
markLocation (Mark (Ptr Addr#
p)) = ByteString -> Int -> Location
location (forall s. KnownBase s => ByteString
bytes @s) (Int# -> Int
I# (Addr# -> Addr# -> Int#
minusAddr# Addr#
p (forall s. KnownBase s => Addr#
start @s)))
{-# inline markLocation #-}