fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix(room): deduplicate room column and fix order

Browse Source
This commit is contained in:
Steffen Jost 2024-10-17 16:48:09 +02:00
parent ec2b09b20b
commit d4d511a02f
3 changed files with 25 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Handler/School/DayTasks.hs
View File

@ -42,7 +42,7 @@ instance Finite DailyTableAction
nullaryPathPiece ''DailyTableAction $ camelToPathPiece' 2
embedRenderMessage ''UniWorX ''DailyTableAction id
data DailyTableActionData = DailyActDummyData
data DailyTableActionData = DailyActDummyData
deriving (Eq, Ord, Read, Show, Generic)
-- | partial JSON object to be used for filtering with "@>"
@ -240,9 +240,9 @@ mkDailyTable isAdmin ssh nd = do
in anchorCell (CTutorialR tid cssh csh tutName TUsersR) $ citext2widget tutName
, sortable Nothing (i18nCell MsgTableTutorialOccurrence) $ \(view $ resultTutorial . _entityKey -> tutId) -> cellMaybe (lessonTimesCell False) $ Map.lookup tutId tutLessons
, sortable Nothing (i18nCell MsgTableTutorialRoom) $ \(view $ resultTutorial . _entityKey -> tutId) ->
-- listInlineCell (foldMap (fmap lessonRoom) $ Map.lookup tutId tutLessons) $ cellMaybe roomReferenceCell
-- listInlineCell (concat $ mapMM lessonRoom $ Map.lookup tutId tutLessons) roomReferenceCell
cellMaybe (`listInlineCell` roomReferenceCell) $ mapMM lessonRoom $ Map.lookup tutId tutLessons
-- listInlineCell (nubOrd . concat $ mapMM lessonRoom $ Map.lookup tutId tutLessons) roomReferenceCell
cellMaybe ((`listInlineCell` roomReferenceCell) . nubOrd) $ mapMM lessonRoom $ Map.lookup tutId tutLessons
-- , sortable Nothing (i18nCell MsgTableTutorialRoom) $ \(view $ resultTutorial . _entityKey -> _) -> listCell ["A","D","C","B"] textCell -- DEMO: listCell reverses the order, for list-types! listInlineCell is fixed now
, sortable Nothing (i18nCell $ MsgCourseQualifications 3) $ \(preview resultCourseQualis -> cqs) -> maybeCell cqs $ flip listInlineCell qualificationIdShortCell
, sortable (Just "user-company") (i18nCell MsgTablePrimeCompany) $ \(preview resultCompanyId -> mcid) -> cellMaybe companyIdCell mcid
, sortable (Just "booking-company") (i18nCell MsgTableBookingCompany) $ \(view $ resultParticipant . _entityVal . _tutorialParticipantCompany -> mcid) -> cellMaybe companyIdCell mcid

10
src/Handler/Utils/Table/Pagination.hs
View File

@ -1854,19 +1854,19 @@ maybeLinkEitherCellCM' mCache xM x2route (x2widgetAuth,x2widgetUnauth) = cell $
toWidget $ x2widgetUnauth Nothing
listInlineCell :: (IsDBTable m a, MonoFoldable mono) => mono -> (Element mono -> DBCell m a) -> DBCell m a
listInlineCell :: (IsDBTable m a, MonoFoldable mono, SemiSequence mono) => mono -> (Element mono -> DBCell m a) -> DBCell m a
listInlineCell = listInlineCell' . return
listInlineCell' :: (IsDBTable m a, MonoFoldable mono) => WriterT a m mono -> (Element mono -> DBCell m a) -> DBCell m a
listInlineCell' :: (IsDBTable m a, MonoFoldable mono, SemiSequence mono) => WriterT a m mono -> (Element mono -> DBCell m a) -> DBCell m a
listInlineCell' mkXS mkCell = ilistInlineCell' (otoList <$> mkXS) $ const mkCell
ilistInlineCell :: (IsDBTable m a, MonoFoldableWithKey mono) => mono -> (MonoKey mono -> Element mono -> DBCell m a) -> DBCell m a
ilistInlineCell :: (IsDBTable m a, MonoFoldableWithKey mono, SemiSequence mono) => mono -> (MonoKey mono -> Element mono -> DBCell m a) -> DBCell m a
ilistInlineCell = ilistInlineCell' . return
ilistInlineCell' :: (IsDBTable m a, MonoFoldableWithKey mono) => WriterT a m mono -> (MonoKey mono -> Element mono -> DBCell m a) -> DBCell m a
ilistInlineCell' :: (IsDBTable m a, MonoFoldableWithKey mono, SemiSequence mono) => WriterT a m mono -> (MonoKey mono -> Element mono -> DBCell m a) -> DBCell m a
ilistInlineCell' mkXS mkCell = review dbCell . ([], ) $ do
xs <- mkXS
cells <- forM (otoKeyedList xs) $
cells <- forM (otoKeyedList $ reverse xs) $ -- Do we need to reverse for all MonoFoldableWithKey, or is only the List-Instance flawed?
\(view dbCell . uncurry mkCell -> (attrs, mkWidget)) -> (attrs, ) <$> mkWidget
return $(widgetFile "table/cell/listInline")

20
test/Database/Fill.hs
View File

@ -1084,6 +1084,12 @@ fillDb = do
, scheduleEnd = TimeOfDay 14 44 0
, scheduleRoom = Just $ RoomReferenceSimple "A320neo"
}
, ScheduleWeekly
{ scheduleDayOfWeek = Friday
, scheduleStart = TimeOfDay 15 55 0
, scheduleEnd = TimeOfDay 16 16 0
, scheduleRoom = Just $ RoomReferenceSimple "A340"
}
, ScheduleWeekly
{ scheduleDayOfWeek = Sunday
, scheduleStart = TimeOfDay 15 55 0
@ -1094,8 +1100,8 @@ fillDb = do
, occurrencesExceptions = Set.fromList
[ ExceptOccur
{ exceptDay = nTimes 7 succ firstDay
, exceptStart = TimeOfDay 8 30 0
, exceptEnd = TimeOfDay 16 0 0
, exceptStart = TimeOfDay 8 30 30
, exceptEnd = TimeOfDay 16 0 30
, exceptRoom = Just $ RoomReferenceSimple "A380"
}
, ExceptOccur
@ -1107,7 +1113,13 @@ fillDb = do
, ExceptOccur
{ exceptDay = nowaday
, exceptStart = TimeOfDay 9 10 0
, exceptEnd = TimeOfDay 16 10 0
, exceptEnd = TimeOfDay 12 10 0
, exceptRoom = Just $ RoomReferenceSimple "B747"
}
, ExceptOccur
{ exceptDay = nowaday
, exceptStart = TimeOfDay 13 11 0
, exceptEnd = TimeOfDay 16 11 0
, exceptRoom = Just $ RoomReferenceSimple "B747"
}
]
@ -1152,7 +1164,7 @@ fillDb = do
{ exceptDay = nowaday
, exceptStart = TimeOfDay 17 10 0
, exceptEnd = TimeOfDay 18 10 0
, exceptRoom = Nothing
, exceptRoom = Just $ RoomReferenceSimple "A380"
}
]
}