module Uri where
import FFI
import Prelude
data Uri
currentUri :: Fay String
currentUri = ffi "window['location']['href']"
newUri :: String -> Uri
newUri = ffi "new window['Uri'](%1)"
toString :: Uri -> String
toString = ffi "%1['toString']()"
clone :: Uri -> Uri
clone = ffi "%1['clone']()"
protocol :: Uri -> Nullable String
protocol = ffi "%1['protocol']()"
userInfo :: Uri -> Nullable String
userInfo = ffi "%1['userInfo']()"
host :: Uri -> Nullable String
host = ffi "%1['host']()"
port :: Uri -> Nullable String
port = ffi "%1['port']()"
path :: Uri -> Nullable String
path = ffi "%1['path']()"
query :: Uri -> Nullable String
query = ffi "%1['query']()"
anchor :: Uri -> Nullable String
anchor = ffi "%1['anchor']()"
queryParamValue :: String -> Uri -> String
queryParamValue = ffi "%2['getQueryParamValue'](%1)"
queryParamValues :: String -> Uri -> [String]
queryParamValues = ffi "%2['getQueryParamValues'](%1)"
withProtocol :: String -> Uri -> Uri
withProtocol = ffi "%2['clone']()['setProtocol'](%1)"
withUserInfo :: String -> Uri -> Uri
withUserInfo = ffi "%2['clone']()['setUserInfo'](%1)"
withHost :: String -> Uri -> Uri
withHost = ffi "%2['clone']()['setHost'](%1)"
withPort :: String -> Uri -> Uri
withPort = ffi "%2['clone']()['setPort'](%1)"
withPath :: String -> Uri -> Uri
withPath = ffi "%2['clone']()['setPath'](%1)"
withQuery :: String -> Uri -> Uri
withQuery = ffi "%2['clone']()['setQuery'](%1)"
withAnchor :: String -> Uri -> Uri
withAnchor = ffi "%2['clone']()['setAnchor'](%1)"
removeProtocol :: Uri -> Uri
removeProtocol = ffi "%1['clone']()['setProtocol'](null)"
removeUserInfo :: Uri -> Uri
removeUserInfo = ffi "%1['clone']()['setUserInfo'](null)"
removeHost :: Uri -> Uri
removeHost = ffi "%1['clone']()['setHost'](null)"
removePort :: Uri -> Uri
removePort = ffi "%1['clone']()['setPort'](null)"
removePath :: Uri -> Uri
removePath = ffi "%1['clone']()['setPath'](null)"
removeQuery :: Uri -> Uri
removeQuery = ffi "%1['clone']()['setQuery'](null)"
removeAnchor :: Uri -> Uri
removeAnchor = ffi "%1['clone']()['setAnchor'](null)"
addQueryParam :: String -> String -> Uri -> Uri
addQueryParam = ffi "%3['clone']()['addQueryParam'](%1,%2)"
replaceQueryParam :: String -> String -> Uri -> Uri
replaceQueryParam = ffi "%3['clone']()['replaceQueryParam'](%1,%2)"
replaceQueryParamValue :: String -> String -> String -> Uri -> Uri
replaceQueryParamValue = ffi "%4['clone']()['replaceQueryParam'](%1, %3, %2)"
deleteQueryParam :: String -> Uri -> Uri
deleteQueryParam = ffi "%2['clone']()['deleteQueryParam'](%1)"
deleteQueryParamValue :: String -> String -> Uri -> Uri
deleteQueryParamValue = ffi "%3['clone']()['deleteQueryParam'](%1,%2)"