-- |
-- 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.

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

module Text.URI.Render
  ( render
  , render'
  , renderBs
  , renderBs'
  , renderStr
  , renderStr' )
where

import Data.ByteString (ByteString)
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 Data.String (IsString (..))
import Data.Tagged
import Data.Text (Text)
import Data.Word (Word8)
import Numeric (showInt)
import Text.URI.Types
import qualified Data.ByteString              as B
import qualified Data.ByteString.Lazy         as BL
import qualified Data.ByteString.Lazy.Builder as BLB
import qualified Data.List.NonEmpty           as NE
import qualified Data.Semigroup               as S
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

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

-- | Render a given 'URI' value as strict 'Text'.

render :: URI -> Text
render :: URI -> Text
render = Text -> Text
TL.toStrict (Text -> Text) -> (URI -> Text) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TLB.toLazyText (Builder -> Text) -> (URI -> Builder) -> URI -> Text
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' x :: URI
x = (Word -> Builder)
-> (forall (l :: RTextLabel). RLabel l => RText l -> Builder)
-> (forall s. Reifies s (Renders Builder) => Tagged s Builder)
-> Builder
forall b.
(Word -> b)
-> (forall (l :: RTextLabel). RLabel l => RText l -> b)
-> (forall s. Reifies s (Renders b) => Tagged s b)
-> b
equip
  Word -> Builder
forall a. Integral a => a -> Builder
TLB.decimal
  (Text -> Builder
TLB.fromText (Text -> Builder) -> (RText l -> Text) -> RText l -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RText l -> Text
forall (l :: RTextLabel). RLabel l => RText l -> Text
percentEncode)
  (URI -> Tagged s Builder
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 (ByteString -> ByteString)
-> (URI -> ByteString) -> URI -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BLB.toLazyByteString (Builder -> ByteString) -> (URI -> Builder) -> URI -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> Builder
renderBs'

-- | Render a given 'URI' value as a 'BLB.Builder'.

renderBs' :: URI -> BLB.Builder
renderBs' :: URI -> Builder
renderBs' x :: URI
x = (Word -> Builder)
-> (forall (l :: RTextLabel). RLabel l => RText l -> Builder)
-> (forall s. Reifies s (Renders Builder) => Tagged s Builder)
-> Builder
forall b.
(Word -> b)
-> (forall (l :: RTextLabel). RLabel l => RText l -> b)
-> (forall s. Reifies s (Renders b) => Tagged s b)
-> b
equip
  Word -> Builder
BLB.wordDec
  (ByteString -> Builder
BLB.byteString (ByteString -> Builder)
-> (RText l -> ByteString) -> RText l -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> (RText l -> Text) -> RText l -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RText l -> Text
forall (l :: RTextLabel). RLabel l => RText l -> Text
percentEncode)
  (URI -> Tagged s Builder
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 = ((String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ []) ((String -> String) -> String)
-> (URI -> String -> String) -> URI -> String
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' x :: URI
x = DString -> String -> String
toShowS (DString -> String -> String) -> DString -> String -> String
forall a b. (a -> b) -> a -> b
$ (Word -> DString)
-> (forall (l :: RTextLabel). RLabel l => RText l -> DString)
-> (forall s. Reifies s (Renders DString) => Tagged s DString)
-> DString
forall b.
(Word -> b)
-> (forall (l :: RTextLabel). RLabel l => RText l -> b)
-> (forall s. Reifies s (Renders b) => Tagged s b)
-> b
equip
  ((String -> String) -> DString
DString ((String -> String) -> DString)
-> (Word -> String -> String) -> Word -> DString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> String -> String
forall a. Integral a => a -> String -> String
showInt)
  (String -> DString
forall a. IsString a => String -> a
fromString (String -> DString) -> (RText l -> String) -> RText l -> DString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (RText l -> Text) -> RText l -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RText l -> Text
forall (l :: RTextLabel). RLabel l => RText l -> Text
percentEncode)
  (URI -> Tagged s DString
forall b. Render URI b
genericRender URI
x)

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

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

equip
  :: forall b. (Word -> b)
  -> (forall l. RLabel l => RText l -> b)
  -> (forall (s :: Type). Reifies s (Renders b) => Tagged s b)
  -> b
equip :: (Word -> b)
-> (forall (l :: RTextLabel). RLabel l => RText l -> b)
-> (forall s. Reifies s (Renders b) => Tagged s b)
-> b
equip rWord :: Word -> b
rWord rText :: forall (l :: RTextLabel). RLabel l => RText l -> b
rText f :: forall s. Reifies s (Renders b) => Tagged s b
f = Renders b -> (forall s. Reifies s (Renders b) => Proxy s -> b) -> b
forall a r. a -> (forall s. Reifies s a => Proxy s -> r) -> r
reify Renders :: forall b.
(Word -> b)
-> (forall (l :: RTextLabel). RLabel l => RText l -> b)
-> Renders b
Renders {..} ((forall s. Reifies s (Renders b) => Proxy s -> b) -> b)
-> (forall s. Reifies s (Renders b) => Proxy s -> b) -> b
forall a b. (a -> b) -> a -> b
$ \(Proxy s
Proxy :: Proxy s') ->
  Tagged s b -> b
forall k (s :: k) b. Tagged s b -> b
unTagged (Tagged s b
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 :: Word -> Tagged s b
renderWord = b -> Tagged s b
forall k (s :: k) b. b -> Tagged s b
Tagged (b -> Tagged s b) -> (Word -> b) -> Word -> Tagged s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Renders b -> Word -> b
forall b. Renders b -> Word -> b
rWord (Proxy s -> Renders b
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
reflect (Proxy s
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 :: RText l -> Tagged s b
renderText = b -> Tagged s b
forall k (s :: k) b. b -> Tagged s b
Tagged (b -> Tagged s b) -> (RText l -> b) -> RText l -> Tagged s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Renders b -> forall (l :: RTextLabel). RLabel l => RText l -> b
forall b.
Renders b -> forall (l :: RTextLabel). RLabel l => RText l -> b
rText (Proxy s -> Renders b
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
reflect (Proxy s
forall k (t :: k). Proxy t
Proxy :: Proxy s))

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

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

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

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

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

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

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

rQueryParam :: Render QueryParam b
rQueryParam :: QueryParam -> Tagged s b
rQueryParam = \case
  QueryFlag flag :: RText 'QueryKey
flag -> RText 'QueryKey -> Tagged s b
forall s b (l :: RTextLabel).
(Reifies s (Renders b), RLabel l) =>
RText l -> Tagged s b
renderText RText 'QueryKey
flag
  QueryParam k :: RText 'QueryKey
k v :: RText 'QueryValue
v -> RText 'QueryKey -> Tagged s b
forall s b (l :: RTextLabel).
(Reifies s (Renders b), RLabel l) =>
RText l -> Tagged s b
renderText RText 'QueryKey
k Tagged s b -> Tagged s b -> Tagged s b
forall a. Semigroup a => a -> a -> a
<> "=" Tagged s b -> Tagged s b -> Tagged s b
forall a. Semigroup a => a -> a -> a
<> RText 'QueryValue -> Tagged s b
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 :: RText 'Fragment -> Tagged s b
rFragment = ("#" Tagged s b -> Tagged s b -> Tagged s b
forall a. Semigroup a => a -> a -> a
<>) (Tagged s b -> Tagged s b)
-> (RText 'Fragment -> Tagged s b) -> RText 'Fragment -> Tagged s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RText 'Fragment -> Tagged s b
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 a :: String -> String
a <> :: DString -> DString -> DString
<> DString b :: String -> String
b = (String -> String) -> DString
DString (String -> String
a (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
b)

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

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

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

-- | Percent-encode a 'Text' value.

percentEncode :: forall l. RLabel l
  => RText l           -- ^ Input text to encode
  -> Text              -- ^ Percent-encoded text
percentEncode :: RText l -> Text
percentEncode rtxt :: RText l
rtxt =
  if Proxy l -> Text -> Bool
forall (l :: RTextLabel). RLabel l => Proxy l -> Text -> Bool
skipEscaping (Proxy l
forall k (t :: k). Proxy t
Proxy :: Proxy l) Text
txt
    then Text
txt
    else ((ByteString, String) -> Maybe (Char, (ByteString, String)))
-> (ByteString, String) -> Text
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 (bs' :: ByteString
bs', []) =
      case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
bs' of
        Nothing -> Maybe (Char, (ByteString, String))
forall a. Maybe a
Nothing
        Just (w :: Word8
w, bs'' :: ByteString
bs'') -> (Char, (ByteString, String)) -> Maybe (Char, (ByteString, String))
forall a. a -> Maybe a
Just ((Char, (ByteString, String))
 -> Maybe (Char, (ByteString, String)))
-> (Char, (ByteString, String))
-> Maybe (Char, (ByteString, String))
forall a b. (a -> b) -> a -> b
$
          if | Bool
sap Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 32 -> ('+', (ByteString
bs'', []))
             | Word8 -> Bool
nne Word8
w          -> (Int -> Char
chr (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w), (ByteString
bs'', []))
             | Bool
otherwise      ->
               let c :: Char
c:|cs :: String
cs = Word8 -> NonEmpty Char
forall a. Integral a => a -> NonEmpty Char
encodeByte Word8
w
               in (Char
c, (ByteString
bs'', String
cs))
    f (bs' :: ByteString
bs', x :: Char
x:xs :: String
xs) = (Char, (ByteString, String)) -> Maybe (Char, (ByteString, String))
forall a. a -> Maybe a
Just (Char
x, (ByteString
bs', String
xs))
    encodeByte :: a -> NonEmpty Char
encodeByte x :: a
x = '%' Char -> String -> NonEmpty Char
forall a. a -> [a] -> NonEmpty a
:| [Int -> Char
intToDigit Int
h, Int -> Char
intToDigit Int
l]
      where
        (h :: Int
h, l :: Int
l) = a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` 16
    nne :: Word8 -> Bool
nne = Proxy l -> Word8 -> Bool
forall (l :: RTextLabel). RLabel l => Proxy l -> Word8 -> Bool
needsNoEscaping (Proxy l
forall k (t :: k). Proxy t
Proxy :: Proxy l)
    sap :: Bool
sap = Proxy l -> Bool
forall (l :: RTextLabel). RLabel l => Proxy l -> Bool
spaceAsPlus     (Proxy l
forall k (t :: k). Proxy t
Proxy :: Proxy l)
    txt :: Text
txt = RText l -> Text
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 -> Word8 -> Bool

  -- | Whether to serialize space as the plus sign.

  spaceAsPlus :: Proxy l -> Bool
  spaceAsPlus Proxy = Bool
False

  -- | Whether to skip percent-escaping altogether for this value.

  skipEscaping :: Proxy l -> Text -> Bool
  skipEscaping Proxy _ = Bool
False

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

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

instance RLabel 'Username where
  needsNoEscaping :: Proxy 'Username -> Word8 -> Bool
needsNoEscaping Proxy x :: Word8
x = Word8 -> Bool
isUnreserved Word8
x Bool -> Bool -> Bool
|| Word8 -> Bool
isDelim Word8
x

instance RLabel 'Password where
  needsNoEscaping :: Proxy 'Password -> Word8 -> Bool
needsNoEscaping Proxy x :: Word8
x = Word8 -> Bool
isUnreserved Word8
x Bool -> Bool -> Bool
|| Word8 -> Bool
isDelim Word8
x Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 58

instance RLabel 'PathPiece where
  needsNoEscaping :: Proxy 'PathPiece -> Word8 -> Bool
needsNoEscaping Proxy x :: Word8
x =
    Word8 -> Bool
isUnreserved Word8
x Bool -> Bool -> Bool
|| Word8 -> Bool
isDelim Word8
x Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== 64

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

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

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

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

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

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

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

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