{-# 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 (n :: Text
n := v :: 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 :: (input -> Either error text)
-> text -> Form m input error [XMLGenT x (XMLType x)] () text
inputText getInput :: input -> Either error text
getInput initialValue :: 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 i :: a
i a :: 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 :: (input -> Either error text)
-> text -> Form m input error [XMLGenT x (XMLType x)] () text
inputEmail getInput :: input -> Either error text
getInput initialValue :: 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 i :: a
i a :: 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 :: (input -> Either error text)
-> text -> Form m input error [XMLGenT x (XMLType x)] () text
inputPassword getInput :: input -> Either error text
getInput initialValue :: 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 i :: a
i a :: 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 :: (input -> Either error text)
-> text
-> Form m input error [XMLGenT x (XMLType x)] () (Maybe text)
inputSubmit getInput :: input -> Either error text
getInput initialValue :: 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 i :: a
i a :: 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 :: text -> Form m input error [XMLGenT x (XMLType x)] () ()
inputReset lbl :: 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 i :: a
i a :: 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 :: (input -> Either error text)
-> text -> Form m input error [XMLGenT x (XMLType x)] () text
inputHidden getInput :: input -> Either error text
getInput initialValue :: 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 i :: a
i a :: 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 :: text -> Form m input error [XMLGenT x (XMLType x)] () ()
inputButton label :: 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 i :: a
i a :: 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    -- ^ cols
         -> Int    -- ^ rows
         -> text   -- ^ initial text
         -> Form m input error [XMLGenT x (XMLType x)] () text
textarea :: (input -> Either error text)
-> Int
-> Int
-> text
-> Form m input error [XMLGenT x (XMLType x)] () text
textarea getInput :: input -> Either error text
getInput cols :: Int
cols rows :: Int
rows initialValue :: 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 i :: FormId
i txt :: text
txt = [hsx| [<textarea rows=rows cols=cols id=i name=i><% txt %></textarea>] |]

-- | 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, XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId)) =>
             Form m input error [XMLGenT x (XMLType x)] () (FileType input)
inputFile :: 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 i :: a
i = [hsx| [<input type="file" name=i id=i />] |]

-- | Create a @\<button type=\"submit\"\>@ element
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 :: (input -> Either error text)
-> text
-> children
-> Form m input error [XMLGenT x (XMLType x)] () (Maybe text)
buttonSubmit getInput :: input -> Either error text
getInput text :: text
text c :: 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 i :: FormId
i a :: 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 :: children -> Form m input error [XMLGenT x (XMLType x)] () ()
buttonReset c :: 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 i :: FormId
i a :: 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 :: children -> Form m input error [XMLGenT x (XMLType x)] () ()
button c :: 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 i :: FormId
i a :: 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 :: c -> Form m input error [XMLGenT x (XMLType x)] () ()
label c :: 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 i :: FormId
i = [hsx| [<label for=i><% c %></label>] |]

-- FIXME: should this use inputMaybe?
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  -- ^ initially checked
                -> Form m input error [XMLGenT x (XMLType x)] () Bool
inputCheckbox :: Bool -> Form m input error [XMLGenT x (XMLType x)] () Bool
inputCheckbox initiallyChecked :: 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
           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
           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 -- checkboxes only appear in the submitted data when checked
           (Found input :: 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 _) -> 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 i :: FormId
i checked :: 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)]  -- ^ value, label, initially checked
                -> (a -> Bool) -- ^ function which indicates if a value should be checked initially
                -> Form m input error [XMLGenT x (XMLType x)] () [a]
inputCheckboxes :: [(a, lbl)]
-> (a -> Bool) -> Form m input error [XMLGenT x (XMLType x)] () [a]
inputCheckboxes choices :: [(a, lbl)]
choices isChecked :: 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 nm :: a
nm choices' :: 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 nm :: a
nm (i :: a
i, val :: a
val, lbl :: c
lbl, checked :: 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)]  -- ^ value, label, initially checked
           -> (a -> Bool) -- ^ isDefault
           -> Form m input error [XMLGenT x (XMLType x)] () a
inputRadio :: [(a, lbl)]
-> (a -> Bool) -> Form m input error [XMLGenT x (XMLType x)] () a
inputRadio choices :: [(a, lbl)]
choices isDefault :: 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 nm :: a
nm choices' :: 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 nm :: a
nm (i :: a
i, val :: a
val, lbl :: c
lbl, checked :: 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)]  -- ^ value, label, initially checked
                 -> a -- ^ default
                 -> Form m input error [XMLGenT x (XMLType x)] proof a
inputRadioForms :: [(Form m input error [XMLGenT x (XMLType x)] proof a, lbl)]
-> a -> Form m input error [XMLGenT x (XMLType x)] proof a
inputRadioForms choices :: [(Form m input error [XMLGenT x (XMLType x)] proof a, lbl)]
choices def :: 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 [] = "[]"
      formIdsJS ids :: [FormId]
ids =
          "['" 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
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
<> "']"

      onclick :: FormId -> FormId -> [FormId] -> Text
      onclick :: FormId -> FormId -> [FormId] -> Text
onclick nm :: FormId
nm iview :: FormId
iview iviews :: [FormId]
iviews = [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                [ "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
<> ";"
                , "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
<> "';"
                , "for (var i = 0; i < views.length; i++) {"
                , "  if (iview == views[i]) {"
                , "    document.getElementById(iview).style.display='block';"
                , "  } else {"
                , "    document.getElementById(views[i]).style.display='none';"
                , "  }"
                , "}"
                ]

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)]  -- ^ value, label, initially checked
                 -> a -- ^ default
                 -> Form m input error [XMLGenT x (XMLType x)] proof a
inputRadioForms' :: (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' onclick :: FormId -> FormId -> [FormId] -> Text
onclick choices :: [(Form m input error [XMLGenT x (XMLType x)] proof a, lbl)]
choices def :: 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 (\(_,_, iv :: FormId
iv, _, _, _) -> 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 nm :: FormId
nm choices' :: [(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 nm :: FormId
nm iviews :: [FormId]
iviews (i :: FormId
i, val :: Int
val, iview :: FormId
iview, view :: [XMLGenT x (XMLType x)]
view, lbl :: lbl
lbl, checked :: 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)]  -- ^ value, label
           -> (a -> Bool) -- ^ isDefault, must match *exactly one* element in the list of choices
           -> Form m input error [XMLGenT x (XMLType x)] () a
select :: [(a, lbl)]
-> (a -> Bool) -> Form m input error [XMLGenT x (XMLType x)] () a
select choices :: [(a, lbl)]
choices isDefault :: 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 nm :: a
nm choices' :: t (a, a, c, Bool)
choices' = [hsx|
          [<select name=nm>
            <% mapM mkOption choices' %>
           </select>
          ] |]

      mkOption :: (a, a, c, Bool) -> XMLGenT m (XMLType m)
mkOption (_, val :: a
val, lbl :: c
lbl, selected :: 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)]  -- ^ value, label, initially checked
               -> (a -> Bool)  -- ^ isSelected initially
               -> Form m input error [XMLGenT x (XMLType x)] () [a]
selectMultiple :: [(a, lbl)]
-> (a -> Bool) -> Form m input error [XMLGenT x (XMLType x)] () [a]
selectMultiple choices :: [(a, lbl)]
choices isSelected :: 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 nm :: a
nm choices' :: 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 (_, val :: a
val, lbl :: c
lbl, selected :: Bool
selected) = [hsx|
          <option value=val (if selected then [("selected" := "selected") :: Attr Text Text] else [])>
           <% lbl %>
          </option> |]
{-
inputMultiSelectOptGroup :: (Functor m, XMLGenerator x, StringType x ~ Text, EmbedAsChild x groupLbl, EmbedAsChild x lbl, EmbedAsAttr x (Attr Text FormId), FormError error, ErrorInputType error ~ input, FormInput input, Monad m) =>
                   [(groupLbl, [(a, lbl, Bool)])]  -- ^ value, label, initially checked
                -> Form m input error [XMLGenT x (XMLType x)] () [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>
-}

errorList :: (Monad m, XMLGenerator x, StringType x ~ Text, EmbedAsChild x error) =>
             Form m input error [XMLGenT x (XMLType x)] () ()
errorList :: 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 :: * -> *) c.
(EmbedAsAttr m (Attr Text Text), EmbedAsChild m (XMLType m),
 EmbedAsChild m c, StringType m ~ Text) =>
[c] -> [XMLGenT m (XMLType m)]
mkErrors
    where
      mkErrors :: [c] -> [XMLGenT m (XMLType m)]
mkErrors []   = []
      mkErrors errs :: [c]
errs = [hsx| [<ul class="reform-error-list"><% mapM mkError errs %></ul>] |]
      mkError :: c -> XMLGenT m (XMLType m)
mkError e :: 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 :: 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 :: * -> *) c.
(EmbedAsAttr m (Attr Text Text), EmbedAsChild m (XMLType m),
 EmbedAsChild m c, StringType m ~ Text) =>
[c] -> [XMLGenT m (XMLType m)]
mkErrors
    where
      mkErrors :: [c] -> [XMLGenT m (XMLType m)]
mkErrors []   = []
      mkErrors errs :: [c]
errs = [hsx| [<ul class="reform-error-list"><% mapM mkError errs %></ul>] |]
      mkError :: c -> XMLGenT m (XMLType m)
mkError e :: c
e     = [hsx| <li><% e %></li> |]


br :: (Monad m, XMLGenerator x, StringType x ~ Text) => Form m input error [XMLGenT x (XMLType x)] () ()
br :: 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 :: Form m input error c proof a
-> Form m input error [XMLGenT x (XMLType x)] proof a
fieldset frm :: 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 (\xml :: 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 :: Form m input error c proof a
-> Form m input error [XMLGenT x (XMLType x)] proof a
ol frm :: 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 (\xml :: 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 :: Form m input error c proof a
-> Form m input error [XMLGenT x (XMLType x)] proof a
ul frm :: 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 (\xml :: 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 :: Form m input error c proof a
-> Form m input error [XMLGenT x (XMLType x)] proof a
li frm :: 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 (\xml :: c
xml -> [hsx| [<li class="reform"><% xml %></li>] |]) Form m input error c proof a
frm

-- | create @\<form action=action method=\"POST\" enctype=\"multipart/form-data\"\>@
form :: (XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text action)) =>
        action                  -- ^ action url
     -> [(Text,Text)]       -- ^ hidden fields to add to form
     -> [XMLGenT x (XMLType x)] -- ^ children
     -> [XMLGenT x (XMLType x)]
form :: action
-> [(Text, Text)]
-> [XMLGenT x (XMLType x)]
-> [XMLGenT x (XMLType x)]
form action :: action
action hidden :: [(Text, Text)]
hidden children :: [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 (name :: a
name, value :: 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 :: Form m input error [GenXML x] proof a
-> attr -> Form m input error [GenXML x] proof a
setAttrs form :: Form m input error [GenXML x] proof a
form attrs :: attr
attrs = ([GenXML x] -> [GenXML x])
-> Form m input error [GenXML x] proof a
-> Form m input error [GenXML 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 ((GenXML x -> GenXML x) -> [GenXML x] -> [GenXML x]
forall a b. (a -> b) -> [a] -> [b]
map (GenXML x -> attr -> GenXML x
forall (m :: * -> *) elem attr.
(SetAttr m elem, EmbedAsAttr m attr) =>
elem -> attr -> GenXML m
`set` attr
attrs)) Form m input error [GenXML x] proof a
form