~alcinnz/bureaucromancy

ref: 1030d237866bf99999711515fa46dd9fdf729324 bureaucromancy/src/Text/HTML/Form/Query.hs -rw-r--r-- 2.4 KiB
1030d237 — Adrian Cochrane Internationalize form validation. 11 months ago
                                                                                
b77ee394 Adrian Cochrane
696da319 Adrian Cochrane
d6349351 Adrian Cochrane
703b3073 Adrian Cochrane
b77ee394 Adrian Cochrane
703b3073 Adrian Cochrane
b48eccb1 Adrian Cochrane
703b3073 Adrian Cochrane
696da319 Adrian Cochrane
703b3073 Adrian Cochrane
696da319 Adrian Cochrane
b77ee394 Adrian Cochrane
703b3073 Adrian Cochrane
b77ee394 Adrian Cochrane
703b3073 Adrian Cochrane
696da319 Adrian Cochrane
703b3073 Adrian Cochrane
b77ee394 Adrian Cochrane
696da319 Adrian Cochrane
b77ee394 Adrian Cochrane
b7acdbaa Adrian Cochrane
9014ee29 Adrian Cochrane
b77ee394 Adrian Cochrane
703b3073 Adrian Cochrane
696da319 Adrian Cochrane
b77ee394 Adrian Cochrane
703b3073 Adrian Cochrane
b48eccb1 Adrian Cochrane
696da319 Adrian Cochrane
b48eccb1 Adrian Cochrane
696da319 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
46
47
48
49
50
51
52
53
{-# 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 = "<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 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 }