reform-hamlet (empty) → 0.0
raw patch · 6 files changed
+827/−0 lines, 6 filesdep +basedep +blaze-markupdep +hamletsetup-changed
Dependencies added: base, blaze-markup, hamlet, reform, text
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- Text/Reform/Hamlet/Common.hs +262/−0
- Text/Reform/Hamlet/String.hs +242/−0
- Text/Reform/Hamlet/Text.hs +263/−0
- reform-hamlet.cabal +28/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2012, Jeremy Shaw++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Jeremy Shaw nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Text/Reform/Hamlet/Common.hs view
@@ -0,0 +1,262 @@+{-# 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 fid = toMarkup (show fid)++inputText :: (FormError error, Monad m, ToMarkup text) => (input -> Either error text) -> text -> Form m input error (HtmlUrl url) () text+inputText getInput initialValue = G.input getInput inputField initialValue+ where+ inputField i 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 getInput initialValue = G.input getInput inputField initialValue+ where+ inputField i 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 getInput initialValue = G.inputMaybe getInput inputField initialValue+ where+ inputField i 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 lbl = G.inputNoData inputField lbl+ where+ inputField i 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 getInput initialValue = G.input getInput inputField initialValue+ where+ inputField i 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 label = G.inputNoData inputField label+ where+ inputField i 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 getInput cols rows initialValue = G.input getInput textareaView initialValue+ where+ textareaView i 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 = G.inputFile fileView+ where+ fileView 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 getInput text c = G.inputMaybe getInput inputField text+ where+ inputField i 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 c = G.inputNoData inputField Nothing+ where+ inputField i 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 c = G.inputNoData inputField Nothing+ where+ inputField i a = [hamlet|<button type="button" id=#{i} name=#{i}>#{c}|]++label :: (Monad m, ToMarkup c) =>+ c+ -> Form m input error (HtmlUrl url) () ()+label c = G.label mkLabel+ where+ mkLabel 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 initiallyChecked =+ Form $+ do i <- getFormId+ v <- getFormInput' i+ case v of+ Default -> mkCheckbox i initiallyChecked+ Missing -> mkCheckbox i False -- checkboxes only appear in the submitted data when checked+ (Found input) ->+ case getInputText input of+ (Right _) -> mkCheckbox i True+ (Left (e :: error) ) -> mkCheckbox i False+ where+ mkCheckbox i checked =+ return ( View $ const $ [hamlet|+$if checked+ <input type="checkbox" id=#{i} name=#{i} value=#{i} checked="checked">+$else+ <input type="checkbox" id=#{i} name=#{i} value=#{i}>+|]+ , return $ Ok (Proved { proofs = ()+ , pos = unitRange i+ , unProved = if checked then True else 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 choices isChecked =+ G.inputMulti choices mkCheckboxes isChecked+ where+ mkCheckboxes nm 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 choices isDefault =+ G.inputChoice isDefault choices mkRadios+ where+ mkRadios nm 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 choices isDefault =+ G.inputChoice isDefault choices mkSelect+ where+ mkSelect nm 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 choices isSelected =+ G.inputMulti choices mkSelect isSelected+ where+ mkSelect nm 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 = G.errors mkErrors+ where+ mkErrors [] = [hamlet||]+ mkErrors errs = [hamlet|+<ul .reform-error-list>+ $forall e <- errs+ <li>#{e}+|]++childErrorList :: (Monad m, ToMarkup error) =>+ Form m input error (HtmlUrl url) () ()+childErrorList = G.childErrors mkErrors+ where+ mkErrors [] = [hamlet||]+ mkErrors errs = [hamlet|+<ul .reform-error-list>+ $forall e <- errs+ <li>#{e}+|]++br :: Monad m => Form m input error (HtmlUrl url) () ()+br = 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 frm = mapView (\xml -> [hamlet|<fieldset .reform>#{xml}|]) frm++ol :: (Monad m, Functor m, ToMarkup c) =>+ Form m input error c proof a+ -> Form m input error (HtmlUrl url) proof a+ol frm = mapView (\xml -> [hamlet|<ol .reform>#{xml}|]) frm++ul :: (Monad m, Functor m, ToMarkup c) =>+ Form m input error c proof a+ -> Form m input error (HtmlUrl url) proof a+ul frm = mapView (\xml -> [hamlet|<ul .reform>#{xml}|]) frm++li :: (Monad m, Functor m, ToMarkup c) =>+ Form m input error c proof a+ -> Form m input error (HtmlUrl url) proof a+li frm = mapView (\xml -> [hamlet|<li .reform>#{xml}|]) 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 hidden children+ = [hamlet|+<form action=#{action} method="POST" enctype="multipart/form-data">+ $forall (name, value) <- hidden+ <input type="hidden" name=#{name} value=#{value}>+ ^{children}+|]
+ Text/Reform/Hamlet/String.hs view
@@ -0,0 +1,242 @@+{-# LANGUAGE RankNTypes, TypeFamilies #-}+{- |+This module provides functions creating Reform using Hamlet markup.++This module assumes that you wish for text based controls such as 'inputText' and 'textarea' to using 'String' values. If you prefer 'Data.Text.Text' see "Text.Reform.Hamlet.Text".++-}+module Text.Reform.Hamlet.String+ ( -- * \<input\> element+ inputText+ , inputPassword+ , inputSubmit+ , inputReset+ , inputHidden+ , inputButton+ , inputCheckbox+ , inputCheckboxes+ , inputRadio+ , inputFile+ -- * \<textarea\> element+ , textarea+ -- * \<button\> element+ , buttonSubmit+ , buttonReset+ , button+ -- * \<select\> element+ , select+ , selectMultiple+ -- * \<label\> element+ , label+ -- * errors+ , errorList+ , childErrorList+ -- * layout functions+ , br+ , fieldset+ , ol+ , ul+ , li+ , form+ ) where++import Data.Text.Lazy (Text, pack)+import Text.Blaze (ToMarkup(..))+import Text.Reform+import qualified Text.Reform.Hamlet.Common as C+import Text.Hamlet (HtmlUrl)++-- | Create an @\<input type=\"text\"\>@ element+inputText :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input) =>+ String -- ^ initial value+ -> Form m input error (HtmlUrl url) () String+inputText initialValue = C.inputText getInputString initialValue++-- | Create an @\<input type=\"password\"\>@ element+inputPassword :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input) =>+ Form m input error (HtmlUrl url) () String+inputPassword = C.inputPassword getInputString ""++-- | Create an @\<input type=\"submit\"\>@ element+--+-- returns:+--+-- [@Just@ /value/] if this button was used to submit the form.+--+-- [@Nothing@] if this button was not used to submit the form.+inputSubmit :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input) =>+ String -- ^ @value@ attribute. Used for button label, and value if button is submitted.+ -> Form m input error (HtmlUrl url) () (Maybe String)+inputSubmit initialValue = C.inputSubmit getInputString initialValue++-- | Create an @\<input type=\"reset\"\>@ element+--+-- This element does not add any data to the form data set.+inputReset :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input) =>+ String -- ^ value attribute. Used only to label the button.+ -> Form m input error (HtmlUrl url) () ()+inputReset = C.inputReset++-- | Create an @\<input type=\"hidden\"\>@ element+inputHidden :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input) =>+ String -- ^ value to store in the hidden element+ -> Form m input error (HtmlUrl url) () String+inputHidden initialValue = C.inputHidden getInputString initialValue++-- | Create an @\<input type=\"button\"\>@ element+--+-- The element is a push button with a text label. The button does nothing by default, but actions can be added using javascript. This element does not add any data to the form data set.+--+-- see also: 'C.button'+inputButton :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input) =>+ String -- ^ value attribute. Used to label the button.+ -> Form m input error (HtmlUrl url) () ()+inputButton label = C.inputButton label++-- | Create a \<textarea\>\<\/textarea\> element+textarea :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input) =>+ Int -- ^ cols+ -> Int -- ^ rows+ -> String -- ^ initial contents+ -> Form m input error (HtmlUrl url) () String+textarea rows cols initialValue = C.textarea getInputString rows cols initialValue++-- | create a @\<button type=\"submit\"\>\<\/button\>@ element+buttonSubmit :: ( Monad m, FormError error, FormInput input, ErrorInputType error ~ input, ToMarkup children) =>+ String -- ^ value attribute. Returned if this button submits the form.+ -> children -- ^ children to embed in the \<button\>+ -> Form m input error (HtmlUrl url) () (Maybe String)+buttonSubmit = C.buttonSubmit getInputString++--------------------------------------------------------------------------------+-- re-exports from .Common. In theory we could just put the docs in .Common,+-- but, currently HSX strips them out.++-- | Create a single @\<input type=\"checkbox\"\>@ element+--+-- returns a 'Bool' indicating if it was checked or not.+--+-- see also 'inputCheckboxes'+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 = C.inputCheckbox++-- | Create a group of @\<input type=\"checkbox\"\>@ elements+--+inputCheckboxes :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, ToMarkup lbl) =>+ [(a, lbl)] -- ^ (value, label)+ -> (a -> Bool) -- ^ function which marks if a value should be checked (aka, selected) initially or not. Can match zero or more elements.+ -> Form m input error (HtmlUrl url) () [a]+inputCheckboxes = C.inputCheckboxes++-- | Create a group of @\<input type=\"radio\"\>@ elements+inputRadio :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, ToMarkup lbl) =>+ [(a, lbl)] -- ^ (value, label)+ -> (a -> Bool) -- ^ predicate which returns @True@ if @a@ should be initially checked. Must match exactly one value in the previous argument.+ -> Form m input error (HtmlUrl url) () a+inputRadio = C.inputRadio++-- | 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 = C.inputFile++-- | create a @\<button type=\"reset\"\>\<\/button\>@ element+--+-- This element does not add any data to the form data set.+buttonReset :: (Monad m, FormError error, ToMarkup children) =>+ children -- ^ children of the @<\/button\>@ element+ -> Form m input error (HtmlUrl url) () ()+buttonReset = C.buttonReset++-- | create a @\<button type=\"button\"\>\<\/button\>@ element+--+-- This element does not add any data to the form data set.+button :: ( Monad m, FormError error, FormInput input, ErrorInputType error ~ input, ToMarkup children) =>+ children -- ^ children to embed in the \<button\>+ -> Form m input error (HtmlUrl url) () ()+button = C.button++-- | create @\<select\>\<\/select\>@ element plus its @\<option\>\<\/option\>@ children.+--+-- see also: 'selectMultiple'+select :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, ToMarkup lbl) =>+ [(a, lbl)] -- ^ (value, label)+ -> (a -> Bool) -- ^ specifies which value is initially selected. Must match *exactly one* element in the list of choices+ -> Form m input error (HtmlUrl url) () a+select = C.select++-- | create @\<select multiple=\"multiple\"\>\<\/select\>@ element plus its @\<option\>\<\/option\>@ children.+--+-- This creates a @\<select\>@ element which allows more than one item to be selected.+selectMultiple :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, ToMarkup lbl) =>+ [(a, lbl)] -- ^ (value, label)+ -> (a -> Bool) -- ^ specifies which values are initially selected. Can match 0 or more elements.+ -> Form m input error (HtmlUrl url) () [a]+selectMultiple = C.selectMultiple++-- | create a @\<label\>@ element.+--+-- Use this with <++ or ++> to ensure that the @for@ attribute references the correct @id@.+--+-- > label "some input field: " ++> inputText ""+label :: (Monad m, ToMarkup c) =>+ c+ -> Form m input error (HtmlUrl url) () ()+label = C.label++-- | create a @\<ul\>@ which contains all the errors related to the 'Form'.+--+-- The @<\ul\>@ will have the attribute @class=\"reform-error-list\"@.+errorList :: (Monad m, ToMarkup error) =>+ Form m input error (HtmlUrl url) () ()+errorList = C.errorList++-- | create a @\<ul\>@ which contains all the errors related to the 'Form'.+--+-- Includes errors from children of the current form.+--+-- The @<\ul\>@ will have the attribute @class=\"reform-error-list\"@.+childErrorList :: (Monad m, ToMarkup error) =>+ Form m input error (HtmlUrl url) () ()+childErrorList = C.childErrorList++-- | create a @\<br\>@ tag.+br :: (Monad m) => Form m input error (HtmlUrl url) () ()+br = C.br++-- | wrap a @\<fieldset class=\"reform\"\>@ around a 'Form'+--+fieldset :: (Monad m, Functor m, ToMarkup c) =>+ Form m input error c proof a+ -> Form m input error (HtmlUrl url) proof a+fieldset = C.fieldset++-- | wrap an @\<ol class=\"reform\"\>@ around a 'Form'+ol :: (Monad m, Functor m, ToMarkup c) =>+ Form m input error c proof a+ -> Form m input error (HtmlUrl url) proof a+ol = C.ol++-- | wrap a @\<ul class=\"reform\"\>@ around a 'Form'+ul :: (Monad m, Functor m, ToMarkup c) =>+ Form m input error c proof a+ -> Form m input error (HtmlUrl url) proof a+ul = C.ul++-- | wrap a @\<li class=\"reform\"\>@ around a 'Form'+li :: (Monad m, Functor m, ToMarkup c) =>+ Form m input error c proof a+ -> Form m input error (HtmlUrl url) proof a+li = C.li++-- | create @\<form action=action method=\"POST\" enctype=\"multipart/form-data\"\>@+form :: ToMarkup action =>+ action -- ^ action url+ -> [(Text, Text)] -- ^ extra hidden fields to add to form+ -> (HtmlUrl url) -- ^ children+ -> (HtmlUrl url)+form = C.form
+ Text/Reform/Hamlet/Text.hs view
@@ -0,0 +1,263 @@+{-# LANGUAGE RankNTypes, TypeFamilies #-}+{- |+This module provides functions creating Reform using Hamlet markup.++This module assumes that you wish for text based controls such as 'inputText' and 'textarea' to using 'Text' values. If you prefer 'String' see "Text.Reform.Hamlet.String".+-}+module Text.Reform.Hamlet.Text+ ( -- * \<input\> element+ inputText+ , inputPassword+ , inputSubmit+ , inputReset+ , inputHidden+ , inputButton+ , inputCheckbox+ , inputCheckboxes+ , inputRadio+ , inputFile+ -- * \<textarea\> element+ , textarea+ -- * \<button\> element+ , buttonSubmit+ , buttonReset+ , button+ -- * \<select\> element+ , select+ , selectMultiple+ -- * \<label\> element+ , label+ , labelText+ -- * errors+ , errorList+ , childErrorList+ -- * layout functions+ , br+ , fieldset+ , ol+ , ul+ , li+ , form+ ) where++import Data.Text (empty)+import qualified Data.Text as T+import Data.Text.Lazy (Text)+import Text.Blaze (ToMarkup(..))+import Text.Reform+import qualified Text.Reform.Hamlet.Common as C+import Text.Hamlet (HtmlUrl)++-- | Create an @\<input type=\"text\"\>@ element+inputText :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input) =>+ T.Text -- ^ initial value+ -> Form m input error (HtmlUrl url) () T.Text+inputText initialValue = C.inputText getInputText initialValue++-- | Create an @\<input type=\"password\"\>@ element+inputPassword :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input) =>+ Form m input error (HtmlUrl url) () T.Text+inputPassword = C.inputPassword getInputText empty++-- | Create an @\<input type=\"submit\"\>@ element+--+-- returns:+--+-- [@Just@ /value/] if this button was used to submit the form.+--+-- [@Nothing@] if this button was not used to submit the form.+inputSubmit :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input) =>+ T.Text -- ^ @value@ attribute. Used for button label, and value if button is submitted.+ -> Form m input error (HtmlUrl url) () (Maybe T.Text)+inputSubmit initialValue = C.inputSubmit getInputText initialValue++-- | Create an @\<input type=\"reset\"\>@ element+--+-- This element does not add any data to the form data set.+inputReset :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input) =>+ T.Text -- ^ value attribute. Used only to label the button.+ -> Form m input error (HtmlUrl url) () ()+inputReset = C.inputReset++-- | Create an @\<input type=\"hidden\"\>@ element+inputHidden :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input) =>+ T.Text -- ^ value to store in the hidden element+ -> Form m input error (HtmlUrl url) () T.Text+inputHidden initialValue = C.inputHidden getInputText initialValue++-- | Create an @\<input type=\"button\"\>@ element+--+-- The element is a push button with a text label. The button does nothing by default, but actions can be added using javascript. This element does not add any data to the form data set.+--+-- see also: 'C.button'+inputButton :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input) =>+ Text -- ^ value attribute. Used to label the button.+ -> Form m input error (HtmlUrl url) () ()+inputButton label = C.inputButton label++-- | Create a \<textarea\>\<\/textarea\> element+textarea :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input) =>+ Int -- ^ cols+ -> Int -- ^ rows+ -> T.Text -- ^ initial contents+ -> Form m input error (HtmlUrl url) () T.Text+textarea rows cols initialValue = C.textarea getInputText rows cols initialValue++-- | create a @\<button type=\"submit\"\>\<\/button\>@ element+buttonSubmit :: ( Monad m, FormError error, FormInput input, ErrorInputType error ~ input, ToMarkup children) =>+ T.Text -- ^ value attribute. Returned if this button submits the form.+ -> children -- ^ children to embed in the \<button\>+ -> Form m input error (HtmlUrl url) () (Maybe T.Text)+buttonSubmit = C.buttonSubmit getInputText++--------------------------------------------------------------------------------+-- re-exports from .Common. In theory we could just put the docs in .Common,+-- but, currently HSX strips them out.++-- | Create a single @\<input type=\"checkbox\"\>@ element+--+-- returns a 'Bool' indicating if it was checked or not.+--+-- see also 'inputCheckboxes'+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 = C.inputCheckbox++-- | Create a group of @\<input type=\"checkbox\"\>@ elements+--+inputCheckboxes :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, ToMarkup lbl) =>+ [(a, lbl)] -- ^ (value, label)+ -> (a -> Bool) -- ^ function which marks if a value should be checked (aka, selected) initially or not. Can match zero or more elements.+ -> Form m input error (HtmlUrl url) () [a]+inputCheckboxes = C.inputCheckboxes++-- | Create a group of @\<input type=\"radio\"\>@ elements+inputRadio :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, ToMarkup lbl) =>+ [(a, lbl)] -- ^ (value, label)+ -> (a -> Bool) -- ^ predicate which returns @True@ if @a@ should be initially checked. Must match exactly one value in the previous argument.+ -> Form m input error (HtmlUrl url) () a+inputRadio = C.inputRadio++-- | 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 = C.inputFile++-- | create a @\<button type=\"reset\"\>\<\/button\>@ element+--+-- This element does not add any data to the form data set.+buttonReset :: (Monad m, FormError error, ToMarkup children) =>+ children -- ^ children of the @<\/button\>@ element+ -> Form m input error (HtmlUrl url) () ()+buttonReset = C.buttonReset++-- | create a @\<button type=\"button\"\>\<\/button\>@ element+--+-- This element does not add any data to the form data set.+button :: (Monad m, FormError error, FormInput input, ErrorInputType error ~ input, ToMarkup children) =>+ children -- ^ children to embed in the \<button\>+ -> Form m input error (HtmlUrl url) () ()+button = C.button++-- | create @\<select\>\<\/select\>@ element plus its @\<option\>\<\/option\>@ children.+--+-- see also: 'selectMultiple'+select :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, ToMarkup lbl) =>+ [(a, lbl)] -- ^ (value, label)+ -> (a -> Bool) -- ^ specifies which value is initially selected. Must match *exactly one* element in the list of choices+ -> Form m input error (HtmlUrl url) () a+select = C.select++-- | create @\<select multiple=\"multiple\"\>\<\/select\>@ element plus its @\<option\>\<\/option\>@ children.+--+-- This creates a @\<select\>@ element which allows more than one item to be selected.+selectMultiple :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, ToMarkup lbl) =>+ [(a, lbl)] -- ^ (value, label)+ -> (a -> Bool) -- ^ specifies which values are initially selected. Can match 0 or more elements.+ -> Form m input error (HtmlUrl url) () [a]+selectMultiple = C.selectMultiple++-- | create a @\<label\>@ element.+--+-- Use this with <++ or ++> to ensure that the @for@ attribute references the correct @id@.+--+-- > label "some input field: " ++> inputText ""+--+-- see also: 'labelText'+label :: (Monad m, ToMarkup c) =>+ c+ -> Form m input error (HtmlUrl url) () ()+label = C.label++-- | create a @\<label\>@ element.+--+-- Use this with <++ or ++> to ensure that the @for@ attribute references the correct @id@.+--+-- > labelText "some input field: " ++> inputText ""+--+-- This function is provided as an alternative to 'label' because when+-- the 'OverloadedStrings' extension is enabled, you will get+-- ambiguous type errors when attempting to apply 'label' to a string+-- literal. While the type error can be fixed using an explicit type+-- signature, calling 'labelText' looks nicer.+labelText :: Monad m =>+ Text+ -> Form m input error (HtmlUrl url) () ()+labelText = C.label+++-- | create a @\<ul\>@ which contains all the errors related to the 'Form'.+--+-- The @<\ul\>@ will have the attribute @class=\"reform-error-list\"@.+errorList :: (Monad m, ToMarkup error) =>+ Form m input error (HtmlUrl url) () ()+errorList = C.errorList++-- | create a @\<ul\>@ which contains all the errors related to the 'Form'.+--+-- Includes errors from children of the current form.+--+-- The @<\ul\>@ will have the attribute @class=\"reform-error-list\"@.+childErrorList :: (Monad m, ToMarkup error) =>+ Form m input error (HtmlUrl url) () ()+childErrorList = C.childErrorList++-- | create a @\<br\>@ tag.+br :: (Monad m) => Form m input error (HtmlUrl url) () ()+br = C.br++-- | wrap a @\<fieldset class=\"reform\"\>@ around a 'Form'+--+fieldset :: (Monad m, Functor m, ToMarkup c) =>+ Form m input error c proof a+ -> Form m input error (HtmlUrl url) proof a+fieldset = C.fieldset++-- | wrap an @\<ol class=\"reform\"\>@ around a 'Form'+ol :: (Monad m, Functor m, ToMarkup c) =>+ Form m input error c proof a+ -> Form m input error (HtmlUrl url) proof a+ol = C.ol++-- | wrap a @\<ul class=\"reform\"\>@ around a 'Form'+ul :: (Monad m, Functor m, ToMarkup c) =>+ Form m input error c proof a+ -> Form m input error (HtmlUrl url) proof a+ul = C.ul++-- | wrap a @\<li class=\"reform\"\>@ around a 'Form'+li :: (Monad m, Functor m, ToMarkup c) =>+ Form m input error c proof a+ -> Form m input error (HtmlUrl url) proof a+li = C.li++-- | create @\<form action=action method=\"POST\" enctype=\"multipart/form-data\"\>@+form :: ToMarkup action =>+ action -- ^ action url+ -> [(Text,Text)] -- ^ extra hidden fields to add to form+ -> (HtmlUrl url) -- ^ children+ -> (HtmlUrl url)+form = C.form
+ reform-hamlet.cabal view
@@ -0,0 +1,28 @@+Name: reform-hamlet+Version: 0.0+Synopsis: Add support for using Hamlet with Reform+Description: Reform is a library for building and validating forms using applicative functors. This package add support for using reform with Hamlet.+Homepage: http://www.happstack.com/+License: BSD3+License-file: LICENSE+Author: Jeremy Shaw+Maintainer: jeremy@n-heptane.com+Copyright: 2012 Jeremy Shaw, Jasper Van der Jeugt, SeeReason Partners LLC+Category: Web+Build-type: Simple+Cabal-version: >=1.6++source-repository head+ type: darcs+ subdir: reform-hamlet+ location: http://hub.darcs.net/stepcut/reform++Library+ Exposed-modules: Text.Reform.Hamlet.Common+ Text.Reform.Hamlet.String+ Text.Reform.Hamlet.Text+ Build-depends: base > 4 && <5,+ blaze-markup > 0.5 && < 0.6,+ hamlet > 1.0 && < 1.2,+ reform == 0.2.*,+ text == 0.11.*