{-# 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
-> Int
-> 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
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)
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
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
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
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
inputCheckbox :: forall x error input m. (Monad m, FormInput input, FormError error, ErrorInputType error ~ input) =>
Bool
-> 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
(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
})
)
inputCheckboxes :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, H.ToMarkup lbl) =>
[(a, lbl)]
-> (a -> Bool)
-> 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
]
inputRadio :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, H.ToMarkup lbl) =>
[(a, lbl)]
-> (a -> Bool)
-> 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
]
select :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, H.ToMarkup lbl) =>
[(a, lbl)]
-> (a -> Bool)
-> 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
selectMultiple :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, H.ToMarkup lbl) =>
[(a, lbl)]
-> (a -> Bool)
-> 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
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
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
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
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
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
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
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
form :: (H.ToValue action) =>
action
-> [(Text, Text)]
-> Html
-> 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)
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