    {-# LANGUAGE OverloadedStrings #-}
    module Network.Wai.Middleware.Push.Referer.ParseURL (
        parseUrl
      ) where

    import Data.ByteString (ByteString)
    import Data.ByteString.Internal (ByteString(..), memchr)
    import Data.Word8
    import Foreign.ForeignPtr (withForeignPtr, ForeignPtr)
    import Foreign.Ptr (Ptr, plusPtr, minusPtr, nullPtr)
    import Foreign.Storable (peek)

    import Network.Wai.Middleware.Push.Referer.Types

    -- |
    --
    -- >>> parseUrl ""
    -- (Nothing,"")
    -- >>> parseUrl "/"
    -- (Nothing,"/")
    -- >>> parseUrl "ht"
    -- (Nothing,"")
    -- >>> parseUrl "http://example.com/foo/bar/"
    -- (Just "example.com","/foo/bar/")
    -- >>> parseUrl "https://www.example.com/path/to/dir/"
    -- (Just "www.example.com","/path/to/dir/")
    -- >>> parseUrl "http://www.example.com:8080/path/to/dir/"
    -- (Just "www.example.com:8080","/path/to/dir/")
    -- >>> parseUrl "//www.example.com:8080/path/to/dir/"
    -- (Just "www.example.com:8080","/path/to/dir/")
    -- >>> parseUrl "/path/to/dir/"
    -- (Nothing,"/path/to/dir/")

    parseUrl :: ByteString -> IO (Maybe ByteString, URLPath)
    parseUrl :: URLPath -> IO (Maybe URLPath, URLPath)
    parseUrl bs :: URLPath
    bs@(PS ForeignPtr Word8
    fptr0 Int
    off Int
    len)
      | Int
    len Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 = (Maybe URLPath, URLPath) -> IO (Maybe URLPath, URLPath)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe URLPath
    forall a. Maybe a
    Nothing, URLPath
    "")
      | Int
    len Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1 = (Maybe URLPath, URLPath) -> IO (Maybe URLPath, URLPath)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe URLPath
    forall a. Maybe a
    Nothing, URLPath
    bs)
      | Bool
    otherwise = ForeignPtr Word8
    -> (Ptr Word8 -> IO (Maybe URLPath, URLPath))
    -> IO (Maybe URLPath, URLPath)
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
    withForeignPtr ForeignPtr Word8
    fptr0 ((Ptr Word8 -> IO (Maybe URLPath, URLPath))
     -> IO (Maybe URLPath, URLPath))
    -> (Ptr Word8 -> IO (Maybe URLPath, URLPath))
    -> IO (Maybe URLPath, URLPath)
    forall a b. (a -> b) -> a -> b
    $ \Ptr Word8
    ptr0 -> do
          let begptr :: Ptr b
    begptr = Ptr Word8
    ptr0 Ptr Word8 -> Int -> Ptr b
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    off
              limptr :: Ptr b
    limptr = Ptr (ZonkAny 2)
    forall {b}. Ptr b
    begptr Ptr (ZonkAny 2) -> Int -> Ptr b
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    len
          ForeignPtr Word8
    -> Ptr Word8
    -> Ptr Word8
    -> Ptr Word8
    -> Int
    -> IO (Maybe URLPath, URLPath)
    parseUrl' ForeignPtr Word8
    fptr0 Ptr Word8
    ptr0 Ptr Word8
    forall {b}. Ptr b
    begptr Ptr Word8
    forall {b}. Ptr b
    limptr Int
    len

    parseUrl' :: ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> Int
              -> IO (Maybe ByteString, URLPath)
    parseUrl' :: ForeignPtr Word8
    -> Ptr Word8
    -> Ptr Word8
    -> Ptr Word8
    -> Int
    -> IO (Maybe URLPath, URLPath)
    parseUrl' ForeignPtr Word8
    fptr0 Ptr Word8
    ptr0 Ptr Word8
    begptr Ptr Word8
    limptr Int
    len0 = do
          w0 <- Ptr Word8 -> IO Word8
    forall a. Storable a => Ptr a -> IO a
    peek Ptr Word8
    begptr
          if w0 == _slash then do
              w1 <- peek $ begptr `plusPtr` 1
              if w1 == _slash  then
                  doubleSlashed begptr len0
                else
                  slashed begptr len0 Nothing
            else do
              colonptr <- memchr begptr _colon $ fromIntegral len0
              if colonptr == nullPtr then
                  return (Nothing, "")
                else do
                  let authptr = Ptr Word8
    colonptr Ptr Word8 -> Int -> Ptr b
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    1
                  doubleSlashed authptr (limptr `minusPtr` authptr)
      where
        -- // / ?
        doubleSlashed :: Ptr Word8 -> Int -> IO (Maybe ByteString, URLPath)
        doubleSlashed :: Ptr Word8 -> Int -> IO (Maybe URLPath, URLPath)
    doubleSlashed Ptr Word8
    ptr Int
    len
          | Int
    len Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    2  = (Maybe URLPath, URLPath) -> IO (Maybe URLPath, URLPath)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe URLPath
    forall a. Maybe a
    Nothing, URLPath
    "")
          | Bool
    otherwise = do
              let ptr1 :: Ptr b
    ptr1 = Ptr Word8
    ptr Ptr Word8 -> Int -> Ptr b
    forall a b. Ptr a -> Int -> Ptr b
    `plusPtr` Int
    2
              pathptr <- Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
    memchr Ptr Word8
    forall {b}. Ptr b
    ptr1 Word8
    _slash (CSize -> IO (Ptr Word8)) -> CSize -> IO (Ptr Word8)
    forall a b. (a -> b) -> a -> b
    $ Int -> CSize
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    len
              if pathptr == nullPtr then
                  return (Nothing, "")
                else do
                  let auth = Ptr Word8 -> Ptr (ZonkAny 0) -> Ptr Word8 -> URLPath
    forall {b} {b} {a}. Ptr b -> Ptr b -> Ptr a -> URLPath
    bs Ptr Word8
    ptr0 Ptr (ZonkAny 0)
    forall {b}. Ptr b
    ptr1 Ptr Word8
    pathptr
                  slashed pathptr (limptr `minusPtr` pathptr) (Just auth)

        -- / ?
        slashed :: Ptr Word8 -> Int -> Maybe ByteString -> IO (Maybe ByteString, URLPath)
        slashed :: Ptr Word8 -> Int -> Maybe URLPath -> IO (Maybe URLPath, URLPath)
    slashed Ptr Word8
    ptr Int
    len Maybe URLPath
    mauth = do
            questionptr <- Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
    memchr Ptr Word8
    ptr Word8
    _question (CSize -> IO (Ptr Word8)) -> CSize -> IO (Ptr Word8)
    forall a b. (a -> b) -> a -> b
    $ Int -> CSize
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    len
            if questionptr == nullPtr then do
                let path = Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> URLPath
    forall {b} {b} {a}. Ptr b -> Ptr b -> Ptr a -> URLPath
    bs Ptr Word8
    ptr0 Ptr Word8
    ptr Ptr Word8
    limptr
                return (mauth, path)
              else do
                let path = Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> URLPath
    forall {b} {b} {a}. Ptr b -> Ptr b -> Ptr a -> URLPath
    bs Ptr Word8
    ptr0 Ptr Word8
    ptr Ptr Word8
    questionptr
                return (mauth, path)
        bs :: Ptr b -> Ptr b -> Ptr a -> URLPath
    bs Ptr b
    p0 Ptr b
    p1 Ptr a
    p2 = URLPath
    path
          where
            off :: Int
    off = Ptr b
    p1 Ptr b -> Ptr b -> Int
    forall a b. Ptr a -> Ptr b -> Int
    `minusPtr` Ptr b
    p0
            siz :: Int
    siz = Ptr a
    p2 Ptr a -> Ptr b -> Int
    forall a b. Ptr a -> Ptr b -> Int
    `minusPtr` Ptr b
    p1
            path :: URLPath
    path = ForeignPtr Word8 -> Int -> Int -> URLPath
    PS ForeignPtr Word8
    fptr0 Int
    off Int
    siz