From e23a5a64cc1e0b3540666b10ec331efed8669e10 Mon Sep 17 00:00:00 2001
From: Wolfgang Witt <Wolfgang.Witt@campus.lmu.de>
Date: Thu, 1 Apr 2021 11:42:34 +0200
Subject: [PATCH] chore: button only redirects to postCFavouriteR

actual swapping should happen there
still need to display the correct button
---
 src/Handler/Course.hs      | 11 +++++++++-
 src/Handler/Course/Show.hs | 42 +++++++++++---------------------------
 2 files changed, 22 insertions(+), 31 deletions(-)

diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index 0208a124c..051875618 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -Wwarn #-}
+
 module Handler.Course
   ( module Handler.Course
   ) where
@@ -33,5 +35,12 @@ getCNotesR = postCNotesR
 postCNotesR _ _ _ = defaultLayout [whamlet|You have corrector access to this course.|]
 
 postCFavouriteR :: TermId -> SchoolId -> CourseShorthand -> Handler ()
-postCFavouriteR _ _ _ = error "not implemented"
+postCFavouriteR tid ssh csh = do
+  -- TODO swap FavouriteReason here
+  -- TODO participants can't remove favourite?
+  liftIO $ do
+    putStrLn "\nswapping FavouriteReason"
+    print (tid, ssh, csh)
+  -- show course page again
+  void $ redirect $ CourseR tid ssh csh CShowR
 -- TODO Route for Icon to toggle manual Favorite
diff --git a/src/Handler/Course/Show.hs b/src/Handler/Course/Show.hs
index 5e9991cf1..6d25eed48 100644
--- a/src/Handler/Course/Show.hs
+++ b/src/Handler/Course/Show.hs
@@ -45,36 +45,18 @@ instance Button UniWorX CourseFavouriteToggleButton where
 
   btnClasses _ = [BCIsButton]
 
-newtype CourseFavouriteToggleForm = CourseFavouriteToggleForm
-  { cftfFavouriteReason :: Maybe FavouriteReason
-  } deriving stock   (Eq, Ord, Read, Show, Generic, Typeable)
-    deriving newtype (Default, FromJSON, ToJSON)
-
-makeLenses_ ''CourseFavouriteToggleForm
-
 -- inspired by examAutoOccurrenceIgnoreRoomsForm
-courseFavouriteToggleForm :: TermId -> SchoolId -> CourseShorthand -> CourseFavouriteToggleForm -> Form CourseFavouriteToggleForm
-courseFavouriteToggleForm tid ssh csh protoForm html = do
-  -- create all buttons
-  (btnResManual, wgtManual) <- identifyForm FIDCourseFavouriteToggle (buttonForm' [BtnCourseFavouriteToggleManual]) html
-  (btnResAutomatic, wgtAutomatic) <- identifyForm FIDCourseFavouriteToggle (buttonForm' [BtnCourseFavouriteToggleAutomatic]) html
-  (btnResOff, wgtOff) <- identifyForm FIDCourseFavouriteToggle (buttonForm' [BtnCourseFavouriteToggleOff]) html
-
-  -- choose the relevant button to display
-  let btnRes = btnResManual <|> btnResAutomatic <|> btnResOff
-      (wgt, res) = case btnRes of
-        (FormSuccess BtnCourseFavouriteToggleManual) -> (wgtAutomatic, FormSuccess $ CourseFavouriteToggleForm $ Just FavouriteCurrent)
-          -- TODO participants can't remove favourite?
-        (FormSuccess BtnCourseFavouriteToggleAutomatic) -> (wgtOff, FormSuccess $ CourseFavouriteToggleForm Nothing)
-        (FormSuccess BtnCourseFavouriteToggleOff) -> (wgtAutomatic, FormSuccess $ CourseFavouriteToggleForm $ Just FavouriteCurrent)
-        _otherwise -> (,FormMissing) $ case cftfFavouriteReason protoForm of
-          Nothing -> wgtOff
-          (Just FavouriteVisited) -> wgtAutomatic
-          -- TODO participants can't remove favourite?
-          (Just FavouriteParticipant) -> wgtAutomatic
-          (Just FavouriteManual) -> wgtManual
-          (Just FavouriteCurrent) -> wgtAutomatic
-  return (res, wgt)
+courseFavouriteToggleForm :: Maybe FavouriteReason -> Form ()
+courseFavouriteToggleForm currentReason html
+  = over _1 (fmap $ const ()) <$> identifyForm FIDCourseFavouriteToggle (buttonForm' [btn]) html
+  where
+    btn :: CourseFavouriteToggleButton
+    btn = case currentReason of
+      Nothing -> BtnCourseFavouriteToggleOff
+      (Just FavouriteVisited) -> BtnCourseFavouriteToggleAutomatic
+      (Just FavouriteParticipant) -> BtnCourseFavouriteToggleAutomatic
+      (Just FavouriteManual) -> BtnCourseFavouriteToggleManual
+      (Just FavouriteCurrent) -> BtnCourseFavouriteToggleAutomatic
 
 -- TODO add toggle Manual favorite Icon here
 getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
@@ -310,7 +292,7 @@ getCShowR tid ssh csh = do
   mayCreateEvents <- hasWriteAccessTo $ CourseR tid ssh csh CEventsNewR
   mayEdit <- hasWriteAccessTo $ CourseR tid ssh csh CEditR
 
-  favouriteToggleRes <- runFormPost $ courseFavouriteToggleForm tid ssh csh $ CourseFavouriteToggleForm $ Just FavouriteVisited
+  favouriteToggleRes <- runFormPost $ courseFavouriteToggleForm $ Just FavouriteVisited
   let favouriteToggleWgt = favouriteToggleRes & \((_, favouriteToggleView), favouriteToggleEncoding) ->
         wrapForm favouriteToggleView def
           { formAction   = Just . SomeRoute $ CourseR tid ssh csh CFavouriteR