fraport/fradrive-old
fraport/fradrive-old
Archived
3
1
Fork 0
Code Issues 65 Pull Requests 5 Actions Packages Projects Releases 197 Wiki Activity

fix(schedule): fix PathPiece instances, option instead of view/offset buttons

Browse Source
This commit is contained in:
Sarah Vaupel 2020-10-22 18:32:53 +02:00
parent acb663c480
commit be700882e1
2 changed files with 34 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
src/Handler/Schedule.hs
View File

@ -18,7 +18,14 @@ postScheduleR = do
-- TODO: local instead of global get params?
mOptions <- lookupGlobalGetParam GetScheduleOptions
$logInfoS "SCHEDULE" $ "encountered param: " <> tshow mOptions
let debugScheduleOptions = ScheduleOptions
{ scheduleView = ScheduleViewWeek
, scheduleOffset = ScheduleOffsetDays 5
}
$logInfoS "TEST" $ "debugScheduleOptions: " <> toPathPiece debugScheduleOptions
$logInfoS "SCHEDULE" $ "encountered param: " <> tshow mOptions <> ", param path piece: " <> toPathPiece GetScheduleOptions
let
-- TODO: persist default schedule view in user settings, lookup default and choose schedule accordingly
@ -35,16 +42,16 @@ postScheduleR = do
currentScheduleOffset :: ScheduleOffset
currentScheduleOffset = scheduleOffset $ fromMaybe defaultScheduleOptions mOptions
offsetFromWeekBtn :: ButtonScheduleOffsetWeek -> ScheduleOffset
offsetFromWeekBtn btn = case schedBtnOffset btn of
ScheduleOffsetNone -> ScheduleOffsetNone
offset -> currentScheduleOffset `addOffset` offset
--offsetFromWeekBtn :: ButtonScheduleOffsetWeek -> ScheduleOffset
--offsetFromWeekBtn btn = case schedBtnOffset btn of
-- ScheduleOffsetNone -> ScheduleOffsetNone
-- offset -> currentScheduleOffset `addOffset` offset
scheduleOptionsForm :: Html -> MForm (HandlerFor UniWorX) (FormResult ScheduleOptions, Widget)
scheduleOptionsForm csrf = do
(viewRess, viewWidgets) <- fmap unzip . for (universeF :: [ScheduleView]) $ \sView ->
mopt (buttonField sView) ("" { fsName = Just $ toPathPiece GetScheduleOptions
, fsAttrs = if sView == currentScheduleView then [("disabled","")] else mempty
(viewRess, viewWidgets) <- fmap unzip . for (universeF :: [ScheduleView]) $ \scheduleView ->
mopt (buttonField ScheduleOptions{scheduleOffset=ScheduleOffsetNone,..}) ("" { fsName = Just $ toPathPiece GetScheduleOptions
, fsAttrs = if scheduleView == currentScheduleView then [("disabled","")] else mempty
}) Nothing
viewRes <- if
-- TODO: ignoring FormFailures for now
@ -55,7 +62,7 @@ postScheduleR = do
| otherwise -> case catMaybes $ catMaybes (formResultToMaybe <$> viewRess) of
[sView] -> do
$logInfoS "SCHEDULE-VIEW" $ "encountered single view result: " <> tshow sView <> ", all results: " <> tshow viewRess
return $ FormSuccess sView
return $ FormSuccess $ scheduleView sView
_ -> do
$logInfoS "SCHEDULE-VIEW" $ "encountered no view, all results: " <> tshow viewRess
$logInfoS "SCHEDULE-VIEW" $ "currentScheduleView: " <> tshow currentScheduleView
@ -63,12 +70,17 @@ postScheduleR = do
let
offsetBtns = case viewRes of
FormSuccess ScheduleViewWeek -> (universeF :: [ButtonScheduleOffsetWeek])
FormSuccess ScheduleViewWeek -> [ ScheduleOffsetDays (-7)
, ScheduleOffsetDays (-1)
, ScheduleOffsetDays 0
, ScheduleOffsetDays 1
, ScheduleOffsetDays 7
] <&> (\sOffset -> ScheduleOptions{scheduleView=currentScheduleView,scheduleOffset=sOffset})
_ -> mempty
(offsetRess, offsetWidgets) <- fmap unzip . for offsetBtns $ \btn ->
mopt (buttonField btn) ("" { fsName = Just $ toPathPiece GetScheduleOptions
, fsAttrs = if offsetFromWeekBtn btn == currentScheduleOffset then [("disabled","")] else mempty
, fsAttrs = if scheduleOffset btn == currentScheduleOffset then [("disabled","")] else mempty
}) Nothing
offsetRes <- if
@ -81,7 +93,7 @@ postScheduleR = do
[offset] -> do
$logInfoS "SCHEDULE-OFFSET" $ "encountered single offset result: " <> tshow offset <> ", all results: " <> tshow offsetRess
$logInfoS "SCHEDULE-OFFSET" $ "currentScheduleOffset: " <> tshow currentScheduleOffset
(return . FormSuccess . addOffset currentScheduleOffset . schedBtnOffset) offset
(return . FormSuccess . scheduleOffset) offset
_ -> do
$logInfoS "SCHEDULE-OFFSET" $ "encountered no offset result, all results: " <> tshow offsetRess
$logInfoS "SCHEDULE-OFFSET" $ "currentScheduleOffset: " <> tshow currentScheduleOffset

13
src/Handler/Utils/Schedule/Types/ScheduleOptions.hs
View File

@ -18,7 +18,7 @@ instance Bounded ScheduleView where
instance Finite ScheduleView
instance Universe ScheduleView
derivePathPiece ''ScheduleView (camelToPathPiece' 2) "-"
derivePathPiece ''ScheduleView (camelToPathPiece' 1) "_"
instance Button UniWorX ScheduleView where
btnClasses ScheduleViewWeek = [BCIsButton, BCScheduleView]
@ -29,7 +29,7 @@ data ScheduleOffset = ScheduleOffsetNone
| ScheduleOffsetDays Int
deriving (Eq, Ord, Show, Read, Generic, Typeable)
derivePathPiece ''ScheduleOffset (camelToPathPiece' 2) "-"
derivePathPiece ''ScheduleOffset (camelToPathPiece' 1) "_"
data ScheduleOptions = ScheduleOptions
@ -38,4 +38,11 @@ data ScheduleOptions = ScheduleOptions
}
deriving (Eq, Ord, Show, Read, Generic, Typeable)
derivePathPiece ''ScheduleOptions (camelToPathPiece' 2) "--"
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} |]