diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index a321103e3..1e72c59cd 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -113,6 +113,8 @@ ScheduleOffsetWeekCurrent: Zu aktueller Woche springen ScheduleOffsetWeekForwardDay: 1 Tag vorwärts ScheduleOffsetWeekForwardWeek: 1 Woche vorwärts +ScheduleReset: Standard + ScheduleTableHeadTime: Zeit ScheduleRoom: Raum @@ -2919,4 +2921,4 @@ InvalidCredentialsADAccountDisabled: Benutzereintrag gesperrt InvalidCredentialsADTooManyContextIds: Benutzereintrag trägt zu viele Sicherheitskennzeichen InvalidCredentialsADAccountExpired: Benutzereintrag abgelaufen InvalidCredentialsADPasswordMustChange: Passwort muss geändert werden -InvalidCredentialsADAccountLockedOut: Benutzereintrag wurde durch Eindringlingserkennung gesperrt \ No newline at end of file +InvalidCredentialsADAccountLockedOut: Benutzereintrag wurde durch Eindringlingserkennung gesperrt diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg index 6946ac632..d98072851 100644 --- a/messages/uniworx/en-eu.msg +++ b/messages/uniworx/en-eu.msg @@ -114,6 +114,8 @@ ScheduleOffsetWeekCurrent: Jump to current week ScheduleOffsetWeekForwardDay: 1 day forward ScheduleOffsetWeekForwardWeek: 1 week forward +ScheduleReset: Default + ScheduleTableHeadTime: Time ScheduleRoom: Room diff --git a/src/Handler/Schedule.hs b/src/Handler/Schedule.hs index 53512dc0f..bf9a724ab 100644 --- a/src/Handler/Schedule.hs +++ b/src/Handler/Schedule.hs @@ -19,24 +19,30 @@ postScheduleR = do mOptions <- lookupGlobalGetParam GetScheduleOptions let - -- TODO: persist default schedule view in user settings, lookup default and choose schedule accordingly - -- if mView == Nothing + -- TODO: persist default schedule view in user settings and choose scheduleView accordingly defaultScheduleOptions :: ScheduleOptions defaultScheduleOptions = ScheduleOptions { scheduleView = ScheduleViewWeek , scheduleOffset = ScheduleOffsetNone + , scheduleOptionsAction = ScheduleSetDefault } + currentScheduleOptions :: ScheduleOptions + currentScheduleOptions = fromMaybe defaultScheduleOptions mOptions + currentScheduleView :: ScheduleView - currentScheduleView = scheduleView $ fromMaybe defaultScheduleOptions mOptions + currentScheduleView = scheduleView currentScheduleOptions currentScheduleOffset :: ScheduleOffset - currentScheduleOffset = scheduleOffset $ fromMaybe defaultScheduleOptions mOptions + currentScheduleOffset = scheduleOffset currentScheduleOptions + + currentScheduleOptionsAction :: ScheduleOptionsAction + currentScheduleOptionsAction = scheduleOptionsAction currentScheduleOptions scheduleOptionsForm :: Html -> MForm (HandlerFor UniWorX) (FormResult ScheduleOptions, Widget) scheduleOptionsForm csrf = do (viewRess, viewWidgets) <- fmap unzip . for (universeF :: [ScheduleView]) $ \scheduleView -> - mopt (buttonField ScheduleOptions{scheduleOffset=ScheduleOffsetNone,..}) + mopt (buttonField ScheduleOptions{scheduleOffset=ScheduleOffsetNone,scheduleOptionsAction=ScheduleSetView,..}) ("" { fsName = Just $ toPathPiece GetScheduleOptions , fsAttrs = if scheduleView == currentScheduleView then [("disabled","")] else mempty }) Nothing @@ -47,29 +53,39 @@ postScheduleR = do -- $logInfoS "SCHEDULE-VIEW" $ "encountered error(s): " <> tshow errs -- (return . FormFailure . mconcat . catMaybes . (fmap $ preview _FormFailure) . toNullable) errs | otherwise -> case catMaybes $ catMaybes (formResultToMaybe <$> viewRess) of - [sView] -> return $ FormSuccess $ scheduleView sView - _ -> return $ FormSuccess currentScheduleView + --[sView] -> return $ FormSuccess $ scheduleView sView + [ScheduleOptions{scheduleView=sView}] -> return $ FormSuccess $ ScheduleOptions + { scheduleView = sView + , scheduleOffset = ScheduleOffsetNone + , scheduleOptionsAction = ScheduleSetView + } + --_ -> return $ FormSuccess currentScheduleView + _ -> return $ FormSuccess $ ScheduleOptions + { scheduleView = currentScheduleView + , scheduleOffset = ScheduleOffsetNone + , scheduleOptionsAction = ScheduleSetView + } let offsetBtns = case viewRes of - FormSuccess ScheduleViewWeek -> [ ScheduleOffsetDays (-7) - , ScheduleOffsetDays (-1) - , ScheduleOffsetNone - , ScheduleOffsetDays 1 - , ScheduleOffsetDays 7 - ] <&> (\sOffset -> ScheduleOptions - { scheduleView = currentScheduleView - , scheduleOffset = case sOffset of - ScheduleOffsetNone -> ScheduleOffsetNone - _ -> currentScheduleOffset `addOffset` sOffset - }) + FormSuccess ScheduleOptions{scheduleView=ScheduleViewWeek} -> [ ScheduleOffsetDays (-7) + , ScheduleOffsetDays (-1) + , ScheduleOffsetNone + , ScheduleOffsetDays 1 + , ScheduleOffsetDays 7 + ] <&> (\sNewOffset -> ScheduleOptions + { scheduleView = currentScheduleView + , scheduleOffset = case sNewOffset of + ScheduleOffsetNone -> ScheduleOffsetNone + _ -> currentScheduleOffset `addOffset` sNewOffset + , scheduleOptionsAction = ScheduleSetOffset (offsetInDays sNewOffset) + }) _ -> mempty (offsetRess, offsetWidgets) <- fmap unzip . for offsetBtns $ \btn -> mopt (buttonField btn) ("" { fsName = Just $ toPathPiece GetScheduleOptions , fsAttrs = if offsetInDays (scheduleOffset btn) == offsetInDays currentScheduleOffset then [("disabled","")] else mempty }) Nothing - offsetRes <- if -- TODO: ignoring FormFailures for now -- | Just errs <- fromNullable (filter (is _FormFailure) offsetRess) -> do @@ -77,11 +93,21 @@ postScheduleR = do -- $logInfoS "SCHEDULE-OFFSET" $ "encountered error(s): " <> tshow errs -- (return . FormFailure . mconcat . catMaybes . (fmap $ preview _FormFailure) . toNullable) errs | otherwise -> case catMaybes $ catMaybes (formResultToMaybe <$> offsetRess) of - [offset] -> (return . FormSuccess . scheduleOffset) offset - _ -> return $ FormSuccess currentScheduleOffset + --[offset] -> (return . FormSuccess . scheduleOffset) offset + [opt] -> return $ FormSuccess opt + _ -> return $ FormSuccess $ ScheduleOptions + { scheduleView = currentScheduleView + , scheduleOffset = currentScheduleOffset + , scheduleOptionsAction = currentScheduleOptionsAction + } + --_ -> return $ FormSuccess currentScheduleOffset let - scheduleResult = ScheduleOptions <$> viewRes <*> offsetRes + -- scheduleResult = ScheduleOptions <$> viewRes <*> offsetRes <*> offsetActionRes + scheduleResult = case (viewRes, offsetRes) of + (_, opts@(FormSuccess _)) -> opts + (opts@(FormSuccess _), _) -> opts + _ -> FormSuccess currentScheduleOptions optionsWidget = $(widgetFile "schedule/options") return (scheduleResult, optionsWidget) diff --git a/src/Handler/Utils/Schedule/Types/ScheduleOptions.hs b/src/Handler/Utils/Schedule/Types/ScheduleOptions.hs index b3b278a9a..1c2bdacd4 100644 --- a/src/Handler/Utils/Schedule/Types/ScheduleOptions.hs +++ b/src/Handler/Utils/Schedule/Types/ScheduleOptions.hs @@ -1,6 +1,7 @@ module Handler.Utils.Schedule.Types.ScheduleOptions ( ScheduleView(..) , ScheduleOffset(..) + , ScheduleOptionsAction(..) , ScheduleOptions(..) ) where @@ -31,18 +32,34 @@ data ScheduleOffset = ScheduleOffsetNone derivePathPiece ''ScheduleOffset (camelToPathPiece' 1) "_" +data ScheduleOptionsAction = ScheduleSetView + | ScheduleSetOffset Int -- TODO: use ScheduleOffset instead of Int + | ScheduleSetDefault + deriving (Eq, Ord, Show, Read, Generic, Typeable) + +derivePathPiece ''ScheduleOptionsAction (camelToPathPiece' 1) "_" data ScheduleOptions = ScheduleOptions { scheduleView :: ScheduleView , scheduleOffset :: ScheduleOffset + , scheduleOptionsAction :: ScheduleOptionsAction } - deriving (Eq, Ord, Show, Read, Generic, Typeable) + deriving (Generic, Typeable) derivePathPiece ''ScheduleOptions (camelToPathPiece' 1) "__" instance Button UniWorX ScheduleOptions where btnClasses = const [BCIsButton] - btnLabel ScheduleOptions{..} = case scheduleOffset of - ScheduleOffsetNone -> case scheduleView of - ScheduleViewWeek -> [whamlet| _{MsgBtnScheduleViewWeek} |] - ScheduleOffsetDays d -> [whamlet| #{tshow d} |] + btnLabel ScheduleOptions{..} = case scheduleOptionsAction of + ScheduleSetDefault -> [whamlet| _{MsgScheduleReset} |] + ScheduleSetView -> case scheduleView of + ScheduleViewWeek -> [whamlet| _{MsgScheduleViewWeek} |] + ScheduleSetOffset d -> case scheduleView of + ScheduleViewWeek -> let iconTooltipMessage i m = iconTooltip [whamlet| _{m} |] (Just i) True + in case d of + (-7) -> [whamlet| ^{iconTooltipMessage IconFastBackward MsgScheduleOffsetWeekBackwardWeek} |] + (-1) -> [whamlet| ^{iconTooltipMessage IconBackward MsgScheduleOffsetWeekBackwardDay} |] + 0 -> [whamlet| ^{iconTooltipMessage IconCurrent MsgScheduleOffsetWeekCurrent} |] + 1 -> [whamlet| ^{iconTooltipMessage IconForward MsgScheduleOffsetWeekForwardDay} |] + 7 -> [whamlet| ^{iconTooltipMessage IconFastForward MsgScheduleOffsetWeekForwardWeek} |] + _ -> [whamlet| #{tshow d} |]