{-# LANGUAGE
    BangPatterns
  , UnboxedTuples
  , UnboxedSums
  , MagicHash
  , RebindableSyntax
  , ScopedTypeVariables
  , RecordWildCards
  , NamedFieldPuns
#-}

-- The parser lives in its own module because it uses RebindableSyntax,
-- which adversely affects inference and error messages.
module Url.Rebind
  ( decodeUrl
  ) where

import Prelude hiding ((>>=),(>>),pure)
import Data.Bytes.Parser.Rebindable ((>>),(>>=),pure)

import Data.Bytes.Types (Bytes(..))
import Data.Char (ord)
import Data.Word (Word8)
import GHC.Exts (Int(I#),Int#,(+#),(<#),(-#),orI#,(>=#),(==#),(>#))
import GHC.Word (Word16(W16#))
import Url.Unsafe (Url(..),ParseError(..))
import qualified Data.Bytes.Parser as P
import qualified Data.Bytes.Parser.Latin as P (skipUntil, char, char2, decWord16, skipDigits1)
import qualified Data.Bytes.Parser.Unsafe as PU
import qualified GHC.Exts as Exts

-- | Decode a hierarchical URL
decodeUrl :: Bytes -> Either ParseError Url
decodeUrl :: Bytes -> Either ParseError Url
decodeUrl Bytes
urlSerialization = (forall s. Parser ParseError s Url)
-> Bytes -> Either ParseError Url
forall e a. (forall s. Parser e s a) -> Bytes -> Either e a
P.parseBytesEither forall s. Parser ParseError s Url
parserUrl Bytes
urlSerialization

parserAuthority :: Int# -> P.Parser ParseError s (# Int#, Int#, Int#, Int#, Int# #)
{-# inline parserAuthority #-}
parserAuthority :: Int# -> Parser ParseError s (# Int#, Int#, Int#, Int#, Int# #)
parserAuthority Int#
urlSchemeEnd = do
  Int#
userStart <- Parser ParseError s Int#
forall e s. Parser e s Int#
PU.cursor#
  Int#
i3 <- Parser ParseError s () -> Parser ParseError s Int#
forall e s a. Parser e s a -> Parser e s Int#
P.measure_# (Char -> Parser ParseError s ()
forall e s. Char -> Parser e s ()
P.skipUntil Char
':')
  Int -> Parser ParseError s ()
forall e s. Int -> Parser e s ()
PU.unconsume (Int# -> Int
I# Int#
i3)
  Int#
i4 <- Parser ParseError s () -> Parser ParseError s Int#
forall e s a. Parser e s a -> Parser e s Int#
P.measure_# (Char -> Parser ParseError s ()
forall e s. Char -> Parser e s ()
P.skipUntil Char
'@')
  Int -> Parser ParseError s ()
forall e s. Int -> Parser e s ()
PU.unconsume (Int# -> Int
I# Int#
i4)
  Int#
i5 <- Parser ParseError s () -> Parser ParseError s Int#
forall e s a. Parser e s a -> Parser e s Int#
P.measure_# (Char -> Parser ParseError s ()
forall e s. Char -> Parser e s ()
P.skipUntil Char
'/')
  Int -> Parser ParseError s ()
forall e s. Int -> Parser e s ()
PU.unconsume (Int# -> Int
I# Int#
i5)
  Int#
urlUsernameEnd <- ( case (Int#
i4 Int# -> Int# -> Int#
>=# Int#
i5) Int# -> Int# -> Int#
`orI#` (Int#
i3 Int# -> Int# -> Int#
==# Int#
i4) of
          Int#
1# -> Int -> Parser ParseError s ()
forall e s. Int -> Parser e s ()
PU.jump (Int# -> Int
I# Int#
userStart) Parser ParseError s ()
-> Parser ParseError s Int# -> Parser ParseError s Int#
forall e s a b.
Bind 'LiftedRep 'LiftedRep =>
Parser e s a -> Parser e s b -> Parser e s b
>> Int# -> Parser ParseError s Int#
forall e s a. Pure 'LiftedRep => a -> Parser e s a
pure Int#
userStart
          Int#
_ -> let jumpi :: Int#
jumpi = Int#
i4 in
            case Int#
i3 Int# -> Int# -> Int#
<# Int#
i4 of
              Int#
1# -> Int -> Parser ParseError s ()
forall e s. Int -> Parser e s ()
PU.jump (Int# -> Int
I# (Int#
userStart Int# -> Int# -> Int#
+# Int#
jumpi Int# -> Int# -> Int#
+# Int#
1# )) Parser ParseError s ()
-> Parser ParseError s Int# -> Parser ParseError s Int#
forall e s a b.
Bind 'LiftedRep 'LiftedRep =>
Parser e s a -> Parser e s b -> Parser e s b
>> Int# -> Parser ParseError s Int#
forall e s a. Pure 'LiftedRep => a -> Parser e s a
pure (Int#
userStart Int# -> Int# -> Int#
+# Int#
i3)
              Int#
_ -> Int -> Parser ParseError s ()
forall e s. Int -> Parser e s ()
PU.jump (Int# -> Int
I# (Int#
userStart Int# -> Int# -> Int#
+# Int#
jumpi Int# -> Int# -> Int#
+# Int#
1# )) Parser ParseError s ()
-> Parser ParseError s Int# -> Parser ParseError s Int#
forall e s a b.
Bind 'LiftedRep 'LiftedRep =>
Parser e s a -> Parser e s b -> Parser e s b
>> Int# -> Parser ParseError s Int#
forall e s a. Pure 'LiftedRep => a -> Parser e s a
pure (Int#
userStart Int# -> Int# -> Int#
+# Int#
i4)
      )
  Int#
urlHostStart <- Parser ParseError s Int#
forall e s. Parser e s Int#
PU.cursor#
  Int#
colonSlashNeither <- ParseError -> Word8 -> Word8 -> Parser ParseError s Int#
forall e s. e -> Word8 -> Word8 -> Parser e s Int#
P.skipTrailedBy2# ParseError
EndOfInput (Char -> Word8
c2w Char
':') (Char -> Word8
c2w Char
'/') Parser ParseError s Int# -> Int# -> Parser ParseError s Int#
forall e x s. Parser x s Int# -> Int# -> Parser e s Int#
`orElse#` Int#
2#
  (# !Int#
urlHostEnd, !Int#
urlPort #) <- case Int#
colonSlashNeither of
    Int#
0# -> do
      Int#
urlHostEnd <- Parser ParseError s Int#
forall e s. Parser e s Int#
PU.cursor# -- ':' encountered first
      (W16# Word#
urlPort) <- ParseError -> Parser ParseError s Word16
forall e s. e -> Parser e s Word16
P.decWord16 ParseError
InvalidPort
      (# Int#, Int# #) -> Parser ParseError s (# Int#, Int# #)
forall e s a. Pure 'LiftedRep => a -> Parser e s a
pure (# Int#
urlHostEnd Int# -> Int# -> Int#
-# Int#
1#, Word# -> Int#
Exts.word2Int# Word#
urlPort #)
    Int#
1# -> do -- '/' encountered first
      Int#
urlHostEnd' <- Parser ParseError s Int#
forall e s. Parser e s Int#
PU.cursor#
      -- Backing up by one since we want to put the slash back
      -- to let it be part of the path.
      let urlHostEnd :: Int#
urlHostEnd = Int#
urlHostEnd' Int# -> Int# -> Int#
-# Int#
1#
      Int -> Parser ParseError s ()
forall e s. Int -> Parser e s ()
PU.jump (Int# -> Int
I# Int#
urlHostEnd)
      (# Int#, Int# #) -> Parser ParseError s (# Int#, Int# #)
forall e s a. Pure 'LiftedRep => a -> Parser e s a
pure (# Int#
urlHostEnd, Int#
0x10000# #)
    Int#
_ -> do -- neither encountered
      Int#
urlHostEnd <- Parser ParseError s Int#
forall e s. Parser e s Int#
PU.cursor#
      Int -> Parser ParseError s ()
forall e s. Int -> Parser e s ()
PU.jump (Int# -> Int
I# Int#
urlHostEnd)
      (# Int#, Int# #) -> Parser ParseError s (# Int#, Int# #)
forall e s a. Pure 'LiftedRep => a -> Parser e s a
pure (# Int#
urlHostEnd, Int#
0x10000# #)
  (# Int#, Int#, Int#, Int#, Int# #)
-> Parser ParseError s (# Int#, Int#, Int#, Int#, Int# #)
forall e s a. Pure 'LiftedRep => a -> Parser e s a
pure
    (# Int#
urlSchemeEnd 
    , Int#
urlUsernameEnd 
    , Int#
urlHostStart  
    , Int#
urlHostEnd    
    , Int#
urlPort       
    #)

-- | Parser type from @bytesmith@
-- Note: non-hierarchical Urls (such as relative paths) will not currently parse.
parserUrl :: P.Parser ParseError s Url
parserUrl :: Parser ParseError s Url
parserUrl = do
  urlSerialization :: Bytes
urlSerialization@(Bytes ByteArray
_ Int
_ (I# Int#
len)) <- Parser ParseError s Bytes
forall e s. Parser e s Bytes
P.peekRemaining 
  Int#
start <- Parser ParseError s Int#
forall e s. Parser e s Int#
PU.cursor#
  (I# Int#
i1, !Bool
slashFirst) <- Parser ParseError s Bool -> Parser ParseError s (Int, Bool)
forall e s a. Parser e s a -> Parser e s (Int, a)
P.measure (Parser ParseError s Bool -> Parser ParseError s (Int, Bool))
-> Parser ParseError s Bool -> Parser ParseError s (Int, Bool)
forall a b. (a -> b) -> a -> b
$
               ParseError -> Word8 -> Word8 -> Parser ParseError s Bool
forall e s. e -> Word8 -> Word8 -> Parser e s Bool
P.skipTrailedBy2 ParseError
EndOfInput (Char -> Word8
c2w Char
':') (Char -> Word8
c2w Char
'/')
    Parser ParseError s Bool
-> Parser ParseError s Bool -> Parser ParseError s Bool
forall x s a e. Parser x s a -> Parser e s a -> Parser e s a
`P.orElse` Bool -> Parser ParseError s Bool
forall e s a. Pure 'LiftedRep => a -> Parser e s a
pure Bool
True
  (# Int#
urlSchemeEnd, Int#
urlUsernameEnd, Int#
urlHostStart, Int#
urlHostEnd, Int#
urlPort #) <- case Bool
slashFirst of
    Bool
False ->
      -- If we see something like "abc://" with a colon followed by two
      -- slashes, we assume that the authority is present ("abc" in
      -- this case).
      Parser ParseError s () -> Parser ParseError s Int#
forall x s a e. Parser x s a -> Parser e s Int#
succeeded (ParseError -> Char -> Char -> Parser ParseError s ()
forall e s. e -> Char -> Char -> Parser e s ()
P.char2 ParseError
InvalidAuthority Char
'/' Char
'/') Parser ParseError s Int#
-> (Int# -> Parser ParseError s (# Int#, Int#, Int#, Int#, Int# #))
-> Parser ParseError s (# Int#, Int#, Int#, Int#, Int# #)
forall e s a b.
Bind 'LiftedRep 'LiftedRep =>
Parser e s a -> (a -> Parser e s b) -> Parser e s b
>>= \Int#
hasAuthorityA -> do
        let urlSchemeEnd :: Int#
urlSchemeEnd = (Int#
i1 Int# -> Int# -> Int#
-# Int#
1# )
        case Int#
hasAuthorityA of
          Int#
0# -> Parser () s () -> Parser ParseError s Int#
forall x s a e. Parser x s a -> Parser e s Int#
succeeded (() -> Parser () s ()
forall e s. e -> Parser e s ()
P.skipDigits1 () Parser () s () -> Parser () s () -> Parser () s ()
forall e s a b.
Bind 'LiftedRep 'LiftedRep =>
Parser e s a -> Parser e s b -> Parser e s b
>> () -> Char -> Parser () s ()
forall e s. e -> Char -> Parser e s ()
P.char () Char
'/') Parser ParseError s Int#
-> (Int# -> Parser ParseError s (# Int#, Int#, Int#, Int#, Int# #))
-> Parser ParseError s (# Int#, Int#, Int#, Int#, Int# #)
forall e s a b.
Bind 'LiftedRep 'LiftedRep =>
Parser e s a -> (a -> Parser e s b) -> Parser e s b
>>= \Int#
hasAuthorityB ->
            -- Here, we are looking for things like "example.com:8888/" that
            -- are missing the scheme but include a port.
            case Int#
hasAuthorityB of
              Int#
0# -> (# Int#, Int#, Int#, Int#, Int# #)
-> Parser ParseError s (# Int#, Int#, Int#, Int#, Int# #)
forall e s a. Pure 'LiftedRep => a -> Parser e s a
pure (# Int#
urlSchemeEnd, Int#
urlSchemeEnd, Int#
urlSchemeEnd, Int#
urlSchemeEnd, Int#
0x10000# #)
              Int#
_ -> Int -> Parser ParseError s ()
forall e s. Int -> Parser e s ()
PU.jump (Int# -> Int
I# Int#
start) Parser ParseError s ()
-> Parser ParseError s (# Int#, Int#, Int#, Int#, Int# #)
-> Parser ParseError s (# Int#, Int#, Int#, Int#, Int# #)
forall e s a b.
Bind 'LiftedRep 'LiftedRep =>
Parser e s a -> Parser e s b -> Parser e s b
>> Int# -> Parser ParseError s (# Int#, Int#, Int#, Int#, Int# #)
forall s.
Int# -> Parser ParseError s (# Int#, Int#, Int#, Int#, Int# #)
parserAuthority Int#
start
          Int#
_ -> Int# -> Parser ParseError s (# Int#, Int#, Int#, Int#, Int# #)
forall s.
Int# -> Parser ParseError s (# Int#, Int#, Int#, Int#, Int# #)
parserAuthority Int#
urlSchemeEnd
    Bool
True ->
      Int -> Parser ParseError s ()
forall e s. Int -> Parser e s ()
PU.jump (Int# -> Int
I# Int#
start) Parser ParseError s ()
-> Parser ParseError s (# Int#, Int#, Int#, Int#, Int# #)
-> Parser ParseError s (# Int#, Int#, Int#, Int#, Int# #)
forall e s a b.
Bind 'LiftedRep 'LiftedRep =>
Parser e s a -> Parser e s b -> Parser e s b
>> Int# -> Parser ParseError s (# Int#, Int#, Int#, Int#, Int# #)
forall s.
Int# -> Parser ParseError s (# Int#, Int#, Int#, Int#, Int# #)
parserAuthority Int#
start 
  Int#
urlPathStart <- Parser ParseError s Int#
forall e s. Parser e s Int#
PU.cursor#
  Int#
i8 <- Parser ParseError s () -> Parser ParseError s Int#
forall e s a. Parser e s a -> Parser e s Int#
P.measure_# (Char -> Parser ParseError s ()
forall e s. Char -> Parser e s ()
P.skipUntil Char
'?')
  Int -> Parser ParseError s ()
forall e s. Int -> Parser e s ()
PU.unconsume (Int# -> Int
I# Int#
i8)
  Int#
i9 <- Parser ParseError s () -> Parser ParseError s Int#
forall e s a. Parser e s a -> Parser e s Int#
P.measure_# (Char -> Parser ParseError s ()
forall e s. Char -> Parser e s ()
P.skipUntil Char
'#')
  Int -> Parser ParseError s ()
forall e s. Int -> Parser e s ()
PU.unconsume (Int# -> Int
I# Int#
i9)
  (# !Int#
urlQueryStart, !Int#
urlFragmentStart #) <- case Int# -> Int# -> Ordering
intCompare# Int#
i8 Int#
i9 of
    Ordering
EQ -> (# Int#, Int# #) -> Parser ParseError s (# Int#, Int# #)
forall e s a. Pure 'LiftedRep => a -> Parser e s a
pure (# Int#
len, Int#
len #)
    Ordering
LT -> Char -> Parser ParseError s ()
forall e s. Char -> Parser e s ()
P.skipUntil Char
'#' Parser ParseError s ()
-> Parser ParseError s (# Int#, Int# #)
-> Parser ParseError s (# Int#, Int# #)
forall e s a b.
Bind 'LiftedRep 'LiftedRep =>
Parser e s a -> Parser e s b -> Parser e s b
>> 
      let !urlFragmentStart :: Int#
urlFragmentStart = Int#
i9 Int# -> Int# -> Int#
+# Int#
urlPathStart
       in (# Int#, Int# #) -> Parser ParseError s (# Int#, Int# #)
forall e s a. Pure 'LiftedRep => a -> Parser e s a
pure (# (Int#
i8 Int# -> Int# -> Int#
+# Int#
urlPathStart), Int#
urlFragmentStart #)
    Ordering
GT -> Char -> Parser ParseError s ()
forall e s. Char -> Parser e s ()
P.skipUntil Char
'#' Parser ParseError s ()
-> Parser ParseError s (# Int#, Int# #)
-> Parser ParseError s (# Int#, Int# #)
forall e s a b.
Bind 'LiftedRep 'LiftedRep =>
Parser e s a -> Parser e s b -> Parser e s b
>> 
      let !urlFragmentStart :: Int#
urlFragmentStart = Int#
i9 Int# -> Int# -> Int#
+# Int#
urlPathStart
       in (# Int#, Int# #) -> Parser ParseError s (# Int#, Int# #)
forall e s a. Pure 'LiftedRep => a -> Parser e s a
pure (# Int#
urlFragmentStart, Int#
urlFragmentStart #)
  Url -> Parser ParseError s Url
forall e s a. Pure 'LiftedRep => a -> Parser e s a
pure (Url :: Bytes
-> Int#
-> Int#
-> Int#
-> Int#
-> Int#
-> Int#
-> Int#
-> Int#
-> Url
Url {Int#
Bytes
urlFragmentStart :: Int#
urlQueryStart :: Int#
urlPathStart :: Int#
urlPort :: Int#
urlHostEnd :: Int#
urlHostStart :: Int#
urlUsernameEnd :: Int#
urlSchemeEnd :: Int#
urlSerialization :: Bytes
urlFragmentStart :: Int#
urlQueryStart :: Int#
urlPathStart :: Int#
urlPort :: Int#
urlHostEnd :: Int#
urlHostStart :: Int#
urlUsernameEnd :: Int#
urlSchemeEnd :: Int#
urlSerialization :: Bytes
..})

intCompare# :: Int# -> Int# -> Ordering
intCompare# :: Int# -> Int# -> Ordering
intCompare# Int#
a Int#
b = case Int#
a Int# -> Int# -> Int#
==# Int#
b of
  Int#
0# -> case Int#
a Int# -> Int# -> Int#
># Int#
b of
    Int#
0# -> Ordering
LT
    Int#
_ -> Ordering
GT
  Int#
_ -> Ordering
EQ

-- | Unsafe conversion between 'Char' and 'Word8'. This is a no-op and
-- silently truncates to 8 bits Chars > '\255'.
c2w :: Char -> Word8
c2w :: Char -> Word8
c2w = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
{-# INLINE c2w #-}

orElse# :: forall e x s. PU.Parser x s Int# -> Int# -> PU.Parser e s Int#
{-# inline orElse# #-}
orElse# :: Parser x s Int# -> Int# -> Parser e s Int#
orElse# (PU.Parser (# ByteArray#, Int#, Int# #) -> ST# s (Result# x Int#)
f) Int#
i = ((# ByteArray#, Int#, Int# #) -> ST# s (Result# e Int#))
-> Parser e s Int#
forall a b c.
((# ByteArray#, Int#, Int# #) -> ST# b (Result# a c))
-> Parser a b c
PU.Parser
  (\x :: (# ByteArray#, Int#, Int# #)
x@(# ByteArray#
_, Int#
b, Int#
c #) State# s
s0 -> case (# ByteArray#, Int#, Int# #) -> ST# s (Result# x Int#)
f (# ByteArray#, Int#, Int# #)
x State# s
s0 of
    (# State# s
s1, Result# x Int#
r0 #) -> case Result# x Int#
r0 of
      (# x
_ | #) -> (# State# s
s1, (# | (# Int#
i, Int#
b, Int#
c #) #) #)
      (# | (# Int#, Int#, Int# #)
r #) -> (# State# s
s1, (# | (# Int#, Int#, Int# #)
r #) #)
  )

-- Runs the parser, returning 1 if it succeeds and 0 if it fails.
-- Rolls back on failure, but consumes on success.
succeeded :: PU.Parser x s a -> PU.Parser e s Int#
{-# inline succeeded #-}
succeeded :: Parser x s a -> Parser e s Int#
succeeded (PU.Parser (# ByteArray#, Int#, Int# #) -> ST# s (Result# x a)
f) = ((# ByteArray#, Int#, Int# #) -> ST# s (Result# e Int#))
-> Parser e s Int#
forall a b c.
((# ByteArray#, Int#, Int# #) -> ST# b (Result# a c))
-> Parser a b c
PU.Parser
  (\x :: (# ByteArray#, Int#, Int# #)
x@(# ByteArray#
_, Int#
b, Int#
c #) State# s
s0 -> case (# ByteArray#, Int#, Int# #) -> ST# s (Result# x a)
f (# ByteArray#, Int#, Int# #)
x State# s
s0 of
    (# State# s
s1, Result# x a
r0 #) -> case Result# x a
r0 of
      (# x
_ | #) -> (# State# s
s1, (# | (# Int#
0#, Int#
b, Int#
c #) #) #)
      (# | (# a
_, Int#
b1, Int#
c1 #) #) -> (# State# s
s1, (# | (# Int#
1#, Int#
b1, Int#
c1 #) #) #)
  )