~alcinnz/bureaucromancy

ref: 680706daf93b5e0ac346df89fe691735bf12b18e bureaucromancy/src/Text/HTML/Form/Query.hs -rw-r--r-- 1.5 KiB
680706da — Adrian Cochrane Add week & color input support! 1 year, 1 month ago
                                                                                
b77ee394 Adrian Cochrane
703b3073 Adrian Cochrane
b77ee394 Adrian Cochrane
703b3073 Adrian Cochrane
b77ee394 Adrian Cochrane
703b3073 Adrian Cochrane
b77ee394 Adrian Cochrane
703b3073 Adrian Cochrane
b77ee394 Adrian Cochrane
b7acdbaa Adrian Cochrane
9014ee29 Adrian Cochrane
b77ee394 Adrian Cochrane
703b3073 Adrian Cochrane
b77ee394 Adrian Cochrane
703b3073 Adrian Cochrane
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
{-# LANGUAGE OverloadedStrings #-}
module Text.HTML.Form.Query(
    renderQueryString, renderQueryString', renderQuery') where

import Text.HTML.Form (Form(..), Input(..), OptionGroup(..), Option(..))
import Network.URI (escapeURIString, isUnescapedInURIComponent)
import Data.List (intercalate)
import Data.Text (unpack)

renderQueryString :: Form -> String
renderQueryString = renderQueryString' . renderQuery'
renderQueryString' :: [(String, String)] -> String
renderQueryString' query = intercalate "&" [
    escape key ++ '=':escape val | (key, val) <- query
  ]

renderQuery' :: Form -> [(String, String)]
renderQuery' form = concatMap renderInput' $ inputs form
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 = "<select>",
        inputName = k, value = "", list = opts, multiple = False
    } | val:_ <- [optValue opt | grp <- opts, opt <- subopts grp, optSelected opt]
        = [(unpack k, unpack val)]
      | otherwise = []
renderInput' Input { inputType = "<select>",
        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 :: String -> String
escape = escapeURIString isUnescapedInURIComponent