{-# LANGUAGE OverloadedStrings #-} -- | Convert query data between parsed form data, multi-maps, & URI query strings. module Text.HTML.Form.Query(renderQueryString, renderQueryString', renderQuery', applyQuery, applyQuery') where import Text.HTML.Form (Form(..), Input(..), OptionGroup(..), Option(..)) import Network.URI (escapeURIString, isUnescapedInURIComponent) import Data.List (intercalate) import Data.Text (unpack) import qualified Data.Text as Txt -- | Serialize a form to a URI query string. renderQueryString :: Form -> String renderQueryString = renderQueryString' . renderQuery' -- | Serialize a key-value multi-map to a URI query string. renderQueryString' :: [(String, String)] -> String renderQueryString' query = intercalate "&" [ escape key ++ '=':escape val | (key, val) <- query ] -- | Serialize a form to a key-value multi-map. renderQuery' :: Form -> [(String, String)] renderQuery' form = concatMap renderInput' $ inputs form -- | Serialize an input to a key-value multi-map. renderInput' :: Input -> [(String, String)] renderInput' Input { inputType = inputType' } | inputType' `elem` ["submit", "reset", "button", "file"] = [] renderInput' Input { checked = False, inputType = inputType' } | inputType' `elem` ["radio", "checkbox"] = [] renderInput' Input { inputType = "", inputName = k, list = opts, multiple = True } = [(unpack k, unpack $ optValue opt) | grp <- opts, opt <- subopts grp, optSelected opt] renderInput' Input { inputName = k, value = v } = [(unpack k, unpack v)] -- | escape a URI string. escape :: String -> String escape = escapeURIString isUnescapedInURIComponent -- | Adjust an input to store the appropriate values encoded in a key-value multi-map. applyQuery :: Input -> [(String, String)] -> Input applyQuery input@Input { inputName = n } qs | inputType input `notElem` ["submit", "reset", "button", "checkbox", "radio"], Just val' <- unpack n `lookup` qs = input { value = Txt.pack val' } | otherwise = input -- | Adjust all inputs in a form to store the values encoded in a key-value multi-map. applyQuery' :: Form -> [(String, String)] -> Form applyQuery' form qs = form { inputs = flip applyQuery qs `map` inputs form }