chore: button only redirects to postCFavouriteR
actual swapping should happen there still need to display the correct button
This commit is contained in:
parent
6b9c0849e4
commit
e23a5a64cc
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user