fix(schedule): button without value parse

This commit is contained in:
Sarah Vaupel 2020-10-24 15:38:32 +02:00
parent cb61482b83
commit 04341d2e49
2 changed files with 29 additions and 8 deletions

View File

@ -33,11 +33,11 @@ postScheduleR = do
scheduleOptionsForm :: Html -> MForm (HandlerFor UniWorX) (FormResult ScheduleOptions, Widget)
scheduleOptionsForm csrf = do
(viewRess, viewWidgets) <- fmap unzip . for (universeF :: [ScheduleView]) $ \sView ->
mopt (buttonField ScheduleOptions
{ scheduleView = sView
, scheduleOffset = ScheduleOffsetNone
, scheduleOptionsAction = ScheduleSetView
})
mopt (buttonFieldNoParse ScheduleOptions
{ scheduleView = sView
, scheduleOffset = ScheduleOffsetNone
, scheduleOptionsAction = ScheduleSetView
})
("" { fsName = Just $ toPathPiece GetScheduleOptions
, fsAttrs = if sView == scheduleView currentScheduleOptions then [("disabled","")] else mempty
}) Nothing
@ -74,9 +74,9 @@ postScheduleR = do
_ -> mempty
(offsetRess, offsetWidgets) <- fmap unzip . for offsetBtns $ \btn ->
mopt (buttonField btn) ("" { fsName = Just $ toPathPiece GetScheduleOptions
, fsAttrs = if offsetInDays (scheduleOffset btn) == offsetInDays (scheduleOffset currentScheduleOptions) then [("disabled","")] else mempty
}) Nothing
mopt (buttonFieldNoParse btn) ("" { fsName = Just $ toPathPiece GetScheduleOptions
, fsAttrs = if offsetInDays (scheduleOffset btn) == offsetInDays (scheduleOffset currentScheduleOptions) then [("disabled","")] else mempty
}) Nothing
offsetRes <- if
-- TODO: ignoring FormFailures for now
-- | Just errs <- fromNullable (filter (is _FormFailure) offsetRess) -> do

View File

@ -332,6 +332,27 @@ buttonField btn = Field{..}
| otherwise = return . Left $ SomeMessage MsgWrongButtonValue
fieldParse _ _ = return . Left $ SomeMessage MsgMultipleButtonValues
-- | Similar to buttonField, but with dummy fieldParse
buttonFieldNoParse :: forall a m.
( Button (HandlerSite m) a
, MonadHandler m
) => a -> Field m a
buttonFieldNoParse btn = Field{..}
where
fieldEnctype = UrlEncoded
fieldView :: FieldViewFunc m a
fieldView fid name attrs _val _ = let
validate = btnValidate (Proxy @(HandlerSite m)) btn
classes :: [ButtonClass (HandlerSite m)]
classes = btnClasses btn
in [whamlet|
$newline never
<button class=#{unwords $ map toPathPiece classes} type=submit name=#{name} value=#{toPathPiece btn} *{attrs} ##{fid} :not validate:formnovalidate>^{btnLabel btn}
|]
fieldParse _ _ = return . Right $ Just btn
combinedButtonField :: forall a m.
( Button (HandlerSite m) a
, MonadHandler m