    module Happstack.Server.SURI.ParseURI(parseURIRef) where

    import qualified Data.ByteString          as BB
    import qualified Data.ByteString.Internal as BB
    import qualified Data.ByteString.Unsafe   as BB
    import Data.ByteString.Char8 as BC
    import Prelude hiding(break,length,null,drop,splitAt)
    import Network.URI

    -- import Happstack.Util.ByteStringCompat

    parseURIRef :: ByteString -> URI
    parseURIRef :: ByteString -> URI
    parseURIRef ByteString
    fs =
      case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
    break (\Char
    c -> Char
    ':' Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    c Bool -> Bool -> Bool
    || Char
    '/' Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    c Bool -> Bool -> Bool
    || Char
    '?' Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    c Bool -> Bool -> Bool
    || Char
    '#' Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    c) ByteString
    fs of
      (ByteString
    initial,ByteString
    rest) ->
          let ui :: [Char]
    ui = ByteString -> [Char]
    unpack ByteString
    initial
          in case ByteString -> Maybe (Char, ByteString)
    uncons ByteString
    rest of
             Maybe (Char, ByteString)
    Nothing ->
                 if ByteString -> Bool
    null ByteString
    initial then URI
    nullURI -- empty uri
                                 else -- uri not containing either ':' or '/'
                                      URI
    nullURI { uriPath = ui }
             Just (Char
    c, ByteString
    rrest) ->
                 case Char
    c of
                 Char
    ':' -> ByteString
    -> (Maybe URIAuth -> [Char] -> [Char] -> [Char] -> URI) -> URI
    forall b.
    ByteString
    -> (Maybe URIAuth -> [Char] -> [Char] -> [Char] -> b) -> b
    pabsuri   ByteString
    rrest ((Maybe URIAuth -> [Char] -> [Char] -> [Char] -> URI) -> URI)
    -> (Maybe URIAuth -> [Char] -> [Char] -> [Char] -> URI) -> URI
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Maybe URIAuth -> [Char] -> [Char] -> [Char] -> URI
    URI (ByteString -> [Char]
    unpack ByteString
    initial)
                 Char
    '/' -> ByteString -> ([Char] -> [Char] -> [Char] -> URI) -> URI
    forall b. ByteString -> ([Char] -> [Char] -> [Char] -> b) -> b
    puriref   ByteString
    fs    (([Char] -> [Char] -> [Char] -> URI) -> URI)
    -> ([Char] -> [Char] -> [Char] -> URI) -> URI
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Maybe URIAuth -> [Char] -> [Char] -> [Char] -> URI
    URI [Char]
    "" Maybe URIAuth
    forall a. Maybe a
    Nothing
                 Char
    '?' -> ByteString -> ([Char] -> [Char] -> URI) -> URI
    forall t. ByteString -> ([Char] -> [Char] -> t) -> t
    pquery    ByteString
    rrest (([Char] -> [Char] -> URI) -> URI)
    -> ([Char] -> [Char] -> URI) -> URI
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Maybe URIAuth -> [Char] -> [Char] -> [Char] -> URI
    URI [Char]
    "" Maybe URIAuth
    forall a. Maybe a
    Nothing [Char]
    ui
                 Char
    '#' -> ByteString -> ([Char] -> URI) -> URI
    forall b. ByteString -> ([Char] -> b) -> b
    pfragment ByteString
    rrest (([Char] -> URI) -> URI) -> ([Char] -> URI) -> URI
    forall a b. (a -> b) -> a -> b
    $ [Char] -> Maybe URIAuth -> [Char] -> [Char] -> [Char] -> URI
    URI [Char]
    "" Maybe URIAuth
    forall a. Maybe a
    Nothing [Char]
    ui [Char]
    ""
                 Char
    _   -> [Char] -> URI
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "parseURIRef: Can't happen"

    pabsuri :: ByteString
               -> (Maybe URIAuth -> String -> String -> String -> b)
               -> b
    pabsuri :: forall b.
    ByteString
    -> (Maybe URIAuth -> [Char] -> [Char] -> [Char] -> b) -> b
    pabsuri ByteString
    fs Maybe URIAuth -> [Char] -> [Char] -> [Char] -> b
    cont =
      if ByteString -> Int
    length ByteString
    fs Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    2 Bool -> Bool -> Bool
    && ByteString -> Char
    unsafeHead ByteString
    fs Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '/' Bool -> Bool -> Bool
    && ByteString -> Int -> Char
    unsafeIndex ByteString
    fs Int
    1 Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '/'
         then ByteString
    -> (Maybe URIAuth -> [Char] -> [Char] -> [Char] -> b) -> b
    forall b.
    ByteString
    -> (Maybe URIAuth -> [Char] -> [Char] -> [Char] -> b) -> b
    pauthority (Int -> ByteString -> ByteString
    drop Int
    2 ByteString
    fs) Maybe URIAuth -> [Char] -> [Char] -> [Char] -> b
    cont
         else ByteString -> ([Char] -> [Char] -> [Char] -> b) -> b
    forall b. ByteString -> ([Char] -> [Char] -> [Char] -> b) -> b
    puriref ByteString
    fs (([Char] -> [Char] -> [Char] -> b) -> b)
    -> ([Char] -> [Char] -> [Char] -> b) -> b
    forall a b. (a -> b) -> a -> b
    $ Maybe URIAuth -> [Char] -> [Char] -> [Char] -> b
    cont Maybe URIAuth
    forall a. Maybe a
    Nothing
    pauthority :: ByteString
                  -> (Maybe URIAuth -> String -> String -> String -> b)
                  -> b
    pauthority :: forall b.
    ByteString
    -> (Maybe URIAuth -> [Char] -> [Char] -> [Char] -> b) -> b
    pauthority ByteString
    fs Maybe URIAuth -> [Char] -> [Char] -> [Char] -> b
    cont =
      let (ByteString
    auth,ByteString
    rest) = Char -> ByteString -> (ByteString, ByteString)
    breakChar Char
    '/' ByteString
    fs
      in ByteString -> ([Char] -> [Char] -> [Char] -> b) -> b
    forall b. ByteString -> ([Char] -> [Char] -> [Char] -> b) -> b
    puriref ByteString
    rest (([Char] -> [Char] -> [Char] -> b) -> b)
    -> ([Char] -> [Char] -> [Char] -> b) -> b
    forall a b. (a -> b) -> a -> b
    $! Maybe URIAuth -> [Char] -> [Char] -> [Char] -> b
    cont (URIAuth -> Maybe URIAuth
    forall a. a -> Maybe a
    Just (URIAuth -> Maybe URIAuth) -> URIAuth -> Maybe URIAuth
    forall a b. (a -> b) -> a -> b
    $! ByteString -> URIAuth
    pauthinner ByteString
    auth)
    pauthinner :: ByteString -> URIAuth
    pauthinner :: ByteString -> URIAuth
    pauthinner ByteString
    fs =
      case Char -> ByteString -> (ByteString, ByteString)
    breakChar Char
    '@' ByteString
    fs of
        (ByteString
    a,ByteString
    b) -> ByteString -> ([Char] -> [Char] -> URIAuth) -> URIAuth
    forall t. ByteString -> ([Char] -> [Char] -> t) -> t
    pauthport ByteString
    b  (([Char] -> [Char] -> URIAuth) -> URIAuth)
    -> ([Char] -> [Char] -> URIAuth) -> URIAuth
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char] -> [Char] -> URIAuth
    URIAuth (ByteString -> [Char]
    unpack ByteString
    a)
    pauthport :: ByteString -> (String -> String -> t) -> t
    pauthport :: forall t. ByteString -> ([Char] -> [Char] -> t) -> t
    pauthport ByteString
    fs [Char] -> [Char] -> t
    cont =
      let spl :: Int -> (ByteString, ByteString)
    spl Int
    idx = Int -> ByteString -> (ByteString, ByteString)
    splitAt (Int
    idxInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) ByteString
    fs
      in case ByteString -> Char
    unsafeHead ByteString
    fs of
          Char
    _ | ByteString -> Bool
    null ByteString
    fs -> [Char] -> [Char] -> t
    cont [Char]
    "" [Char]
    ""
          Char
    '['         -> case (Int -> (ByteString, ByteString))
    -> Maybe Int -> Maybe (ByteString, ByteString)
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Int -> (ByteString, ByteString)
    spl (Char -> ByteString -> Maybe Int
    elemIndexEnd Char
    ']' ByteString
    fs) of
                           Just (ByteString
    a,ByteString
    b) | ByteString -> Bool
    null ByteString
    b              -> [Char] -> [Char] -> t
    cont (ByteString -> [Char]
    unpack ByteString
    a) [Char]
    ""
                                      | ByteString -> Char
    unsafeHead ByteString
    b Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ':' -> [Char] -> [Char] -> t
    cont (ByteString -> [Char]
    unpack ByteString
    a) (ByteString -> [Char]
    unpack (ByteString -> [Char]) -> ByteString -> [Char]
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString
    unsafeTail ByteString
    b)
                           Maybe (ByteString, ByteString)
    x                                -> [Char] -> t
    forall a. HasCallStack => [Char] -> a
    error ([Char]
    "Parsing uri failed (pauthport):"[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++Maybe (ByteString, ByteString) -> [Char]
    forall a. Show a => a -> [Char]
    show Maybe (ByteString, ByteString)
    x)
          Char
    _           -> case Char -> ByteString -> (ByteString, ByteString)
    breakCharEnd Char
    ':' ByteString
    fs of
                           (ByteString
    a,ByteString
    b) -> [Char] -> [Char] -> t
    cont (ByteString -> [Char]
    unpack ByteString
    a) (ByteString -> [Char]
    unpack ByteString
    b)
    puriref :: ByteString -> (String -> String -> String -> b) -> b
    puriref :: forall b. ByteString -> ([Char] -> [Char] -> [Char] -> b) -> b
    puriref ByteString
    fs [Char] -> [Char] -> [Char] -> b
    cont =
      let (ByteString
    u,ByteString
    r) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
    break (\Char
    c -> Char
    '#' Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    c Bool -> Bool -> Bool
    || Char
    '?' Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    c) ByteString
    fs
      in case ByteString -> Char
    unsafeHead ByteString
    r of
          Char
    _ | ByteString -> Bool
    null ByteString
    r -> [Char] -> [Char] -> [Char] -> b
    cont (ByteString -> [Char]
    unpack ByteString
    u) [Char]
    "" [Char]
    ""
          Char
    '?'        -> ByteString -> ([Char] -> [Char] -> b) -> b
    forall t. ByteString -> ([Char] -> [Char] -> t) -> t
    pquery    (ByteString -> ByteString
    unsafeTail ByteString
    r) (([Char] -> [Char] -> b) -> b) -> ([Char] -> [Char] -> b) -> b
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char] -> [Char] -> b
    cont (ByteString -> [Char]
    unpack ByteString
    u)
          Char
    '#'        -> ByteString -> ([Char] -> b) -> b
    forall b. ByteString -> ([Char] -> b) -> b
    pfragment (ByteString -> ByteString
    unsafeTail ByteString
    r) (([Char] -> b) -> b) -> ([Char] -> b) -> b
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char] -> [Char] -> b
    cont (ByteString -> [Char]
    unpack ByteString
    u) [Char]
    ""
          Char
    _          -> [Char] -> b
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "unexpected match"
    pquery :: ByteString -> (String -> String -> t) -> t
    pquery :: forall t. ByteString -> ([Char] -> [Char] -> t) -> t
    pquery ByteString
    fs [Char] -> [Char] -> t
    cont =
      case Char -> ByteString -> (ByteString, ByteString)
    breakChar Char
    '#' ByteString
    fs of
        (ByteString
    a,ByteString
    b) -> [Char] -> [Char] -> t
    cont (Char
    '?'Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    :ByteString -> [Char]
    unpack ByteString
    a) (ByteString -> [Char]
    unpack ByteString
    b)
    pfragment :: ByteString -> (String -> b) -> b
    pfragment :: forall b. ByteString -> ([Char] -> b) -> b
    pfragment ByteString
    fs [Char] -> b
    cont =
      [Char] -> b
    cont ([Char] -> b) -> [Char] -> b
    forall a b. (a -> b) -> a -> b
    $ ByteString -> [Char]
    unpack ByteString
    fs

    unsafeTail :: ByteString -> ByteString
    unsafeTail :: ByteString -> ByteString
    unsafeTail = ByteString -> ByteString
    BB.unsafeTail
    unsafeHead :: ByteString -> Char
    unsafeHead :: ByteString -> Char
    unsafeHead = Word8 -> Char
    BB.w2c (Word8 -> Char) -> (ByteString -> Word8) -> ByteString -> Char
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Word8
    BB.unsafeHead
    unsafeIndex :: ByteString -> Int -> Char
    unsafeIndex :: ByteString -> Int -> Char
    unsafeIndex ByteString
    s = Word8 -> Char
    BB.w2c (Word8 -> Char) -> (Int -> Word8) -> Int -> Char
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Int -> Word8
    BB.unsafeIndex ByteString
    s

    -- | Semantically equivalent to break on strings
    {-# INLINE breakChar #-}
    breakChar :: Char -> ByteString -> (ByteString, ByteString)
    breakChar :: Char -> ByteString -> (ByteString, ByteString)
    breakChar Char
    ch = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
    BB.break (Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) Word8
    x) where x :: Word8
    x = Char -> Word8
    BB.c2w Char
    ch

    -- | 'breakCharEnd' behaves like breakChar, but from the end of the
    -- ByteString.
    --
    -- > breakCharEnd ('b') (pack "aabbcc") == ("aab","cc")
    --
    -- and the following are equivalent:
    --
    -- > breakCharEnd 'c' "abcdef"
    -- > let (x,y) = break (=='c') (reverse "abcdef")
    -- > in (reverse (drop 1 y), reverse x)
    --
    {-# INLINE breakCharEnd #-}
    breakCharEnd :: Char -> ByteString -> (ByteString, ByteString)
    breakCharEnd :: Char -> ByteString -> (ByteString, ByteString)
    breakCharEnd Char
    c ByteString
    p = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
    BB.breakEnd (Word8 -> Word8 -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) Word8
    x) ByteString
    p where x :: Word8
    x = Char -> Word8
    BB.c2w Char
    c