packages feed

reform-lucid (empty) → 0.0.1.0

raw patch · 6 files changed

+666/−0 lines, 6 filesdep +basedep +luciddep +path-piecessetup-changed

Dependencies added: base, lucid, path-pieces, 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/Lucid/Common.hs view
@@ -0,0 +1,387 @@+{-# LANGUAGE +    OverloadedStrings+  , ScopedTypeVariables+  , TypeFamilies +#-}++module Text.Reform.Lucid.Common where++import Data.Monoid (mconcat, mempty, (<>))+import Lucid+import Data.Text (Text)+import Text.Reform.Backend+import Text.Reform.Core+import Text.Reform.Generalized as G+import Text.Reform.Result (FormId, Result(Ok), unitRange)+import Web.PathPieces+import Data.Foldable (traverse_)+import qualified Text.Read+import qualified Data.Text as T++instance PathPiece FormId where+  toPathPiece fid = T.pack (show fid)+  fromPathPiece fidT = Nothing++inputText :: (Monad m, FormError error, PathPiece text, Applicative f) =>+             (input -> Either error text)+          -> text+          -> Form m input error (HtmlT f ()) () text+inputText getInput initialValue = G.input getInput inputField initialValue+    where+      inputField i a = input_ [type_ "text", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]++inputPassword :: (Monad m, FormError error, PathPiece text, Applicative f) =>+             (input -> Either error text)+          -> text+          -> Form m input error (HtmlT f ()) () text+inputPassword getInput initialValue = G.input getInput inputField initialValue+    where+      inputField i a = input_ [type_ "password", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]++inputSubmit :: (Monad m, FormError error, PathPiece text, Applicative f) =>+             (input -> Either error text)+          -> text+          -> Form m input error (HtmlT f ()) () (Maybe text)+inputSubmit getInput initialValue = G.inputMaybe getInput inputField initialValue+    where+      inputField i a = input_ [type_ "submit", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]++inputReset :: (Monad m, FormError error, PathPiece text, Applicative f) =>+              text+           -> Form m input error (HtmlT f ()) () ()+inputReset lbl = G.inputNoData inputField lbl+    where+      inputField i a = input_ [type_ "submit", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]++inputHidden :: (Monad m, FormError error, PathPiece text, Applicative f) =>+             (input -> Either error text)+          -> text+          -> Form m input error (HtmlT f ()) () text+inputHidden getInput initialValue = G.input getInput inputField initialValue+    where+      inputField i a = input_ [type_ "hidden", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]++inputButton :: (Monad m, FormError error, PathPiece text, Applicative f) =>+             text+          -> Form m input error (HtmlT f ()) () ()+inputButton label = G.inputNoData inputField label+    where+      inputField i a = input_ [type_ "button", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]+++textarea :: (Monad m, FormError error, ToHtml text, Monad f) =>+            (input -> Either error text)+         -> Int    -- ^ cols+         -> Int    -- ^ rows+         -> text   -- ^ initial text+         -> Form m input error (HtmlT f ()) () text+textarea getInput cols rows initialValue = G.input getInput textareaView initialValue+    where+      textareaView i txt =+          textarea_ [ rows_ (toPathPiece rows)+                    , cols_ (toPathPiece cols)+                    , id_   (toPathPiece i)+                    , name_ (toPathPiece i)+                    ] $ toHtml 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, Applicative f) =>+             Form m input error (HtmlT f ()) () (FileType input)+inputFile = G.inputFile fileView+    where+      fileView i = input_ [type_ "file", id_ (toPathPiece i), name_ (toPathPiece i)]+++-- | Create a @\<button type=\"submit\"\>@ element+buttonSubmit :: (Monad m, FormError error, PathPiece text, ToHtml children, Monad f) =>+                (input -> Either error text)+             -> text+             -> children+             -> Form m input error (HtmlT f ()) () (Maybe text)+buttonSubmit getInput text c = G.inputMaybe getInput inputField text+    where+      inputField i a = button_ [type_ "submit", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)] $ toHtml c++-- | create a  @\<button type=\"reset\"\>\<\/button\>@ element+--+-- This element does not add any data to the form data set.+buttonReset :: (Monad m, FormError error, ToHtml children, Monad f) =>+               children+             -> Form m input error (HtmlT f ()) () ()+buttonReset c = G.inputNoData inputField Nothing+    where+      inputField i a = button_ [type_ "reset", id_ (toPathPiece i), name_ (toPathPiece i)] $ toHtml c++-- | create a  @\<button type=\"button\"\>\<\/button\>@ element+--+-- This element does not add any data to the form data set.+button :: (Monad m, FormError error, ToHtml children, Monad f) =>+          children+       -> Form m input error (HtmlT f ()) () ()+button c = G.inputNoData inputField Nothing+    where+      inputField i a = button_ [type_ "button", id_ (toPathPiece i), name_ (toPathPiece i)] $ toHtml c+++-- | 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, ToHtml children, Monad f) =>+         children+      -> Form m input error (HtmlT f ()) () ()+label c = G.label mkLabel+  where+  mkLabel i = label_ [for_ (toPathPiece i)] $ toHtml c++arbitraryHtml :: Monad m => view -> Form m input error view () ()+arbitraryHtml wrap = Form $ do+    id' <- getFormId+    return ( View (const $ wrap)+           , return (Ok $ Proved { proofs   = ()+                                 , pos      = unitRange id'+                                 , unProved = ()+                                 })+           )++inputInt :: (Monad m, FormError err, Applicative f)+  => (input -> Either err Int)+  -> Int+  -> Form m input err (HtmlT f ()) () Int+inputInt getInput initialValue = G.input getInput inputField initialValue+  where+  inputField i a = input_ [type_ "number", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece a)]++inputDouble :: (Monad m, FormError err, Applicative f)+  => (input -> Either err Double)+  -> Double+  -> Form m input err (HtmlT f ()) () Double+inputDouble getInput initialValue = G.input getInput inputField initialValue+  where+  inputField i a = input_ [type_ "number", step_ "any", id_ (toPathPiece i), name_ (toPathPiece i), value_ (T.pack $ show a)]++-- | Create a single @\<input type=\"checkbox\"\>@ element+--+-- returns a 'Bool' indicating if it was checked or not.+--+-- see also 'inputCheckboxes'+-- FIXME: Should this built on something in Generalized?+inputCheckbox :: forall x error input m f. (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, Applicative f) =>+                   Bool  -- ^ initially checked+                -> Form m input error (HtmlT f ()) () 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 =+          let checkbox  = input_ $ (if checked then (:) checked_ else id) +                                   [type_ "checkbox", id_ (toPathPiece i), name_ (toPathPiece i), value_ (toPathPiece i)]+          in+          return ( View $ const $ checkbox+                 , return $ Ok (Proved { proofs   = ()+                                       , pos      = unitRange i+                                       , unProved = if checked then True else False+                                       })+                 )++-- | Create a group of @\<input type=\"checkbox\"\>@ elements+--+inputCheckboxes :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, ToHtml lbl, Monad f) =>+                  [(a, lbl)]  -- ^ value, label, initially checked+                -> (a -> Bool) -- ^ function which indicates if a value should be checked initially+                -> Form m input error (HtmlT f ()) () [a]+inputCheckboxes choices isChecked =+    G.inputMulti choices mkCheckboxes isChecked+    where+      mkCheckboxes nm choices' = mconcat $ concatMap (mkCheckbox nm) choices'+      mkCheckbox nm (i, val, lbl, checked) =+          [ input_ $ ((if checked then (checked_ :) else id)+                     [type_ "checkbox", id_ (toPathPiece i), name_ (toPathPiece nm), value_ (toPathPiece val)])+          , label_ [for_ (toPathPiece i)] $ toHtml lbl+          ]++-- | Create a group of @\<input type=\"radio\"\>@ elements+inputRadio :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, ToHtml lbl, Monad f) =>+              [(a, lbl)]  -- ^ value, label, initially checked+           -> (a -> Bool) -- ^ isDefault+           -> Form m input error (HtmlT f ()) () a+inputRadio choices isDefault =+    G.inputChoice isDefault choices mkRadios+    where+      mkRadios nm choices' = mconcat $ concatMap (mkRadio nm) choices'+      mkRadio nm (i, val, lbl, checked) =+          [  input_ $ (if checked then (checked_ :) else id)+                      [type_ "radio", id_ (toPathPiece i), name_ (toPathPiece nm), value_ (toPathPiece val)]+          ,  label_ [for_ (toPathPiece i)] $ toHtml lbl+          ,  br_ []+          ]++-- | create @\<select\>\<\/select\>@ element plus its @\<option\>\<\/option\>@ children.+--+-- see also: 'selectMultiple'+select :: (Functor m, Monad m, FormError error, ErrorInputType error ~ input, FormInput input, ToHtml lbl, Monad f) +  => [(a, lbl)]  -- ^ value, label+  -> (a -> Bool) -- ^ isDefault, must match *exactly one* element in the list of choices+  -> Form m input error (HtmlT f ()) () a+select choices isDefault  =+  G.inputChoice isDefault choices mkSelect+  where+  mkSelect :: (ToHtml lbl, Monad f) => FormId -> [(a, Int, lbl, Bool)] -> HtmlT f ()+  mkSelect nm choices' =+    select_ [name_ (toPathPiece nm)] $+      traverse_ mkOption choices'++  mkOption :: (ToHtml lbl, Monad f) => (a, Int, lbl, Bool) -> HtmlT f ()+  mkOption (_, val, lbl, selected) =+    option_ +      ( (if selected then ((:) (selected_ "selected")) else id)+        [value_ (toPathPiece val)]+      )+      (toHtml lbl)++-- | 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, ToHtml lbl, Monad f)+  => [(a, lbl)]  -- ^ value, label, initially checked+  -> (a -> Bool)  -- ^ isSelected initially+  -> Form m input error (HtmlT f ()) () [a]+selectMultiple choices isSelected =+  G.inputMulti choices mkSelect isSelected+  where+  mkSelect :: (ToHtml lbl, Monad f) => FormId -> [(a, Int, lbl, Bool)] -> HtmlT f ()+  mkSelect nm choices' =+    select_ [name_ (toPathPiece nm), multiple_ "multiple"] $+      traverse_ mkOption choices'++  mkOption :: (ToHtml lbl, Monad f) => (a, Int, lbl, Bool) -> HtmlT f ()+  mkOption (_, val, lbl, selected) = option_+    ( (if selected then ((:) (selected_ "selected")) else id)+      [value_ (toPathPiece val)]+    ) +    (toHtml lbl)++{-+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, Applicative f) =>+                   [(groupLbl, [(a, lbl, Bool)])]  -- ^ value, label, initially checked+                -> Form m input error (HtmlT f ()) () [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>+-}++-- | 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, ToHtml error, Monad f) =>+             Form m input error (HtmlT f ()) () ()+errorList = G.errors mkErrors+  where+  mkErrors :: Monad f => ToHtml a => [a] -> HtmlT f ()+  mkErrors []   = mempty+  mkErrors errs = ul_ [class_ "reform-error-list"] $ traverse_ mkError errs+  mkError :: Monad f => ToHtml a => a -> HtmlT f ()+  mkError e     = li_ [] $ toHtml e++-- | create a @\<ul\>@ which contains all the errors related to the 'Form'.+--+-- Includes errors from child forms.+--+-- The @<\ul\>@ will have the attribute @class=\"reform-error-list\"@.+childErrorList :: (Monad m, ToHtml error, Monad f) =>+             Form m input error (HtmlT f ()) () ()+childErrorList = G.childErrors mkErrors+  where+  mkErrors :: Monad f => ToHtml a => [a] -> HtmlT f ()+  mkErrors []   = mempty+  mkErrors errs = ul_ [class_ "reform-error-list"] $ traverse_ mkError errs+  mkError :: Monad f => ToHtml a => a -> HtmlT f ()+  mkError e     = li_ [] $ toHtml e+++-- | create a @\<br\>@ tag.+br :: (Monad m, Applicative f) => Form m input error (HtmlT f ()) () ()+br = view (br_ [])++-- | wrap a @\<fieldset class=\"reform\"\>@ around a 'Form'+--+fieldset :: (Monad m, Functor m, Applicative f) =>+            Form m input error (HtmlT f ()) proof a+         -> Form m input error (HtmlT f ()) proof a+fieldset frm = mapView (fieldset_ [class_ "reform"]) frm++-- | wrap an @\<ol class=\"reform\"\>@ around a 'Form'+ol :: (Monad m, Functor m, Applicative f) =>+      Form m input error (HtmlT f ()) proof a+   -> Form m input error (HtmlT f ()) proof a+ol frm = mapView (ol_ [class_ "reform"]) frm++-- | wrap a @\<ul class=\"reform\"\>@ around a 'Form'+ul :: (Monad m, Functor m, Applicative f) =>+      Form m input error (HtmlT f ()) proof a+   -> Form m input error (HtmlT f ()) proof a+ul frm = mapView (ul_ [class_ "reform"]) frm++-- | wrap a @\<li class=\"reform\"\>@ around a 'Form'+li :: (Monad m, Functor m, Applicative f) =>+      Form m input error (HtmlT f ()) proof a+   -> Form m input error (HtmlT f ()) proof a+li frm = mapView (li_ [class_ "reform"]) frm++-- | create @\<form action=action method=\"GET\" enctype=\"multipart/form-data\"\>@+formGenGET :: (Applicative m)+  => Text -- ^ action url+  -> [(Text,Text)] -- ^ hidden fields to add to form+  -> HtmlT m b+  -> HtmlT m b+formGenGET action hidden children = do +  form_ [action_ action, method_ "GET", enctype_ "multipart/form-data"] $+       traverse_ mkHidden hidden+    *> children+  where+  mkHidden (name, value) = input_ [type_ "hidden", name_ name, value_ value]++-- | create @\<form action=action method=\"POST\" enctype=\"multipart/form-data\"\>@+formGenPOST :: (Applicative m)+  => Text -- ^ action url+  -> [(Text,Text)] -- ^ hidden fields to add to form+  -> HtmlT m b+  -> HtmlT m b+formGenPOST action hidden children = do +  form_ [action_ action, method_ "POST", enctype_ "multipart/form-data"] $+       traverse_ mkHidden hidden+    *> children+  where+  mkHidden (name, value) = input_ [type_ "hidden", name_ name, value_ value]++-- | add an attribute to the 'Html' for a form element.+setAttr :: (Monad m, Functor m, Applicative f) =>+           Form m input error (HtmlT f ()) proof a+         -> [Attribute]+         -> Form m input error (HtmlT f ()) proof a+setAttr form attr = mapView (\x -> x `with` attr) form
+ Text/Reform/Lucid/String.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, UndecidableInstances, ViewPatterns #-}+{- |+This module provides functions creating Reform using blaze-html 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.Blaze.Text".++-}+module Text.Reform.Lucid.String+    ( -- * \<input\> element+      inputText+    , inputPassword+    , inputSubmit+    , inputReset+    , inputHidden+    , inputButton+    , C.inputCheckbox+    , C.inputCheckboxes+    , C.inputRadio+    , C.inputFile+      -- * \<textarea\> element+    , textarea+      -- * \<button\> element+    , buttonSubmit+    , C.buttonReset+    , C.button+      -- * \<select\> element+    , C.select+    , C.selectMultiple+      -- * \<label\> element+    , C.label+      -- * errors+    , C.errorList+    , C.childErrorList+      -- * layout functions+    , C.br+    , C.fieldset+    , C.ol+    , C.ul+    , C.li+    , C.formGenGET+    , C.formGenPOST+    ) where++import Lucid (ToHtml, HtmlT)+import Text.Reform+import qualified Text.Reform.Lucid.Common as C++-- | Create an @\<input type=\"text\"\>@ element+inputText :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, Applicative f) =>+               String -- ^ initial value+            -> Form m input error (HtmlT f ()) () String+inputText initialValue = C.inputText getInputString initialValue++-- | Create an @\<input type=\"password\"\>@ element+inputPassword :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, Applicative f) =>+                 Form m input error (HtmlT f ()) () 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, Applicative f) =>+               String -- ^ @value@ attribute. Used for button label, and value if button is submitted.+            -> Form m input error (HtmlT f ()) () (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, Applicative f) =>+              String -- ^ value attribute. Used only to label the button.+           -> Form m input error (HtmlT f ()) () ()+inputReset = C.inputReset++-- | Create an @\<input type=\"hidden\"\>@ element+inputHidden :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, Applicative f) =>+               String -- ^ value to store in the hidden element+            -> Form m input error (HtmlT f ()) () 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, Applicative f) =>+               String -- ^ value attribute. Used to label the button.+            -> Form m input error (HtmlT f ()) () ()+inputButton label = C.inputButton label++-- | Create a \<textarea\>\<\/textarea\> element+textarea :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, Monad f) =>+            Int    -- ^ cols+         -> Int    -- ^ rows+         -> String -- ^ initial contents+         -> Form m input error (HtmlT f ()) () 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, ToHtml children, Monad f) =>+                String -- ^ value attribute. Returned if this button submits the form.+             -> children -- ^ children to embed in the \<button\>+             -> Form m input error (HtmlT f ()) () (Maybe String)+buttonSubmit = C.buttonSubmit getInputString
+ Text/Reform/Lucid/Text.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeFamilies, UndecidableInstances, ViewPatterns #-}+{- |+This module provides functions creating Reform using blaze-html 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.Blaze.String".++-}+module Text.Reform.Lucid.Text+    ( -- * \<input\> element+      inputText+    , inputPassword+    , inputSubmit+    , inputReset+    , inputHidden+    , inputButton+    , C.inputCheckbox+    , C.inputCheckboxes+    , C.inputRadio+    , C.inputFile+      -- * \<textarea\> element+    , textarea+      -- * \<button\> element+    , buttonSubmit+    , C.buttonReset+    , C.button+      -- * \<select\> element+    , C.select+    , C.selectMultiple+      -- * \<label\> element+    , C.label+      -- * errors+    , C.errorList+    , C.childErrorList+      -- * layout functions+    , C.br+    , C.fieldset+    , C.ol+    , C.ul+    , C.li+    , C.formGenGET+    , C.formGenPOST+    ) where++import Data.Text (Text, empty)+import Lucid (ToHtml, HtmlT)+import Text.Reform+import qualified Text.Reform.Lucid.Common as C++-- | Create an @\<input type=\"text\"\>@ element+inputText :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, Applicative f) =>+               Text -- ^ initial value+            -> Form m input error (HtmlT f ()) () Text+inputText initialValue = C.inputText getInputText initialValue++-- | Create an @\<input type=\"password\"\>@ element+inputPassword :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, Applicative f) =>+                 Form m input error (HtmlT f ()) () 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, Applicative f) =>+               Text -- ^ @value@ attribute. Used for button label, and value if button is submitted.+            -> Form m input error (HtmlT f ()) () (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, Applicative f) =>+              Text -- ^ value attribute. Used only to label the button.+           -> Form m input error (HtmlT f ()) () ()+inputReset = C.inputReset++-- | Create an @\<input type=\"hidden\"\>@ element+inputHidden :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, Applicative f) =>+               Text -- ^ value to store in the hidden element+            -> Form m input error (HtmlT f ()) () 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, Applicative f) =>+               Text -- ^ value attribute. Used to label the button.+            -> Form m input error (HtmlT f ()) () ()+inputButton label = C.inputButton label++-- | Create a \<textarea\>\<\/textarea\> element+textarea :: (Monad m, FormInput input, FormError error, ErrorInputType error ~ input, Monad f) =>+            Int    -- ^ cols+         -> Int    -- ^ rows+         -> Text -- ^ initial contents+         -> Form m input error (HtmlT f ()) () 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, ToHtml children, Monad f) =>+                Text -- ^ value attribute. Returned if this button submits the form.+             -> children -- ^ children to embed in the \<button\>+             -> Form m input error (HtmlT f ()) () (Maybe Text)+buttonSubmit = C.buttonSubmit getInputText
+ reform-lucid.cabal view
@@ -0,0 +1,30 @@+Name:                reform-lucid+Version:             0.0.1.0+Synopsis:            Add support for using lucid with Reform+Description:         Reform is a library for building and validating forms using applicative functors. This package add support for using reform with blaze-html.+License:             BSD3+License-file:        LICENSE+Author:              Jeremy Shaw, Zachary Churchill+Maintainer:          zacharyachurchill@gmail.com+Copyright:           2012 Jeremy Shaw, SeeReason Partners LLC,+                     2019 Zachar Churchill+Category:            Web+Build-type:          Simple+Cabal-version:       >=1.6++source-repository head+  type:     git+  location: https://github.com/goolord/reform-lucid.git++Library+  exposed-modules: +    Text.Reform.Lucid.Common+    Text.Reform.Lucid.String+    Text.Reform.Lucid.Text++  build-depends:+      base >4.5 && <5+    , lucid < 3.0.0+    , reform == 0.2.*+    , text >= 0.11 && < 1.3+    , path-pieces