From 04341d2e494ee71af1505c2967d7be64328a7162 Mon Sep 17 00:00:00 2001
From: Sarah Vaupel <>
Date: Sat, 24 Oct 2020 15:38:32 +0200
Subject: [PATCH] fix(schedule): button without value parse

---
 src/Handler/Schedule.hs | 16 ++++++++--------
 src/Utils/Form.hs       | 21 +++++++++++++++++++++
 2 files changed, 29 insertions(+), 8 deletions(-)

diff --git a/src/Handler/Schedule.hs b/src/Handler/Schedule.hs
index e1918784e..b740f28ad 100644
--- a/src/Handler/Schedule.hs
+++ b/src/Handler/Schedule.hs
@@ -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
diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
index 95d197cf9..f43651cfd 100644
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@@ -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