{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, UndecidableInstances, ViewPatterns, OverloadedStrings, QuasiQuotes #-}
module Text.Reform.HSP.Common where
import Data.List (intercalate)
import Data.Monoid ((<>), mconcat)
import Data.Text.Lazy (Text, pack)
import qualified Data.Text as T
import Text.Reform.Backend
import Text.Reform.Core
import Text.Reform.Generalized as G
import Text.Reform.Result (FormId, Result(Ok), unitRange)
import Language.Haskell.HSX.QQ (hsx)
import HSP.XMLGenerator
import HSP.XML
instance (XMLGen m, EmbedAsAttr m (Attr Text Text)) => (EmbedAsAttr m (Attr Text FormId)) where
asAttr :: Attr Text FormId -> GenAttributeList m
asAttr (Text
n := FormId
v) = Attr Text Text -> GenAttributeList m
forall (m :: * -> *) a. EmbedAsAttr m a => a -> GenAttributeList m
asAttr (Text
n Text -> Text -> Attr Text Text
forall n a. n -> a -> Attr n a
:= (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ FormId -> String
forall a. Show a => a -> String
show FormId
v))
inputText :: (Monad m, FormError error, XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId), EmbedAsAttr x (Attr Text text)) =>
(input -> Either error text)
-> text
-> Form m input error [XMLGenT x (XMLType x)] () text
inputText :: forall (m :: * -> *) error (x :: * -> *) text input.
(Monad m, FormError error, XMLGenerator x, StringType x ~ Text,
EmbedAsAttr x (Attr Text FormId),
EmbedAsAttr x (Attr Text text)) =>
(input -> Either error text)
-> text -> Form m input error [XMLGenT x (XMLType x)] () text
inputText input -> Either error text
getInput text
initialValue = (input -> Either error text)
-> (FormId -> text -> [XMLGenT x (XMLType x)])
-> text
-> Form m input error [XMLGenT x (XMLType x)] () 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 -> [XMLGenT x (XMLType x)]
forall {m :: * -> *} {a} {a}.
(EmbedAsAttr m (Attr Text a), EmbedAsAttr m (Attr Text a),
EmbedAsAttr m (Attr Text Text), StringType m ~ Text) =>
a -> a -> [XMLGenT m (XMLType m)]
inputField text
initialValue
where
inputField :: a -> a -> [XMLGenT m (XMLType m)]
inputField a
i a
a = [hsx| [<input type="text" id=i name=i value=a />] |]
inputEmail :: (Monad m, FormError error, XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId), EmbedAsAttr x (Attr Text text)) =>
(input -> Either error text)
-> text
-> Form m input error [XMLGenT x (XMLType x)] () text
inputEmail :: forall (m :: * -> *) error (x :: * -> *) text input.
(Monad m, FormError error, XMLGenerator x, StringType x ~ Text,
EmbedAsAttr x (Attr Text FormId),
EmbedAsAttr x (Attr Text text)) =>
(input -> Either error text)
-> text -> Form m input error [XMLGenT x (XMLType x)] () text
inputEmail input -> Either error text
getInput text
initialValue = (input -> Either error text)
-> (FormId -> text -> [XMLGenT x (XMLType x)])
-> text
-> Form m input error [XMLGenT x (XMLType x)] () 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 -> [XMLGenT x (XMLType x)]
forall {m :: * -> *} {a} {a}.
(EmbedAsAttr m (Attr Text a), EmbedAsAttr m (Attr Text a),
EmbedAsAttr m (Attr Text Text), StringType m ~ Text) =>
a -> a -> [XMLGenT m (XMLType m)]
inputField text
initialValue
where
inputField :: a -> a -> [XMLGenT m (XMLType m)]
inputField a
i a
a = [hsx| [<input type="email" id=i name=i value=a />] |]
inputPassword :: (Monad m, FormError error, XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId), EmbedAsAttr x (Attr Text text)) =>
(input -> Either error text)
-> text
-> Form m input error [XMLGenT x (XMLType x)] () text
inputPassword :: forall (m :: * -> *) error (x :: * -> *) text input.
(Monad m, FormError error, XMLGenerator x, StringType x ~ Text,
EmbedAsAttr x (Attr Text FormId),
EmbedAsAttr x (Attr Text text)) =>
(input -> Either error text)
-> text -> Form m input error [XMLGenT x (XMLType x)] () text
inputPassword input -> Either error text
getInput text
initialValue = (input -> Either error text)
-> (FormId -> text -> [XMLGenT x (XMLType x)])
-> text
-> Form m input error [XMLGenT x (XMLType x)] () 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 -> [XMLGenT x (XMLType x)]
forall {m :: * -> *} {a} {a}.
(EmbedAsAttr m (Attr Text a), EmbedAsAttr m (Attr Text a),
EmbedAsAttr m (Attr Text Text), StringType m ~ Text) =>
a -> a -> [XMLGenT m (XMLType m)]
inputField text
initialValue
where
inputField :: a -> a -> [XMLGenT m (XMLType m)]
inputField a
i a
a = [hsx| [<input type="password" id=i name=i value=a />] |]
inputSubmit :: (Monad m, FormError error, XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId), EmbedAsAttr x (Attr Text text)) =>
(input -> Either error text)
-> text
-> Form m input error [XMLGenT x (XMLType x)] () (Maybe text)
inputSubmit :: forall (m :: * -> *) error (x :: * -> *) text input.
(Monad m, FormError error, XMLGenerator x, StringType x ~ Text,
EmbedAsAttr x (Attr Text FormId),
EmbedAsAttr x (Attr Text text)) =>
(input -> Either error text)
-> text
-> Form m input error [XMLGenT x (XMLType x)] () (Maybe text)
inputSubmit input -> Either error text
getInput text
initialValue = (input -> Either error text)
-> (FormId -> text -> [XMLGenT x (XMLType x)])
-> text
-> Form m input error [XMLGenT x (XMLType x)] () (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 -> [XMLGenT x (XMLType x)]
forall {m :: * -> *} {a} {a}.
(EmbedAsAttr m (Attr Text a), EmbedAsAttr m (Attr Text a),
EmbedAsAttr m (Attr Text Text), StringType m ~ Text) =>
a -> a -> [XMLGenT m (XMLType m)]
inputField text
initialValue
where
inputField :: a -> a -> [XMLGenT m (XMLType m)]
inputField a
i a
a = [hsx| [<input type="submit" id=i name=i value=a />] |]
inputReset :: (Monad m, FormError error, XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId), EmbedAsAttr x (Attr Text text)) =>
text
-> Form m input error [XMLGenT x (XMLType x)] () ()
inputReset :: forall (m :: * -> *) error (x :: * -> *) text input.
(Monad m, FormError error, XMLGenerator x, StringType x ~ Text,
EmbedAsAttr x (Attr Text FormId),
EmbedAsAttr x (Attr Text text)) =>
text -> Form m input error [XMLGenT x (XMLType x)] () ()
inputReset text
lbl = (FormId -> text -> [XMLGenT x (XMLType x)])
-> text -> Form m input error [XMLGenT x (XMLType x)] () ()
forall (m :: * -> *) a view input error.
Monad m =>
(FormId -> a -> view) -> a -> Form m input error view () ()
G.inputNoData FormId -> text -> [XMLGenT x (XMLType x)]
forall {m :: * -> *} {a} {a}.
(EmbedAsAttr m (Attr Text a), EmbedAsAttr m (Attr Text a),
EmbedAsAttr m (Attr Text Text), StringType m ~ Text) =>
a -> a -> [XMLGenT m (XMLType m)]
inputField text
lbl
where
inputField :: a -> a -> [XMLGenT m (XMLType m)]
inputField a
i a
a = [hsx| [<input type="reset" id=i name=i value=a />] |]
inputHidden :: (Monad m, FormError error, XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId), EmbedAsAttr x (Attr Text text)) =>
(input -> Either error text)
-> text
-> Form m input error [XMLGenT x (XMLType x)] () text
inputHidden :: forall (m :: * -> *) error (x :: * -> *) text input.
(Monad m, FormError error, XMLGenerator x, StringType x ~ Text,
EmbedAsAttr x (Attr Text FormId),
EmbedAsAttr x (Attr Text text)) =>
(input -> Either error text)
-> text -> Form m input error [XMLGenT x (XMLType x)] () text
inputHidden input -> Either error text
getInput text
initialValue = (input -> Either error text)
-> (FormId -> text -> [XMLGenT x (XMLType x)])
-> text
-> Form m input error [XMLGenT x (XMLType x)] () 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 -> [XMLGenT x (XMLType x)]
forall {m :: * -> *} {a} {a}.
(EmbedAsAttr m (Attr Text a), EmbedAsAttr m (Attr Text a),
EmbedAsAttr m (Attr Text Text), StringType m ~ Text) =>
a -> a -> [XMLGenT m (XMLType m)]
inputField text
initialValue
where
inputField :: a -> a -> [XMLGenT m (XMLType m)]
inputField a
i a
a = [hsx| [<input type="hidden" id=i name=i value=a />] |]
inputButton :: (Monad m, FormError error, XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId), EmbedAsAttr x (Attr Text text)) =>
text
-> Form m input error [XMLGenT x (XMLType x)] () ()
inputButton :: forall (m :: * -> *) error (x :: * -> *) text input.
(Monad m, FormError error, XMLGenerator x, StringType x ~ Text,
EmbedAsAttr x (Attr Text FormId),
EmbedAsAttr x (Attr Text text)) =>
text -> Form m input error [XMLGenT x (XMLType x)] () ()
inputButton text
label = (FormId -> text -> [XMLGenT x (XMLType x)])
-> text -> Form m input error [XMLGenT x (XMLType x)] () ()
forall (m :: * -> *) a view input error.
Monad m =>
(FormId -> a -> view) -> a -> Form m input error view () ()
G.inputNoData FormId -> text -> [XMLGenT x (XMLType x)]
forall {m :: * -> *} {a} {a}.
(EmbedAsAttr m (Attr Text a), EmbedAsAttr m (Attr Text a),
EmbedAsAttr m (Attr Text Text), StringType m ~ Text) =>
a -> a -> [XMLGenT m (XMLType m)]
inputField text
label
where
inputField :: a -> a -> [XMLGenT m (XMLType m)]
inputField a
i a
a = [hsx| [<input type="button" id=i name=i value=a />] |]
textarea :: (Monad m, FormError error, XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId), EmbedAsChild x text) =>
(input -> Either error text)
-> Int
-> Int
-> text
-> Form m input error [XMLGenT x (XMLType x)] () text
textarea :: forall (m :: * -> *) error (x :: * -> *) text input.
(Monad m, FormError error, XMLGenerator x, StringType x ~ Text,
EmbedAsAttr x (Attr Text FormId), EmbedAsChild x text) =>
(input -> Either error text)
-> Int
-> Int
-> text
-> Form m input error [XMLGenT x (XMLType x)] () text
textarea input -> Either error text
getInput Int
cols Int
rows text
initialValue = (input -> Either error text)
-> (FormId -> text -> [XMLGenT x (XMLType x)])
-> text
-> Form m input error [XMLGenT x (XMLType x)] () 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 -> [XMLGenT x (XMLType x)]
textareaView text
initialValue
where
textareaView :: FormId -> text -> [XMLGenT x (XMLType x)]
textareaView FormId
i text
txt = [hsx| [<textarea rows=rows cols=cols id=i name=i><% txt %></textarea>] |]
inputFile :: (Monad m, FormError error, FormInput input, ErrorInputType error ~ input, XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId)) =>
Form m input error [XMLGenT x (XMLType x)] () (FileType input)
inputFile :: forall (m :: * -> *) error input (x :: * -> *).
(Monad m, FormError error, FormInput input,
ErrorInputType error ~ input, XMLGenerator x, StringType x ~ Text,
EmbedAsAttr x (Attr Text FormId)) =>
Form m input error [XMLGenT x (XMLType x)] () (FileType input)
inputFile = (FormId -> [XMLGenT x (XMLType x)])
-> Form m input error [XMLGenT x (XMLType x)] () (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 -> [XMLGenT x (XMLType x)]
forall {m :: * -> *} {a}.
(EmbedAsAttr m (Attr Text a), EmbedAsAttr m (Attr Text Text),
StringType m ~ Text) =>
a -> [XMLGenT m (XMLType m)]
fileView
where
fileView :: a -> [XMLGenT m (XMLType m)]
fileView a
i = [hsx| [<input type="file" name=i id=i />] |]
buttonSubmit :: ( Monad m, FormError error, XMLGenerator x, StringType x ~ Text, EmbedAsChild x children , EmbedAsAttr x (Attr Text FormId), EmbedAsAttr x (Attr Text text)) =>
(input -> Either error text)
-> text
-> children
-> Form m input error [XMLGenT x (XMLType x)] () (Maybe text)
buttonSubmit :: forall (m :: * -> *) error (x :: * -> *) children text input.
(Monad m, FormError error, XMLGenerator x, StringType x ~ Text,
EmbedAsChild x children, EmbedAsAttr x (Attr Text FormId),
EmbedAsAttr x (Attr Text text)) =>
(input -> Either error text)
-> text
-> children
-> Form m input error [XMLGenT x (XMLType x)] () (Maybe text)
buttonSubmit input -> Either error text
getInput text
text children
c = (input -> Either error text)
-> (FormId -> text -> [XMLGenT x (XMLType x)])
-> text
-> Form m input error [XMLGenT x (XMLType x)] () (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 -> [XMLGenT x (XMLType x)]
inputField text
text
where
inputField :: FormId -> text -> [XMLGenT x (XMLType x)]
inputField FormId
i text
a = [hsx| [<button type="submit" id=i name=i value=a><% c %></button>] |]
buttonReset :: ( Monad m, FormError error, XMLGenerator x, StringType x ~ Text, EmbedAsChild x children , EmbedAsAttr x (Attr Text FormId)
) =>
children
-> Form m input error [XMLGenT x (XMLType x)] () ()
buttonReset :: forall (m :: * -> *) error (x :: * -> *) children input.
(Monad m, FormError error, XMLGenerator x, StringType x ~ Text,
EmbedAsChild x children, EmbedAsAttr x (Attr Text FormId)) =>
children -> Form m input error [XMLGenT x (XMLType x)] () ()
buttonReset children
c = (FormId -> Maybe Any -> [XMLGenT x (XMLType x)])
-> Maybe Any -> Form m input error [XMLGenT x (XMLType x)] () ()
forall (m :: * -> *) a view input error.
Monad m =>
(FormId -> a -> view) -> a -> Form m input error view () ()
G.inputNoData FormId -> Maybe Any -> [XMLGenT x (XMLType x)]
inputField Maybe Any
forall a. Maybe a
Nothing
where
inputField :: FormId -> Maybe Any -> [XMLGenT x (XMLType x)]
inputField FormId
i Maybe Any
a = [hsx| [<button type="reset" id=i name=i><% c %></button>] |]
button :: ( Monad m, FormError error, XMLGenerator x, StringType x ~ Text, EmbedAsChild x children , EmbedAsAttr x (Attr Text FormId)
) =>
children
-> Form m input error [XMLGenT x (XMLType x)] () ()
button :: forall (m :: * -> *) error (x :: * -> *) children input.
(Monad m, FormError error, XMLGenerator x, StringType x ~ Text,
EmbedAsChild x children, EmbedAsAttr x (Attr Text FormId)) =>
children -> Form m input error [XMLGenT x (XMLType x)] () ()
button children
c = (FormId -> Maybe Any -> [XMLGenT x (XMLType x)])
-> Maybe Any -> Form m input error [XMLGenT x (XMLType x)] () ()
forall (m :: * -> *) a view input error.
Monad m =>
(FormId -> a -> view) -> a -> Form m input error view () ()
G.inputNoData FormId -> Maybe Any -> [XMLGenT x (XMLType x)]
inputField Maybe Any
forall a. Maybe a
Nothing
where
inputField :: FormId -> Maybe Any -> [XMLGenT x (XMLType x)]
inputField FormId
i Maybe Any
a = [hsx| [<button type="button" id=i name=i><% c %></button>] |]
label :: (Monad m, XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId), EmbedAsChild x c) =>
c
-> Form m input error [XMLGenT x (XMLType x)] () ()
label :: forall (m :: * -> *) (x :: * -> *) c input error.
(Monad m, XMLGenerator x, StringType x ~ Text,
EmbedAsAttr x (Attr Text FormId), EmbedAsChild x c) =>
c -> Form m input error [XMLGenT x (XMLType x)] () ()
label c
c = (FormId -> [XMLGenT x (XMLType x)])
-> Form m input error [XMLGenT x (XMLType x)] () ()
forall (m :: * -> *) view input error.
Monad m =>
(FormId -> view) -> Form m input error view () ()
G.label FormId -> [XMLGenT x (XMLType x)]
mkLabel
where
mkLabel :: FormId -> [XMLGenT x (XMLType x)]
mkLabel FormId
i = [hsx| [<label for=i><% c %></label>] |]
inputCheckbox :: forall x error input m. (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId)) =>
Bool
-> Form m input error [XMLGenT x (XMLType x)] () Bool
inputCheckbox :: forall (x :: * -> *) error input (m :: * -> *).
(Monad m, FormInput input, FormError error,
ErrorInputType error ~ input, XMLGenerator x, StringType x ~ Text,
EmbedAsAttr x (Attr Text FormId)) =>
Bool -> Form m input error [XMLGenT x (XMLType x)] () Bool
inputCheckbox Bool
initiallyChecked =
FormState
m
input
(View error [XMLGenT x (XMLType x)],
m (Result error (Proved () Bool)))
-> Form m input error [XMLGenT x (XMLType x)] () 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 [XMLGenT x (XMLType x)],
m (Result error (Proved () Bool)))
-> Form m input error [XMLGenT x (XMLType x)] () Bool)
-> FormState
m
input
(View error [XMLGenT x (XMLType x)],
m (Result error (Proved () Bool)))
-> Form m input error [XMLGenT x (XMLType x)] () 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 [XMLGenT x (XMLType x)],
m (Result error (Proved () Bool)))
forall {m :: * -> *} {m :: * -> *} {m :: * -> *} {error} {e}.
(EmbedAsAttr m (Attr Text Text), Monad m, Monad m,
StringType m ~ Text) =>
FormId
-> Bool
-> m (View error [XMLGenT m (XMLType m)],
m (Result e (Proved () Bool)))
mkCheckbox FormId
i Bool
initiallyChecked
Value input
Missing -> FormId
-> Bool
-> FormState
m
input
(View error [XMLGenT x (XMLType x)],
m (Result error (Proved () Bool)))
forall {m :: * -> *} {m :: * -> *} {m :: * -> *} {error} {e}.
(EmbedAsAttr m (Attr Text Text), Monad m, Monad m,
StringType m ~ Text) =>
FormId
-> Bool
-> m (View error [XMLGenT m (XMLType m)],
m (Result e (Proved () Bool)))
mkCheckbox FormId
i Bool
False
(Found input
input) ->
case input -> Either error Text
forall input error.
(FormInput input, FormError error, ErrorInputType error ~ input) =>
input -> Either error Text
getInputText input
input of
(Right Text
_) -> FormId
-> Bool
-> FormState
m
input
(View error [XMLGenT x (XMLType x)],
m (Result error (Proved () Bool)))
forall {m :: * -> *} {m :: * -> *} {m :: * -> *} {error} {e}.
(EmbedAsAttr m (Attr Text Text), Monad m, Monad m,
StringType m ~ Text) =>
FormId
-> Bool
-> m (View error [XMLGenT m (XMLType m)],
m (Result e (Proved () Bool)))
mkCheckbox FormId
i Bool
True
(Left (error
e :: error) ) -> FormId
-> Bool
-> FormState
m
input
(View error [XMLGenT x (XMLType x)],
m (Result error (Proved () Bool)))
forall {m :: * -> *} {m :: * -> *} {m :: * -> *} {error} {e}.
(EmbedAsAttr m (Attr Text Text), Monad m, Monad m,
StringType m ~ Text) =>
FormId
-> Bool
-> m (View error [XMLGenT m (XMLType m)],
m (Result e (Proved () Bool)))
mkCheckbox FormId
i Bool
False
where
mkCheckbox :: FormId
-> Bool
-> m (View error [XMLGenT m (XMLType m)],
m (Result e (Proved () Bool)))
mkCheckbox FormId
i Bool
checked =
(View error [XMLGenT m (XMLType m)], m (Result e (Proved () Bool)))
-> m (View error [XMLGenT m (XMLType m)],
m (Result e (Proved () Bool)))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(FormRange, error)] -> [XMLGenT m (XMLType m)])
-> View error [XMLGenT m (XMLType m)]
forall error v. ([(FormRange, error)] -> v) -> View error v
View (([(FormRange, error)] -> [XMLGenT m (XMLType m)])
-> View error [XMLGenT m (XMLType m)])
-> ([(FormRange, error)] -> [XMLGenT m (XMLType m)])
-> View error [XMLGenT m (XMLType m)]
forall a b. (a -> b) -> a -> b
$ [XMLGenT m (XMLType m)]
-> [(FormRange, error)] -> [XMLGenT m (XMLType m)]
forall a b. a -> b -> a
const ([XMLGenT m (XMLType m)]
-> [(FormRange, error)] -> [XMLGenT m (XMLType m)])
-> [XMLGenT m (XMLType m)]
-> [(FormRange, error)]
-> [XMLGenT m (XMLType m)]
forall a b. (a -> b) -> a -> b
$ [hsx| [<input type="checkbox" id=i name=i value=i (if checked then [("checked" := "checked") :: Attr Text Text] else []) />] |]
, 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, XMLGenerator x, StringType x ~ Text, EmbedAsChild x lbl, EmbedAsAttr x (Attr Text FormId)) =>
[(a, lbl)]
-> (a -> Bool)
-> Form m input error [XMLGenT x (XMLType x)] () [a]
inputCheckboxes :: forall (m :: * -> *) error input (x :: * -> *) lbl a.
(Functor m, Monad m, FormError error, ErrorInputType error ~ input,
FormInput input, XMLGenerator x, StringType x ~ Text,
EmbedAsChild x lbl, EmbedAsAttr x (Attr Text FormId)) =>
[(a, lbl)]
-> (a -> Bool) -> Form m input error [XMLGenT x (XMLType x)] () [a]
inputCheckboxes [(a, lbl)]
choices a -> Bool
isChecked =
[(a, lbl)]
-> (FormId
-> [(FormId, Int, lbl, Bool)] -> [XMLGenT x (XMLType x)])
-> (a -> Bool)
-> Form m input error [XMLGenT x (XMLType x)] () [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)] -> [XMLGenT x (XMLType x)]
forall {t :: * -> *} {a} {m :: * -> *} {a} {a} {c}.
(Foldable t, Show a, EmbedAsAttr m (Attr Text a),
EmbedAsAttr m (Attr Text a), EmbedAsAttr m (Attr Text Text),
EmbedAsChild m c, StringType m ~ Text) =>
a -> t (a, a, c, Bool) -> [XMLGenT m (XMLType m)]
mkCheckboxes a -> Bool
isChecked
where
mkCheckboxes :: a -> t (a, a, c, Bool) -> [XMLGenT m (XMLType m)]
mkCheckboxes a
nm t (a, a, c, Bool)
choices' = ((a, a, c, Bool) -> [XMLGenT m (XMLType m)])
-> t (a, a, c, Bool) -> [XMLGenT m (XMLType m)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (a -> (a, a, c, Bool) -> [XMLGenT m (XMLType m)]
forall {a} {m :: * -> *} {a} {a} {c}.
(Show a, EmbedAsAttr m (Attr Text a), EmbedAsAttr m (Attr Text a),
EmbedAsAttr m (Attr Text Text), EmbedAsChild m c,
StringType m ~ Text) =>
a -> (a, a, c, Bool) -> [XMLGenT m (XMLType m)]
mkCheckbox a
nm) t (a, a, c, Bool)
choices'
mkCheckbox :: a -> (a, a, c, Bool) -> [XMLGenT m (XMLType m)]
mkCheckbox a
nm (a
i, a
val, c
lbl, Bool
checked) = [hsx|
[ <input type="checkbox" id=i name=nm value=(pack $ show val) (if checked then [("checked" := "checked") :: Attr Text Text] else []) />
, <label for=i><% lbl %></label>
] |]
inputRadio :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, XMLGenerator x, StringType x ~ Text, EmbedAsChild x lbl, EmbedAsAttr x (Attr Text FormId)) =>
[(a, lbl)]
-> (a -> Bool)
-> Form m input error [XMLGenT x (XMLType x)] () a
inputRadio :: forall (m :: * -> *) error input (x :: * -> *) lbl a.
(Functor m, Monad m, FormError error, ErrorInputType error ~ input,
FormInput input, XMLGenerator x, StringType x ~ Text,
EmbedAsChild x lbl, EmbedAsAttr x (Attr Text FormId)) =>
[(a, lbl)]
-> (a -> Bool) -> Form m input error [XMLGenT x (XMLType x)] () a
inputRadio [(a, lbl)]
choices a -> Bool
isDefault =
(a -> Bool)
-> [(a, lbl)]
-> (FormId
-> [(FormId, Int, lbl, Bool)] -> [XMLGenT x (XMLType x)])
-> Form m input error [XMLGenT x (XMLType x)] () 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)] -> [XMLGenT x (XMLType x)]
forall {t :: * -> *} {a} {m :: * -> *} {a} {a} {c}.
(Foldable t, Show a, EmbedAsAttr m (Attr Text a),
EmbedAsAttr m (Attr Text a), EmbedAsAttr m (Attr Text Text),
EmbedAsChild m c, StringType m ~ Text) =>
a -> t (a, a, c, Bool) -> [XMLGenT m (XMLType m)]
mkRadios
where
mkRadios :: a -> t (a, a, c, Bool) -> [XMLGenT m (XMLType m)]
mkRadios a
nm t (a, a, c, Bool)
choices' = ((a, a, c, Bool) -> [XMLGenT m (XMLType m)])
-> t (a, a, c, Bool) -> [XMLGenT m (XMLType m)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (a -> (a, a, c, Bool) -> [XMLGenT m (XMLType m)]
forall {a} {m :: * -> *} {a} {a} {c}.
(Show a, EmbedAsAttr m (Attr Text a), EmbedAsAttr m (Attr Text a),
EmbedAsAttr m (Attr Text Text), EmbedAsChild m c,
StringType m ~ Text) =>
a -> (a, a, c, Bool) -> [XMLGenT m (XMLType m)]
mkRadio a
nm) t (a, a, c, Bool)
choices'
mkRadio :: a -> (a, a, c, Bool) -> [XMLGenT m (XMLType m)]
mkRadio a
nm (a
i, a
val, c
lbl, Bool
checked) = [hsx|
[ <input type="radio" id=i name=nm value=(pack $ show val) (if checked then [("checked" := "checked") :: Attr Text Text] else []) />
, <label for=i><% lbl %></label>
, <br />
] |]
inputRadioForms :: forall m x error input lbl proof a. (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, XMLGenerator x, StringType x ~ Text, EmbedAsChild x lbl, EmbedAsAttr x (Attr Text FormId)) =>
[(Form m input error [XMLGenT x (XMLType x)] proof a, lbl)]
-> a
-> Form m input error [XMLGenT x (XMLType x)] proof a
inputRadioForms :: forall (m :: * -> *) (x :: * -> *) error input lbl proof a.
(Functor m, Monad m, FormError error, ErrorInputType error ~ input,
FormInput input, XMLGenerator x, StringType x ~ Text,
EmbedAsChild x lbl, EmbedAsAttr x (Attr Text FormId)) =>
[(Form m input error [XMLGenT x (XMLType x)] proof a, lbl)]
-> a -> Form m input error [XMLGenT x (XMLType x)] proof a
inputRadioForms [(Form m input error [XMLGenT x (XMLType x)] proof a, lbl)]
choices a
def =
(FormId -> FormId -> [FormId] -> Text)
-> [(Form m input error [XMLGenT x (XMLType x)] proof a, lbl)]
-> a
-> Form m input error [XMLGenT x (XMLType x)] proof a
forall (m :: * -> *) (x :: * -> *) error input lbl proof a.
(Functor m, Monad m, FormError error, ErrorInputType error ~ input,
FormInput input, XMLGenerator x, StringType x ~ Text,
EmbedAsChild x lbl, EmbedAsAttr x (Attr Text FormId)) =>
(FormId -> FormId -> [FormId] -> Text)
-> [(Form m input error [XMLGenT x (XMLType x)] proof a, lbl)]
-> a
-> Form m input error [XMLGenT x (XMLType x)] proof a
inputRadioForms' FormId -> FormId -> [FormId] -> Text
onclick [(Form m input error [XMLGenT x (XMLType x)] proof a, lbl)]
choices a
def
where
formIdsJS :: [FormId] -> Text
formIdsJS :: [FormId] -> Text
formIdsJS [] = Text
"[]"
formIdsJS [FormId]
ids =
Text
"['" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"', '" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (FormId -> String) -> [FormId] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map FormId -> String
forall a. Show a => a -> String
show [FormId]
ids) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"']"
onclick :: FormId -> FormId -> [FormId] -> Text
onclick :: FormId -> FormId -> [FormId] -> Text
onclick FormId
nm FormId
iview [FormId]
iviews = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
[ Text
"var views = " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [FormId] -> Text
formIdsJS [FormId]
iviews Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";"
, Text
"var iview = '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ FormId -> String
forall a. Show a => a -> String
show FormId
iview) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"';"
, Text
"for (var i = 0; i < views.length; i++) {"
, Text
" if (iview == views[i]) {"
, Text
" document.getElementById(iview).style.display='block';"
, Text
" } else {"
, Text
" document.getElementById(views[i]).style.display='none';"
, Text
" }"
, Text
"}"
]
inputRadioForms' :: forall m x error input lbl proof a. (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, XMLGenerator x, StringType x ~ Text, EmbedAsChild x lbl, EmbedAsAttr x (Attr Text FormId)) =>
(FormId -> FormId -> [FormId] -> Text)
-> [(Form m input error [XMLGenT x (XMLType x)] proof a, lbl)]
-> a
-> Form m input error [XMLGenT x (XMLType x)] proof a
inputRadioForms' :: forall (m :: * -> *) (x :: * -> *) error input lbl proof a.
(Functor m, Monad m, FormError error, ErrorInputType error ~ input,
FormInput input, XMLGenerator x, StringType x ~ Text,
EmbedAsChild x lbl, EmbedAsAttr x (Attr Text FormId)) =>
(FormId -> FormId -> [FormId] -> Text)
-> [(Form m input error [XMLGenT x (XMLType x)] proof a, lbl)]
-> a
-> Form m input error [XMLGenT x (XMLType x)] proof a
inputRadioForms' FormId -> FormId -> [FormId] -> Text
onclick [(Form m input error [XMLGenT x (XMLType x)] proof a, lbl)]
choices a
def =
a
-> [(Form m input error [XMLGenT x (XMLType x)] proof a, lbl)]
-> (FormId
-> [(FormId, Int, FormId, [XMLGenT x (XMLType x)], lbl, Bool)]
-> [XMLGenT x (XMLType x)])
-> Form m input error [XMLGenT x (XMLType x)] proof a
forall a (m :: * -> *) error input lbl view proof.
(Functor m, Monad m, FormError error, ErrorInputType error ~ input,
FormInput input) =>
a
-> [(Form m input error view proof a, lbl)]
-> (FormId -> [(FormId, Int, FormId, view, lbl, Bool)] -> view)
-> Form m input error view proof a
G.inputChoiceForms a
def [(Form m input error [XMLGenT x (XMLType x)] proof a, lbl)]
choices FormId
-> [(FormId, Int, FormId, [XMLGenT x (XMLType x)], lbl, Bool)]
-> [XMLGenT x (XMLType x)]
mkRadios
where
iviewsExtract :: [(FormId, Int, FormId, [XMLGenT x (XMLType x)], lbl, Bool)] -> [FormId]
iviewsExtract :: [(FormId, Int, FormId, [XMLGenT x (XMLType x)], lbl, Bool)]
-> [FormId]
iviewsExtract = ((FormId, Int, FormId, [XMLGenT x (XMLType x)], lbl, Bool)
-> FormId)
-> [(FormId, Int, FormId, [XMLGenT x (XMLType x)], lbl, Bool)]
-> [FormId]
forall a b. (a -> b) -> [a] -> [b]
map (\(FormId
_,Int
_, FormId
iv, [XMLGenT x (XMLType x)]
_, lbl
_, Bool
_) -> FormId
iv)
mkRadios :: FormId -> [(FormId, Int, FormId, [XMLGenT x (XMLType x)], lbl, Bool)] -> [XMLGenT x (XMLType x)]
mkRadios :: FormId
-> [(FormId, Int, FormId, [XMLGenT x (XMLType x)], lbl, Bool)]
-> [XMLGenT x (XMLType x)]
mkRadios FormId
nm [(FormId, Int, FormId, [XMLGenT x (XMLType x)], lbl, Bool)]
choices' =
let iviews :: [FormId]
iviews = [(FormId, Int, FormId, [XMLGenT x (XMLType x)], lbl, Bool)]
-> [FormId]
iviewsExtract [(FormId, Int, FormId, [XMLGenT x (XMLType x)], lbl, Bool)]
choices' in
(((FormId, Int, FormId, [XMLGenT x (XMLType x)], lbl, Bool)
-> [XMLGenT x (XMLType x)])
-> [(FormId, Int, FormId, [XMLGenT x (XMLType x)], lbl, Bool)]
-> [XMLGenT x (XMLType x)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (FormId
-> [FormId]
-> (FormId, Int, FormId, [XMLGenT x (XMLType x)], lbl, Bool)
-> [XMLGenT x (XMLType x)]
mkRadio FormId
nm [FormId]
iviews) [(FormId, Int, FormId, [XMLGenT x (XMLType x)], lbl, Bool)]
choices')
mkRadio :: FormId
-> [FormId]
-> (FormId, Int, FormId, [XMLGenT x (XMLType x)], lbl, Bool)
-> [XMLGenT x (XMLType x)]
mkRadio FormId
nm [FormId]
iviews (FormId
i, Int
val, FormId
iview, [XMLGenT x (XMLType x)]
view, lbl
lbl, Bool
checked) = [hsx|
[ <div>
<input type="radio" onclick=(onclick nm iview iviews) id=i name=nm value=(pack $ show val) (if checked then [("checked" := "checked") :: Attr Text Text] else []) />
<label for=i><% lbl %></label>
<div id=iview (if checked then [] else [("style" := "display:none;") :: Attr Text Text])><% view %></div>
</div>
] |]
select :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, XMLGenerator x, StringType x ~ Text, EmbedAsChild x lbl, EmbedAsAttr x (Attr Text FormId)) =>
[(a, lbl)]
-> (a -> Bool)
-> Form m input error [XMLGenT x (XMLType x)] () a
select :: forall (m :: * -> *) error input (x :: * -> *) lbl a.
(Functor m, Monad m, FormError error, ErrorInputType error ~ input,
FormInput input, XMLGenerator x, StringType x ~ Text,
EmbedAsChild x lbl, EmbedAsAttr x (Attr Text FormId)) =>
[(a, lbl)]
-> (a -> Bool) -> Form m input error [XMLGenT x (XMLType x)] () a
select [(a, lbl)]
choices a -> Bool
isDefault =
(a -> Bool)
-> [(a, lbl)]
-> (FormId
-> [(FormId, Int, lbl, Bool)] -> [XMLGenT x (XMLType x)])
-> Form m input error [XMLGenT x (XMLType x)] () 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)] -> [XMLGenT x (XMLType x)]
forall {m :: * -> *} {t :: * -> *} {a} {a} {c} {a}.
(Traversable t, EmbedAsAttr m (Attr Text a),
EmbedAsAttr m (Attr Text a), EmbedAsAttr m (Attr Text Text),
EmbedAsChild m c, EmbedAsChild m (t (XMLType m)),
StringType m ~ Text) =>
a -> t (a, a, c, Bool) -> [XMLGenT m (XMLType m)]
mkSelect
where
mkSelect :: a -> t (a, a, c, Bool) -> [XMLGenT m (XMLType m)]
mkSelect a
nm t (a, a, c, Bool)
choices' = [hsx|
[<select name=nm>
<% mapM mkOption choices' %>
</select>
] |]
mkOption :: (a, a, c, Bool) -> XMLGenT m (XMLType m)
mkOption (a
_, a
val, c
lbl, Bool
selected) = [hsx|
<option value=val (if selected then [("selected" := "selected") :: Attr Text Text] else []) >
<% lbl %>
</option> |]
selectMultiple :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, XMLGenerator x, StringType x ~ Text, EmbedAsChild x lbl, EmbedAsAttr x (Attr Text FormId)) =>
[(a, lbl)]
-> (a -> Bool)
-> Form m input error [XMLGenT x (XMLType x)] () [a]
selectMultiple :: forall (m :: * -> *) error input (x :: * -> *) lbl a.
(Functor m, Monad m, FormError error, ErrorInputType error ~ input,
FormInput input, XMLGenerator x, StringType x ~ Text,
EmbedAsChild x lbl, EmbedAsAttr x (Attr Text FormId)) =>
[(a, lbl)]
-> (a -> Bool) -> Form m input error [XMLGenT x (XMLType x)] () [a]
selectMultiple [(a, lbl)]
choices a -> Bool
isSelected =
[(a, lbl)]
-> (FormId
-> [(FormId, Int, lbl, Bool)] -> [XMLGenT x (XMLType x)])
-> (a -> Bool)
-> Form m input error [XMLGenT x (XMLType x)] () [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)] -> [XMLGenT x (XMLType x)]
forall {m :: * -> *} {t :: * -> *} {a} {a} {c} {a}.
(Traversable t, EmbedAsAttr m (Attr Text a),
EmbedAsAttr m (Attr Text a), EmbedAsAttr m (Attr Text Text),
EmbedAsChild m c, EmbedAsChild m (t (XMLType m)),
StringType m ~ Text) =>
a -> t (a, a, c, Bool) -> [XMLGenT m (XMLType m)]
mkSelect a -> Bool
isSelected
where
mkSelect :: a -> t (a, a, c, Bool) -> [XMLGenT m (XMLType m)]
mkSelect a
nm t (a, a, c, Bool)
choices' = [hsx|
[<select name=nm multiple="multiple">
<% mapM mkOption choices' %>
</select>
] |]
mkOption :: (a, a, c, Bool) -> XMLGenT m (XMLType m)
mkOption (a
_, a
val, c
lbl, Bool
selected) = [hsx|
<option value=val (if selected then [("selected" := "selected") :: Attr Text Text] else [])>
<% lbl %>
</option> |]
errorList :: (Monad m, XMLGenerator x, StringType x ~ Text, EmbedAsChild x error) =>
Form m input error [XMLGenT x (XMLType x)] () ()
errorList :: forall (m :: * -> *) (x :: * -> *) error input.
(Monad m, XMLGenerator x, StringType x ~ Text,
EmbedAsChild x error) =>
Form m input error [XMLGenT x (XMLType x)] () ()
errorList = ([error] -> [XMLGenT x (XMLType x)])
-> Form m input error [XMLGenT x (XMLType x)] () ()
forall (m :: * -> *) error view input.
Monad m =>
([error] -> view) -> Form m input error view () ()
G.errors [error] -> [XMLGenT x (XMLType x)]
forall {m :: * -> *} {a}.
(EmbedAsAttr m (Attr Text Text), EmbedAsChild m (XMLType m),
EmbedAsChild m a, StringType m ~ Text) =>
[a] -> [XMLGenT m (XMLType m)]
mkErrors
where
mkErrors :: [a] -> [XMLGenT m (XMLType m)]
mkErrors [] = []
mkErrors [a]
errs = [hsx| [<ul class="reform-error-list"><% mapM mkError errs %></ul>] |]
mkError :: c -> XMLGenT m (XMLType m)
mkError c
e = [hsx| <li><% e %></li> |]
childErrorList :: (Monad m, XMLGenerator x, StringType x ~ Text, EmbedAsChild x error) =>
Form m input error [XMLGenT x (XMLType x)] () ()
childErrorList :: forall (m :: * -> *) (x :: * -> *) error input.
(Monad m, XMLGenerator x, StringType x ~ Text,
EmbedAsChild x error) =>
Form m input error [XMLGenT x (XMLType x)] () ()
childErrorList = ([error] -> [XMLGenT x (XMLType x)])
-> Form m input error [XMLGenT x (XMLType x)] () ()
forall (m :: * -> *) error view input.
Monad m =>
([error] -> view) -> Form m input error view () ()
G.childErrors [error] -> [XMLGenT x (XMLType x)]
forall {m :: * -> *} {a}.
(EmbedAsAttr m (Attr Text Text), EmbedAsChild m (XMLType m),
EmbedAsChild m a, StringType m ~ Text) =>
[a] -> [XMLGenT m (XMLType m)]
mkErrors
where
mkErrors :: [a] -> [XMLGenT m (XMLType m)]
mkErrors [] = []
mkErrors [a]
errs = [hsx| [<ul class="reform-error-list"><% mapM mkError errs %></ul>] |]
mkError :: c -> XMLGenT m (XMLType m)
mkError c
e = [hsx| <li><% e %></li> |]
br :: (Monad m, XMLGenerator x, StringType x ~ Text) => Form m input error [XMLGenT x (XMLType x)] () ()
br :: forall (m :: * -> *) (x :: * -> *) input error.
(Monad m, XMLGenerator x, StringType x ~ Text) =>
Form m input error [XMLGenT x (XMLType x)] () ()
br = [XMLGenT x (XMLType x)]
-> Form m input error [XMLGenT x (XMLType x)] () ()
forall (m :: * -> *) view input error.
Monad m =>
view -> Form m input error view () ()
view [hsx| [<br />] |]
fieldset :: (Monad m, Functor m, XMLGenerator x, StringType x ~ Text, EmbedAsChild x c) =>
Form m input error c proof a
-> Form m input error [XMLGenT x (XMLType x)] proof a
fieldset :: forall (m :: * -> *) (x :: * -> *) c input error proof a.
(Monad m, Functor m, XMLGenerator x, StringType x ~ Text,
EmbedAsChild x c) =>
Form m input error c proof a
-> Form m input error [XMLGenT x (XMLType x)] proof a
fieldset Form m input error c proof a
frm = (c -> [XMLGenT x (XMLType x)])
-> Form m input error c proof a
-> Form m input error [XMLGenT x (XMLType x)] 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 (\c
xml -> [hsx| [<fieldset class="reform"><% xml %></fieldset>] |]) Form m input error c proof a
frm
ol :: (Monad m, Functor m, XMLGenerator x, StringType x ~ Text, EmbedAsChild x c) =>
Form m input error c proof a
-> Form m input error [XMLGenT x (XMLType x)] proof a
ol :: forall (m :: * -> *) (x :: * -> *) c input error proof a.
(Monad m, Functor m, XMLGenerator x, StringType x ~ Text,
EmbedAsChild x c) =>
Form m input error c proof a
-> Form m input error [XMLGenT x (XMLType x)] proof a
ol Form m input error c proof a
frm = (c -> [XMLGenT x (XMLType x)])
-> Form m input error c proof a
-> Form m input error [XMLGenT x (XMLType x)] 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 (\c
xml -> [hsx| [<ol class="reform"><% xml %></ol>] |]) Form m input error c proof a
frm
ul :: (Monad m, Functor m, XMLGenerator x, StringType x ~ Text, EmbedAsChild x c) =>
Form m input error c proof a
-> Form m input error [XMLGenT x (XMLType x)] proof a
ul :: forall (m :: * -> *) (x :: * -> *) c input error proof a.
(Monad m, Functor m, XMLGenerator x, StringType x ~ Text,
EmbedAsChild x c) =>
Form m input error c proof a
-> Form m input error [XMLGenT x (XMLType x)] proof a
ul Form m input error c proof a
frm = (c -> [XMLGenT x (XMLType x)])
-> Form m input error c proof a
-> Form m input error [XMLGenT x (XMLType x)] 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 (\c
xml -> [hsx| [<ul class="reform"><% xml %></ul>] |]) Form m input error c proof a
frm
li :: (Monad m, Functor m, XMLGenerator x, StringType x ~ Text, EmbedAsChild x c) =>
Form m input error c proof a
-> Form m input error [XMLGenT x (XMLType x)] proof a
li :: forall (m :: * -> *) (x :: * -> *) c input error proof a.
(Monad m, Functor m, XMLGenerator x, StringType x ~ Text,
EmbedAsChild x c) =>
Form m input error c proof a
-> Form m input error [XMLGenT x (XMLType x)] proof a
li Form m input error c proof a
frm = (c -> [XMLGenT x (XMLType x)])
-> Form m input error c proof a
-> Form m input error [XMLGenT x (XMLType x)] 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 (\c
xml -> [hsx| [<li class="reform"><% xml %></li>] |]) Form m input error c proof a
frm
form :: (XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text action)) =>
action
-> [(Text,Text)]
-> [XMLGenT x (XMLType x)]
-> [XMLGenT x (XMLType x)]
form :: forall (x :: * -> *) action.
(XMLGenerator x, StringType x ~ Text,
EmbedAsAttr x (Attr Text action)) =>
action
-> [(Text, Text)]
-> [XMLGenT x (XMLType x)]
-> [XMLGenT x (XMLType x)]
form action
action [(Text, Text)]
hidden [XMLGenT x (XMLType x)]
children
= [hsx|
[ <form action=action method="POST" enctype="multipart/form-data">
<% mapM mkHidden hidden %>
<% children %>
</form>
] |]
where
mkHidden :: (a, a) -> XMLGenT m (XMLType m)
mkHidden (a
name, a
value) =
[hsx| <input type="hidden" name=name value=value /> |]
setAttrs :: (EmbedAsAttr x attr, XMLGenerator x, StringType x ~ Text, Monad m, Functor m) =>
Form m input error [GenXML x] proof a
-> attr
-> Form m input error [GenXML x] proof a
setAttrs :: forall (x :: * -> *) attr (m :: * -> *) input error proof a.
(EmbedAsAttr x attr, XMLGenerator x, StringType x ~ Text, Monad m,
Functor m) =>
Form m input error [GenXML x] proof a
-> attr -> Form m input error [GenXML x] proof a
setAttrs Form m input error [XMLGenT x (XMLType x)] proof a
form attr
attrs = ([XMLGenT x (XMLType x)] -> [XMLGenT x (XMLType x)])
-> Form m input error [XMLGenT x (XMLType x)] proof a
-> Form m input error [XMLGenT x (XMLType x)] 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 ((XMLGenT x (XMLType x) -> XMLGenT x (XMLType x))
-> [XMLGenT x (XMLType x)] -> [XMLGenT x (XMLType x)]
forall a b. (a -> b) -> [a] -> [b]
map (XMLGenT x (XMLType x) -> attr -> XMLGenT x (XMLType x)
forall (m :: * -> *) elem attr.
(SetAttr m elem, EmbedAsAttr m attr) =>
elem -> attr -> GenXML m
`set` attr
attrs)) Form m input error [XMLGenT x (XMLType x)] proof a
form