{-# LANGUAGE QuasiQuotes, ScopedTypeVariables, TypeFamilies #-}

module Text.Reform.Hamlet.Common where

import Data.Text.Lazy (Text, pack)
import qualified Data.Text as T
import Text.Blaze (ToMarkup(..))
import Text.Reform.Backend
import Text.Reform.Core
import Text.Reform.Generalized as G
import Text.Reform.Result (FormId, Result(Ok), unitRange)
import Text.Hamlet (hamlet, HtmlUrl)

instance ToMarkup FormId where
    toMarkup :: FormId -> Markup
toMarkup FormId
fid = String -> Markup
forall a. ToMarkup a => a -> Markup
toMarkup (FormId -> String
forall a. Show a => a -> String
show FormId
fid)

inputText :: (FormError error, Monad m, ToMarkup text) => (input -> Either error text) -> text -> Form m input error (HtmlUrl url) () text
inputText :: (input -> Either error text)
-> text -> Form m input error (HtmlUrl url) () text
inputText input -> Either error text
getInput text
initialValue = (input -> Either error text)
-> (FormId -> text -> HtmlUrl url)
-> text
-> Form m input error (HtmlUrl url) () 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 -> HtmlUrl url
forall a a p. (ToMarkup a, ToMarkup a) => a -> a -> p -> Markup
inputField text
initialValue
    where
      inputField :: a -> a -> p -> Markup
inputField a
i a
a = [hamlet|<input type="text" id=#{i} name=#{i} value=#{a}>|]

inputPassword :: (Monad m, FormError error, ToMarkup text) =>
             (input -> Either error text)
          -> text
          -> Form m input error (HtmlUrl url) () text
inputPassword :: (input -> Either error text)
-> text -> Form m input error (HtmlUrl url) () text
inputPassword input -> Either error text
getInput text
initialValue = (input -> Either error text)
-> (FormId -> text -> HtmlUrl url)
-> text
-> Form m input error (HtmlUrl url) () 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 -> HtmlUrl url
forall a a p. (ToMarkup a, ToMarkup a) => a -> a -> p -> Markup
inputField text
initialValue
    where
      inputField :: a -> a -> p -> Markup
inputField a
i a
a = [hamlet|<input type="password" id=#{i} name=#{i} value=#{a}>|]

inputSubmit :: (Monad m, FormError error, ToMarkup text) =>
             (input -> Either error text)
          -> text
          -> Form m input error (HtmlUrl url) () (Maybe text)
inputSubmit :: (input -> Either error text)
-> text -> Form m input error (HtmlUrl url) () (Maybe text)
inputSubmit input -> Either error text
getInput text
initialValue = (input -> Either error text)
-> (FormId -> text -> HtmlUrl url)
-> text
-> Form m input error (HtmlUrl url) () (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 -> HtmlUrl url
forall a a p. (ToMarkup a, ToMarkup a) => a -> a -> p -> Markup
inputField text
initialValue
    where
      inputField :: a -> a -> p -> Markup
inputField a
i a
a = [hamlet|<input type="submit" id=#{i} name=#{i} value=#{a}>|]

inputReset :: (Monad m, FormError error, ToMarkup text) =>
              text
           -> Form m input error (HtmlUrl url) () ()
inputReset :: text -> Form m input error (HtmlUrl url) () ()
inputReset text
lbl = (FormId -> text -> HtmlUrl url)
-> text -> Form m input error (HtmlUrl url) () ()
forall (m :: * -> *) a view input error.
Monad m =>
(FormId -> a -> view) -> a -> Form m input error view () ()
G.inputNoData FormId -> text -> HtmlUrl url
forall a a p. (ToMarkup a, ToMarkup a) => a -> a -> p -> Markup
inputField text
lbl
    where
      inputField :: a -> a -> p -> Markup
inputField a
i a
a = [hamlet|<input type="reset" id=#{i} name=#{i} value=#{a}>|]

inputHidden :: (Monad m, FormError error, ToMarkup text) =>
             (input -> Either error text)
          -> text
          -> Form m input error (HtmlUrl url) () text
inputHidden :: (input -> Either error text)
-> text -> Form m input error (HtmlUrl url) () text
inputHidden input -> Either error text
getInput text
initialValue = (input -> Either error text)
-> (FormId -> text -> HtmlUrl url)
-> text
-> Form m input error (HtmlUrl url) () 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 -> HtmlUrl url
forall a a p. (ToMarkup a, ToMarkup a) => a -> a -> p -> Markup
inputField text
initialValue
    where
      inputField :: a -> a -> p -> Markup
inputField a
i a
a = [hamlet|<input type="hidden" id=#{i} name=#{i} value=#{a}>|]

inputButton :: (Monad m, FormError error, ToMarkup text) =>
             text
          -> Form m input error (HtmlUrl url) () ()

inputButton :: text -> Form m input error (HtmlUrl url) () ()
inputButton text
label = (FormId -> text -> HtmlUrl url)
-> text -> Form m input error (HtmlUrl url) () ()
forall (m :: * -> *) a view input error.
Monad m =>
(FormId -> a -> view) -> a -> Form m input error view () ()
G.inputNoData FormId -> text -> HtmlUrl url
forall a a p. (ToMarkup a, ToMarkup a) => a -> a -> p -> Markup
inputField text
label
    where
      inputField :: a -> a -> p -> Markup
inputField a
i a
a = [hamlet|<input type="button" id=#{i} name=#{i} value=#{a}>|]

textarea :: (Monad m, FormError error, ToMarkup text) =>
            (input -> Either error text)
         -> Int    -- ^ cols
         -> Int    -- ^ rows
         -> text   -- ^ initial text
         -> Form m input error (HtmlUrl url) () text
textarea :: (input -> Either error text)
-> Int -> Int -> text -> Form m input error (HtmlUrl url) () text
textarea input -> Either error text
getInput Int
cols Int
rows text
initialValue = (input -> Either error text)
-> (FormId -> text -> HtmlUrl url)
-> text
-> Form m input error (HtmlUrl url) () 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 -> HtmlUrl url
textareaView text
initialValue
    where
      textareaView :: FormId -> text -> HtmlUrl url
textareaView FormId
i text
txt = [hamlet|<textarea rows=#{rows} cols=#{cols} id=#{i} name=#{i}>#{txt}|]

-- | Create an @\<input type=\"file\"\>@ element
--
-- This control may succeed even if the user does not actually select a file to upload. In that case the uploaded name will likely be "" and the file contents will be empty as well.
inputFile :: (Monad m, FormError error, FormInput input, ErrorInputType error ~ input) =>
             Form m input error (HtmlUrl url) () (FileType input)
inputFile :: Form m input error (HtmlUrl url) () (FileType input)
inputFile = (FormId -> HtmlUrl url)
-> Form m input error (HtmlUrl url) () (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 -> HtmlUrl url
forall a p. ToMarkup a => a -> p -> Markup
fileView
    where
      fileView :: a -> p -> Markup
fileView a
i = [hamlet|<input type="file" name=#{i} id=#{i}>|]

-- | Create a @\<button type=\"submit\"\>@ element
buttonSubmit :: (Monad m, FormError error, ToMarkup text, ToMarkup children) =>
                (input -> Either error text)
             -> text
             -> children
             -> Form m input error (HtmlUrl url) () (Maybe text)
buttonSubmit :: (input -> Either error text)
-> text
-> children
-> Form m input error (HtmlUrl url) () (Maybe text)
buttonSubmit input -> Either error text
getInput text
text children
c = (input -> Either error text)
-> (FormId -> text -> HtmlUrl url)
-> text
-> Form m input error (HtmlUrl url) () (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 -> HtmlUrl url
inputField text
text
    where
      inputField :: FormId -> text -> HtmlUrl url
inputField FormId
i text
a = [hamlet|<button type="submit" id=#{i} name=#{i} value=#{a}>#{c}|]

buttonReset :: (Monad m, FormError error, ToMarkup children) =>
               children
             -> Form m input error (HtmlUrl url) () ()
buttonReset :: children -> Form m input error (HtmlUrl url) () ()
buttonReset children
c = (FormId -> Maybe Any -> HtmlUrl url)
-> Maybe Any -> Form m input error (HtmlUrl url) () ()
forall (m :: * -> *) a view input error.
Monad m =>
(FormId -> a -> view) -> a -> Form m input error view () ()
G.inputNoData FormId -> Maybe Any -> HtmlUrl url
inputField Maybe Any
forall a. Maybe a
Nothing
    where
      inputField :: FormId -> Maybe Any -> HtmlUrl url
inputField FormId
i Maybe Any
a = [hamlet|<button type="reset" id=#{i} name=#{i}>#{c}|]

button :: (Monad m, FormError error, ToMarkup children) =>
               children
             -> Form m input error (HtmlUrl url) () ()
button :: children -> Form m input error (HtmlUrl url) () ()
button children
c = (FormId -> Maybe Any -> HtmlUrl url)
-> Maybe Any -> Form m input error (HtmlUrl url) () ()
forall (m :: * -> *) a view input error.
Monad m =>
(FormId -> a -> view) -> a -> Form m input error view () ()
G.inputNoData FormId -> Maybe Any -> HtmlUrl url
inputField Maybe Any
forall a. Maybe a
Nothing
    where
      inputField :: FormId -> Maybe Any -> HtmlUrl url
inputField FormId
i Maybe Any
a = [hamlet|<button type="button" id=#{i} name=#{i}>#{c}|]

label :: (Monad m, ToMarkup c) =>
         c
      -> Form m input error (HtmlUrl url) () ()
label :: c -> Form m input error (HtmlUrl url) () ()
label c
c = (FormId -> HtmlUrl url) -> Form m input error (HtmlUrl url) () ()
forall (m :: * -> *) view input error.
Monad m =>
(FormId -> view) -> Form m input error view () ()
G.label FormId -> HtmlUrl url
mkLabel
    where
      mkLabel :: FormId -> HtmlUrl url
mkLabel FormId
i = [hamlet|<label for=#{i}>#{c}|]

-- FIXME: should this use inputMaybe?
inputCheckbox :: forall x error input m url. (Monad m, FormInput input, FormError error, ErrorInputType error ~ input) =>
                   Bool  -- ^ initially checked
                -> Form m input error (HtmlUrl url) () Bool
inputCheckbox :: Bool -> Form m input error (HtmlUrl url) () Bool
inputCheckbox Bool
initiallyChecked =
    FormState
  m
  input
  (View error (HtmlUrl url), m (Result error (Proved () Bool)))
-> Form m input error (HtmlUrl url) () 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 (HtmlUrl url), m (Result error (Proved () Bool)))
 -> Form m input error (HtmlUrl url) () Bool)
-> FormState
     m
     input
     (View error (HtmlUrl url), m (Result error (Proved () Bool)))
-> Form m input error (HtmlUrl url) () 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 (HtmlUrl url), m (Result error (Proved () Bool)))
forall (m :: * -> *) (m :: * -> *) error p e.
(Monad m, Monad m) =>
FormId
-> Bool
-> m (View error (p -> Markup), m (Result e (Proved () Bool)))
mkCheckbox FormId
i Bool
initiallyChecked
           Value input
Missing   -> FormId
-> Bool
-> FormState
     m
     input
     (View error (HtmlUrl url), m (Result error (Proved () Bool)))
forall (m :: * -> *) (m :: * -> *) error p e.
(Monad m, Monad m) =>
FormId
-> Bool
-> m (View error (p -> Markup), 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 (HtmlUrl url), m (Result error (Proved () Bool)))
forall (m :: * -> *) (m :: * -> *) error p e.
(Monad m, Monad m) =>
FormId
-> Bool
-> m (View error (p -> Markup), m (Result e (Proved () Bool)))
mkCheckbox FormId
i Bool
True
                 (Left  (error
e :: error) ) -> FormId
-> Bool
-> FormState
     m
     input
     (View error (HtmlUrl url), m (Result error (Proved () Bool)))
forall (m :: * -> *) (m :: * -> *) error p e.
(Monad m, Monad m) =>
FormId
-> Bool
-> m (View error (p -> Markup), m (Result e (Proved () Bool)))
mkCheckbox FormId
i Bool
False
    where
      mkCheckbox :: FormId
-> Bool
-> m (View error (p -> Markup), m (Result e (Proved () Bool)))
mkCheckbox FormId
i Bool
checked =
          (View error (p -> Markup), m (Result e (Proved () Bool)))
-> m (View error (p -> Markup), m (Result e (Proved () Bool)))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(FormRange, error)] -> p -> Markup) -> View error (p -> Markup)
forall error v. ([(FormRange, error)] -> v) -> View error v
View (([(FormRange, error)] -> p -> Markup) -> View error (p -> Markup))
-> ([(FormRange, error)] -> p -> Markup)
-> View error (p -> Markup)
forall a b. (a -> b) -> a -> b
$ (p -> Markup) -> [(FormRange, error)] -> p -> Markup
forall a b. a -> b -> a
const ((p -> Markup) -> [(FormRange, error)] -> p -> Markup)
-> (p -> Markup) -> [(FormRange, error)] -> p -> Markup
forall a b. (a -> b) -> a -> b
$ [hamlet|
$if checked
  <input type="checkbox" id=#{i} name=#{i} value=#{i} checked="checked">
$else
  <input type="checkbox" id=#{i} name=#{i} value=#{i}>
|]
                 , 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, ToMarkup lbl) =>
                  [(a, lbl)]  -- ^ value, label, initially checked
                -> (a -> Bool) -- ^ function which indicates if a value should be checked initially
                -> Form m input error (HtmlUrl url) () [a]
inputCheckboxes :: [(a, lbl)]
-> (a -> Bool) -> Form m input error (HtmlUrl url) () [a]
inputCheckboxes [(a, lbl)]
choices a -> Bool
isChecked =
    [(a, lbl)]
-> (FormId -> [(FormId, Int, lbl, Bool)] -> HtmlUrl url)
-> (a -> Bool)
-> Form m input error (HtmlUrl url) () [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)] -> HtmlUrl url
forall (t :: * -> *) a a a a p.
(Foldable t, Show a, ToMarkup a, ToMarkup a, ToMarkup a) =>
a -> t (a, a, a, Bool) -> p -> Markup
mkCheckboxes a -> Bool
isChecked
    where
      mkCheckboxes :: a -> t (a, a, a, Bool) -> p -> Markup
mkCheckboxes a
nm t (a, a, a, Bool)
choices' = [hamlet|
$forall (i, val, lbl, checked) <- choices'
  $if checked
    <input type="checkbox" id=#{i} name=#{nm} value=#{show val} checked="checked">
  $else
    <input type="checkbox" id=#{i} name=#{nm} value=#{show val}>
  <label for=#{i}>#{lbl}
|]

inputRadio :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, ToMarkup lbl) =>
              [(a, lbl)]  -- ^ value, label, initially checked
           -> (a -> Bool) -- ^ isDefault
           -> Form m input error (HtmlUrl url) () a
inputRadio :: [(a, lbl)] -> (a -> Bool) -> Form m input error (HtmlUrl url) () a
inputRadio [(a, lbl)]
choices a -> Bool
isDefault =
    (a -> Bool)
-> [(a, lbl)]
-> (FormId -> [(FormId, Int, lbl, Bool)] -> HtmlUrl url)
-> Form m input error (HtmlUrl url) () 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)] -> HtmlUrl url
forall (t :: * -> *) a a a a p.
(Foldable t, Show a, ToMarkup a, ToMarkup a, ToMarkup a) =>
a -> t (a, a, a, Bool) -> p -> Markup
mkRadios
    where
      mkRadios :: a -> t (a, a, a, Bool) -> p -> Markup
mkRadios a
nm t (a, a, a, Bool)
choices' = [hamlet|
$forall (i, val, lbl, checked) <- choices'
  $if checked
    <input type="radio" id=#{i} name=#{nm} value=#{show val} checked="checked">
  $else
    <input type="radio" id=#{i} name=#{nm} value=#{show val}>
  <label for=#{i}>#{lbl}
  <br>
|]

select :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, ToMarkup lbl) =>
              [(a, lbl)]  -- ^ value, label
           -> (a -> Bool) -- ^ isDefault, must match *exactly one* element in the list of choices
           -> Form m input error (HtmlUrl url) () a
select :: [(a, lbl)] -> (a -> Bool) -> Form m input error (HtmlUrl url) () a
select [(a, lbl)]
choices a -> Bool
isDefault  =
    (a -> Bool)
-> [(a, lbl)]
-> (FormId -> [(FormId, Int, lbl, Bool)] -> HtmlUrl url)
-> Form m input error (HtmlUrl url) () 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)] -> HtmlUrl url
forall (t :: * -> *) a a a a p.
(Foldable t, ToMarkup a, ToMarkup a, ToMarkup a) =>
a -> t (a, a, a, Bool) -> p -> Markup
mkSelect
    where
      mkSelect :: a -> t (a, a, a, Bool) -> p -> Markup
mkSelect a
nm t (a, a, a, Bool)
choices' = [hamlet|
<select name=#{nm}>
  $forall (_, val, lbl, selected) <- choices'
    $if selected
      <option value=#{val} selected="selected">#{lbl}
    $else
      <option value=#{val}>#{lbl}
|]

selectMultiple :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, ToMarkup lbl) =>
                  [(a, lbl)]  -- ^ value, label, initially checked
               -> (a -> Bool)  -- ^ isSelected initially
               -> Form m input error (HtmlUrl url) () [a]
selectMultiple :: [(a, lbl)]
-> (a -> Bool) -> Form m input error (HtmlUrl url) () [a]
selectMultiple [(a, lbl)]
choices a -> Bool
isSelected =
    [(a, lbl)]
-> (FormId -> [(FormId, Int, lbl, Bool)] -> HtmlUrl url)
-> (a -> Bool)
-> Form m input error (HtmlUrl url) () [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)] -> HtmlUrl url
forall (t :: * -> *) a a a a p.
(Foldable t, ToMarkup a, ToMarkup a, ToMarkup a) =>
a -> t (a, a, a, Bool) -> p -> Markup
mkSelect a -> Bool
isSelected
    where
      mkSelect :: a -> t (a, a, a, Bool) -> p -> Markup
mkSelect a
nm t (a, a, a, Bool)
choices' = [hamlet|
<select name=#{nm} multiple="multiple">
  $forall (_, val, lbl, selected) <- choices'
    $if selected
      <option value=#{val} selected="selected">#{lbl}
    $else
      <option value=#{val}>#{lbl}
|]

errorList :: (Monad m, ToMarkup error) =>
             Form m input error (HtmlUrl url) () ()
errorList :: Form m input error (HtmlUrl url) () ()
errorList = ([error] -> HtmlUrl url) -> Form m input error (HtmlUrl url) () ()
forall (m :: * -> *) error view input.
Monad m =>
([error] -> view) -> Form m input error view () ()
G.errors [error] -> HtmlUrl url
forall a p. ToMarkup a => [a] -> p -> Markup
mkErrors
    where
      mkErrors :: [a] -> p -> Markup
mkErrors []   = [hamlet||]
      mkErrors [a]
errs = [hamlet|
<ul .reform-error-list>
  $forall e <- errs
    <li>#{e}
|]

childErrorList :: (Monad m, ToMarkup error) =>
             Form m input error (HtmlUrl url) () ()
childErrorList :: Form m input error (HtmlUrl url) () ()
childErrorList = ([error] -> HtmlUrl url) -> Form m input error (HtmlUrl url) () ()
forall (m :: * -> *) error view input.
Monad m =>
([error] -> view) -> Form m input error view () ()
G.childErrors [error] -> HtmlUrl url
forall a p. ToMarkup a => [a] -> p -> Markup
mkErrors
    where
      mkErrors :: [a] -> p -> Markup
mkErrors []   = [hamlet||]
      mkErrors [a]
errs = [hamlet|
<ul .reform-error-list>
  $forall e <- errs
    <li>#{e}
|]

br :: Monad m => Form m input error (HtmlUrl url) () ()
br :: Form m input error (HtmlUrl url) () ()
br = HtmlUrl url -> Form m input error (HtmlUrl url) () ()
forall (m :: * -> *) view input error.
Monad m =>
view -> Form m input error view () ()
view [hamlet|<br>|]

fieldset :: (Monad m, Functor m, ToMarkup c) =>
            Form m input error c proof a
         -> Form m input error (HtmlUrl url) proof a
fieldset :: Form m input error c proof a
-> Form m input error (HtmlUrl url) proof a
fieldset Form m input error c proof a
frm = (c -> HtmlUrl url)
-> Form m input error c proof a
-> Form m input error (HtmlUrl url) 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 -> [hamlet|<fieldset .reform>#{xml}|]) Form m input error c proof a
frm

ol :: (Monad m, Functor m, ToMarkup c) =>
      Form m input error c proof a
   -> Form m input error (HtmlUrl url) proof a
ol :: Form m input error c proof a
-> Form m input error (HtmlUrl url) proof a
ol Form m input error c proof a
frm = (c -> HtmlUrl url)
-> Form m input error c proof a
-> Form m input error (HtmlUrl url) 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 -> [hamlet|<ol .reform>#{xml}|]) Form m input error c proof a
frm

ul :: (Monad m, Functor m, ToMarkup c) =>
      Form m input error c proof a
   -> Form m input error (HtmlUrl url) proof a
ul :: Form m input error c proof a
-> Form m input error (HtmlUrl url) proof a
ul Form m input error c proof a
frm = (c -> HtmlUrl url)
-> Form m input error c proof a
-> Form m input error (HtmlUrl url) 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 -> [hamlet|<ul .reform>#{xml}|]) Form m input error c proof a
frm

li :: (Monad m, Functor m, ToMarkup c) =>
      Form m input error c proof a
   -> Form m input error (HtmlUrl url) proof a
li :: Form m input error c proof a
-> Form m input error (HtmlUrl url) proof a
li Form m input error c proof a
frm = (c -> HtmlUrl url)
-> Form m input error c proof a
-> Form m input error (HtmlUrl url) 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 -> [hamlet|<li .reform>#{xml}|]) Form m input error c proof a
frm

-- | create @\<form action=action method=\"POST\" enctype=\"multipart/form-data\"\>@
form :: ToMarkup action =>
        action              -- ^ action url
     -> [(Text,Text)]       -- ^ hidden fields to add to form
     -> HtmlUrl url         -- ^ children
     -> HtmlUrl url
form :: action -> [(Text, Text)] -> HtmlUrl url -> HtmlUrl url
form action
action [(Text, Text)]
hidden HtmlUrl url
children
    = [hamlet|
<form action=#{action} method="POST" enctype="multipart/form-data">
  $forall (name, value) <- hidden
    <input type="hidden" name=#{name} value=#{value}>
  ^{children}
|]