{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module      :  Text.URI.Render
-- Copyright   :  © 2017–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- URI renders, an internal module.
module Text.URI.Render
  ( render,
    render',
    renderBs,
    renderBs',
    renderStr,
    renderStr',
  )
where

import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Lazy as BL
import Data.Char (chr, intToDigit)
import Data.Kind (Type)
import Data.List (intersperse)
import Data.List.NonEmpty (NonEmpty (..))
import Data.Proxy
import Data.Reflection
import qualified Data.Semigroup as S
import Data.String (IsString (..))
import Data.Tagged
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TLB
import qualified Data.Text.Lazy.Builder.Int as TLB
import Data.Word (Word8)
import Numeric (showInt)
import Text.URI.Types

----------------------------------------------------------------------------
-- High-level wrappers

-- | Render a given 'URI' value as strict 'Text'.
render :: URI -> Text
render :: URI -> Text
render = Text -> Text
TL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TLB.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> Builder
render'

-- | Render a given 'URI' value as a 'TLB.Builder'.
render' :: URI -> TLB.Builder
render' :: URI -> Builder
render' URI
x =
  forall b.
(Word -> b)
-> (forall (l :: RTextLabel).
    RLabel l =>
    Maybe Word8 -> RText l -> b)
-> (forall s. Reifies s (Renders b) => Tagged s b)
-> b
equip
    forall a. Integral a => a -> Builder
TLB.decimal
    ( \Maybe Word8
mw RText l
r ->
        Text -> Builder
TLB.fromText
          ( forall (l :: RTextLabel).
RLabel l =>
Maybe (RText 'Scheme) -> Maybe Word8 -> RText l -> Text
percentEncode
              (URI -> Maybe (RText 'Scheme)
uriScheme URI
x)
              (URI -> Maybe Word8 -> Maybe Word8
mediateExtraEscaping URI
x Maybe Word8
mw)
              RText l
r
          )
    )
    (forall b. Render URI b
genericRender URI
x)

-- | Render a given 'URI' value as a strict 'ByteString'.
renderBs :: URI -> ByteString
renderBs :: URI -> ByteString
renderBs = ByteString -> ByteString
BL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> Builder
renderBs'

-- | Render a given 'URI' value as a 'BB.Builder'.
renderBs' :: URI -> BB.Builder
renderBs' :: URI -> Builder
renderBs' URI
x =
  forall b.
(Word -> b)
-> (forall (l :: RTextLabel).
    RLabel l =>
    Maybe Word8 -> RText l -> b)
-> (forall s. Reifies s (Renders b) => Tagged s b)
-> b
equip
    Word -> Builder
BB.wordDec
    ( \Maybe Word8
mw RText l
r ->
        ByteString -> Builder
BB.byteString
          ( Text -> ByteString
TE.encodeUtf8
              ( forall (l :: RTextLabel).
RLabel l =>
Maybe (RText 'Scheme) -> Maybe Word8 -> RText l -> Text
percentEncode
                  (URI -> Maybe (RText 'Scheme)
uriScheme URI
x)
                  (URI -> Maybe Word8 -> Maybe Word8
mediateExtraEscaping URI
x Maybe Word8
mw)
                  RText l
r
              )
          )
    )
    (forall b. Render URI b
genericRender URI
x)

-- | Render a given 'URI' value as a 'String'.
--
-- @since 0.0.2.0
renderStr :: URI -> String
renderStr :: URI -> String
renderStr = (forall a b. (a -> b) -> a -> b
$ []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> String -> String
renderStr'

-- | Render a given 'URI' value as 'ShowS'.
--
-- @since 0.0.2.0
renderStr' :: URI -> ShowS
renderStr' :: URI -> String -> String
renderStr' URI
x =
  DString -> String -> String
toShowS forall a b. (a -> b) -> a -> b
$
    forall b.
(Word -> b)
-> (forall (l :: RTextLabel).
    RLabel l =>
    Maybe Word8 -> RText l -> b)
-> (forall s. Reifies s (Renders b) => Tagged s b)
-> b
equip
      ((String -> String) -> DString
DString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> String -> String
showInt)
      ( \Maybe Word8
mw RText l
r ->
          forall a. IsString a => String -> a
fromString
            ( Text -> String
T.unpack
                ( forall (l :: RTextLabel).
RLabel l =>
Maybe (RText 'Scheme) -> Maybe Word8 -> RText l -> Text
percentEncode
                    (URI -> Maybe (RText 'Scheme)
uriScheme URI
x)
                    (URI -> Maybe Word8 -> Maybe Word8
mediateExtraEscaping URI
x Maybe Word8
mw)
                    RText l
r
                )
            )
      )
      (forall b. Render URI b
genericRender URI
x)

-- | This is a (slightly hackish) way used to only escape ':' in the first
-- path segment and only if there no scheme and no authority component.
mediateExtraEscaping :: URI -> Maybe Word8 -> Maybe Word8
mediateExtraEscaping :: URI -> Maybe Word8 -> Maybe Word8
mediateExtraEscaping URI
uri Maybe Word8
mw =
  case (URI -> Maybe (RText 'Scheme)
uriScheme URI
uri, URI -> Either Bool Authority
uriAuthority URI
uri) of
    (Maybe (RText 'Scheme)
Nothing, Left Bool
_) -> Maybe Word8
mw
    (Maybe (RText 'Scheme), Either Bool Authority)
_ -> forall a. Maybe a
Nothing

----------------------------------------------------------------------------
-- Reflection stuff

data Renders b = Renders
  { forall b. Renders b -> Word -> b
rWord :: Word -> b,
    forall b.
Renders b
-> forall (l :: RTextLabel).
   RLabel l =>
   Maybe Word8 -> RText l -> b
rText :: forall l. (RLabel l) => Maybe Word8 -> RText l -> b
  }

equip ::
  forall b.
  (Word -> b) ->
  (forall l. (RLabel l) => Maybe Word8 -> RText l -> b) ->
  (forall (s :: Type). (Reifies s (Renders b)) => Tagged s b) ->
  b
equip :: forall b.
(Word -> b)
-> (forall (l :: RTextLabel).
    RLabel l =>
    Maybe Word8 -> RText l -> b)
-> (forall s. Reifies s (Renders b) => Tagged s b)
-> b
equip Word -> b
rWord forall (l :: RTextLabel). RLabel l => Maybe Word8 -> RText l -> b
rText forall s. Reifies s (Renders b) => Tagged s b
f = forall a r. a -> (forall s. Reifies s a => Proxy s -> r) -> r
reify Renders {Word -> b
forall (l :: RTextLabel). RLabel l => Maybe Word8 -> RText l -> b
rText :: forall (l :: RTextLabel). RLabel l => Maybe Word8 -> RText l -> b
rWord :: Word -> b
rText :: forall (l :: RTextLabel). RLabel l => Maybe Word8 -> RText l -> b
rWord :: Word -> b
..} forall a b. (a -> b) -> a -> b
$ \(Proxy s
Proxy :: Proxy s') ->
  forall {k} (s :: k) b. Tagged s b -> b
unTagged (forall s. Reifies s (Renders b) => Tagged s b
f :: Tagged s' b)

renderWord ::
  forall s b.
  (Reifies s (Renders b)) =>
  Word ->
  Tagged s b
renderWord :: forall s b. Reifies s (Renders b) => Word -> Tagged s b
renderWord = forall {k} (s :: k) b. b -> Tagged s b
Tagged forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. Renders b -> Word -> b
rWord (forall {k} (s :: k) a (proxy :: k -> *).
Reifies s a =>
proxy s -> a
reflect (forall {k} (t :: k). Proxy t
Proxy :: Proxy s))

renderText ::
  forall s b l.
  (Reifies s (Renders b), RLabel l) =>
  RText l ->
  Tagged s b
renderText :: forall s b (l :: RTextLabel).
(Reifies s (Renders b), RLabel l) =>
RText l -> Tagged s b
renderText = forall {k} (s :: k) b. b -> Tagged s b
Tagged forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b.
Renders b
-> forall (l :: RTextLabel).
   RLabel l =>
   Maybe Word8 -> RText l -> b
rText (forall {k} (s :: k) a (proxy :: k -> *).
Reifies s a =>
proxy s -> a
reflect (forall {k} (t :: k). Proxy t
Proxy :: Proxy s)) forall a. Maybe a
Nothing

renderTextEscaping ::
  forall s b l.
  (Reifies s (Renders b), RLabel l) =>
  Word8 ->
  RText l ->
  Tagged s b
renderTextEscaping :: forall s b (l :: RTextLabel).
(Reifies s (Renders b), RLabel l) =>
Word8 -> RText l -> Tagged s b
renderTextEscaping Word8
w = forall {k} (s :: k) b. b -> Tagged s b
Tagged forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b.
Renders b
-> forall (l :: RTextLabel).
   RLabel l =>
   Maybe Word8 -> RText l -> b
rText (forall {k} (s :: k) a (proxy :: k -> *).
Reifies s a =>
proxy s -> a
reflect (forall {k} (t :: k). Proxy t
Proxy :: Proxy s)) (forall a. a -> Maybe a
Just Word8
w)

----------------------------------------------------------------------------
-- Generic render

type Render a b =
  forall (s :: Type).
  (Semigroup b, Monoid b, IsString b, Reifies s (Renders b)) =>
  a ->
  Tagged s b

genericRender :: Render URI b
genericRender :: forall b. Render URI b
genericRender URI {[QueryParam]
Maybe (Bool, NonEmpty (RText 'PathPiece))
Maybe (RText 'Scheme)
Maybe (RText 'Fragment)
Either Bool Authority
uriFragment :: URI -> Maybe (RText 'Fragment)
uriQuery :: URI -> [QueryParam]
uriPath :: URI -> Maybe (Bool, NonEmpty (RText 'PathPiece))
uriFragment :: Maybe (RText 'Fragment)
uriQuery :: [QueryParam]
uriPath :: Maybe (Bool, NonEmpty (RText 'PathPiece))
uriAuthority :: Either Bool Authority
uriScheme :: Maybe (RText 'Scheme)
uriAuthority :: URI -> Either Bool Authority
uriScheme :: URI -> Maybe (RText 'Scheme)
..} =
  forall a. Monoid a => [a] -> a
mconcat
    [ forall m a. Monoid m => (a -> m) -> Maybe a -> m
rJust forall b. Render (RText 'Scheme) b
rScheme Maybe (RText 'Scheme)
uriScheme,
      forall m a. Monoid m => (a -> m) -> Maybe a -> m
rJust forall b. Render Authority b
rAuthority (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just Either Bool Authority
uriAuthority),
      forall a b.
Either Bool a
-> Render (Maybe (Bool, NonEmpty (RText 'PathPiece))) b
rAbsPathSlash Either Bool Authority
uriAuthority Maybe (Bool, NonEmpty (RText 'PathPiece))
uriPath,
      forall b. Render (Maybe (Bool, NonEmpty (RText 'PathPiece))) b
rPath Maybe (Bool, NonEmpty (RText 'PathPiece))
uriPath,
      forall b. Render [QueryParam] b
rQuery [QueryParam]
uriQuery,
      forall m a. Monoid m => (a -> m) -> Maybe a -> m
rJust forall b. Render (RText 'Fragment) b
rFragment Maybe (RText 'Fragment)
uriFragment
    ]
{-# INLINE genericRender #-}

rJust :: (Monoid m) => (a -> m) -> Maybe a -> m
rJust :: forall m a. Monoid m => (a -> m) -> Maybe a -> m
rJust = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty

rScheme :: Render (RText 'Scheme) b
rScheme :: forall b. Render (RText 'Scheme) b
rScheme = (forall a. Semigroup a => a -> a -> a
<> Tagged s b
":") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s b (l :: RTextLabel).
(Reifies s (Renders b), RLabel l) =>
RText l -> Tagged s b
renderText
{-# INLINE rScheme #-}

rAuthority :: Render Authority b
rAuthority :: forall b. Render Authority b
rAuthority Authority {Maybe Word
Maybe UserInfo
RText 'Host
authPort :: Authority -> Maybe Word
authHost :: Authority -> RText 'Host
authUserInfo :: Authority -> Maybe UserInfo
authPort :: Maybe Word
authHost :: RText 'Host
authUserInfo :: Maybe UserInfo
..} =
  forall a. Monoid a => [a] -> a
mconcat
    [ Tagged s b
"//",
      forall m a. Monoid m => (a -> m) -> Maybe a -> m
rJust forall b. Render UserInfo b
rUserInfo Maybe UserInfo
authUserInfo,
      forall s b (l :: RTextLabel).
(Reifies s (Renders b), RLabel l) =>
RText l -> Tagged s b
renderText RText 'Host
authHost,
      forall m a. Monoid m => (a -> m) -> Maybe a -> m
rJust ((Tagged s b
":" forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s b. Reifies s (Renders b) => Word -> Tagged s b
renderWord) Maybe Word
authPort
    ]
{-# INLINE rAuthority #-}

rUserInfo :: Render UserInfo b
rUserInfo :: forall b. Render UserInfo b
rUserInfo UserInfo {Maybe (RText 'Password)
RText 'Username
uiPassword :: UserInfo -> Maybe (RText 'Password)
uiUsername :: UserInfo -> RText 'Username
uiPassword :: Maybe (RText 'Password)
uiUsername :: RText 'Username
..} =
  forall a. Monoid a => [a] -> a
mconcat
    [ forall s b (l :: RTextLabel).
(Reifies s (Renders b), RLabel l) =>
RText l -> Tagged s b
renderText RText 'Username
uiUsername,
      forall m a. Monoid m => (a -> m) -> Maybe a -> m
rJust ((Tagged s b
":" forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s b (l :: RTextLabel).
(Reifies s (Renders b), RLabel l) =>
RText l -> Tagged s b
renderText) Maybe (RText 'Password)
uiPassword,
      Tagged s b
"@"
    ]
{-# INLINE rUserInfo #-}

rAbsPathSlash ::
  Either Bool a ->
  Render (Maybe (Bool, NonEmpty (RText 'PathPiece))) b
rAbsPathSlash :: forall a b.
Either Bool a
-> Render (Maybe (Bool, NonEmpty (RText 'PathPiece))) b
rAbsPathSlash (Left Bool
isAbsolute) Maybe (Bool, NonEmpty (RText 'PathPiece))
_ = if Bool
isAbsolute then Tagged s b
"/" else forall a. Monoid a => a
mempty
rAbsPathSlash (Right a
_) Maybe (Bool, NonEmpty (RText 'PathPiece))
Nothing = forall a. Monoid a => a
mempty
rAbsPathSlash (Right a
_) (Just (Bool, NonEmpty (RText 'PathPiece))
_) = Tagged s b
"/"
{-# INLINE rAbsPathSlash #-}

rPath :: Render (Maybe (Bool, NonEmpty (RText 'PathPiece))) b
rPath :: forall b. Render (Maybe (Bool, NonEmpty (RText 'PathPiece))) b
rPath Maybe (Bool, NonEmpty (RText 'PathPiece))
path =
  case Maybe (Bool, NonEmpty (RText 'PathPiece))
path of
    Maybe (Bool, NonEmpty (RText 'PathPiece))
Nothing -> forall a. Monoid a => a
mempty
    Just (Bool
trailingSlash, NonEmpty (RText 'PathPiece)
ps) ->
      ( forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse Tagged s b
"/" forall a b. (a -> b) -> a -> b
$ case NonEmpty (RText 'PathPiece)
ps of
          (RText 'PathPiece
x :| [RText 'PathPiece]
xs) -> forall s b (l :: RTextLabel).
(Reifies s (Renders b), RLabel l) =>
Word8 -> RText l -> Tagged s b
renderTextEscaping Word8
58 RText 'PathPiece
x forall a. a -> [a] -> [a]
: forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s b (l :: RTextLabel).
(Reifies s (Renders b), RLabel l) =>
RText l -> Tagged s b
renderText [RText 'PathPiece]
xs
      )
        forall a. Semigroup a => a -> a -> a
<> if Bool
trailingSlash then Tagged s b
"/" else forall a. Monoid a => a
mempty
{-# INLINE rPath #-}

rQuery :: Render [QueryParam] b
rQuery :: forall b. Render [QueryParam] b
rQuery = \case
  [] -> forall a. Monoid a => a
mempty
  [QueryParam]
qs -> Tagged s b
"?" forall a. Semigroup a => a -> a -> a
<> forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse Tagged s b
"&" (forall b. Render QueryParam b
rQueryParam forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [QueryParam]
qs))
{-# INLINE rQuery #-}

rQueryParam :: Render QueryParam b
rQueryParam :: forall b. Render QueryParam b
rQueryParam = \case
  QueryFlag RText 'QueryKey
flag -> forall s b (l :: RTextLabel).
(Reifies s (Renders b), RLabel l) =>
RText l -> Tagged s b
renderText RText 'QueryKey
flag
  QueryParam RText 'QueryKey
k RText 'QueryValue
v -> forall s b (l :: RTextLabel).
(Reifies s (Renders b), RLabel l) =>
RText l -> Tagged s b
renderText RText 'QueryKey
k forall a. Semigroup a => a -> a -> a
<> Tagged s b
"=" forall a. Semigroup a => a -> a -> a
<> forall s b (l :: RTextLabel).
(Reifies s (Renders b), RLabel l) =>
RText l -> Tagged s b
renderText RText 'QueryValue
v
{-# INLINE rQueryParam #-}

rFragment :: Render (RText 'Fragment) b
rFragment :: forall b. Render (RText 'Fragment) b
rFragment = (Tagged s b
"#" forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s b (l :: RTextLabel).
(Reifies s (Renders b), RLabel l) =>
RText l -> Tagged s b
renderText
{-# INLINE rFragment #-}

----------------------------------------------------------------------------
-- DString

newtype DString = DString {DString -> String -> String
toShowS :: ShowS}

instance S.Semigroup DString where
  DString String -> String
a <> :: DString -> DString -> DString
<> DString String -> String
b = (String -> String) -> DString
DString (String -> String
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
b)

instance Monoid DString where
  mempty :: DString
mempty = (String -> String) -> DString
DString forall a. a -> a
id
  mappend :: DString -> DString -> DString
mappend = forall a. Semigroup a => a -> a -> a
(S.<>)

instance IsString DString where
  fromString :: String -> DString
fromString String
str = (String -> String) -> DString
DString (String
str forall a. [a] -> [a] -> [a]
++)

----------------------------------------------------------------------------
-- Percent-encoding

-- | Percent-encode a 'Text' value.
percentEncode ::
  forall l.
  (RLabel l) =>
  -- | Scheme of the URI
  Maybe (RText 'Scheme) ->
  -- | A byte to additionally escape
  Maybe Word8 ->
  -- | Input text to encode
  RText l ->
  -- | Percent-encoded text
  Text
percentEncode :: forall (l :: RTextLabel).
RLabel l =>
Maybe (RText 'Scheme) -> Maybe Word8 -> RText l -> Text
percentEncode Maybe (RText 'Scheme)
mscheme Maybe Word8
alsoEscape RText l
rtxt =
  if forall (l :: RTextLabel). RLabel l => Proxy l -> Text -> Bool
skipEscaping (forall {k} (t :: k). Proxy t
Proxy :: Proxy l) Text
txt
    then Text
txt
    else forall a. (a -> Maybe (Char, a)) -> a -> Text
T.unfoldr (ByteString, String) -> Maybe (Char, (ByteString, String))
f (Text -> ByteString
TE.encodeUtf8 Text
txt, [])
  where
    f :: (ByteString, String) -> Maybe (Char, (ByteString, String))
f (ByteString
bs', []) =
      case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
bs' of
        Maybe (Word8, ByteString)
Nothing -> forall a. Maybe a
Nothing
        Just (Word8
w, ByteString
bs'') ->
          forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
            if
              | Bool
sap Bool -> Bool -> Bool
&& Word8
w forall a. Eq a => a -> a -> Bool
== Word8
32 -> (Char
'+', (ByteString
bs'', []))
              | Word8 -> Bool
nne Word8
w -> (Int -> Char
chr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w), (ByteString
bs'', []))
              | Bool
otherwise ->
                  let Char
c :| String
cs = forall {p}. Integral p => p -> NonEmpty Char
encodeByte Word8
w
                   in (Char
c, (ByteString
bs'', String
cs))
    f (ByteString
bs', Char
x : String
xs) = forall a. a -> Maybe a
Just (Char
x, (ByteString
bs', String
xs))
    encodeByte :: p -> NonEmpty Char
encodeByte p
x = Char
'%' forall a. a -> [a] -> NonEmpty a
:| [Int -> Char
intToDigit Int
h, Int -> Char
intToDigit Int
l]
      where
        (Int
h, Int
l) = forall a b. (Integral a, Num b) => a -> b
fromIntegral p
x forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
16
    nne :: Word8 -> Bool
nne Word8
w =
      let normalCase :: Bool
normalCase = forall (l :: RTextLabel).
RLabel l =>
Proxy l -> Maybe (RText 'Scheme) -> Word8 -> Bool
needsNoEscaping (forall {k} (t :: k). Proxy t
Proxy :: Proxy l) Maybe (RText 'Scheme)
mscheme Word8
w
       in case Maybe Word8
alsoEscape of
            Maybe Word8
Nothing -> Bool
normalCase
            Just Word8
w' -> if Word8
w forall a. Eq a => a -> a -> Bool
== Word8
w' then Bool
False else Bool
normalCase
    sap :: Bool
sap = forall (l :: RTextLabel). RLabel l => Proxy l -> Bool
spaceAsPlus (forall {k} (t :: k). Proxy t
Proxy :: Proxy l)
    txt :: Text
txt = forall (l :: RTextLabel). RText l -> Text
unRText RText l
rtxt
{-# INLINE percentEncode #-}

-- | This type class attaches some predicates that control serialization to
-- the type level label of kind 'RTextLabel'.
class RLabel (l :: RTextLabel) where
  -- | The predicate selects bytes that are not to be percent-escaped in
  -- rendered URI.
  needsNoEscaping :: Proxy l -> Maybe (RText 'Scheme) -> Word8 -> Bool

  -- | Whether to serialize space as the plus sign.
  spaceAsPlus :: Proxy l -> Bool
  spaceAsPlus Proxy l
Proxy = Bool
False

  -- | Whether to skip percent-escaping altogether for this value.
  skipEscaping :: Proxy l -> Text -> Bool
  skipEscaping Proxy l
Proxy Text
_ = Bool
False

instance RLabel 'Scheme where
  needsNoEscaping :: Proxy 'Scheme -> Maybe (RText 'Scheme) -> Word8 -> Bool
needsNoEscaping Proxy 'Scheme
Proxy Maybe (RText 'Scheme)
_ Word8
x = Word8 -> Bool
isAlphaNum Word8
x Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
== Word8
43 Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
== Word8
45 Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
== Word8
46

instance RLabel 'Host where
  needsNoEscaping :: Proxy 'Host -> Maybe (RText 'Scheme) -> Word8 -> Bool
needsNoEscaping Proxy 'Host
Proxy Maybe (RText 'Scheme)
_ Word8
x = Word8 -> Bool
isUnreserved Word8
x Bool -> Bool -> Bool
|| Word8 -> Bool
isDelim Word8
x
  skipEscaping :: Proxy 'Host -> Text -> Bool
skipEscaping Proxy 'Host
Proxy Text
x = Int -> Text -> Text
T.take Int
1 Text
x forall a. Eq a => a -> a -> Bool
== Text
"["

instance RLabel 'Username where
  needsNoEscaping :: Proxy 'Username -> Maybe (RText 'Scheme) -> Word8 -> Bool
needsNoEscaping Proxy 'Username
Proxy Maybe (RText 'Scheme)
_ Word8
x = Word8 -> Bool
isUnreserved Word8
x Bool -> Bool -> Bool
|| Word8 -> Bool
isDelim Word8
x

instance RLabel 'Password where
  needsNoEscaping :: Proxy 'Password -> Maybe (RText 'Scheme) -> Word8 -> Bool
needsNoEscaping Proxy 'Password
Proxy Maybe (RText 'Scheme)
_ Word8
x = Word8 -> Bool
isUnreserved Word8
x Bool -> Bool -> Bool
|| Word8 -> Bool
isDelim Word8
x Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
== Word8
58

instance RLabel 'PathPiece where
  needsNoEscaping :: Proxy 'PathPiece -> Maybe (RText 'Scheme) -> Word8 -> Bool
needsNoEscaping Proxy 'PathPiece
Proxy Maybe (RText 'Scheme)
mscheme Word8
x =
    case Maybe (RText 'Scheme)
mscheme of
      Maybe (RText 'Scheme)
Nothing -> Bool
commonCase
      Just RText 'Scheme
scheme ->
        if forall (l :: RTextLabel). RText l -> Text
unRText RText 'Scheme
scheme forall a. Eq a => a -> a -> Bool
== Text
"mailto"
          then Bool
commonCase Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
== Word8
64
          else Bool
commonCase
    where
      commonCase :: Bool
commonCase = Word8 -> Bool
isUnreserved Word8
x Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
== Word8
58

instance RLabel 'QueryKey where
  needsNoEscaping :: Proxy 'QueryKey -> Maybe (RText 'Scheme) -> Word8 -> Bool
needsNoEscaping Proxy 'QueryKey
Proxy Maybe (RText 'Scheme)
_ Word8
x =
    (Word8 -> Bool) -> Word8 -> Bool
isPChar Word8 -> Bool
isDelim' Word8
x Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
== Word8
47 Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
== Word8
63
  spaceAsPlus :: Proxy 'QueryKey -> Bool
spaceAsPlus Proxy 'QueryKey
Proxy = Bool
True

instance RLabel 'QueryValue where
  needsNoEscaping :: Proxy 'QueryValue -> Maybe (RText 'Scheme) -> Word8 -> Bool
needsNoEscaping Proxy 'QueryValue
Proxy Maybe (RText 'Scheme)
_ Word8
x =
    (Word8 -> Bool) -> Word8 -> Bool
isPChar Word8 -> Bool
isDelim' Word8
x Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
== Word8
47 Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
== Word8
63
  spaceAsPlus :: Proxy 'QueryValue -> Bool
spaceAsPlus Proxy 'QueryValue
Proxy = Bool
True

instance RLabel 'Fragment where
  needsNoEscaping :: Proxy 'Fragment -> Maybe (RText 'Scheme) -> Word8 -> Bool
needsNoEscaping Proxy 'Fragment
Proxy Maybe (RText 'Scheme)
_ Word8
x =
    (Word8 -> Bool) -> Word8 -> Bool
isPChar Word8 -> Bool
isDelim Word8
x Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
== Word8
47 Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
== Word8
63

isPChar :: (Word8 -> Bool) -> Word8 -> Bool
isPChar :: (Word8 -> Bool) -> Word8 -> Bool
isPChar Word8 -> Bool
f Word8
x = Word8 -> Bool
isUnreserved Word8
x Bool -> Bool -> Bool
|| Word8 -> Bool
f Word8
x Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
== Word8
58 Bool -> Bool -> Bool
|| Word8
x forall a. Eq a => a -> a -> Bool
== Word8
64

isUnreserved :: Word8 -> Bool
isUnreserved :: Word8 -> Bool
isUnreserved Word8
x = Word8 -> Bool
isAlphaNum Word8
x Bool -> Bool -> Bool
|| Bool
other
  where
    other :: Bool
other = case Word8
x of
      Word8
45 -> Bool
True
      Word8
46 -> Bool
True
      Word8
95 -> Bool
True
      Word8
126 -> Bool
True
      Word8
_ -> Bool
False

isAlphaNum :: Word8 -> Bool
isAlphaNum :: Word8 -> Bool
isAlphaNum Word8
x
  | Word8
x forall a. Ord a => a -> a -> Bool
>= Word8
65 Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
90 = Bool
True -- 'A'..'Z'
  | Word8
x forall a. Ord a => a -> a -> Bool
>= Word8
97 Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
122 = Bool
True -- 'a'..'z'
  | Word8
x forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
57 = Bool
True -- '0'..'9'
  | Bool
otherwise = Bool
False

isDelim :: Word8 -> Bool
isDelim :: Word8 -> Bool
isDelim Word8
x
  | Word8
x forall a. Eq a => a -> a -> Bool
== Word8
33 = Bool
True
  | Word8
x forall a. Eq a => a -> a -> Bool
== Word8
36 = Bool
True
  | Word8
x forall a. Ord a => a -> a -> Bool
>= Word8
38 Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
44 = Bool
True
  | Word8
x forall a. Eq a => a -> a -> Bool
== Word8
59 = Bool
True
  | Word8
x forall a. Eq a => a -> a -> Bool
== Word8
61 = Bool
True
  | Bool
otherwise = Bool
False

isDelim' :: Word8 -> Bool
isDelim' :: Word8 -> Bool
isDelim' Word8
x
  | Word8
x forall a. Eq a => a -> a -> Bool
== Word8
33 = Bool
True
  | Word8
x forall a. Eq a => a -> a -> Bool
== Word8
36 = Bool
True
  | Word8
x forall a. Ord a => a -> a -> Bool
>= Word8
39 Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
<= Word8
42 = Bool
True
  | Word8
x forall a. Eq a => a -> a -> Bool
== Word8
44 = Bool
True
  | Word8
x forall a. Eq a => a -> a -> Bool
== Word8
59 = Bool
True
  | Bool
otherwise = Bool
False