~alcinnz/bureaucromancy

ref: a3d5ae5407b47e008d51490223faa19649bfd90f bureaucromancy/src/Text/HTML/Form/WebApp.hs -rw-r--r-- 1.4 KiB
a3d5ae54 — Adrian Cochrane Add support for checkboxes, along with supporting infrastructure. 1 year, 4 months 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
{-# LANGUAGE OverloadedStrings #-}
module Text.HTML.Form.WebApp (renderPage, Form(..)) where

import Data.ByteString as BS
import Data.Text as Txt
import Data.Text.Encoding as Txt
import Text.Read (readMaybe)

import Text.HTML.Form (Form(..), Input(..))
import Text.HTML.Form.WebApp.Ginger (template)
import Text.HTML.Form.Query (renderQueryString)

renderPage :: Form -> [Text] -> [(ByteString, Maybe ByteString)] -> IO (Maybe Text)
renderPage form (n:path) query
    | Just ix <- readMaybe $ Txt.unpack n, ix < Prelude.length (inputs form) =
        renderInput form (inputs form !! ix) path query
renderPage form [] _ = return $ Just $ Txt.concat [
    "<a href='/0?", Txt.pack $ renderQueryString form, "'>Start!</a>"]
renderPage _ _ _ = return Nothing

renderInput :: Form -> Input -> [Text] -> [(ByteString, Maybe ByteString)] ->
    IO (Maybe Text)
renderInput form input@Input {inputType = "checkbox", inputName = k', value = v'}
        [] qs
    | (utf8 k', Just $ utf8 v') `Prelude.elem` qs =
        template "checkbox.html" form input qs [
            q | q@(k, v) <- qs, k /= utf8 k', v /= Just (utf8 v')]
    | v' == "", (utf8 k', Nothing) `Prelude.elem` qs =
        template "checkbox.html" form input qs [
            q | q@(k, v) <- qs, k /= utf8 k', v /= Nothing]
    | otherwise =
        template "checkbox.html" form input qs ((utf8 k', Just $ utf8 v'):qs)
renderInput _ _ _ _ = return Nothing

utf8 :: Text -> ByteString
utf8 = Txt.encodeUtf8