fix(schedule): button without value parse
This commit is contained in:
parent
cb61482b83
commit
04341d2e49
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Reference in New Issue
Block a user