packages feed

reform-hsp (empty) → 0.1.1

raw patch · 6 files changed

+836/−0 lines, 6 filesdep +basedep +hspdep +reformsetup-changed

Dependencies added: base, hsp, reform, text

Files

+ 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/HSP/Common.hs view
@@ -0,0 +1,279 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, UndecidableInstances, ViewPatterns #-}+{-# OPTIONS_GHC -F -pgmFtrhsx #-}+module Text.Reform.HSP.Common where++import Text.Reform.Backend+import Text.Reform.Core+import Text.Reform.Generalized as G+import Text.Reform.Result (FormId, Result(Ok), unitRange)+import HSP++instance (EmbedAsAttr m (Attr String String)) => (EmbedAsAttr m (Attr String FormId)) where+    asAttr (n := v) = asAttr (n := show v)++inputText :: (Monad m, FormError error, XMLGenerator x, EmbedAsAttr x (Attr String FormId), EmbedAsAttr x (Attr String text)) =>+             (input -> Either error text)+          -> text+          -> Form m input error [XMLGenT x (XMLType x)] () text+inputText getInput initialValue = G.input getInput inputField initialValue+    where+      inputField i a = [<input type="text" id=i name=i value=a />]++inputPassword :: (Monad m, FormError error, XMLGenerator x, EmbedAsAttr x (Attr String FormId), EmbedAsAttr x (Attr String text)) =>+             (input -> Either error text)+          -> text+          -> Form m input error [XMLGenT x (XMLType x)] () text+inputPassword getInput initialValue = G.input getInput inputField initialValue+    where+      inputField i a = [<input type="password" id=i name=i value=a />]++inputSubmit :: (Monad m, FormError error, XMLGenerator x, EmbedAsAttr x (Attr String FormId), EmbedAsAttr x (Attr String text)) =>+             (input -> Either error text)+          -> text+          -> Form m input error [XMLGenT x (XMLType x)] () (Maybe text)+inputSubmit getInput initialValue = G.inputMaybe getInput inputField initialValue+    where+      inputField i a = [<input type="submit" id=i name=i value=a />]++inputReset :: (Monad m, FormError error, XMLGenerator x, EmbedAsAttr x (Attr String FormId), EmbedAsAttr x (Attr String text)) =>+              text+           -> Form m input error [XMLGenT x (XMLType x)] () ()+inputReset lbl = G.inputNoData inputField lbl+    where+      inputField i a = [<input type="reset" id=i name=i value=a />]++inputHidden :: (Monad m, FormError error, XMLGenerator x, EmbedAsAttr x (Attr String FormId), EmbedAsAttr x (Attr String text)) =>+             (input -> Either error text)+          -> text+          -> Form m input error [XMLGenT x (XMLType x)] () text+inputHidden getInput initialValue = G.input getInput inputField initialValue+    where+      inputField i a = [<input type="hidden" id=i name=i value=a />]++inputButton :: (Monad m, FormError error, XMLGenerator x, EmbedAsAttr x (Attr String FormId), EmbedAsAttr x (Attr String text)) =>+             text+          -> Form m input error [XMLGenT x (XMLType x)] () ()+inputButton label = G.inputNoData inputField label+    where+      inputField i a = [<input type="button" id=i name=i value=a />]++textarea :: (Monad m, FormError error, XMLGenerator x, EmbedAsAttr x (Attr String 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 getInput cols rows initialValue = G.input getInput textareaView initialValue+    where+      textareaView i txt = [<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, EmbedAsAttr x (Attr String FormId)) =>+             Form m input error [XMLGenT x (XMLType x)] () (FileType input)+inputFile = G.inputFile fileView+    where+      fileView i = [<input type="file" name=i id=i />]++-- | Create a @\<button type=\"submit\"\>@ element+buttonSubmit :: ( Monad m, FormError error, XMLGenerator x, EmbedAsChild x children , EmbedAsAttr x (Attr String FormId), EmbedAsAttr x (Attr String text)) =>+                (input -> Either error text)+             -> text+             -> children+             -> Form m input error [XMLGenT x (XMLType x)] () (Maybe text)+buttonSubmit getInput text c = G.inputMaybe getInput inputField text+    where+      inputField i a = [<button type="submit" id=i name=i value=a><% c %></button>]++buttonReset :: ( Monad m, FormError error, XMLGenerator x, EmbedAsChild x children , EmbedAsAttr x (Attr String FormId)+                ) =>+               children+             -> Form m input error [XMLGenT x (XMLType x)] () ()+buttonReset c = G.inputNoData inputField Nothing+    where+      inputField i a = [<button type="reset" id=i name=i><% c %></button>]++button :: ( Monad m, FormError error, XMLGenerator x, EmbedAsChild x children , EmbedAsAttr x (Attr String FormId)+                ) =>+               children+             -> Form m input error [XMLGenT x (XMLType x)] () ()+button c = G.inputNoData inputField Nothing+    where+      inputField i a = [<button type="button" id=i name=i><% c %></button>]++label :: (Monad m, XMLGenerator x, EmbedAsAttr x (Attr String FormId), EmbedAsChild x c) =>+         c+      -> Form m input error [XMLGenT x (XMLType x)] () ()+label c = G.label mkLabel+    where+      mkLabel i = [<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, EmbedAsAttr x (Attr String FormId)) =>+                   Bool  -- ^ initially checked+                -> Form m input error [XMLGenT x (XMLType x)] () 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 getInputString input of+                 (Right _) -> mkCheckbox i True+                 (Left  (e :: error) ) -> mkCheckbox i False+    where+      mkCheckbox i checked =+          return ( View $ const $ [<input type="checkbox" id=i name=i value=i (if checked then [("checked" := "checked")] else []) />]+                 , 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, XMLGenerator x, EmbedAsChild x lbl, EmbedAsAttr x (Attr String 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 choices isChecked =+    G.inputMulti choices mkCheckboxes isChecked+    where+      mkCheckboxes nm choices' = concatMap (mkCheckbox nm) choices'+      mkCheckbox nm (i, val, lbl, checked) =+             [ <input type="checkbox" id=i name=nm value=(show val) (if checked then [("checked" := "checked")] else []) />+             , <label for=i><% lbl %></label>+             ]++inputRadio :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, XMLGenerator x, EmbedAsChild x lbl, EmbedAsAttr x (Attr String FormId)) =>+              [(a, lbl)]  -- ^ value, label, initially checked+           -> (a -> Bool) -- ^ isDefault+           -> Form m input error [XMLGenT x (XMLType x)] () a+inputRadio choices isDefault =+    G.inputChoice isDefault choices mkRadios+    where+      mkRadios nm choices' = concatMap (mkRadio nm) choices'+      mkRadio nm (i, val, lbl, checked) =+             [ <input type="radio" id=i name=nm value=(show val) (if checked then [("checked" := "checked")] else []) />+             , <label for=i><% lbl %></label>+             , <br />+             ]++select :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, XMLGenerator x, EmbedAsChild x lbl, EmbedAsAttr x (Attr String 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 choices isDefault  =+    G.inputChoice isDefault choices mkSelect+    where+      mkSelect nm choices' =+          [<select name=nm>+            <% mapM mkOption choices' %>+           </select>+          ]++      mkOption (_, val, lbl, selected) =+          <option value=val (if selected then ["selected" := "selected"] else [])>+           <% lbl %>+          </option>++selectMultiple :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, XMLGenerator x, EmbedAsChild x lbl, EmbedAsAttr x (Attr String FormId)) =>+                  [(a, lbl)]  -- ^ value, label, initially checked+               -> (a -> Bool)  -- ^ isSelected initially+               -> Form m input error [XMLGenT x (XMLType x)] () [a]+selectMultiple choices isSelected =+    G.inputMulti choices mkSelect isSelected+    where+      mkSelect nm choices' =+          [<select name=nm multiple="multiple">+            <% mapM mkOption choices' %>+           </select>+          ]+      mkOption (_, val, lbl, selected) =+          <option value=val (if selected then ["selected" := "selected"] else [])>+           <% lbl %>+          </option>+{-+inputMultiSelectOptGroup :: (Functor m, XMLGenerator x, EmbedAsChild x groupLbl, EmbedAsChild x lbl, EmbedAsAttr x (Attr String 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, EmbedAsChild x error) =>+             Form m input error [XMLGenT x (XMLType x)] () ()+errorList = G.errors mkErrors+    where+      mkErrors []   = []+      mkErrors errs = [<ul class="reform-error-list"><% mapM mkError errs %></ul>]+      mkError e     = <li><% e %></li>++childErrorList :: (Monad m, XMLGenerator x, EmbedAsChild x error) =>+             Form m input error [XMLGenT x (XMLType x)] () ()+childErrorList = G.childErrors mkErrors+    where+      mkErrors []   = []+      mkErrors errs = [<ul class="reform-error-list"><% mapM mkError errs %></ul>]+      mkError e     = <li><% e %></li>+++br :: (Monad m, XMLGenerator x) => Form m input error [XMLGenT x (XMLType x)] () ()+br = view [<br />]++fieldset :: (Monad m, Functor m, XMLGenerator x, EmbedAsChild x c) =>+            Form m input error c proof a+         -> Form m input error [XMLGenT x (XMLType x)] proof a+fieldset frm = mapView (\xml -> [<fieldset class="reform"><% xml %></fieldset>]) frm++ol :: (Monad m, Functor m, XMLGenerator x, EmbedAsChild x c) =>+      Form m input error c proof a+   -> Form m input error [XMLGenT x (XMLType x)] proof a+ol frm = mapView (\xml -> [<ol class="reform"><% xml %></ol>]) frm++ul :: (Monad m, Functor m, XMLGenerator x, EmbedAsChild x c) =>+      Form m input error c proof a+   -> Form m input error [XMLGenT x (XMLType x)] proof a+ul frm = mapView (\xml -> [<ul class="reform"><% xml %></ul>]) frm++li :: (Monad m, Functor m, XMLGenerator x, EmbedAsChild x c) =>+      Form m input error c proof a+   -> Form m input error [XMLGenT x (XMLType x)] proof a+li frm = mapView (\xml -> [<li class="reform"><% xml %></li>]) frm++-- | create @\<form action=action method=\"POST\" enctype=\"multipart/form-data\"\>@+form :: (XMLGenerator x, EmbedAsAttr x (Attr String action)) =>+        action                  -- ^ action url+     -> [(String,String)]       -- ^ hidden fields to add to form+     -> [XMLGenT x (XMLType x)] -- ^ childern+     -> [XMLGenT x (XMLType x)]+form action hidden children+    = [ <form action=action method="POST" enctype="multipart/form-data">+         <% mapM mkHidden hidden %>+         <% children %>+        </form>+      ]+    where+      mkHidden (name, value) =+          <input type="hidden" name=name value=value />++setAttrs :: (EmbedAsAttr x attr, XMLGenerator x, Monad m, Functor m) =>+            Form m input error [GenXML x] proof a+         -> attr+         -> Form m input error [GenXML x] proof a+setAttrs form attrs = mapView (map (`set` attrs)) form
+ Text/Reform/HSP/String.hs view
@@ -0,0 +1,249 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, UndecidableInstances, ViewPatterns #-}+{- |+This module provides functions creating Reform using HSP 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.HSP.Text".++-}+module Text.Reform.HSP.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+    , setAttrs+    ) where++import HSP+import Text.Reform+import qualified Text.Reform.HSP.Common as C++-- | Create an @\<input type=\"text\"\>@ element+inputText :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, XMLGenerator x, EmbedAsAttr x (Attr String FormId)) =>+               String -- ^ initial value+            -> Form m input error [XMLGenT x (XMLType x)] () String+inputText initialValue = C.inputText getInputString initialValue++-- | Create an @\<input type=\"password\"\>@ element+inputPassword :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, XMLGenerator x, EmbedAsAttr x (Attr String FormId)) =>+                 Form m input error [XMLGenT x (XMLType x)] () 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, XMLGenerator x, EmbedAsAttr x (Attr String FormId)) =>+               String -- ^ @value@ attribute. Used for button label, and value if button is submitted.+            -> Form m input error [XMLGenT x (XMLType x)] () (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, XMLGenerator x, EmbedAsAttr x (Attr String FormId)) =>+              String -- ^ value attribute. Used only to label the button.+           -> Form m input error [XMLGenT x (XMLType x)] () ()+inputReset = C.inputReset++-- | Create an @\<input type=\"hidden\"\>@ element+inputHidden :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, XMLGenerator x, EmbedAsAttr x (Attr String FormId)) =>+               String -- ^ value to store in the hidden element+            -> Form m input error [XMLGenT x (XMLType x)] () 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, XMLGenerator x, EmbedAsAttr x (Attr String FormId)) =>+               String -- ^ value attribute. Used to label the button.+            -> Form m input error [XMLGenT x (XMLType x)] () ()+inputButton label = C.inputButton label++-- | Create a \<textarea\>\<\/textarea\> element+textarea :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, XMLGenerator x, EmbedAsAttr x (Attr String FormId)) =>+            Int    -- ^ cols+         -> Int    -- ^ rows+         -> String -- ^ initial contents+         -> Form m input error [XMLGenT x (XMLType x)] () 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, XMLGenerator x, EmbedAsChild x children , EmbedAsAttr x (Attr String FormId)) =>+                String -- ^ value attribute. Returned if this button submits the form.+             -> children -- ^ children to embed in the \<button\>+             -> Form m input error [XMLGenT x (XMLType x)] () (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. (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, XMLGenerator x, EmbedAsAttr x (Attr String FormId)) =>+                   Bool  -- ^ initially checked+                -> Form m input error [XMLGenT x (XMLType x)] () Bool+inputCheckbox = C.inputCheckbox++-- | Create a group of @\<input type=\"checkbox\"\>@ elements+--+inputCheckboxes :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, XMLGenerator x, EmbedAsChild x lbl, EmbedAsAttr x (Attr String FormId)) =>+                   [(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 [XMLGenT x (XMLType x)] () [a]+inputCheckboxes = C.inputCheckboxes++-- | Create a group of @\<input type=\"radio\"\>@ elements+inputRadio :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, XMLGenerator x, EmbedAsChild x lbl, EmbedAsAttr x (Attr String FormId)) =>+              [(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 [XMLGenT x (XMLType x)] () 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, XMLGenerator x, EmbedAsAttr x (Attr String FormId)) =>+             Form m input error [XMLGenT x (XMLType x)] () (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, XMLGenerator x, EmbedAsChild x children , EmbedAsAttr x (Attr String FormId)+                ) =>+               children -- ^ children of the @<\/button\>@ element+             -> Form m input error [XMLGenT x (XMLType x)] () ()+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, XMLGenerator x, EmbedAsChild x children , EmbedAsAttr x (Attr String FormId)) =>+          children -- ^ children to embed in the \<button\>+       -> Form m input error [XMLGenT x (XMLType x)] () ()+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, XMLGenerator x, EmbedAsChild x lbl, EmbedAsAttr x (Attr String FormId)) =>+              [(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 [XMLGenT x (XMLType x)] () 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, XMLGenerator x, EmbedAsChild x lbl, EmbedAsAttr x (Attr String FormId)) =>+                  [(a, lbl)]  -- ^ (value, label)+               -> (a -> Bool) -- ^ specifies which values are initially selected. Can match 0 or more elements.+               -> Form m input error [XMLGenT x (XMLType x)] () [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, XMLGenerator x, EmbedAsAttr x (Attr String FormId), EmbedAsChild x c) =>+         c+      -> Form m input error [XMLGenT x (XMLType x)] () ()+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, XMLGenerator x, EmbedAsChild x error) =>+             Form m input error [XMLGenT x (XMLType x)] () ()+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, XMLGenerator x, EmbedAsChild x error) =>+             Form m input error [XMLGenT x (XMLType x)] () ()+childErrorList = C.childErrorList++-- | create a @\<br\>@ tag.+br :: (Monad m, XMLGenerator x) => Form m input error [XMLGenT x (XMLType x)] () ()+br = C.br++-- | wrap a @\<fieldset class=\"reform\"\>@ around a 'Form'+--+fieldset :: (Monad m, Functor m, XMLGenerator x, EmbedAsChild x c) =>+            Form m input error c proof a+         -> Form m input error [XMLGenT x (XMLType x)] proof a+fieldset = C.fieldset++-- | wrap an @\<ol class=\"reform\"\>@ around a 'Form'+ol :: (Monad m, Functor m, XMLGenerator x, EmbedAsChild x c) =>+      Form m input error c proof a+   -> Form m input error [XMLGenT x (XMLType x)] proof a+ol = C.ol++-- | wrap a @\<ul class=\"reform\"\>@ around a 'Form'+ul :: (Monad m, Functor m, XMLGenerator x, EmbedAsChild x c) =>+      Form m input error c proof a+   -> Form m input error [XMLGenT x (XMLType x)] proof a+ul = C.ul++-- | wrap a @\<li class=\"reform\"\>@ around a 'Form'+li :: (Monad m, Functor m, XMLGenerator x, EmbedAsChild x c) =>+      Form m input error c proof a+   -> Form m input error [XMLGenT x (XMLType x)] proof a+li = C.li++-- | create @\<form action=action method=\"POST\" enctype=\"multipart/form-data\"\>@+form :: (XMLGenerator x, EmbedAsAttr x (Attr String action)) =>+        action                  -- ^ action url+     -> [(String,String)]       -- ^ extra hidden fields to add to form+     -> [XMLGenT x (XMLType x)] -- ^ children+     -> [XMLGenT x (XMLType x)]+form = C.form++-- | set the attributes on the top-level elements of 'Form'+setAttrs :: (EmbedAsAttr x attr, XMLGenerator x, Monad m, Functor m) =>+            Form m input error [XMLGenT x (XMLType x)] proof a+         -> attr+         -> Form m input error [GenXML x] proof a+setAttrs = C.setAttrs
+ Text/Reform/HSP/Text.hs view
@@ -0,0 +1,249 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, UndecidableInstances, ViewPatterns #-}+{- |+This module provides functions creating Reform using HSP 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.HSP.String".+-}+module Text.Reform.HSP.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+      -- * errors+    , errorList+    , childErrorList+      -- * layout functions+    , br+    , fieldset+    , ol+    , ul+    , li+    , form+    , setAttrs+    ) where++import Data.Text (Text, empty)+import HSP+import Text.Reform+import qualified Text.Reform.HSP.Common as C++-- | Create an @\<input type=\"text\"\>@ element+inputText :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, XMLGenerator x, EmbedAsAttr x (Attr String FormId), EmbedAsAttr x (Attr String Text)) =>+               Text -- ^ initial value+            -> Form m input error [XMLGenT x (XMLType x)] () Text+inputText initialValue = C.inputText getInputText initialValue++-- | Create an @\<input type=\"password\"\>@ element+inputPassword :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, XMLGenerator x, EmbedAsAttr x (Attr String FormId), EmbedAsAttr x (Attr String Text)) =>+                 Form m input error [XMLGenT x (XMLType x)] () 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, XMLGenerator x, EmbedAsAttr x (Attr String FormId), EmbedAsAttr x (Attr String Text)) =>+               Text -- ^ @value@ attribute. Used for button label, and value if button is submitted.+            -> Form m input error [XMLGenT x (XMLType x)] () (Maybe 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, XMLGenerator x, EmbedAsAttr x (Attr String FormId), EmbedAsAttr x (Attr String Text)) =>+              Text -- ^ value attribute. Used only to label the button.+           -> Form m input error [XMLGenT x (XMLType x)] () ()+inputReset = C.inputReset++-- | Create an @\<input type=\"hidden\"\>@ element+inputHidden :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, XMLGenerator x, EmbedAsAttr x (Attr String FormId), EmbedAsAttr x (Attr String Text)) =>+               Text -- ^ value to store in the hidden element+            -> Form m input error [XMLGenT x (XMLType x)] () 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, XMLGenerator x, EmbedAsAttr x (Attr String FormId), EmbedAsAttr x (Attr String Text)) =>+               Text -- ^ value attribute. Used to label the button.+            -> Form m input error [XMLGenT x (XMLType x)] () ()+inputButton label = C.inputButton label++-- | Create a \<textarea\>\<\/textarea\> element+textarea :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, XMLGenerator x, EmbedAsAttr x (Attr String FormId), EmbedAsAttr x (Attr String Text), EmbedAsChild x Text) =>+            Int    -- ^ cols+         -> Int    -- ^ rows+         -> Text -- ^ initial contents+         -> Form m input error [XMLGenT x (XMLType x)] () 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, XMLGenerator x, EmbedAsChild x children , EmbedAsAttr x (Attr String FormId), EmbedAsAttr x (Attr String Text)) =>+                Text -- ^ value attribute. Returned if this button submits the form.+             -> children -- ^ children to embed in the \<button\>+             -> Form m input error [XMLGenT x (XMLType x)] () (Maybe 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. (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, XMLGenerator x, EmbedAsAttr x (Attr String FormId)) =>+                   Bool  -- ^ initially checked+                -> Form m input error [XMLGenT x (XMLType x)] () Bool+inputCheckbox = C.inputCheckbox++-- | Create a group of @\<input type=\"checkbox\"\>@ elements+--+inputCheckboxes :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, XMLGenerator x, EmbedAsChild x lbl, EmbedAsAttr x (Attr String FormId)) =>+                   [(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 [XMLGenT x (XMLType x)] () [a]+inputCheckboxes = C.inputCheckboxes++-- | Create a group of @\<input type=\"radio\"\>@ elements+inputRadio :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, XMLGenerator x, EmbedAsChild x lbl, EmbedAsAttr x (Attr String FormId)) =>+              [(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 [XMLGenT x (XMLType x)] () 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, XMLGenerator x, EmbedAsAttr x (Attr String FormId)) =>+             Form m input error [XMLGenT x (XMLType x)] () (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, XMLGenerator x, EmbedAsChild x children , EmbedAsAttr x (Attr String FormId)+                ) =>+               children -- ^ children of the @<\/button\>@ element+             -> Form m input error [XMLGenT x (XMLType x)] () ()+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, XMLGenerator x, EmbedAsChild x children , EmbedAsAttr x (Attr String FormId)) =>+          children -- ^ children to embed in the \<button\>+       -> Form m input error [XMLGenT x (XMLType x)] () ()+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, XMLGenerator x, EmbedAsChild x lbl, EmbedAsAttr x (Attr String FormId)) =>+              [(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 [XMLGenT x (XMLType x)] () 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, XMLGenerator x, EmbedAsChild x lbl, EmbedAsAttr x (Attr String FormId)) =>+                  [(a, lbl)]  -- ^ (value, label)+               -> (a -> Bool) -- ^ specifies which values are initially selected. Can match 0 or more elements.+               -> Form m input error [XMLGenT x (XMLType x)] () [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, XMLGenerator x, EmbedAsAttr x (Attr String FormId), EmbedAsChild x c) =>+         c+      -> Form m input error [XMLGenT x (XMLType x)] () ()+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, XMLGenerator x, EmbedAsChild x error) =>+             Form m input error [XMLGenT x (XMLType x)] () ()+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, XMLGenerator x, EmbedAsChild x error) =>+             Form m input error [XMLGenT x (XMLType x)] () ()+childErrorList = C.childErrorList++-- | create a @\<br\>@ tag.+br :: (Monad m, XMLGenerator x) => Form m input error [XMLGenT x (XMLType x)] () ()+br = C.br++-- | wrap a @\<fieldset class=\"reform\"\>@ around a 'Form'+--+fieldset :: (Monad m, Functor m, XMLGenerator x, EmbedAsChild x c) =>+            Form m input error c proof a+         -> Form m input error [XMLGenT x (XMLType x)] proof a+fieldset = C.fieldset++-- | wrap an @\<ol class=\"reform\"\>@ around a 'Form'+ol :: (Monad m, Functor m, XMLGenerator x, EmbedAsChild x c) =>+      Form m input error c proof a+   -> Form m input error [XMLGenT x (XMLType x)] proof a+ol = C.ol++-- | wrap a @\<ul class=\"reform\"\>@ around a 'Form'+ul :: (Monad m, Functor m, XMLGenerator x, EmbedAsChild x c) =>+      Form m input error c proof a+   -> Form m input error [XMLGenT x (XMLType x)] proof a+ul = C.ul++-- | wrap a @\<li class=\"reform\"\>@ around a 'Form'+li :: (Monad m, Functor m, XMLGenerator x, EmbedAsChild x c) =>+      Form m input error c proof a+   -> Form m input error [XMLGenT x (XMLType x)] proof a+li = C.li++-- | create @\<form action=action method=\"POST\" enctype=\"multipart/form-data\"\>@+form :: (XMLGenerator x, EmbedAsAttr x (Attr String action)) =>+        action                  -- ^ action url+     -> [(String,String)]       -- ^ extra hidden fields to add to form+     -> [XMLGenT x (XMLType x)] -- ^ children+     -> [XMLGenT x (XMLType x)]+form = C.form++-- | set the attributes on the top-level elements of 'Form'+setAttrs :: (EmbedAsAttr x attr, XMLGenerator x, Monad m, Functor m) =>+            Form m input error [XMLGenT x (XMLType x)] proof a+         -> attr+         -> Form m input error [GenXML x] proof a+setAttrs = C.setAttrs
+ reform-hsp.cabal view
@@ -0,0 +1,27 @@+Name:                reform-hsp+Version:             0.1.1+Synopsis:            Add support for using HSP with Reform+Description:         Reform is a library for building and validating forms using applicative functors. This package add support for using reform with HSP.+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-hsp+    location: http://patch-tag.com/r/stepcut/reform++Library+  Exposed-modules:     Text.Reform.HSP.Common+                       Text.Reform.HSP.String+                       Text.Reform.HSP.Text+  Build-depends:       base > 4 && <5,+                       hsp   == 0.7.*,+                       reform == 0.1.*,+                       text   == 0.11.*