reform-hsp-0.2.7.2/0000755000000000000000000000000013573270706012142 5ustar0000000000000000reform-hsp-0.2.7.2/Setup.hs0000644000000000000000000000005613573270706013577 0ustar0000000000000000import Distribution.Simple main = defaultMain reform-hsp-0.2.7.2/LICENSE0000644000000000000000000000275713573270706013162 0ustar0000000000000000Copyright (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. reform-hsp-0.2.7.2/reform-hsp.cabal0000644000000000000000000000227113573270706015212 0ustar0000000000000000Name: reform-hsp Version: 0.2.7.2 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 tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1, GHC == 8.6.5, GHC == 8.8.1 source-repository head type: git location: https://github.com/Happstack/reform-hsp.git Library Exposed-modules: Text.Reform.HSP.Common Text.Reform.HSP.String Text.Reform.HSP.Text Build-depends: base > 4 && <5, hsp >= 0.9 && < 0.11, hsx2hs >= 0.13 && < 0.15, reform >= 0.2.1 && < 0.4, text >= 0.11 && < 1.3 reform-hsp-0.2.7.2/Text/0000755000000000000000000000000013573270706013066 5ustar0000000000000000reform-hsp-0.2.7.2/Text/Reform/0000755000000000000000000000000013573270706014320 5ustar0000000000000000reform-hsp-0.2.7.2/Text/Reform/HSP/0000755000000000000000000000000013573270706014752 5ustar0000000000000000reform-hsp-0.2.7.2/Text/Reform/HSP/Text.hs0000644000000000000000000003405013573270706016234 0ustar0000000000000000{-# 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 ( -- * \ element inputEmail , inputText , inputPassword , inputSubmit , inputReset , inputHidden , inputButton , inputCheckbox , inputCheckboxes , inputRadio , inputRadioForms , inputFile -- * \ element , textarea -- * \ element , buttonSubmit , buttonReset , button -- * \ element , select , selectMultiple -- * \ element , label , labelText -- * errors , errorList , childErrorList -- * layout functions , br , fieldset , ol , ul , li , form , setAttrs ) where import Data.Text (empty) import qualified Data.Text as T import Data.Text.Lazy (Text) import HSP.XMLGenerator import Text.Reform import qualified Text.Reform.HSP.Common as C -- | Create an @\@ element inputEmail :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId), EmbedAsAttr x (Attr Text T.Text)) => T.Text -- ^ initial value -> Form m input error [XMLGenT x (XMLType x)] () T.Text inputEmail initialValue = C.inputEmail getInputText initialValue -- | Create an @\@ element inputText :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId), EmbedAsAttr x (Attr Text T.Text)) => T.Text -- ^ initial value -> Form m input error [XMLGenT x (XMLType x)] () T.Text inputText initialValue = C.inputText getInputText initialValue -- | Create an @\@ element inputPassword :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId), EmbedAsAttr x (Attr Text T.Text)) => Form m input error [XMLGenT x (XMLType x)] () T.Text inputPassword = C.inputPassword getInputText empty -- | Create an @\@ 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, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId), EmbedAsAttr x (Attr Text T.Text)) => T.Text -- ^ @value@ attribute. Used for button label, and value if button is submitted. -> Form m input error [XMLGenT x (XMLType x)] () (Maybe T.Text) inputSubmit initialValue = C.inputSubmit getInputText initialValue -- | Create an @\@ 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, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId), EmbedAsAttr x (Attr Text T.Text)) => T.Text -- ^ value attribute. Used only to label the button. -> Form m input error [XMLGenT x (XMLType x)] () () inputReset = C.inputReset -- | Create an @\@ element inputHidden :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId), EmbedAsAttr x (Attr Text T.Text)) => T.Text -- ^ value to store in the hidden element -> Form m input error [XMLGenT x (XMLType x)] () T.Text inputHidden initialValue = C.inputHidden getInputText initialValue -- | Create an @\@ 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, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId), EmbedAsAttr x (Attr Text 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\> element textarea :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId), EmbedAsAttr x (Attr Text T.Text), EmbedAsChild x T.Text) => Int -- ^ cols -> Int -- ^ rows -> T.Text -- ^ initial contents -> Form m input error [XMLGenT x (XMLType x)] () T.Text textarea rows cols initialValue = C.textarea getInputText rows cols initialValue -- | create a @\] |] buttonReset :: ( Monad m, FormError error, XMLGenerator x, StringType x ~ Text, EmbedAsChild x children , EmbedAsAttr x (Attr Text FormId) ) => children -> Form m input error [XMLGenT x (XMLType x)] () () buttonReset c = G.inputNoData inputField Nothing where inputField i a = [hsx| [] |] button :: ( Monad m, FormError error, XMLGenerator x, StringType x ~ Text, EmbedAsChild x children , EmbedAsAttr x (Attr Text FormId) ) => children -> Form m input error [XMLGenT x (XMLType x)] () () button c = G.inputNoData inputField Nothing where inputField i a = [hsx| [] |] label :: (Monad m, XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId), EmbedAsChild x c) => c -> Form m input error [XMLGenT x (XMLType x)] () () label c = G.label mkLabel where mkLabel i = [hsx| [] |] -- FIXME: should this use inputMaybe? inputCheckbox :: forall x error input m. (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId)) => Bool -- ^ initially checked -> Form m input error [XMLGenT x (XMLType x)] () Bool inputCheckbox 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 $ [hsx| [] |] , 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, StringType x ~ Text, EmbedAsChild x lbl, EmbedAsAttr x (Attr Text FormId)) => [(a, lbl)] -- ^ value, label, initially checked -> (a -> Bool) -- ^ function which indicates if a value should be checked initially -> Form m input error [XMLGenT x (XMLType x)] () [a] inputCheckboxes choices isChecked = G.inputMulti choices mkCheckboxes isChecked where mkCheckboxes nm choices' = concatMap (mkCheckbox nm) choices' mkCheckbox nm (i, val, lbl, checked) = [hsx| [ , ] |] inputRadio :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, XMLGenerator x, StringType x ~ Text, EmbedAsChild x lbl, EmbedAsAttr x (Attr Text FormId)) => [(a, lbl)] -- ^ value, label, initially checked -> (a -> Bool) -- ^ isDefault -> Form m input error [XMLGenT x (XMLType x)] () a inputRadio choices isDefault = G.inputChoice isDefault choices mkRadios where mkRadios nm choices' = concatMap (mkRadio nm) choices' mkRadio nm (i, val, lbl, checked) = [hsx| [ , ,
] |] inputRadioForms :: forall m x error input lbl proof a. (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, XMLGenerator x, StringType x ~ Text, EmbedAsChild x lbl, EmbedAsAttr x (Attr Text FormId)) => [(Form m input error [XMLGenT x (XMLType x)] proof a, lbl)] -- ^ value, label, initially checked -> a -- ^ default -> Form m input error [XMLGenT x (XMLType x)] proof a inputRadioForms choices def = inputRadioForms' onclick choices def where formIdsJS :: [FormId] -> Text formIdsJS [] = "[]" formIdsJS ids = "['" <> (pack $ intercalate "', '" $ map show ids) <> "']" onclick :: FormId -> FormId -> [FormId] -> Text onclick nm iview iviews = mconcat [ "var views = " <> formIdsJS iviews <> ";" , "var iview = '" <> (pack $ show iview) <> "';" , "for (var i = 0; i < views.length; i++) {" , " if (iview == views[i]) {" , " document.getElementById(iview).style.display='block';" , " } else {" , " document.getElementById(views[i]).style.display='none';" , " }" , "}" ] inputRadioForms' :: forall m x error input lbl proof a. (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, XMLGenerator x, StringType x ~ Text, EmbedAsChild x lbl, EmbedAsAttr x (Attr Text FormId)) => (FormId -> FormId -> [FormId] -> Text) -> [(Form m input error [XMLGenT x (XMLType x)] proof a, lbl)] -- ^ value, label, initially checked -> a -- ^ default -> Form m input error [XMLGenT x (XMLType x)] proof a inputRadioForms' onclick choices def = G.inputChoiceForms def choices mkRadios where iviewsExtract :: [(FormId, Int, FormId, [XMLGenT x (XMLType x)], lbl, Bool)] -> [FormId] iviewsExtract = map (\(_,_, iv, _, _, _) -> iv) mkRadios :: FormId -> [(FormId, Int, FormId, [XMLGenT x (XMLType x)], lbl, Bool)] -> [XMLGenT x (XMLType x)] mkRadios nm choices' = let iviews = iviewsExtract choices' in (concatMap (mkRadio nm iviews) choices') mkRadio nm iviews (i, val, iview, view, lbl, checked) = [hsx| [
<% view %>
] |] select :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, XMLGenerator x, StringType x ~ Text, EmbedAsChild x lbl, EmbedAsAttr x (Attr Text FormId)) => [(a, lbl)] -- ^ value, label -> (a -> Bool) -- ^ isDefault, must match *exactly one* element in the list of choices -> Form m input error [XMLGenT x (XMLType x)] () a select choices isDefault = G.inputChoice isDefault choices mkSelect where mkSelect nm choices' = [hsx| [ ] |] mkOption (_, val, lbl, selected) = [hsx| |] selectMultiple :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, XMLGenerator x, StringType x ~ Text, EmbedAsChild x lbl, EmbedAsAttr x (Attr Text FormId)) => [(a, lbl)] -- ^ value, label, initially checked -> (a -> Bool) -- ^ isSelected initially -> Form m input error [XMLGenT x (XMLType x)] () [a] selectMultiple choices isSelected = G.inputMulti choices mkSelect isSelected where mkSelect nm choices' = [hsx| [ ] |] mkOption (_, val, lbl, selected) = [hsx| |] {- inputMultiSelectOptGroup :: (Functor m, XMLGenerator x, StringType x ~ Text, EmbedAsChild x groupLbl, EmbedAsChild x lbl, EmbedAsAttr x (Attr Text FormId), FormError error, ErrorInputType error ~ input, FormInput input, Monad m) => [(groupLbl, [(a, lbl, Bool)])] -- ^ value, label, initially checked -> Form m input error [XMLGenT x (XMLType x)] () [a] inputMultiSelectOptGroup choices = G.inputMulti choices mkSelect where mkSelect nm choices' = [ ] mkOptGroup (grpLabel, options) = <% mapM mkOption options %> mkOption (_, val, lbl, selected) = -} errorList :: (Monad m, XMLGenerator x, StringType x ~ Text, EmbedAsChild x error) => Form m input error [XMLGenT x (XMLType x)] () () errorList = G.errors mkErrors where mkErrors [] = [] mkErrors errs = [hsx| [
    <% mapM mkError errs %>
] |] mkError e = [hsx|
  • <% e %>
    • |] childErrorList :: (Monad m, XMLGenerator x, StringType x ~ Text, EmbedAsChild x error) => Form m input error [XMLGenT x (XMLType x)] () () childErrorList = G.childErrors mkErrors where mkErrors [] = [] mkErrors errs = [hsx| [
      <% mapM mkError errs %>
    ] |] mkError e = [hsx|
  • <% e %>
    • |] br :: (Monad m, XMLGenerator x, StringType x ~ Text) => Form m input error [XMLGenT x (XMLType x)] () () br = view [hsx| [
    ] |] fieldset :: (Monad m, Functor m, XMLGenerator x, StringType x ~ Text, EmbedAsChild x c) => Form m input error c proof a -> Form m input error [XMLGenT x (XMLType x)] proof a fieldset frm = mapView (\xml -> [hsx| [
    <% xml %>
    ] |]) frm ol :: (Monad m, Functor m, XMLGenerator x, StringType x ~ Text, EmbedAsChild x c) => Form m input error c proof a -> Form m input error [XMLGenT x (XMLType x)] proof a ol frm = mapView (\xml -> [hsx| [
      <% xml %>
    ] |]) frm ul :: (Monad m, Functor m, XMLGenerator x, StringType x ~ Text, EmbedAsChild x c) => Form m input error c proof a -> Form m input error [XMLGenT x (XMLType x)] proof a ul frm = mapView (\xml -> [hsx| [
      <% xml %>
    ] |]) frm li :: (Monad m, Functor m, XMLGenerator x, StringType x ~ Text, EmbedAsChild x c) => Form m input error c proof a -> Form m input error [XMLGenT x (XMLType x)] proof a li frm = mapView (\xml -> [hsx| [
  • <% xml %>
    • ] |]) frm -- | create @\
    @ form :: (XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text action)) => action -- ^ action url -> [(Text,Text)] -- ^ hidden fields to add to form -> [XMLGenT x (XMLType x)] -- ^ children -> [XMLGenT x (XMLType x)] form action hidden children = [hsx| [ <% mapM mkHidden hidden %> <% children %>
    ] |] where mkHidden (name, value) = [hsx| |] setAttrs :: (EmbedAsAttr x attr, XMLGenerator x, StringType x ~ Text, Monad m, Functor m) => Form m input error [GenXML x] proof a -> attr -> Form m input error [GenXML x] proof a setAttrs form attrs = mapView (map (`set` attrs)) form reform-hsp-0.2.7.2/Text/Reform/HSP/String.hs0000644000000000000000000003233213573270706016557 0ustar0000000000000000{-# 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 ( -- * \ element inputEmail , inputText , inputPassword , inputSubmit , inputReset , inputHidden , inputButton , inputCheckbox , inputCheckboxes , inputRadio , inputRadioForms , inputFile -- * \ element , textarea -- * \ element , buttonSubmit , buttonReset , button -- * \ element , select , selectMultiple -- * \ element , label -- * errors , errorList , childErrorList -- * layout functions , br , fieldset , ol , ul , li , form , setAttrs ) where import Data.Text.Lazy (Text, pack) import HSP.XMLGenerator import Text.Reform import qualified Text.Reform.HSP.Common as C -- | Create an @\@ element inputEmail :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId), EmbedAsAttr x (Attr Text String)) => String -- ^ initial value -> Form m input error [XMLGenT x (XMLType x)] () String inputEmail initialValue = C.inputEmail getInputString initialValue -- | Create an @\@ element inputText :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId), EmbedAsAttr x (Attr Text String)) => String -- ^ initial value -> Form m input error [XMLGenT x (XMLType x)] () String inputText initialValue = C.inputText getInputString initialValue -- | Create an @\@ element inputPassword :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId), EmbedAsAttr x (Attr Text String)) => Form m input error [XMLGenT x (XMLType x)] () String inputPassword = C.inputPassword getInputString "" -- | Create an @\@ 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, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId), EmbedAsAttr x (Attr Text String)) => 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 @\@ 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, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId), EmbedAsAttr x (Attr Text String)) => String -- ^ value attribute. Used only to label the button. -> Form m input error [XMLGenT x (XMLType x)] () () inputReset = C.inputReset -- | Create an @\@ element inputHidden :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId), EmbedAsAttr x (Attr Text String)) => 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 @\@ 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, StringType x ~ Text, EmbedAsAttr x (Attr Text FormId), EmbedAsAttr x (Attr Text String)) => String -- ^ value attribute. Used to label the button. -> Form m input error [XMLGenT x (XMLType x)] () () inputButton label = C.inputButton label -- | Create a \\<\/textarea\> element textarea :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, XMLGenerator x, StringType x ~ Text, EmbedAsAttr x (Attr Text 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 @\