{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, TypeFamilies #-}
module Text.Reform.Blaze.Common where

import Data.Monoid (mconcat, mempty, (<>))
import Data.Text.Lazy (Text)
import Text.Reform.Backend
import Text.Reform.Core
import Text.Reform.Generalized as G
import Text.Reform.Result (FormId, Result(Ok), unitRange)
import Text.Blaze.Html (Html, (!), toValue)
import qualified Text.Blaze.Html5  as H
import Text.Blaze.Html5.Attributes (type_, name, value)
import qualified Text.Blaze.Html5.Attributes as A

instance H.ToValue FormId where
    toValue :: FormId -> AttributeValue
toValue FormId
fid = String -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue (FormId -> String
forall a. Show a => a -> String
show FormId
fid)

inputText :: (Monad m, FormError error, H.ToValue text) =>
             (input -> Either error text)
          -> text
          -> Form m input error Html () text
inputText :: (input -> Either error text)
-> text -> Form m input error Html () text
inputText input -> Either error text
getInput text
initialValue = (input -> Either error text)
-> (FormId -> text -> Html)
-> text
-> Form m input error Html () text
forall (m :: * -> *) error input a view.
(Monad m, FormError error) =>
(input -> Either error a)
-> (FormId -> a -> view) -> a -> Form m input error view () a
G.input input -> Either error text
getInput FormId -> text -> Html
forall a a. (ToValue a, ToValue a) => a -> a -> Html
inputField text
initialValue
    where
      inputField :: a -> a -> Html
inputField a
i a
a = Html
H.input Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"text" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
i) Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
name (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
i) Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
value (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
a)

inputPassword :: (Monad m, FormError error, H.ToValue text) =>
             (input -> Either error text)
          -> text
          -> Form m input error Html () text
inputPassword :: (input -> Either error text)
-> text -> Form m input error Html () text
inputPassword input -> Either error text
getInput text
initialValue = (input -> Either error text)
-> (FormId -> text -> Html)
-> text
-> Form m input error Html () text
forall (m :: * -> *) error input a view.
(Monad m, FormError error) =>
(input -> Either error a)
-> (FormId -> a -> view) -> a -> Form m input error view () a
G.input input -> Either error text
getInput FormId -> text -> Html
forall a a. (ToValue a, ToValue a) => a -> a -> Html
inputField text
initialValue
    where
      inputField :: a -> a -> Html
inputField a
i a
a = Html
H.input Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"password" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
i) Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
name (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
i) Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
value (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
a)

inputSubmit :: (Monad m, FormError error, H.ToValue text) =>
             (input -> Either error text)
          -> text
          -> Form m input error Html () (Maybe text)
inputSubmit :: (input -> Either error text)
-> text -> Form m input error Html () (Maybe text)
inputSubmit input -> Either error text
getInput text
initialValue = (input -> Either error text)
-> (FormId -> text -> Html)
-> text
-> Form m input error Html () (Maybe text)
forall (m :: * -> *) error input a view.
(Monad m, FormError error) =>
(input -> Either error a)
-> (FormId -> a -> view)
-> a
-> Form m input error view () (Maybe a)
G.inputMaybe input -> Either error text
getInput FormId -> text -> Html
forall a a. (ToValue a, ToValue a) => a -> a -> Html
inputField text
initialValue
    where
      inputField :: a -> a -> Html
inputField a
i a
a = Html
H.input Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"submit" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
i) Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
name (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
i) Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
value (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
a)

inputReset :: (Monad m, FormError error, H.ToValue text) =>
              text
           -> Form m input error Html () ()
inputReset :: text -> Form m input error Html () ()
inputReset text
lbl = (FormId -> text -> Html) -> text -> Form m input error Html () ()
forall (m :: * -> *) a view input error.
Monad m =>
(FormId -> a -> view) -> a -> Form m input error view () ()
G.inputNoData FormId -> text -> Html
forall a a. (ToValue a, ToValue a) => a -> a -> Html
inputField text
lbl
    where
      inputField :: a -> a -> Html
inputField a
i a
a = Html
H.input Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"submit" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
i) Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
name (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
i) Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
value (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
a)

inputHidden :: (Monad m, FormError error, H.ToValue text) =>
             (input -> Either error text)
          -> text
          -> Form m input error Html () text
inputHidden :: (input -> Either error text)
-> text -> Form m input error Html () text
inputHidden input -> Either error text
getInput text
initialValue = (input -> Either error text)
-> (FormId -> text -> Html)
-> text
-> Form m input error Html () text
forall (m :: * -> *) error input a view.
(Monad m, FormError error) =>
(input -> Either error a)
-> (FormId -> a -> view) -> a -> Form m input error view () a
G.input input -> Either error text
getInput FormId -> text -> Html
forall a a. (ToValue a, ToValue a) => a -> a -> Html
inputField text
initialValue
    where
      inputField :: a -> a -> Html
inputField a
i a
a = Html
H.input Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"hidden" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
i) Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
name (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
i) Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
value (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
a)

inputButton :: (Monad m, FormError error, H.ToValue text) =>
             text
          -> Form m input error Html () ()
inputButton :: text -> Form m input error Html () ()
inputButton text
label = (FormId -> text -> Html) -> text -> Form m input error Html () ()
forall (m :: * -> *) a view input error.
Monad m =>
(FormId -> a -> view) -> a -> Form m input error view () ()
G.inputNoData FormId -> text -> Html
forall a a. (ToValue a, ToValue a) => a -> a -> Html
inputField text
label
    where
      inputField :: a -> a -> Html
inputField a
i a
a = Html
H.input Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"button" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
i) Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
name (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
i) Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
value (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
a)


textarea :: (Monad m, FormError error, H.ToMarkup text) =>
            (input -> Either error text)
         -> Int    -- ^ cols
         -> Int    -- ^ rows
         -> text   -- ^ initial text
         -> Form m input error Html () text
textarea :: (input -> Either error text)
-> Int -> Int -> text -> Form m input error Html () text
textarea input -> Either error text
getInput Int
cols Int
rows text
initialValue = (input -> Either error text)
-> (FormId -> text -> Html)
-> text
-> Form m input error Html () text
forall (m :: * -> *) error input a view.
(Monad m, FormError error) =>
(input -> Either error a)
-> (FormId -> a -> view) -> a -> Form m input error view () a
G.input input -> Either error text
getInput FormId -> text -> Html
textareaView text
initialValue
    where
      textareaView :: FormId -> text -> Html
textareaView FormId
i text
txt =
          Html -> Html
H.textarea (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.rows (Int -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue Int
rows)
                     (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.cols (Int -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue Int
cols)
                     (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id   (FormId -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue FormId
i)
                     (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.name (FormId -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue FormId
i) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
               text -> Html
forall a. ToMarkup a => a -> Html
H.toHtml text
txt


-- | Create an @\<input type=\"file\"\>@ element
--
-- This control may succeed even if the user does not actually select a file to upload. In that case the uploaded name will likely be \"\" and the file contents will be empty as well.
inputFile :: (Monad m, FormError error, FormInput input, ErrorInputType error ~ input) =>
             Form m input error Html () (FileType input)
inputFile :: Form m input error Html () (FileType input)
inputFile = (FormId -> Html) -> Form m input error Html () (FileType input)
forall (m :: * -> *) input error view.
(Monad m, FormInput input, FormError error,
 ErrorInputType error ~ input) =>
(FormId -> view) -> Form m input error view () (FileType input)
G.inputFile FormId -> Html
forall a. ToValue a => a -> Html
fileView
    where
      fileView :: a -> Html
fileView a
i = Html
H.input Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"file" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
i) Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
name (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
i)


-- | Create a @\<button type=\"submit\"\>@ element
buttonSubmit :: (Monad m, FormError error, H.ToValue text, H.ToMarkup children) =>
                (input -> Either error text)
             -> text
             -> children
             -> Form m input error Html () (Maybe text)
buttonSubmit :: (input -> Either error text)
-> text -> children -> Form m input error Html () (Maybe text)
buttonSubmit input -> Either error text
getInput text
text children
c = (input -> Either error text)
-> (FormId -> text -> Html)
-> text
-> Form m input error Html () (Maybe text)
forall (m :: * -> *) error input a view.
(Monad m, FormError error) =>
(input -> Either error a)
-> (FormId -> a -> view)
-> a
-> Form m input error view () (Maybe a)
G.inputMaybe input -> Either error text
getInput FormId -> text -> Html
inputField text
text
    where
      inputField :: FormId -> text -> Html
inputField FormId
i text
a = Html -> Html
H.button (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"submit" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (FormId -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue FormId
i) (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
name (FormId -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue FormId
i) (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
value (text -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue text
a) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ children -> Html
forall a. ToMarkup a => a -> Html
H.toHtml children
c

-- | create a  @\<button type=\"reset\"\>\<\/button\>@ element
--
-- This element does not add any data to the form data set.
buttonReset :: (Monad m, FormError error, H.ToMarkup children) =>
               children
             -> Form m input error Html () ()
buttonReset :: children -> Form m input error Html () ()
buttonReset children
c = (FormId -> Maybe Any -> Html)
-> Maybe Any -> Form m input error Html () ()
forall (m :: * -> *) a view input error.
Monad m =>
(FormId -> a -> view) -> a -> Form m input error view () ()
G.inputNoData FormId -> Maybe Any -> Html
inputField Maybe Any
forall a. Maybe a
Nothing
    where
      inputField :: FormId -> Maybe Any -> Html
inputField FormId
i Maybe Any
a = Html -> Html
H.button (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"reset" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (FormId -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue FormId
i) (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
name (FormId -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue FormId
i) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ children -> Html
forall a. ToMarkup a => a -> Html
H.toHtml children
c

-- | create a  @\<button type=\"button\"\>\<\/button\>@ element
--
-- This element does not add any data to the form data set.
button :: (Monad m, FormError error, H.ToMarkup children) =>
          children
       -> Form m input error Html () ()
button :: children -> Form m input error Html () ()
button children
c = (FormId -> Maybe Any -> Html)
-> Maybe Any -> Form m input error Html () ()
forall (m :: * -> *) a view input error.
Monad m =>
(FormId -> a -> view) -> a -> Form m input error view () ()
G.inputNoData FormId -> Maybe Any -> Html
inputField Maybe Any
forall a. Maybe a
Nothing
    where
      inputField :: FormId -> Maybe Any -> Html
inputField FormId
i Maybe Any
a = Html -> Html
H.button (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"button" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (FormId -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue FormId
i) (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
name (FormId -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue FormId
i) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ children -> Html
forall a. ToMarkup a => a -> Html
H.toHtml children
c


-- | create a @\<label\>@ element.
--
-- Use this with <++ or ++> to ensure that the @for@ attribute references the correct @id@.
--
-- > label "some input field: " ++> inputText ""
label :: (Monad m, H.ToMarkup children) =>
         children
      -> Form m input error Html () ()
label :: children -> Form m input error Html () ()
label children
c = (FormId -> Html) -> Form m input error Html () ()
forall (m :: * -> *) view input error.
Monad m =>
(FormId -> view) -> Form m input error view () ()
G.label FormId -> Html
mkLabel
    where
      mkLabel :: FormId -> Html
mkLabel FormId
i = Html -> Html
H.label (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.for (FormId -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue FormId
i) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ children -> Html
forall a. ToMarkup a => a -> Html
H.toHtml children
c



-- | Create a single @\<input type=\"checkbox\"\>@ element
--
-- returns a 'Bool' indicating if it was checked or not.
--
-- see also 'inputCheckboxes'
-- FIXME: Should this built on something in Generalized?
inputCheckbox :: forall x error input m. (Monad m, FormInput input, FormError error, ErrorInputType error ~ input) =>
                   Bool  -- ^ initially checked
                -> Form m input error Html () Bool
inputCheckbox :: Bool -> Form m input error Html () Bool
inputCheckbox Bool
initiallyChecked =
    FormState
  m input (View error Html, m (Result error (Proved () Bool)))
-> Form m input error Html () Bool
forall (m :: * -> *) input error view proof a.
FormState
  m input (View error view, m (Result error (Proved proof a)))
-> Form m input error view proof a
Form (FormState
   m input (View error Html, m (Result error (Proved () Bool)))
 -> Form m input error Html () Bool)
-> FormState
     m input (View error Html, m (Result error (Proved () Bool)))
-> Form m input error Html () Bool
forall a b. (a -> b) -> a -> b
$
      do FormId
i <- FormState m input FormId
forall (m :: * -> *) i. Monad m => FormState m i FormId
getFormId
         Value input
v <- FormId -> FormState m input (Value input)
forall (m :: * -> *) input.
Monad m =>
FormId -> FormState m input (Value input)
getFormInput' FormId
i
         case Value input
v of
           Value input
Default   -> FormId
-> Bool
-> FormState
     m input (View error Html, m (Result error (Proved () Bool)))
forall (m :: * -> *) (m :: * -> *) error e.
(Monad m, Monad m) =>
FormId
-> Bool -> m (View error Html, m (Result e (Proved () Bool)))
mkCheckbox FormId
i Bool
initiallyChecked
           Value input
Missing   -> FormId
-> Bool
-> FormState
     m input (View error Html, m (Result error (Proved () Bool)))
forall (m :: * -> *) (m :: * -> *) error e.
(Monad m, Monad m) =>
FormId
-> Bool -> m (View error Html, m (Result e (Proved () Bool)))
mkCheckbox FormId
i Bool
False -- checkboxes only appear in the submitted data when checked
           (Found input
input) ->
               case input -> Either error String
forall input error.
(FormInput input, FormError error, ErrorInputType error ~ input) =>
input -> Either error String
getInputString input
input of
                 (Right String
_) -> FormId
-> Bool
-> FormState
     m input (View error Html, m (Result error (Proved () Bool)))
forall (m :: * -> *) (m :: * -> *) error e.
(Monad m, Monad m) =>
FormId
-> Bool -> m (View error Html, m (Result e (Proved () Bool)))
mkCheckbox FormId
i Bool
True
                 (Left  (error
e :: error) ) -> FormId
-> Bool
-> FormState
     m input (View error Html, m (Result error (Proved () Bool)))
forall (m :: * -> *) (m :: * -> *) error e.
(Monad m, Monad m) =>
FormId
-> Bool -> m (View error Html, m (Result e (Proved () Bool)))
mkCheckbox FormId
i Bool
False
    where
      mkCheckbox :: FormId
-> Bool -> m (View error Html, m (Result e (Proved () Bool)))
mkCheckbox FormId
i Bool
checked =
          let checkbox :: Html
checkbox  = Html
H.input Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"checkbox" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (FormId -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue FormId
i) Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
name (FormId -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue FormId
i) Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
value (FormId -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue FormId
i)
              checkbox' :: Html
checkbox' = if Bool
checked then Html
checkbox Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.checked AttributeValue
"checked" else Html
checkbox
          in
          (View error Html, m (Result e (Proved () Bool)))
-> m (View error Html, m (Result e (Proved () Bool)))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(FormRange, error)] -> Html) -> View error Html
forall error v. ([(FormRange, error)] -> v) -> View error v
View (([(FormRange, error)] -> Html) -> View error Html)
-> ([(FormRange, error)] -> Html) -> View error Html
forall a b. (a -> b) -> a -> b
$ Html -> [(FormRange, error)] -> Html
forall a b. a -> b -> a
const (Html -> [(FormRange, error)] -> Html)
-> Html -> [(FormRange, error)] -> Html
forall a b. (a -> b) -> a -> b
$  Html
checkbox'
                 , Result e (Proved () Bool) -> m (Result e (Proved () Bool))
forall (m :: * -> *) a. Monad m => a -> m a
return (Result e (Proved () Bool) -> m (Result e (Proved () Bool)))
-> Result e (Proved () Bool) -> m (Result e (Proved () Bool))
forall a b. (a -> b) -> a -> b
$ Proved () Bool -> Result e (Proved () Bool)
forall e ok. ok -> Result e ok
Ok (Proved :: forall proofs a. proofs -> FormRange -> a -> Proved proofs a
Proved { proofs :: ()
proofs   = ()
                                       , pos :: FormRange
pos      = FormId -> FormRange
unitRange FormId
i
                                       , unProved :: Bool
unProved = if Bool
checked then Bool
True else Bool
False
                                       })
                 )

-- | Create a group of @\<input type=\"checkbox\"\>@ elements
--
inputCheckboxes :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, H.ToMarkup lbl) =>
                  [(a, lbl)]  -- ^ value, label, initially checked
                -> (a -> Bool) -- ^ function which indicates if a value should be checked initially
                -> Form m input error Html () [a]
inputCheckboxes :: [(a, lbl)] -> (a -> Bool) -> Form m input error Html () [a]
inputCheckboxes [(a, lbl)]
choices a -> Bool
isChecked =
    [(a, lbl)]
-> (FormId -> [(FormId, Int, lbl, Bool)] -> Html)
-> (a -> Bool)
-> Form m input error Html () [a]
forall (m :: * -> *) input error view a lbl.
(Functor m, FormError error, ErrorInputType error ~ input,
 FormInput input, Monad m) =>
[(a, lbl)]
-> (FormId -> [(FormId, Int, lbl, Bool)] -> view)
-> (a -> Bool)
-> Form m input error view () [a]
G.inputMulti [(a, lbl)]
choices FormId -> [(FormId, Int, lbl, Bool)] -> Html
forall (t :: * -> *) a a a a.
(Foldable t, ToValue a, ToValue a, ToValue a, ToMarkup a) =>
a -> t (a, a, a, Bool) -> Html
mkCheckboxes a -> Bool
isChecked
    where
      mkCheckboxes :: a -> t (a, a, a, Bool) -> Html
mkCheckboxes a
nm t (a, a, a, Bool)
choices' = [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ ((a, a, a, Bool) -> [Html]) -> t (a, a, a, Bool) -> [Html]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (a -> (a, a, a, Bool) -> [Html]
forall a a a a.
(ToValue a, ToValue a, ToValue a, ToMarkup a) =>
a -> (a, a, a, Bool) -> [Html]
mkCheckbox a
nm) t (a, a, a, Bool)
choices'
      mkCheckbox :: a -> (a, a, a, Bool) -> [Html]
mkCheckbox a
nm (a
i, a
val, a
lbl, Bool
checked) =
          [ ((if Bool
checked then (Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.checked AttributeValue
"checked") else Html -> Html
forall a. a -> a
id) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
                     Html
H.input Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"checkbox" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
i) Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
name (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
nm) Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
value (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
val))
                  ,  Html -> Html
H.label (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.for (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
i) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ a -> Html
forall a. ToMarkup a => a -> Html
H.toHtml a
lbl
                  ]

-- | Create a group of @\<input type=\"radio\"\>@ elements
inputRadio :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, H.ToMarkup lbl) =>
              [(a, lbl)]  -- ^ value, label, initially checked
           -> (a -> Bool) -- ^ isDefault
           -> Form m input error Html () a
inputRadio :: [(a, lbl)] -> (a -> Bool) -> Form m input error Html () a
inputRadio [(a, lbl)]
choices a -> Bool
isDefault =
    (a -> Bool)
-> [(a, lbl)]
-> (FormId -> [(FormId, Int, lbl, Bool)] -> Html)
-> Form m input error Html () a
forall a (m :: * -> *) error input lbl view.
(Functor m, FormError error, ErrorInputType error ~ input,
 FormInput input, Monad m) =>
(a -> Bool)
-> [(a, lbl)]
-> (FormId -> [(FormId, Int, lbl, Bool)] -> view)
-> Form m input error view () a
G.inputChoice a -> Bool
isDefault [(a, lbl)]
choices FormId -> [(FormId, Int, lbl, Bool)] -> Html
forall (t :: * -> *) a a a a.
(Foldable t, ToValue a, ToValue a, ToValue a, ToMarkup a) =>
a -> t (a, a, a, Bool) -> Html
mkRadios
    where
      mkRadios :: a -> t (a, a, a, Bool) -> Html
mkRadios a
nm t (a, a, a, Bool)
choices' = [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ ((a, a, a, Bool) -> [Html]) -> t (a, a, a, Bool) -> [Html]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (a -> (a, a, a, Bool) -> [Html]
forall a a a a.
(ToValue a, ToValue a, ToValue a, ToMarkup a) =>
a -> (a, a, a, Bool) -> [Html]
mkRadio a
nm) t (a, a, a, Bool)
choices'
      mkRadio :: a -> (a, a, a, Bool) -> [Html]
mkRadio a
nm (a
i, a
val, a
lbl, Bool
checked) =
          [ ((if Bool
checked then (Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.checked AttributeValue
"checked") else Html -> Html
forall a. a -> a
id) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
             Html
H.input Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"radio" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.id (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
i) Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
name (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
nm) Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
value (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
val))
          ,  Html -> Html
H.label (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.for (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
i) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ a -> Html
forall a. ToMarkup a => a -> Html
H.toHtml a
lbl
          ,  Html
H.br
          ]

-- | create @\<select\>\<\/select\>@ element plus its @\<option\>\<\/option\>@ children.
--
-- see also: 'selectMultiple'
select :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, H.ToMarkup lbl) =>
              [(a, lbl)]  -- ^ value, label
           -> (a -> Bool) -- ^ isDefault, must match *exactly one* element in the list of choices
           -> Form m input error Html () a
select :: [(a, lbl)] -> (a -> Bool) -> Form m input error Html () a
select [(a, lbl)]
choices a -> Bool
isDefault  =
    (a -> Bool)
-> [(a, lbl)]
-> (FormId -> [(FormId, Int, lbl, Bool)] -> Html)
-> Form m input error Html () a
forall a (m :: * -> *) error input lbl view.
(Functor m, FormError error, ErrorInputType error ~ input,
 FormInput input, Monad m) =>
(a -> Bool)
-> [(a, lbl)]
-> (FormId -> [(FormId, Int, lbl, Bool)] -> view)
-> Form m input error view () a
G.inputChoice a -> Bool
isDefault [(a, lbl)]
choices FormId -> [(FormId, Int, lbl, Bool)] -> Html
forall a a a a.
(ToValue a, ToValue a, ToMarkup a) =>
a -> [(a, a, a, Bool)] -> Html
mkSelect
    where
      mkSelect :: a -> [(a, a, a, Bool)] -> Html
mkSelect a
nm [(a, a, a, Bool)]
choices' =
          Html -> Html
H.select (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
name (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
nm) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
           [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ ((a, a, a, Bool) -> Html) -> [(a, a, a, Bool)] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (a, a, a, Bool) -> Html
forall a a a. (ToValue a, ToMarkup a) => (a, a, a, Bool) -> Html
mkOption [(a, a, a, Bool)]
choices'

      mkOption :: (a, a, a, Bool) -> Html
mkOption (a
_, a
val, a
lbl, Bool
selected) =
          (if Bool
selected then ((Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.selected AttributeValue
"selected") else (Html -> Html) -> Html -> Html
forall a. a -> a
id)
             Html -> Html
H.option (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
value (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
val) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ a -> Html
forall a. ToMarkup a => a -> Html
H.toHtml a
lbl

-- | create @\<select multiple=\"multiple\"\>\<\/select\>@ element plus its @\<option\>\<\/option\>@ children.
--
-- This creates a @\<select\>@ element which allows more than one item to be selected.
selectMultiple :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, H.ToMarkup lbl) =>
                  [(a, lbl)]  -- ^ value, label, initially checked
               -> (a -> Bool)  -- ^ isSelected initially
               -> Form m input error Html () [a]
selectMultiple :: [(a, lbl)] -> (a -> Bool) -> Form m input error Html () [a]
selectMultiple [(a, lbl)]
choices a -> Bool
isSelected =
    [(a, lbl)]
-> (FormId -> [(FormId, Int, lbl, Bool)] -> Html)
-> (a -> Bool)
-> Form m input error Html () [a]
forall (m :: * -> *) input error view a lbl.
(Functor m, FormError error, ErrorInputType error ~ input,
 FormInput input, Monad m) =>
[(a, lbl)]
-> (FormId -> [(FormId, Int, lbl, Bool)] -> view)
-> (a -> Bool)
-> Form m input error view () [a]
G.inputMulti [(a, lbl)]
choices FormId -> [(FormId, Int, lbl, Bool)] -> Html
forall a a a a.
(ToValue a, ToValue a, ToMarkup a) =>
a -> [(a, a, a, Bool)] -> Html
mkSelect a -> Bool
isSelected
    where
      mkSelect :: a -> [(a, a, a, Bool)] -> Html
mkSelect a
nm [(a, a, a, Bool)]
choices' =
          Html -> Html
H.select (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
name (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
nm) (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.multiple AttributeValue
"multiple" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
           [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ ((a, a, a, Bool) -> Html) -> [(a, a, a, Bool)] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (a, a, a, Bool) -> Html
forall a a a. (ToValue a, ToMarkup a) => (a, a, a, Bool) -> Html
mkOption [(a, a, a, Bool)]
choices'

      mkOption :: (a, a, a, Bool) -> Html
mkOption (a
_, a
val, a
lbl, Bool
selected) =
        (if Bool
selected then ((Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.selected AttributeValue
"selected") else (Html -> Html) -> Html -> Html
forall a. a -> a
id)
             Html -> Html
H.option (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
value (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
val) (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ a -> Html
forall a. ToMarkup a => a -> Html
H.toHtml a
lbl

{-
inputMultiSelectOptGroup :: (Functor m, XMLGenerator x, EmbedAsChild x groupLbl, EmbedAsChild x lbl, EmbedAsAttr x (Attr String FormId), FormError error, ErrorInputType error ~ input, FormInput input, Monad m) =>
                   [(groupLbl, [(a, lbl, Bool)])]  -- ^ value, label, initially checked
                -> Form m input error Html () [a]
inputMultiSelectOptGroup choices =
    G.inputMulti choices mkSelect
    where
      mkSelect nm choices' =
          [<select name=nm multiple="multiple">
            <% mapM mkOptGroup choices' %>
           </select>
          ]
      mkOptGroup (grpLabel, options) =
          <optgroup label=grpLabel>
           <% mapM mkOption options %>
          </optgroup>
      mkOption (_, val, lbl, selected) =
          <option value=val (if selected then ["selected" := "selected"] else [])>
           <% lbl %>
          </option>
-}

-- | create a @\<ul\>@ which contains all the errors related to the 'Form'.
--
-- The @<\ul\>@ will have the attribute @class=\"reform-error-list\"@.
errorList :: (Monad m, H.ToMarkup error) =>
             Form m input error Html () ()
errorList :: Form m input error Html () ()
errorList = ([error] -> Html) -> Form m input error Html () ()
forall (m :: * -> *) error view input.
Monad m =>
([error] -> view) -> Form m input error view () ()
G.errors [error] -> Html
forall a. ToMarkup a => [a] -> Html
mkErrors
    where
      mkErrors :: [a] -> Html
mkErrors []   = Html
forall a. Monoid a => a
mempty
      mkErrors [a]
errs =
          Html -> Html
H.ul (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"reform-error-list" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
             [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ (a -> Html) -> [a] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map a -> Html
forall a. ToMarkup a => a -> Html
mkError [a]
errs
      mkError :: a -> Html
mkError a
e     = Html -> Html
H.li (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ a -> Html
forall a. ToMarkup a => a -> Html
H.toHtml a
e

-- | create a @\<ul\>@ which contains all the errors related to the 'Form'.
--
-- Includes errors from child forms.
--
-- The @<\ul\>@ will have the attribute @class=\"reform-error-list\"@.
childErrorList :: (Monad m, H.ToMarkup error) =>
             Form m input error Html () ()
childErrorList :: Form m input error Html () ()
childErrorList = ([error] -> Html) -> Form m input error Html () ()
forall (m :: * -> *) error view input.
Monad m =>
([error] -> view) -> Form m input error view () ()
G.childErrors [error] -> Html
forall a. ToMarkup a => [a] -> Html
mkErrors
    where
      mkErrors :: [a] -> Html
mkErrors []   = Html
forall a. Monoid a => a
mempty
      mkErrors [a]
errs =
          Html -> Html
H.ul (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"reform-error-list" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
             [Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ (a -> Html) -> [a] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map a -> Html
forall a. ToMarkup a => a -> Html
mkError [a]
errs
      mkError :: a -> Html
mkError a
e     = Html -> Html
H.li (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$ a -> Html
forall a. ToMarkup a => a -> Html
H.toHtml a
e


-- | create a @\<br\>@ tag.
br :: (Monad m) => Form m input error Html () ()
br :: Form m input error Html () ()
br = Html -> Form m input error Html () ()
forall (m :: * -> *) view input error.
Monad m =>
view -> Form m input error view () ()
view Html
H.br

-- | wrap a @\<fieldset class=\"reform\"\>@ around a 'Form'
--
fieldset :: (Monad m, Functor m) =>
            Form m input error Html proof a
         -> Form m input error Html proof a
fieldset :: Form m input error Html proof a -> Form m input error Html proof a
fieldset Form m input error Html proof a
frm = (Html -> Html)
-> Form m input error Html proof a
-> Form m input error Html proof a
forall (m :: * -> *) view view' input error proof a.
(Monad m, Functor m) =>
(view -> view')
-> Form m input error view proof a
-> Form m input error view' proof a
mapView (Html -> Html
H.fieldset (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"reform") Form m input error Html proof a
frm

-- | wrap an @\<ol class=\"reform\"\>@ around a 'Form'
ol :: (Monad m, Functor m) =>
      Form m input error Html proof a
   -> Form m input error Html proof a
ol :: Form m input error Html proof a -> Form m input error Html proof a
ol Form m input error Html proof a
frm = (Html -> Html)
-> Form m input error Html proof a
-> Form m input error Html proof a
forall (m :: * -> *) view view' input error proof a.
(Monad m, Functor m) =>
(view -> view')
-> Form m input error view proof a
-> Form m input error view' proof a
mapView (Html -> Html
H.ol (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"reform") Form m input error Html proof a
frm

-- | wrap a @\<ul class=\"reform\"\>@ around a 'Form'
ul :: (Monad m, Functor m) =>
      Form m input error Html proof a
   -> Form m input error Html proof a
ul :: Form m input error Html proof a -> Form m input error Html proof a
ul Form m input error Html proof a
frm = (Html -> Html)
-> Form m input error Html proof a
-> Form m input error Html proof a
forall (m :: * -> *) view view' input error proof a.
(Monad m, Functor m) =>
(view -> view')
-> Form m input error view proof a
-> Form m input error view' proof a
mapView (Html -> Html
H.ul (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"reform") Form m input error Html proof a
frm

-- | wrap a @\<li class=\"reform\"\>@ around a 'Form'
li :: (Monad m, Functor m) =>
      Form m input error Html proof a
   -> Form m input error Html proof a
li :: Form m input error Html proof a -> Form m input error Html proof a
li Form m input error Html proof a
frm = (Html -> Html)
-> Form m input error Html proof a
-> Form m input error Html proof a
forall (m :: * -> *) view view' input error proof a.
(Monad m, Functor m) =>
(view -> view')
-> Form m input error view proof a
-> Form m input error view' proof a
mapView (Html -> Html
H.li (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.class_ AttributeValue
"reform") Form m input error Html proof a
frm

-- | create @\<form action=action method=\"POST\" enctype=\"multipart/form-data\"\>@
form :: (H.ToValue action) =>
        action                  -- ^ action url
     -> [(Text, Text)]       -- ^ hidden fields to add to form
     -> Html -- ^ children
     -> Html
form :: action -> [(Text, Text)] -> Html -> Html
form action
action [(Text, Text)]
hidden Html
children =
    Html -> Html
H.form (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.action (action -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue action
action) (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.method AttributeValue
"POST" (Html -> Html) -> Attribute -> Html -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
A.enctype AttributeValue
"multipart/form-data" (Html -> Html) -> Html -> Html
forall a b. (a -> b) -> a -> b
$
         (([Html] -> Html
forall a. Monoid a => [a] -> a
mconcat ([Html] -> Html) -> [Html] -> Html
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Html) -> [(Text, Text)] -> [Html]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Text) -> Html
forall a a. (ToValue a, ToValue a) => (a, a) -> Html
mkHidden [(Text, Text)]
hidden) Html -> Html -> Html
forall a. Semigroup a => a -> a -> a
<> Html
children)
      where
        mkHidden :: (a, a) -> Html
mkHidden (a
nm, a
val) =
            Html
H.input Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
type_ AttributeValue
"hidden" Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
name (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
nm) Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! AttributeValue -> Attribute
value (a -> AttributeValue
forall a. ToValue a => a -> AttributeValue
toValue a
val)

-- | add an attribute to the 'Html' for a form element.
setAttr :: (Monad m, Functor m) =>
           Form m input error Html proof a
         -> H.Attribute
         -> Form m input error Html proof a
setAttr :: Form m input error Html proof a
-> Attribute -> Form m input error Html proof a
setAttr Form m input error Html proof a
form Attribute
attr = (Html -> Html)
-> Form m input error Html proof a
-> Form m input error Html proof a
forall (m :: * -> *) view view' input error proof a.
(Monad m, Functor m) =>
(view -> view')
-> Form m input error view proof a
-> Form m input error view' proof a
mapView (\Html
e -> Html
e Html -> Attribute -> Html
forall h. Attributable h => h -> Attribute -> h
! Attribute
attr) Form m input error Html proof a
form