From ae0e3f797ff75399a70a711dc563f4167b514dce Mon Sep 17 00:00:00 2001
From: Sarah Vaupel <>
Date: Sat, 24 Oct 2020 19:29:32 +0200
Subject: [PATCH] fix(schedule): reintroduce form failure handling

---
 src/Handler/Schedule.hs | 26 ++++++++++----------------
 1 file changed, 10 insertions(+), 16 deletions(-)

diff --git a/src/Handler/Schedule.hs b/src/Handler/Schedule.hs
index b740f28ad..9d907495c 100644
--- a/src/Handler/Schedule.hs
+++ b/src/Handler/Schedule.hs
@@ -42,13 +42,11 @@ postScheduleR = do
                  , fsAttrs = if sView == scheduleView currentScheduleOptions then [("disabled","")] else mempty
                  }) Nothing
       viewRes <- if
-        -- TODO: ignoring FormFailures for now
-        -- | Just errs <- fromNullable (filter (is _FormFailure) viewRess) -> do
-        --   mapM_ formFailure2Alerts errs
-        --   $logInfoS "SCHEDULE-VIEW" $ "encountered error(s): " <> tshow errs
-        --   (return . FormFailure . mconcat . catMaybes . (fmap $ preview _FormFailure) . toNullable) errs
+        | Just errs <- fromNullable (filter (is _FormFailure) viewRess) -> do
+          mapM_ formFailure2Alerts errs
+          (return . FormFailure . mconcat . catMaybes . (fmap $ preview _FormFailure) . toNullable) errs
         | otherwise -> case catMaybes $ catMaybes (formResultToMaybe <$> viewRess) of
-          [ScheduleOptions{scheduleView=sView}] -> return $ FormSuccess $ ScheduleOptions
+          [ScheduleOptions{scheduleView=sView}] -> (return . FormSuccess) $ ScheduleOptions
                                                    { scheduleView   = sView
                                                    , scheduleOffset = ScheduleOffsetNone
                                                    , scheduleOptionsAction = ScheduleSetView
@@ -78,17 +76,14 @@ postScheduleR = do
                                           , 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
-        --   mapM_ formFailure2Alerts errs
-        --   $logInfoS "SCHEDULE-OFFSET" $ "encountered error(s): " <> tshow errs
-        --   (return . FormFailure . mconcat . catMaybes . (fmap $ preview _FormFailure) . toNullable) errs
+        | Just errs <- fromNullable (filter (is _FormFailure) offsetRess) -> do
+          mapM_ formFailure2Alerts errs
+          (return . FormFailure . mconcat . catMaybes . (fmap $ preview _FormFailure) . toNullable) errs
         | otherwise -> case catMaybes $ catMaybes (formResultToMaybe <$> offsetRess) of
           [opt] -> return $ FormSuccess opt
           _ -> return $ FormSuccess currentScheduleOptions
 
       let
-        -- TODO: work in progress
         scheduleResult = case (viewRes, offsetRes) of
           (_, opts@(FormSuccess _)) -> opts
           (opts@(FormSuccess _), _) -> opts
@@ -99,10 +94,9 @@ postScheduleR = do
 
   ((optionsRes, optionsWidget), optionsEnctype) <- runFormGet scheduleOptionsForm
 
-  let
-    schedule = case optionsRes of
-      FormSuccess ScheduleOptions{scheduleView=ScheduleViewWeek,..} -> weekSchedule uid scheduleOffset
-      _ -> mempty  -- TODO: don't swallow errors!
+  schedule <- case optionsRes of
+    FormSuccess ScheduleOptions{scheduleView=ScheduleViewWeek,..} -> return $ weekSchedule uid scheduleOffset
+    other -> formFailure2Alerts other >> return mempty
 
   siteLayoutMsg MsgMenuSchedule $ do
     setTitleI MsgMenuSchedule