feat(schedule): implement actions field for options
This commit is contained in:
Sarah Vaupel
parent
be442c6058
commit
ae753e5a4f
@ -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
|
||||
InvalidCredentialsADAccountLockedOut: Benutzereintrag wurde durch Eindringlingserkennung gesperrt
|
||||
|
||||
@ -114,6 +114,8 @@ ScheduleOffsetWeekCurrent: Jump to current week
|
||||
ScheduleOffsetWeekForwardDay: 1 day forward
|
||||
ScheduleOffsetWeekForwardWeek: 1 week forward
|
||||
|
||||
ScheduleReset: Default
|
||||
|
||||
ScheduleTableHeadTime: Time
|
||||
|
||||
ScheduleRoom: Room
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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} |]
|
||||
|
||||
Reference in New Issue
Block a user