    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE TupleSections #-}

    -- |
    -- Module      :  Text.URI
    -- Copyright   :  © 2017–present Mark Karpov
    -- License     :  BSD 3 clause
    --
    -- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
    -- Stability   :  experimental
    -- Portability :  portable
    --
    -- This is a modern library for working with URIs as per RFC 3986:
    --
    -- <https://tools.ietf.org/html/rfc3986>
    --
    -- This module is intended to be imported qualified, e.g.:
    --
    -- > import Text.URI (URI)
    -- > import qualified Text.URI as URI
    --
    -- See also "Text.URI.Lens" for lens, prisms, and traversals; see
    -- "Text.URI.QQ" for quasi-quoters for compile-time validation of URIs and
    -- refined text components.
    module Text.URI
      ( -- * Data types
        URI (..),
        mkURI,
        mkURIBs,
        emptyURI,
        makeAbsolute,
        isPathAbsolute,
        relativeTo,
        Authority (..),
        UserInfo (..),
        QueryParam (..),
        ParseException (..),
        ParseExceptionBs (..),

        -- * Refined text
        -- $rtext
        RText,
        RTextLabel (..),
        mkScheme,
        mkHost,
        mkUsername,
        mkPassword,
        mkPathPiece,
        mkQueryKey,
        mkQueryValue,
        mkFragment,
        unRText,
        RTextException (..),

        -- * Parsing
        -- $parsing
        parser,
        parserBs,

        -- * Rendering
        -- $rendering
        render,
        render',
        renderBs,
        renderBs',
        renderStr,
        renderStr',
      )
    where

    import Data.Either (isLeft)
    import Data.List.NonEmpty (NonEmpty (..))
    import qualified Data.List.NonEmpty as NE
    import Data.Maybe (isJust, isNothing)
    import Text.URI.Parser.ByteString
    import Text.URI.Parser.Text
    import Text.URI.Render
    import Text.URI.Types

    -- | The empty 'URI'.
    --
    -- @since 0.2.1.0
    emptyURI :: URI
    emptyURI :: URI
    emptyURI =
      URI
        { uriScheme :: Maybe (RText 'Scheme)
    uriScheme = Maybe (RText 'Scheme)
    forall a. Maybe a
    Nothing,
          uriAuthority :: Either Bool Authority
    uriAuthority = Bool -> Either Bool Authority
    forall a b. a -> Either a b
    Left Bool
    False,
          uriPath :: Maybe (Bool, NonEmpty (RText 'PathPiece))
    uriPath = Maybe (Bool, NonEmpty (RText 'PathPiece))
    forall a. Maybe a
    Nothing,
          uriQuery :: [QueryParam]
    uriQuery = [],
          uriFragment :: Maybe (RText 'Fragment)
    uriFragment = Maybe (RText 'Fragment)
    forall a. Maybe a
    Nothing
        }

    -- $rtext
    --
    -- Refined text values can only be created by using the smart constructors
    -- listed below, such as 'mkScheme'. This eliminates the possibility of
    -- having an invalid component in 'URI' which could invalidate the whole
    -- 'URI'.
    --
    -- Note that the refined text 'RText' type is labelled at the type level
    -- with 'RTextLabel's, which see.
    --
    -- When an invalid 'Data.Text.Text' value is passed to a smart constructor,
    -- it rejects it by throwing the 'RTextException'. Remember that the 'Maybe'
    -- datatype is also an instance of 'Control.Monad.Catch.MonadThrow', and so
    -- one could as well use the smart constructors in the 'Maybe' monad.

    -- $parsing
    --
    -- The input you feed into the parsers must be a valid URI as per RFC 3986,
    -- that is, its components should be percent-encoded where necessary.

    -- $rendering
    --
    -- Rendering functions take care of constructing correct 'URI'
    -- representation as per RFC 3986, that is, percent-encoding will be applied
    -- when necessary automatically.

    -- | @'relativeTo' reference base@ makes the @reference@ 'URI' absolute
    -- resolving it against the @base@ 'URI'.
    --
    -- If the base 'URI' is not absolute itself (that is, it has no scheme),
    -- this function returns 'Nothing'.
    --
    -- See also: <https://tools.ietf.org/html/rfc3986#section-5.2>.
    --
    -- @since 0.2.0.0
    relativeTo ::
      -- | Reference 'URI' to make absolute
      URI ->
      -- | Base 'URI'
      URI ->
      -- | The target 'URI'
      Maybe URI
    relativeTo :: URI -> URI -> Maybe URI
    relativeTo URI
    r URI
    base =
      case URI -> Maybe (RText 'Scheme)
    uriScheme URI
    base of
        Maybe (RText 'Scheme)
    Nothing -> Maybe URI
    forall a. Maybe a
    Nothing
        Just RText 'Scheme
    bscheme ->
          URI -> Maybe URI
    forall a. a -> Maybe a
    Just (URI -> Maybe URI) -> URI -> Maybe URI
    forall a b. (a -> b) -> a -> b
    $
            if Maybe (RText 'Scheme) -> Bool
    forall a. Maybe a -> Bool
    isJust (URI -> Maybe (RText 'Scheme)
    uriScheme URI
    r)
              then URI
    r {uriPath = uriPath r >>= removeDotSegments}
              else
                URI
    r
                  { uriScheme = Just bscheme,
                    uriAuthority = case uriAuthority r of
                      Right Authority
    auth -> Authority -> Either Bool Authority
    forall a b. b -> Either a b
    Right Authority
    auth
                      Left Bool
    rabs ->
                        case URI -> Either Bool Authority
    uriAuthority URI
    base of
                          Right Authority
    auth -> Authority -> Either Bool Authority
    forall a b. b -> Either a b
    Right Authority
    auth
                          Left Bool
    babs -> Bool -> Either Bool Authority
    forall a b. a -> Either a b
    Left (Bool
    babs Bool -> Bool -> Bool
    || Bool
    rabs),
                    uriPath =
                      (>>= removeDotSegments) $
                        if isPathAbsolute r
                          then uriPath r
                          else case (uriPath base, uriPath r) of
                            (Maybe (Bool, NonEmpty (RText 'PathPiece))
    Nothing, Maybe (Bool, NonEmpty (RText 'PathPiece))
    Nothing) -> Maybe (Bool, NonEmpty (RText 'PathPiece))
    forall a. Maybe a
    Nothing
                            (Just (Bool, NonEmpty (RText 'PathPiece))
    b', Maybe (Bool, NonEmpty (RText 'PathPiece))
    Nothing) -> (Bool, NonEmpty (RText 'PathPiece))
    -> Maybe (Bool, NonEmpty (RText 'PathPiece))
    forall a. a -> Maybe a
    Just (Bool, NonEmpty (RText 'PathPiece))
    b'
                            (Maybe (Bool, NonEmpty (RText 'PathPiece))
    Nothing, Just (Bool, NonEmpty (RText 'PathPiece))
    r') -> (Bool, NonEmpty (RText 'PathPiece))
    -> Maybe (Bool, NonEmpty (RText 'PathPiece))
    forall a. a -> Maybe a
    Just (Bool, NonEmpty (RText 'PathPiece))
    r'
                            (Just (Bool
    bt, NonEmpty (RText 'PathPiece)
    bps), Just (Bool
    rt, NonEmpty (RText 'PathPiece)
    rps)) ->
                              (NonEmpty (RText 'PathPiece)
     -> (Bool, NonEmpty (RText 'PathPiece)))
    -> Maybe (NonEmpty (RText 'PathPiece))
    -> Maybe (Bool, NonEmpty (RText 'PathPiece))
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Bool
    rt,) (Maybe (NonEmpty (RText 'PathPiece))
     -> Maybe (Bool, NonEmpty (RText 'PathPiece)))
    -> ([RText 'PathPiece] -> Maybe (NonEmpty (RText 'PathPiece)))
    -> [RText 'PathPiece]
    -> Maybe (Bool, NonEmpty (RText 'PathPiece))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [RText 'PathPiece] -> Maybe (NonEmpty (RText 'PathPiece))
    forall a. [a] -> Maybe (NonEmpty a)
    NE.nonEmpty ([RText 'PathPiece] -> Maybe (Bool, NonEmpty (RText 'PathPiece)))
    -> [RText 'PathPiece] -> Maybe (Bool, NonEmpty (RText 'PathPiece))
    forall a b. (a -> b) -> a -> b
    $
                                (if Bool
    bt then NonEmpty (RText 'PathPiece) -> [RText 'PathPiece]
    forall a. NonEmpty a -> [a]
    NE.toList NonEmpty (RText 'PathPiece)
    bps else NonEmpty (RText 'PathPiece) -> [RText 'PathPiece]
    forall a. NonEmpty a -> [a]
    NE.init NonEmpty (RText 'PathPiece)
    bps)
                                  [RText 'PathPiece] -> [RText 'PathPiece] -> [RText 'PathPiece]
    forall a. Semigroup a => a -> a -> a
    <> NonEmpty (RText 'PathPiece) -> [RText 'PathPiece]
    forall a. NonEmpty a -> [a]
    NE.toList NonEmpty (RText 'PathPiece)
    rps,
                    uriQuery =
                      if isLeft (uriAuthority r)
                        && isNothing (uriPath r)
                        && null (uriQuery r)
                        then uriQuery base
                        else uriQuery r
                  }

    ----------------------------------------------------------------------------
    -- Helpers

    -- | Remove dot segments from a path.
    removeDotSegments ::
      (Bool, NonEmpty (RText 'PathPiece)) ->
      Maybe (Bool, NonEmpty (RText 'PathPiece))
    removeDotSegments :: (Bool, NonEmpty (RText 'PathPiece))
    -> Maybe (Bool, NonEmpty (RText 'PathPiece))
    removeDotSegments (Bool
    trailSlash, NonEmpty (RText 'PathPiece)
    path) = [RText 'PathPiece]
    -> [RText 'PathPiece]
    -> Bool
    -> Maybe (Bool, NonEmpty (RText 'PathPiece))
    forall {l :: RTextLabel}.
    [RText l] -> [RText l] -> Bool -> Maybe (Bool, NonEmpty (RText l))
    go [] (NonEmpty (RText 'PathPiece) -> [RText 'PathPiece]
    forall a. NonEmpty a -> [a]
    NE.toList NonEmpty (RText 'PathPiece)
    path) Bool
    trailSlash
      where
        go :: [RText l] -> [RText l] -> Bool -> Maybe (Bool, NonEmpty (RText l))
    go [RText l]
    out [] Bool
    ts = ((NonEmpty (RText l) -> (Bool, NonEmpty (RText l)))
    -> Maybe (NonEmpty (RText l)) -> Maybe (Bool, NonEmpty (RText l))
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Bool
    ts,) (Maybe (NonEmpty (RText l)) -> Maybe (Bool, NonEmpty (RText l)))
    -> ([RText l] -> Maybe (NonEmpty (RText l)))
    -> [RText l]
    -> Maybe (Bool, NonEmpty (RText l))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [RText l] -> Maybe (NonEmpty (RText l))
    forall a. [a] -> Maybe (NonEmpty a)
    NE.nonEmpty ([RText l] -> Maybe (NonEmpty (RText l)))
    -> ([RText l] -> [RText l])
    -> [RText l]
    -> Maybe (NonEmpty (RText l))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [RText l] -> [RText l]
    forall a. [a] -> [a]
    reverse) [RText l]
    out
        go [RText l]
    out (RText l
    x : [RText l]
    xs) Bool
    ts
          | RText l -> Text
    forall (l :: RTextLabel). RText l -> Text
    unRText RText l
    x Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "." = [RText l] -> [RText l] -> Bool -> Maybe (Bool, NonEmpty (RText l))
    go [RText l]
    out [RText l]
    xs ([RText l] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [RText l]
    xs Bool -> Bool -> Bool
    || Bool
    ts)
          | RText l -> Text
    forall (l :: RTextLabel). RText l -> Text
    unRText RText l
    x Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    ".." = [RText l] -> [RText l] -> Bool -> Maybe (Bool, NonEmpty (RText l))
    go (Int -> [RText l] -> [RText l]
    forall a. Int -> [a] -> [a]
    drop Int
    1 [RText l]
    out) [RText l]
    xs ([RText l] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [RText l]
    xs Bool -> Bool -> Bool
    || Bool
    ts)
          | Bool
    otherwise = [RText l] -> [RText l] -> Bool -> Maybe (Bool, NonEmpty (RText l))
    go (RText l
    x RText l -> [RText l] -> [RText l]
    forall a. a -> [a] -> [a]
    : [RText l]
    out) [RText l]
    xs Bool
    ts