{-# 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 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
render :: URI -> Text
render :: URI -> Text
render = LazyText -> Text
TL.toStrict (LazyText -> Text) -> (URI -> LazyText) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyText
TLB.toLazyText (Builder -> LazyText) -> (URI -> Builder) -> URI -> LazyText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> Builder
render'
render' :: URI -> TLB.Builder
render' :: URI -> Builder
render' URI
x =
(Word -> Builder)
-> (forall (l :: RTextLabel).
RLabel l =>
Maybe Word8 -> RText l -> Builder)
-> (forall s. Reifies s (Renders Builder) => Tagged s Builder)
-> Builder
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
forall a. Integral a => a -> Builder
TLB.decimal
( \Maybe Word8
mw RText l
r ->
Text -> Builder
TLB.fromText
( Maybe (RText 'Scheme) -> Maybe Word8 -> RText l -> Text
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
)
)
(URI -> Tagged s Builder
forall b s.
(Semigroup b, Monoid b, IsString b, Reifies s (Renders b)) =>
URI -> Tagged s b
genericRender URI
x)
renderBs :: URI -> ByteString
renderBs :: URI -> ByteString
renderBs = LazyByteString -> ByteString
BL.toStrict (LazyByteString -> ByteString)
-> (URI -> LazyByteString) -> URI -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyByteString
BB.toLazyByteString (Builder -> LazyByteString)
-> (URI -> Builder) -> URI -> LazyByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> Builder
renderBs'
renderBs' :: URI -> BB.Builder
renderBs' :: URI -> Builder
renderBs' URI
x =
(Word -> Builder)
-> (forall (l :: RTextLabel).
RLabel l =>
Maybe Word8 -> RText l -> Builder)
-> (forall s. Reifies s (Renders Builder) => Tagged s Builder)
-> Builder
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
( Maybe (RText 'Scheme) -> Maybe Word8 -> RText l -> Text
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
)
)
)
(URI -> Tagged s Builder
forall b s.
(Semigroup b, Monoid b, IsString b, Reifies s (Renders b)) =>
URI -> Tagged s b
genericRender URI
x)
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'
renderStr' :: URI -> ShowS
renderStr' :: URI -> String -> String
renderStr' 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 =>
Maybe Word8 -> RText l -> DString)
-> (forall s. Reifies s (Renders DString) => Tagged s DString)
-> DString
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 ((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)
( \Maybe Word8
mw RText l
r ->
String -> DString
forall a. IsString a => String -> a
fromString
( Text -> String
T.unpack
( Maybe (RText 'Scheme) -> Maybe Word8 -> RText l -> Text
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
)
)
)
(URI -> Tagged s DString
forall b s.
(Semigroup b, Monoid b, IsString b, Reifies s (Renders b)) =>
URI -> Tagged s b
genericRender URI
x)
mediateExtraEscaping :: URI -> Maybe Word8 -> Maybe Word8
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)
_ -> Maybe Word8
forall a. Maybe a
Nothing
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 = 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 {Maybe Word8 -> RText l -> b
Word -> b
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
rText :: forall (l :: RTextLabel). RLabel l => Maybe Word8 -> RText l -> b
..} ((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 :: forall s b. Reifies s (Renders b) => 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
forall (proxy :: * -> *). proxy s -> Renders b
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 :: forall s b (l :: RTextLabel).
(Reifies s (Renders b), RLabel l) =>
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 =>
Maybe Word8 -> RText l -> b
forall b.
Renders b
-> forall (l :: RTextLabel).
RLabel l =>
Maybe Word8 -> RText l -> b
rText (Proxy s -> Renders b
forall {k} (s :: k) a (proxy :: k -> *).
Reifies s a =>
proxy s -> a
forall (proxy :: * -> *). proxy s -> Renders b
reflect (Proxy s
forall {k} (t :: k). Proxy t
Proxy :: Proxy s)) Maybe Word8
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 = 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 =>
Maybe Word8 -> RText l -> b
forall b.
Renders b
-> forall (l :: RTextLabel).
RLabel l =>
Maybe Word8 -> RText l -> b
rText (Proxy s -> Renders b
forall {k} (s :: k) a (proxy :: k -> *).
Reifies s a =>
proxy s -> a
forall (proxy :: * -> *). proxy s -> Renders b
reflect (Proxy s
forall {k} (t :: k). Proxy t
Proxy :: Proxy s)) (Word8 -> Maybe Word8
forall a. a -> Maybe a
Just Word8
w)
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 s.
(Semigroup b, Monoid b, IsString b, Reifies s (Renders b)) =>
URI -> Tagged s b
genericRender URI {[QueryParam]
Maybe (Bool, NonEmpty (RText 'PathPiece))
Maybe (RText 'Scheme)
Maybe (RText 'Fragment)
Either Bool Authority
uriScheme :: URI -> Maybe (RText 'Scheme)
uriAuthority :: URI -> Either Bool Authority
uriScheme :: Maybe (RText 'Scheme)
uriAuthority :: Either Bool Authority
uriPath :: Maybe (Bool, NonEmpty (RText 'PathPiece))
uriQuery :: [QueryParam]
uriFragment :: Maybe (RText 'Fragment)
uriFragment :: URI -> Maybe (RText 'Fragment)
uriQuery :: URI -> [QueryParam]
uriPath :: URI -> Maybe (Bool, NonEmpty (RText 'PathPiece))
..} =
[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 s.
(Semigroup b, Monoid b, IsString b, Reifies s (Renders b)) =>
RText 'Scheme -> Tagged s 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 s.
(Semigroup b, Monoid b, IsString b, Reifies s (Renders b)) =>
Authority -> Tagged s 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),
Either Bool Authority
-> Render (Maybe (Bool, NonEmpty (RText 'PathPiece))) b
forall a b.
Either Bool a
-> Render (Maybe (Bool, NonEmpty (RText 'PathPiece))) b
rAbsPathSlash Either Bool Authority
uriAuthority Maybe (Bool, NonEmpty (RText 'PathPiece))
uriPath,
Maybe (Bool, NonEmpty (RText 'PathPiece)) -> Tagged s b
forall b s.
(Semigroup b, Monoid b, IsString b, Reifies s (Renders b)) =>
Maybe (Bool, NonEmpty (RText 'PathPiece)) -> Tagged s b
rPath Maybe (Bool, NonEmpty (RText 'PathPiece))
uriPath,
[QueryParam] -> Tagged s b
forall b s.
(Semigroup b, Monoid b, IsString b, Reifies s (Renders b)) =>
[QueryParam] -> Tagged s 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 s.
(Semigroup b, Monoid b, IsString b, Reifies s (Renders b)) =>
RText 'Fragment -> Tagged s 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 = 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 :: forall b s.
(Semigroup b, Monoid b, IsString b, Reifies s (Renders b)) =>
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 -> 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 :: forall b s.
(Semigroup b, Monoid b, IsString b, Reifies s (Renders b)) =>
Authority -> Tagged s b
rAuthority Authority {Maybe Word
Maybe UserInfo
RText 'Host
authUserInfo :: Maybe UserInfo
authHost :: RText 'Host
authPort :: Maybe Word
authPort :: Authority -> Maybe Word
authHost :: Authority -> RText 'Host
authUserInfo :: Authority -> Maybe UserInfo
..} =
[Tagged s b] -> Tagged s b
forall a. Monoid a => [a] -> a
mconcat
[ Tagged s b
"//",
(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 s.
(Semigroup b, Monoid b, IsString b, Reifies s (Renders b)) =>
UserInfo -> Tagged s 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 -> 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 :: forall b s.
(Semigroup b, Monoid b, IsString b, Reifies s (Renders b)) =>
UserInfo -> Tagged s b
rUserInfo UserInfo {Maybe (RText 'Password)
RText 'Username
uiUsername :: RText 'Username
uiPassword :: Maybe (RText 'Password)
uiPassword :: UserInfo -> Maybe (RText 'Password)
uiUsername :: UserInfo -> RText 'Username
..} =
[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 -> 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,
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 Tagged s b
forall a. Monoid a => a
mempty
rAbsPathSlash (Right a
_) Maybe (Bool, NonEmpty (RText 'PathPiece))
Nothing = Tagged s b
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 s.
(Semigroup b, Monoid b, IsString b, Reifies s (Renders b)) =>
Maybe (Bool, NonEmpty (RText 'PathPiece)) -> Tagged s b
rPath Maybe (Bool, NonEmpty (RText 'PathPiece))
path =
case Maybe (Bool, NonEmpty (RText 'PathPiece))
path of
Maybe (Bool, NonEmpty (RText 'PathPiece))
Nothing -> Tagged s b
forall a. Monoid a => a
mempty
Just (Bool
trailingSlash, NonEmpty (RText 'PathPiece)
ps) ->
( [Tagged s b] -> Tagged s b
forall a. Monoid a => [a] -> a
mconcat ([Tagged s b] -> Tagged s b)
-> ([Tagged s b] -> [Tagged s b]) -> [Tagged s b] -> 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] -> Tagged s b) -> [Tagged s b] -> Tagged s b
forall a b. (a -> b) -> a -> b
$ case NonEmpty (RText 'PathPiece)
ps of
(RText 'PathPiece
x :| [RText 'PathPiece]
xs) -> Word8 -> RText 'PathPiece -> Tagged s b
forall s b (l :: RTextLabel).
(Reifies s (Renders b), RLabel l) =>
Word8 -> RText l -> Tagged s b
renderTextEscaping Word8
58 RText 'PathPiece
x Tagged s b -> [Tagged s b] -> [Tagged s b]
forall a. a -> [a] -> [a]
: (RText 'PathPiece -> Tagged s b)
-> [RText 'PathPiece] -> [Tagged s b]
forall a b. (a -> b) -> [a] -> [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]
xs
)
Tagged s b -> Tagged s b -> Tagged s b
forall a. Semigroup a => a -> a -> a
<> if Bool
trailingSlash then Tagged s b
"/" else Tagged s b
forall a. Monoid a => a
mempty
{-# INLINE rPath #-}
rQuery :: Render [QueryParam] b
rQuery :: forall b s.
(Semigroup b, Monoid b, IsString b, Reifies s (Renders b)) =>
[QueryParam] -> Tagged s b
rQuery = \case
[] -> Tagged s b
forall a. Monoid a => a
mempty
[QueryParam]
qs -> Tagged s b
"?" 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 Tagged s b
"&" (QueryParam -> Tagged s b
forall b s.
(Semigroup b, Monoid b, IsString b, Reifies s (Renders b)) =>
QueryParam -> Tagged s 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 :: forall b s.
(Semigroup b, Monoid b, IsString b, Reifies s (Renders b)) =>
QueryParam -> Tagged s b
rQueryParam = \case
QueryFlag 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 RText 'QueryKey
k 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 -> 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 :: forall b s.
(Semigroup b, Monoid b, IsString b, Reifies s (Renders b)) =>
RText 'Fragment -> Tagged s b
rFragment = (Tagged s b
"#" 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 #-}
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 (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 String
str = (String -> String) -> DString
DString (String
str String -> String -> String
forall a. [a] -> [a] -> [a]
++)
percentEncode ::
forall l.
(RLabel l) =>
Maybe (RText 'Scheme) ->
Maybe Word8 ->
RText l ->
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 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 (ByteString
bs', []) =
case ByteString -> Maybe (Word8, ByteString)
B.uncons ByteString
bs' of
Maybe (Word8, ByteString)
Nothing -> Maybe (Char, (ByteString, String))
forall a. Maybe a
Nothing
Just (Word8
w, 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
== Word8
32 -> (Char
'+', (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 Char
c :| String
cs = Word8 -> NonEmpty Char
forall {p}. Integral p => p -> NonEmpty Char
encodeByte Word8
w
in (Char
c, (ByteString
bs'', String
cs))
f (ByteString
bs', Char
x : String
xs) = (Char, (ByteString, String)) -> Maybe (Char, (ByteString, String))
forall a. a -> Maybe a
Just (Char
x, (ByteString
bs', String
xs))
encodeByte :: p -> NonEmpty Char
encodeByte p
x = Char
'%' Char -> String -> NonEmpty Char
forall a. a -> [a] -> NonEmpty a
:| [Int -> Char
intToDigit Int
h, Int -> Char
intToDigit Int
l]
where
(Int
h, Int
l) = p -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral p
x Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Int
16
nne :: Word8 -> Bool
nne Word8
w =
let normalCase :: Bool
normalCase = Proxy l -> Maybe (RText 'Scheme) -> Word8 -> Bool
forall (l :: RTextLabel).
RLabel l =>
Proxy l -> Maybe (RText 'Scheme) -> Word8 -> Bool
needsNoEscaping (Proxy l
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 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w' then Bool
False else Bool
normalCase
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 #-}
class RLabel (l :: RTextLabel) where
needsNoEscaping :: Proxy l -> Maybe (RText 'Scheme) -> Word8 -> Bool
spaceAsPlus :: Proxy l -> Bool
spaceAsPlus Proxy l
Proxy = Bool
False
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 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
43 Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
45 Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
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 Text -> Text -> Bool
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 Word8 -> Word8 -> Bool
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 RText 'Scheme -> Text
forall (l :: RTextLabel). RText l -> Text
unRText RText 'Scheme
scheme Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"mailto"
then Bool
commonCase Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
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 Word8 -> Word8 -> Bool
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 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
47 Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
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 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
47 Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
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 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
47 Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
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 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
58 Bool -> Bool -> Bool
|| Word8
x Word8 -> Word8 -> Bool
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 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
65 Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
90 = Bool
True
| Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
97 Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
122 = Bool
True
| Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
48 Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
57 = Bool
True
| Bool
otherwise = Bool
False
isDelim :: Word8 -> Bool
isDelim :: Word8 -> Bool
isDelim Word8
x
| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
33 = Bool
True
| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
36 = Bool
True
| Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
38 Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
44 = Bool
True
| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
59 = Bool
True
| Word8
x Word8 -> Word8 -> Bool
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 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
33 = Bool
True
| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
36 = Bool
True
| Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
39 Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
42 = Bool
True
| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
44 = Bool
True
| Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
59 = Bool
True
| Bool
otherwise = Bool
False