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

Error messages are now deleted with fields and are highlighted correctly

Browse Source
This commit is contained in:
Burtannia 2020-11-13 22:25:44 +00:00
parent 39ed1f6453
commit a3319f766a
1 changed files with 37 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -26,7 +26,7 @@ import Control.Arrow (second)
import Control.Monad (liftM) import Control.Monad (liftM)
import Control.Monad.Trans.RWS (ask, tell) import Control.Monad.Trans.RWS (ask, tell)
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Maybe (fromJust, listToMaybe, fromMaybe) import Data.Maybe (fromJust, listToMaybe, fromMaybe, isJust)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Yesod.Core import Yesod.Core
@ -47,6 +47,7 @@ instance ToJavascript Text where toJavascript = toJavascript . toJSON
data MultiSettings site = MultiSettings 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. , msDelClass :: Text -- ^ Class to be applied to the "delete" button.
, 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. , 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. , 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. , msErrWidget :: Maybe (Html -> WidgetFor site ()) -- ^ Only used in applicative forms. Create a widget for displaying errors.
@ -64,18 +65,18 @@ data MultiView site = MultiView
-- --
-- @since 1.6.0 -- @since 1.6.0
bs3Settings :: MultiSettings site bs3Settings :: MultiSettings site
bs3Settings = MultiSettings "btn btn-default" "btn btn-danger" Nothing Nothing (Just errW) bs3Settings = MultiSettings "btn btn-default" "btn btn-danger" "has-error" Nothing Nothing (Just errW)
where where
errW err = errW err =
[whamlet| [whamlet|
<span .help-block .error-block>#{err} <span .help-block>#{err}
|] |]
-- | 'MultiSettings' for Bootstrap 4. -- | 'MultiSettings' for Bootstrap 4.
-- --
-- @since 1.6.0 -- @since 1.6.0
bs4Settings :: MultiSettings site bs4Settings :: MultiSettings site
bs4Settings = MultiSettings "btn btn-basic" "btn btn-danger" Nothing Nothing (Just errW) bs4Settings = MultiSettings "btn btn-basic" "btn btn-danger" "has-error" Nothing Nothing (Just errW)
where where
errW err = errW err =
[whamlet| [whamlet|
@ -86,20 +87,20 @@ bs4Settings = MultiSettings "btn btn-basic" "btn btn-danger" Nothing Nothing (Ju
-- --
-- @since 1.6.0 -- @since 1.6.0
bs3FASettings :: MultiSettings site bs3FASettings :: MultiSettings site
bs3FASettings = MultiSettings "btn btn-default" "btn btn-danger" addIcon delIcon (Just errW) bs3FASettings = MultiSettings "btn btn-default" "btn btn-danger" "has-error" addIcon delIcon (Just errW)
where where
addIcon = Just [shamlet|<i class="fas fa-plus">|] addIcon = Just [shamlet|<i class="fas fa-plus">|]
delIcon = Just [shamlet|<i class="fas fa-trash-alt">|] delIcon = Just [shamlet|<i class="fas fa-trash-alt">|]
errW err = errW err =
[whamlet| [whamlet|
<span .help-block .error-block>#{err} <span .help-block>#{err}
|] |]
-- | 'MultiSettings' for Bootstrap 4 with Font Awesome 5 Icons. -- | 'MultiSettings' for Bootstrap 4 with Font Awesome 5 Icons.
-- --
-- @since 1.6.0 -- @since 1.6.0
bs4FASettings :: MultiSettings site bs4FASettings :: MultiSettings site
bs4FASettings = MultiSettings "btn btn-basic" "btn btn-danger" addIcon delIcon (Just errW) bs4FASettings = MultiSettings "btn btn-basic" "btn btn-danger" "has-error" addIcon delIcon (Just errW)
where where
addIcon = Just [shamlet|<i class="fas fa-plus">|] addIcon = Just [shamlet|<i class="fas fa-plus">|]
delIcon = Just [shamlet|<i class="fas fa-trash-alt">|] delIcon = Just [shamlet|<i class="fas fa-trash-alt">|]
@ -131,10 +132,6 @@ amulti field fs defs minVals ms = formToAForm $
$forall fv <- mvFields $forall fv <- mvFields
^{fvInput fv} ^{fvInput fv}
$maybe err <- fvErrors fv
$maybe errW <- msErrWidget ms
^{errW err}
^{fvInput mvAddBtn} ^{fvInput mvAddBtn}
|] |]
(fv : _) = mvFields (fv : _) = mvFields
@ -206,7 +203,7 @@ mhelperMulti field@Field {..} fs@FieldSettings {..} wrapperClass defs minVals Mu
Just p -> mkRes intField cfs p mfs cName onMissingFail FormSuccess Just p -> mkRes intField cfs p mfs cName onMissingFail FormSuccess
-- generate counter view -- generate counter view
cView <- mkView intField cfs cr Nothing cid cName True cView <- mkView intField cfs cr Nothing Nothing msWrapperErrClass cid cName True
let counter = case cRes of let counter = case cRes of
FormSuccess c -> c FormSuccess c -> c
@ -232,14 +229,14 @@ mhelperMulti field@Field {..} fs@FieldSettings {..} wrapperClass defs minVals Mu
if (numFields == 1) if (numFields == 1)
field.val(""); field.val("");
else else
field.parent().remove(); field.parent().parent().remove();
} }
|] |]
mkDelBtn fieldId = do mkDelBtn fieldId = do
let delBtnId = delBtnPrefix <> fieldId let delBtnId = delBtnPrefix <> fieldId
[whamlet| [whamlet|
<button ##{delBtnId} .#{msDelClass} style="margin-bottom: 1rem; margin-left: 1rem" type="button"> <button ##{delBtnId} .#{msDelClass} style="margin-left: 1rem" type="button">
$maybe inner <- msDelInner $maybe inner <- msDelInner
#{inner} #{inner}
$nothing $nothing
@ -257,7 +254,7 @@ mhelperMulti field@Field {..} fs@FieldSettings {..} wrapperClass defs minVals Mu
(rs, fvs) <- do (rs, fvs) <- do
let mkView' ((n,i), r@(res, _)) = do let mkView' ((n,i), r@(res, _)) = do
let del = Just (mkDelBtn i, wrapperClass) let del = Just (mkDelBtn i, wrapperClass)
fv <- mkView field fs r del i n False fv <- mkView field fs r del msErrWidget msWrapperErrClass i n False
return (res, fv) return (res, fv)
xs = zip (mkNames counter) results xs = zip (mkNames counter) results
notSuccNothing (_, (r,_)) = not $ isSuccNothing r notSuccNothing (_, (r,_)) = not $ isSuccNothing r
@ -292,6 +289,9 @@ mhelperMulti field@Field {..} fs@FieldSettings {..} wrapperClass defs minVals Mu
toWidget toWidget
[lucius| [lucius|
.#{wrapperClass} { .#{wrapperClass} {
margin-bottom: 1rem;
}
.#{wrapperClass}-inner {
display: flex; display: flex;
flex-direction: row; flex-direction: row;
} }
@ -309,12 +309,14 @@ mhelperMulti field@Field {..} fs@FieldSettings {..} wrapperClass defs minVals Mu
var newDelId = #{delBtnPrefix} + newId; var newDelId = #{delBtnPrefix} + newId;
var newWrapper = $("." + #{wrapperClass}).first().clone(); var newWrapper = $("." + #{wrapperClass}).first().clone();
var newField = newWrapper.children("[id^=" + #{theId} + "]"); newWrapper.children( ":not(." + #{wrapperClass} + "-inner)" ).remove(); // remove error messages
var newField = newWrapper.find("[id^=" + #{theId} + "]");
newField.val("").attr('name', newName).attr('id', newId); newField.val("").attr('name', newName).attr('id', newId);
var newDelBtn = newWrapper.children("[id^=" + #{delBtnPrefix} + "]"); var newDelBtn = newWrapper.find("[id^=" + #{delBtnPrefix} + "]");
newDelBtn.attr('id', newDelId); newDelBtn.attr('id', newDelId);
newDelBtn.click(() => deleteField(newField)); newDelBtn.click(() => deleteField(newField));
newWrapper.insertBefore("#" + #{addBtnId}); newWrapper.insertBefore("#" + #{addBtnId});
}); });
@ -360,21 +362,32 @@ mkView :: (site ~ HandlerSite m, MonadHandler m)
=> Field m a => Field m a
-> FieldSettings site -> FieldSettings site
-> (FormResult b, Either Text a) -> (FormResult b, Either Text a)
-> Maybe (WidgetFor site (), Text) -- ^ Delete button widget and class for div wrapping each field with it's delete button. -> Maybe (WidgetFor site (), Text) -- Delete button widget and class for div wrapping each field with it's delete button.
-> Maybe (Html -> WidgetFor site ()) -- Function to display error messages.
-> Text
-> Text -> Text
-> Text -> Text
-> Bool -> Bool
-> MForm m (FieldView site) -> MForm m (FieldView site)
mkView Field {..} FieldSettings {..} (res, val) mdel theId name isReq = do mkView Field {..} FieldSettings {..} (res, val) mdel merrW errClass theId name isReq = do
(_, site, langs) <- ask (_, site, langs) <- ask
let mr2 = renderMessage site langs let mr2 = renderMessage site langs
merr = case res of
FormFailure [e] -> Just $ toHtml e
_ -> Nothing
fv' = fieldView theId name fsAttrs val isReq fv' = fieldView theId name fsAttrs val isReq
fv = do fv = do
[whamlet| [whamlet|
$maybe (delBtn, wrapperClass) <- mdel $maybe (delBtn, wrapperClass) <- mdel
<div .#{wrapperClass}> <div .#{wrapperClass} :isJust merr:.#{errClass}>
^{fv'} <div .#{wrapperClass}-inner>
^{delBtn} ^{fv'}
^{delBtn}
$maybe err <- merr
$maybe errW <- merrW
^{errW err}
$nothing $nothing
^{fv'} ^{fv'}
|] |]
@ -383,9 +396,6 @@ mkView Field {..} FieldSettings {..} (res, val) mdel theId name isReq = do
, fvTooltip = fmap toHtml $ fmap mr2 fsTooltip , fvTooltip = fmap toHtml $ fmap mr2 fsTooltip
, fvId = theId , fvId = theId
, fvInput = fv , fvInput = fv
, fvErrors = , fvErrors = merr
case res of
FormFailure [e] -> Just $ toHtml e
_ -> Nothing
, fvRequired = isReq , fvRequired = isReq
} }