module Network.URI.Utils (
    addQueryParams,
    param,
) where

import Data.ByteString (ByteString)
import qualified Data.Text as Text
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Network.HTTP.Types (Query, QueryItem, parseQuery, renderQuery)
import Network.URI (URI, uriQuery)

addQueryParams :: URI -> Query -> URI
addQueryParams :: URI -> Query -> URI
addQueryParams URI
uri Query
extraQuery = URI
uri{uriQuery :: String
uriQuery = String
newQuery}
  where
    newQuery :: String
newQuery = Text -> String
Text.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Bool -> Query -> ByteString
renderQuery Bool
True Query
fullQuery
    fullQuery :: Query
fullQuery = Query
extraQuery Query -> Query -> Query
forall a. Semigroup a => a -> a -> a
<> Query
oldQuery
    oldQuery :: Query
oldQuery = (ByteString -> Query
parseQuery (ByteString -> Query) -> (URI -> ByteString) -> URI -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 (Text -> ByteString) -> (URI -> Text) -> URI -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> Text) -> (URI -> String) -> URI -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> String
uriQuery) URI
uri

param :: ByteString -> (a -> ByteString) -> a -> QueryItem
param :: ByteString -> (a -> ByteString) -> a -> QueryItem
param ByteString
label a -> ByteString
f a
x = (ByteString
label, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (a -> ByteString
f a
x))