~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, 30 days ago
                                                                                
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 }