{-# LANGUAGE RecordWildCards, FlexibleContexts, FlexibleInstances, OverloadedStrings #-}
module Clckwrks.Redirect.Plugin where

import Clckwrks                     ( ClckwrksConfig(clckTopDir), ClckState(plugins), ClckT(..), ClckURL, ClckPlugins, Theme
                                    , Role(..), ClckPluginsSt, addAdminMenu, addNavBarCallback, addPreProc, query, update
                                    )
import Clckwrks.Acid                (GetUACCT(..), SetUACCT(..))
import Clckwrks.Plugin              (clckPlugin)
import Clckwrks.Redirect.Acid       (RedirectState, initialRedirectState)
import Clckwrks.Redirect.Monad      (RedirectConfig(..), runRedirectT)
import Clckwrks.Redirect.Route      (routeRedirect)
import Clckwrks.Redirect.URL        (RedirectURL(..), RedirectAdminURL(..))
import Clckwrks.Redirect.Types      ()
import Control.Applicative          ((<$>))
import Control.Monad.State          (get)
import Data.Acid                    (AcidState)
import Data.Acid.Advanced           (update', query')
import Data.Acid.Local              (createCheckpointAndClose, openLocalStateFrom,)
import Data.Char              (ord)
import Data.List              (intersperse)
import Data.Monoid            ((<>))
import Data.String            (fromString)
import qualified Data.Text    as Text
import Data.Text                    (Text)
import Data.Text.Lazy         (toStrict)
import qualified Data.Text.Lazy     as TL
import Data.Text.Lazy.Builder (Builder, fromText, singleton, toLazyText)
import Data.Typeable                (Typeable)
import Data.Maybe                   (fromMaybe)
import Data.Set                     (Set)
import qualified Data.Set           as Set
import Numeric                (showIntAtBase)
import Happstack.Server             (ServerPartT, Response, seeOther, notFound, toResponse)
-- import System.Directory             (createDirectoryIfMissing)
import System.FilePath              ((</>))
import Web.Routes                   (toPathSegments, parseSegments, withRouteT, fromPathSegments)
import Web.Plugins.Core             (Plugin(..), Plugins(..), When(..), addCleanup, addHandler, addPostHook, addPluginRouteFn, initPlugin, getConfig, getPluginRouteFn)

redirectHandler :: (RedirectURL -> [(Text, Maybe Text)] -> Text)
                -> RedirectConfig
                -> ClckPlugins
                -> [Text]
                -> ClckT ClckURL (ServerPartT IO) Response
redirectHandler :: (RedirectURL -> [(Text, Maybe Text)] -> Text)
-> RedirectConfig
-> ClckPlugins
-> [Text]
-> ClckT ClckURL (ServerPartT IO) Response
redirectHandler RedirectURL -> [(Text, Maybe Text)] -> Text
showRedirectURL RedirectConfig
redirectConfig ClckPlugins
plugins [Text]
paths =
    case URLParser RedirectURL -> [Text] -> Either String RedirectURL
forall a. URLParser a -> [Text] -> Either String a
parseSegments URLParser RedirectURL
forall url. PathInfo url => URLParser url
fromPathSegments [Text]
paths of
      (Left String
e)  -> Response -> ClckT ClckURL (ServerPartT IO) Response
forall (m :: * -> *) a. FilterMonad Response m => a -> m a
notFound (Response -> ClckT ClckURL (ServerPartT IO) Response)
-> Response -> ClckT ClckURL (ServerPartT IO) Response
forall a b. (a -> b) -> a -> b
$ String -> Response
forall a. ToMessage a => a -> Response
toResponse (String -> String
forall a. Show a => a -> String
show String
e)
      (Right RedirectURL
u) ->
          RouteT ClckURL (StateT ClckState (ServerPartT IO)) Response
-> ClckT ClckURL (ServerPartT IO) Response
forall url (m :: * -> *) a.
RouteT url (StateT ClckState m) a -> ClckT url m a
ClckT (RouteT ClckURL (StateT ClckState (ServerPartT IO)) Response
 -> ClckT ClckURL (ServerPartT IO) Response)
-> RouteT ClckURL (StateT ClckState (ServerPartT IO)) Response
-> ClckT ClckURL (ServerPartT IO) Response
forall a b. (a -> b) -> a -> b
$ ((ClckURL -> [(Text, Maybe Text)] -> Text)
 -> RedirectURL -> [(Text, Maybe Text)] -> Text)
-> RouteT RedirectURL (StateT ClckState (ServerPartT IO)) Response
-> RouteT ClckURL (StateT ClckState (ServerPartT IO)) Response
forall url' url (m :: * -> *) a.
((url' -> [(Text, Maybe Text)] -> Text)
 -> url -> [(Text, Maybe Text)] -> Text)
-> RouteT url m a -> RouteT url' m a
withRouteT (ClckURL -> [(Text, Maybe Text)] -> Text)
-> RedirectURL -> [(Text, Maybe Text)] -> Text
forall url'.
(url' -> [(Text, Maybe Text)] -> Text)
-> RedirectURL -> [(Text, Maybe Text)] -> Text
flattenURL (RouteT RedirectURL (StateT ClckState (ServerPartT IO)) Response
 -> RouteT ClckURL (StateT ClckState (ServerPartT IO)) Response)
-> RouteT RedirectURL (StateT ClckState (ServerPartT IO)) Response
-> RouteT ClckURL (StateT ClckState (ServerPartT IO)) Response
forall a b. (a -> b) -> a -> b
$ ClckT RedirectURL (ServerPartT IO) Response
-> RouteT RedirectURL (StateT ClckState (ServerPartT IO)) Response
forall url (m :: * -> *) a.
ClckT url m a -> RouteT url (StateT ClckState m) a
unClckT (ClckT RedirectURL (ServerPartT IO) Response
 -> RouteT RedirectURL (StateT ClckState (ServerPartT IO)) Response)
-> ClckT RedirectURL (ServerPartT IO) Response
-> RouteT RedirectURL (StateT ClckState (ServerPartT IO)) Response
forall a b. (a -> b) -> a -> b
$ RedirectConfig
-> RedirectT (ServerPartT IO) Response
-> ClckT RedirectURL (ServerPartT IO) Response
forall (m :: * -> *) a.
RedirectConfig -> RedirectT m a -> ClckT RedirectURL m a
runRedirectT RedirectConfig
redirectConfig (RedirectT (ServerPartT IO) Response
 -> ClckT RedirectURL (ServerPartT IO) Response)
-> RedirectT (ServerPartT IO) Response
-> ClckT RedirectURL (ServerPartT IO) Response
forall a b. (a -> b) -> a -> b
$ RedirectURL -> RedirectT (ServerPartT IO) Response
routeRedirect RedirectURL
u
    where
      flattenURL ::   ((url' -> [(Text, Maybe Text)] -> Text) -> (RedirectURL -> [(Text, Maybe Text)] -> Text))
      flattenURL :: (url' -> [(Text, Maybe Text)] -> Text)
-> RedirectURL -> [(Text, Maybe Text)] -> Text
flattenURL url' -> [(Text, Maybe Text)] -> Text
_ RedirectURL
u [(Text, Maybe Text)]
p = RedirectURL -> [(Text, Maybe Text)] -> Text
showRedirectURL RedirectURL
u [(Text, Maybe Text)]
p

redirectInit :: ClckPlugins
         -> IO (Maybe Text)
redirectInit :: ClckPlugins -> IO (Maybe Text)
redirectInit ClckPlugins
plugins =
    do (Just RedirectURL -> [(Text, Maybe Text)] -> Text
redirectShowFn) <- ClckPlugins
-> Text -> IO (Maybe (RedirectURL -> [(Text, Maybe Text)] -> Text))
forall (m :: * -> *) url theme n hook config st.
(MonadIO m, Typeable url) =>
Plugins theme n hook config st
-> Text -> m (Maybe (url -> [(Text, Maybe Text)] -> Text))
getPluginRouteFn ClckPlugins
plugins (Plugin
  RedirectURL
  Theme
  (ClckT ClckURL (ServerPartT IO) Response)
  (ClckT ClckURL IO ())
  ClckwrksConfig
  ClckPluginsSt
-> Text
forall url theme n hook config st.
Plugin url theme n hook config st -> Text
pluginName Plugin
  RedirectURL
  Theme
  (ClckT ClckURL (ServerPartT IO) Response)
  (ClckT ClckURL IO ())
  ClckwrksConfig
  ClckPluginsSt
redirectPlugin)
       (Just ClckURL -> [(Text, Maybe Text)] -> Text
clckShowFn)     <- ClckPlugins
-> Text -> IO (Maybe (ClckURL -> [(Text, Maybe Text)] -> Text))
forall (m :: * -> *) url theme n hook config st.
(MonadIO m, Typeable url) =>
Plugins theme n hook config st
-> Text -> m (Maybe (url -> [(Text, Maybe Text)] -> Text))
getPluginRouteFn ClckPlugins
plugins (Plugin
  ClckURL
  Theme
  (ClckT ClckURL (ServerPartT IO) Response)
  (ClckT ClckURL IO ())
  ClckwrksConfig
  ClckPluginsSt
-> Text
forall url theme n hook config st.
Plugin url theme n hook config st -> Text
pluginName Plugin
  ClckURL
  Theme
  (ClckT ClckURL (ServerPartT IO) Response)
  (ClckT ClckURL IO ())
  ClckwrksConfig
  ClckPluginsSt
clckPlugin)
       Maybe String
mTopDir <- ClckwrksConfig -> Maybe String
clckTopDir (ClckwrksConfig -> Maybe String)
-> IO ClckwrksConfig -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClckPlugins -> IO ClckwrksConfig
forall (m :: * -> *) theme n hook config st.
MonadIO m =>
Plugins theme n hook config st -> m config
getConfig ClckPlugins
plugins
       let basePath :: String
basePath = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"_state" (\String
td -> String
td String -> String -> String
</> String
"_state") Maybe String
mTopDir -- FIXME
           redirectDir :: String
redirectDir  = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"_redirect" (\String
td -> String
td String -> String -> String
</> String
"_redirect") Maybe String
mTopDir

       RedirectState
irs  <- IO RedirectState
initialRedirectState
       AcidState RedirectState
acid <- String -> RedirectState -> IO (AcidState RedirectState)
forall st.
(IsAcidic st, SafeCopy st) =>
String -> st -> IO (AcidState st)
openLocalStateFrom (String
basePath String -> String -> String
</> String
"redirect") RedirectState
irs
       ClckPlugins -> When -> IO () -> IO ()
forall (m :: * -> *) theme n hook config st.
MonadIO m =>
Plugins theme n hook config st -> When -> IO () -> m ()
addCleanup ClckPlugins
plugins When
Always (AcidState RedirectState -> IO ()
forall st. (IsAcidic st, Typeable st) => AcidState st -> IO ()
createCheckpointAndClose AcidState RedirectState
acid)

       let redirectConfig :: RedirectConfig
redirectConfig = RedirectConfig :: AcidState RedirectState
-> (ClckURL -> [(Text, Maybe Text)] -> Text) -> RedirectConfig
RedirectConfig { redirectState :: AcidState RedirectState
redirectState     = AcidState RedirectState
acid
                                           , redirectClckURL :: ClckURL -> [(Text, Maybe Text)] -> Text
redirectClckURL   = ClckURL -> [(Text, Maybe Text)] -> Text
clckShowFn
                                           }

--       addPreProc plugins (redirectCmd acid redirectShowFn)
--       addNavBarCallback plugins (navBarCallback acid redirectShowFn)
       ClckPlugins
-> Text
-> (ClckPlugins
    -> [Text] -> ClckT ClckURL (ServerPartT IO) Response)
-> IO ()
forall (m :: * -> *) theme n hook config st.
MonadIO m =>
Plugins theme n hook config st
-> Text -> (Plugins theme n hook config st -> [Text] -> n) -> m ()
addHandler ClckPlugins
plugins (Plugin
  RedirectURL
  Theme
  (ClckT ClckURL (ServerPartT IO) Response)
  (ClckT ClckURL IO ())
  ClckwrksConfig
  ClckPluginsSt
-> Text
forall url theme n hook config st.
Plugin url theme n hook config st -> Text
pluginName Plugin
  RedirectURL
  Theme
  (ClckT ClckURL (ServerPartT IO) Response)
  (ClckT ClckURL IO ())
  ClckwrksConfig
  ClckPluginsSt
redirectPlugin) ((RedirectURL -> [(Text, Maybe Text)] -> Text)
-> RedirectConfig
-> ClckPlugins
-> [Text]
-> ClckT ClckURL (ServerPartT IO) Response
redirectHandler RedirectURL -> [(Text, Maybe Text)] -> Text
redirectShowFn RedirectConfig
redirectConfig)
--       addPostHook plugins (migrateUACCT acid)

       Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing

addRedirectAdminMenu :: ClckT url IO ()
addRedirectAdminMenu :: ClckT url IO ()
addRedirectAdminMenu =
    do ClckPlugins
p <- ClckState -> ClckPlugins
plugins (ClckState -> ClckPlugins)
-> ClckT url IO ClckState -> ClckT url IO ClckPlugins
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClckT url IO ClckState
forall s (m :: * -> *). MonadState s m => m s
get
       -- (Just redirectShowURL) <- getPluginRouteFn p (pluginName redirectPlugin)
       (Text, [(Set Role, Text, Text)]) -> ClckT url IO ()
forall (m :: * -> *) url.
Monad m =>
(Text, [(Set Role, Text, Text)]) -> ClckT url m ()
addAdminMenu ( Text
"Redirect/Rewrites"
                    , [ ([Role] -> Set Role
forall a. Ord a => [a] -> Set a
Set.fromList [Role
Administrator, Role
Editor], Text
"Redirects", Text
"")
                      ]
                    )
       () -> ClckT url IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
{-
       let newRedirectURL    = pageShowURL (PageAdmin NewPage) []
           pagesURL      = pageShowURL (PageAdmin Pages) []
           feedConfigURL = pageShowURL (PageAdmin EditFeedConfig) []
       addAdminMenu ("Pages/Posts"
                    , [ (Set.fromList [Administrator, Editor], "New Page/Post"   , newRedirectURL)
                      , (Set.fromList [Administrator, Editor], "Edit Page/Post"  , pagesURL)
                      , (Set.fromList [Administrator, Editor], "Edit Feed Config", feedConfigURL)
                      ]
                    )
-}
redirectPlugin :: Plugin RedirectURL Theme (ClckT ClckURL (ServerPartT IO) Response) (ClckT ClckURL IO ()) ClckwrksConfig ClckPluginsSt
redirectPlugin :: Plugin
  RedirectURL
  Theme
  (ClckT ClckURL (ServerPartT IO) Response)
  (ClckT ClckURL IO ())
  ClckwrksConfig
  ClckPluginsSt
redirectPlugin = Plugin :: forall url theme n hook config st.
Text
-> (Plugins theme n hook config st -> IO (Maybe Text))
-> [Text]
-> (url -> [Text])
-> hook
-> Plugin url theme n hook config st
Plugin
    { pluginName :: Text
pluginName           = Text
"redirect"
    , pluginInit :: ClckPlugins -> IO (Maybe Text)
pluginInit           = ClckPlugins -> IO (Maybe Text)
redirectInit
    , pluginDepends :: [Text]
pluginDepends        = [Text
"clck"]
    , pluginToPathSegments :: RedirectURL -> [Text]
pluginToPathSegments = RedirectURL -> [Text]
forall url. PathInfo url => url -> [Text]
toPathSegments
    , pluginPostHook :: ClckT ClckURL IO ()
pluginPostHook       = ClckT ClckURL IO ()
forall url. ClckT url IO ()
addRedirectAdminMenu
    }

plugin :: ClckPlugins -- ^ plugins
       -> Text        -- ^ baseURI
       -> IO (Maybe Text)
plugin :: ClckPlugins -> Text -> IO (Maybe Text)
plugin ClckPlugins
plugins Text
baseURI =
    ClckPlugins
-> Text
-> Plugin
     RedirectURL
     Theme
     (ClckT ClckURL (ServerPartT IO) Response)
     (ClckT ClckURL IO ())
     ClckwrksConfig
     ClckPluginsSt
-> IO (Maybe Text)
forall url theme n hook config st.
Typeable url =>
Plugins theme n hook config st
-> Text -> Plugin url theme n hook config st -> IO (Maybe Text)
initPlugin ClckPlugins
plugins Text
baseURI Plugin
  RedirectURL
  Theme
  (ClckT ClckURL (ServerPartT IO) Response)
  (ClckT ClckURL IO ())
  ClckwrksConfig
  ClckPluginsSt
redirectPlugin

-- | initialize the redirect plugin
--
-- we can not use the standard `initPlugin` function for the redirect plugin because we want to intercept URLs higher up the chain.
initRedirectPlugin ::
              Plugins Theme (ClckT ClckURL (ServerPartT IO) Response) (ClckT ClckURL IO ()) ClckwrksConfig ClckPluginsSt    -- ^ 'Plugins' handle
           -> Text                              -- ^ base URI to prepend to generated URLs
           -> IO (Maybe Text)                   -- ^ possible error message
initRedirectPlugin :: ClckPlugins -> Text -> IO (Maybe Text)
initRedirectPlugin ClckPlugins
plugins Text
baseURI =
    do -- putStrLn $ "initializing " ++ (Text.unpack pluginName)
       let (Plugin{[Text]
Text
ClckT ClckURL IO ()
ClckPlugins -> IO (Maybe Text)
RedirectURL -> [Text]
pluginPostHook :: ClckT ClckURL IO ()
pluginToPathSegments :: RedirectURL -> [Text]
pluginDepends :: [Text]
pluginInit :: ClckPlugins -> IO (Maybe Text)
pluginName :: Text
pluginPostHook :: forall url theme n hook config st.
Plugin url theme n hook config st -> hook
pluginToPathSegments :: forall url theme n hook config st.
Plugin url theme n hook config st -> url -> [Text]
pluginDepends :: forall url theme n hook config st.
Plugin url theme n hook config st -> [Text]
pluginInit :: forall url theme n hook config st.
Plugin url theme n hook config st
-> Plugins theme n hook config st -> IO (Maybe Text)
pluginName :: forall url theme n hook config st.
Plugin url theme n hook config st -> Text
..}) = Plugin
  RedirectURL
  Theme
  (ClckT ClckURL (ServerPartT IO) Response)
  (ClckT ClckURL IO ())
  ClckwrksConfig
  ClckPluginsSt
redirectPlugin
       ClckPlugins -> Text -> Text -> (RedirectURL -> [Text]) -> IO ()
forall (m :: * -> *) url theme n hook config st.
(MonadIO m, Typeable url) =>
Plugins theme n hook config st
-> Text -> Text -> (url -> [Text]) -> m ()
addPluginRouteFn ClckPlugins
plugins Text
pluginName Text
baseURI RedirectURL -> [Text]
pluginToPathSegments -- (\u p ->  {- <> "/" <> {- pluginToPathInfo u <> -} paramsToQueryString (map (\(k, v) -> (k, fromMaybe mempty v)) p)-})
       ClckPlugins -> ClckT ClckURL IO () -> IO ()
forall (m :: * -> *) theme n hook config st.
MonadIO m =>
Plugins theme n hook config st -> hook -> m ()
addPostHook ClckPlugins
plugins ClckT ClckURL IO ()
pluginPostHook
       ClckPlugins -> IO (Maybe Text)
pluginInit ClckPlugins
plugins

paramsToQueryString :: [(Text, Text)] -> Text
paramsToQueryString :: [(Text, Text)] -> Text
paramsToQueryString [] = Text
forall a. Monoid a => a
mempty
paramsToQueryString [(Text, Text)]
ps = Builder -> Text
toStrictText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ Builder
"?" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
"&" (((Text, Text) -> Builder) -> [(Text, Text)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Builder
paramToQueryString [(Text, Text)]
ps) )
    where
      toStrictText :: Builder -> Text
toStrictText = Text -> Text
toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
toLazyText

      isAlphaChar :: Char -> Bool
      isAlphaChar :: Char -> Bool
isAlphaChar Char
c    = (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z') Bool -> Bool -> Bool
|| (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z')

      isDigitChar :: Char -> Bool
      isDigitChar :: Char -> Bool
isDigitChar Char
c    = (Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'9')

      isOk :: Char -> Bool
      isOk :: Char -> Bool
isOk Char
c = Char -> Bool
isAlphaChar Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigitChar Char
c Bool -> Bool -> Bool
|| Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Char
c (String
":@$-_.~" :: String)

      escapeChar :: Char -> Builder
escapeChar Char
c
          | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' '  = Char -> Builder
singleton Char
'+'
          | Char -> Bool
isOk Char
c    = Char -> Builder
singleton Char
c
          | Bool
otherwise = Builder
"%" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
                        let hexDigit :: a -> Char
hexDigit a
n
                                | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
9 = String -> Char
forall a. [a] -> a
head (a -> String
forall a. Show a => a -> String
show a
n)
                                | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
10 = Char
'A'
                                | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
11 = Char
'B'
                                | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
12 = Char
'C'
                                | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
13 = Char
'D'
                                | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
14 = Char
'E'
                                | a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
15 = Char
'F'
                        in case Int -> (Int -> Char) -> Int -> String -> String
forall a.
(Integral a, Show a) =>
a -> (Int -> Char) -> a -> String -> String
showIntAtBase Int
16 Int -> Char
forall a. (Ord a, Num a, Show a) => a -> Char
hexDigit (Char -> Int
ord Char
c) String
"" of
                             []  -> Builder
"00"
                             [Char
x] -> String -> Builder
forall a. IsString a => String -> a
fromString [Char
'0',Char
x]
                             String
cs  -> String -> Builder
forall a. IsString a => String -> a
fromString String
cs

      escapeParam :: Text -> Builder
      escapeParam :: Text -> Builder
escapeParam Text
p = (Char -> Builder -> Builder) -> Builder -> Text -> Builder
forall a. (Char -> a -> a) -> a -> Text -> a
Text.foldr (\Char
c Builder
cs -> Char -> Builder
escapeChar Char
c Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
cs) Builder
forall a. Monoid a => a
mempty Text
p

      paramToQueryString :: (Text, Text) -> Builder
      paramToQueryString :: (Text, Text) -> Builder
paramToQueryString (Text
k,Text
v) = (Text -> Builder
escapeParam Text
k) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"=" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Text -> Builder
escapeParam Text
v)