haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #1707 from yesodweb/multi-form-delete-button

Browse Source 
Multi form delete button
This commit is contained in:
Michael Snoyman 2020-11-20 08:31:48 +02:00 committed by GitHub
commit 95dc598d4b
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 281 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
yesod-form-multi/ChangeLog.md
View File

@ -1,5 +1,20 @@
# Changelog
## 1.7.0
[#1707](https://github.com/yesodweb/yesod/pull/1707)
* Added delete buttons
* Added support for custom text or icons inside add/delete buttons
* Added new presets for Bootstrap + Font Awesome icons
* Added support for more complex fields that have multiple parts stuch as radio fields
* Improved support for fields that rely on hidden inputs like WYSIWYG editors
* Fixed redundant class in existing Bootstrap presets
* Fixed styling not applying to error messages on individual fields
* Tooltips now show once at the top of the multi-field group when using `amulti`
## 1.6.0
* Added `Yesod.Form.MultiInput` which supports multi-input forms without needing to submit the form to add an input field [#1601](https://github.com/yesodweb/yesod/pull/1601)
[#1601](https://github.com/yesodweb/yesod/pull/1601)
* Added `Yesod.Form.MultiInput` which supports multi-input forms without needing to submit the form to add an input field

4
yesod-form-multi/README.md
View File

@ -1,7 +1,5 @@
## yesod-form-multi
Support for creating forms in which the user can specify how many inputs to submit. Includes support for enforcing a minimum number of values.
Intended as an alternative to `Yesod.Form.MassInput`.
# Limitations
- If the user adds too many fields then there is currently no support for a "delete button" although fields submitted empty are considered to be deleted.
Intended as an alternative to `Yesod.Form.MassInput`.

306
yesod-form-multi/Yesod/Form/MultiInput.hs
View File

@ -17,16 +17,19 @@ module Yesod.Form.MultiInput
, mmulti
, amulti
, bs3Settings
, bs3FASettings
, bs4Settings
, bs4FASettings
) where
import Control.Arrow (second)
import Control.Monad (liftM)
import Control.Monad.Trans.RWS (ask, tell)
import qualified Data.Map as Map
import Data.Maybe (fromJust, listToMaybe, fromMaybe)
import Data.Maybe (fromJust, listToMaybe, fromMaybe, isJust)
import Data.Text (Text)
import qualified Data.Text as T
import Text.Julius (rawJS)
import Yesod.Core
import Yesod.Form.Fields (intField)
import Yesod.Form.Functions
@ -41,43 +44,132 @@ instance ToJavascript Text where toJavascript = toJavascript . toJSON
#endif
#endif
-- @since 1.6.0
-- | By default delete buttons have a @margin-left@ property of @0.75rem@.
-- You can override this by specifying an alternative value in a class
-- which is then passed inside 'MultiSettings'.
--
-- @since 1.7.0
data MultiSettings site = MultiSettings
{ msAddClass :: Text -- ^ Class to be applied to the "add another" button.
{ msAddClass :: !Text -- ^ Class to be applied to the "add another" button.
, msDelClass :: !Text -- ^ Class to be applied to the "delete" button.
, msTooltipClass :: Text -- ^ Only used in applicative forms. Class to be applied to the tooltip.
, msWrapperErrClass :: !Text -- ^ Class to be applied to the wrapper if it's field has an error.
, msAddInner :: !(Maybe Html) -- ^ Inner Html of add button, defaults to "Add Another". Useful for adding icons inside buttons.
, msDelInner :: !(Maybe Html) -- ^ Inner Html of delete button, defaults to "Delete". Useful for adding icons inside buttons.
, msErrWidget :: Maybe (Html -> WidgetFor site ()) -- ^ Only used in applicative forms. Create a widget for displaying errors.
}
-- @since 1.6.0
-- | The general structure of each individually generated field is as follows.
-- There is an external wrapper element containing both an inner wrapper and any
-- error messages that apply to that specific field. The inner wrapper contains
-- both the field and it's corresponding delete button.
--
-- The structure is illustrated by the following:
--
-- > <div .#{wrapperClass}>
-- > <div .#{wrapperClass}-inner>
-- > ^{fieldWidget}
-- > ^{deleteButton}
-- > ^{maybeErrorMessages}
--
-- Each wrapper element has the same class which is automatically generated. This class
-- is returned in the 'MultiView' should you wish to change the styling. The inner wrapper
-- uses the same class followed by @-inner@. By default the wrapper and inner wrapper has
-- classes are as follows:
--
-- > .#{wrapperClass} {
-- > margin-bottom: 1rem;
-- > }
-- >
-- > .#{wrapperClass}-inner {
-- > display: flex;
-- > flex-direction: row;
-- > }
--
-- @since 1.7.0
data MultiView site = MultiView
{ mvCounter :: FieldView site -- ^ Hidden counter field.
, mvFields :: [FieldView site] -- ^ Input fields.
, mvAddBtn :: FieldView site -- ^ Button to add another field.
, mvWrapperClass :: Text -- ^ Class applied to a div wrapping each field with it's delete button.
}
-- | 'MultiSettings' for Bootstrap 3.
--
-- @since 1.6.0
bs3Settings :: MultiSettings site
bs3Settings = MultiSettings "btn btn-default" (Just errW)
bs3Settings = MultiSettings
"btn btn-default"
"btn btn-danger"
"help-block"
"has-error"
Nothing Nothing (Just errW)
where
errW err =
[whamlet|
<span .help-block .error-block>#{err}
<span .help-block>#{err}
|]
-- | 'MultiSettings' for Bootstrap 4.
--
-- @since 1.6.0
bs4Settings :: MultiSettings site
bs4Settings = MultiSettings "btn btn-basic" (Just errW)
bs4Settings = MultiSettings
"btn btn-secondary"
"btn btn-danger"
"form-text text-muted"
"has-error"
Nothing Nothing (Just errW)
where
errW err =
[whamlet|
<div .invalid-feedback>#{err}
|]
-- | 'MultiSettings' for Bootstrap 3 with Font Awesome 5 Icons.
-- Uses @fa-plus@ for the add button and @fa-trash-alt@ for the delete button.
--
-- @since 1.7.0
bs3FASettings :: MultiSettings site
bs3FASettings = MultiSettings
"btn btn-default"
"btn btn-danger"
"help-block"
"has-error"
addIcon delIcon (Just errW)
where
addIcon = Just [shamlet|<i class="fas fa-plus">|]
delIcon = Just [shamlet|<i class="fas fa-trash-alt">|]
errW err =
[whamlet|
<span .help-block>#{err}
|]
-- | 'MultiSettings' for Bootstrap 4 with Font Awesome 5 Icons.
-- Uses @fa-plus@ for the add button and @fa-trash-alt@ for the delete button.
--
-- @since 1.7.0
bs4FASettings :: MultiSettings site
bs4FASettings = MultiSettings
"btn btn-secondary"
"btn btn-danger"
"form-text text-muted"
"has-error"
addIcon delIcon (Just errW)
where
addIcon = Just [shamlet|<i class="fas fa-plus">|]
delIcon = Just [shamlet|<i class="fas fa-trash-alt">|]
errW err =
[whamlet|
<div .invalid-feedback>#{err}
|]
-- | Applicative equivalent of 'mmulti'.
--
-- Note about tooltips:
-- Rather than displaying the tooltip alongside each field the
-- tooltip is displayed once at the top of the multi-field set.
--
-- @since 1.6.0
amulti :: (site ~ HandlerSite m, MonadHandler m, RenderMessage site FormMessage)
=> Field m a
@ -92,20 +184,19 @@ amulti field fs defs minVals ms = formToAForm $
mform = do
(fr, MultiView {..}) <- mmulti field fs defs minVals ms
let widget = do
let (fv : _) = mvFields
widget = do
[whamlet|
$maybe tooltip <- fvTooltip fv
<small .#{msTooltipClass ms}>#{tooltip}
^{fvInput mvCounter}
$forall fv <- mvFields
^{fvInput fv}
$maybe err <- fvErrors fv
$maybe errW <- msErrWidget ms
^{errW err}
^{fvInput mvAddBtn}
|]
(fv : _) = mvFields
view = FieldView
{ fvLabel = fvLabel fv
, fvTooltip = Nothing
@ -130,11 +221,10 @@ mmulti :: (site ~ HandlerSite m, MonadHandler m, RenderMessage site FormMessage)
-> Int
-> MultiSettings site
-> MForm m (FormResult [a], MultiView site)
mmulti field fs@FieldSettings {..} defs minVals ms = do
fieldClass <- newFormIdent
let fs' = fs {fsAttrs = addClass fieldClass fsAttrs}
minVals' = if minVals < 0 then 0 else minVals
mhelperMulti field fs' fieldClass defs minVals' ms
mmulti field fs defs minVals' ms = do
wrapperClass <- lift newIdent
let minVals = if minVals' < 0 then 0 else minVals'
mhelperMulti field fs wrapperClass defs minVals ms
-- Helper function, does most of the work for mmulti.
mhelperMulti :: (site ~ HandlerSite m, MonadHandler m, RenderMessage site FormMessage)
@ -145,21 +235,22 @@ mhelperMulti :: (site ~ HandlerSite m, MonadHandler m, RenderMessage site FormMe
-> Int
-> MultiSettings site
-> MForm m (FormResult [a], MultiView site)
mhelperMulti field@Field {..} fs@FieldSettings {..} fieldClass defs minVals MultiSettings {..} = do
mhelperMulti field@Field {..} fs@FieldSettings {..} wrapperClass defs minVals MultiSettings {..} = do
mp <- askParams
(_, site, langs) <- ask
name <- maybe newFormIdent return fsName
theId <- maybe newFormIdent return fsId
theId <- lift $ maybe newIdent return fsId
cName <- newFormIdent
cid <- newFormIdent
addBtnId <- newFormIdent
cid <- lift newIdent
addBtnId <- lift newIdent
delBtnPrefix <- lift newIdent
let mr2 = renderMessage site langs
cDef = length defs
cfs = FieldSettings "" Nothing (Just cid) (Just cName) [("hidden", "true")]
mkName i = name `T.append` (T.pack $ '-' : show i)
mkId i = theId `T.append` (T.pack $ '-' : show i)
mkNames c = [(mkName i, mkId i) | i <- [0 .. c]]
mkNames c = [(i, (mkName i, mkId i)) | i <- [0 .. c]]
onMissingSucc _ _ = FormSuccess Nothing
onMissingFail m l = FormFailure [renderMessage m l MsgValueRequired]
isSuccNothing r = case r of
@ -174,7 +265,7 @@ mhelperMulti field@Field {..} fs@FieldSettings {..} fieldClass defs minVals Mult
Just p -> mkRes intField cfs p mfs cName onMissingFail FormSuccess
-- generate counter view
cView <- mkView intField cfs cr cid cName True
cView <- mkView intField cfs cr Nothing Nothing msWrapperErrClass cid cName True
let counter = case cRes of
FormSuccess c -> c
@ -186,17 +277,71 @@ mhelperMulti field@Field {..} fs@FieldSettings {..} fieldClass defs minVals Mult
if cDef == 0
then [(FormMissing, Left "")]
else [(FormMissing, Right d) | d <- defs]
Just p -> mapM (\n -> mkRes field fs p mfs n onMissingSucc (FormSuccess . Just)) (map fst $ mkNames counter)
Just p -> mapM
(\n -> mkRes field fs p mfs n onMissingSucc (FormSuccess . Just))
(map (fst . snd) $ mkNames counter)
-- delete button
-- The delFunction is included down with the add button rather than with
-- each delete button to ensure that the function only gets included once.
let delFunction = toWidget
[julius|
function deleteField_#{rawJS theId}(wrapper) {
var numFields = $('.#{rawJS wrapperClass}').length;
if (numFields == 1)
{
wrapper.find("*").each(function() {
removeVals($(this));
});
}
else
wrapper.remove();
}
function removeVals(e) {
// input types where we don't want to reset the value
const keepValueTypes = ["radio", "checkbox", "button"];
// uncheck any checkboxes or radio fields and empty any text boxes
if(e.prop('checked') == true)
e.prop('checked', false);
if(!keepValueTypes.includes(e.prop('type')))
e.val("").trigger("change");
// trigger change is to ensure WYSIWYG editors are updated
// when their hidden code field is cleared
}
|]
mkDelBtn fieldId = do
let delBtnId = delBtnPrefix `T.append` fieldId
[whamlet|
<button ##{delBtnId} .#{msDelClass} style="margin-left: 0.75rem" type="button">
$maybe inner <- msDelInner
#{inner}
$nothing
Delete
|]
toWidget
[julius|
$('##{rawJS delBtnId}').click(function() {
var field = $('##{rawJS fieldId}');
deleteField_#{rawJS theId}(field.parents('.#{rawJS wrapperClass}'));
});
|]
-- generate field views
(rs, fvs) <- do
let mkView' ((n,i), r@(res, _)) = do
fv <- mkView field fs r i n False
let mkView' ((c, (n,i)), r@(res, _)) = do
let del = Just (mkDelBtn i, wrapperClass, c)
fv <- mkView field fs r del msErrWidget msWrapperErrClass i n True
return (res, fv)
xs = zip (mkNames counter) results
notSuccNothing (_, (r,_)) = not $ isSuccNothing r
ys = case filter notSuccNothing xs of
[] -> [((mkName 0, mkId 0), (FormSuccess Nothing, Left ""))] -- always need at least one value to generate a field
[] -> [((0, (mkName 0, mkId 0)), (FormSuccess Nothing, Left ""))] -- always need at least one value to generate a field
zs -> zs
rvs <- mapM mkView' ys
return $ unzip rvs
@ -214,23 +359,77 @@ mhelperMulti field@Field {..} fs@FieldSettings {..} fieldClass defs minVals Mult
fRes -> (fRes, False)
-- create add button
-- also includes some styling / functions that we only want to include once
btnWidget = do
[whamlet|
<button ##{addBtnId} .#{msAddClass} type="button">Add Another
<button ##{addBtnId} .#{msAddClass} type="button">
$maybe inner <- msAddInner
#{inner}
$nothing
Add Another
|]
toWidget
[lucius|
.#{wrapperClass} {
margin-bottom: 1rem;
}
.#{wrapperClass}-inner {
display: flex;
flex-direction: row;
}
|]
delFunction -- function used by delete buttons, included here so that it only gets included once
toWidget
[julius|
var extraFields = 0;
$("#" + #{addBtnId}).click(function() {
extraFields++;
var newNumber = parseInt(#{show counter}) + extraFields;
var extraFields_#{rawJS theId} = 0;
$('##{rawJS addBtnId}').click(function() {
extraFields_#{rawJS theId}++;
var newNumber = parseInt(#{show counter}) + extraFields_#{rawJS theId};
$("#" + #{cid}).val(newNumber);
var newName = #{name} + "-" + newNumber;
var newId = #{theId} + "-" + newNumber;
var newDelId = #{delBtnPrefix} + newId;
var newElem = $("." + #{fieldClass}).first().clone();
newElem.val("").attr('name', newName).attr('id', newId);
newElem.insertBefore("#" + #{addBtnId})
// get new wrapper and remove old error messages
var newWrapper = $('.#{rawJS wrapperClass}').first().clone();
newWrapper.children( ':not(.#{rawJS wrapperClass}-inner)' ).remove();
newWrapper.removeClass(#{msWrapperErrClass});
// get counter from wrapper
var oldCount = newWrapper.data("counter");
var oldName = #{name} + "-" + oldCount;
var oldId = #{theId} + "-" + oldCount;
var oldDelBtn = #{delBtnPrefix} + oldId;
// replace any id, name or for attributes that began with
// the old values and replace them with the new values
var idRegex = new RegExp("^" + oldId);
var nameRegex = new RegExp("^" + oldName);
var els = newWrapper.find("*");
els.each(function() {
var e = $(this);
if(e.prop('id') != undefined)
e.prop('id', e.prop('id').replace(idRegex, newId));
if(e.prop('name') != undefined)
e.prop('name', e.prop('name').replace(nameRegex, newName));
if(e.prop('for') != undefined)
e.prop('for', e.prop('for').replace(idRegex, newId)); // radio fields use id in for attribute
removeVals(e);
});
// set new counter on wrapper
newWrapper.attr("data-counter", newNumber);
var newDelBtn = newWrapper.find('[id^=#{rawJS delBtnPrefix}]');
newDelBtn.prop('id', newDelId);
newDelBtn.click(() => deleteField_#{rawJS theId}(newWrapper));
newWrapper.insertBefore('##{rawJS addBtnId}');
});
|]
@ -243,7 +442,7 @@ mhelperMulti field@Field {..} fs@FieldSettings {..} fieldClass defs minVals Mult
, fvRequired = False
}
return (res, MultiView cView fvs btnView)
return (res, MultiView cView fvs btnView wrapperClass)
-- Search for the given field's name in the environment,
-- parse any values found and construct a FormResult.
@ -274,21 +473,42 @@ mkView :: (site ~ HandlerSite m, MonadHandler m)
=> Field m a
-> FieldSettings site
-> (FormResult b, Either Text a)
-- Delete button widget, class for div wrapping each field with it's delete button and counter value for that field.
-- Nothing if the field passed doesn't need a delete button e.g. if it is the counter field.
-> Maybe (WidgetFor site (), Text, Int)
-> Maybe (Html -> WidgetFor site ()) -- Function to display error messages.
-> Text
-> Text
-> Text
-> Bool
-> MForm m (FieldView site)
mkView Field {..} FieldSettings {..} (res, val) theId name isReq = do
mkView Field {..} FieldSettings {..} (res, val) mdel merrW errClass theId name isReq = do
(_, site, langs) <- ask
let mr2 = renderMessage site langs
merr = case res of
FormFailure [e] -> Just $ toHtml e
_ -> Nothing
fv' = fieldView theId name fsAttrs val isReq
fv = do
[whamlet|
$maybe (delBtn, wrapperClass, counter) <- mdel
<div .#{wrapperClass} :isJust merr:.#{errClass} data-counter=#{counter}>
<div .#{wrapperClass}-inner>
^{fv'}
^{delBtn}
$maybe err <- merr
$maybe errW <- merrW
^{errW err}
$nothing
^{fv'}
|]
return $ FieldView
{ fvLabel = toHtml $ mr2 fsLabel
, fvTooltip = fmap toHtml $ fmap mr2 fsTooltip
, fvId = theId
, fvInput = fieldView theId name fsAttrs val isReq
, fvErrors =
case res of
FormFailure [e] -> Just $ toHtml e
_ -> Nothing
, fvInput = fv
, fvErrors = merr
, fvRequired = isReq
}

2
yesod-form-multi/yesod-form-multi.cabal
View File

@ -1,5 +1,5 @@
name: yesod-form-multi
version: 1.6.0
version: 1.7.0
license: MIT
license-file: LICENSE
author: James Burton <jamesejburton@gmail.com>