~alcinnz/bureaucromancy

ref: d6349351d838372d9199a690c5997382d13269c7 bureaucromancy/src/Text/HTML/Form/Query.hs -rw-r--r-- 2.0 KiB
d6349351 — Adrian Cochrane Validate form before submitting, ensure submit & reset buttons are present! 1 year, 1 month ago
                                                                                
b77ee394 Adrian Cochrane
d6349351 Adrian Cochrane
703b3073 Adrian Cochrane
b77ee394 Adrian Cochrane
703b3073 Adrian Cochrane
b48eccb1 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
b48eccb1 Adrian Cochrane
d6349351 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
37
38
39
40
41
42
43
44
45
{-# LANGUAGE OverloadedStrings #-}
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

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

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
applyQuery' :: Form -> [(String, String)] -> Form
applyQuery' form qs = form { inputs = flip applyQuery qs `map` inputs form }