{-# 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 :: Form -> String
renderQueryString = [(String, String)] -> String
renderQueryString' ([(String, String)] -> String)
-> (Form -> [(String, String)]) -> Form -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Form -> [(String, String)]
renderQuery'
-- | Serialize a key-value multi-map to a URI query string.
renderQueryString' :: [(String, String)] -> String
renderQueryString' :: [(String, String)] -> String
renderQueryString' [(String, String)]
query = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"&" [
    String -> String
escape String
key String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
'='Char -> String -> String
forall a. a -> [a] -> [a]
:String -> String
escape String
val | (String
key, String
val) <- [(String, String)]
query
  ]

-- | Serialize a form to a key-value multi-map.
renderQuery' :: Form -> [(String, String)]
renderQuery' :: Form -> [(String, String)]
renderQuery' Form
form = (Input -> [(String, String)]) -> [Input] -> [(String, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Input -> [(String, String)]
renderInput' ([Input] -> [(String, String)]) -> [Input] -> [(String, String)]
forall a b. (a -> b) -> a -> b
$ Form -> [Input]
inputs Form
form
-- | Serialize an input to a key-value multi-map.
renderInput' :: Input -> [(String, String)]
renderInput' :: Input -> [(String, String)]
renderInput' Input { inputType :: Input -> Text
inputType = Text
inputType' }
    | Text
inputType' Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"submit", Text
"reset", Text
"button", Text
"file"] = []
renderInput' Input { checked :: Input -> Bool
checked = Bool
False, inputType :: Input -> Text
inputType = Text
inputType' }
    | Text
inputType' Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text
"radio", Text
"checkbox"] = []
renderInput' Input { inputType :: Input -> Text
inputType = Text
"<select>",
        inputName :: Input -> Text
inputName = Text
k, value :: Input -> Text
value = Text
"", list :: Input -> [OptionGroup]
list = [OptionGroup]
opts, multiple :: Input -> Bool
multiple = Bool
False
    } | Text
val:[Text]
_ <- [Option -> Text
optValue Option
opt | OptionGroup
grp <- [OptionGroup]
opts, Option
opt <- OptionGroup -> [Option]
subopts OptionGroup
grp, Option -> Bool
optSelected Option
opt]
        = [(Text -> String
unpack Text
k, Text -> String
unpack Text
val)]
      | Bool
otherwise = []
renderInput' Input { inputType :: Input -> Text
inputType = Text
"<select>",
        inputName :: Input -> Text
inputName = Text
k, list :: Input -> [OptionGroup]
list = [OptionGroup]
opts, multiple :: Input -> Bool
multiple = Bool
True
    } = [(Text -> String
unpack Text
k, Text -> String
unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Option -> Text
optValue Option
opt) |
            OptionGroup
grp <- [OptionGroup]
opts, Option
opt <- OptionGroup -> [Option]
subopts OptionGroup
grp, Option -> Bool
optSelected Option
opt]
renderInput' Input { inputName :: Input -> Text
inputName = Text
k, value :: Input -> Text
value = Text
v } = [(Text -> String
unpack Text
k, Text -> String
unpack Text
v)]

-- | escape a URI string.
escape :: String -> String
escape :: String -> String
escape = (Char -> Bool) -> String -> String
escapeURIString Char -> Bool
isUnescapedInURIComponent

-- | Adjust an input to store the appropriate values encoded in a key-value multi-map.
applyQuery :: Input -> [(String, String)] -> Input
applyQuery :: Input -> [(String, String)] -> Input
applyQuery input :: Input
input@Input { inputName :: Input -> Text
inputName = Text
n } [(String, String)]
qs
    | Input -> Text
inputType Input
input Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text
"submit", Text
"reset", Text
"button", Text
"checkbox", Text
"radio"],
        Just String
val' <- Text -> String
unpack Text
n String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(String, String)]
qs = Input
input { value = Txt.pack val' }
    | Bool
otherwise = Input
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 -> [(String, String)] -> Form
applyQuery' Form
form [(String, String)]
qs = Form
form { inputs = flip applyQuery qs `map` inputs form }