{-# 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    -- ^ cols
         -> Int    -- ^ rows
         -> text   -- ^ initial 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>] |]

-- | 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 :: 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 />] |]

-- | 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 :: 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>] |]

-- 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 :: 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 -- checkboxes only appear in the submitted data when checked
           (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)]  -- ^ 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 :: 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)]  -- ^ value, label, initially checked
           -> (a -> Bool) -- ^ isDefault
           -> 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)]  -- ^ value, label, initially checked
                 -> a -- ^ default
                 -> 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)]  -- ^ value, label, initially checked
                 -> a -- ^ default
                 -> 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)]  -- ^ 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 :: 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)]  -- ^ value, label, initially checked
               -> (a -> Bool)  -- ^ isSelected initially
               -> 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> |]
{-
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 :: 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

-- | 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 :: 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