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

refactor(occurrences): fold RoomReference into Occurrences (WIP)

Browse Source 
Each Occurrence now has its own RoomReference, i.e. Mondays may have a different Room assigned than Tuesdays

WIP Problem: occurrencesAFrom does not work, always insists on Room missing
This commit is contained in:
Steffen Jost 2024-09-24 17:15:15 +02:00 committed by Sarah Vaupel
parent 692350677f
commit 35cadda2e8
22 changed files with 95 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
messages/uniworx/utils/utils/de-de-formal.msg
View File

@ -91,6 +91,7 @@ UtilExamResultVoided: Entwertet
CourseOption tid@TermId ssh@SchoolId csh@CourseShorthand coursen@CourseName !ident-ok: #{tid} - #{ssh} - #{csh}: #{coursen}
RoomReferenceNone !ident-ok: —
RoomReferenceSimple !ident-ok: Text
RoomReferenceSimpleAt r@Text: in Raum #{r}
RoomReferenceLink: Link & Anweisungen
RoomReferenceSimpleText: Raum
RoomReferenceSimpleTextPlaceholder: Raum

1
messages/uniworx/utils/utils/en-eu.msg
View File

@ -91,6 +91,7 @@ UtilExamResultVoided: Voided
CourseOption tid ssh csh coursen: #{tid} - #{ssh} - #{csh}: #{coursen}
RoomReferenceNone: —
RoomReferenceSimple: Text
RoomReferenceSimpleAt r: at room #{r}
RoomReferenceLink: Link & Instructions
RoomReferenceSimpleText: Room
RoomReferenceSimpleTextPlaceholder: Room

2
src/Handler/Course/Events/Delete.hs
View File

@ -34,7 +34,7 @@ postCEvDeleteR tid ssh csh cID = do
$maybe room <- courseEventRoom
, #{roomReferenceText room}
:
^{occurrencesWidget courseEventTime}
^{occurrencesWidget False courseEventTime}
|]
drRecordConfirmString :: Entity CourseEvent -> DB Text

27
src/Handler/Course/Show.hs
View File

@ -1,4 +1,4 @@
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
-- SPDX-FileCopyrightText: 2022-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later
@ -29,7 +29,7 @@ import Handler.Exam.List (mkExamTable)
getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getCShowR tid ssh csh = do
mbAid <- maybeAuthId
mbAid <- maybeAuthId
now <- liftIO getCurrentTime
(cid,course,courseVisible,schoolName,participants,registration,lecturers,assistants,administrators,correctors,tutors,news,events,submissionGroup,_mayReRegister,(mayViewSheets, mayViewAnySheet), (mayViewMaterials, mayViewAnyMaterial),courseQualifications) <- runDB . maybeT notFound $ do
[(E.Entity cid course, E.Value courseVisible, E.Value schoolName, E.Value participants, fmap entityVal -> registration)]
@ -146,7 +146,7 @@ getCShowR tid ssh csh = do
| otherwise
-> return . modal $(widgetFile "course/login-to-register") . Left . SomeRoute $ AuthR LoginR
registrationOpen <- hasWriteAccessTo $ CourseR tid ssh csh CRegisterR
mayMassRegister <- hasWriteAccessTo $ CourseR tid ssh csh CAddUserR
mayMassRegister <- hasWriteAccessTo $ CourseR tid ssh csh CAddUserR
MsgRenderer mr <- getMsgRenderer
@ -154,14 +154,14 @@ getCShowR tid ssh csh = do
tutorialDBTable = DBTable{..}
where
resultTutorial :: Lens' (DBRow (Entity Tutorial, Bool)) (Entity Tutorial)
resultTutorial = _dbrOutput . _1
resultShowRoom = _dbrOutput . _2
resultTutorial = _dbrOutput . _1
resultHideRoom = _dbrOutput . _2
dbtSQLQuery tutorial = do
E.where_ $ tutorial E.^. TutorialCourse E.==. E.val cid
let showRoom = maybe E.false (flip showTutorialRoom tutorial . E.val) mbAid
E.||. E.not_ (tutorial E.^. TutorialRoomHidden)
return (tutorial, showRoom)
let hideRoom = maybe E.true (E.not__ . flip showTutorialRoom tutorial . E.val) mbAid
E.&&. (tutorial E.^. TutorialRoomHidden)
return (tutorial, hideRoom)
dbtRowKey = (E.^. TutorialId)
dbtProj = over (_dbrOutput . _2) E.unValue <$> dbtProjId
dbtColonnade = dbColonnade $ mconcat
@ -180,10 +180,13 @@ getCShowR tid ssh csh = do
<li>
^{nameEmailWidget' tutor}
|]
, sortable (Just "room") (i18nCell MsgTableTutorialRoom) $ \res -> if
| res ^. resultShowRoom -> maybe (i18nCell MsgTableTutorialRoomIsUnset) roomReferenceCell $ views (resultTutorial . _entityVal) tutorialRoom res
, sortable (Just "room") (i18nCell MsgTableTutorialRoom) $ \res -> if -- TODO REMOVE
| res ^. resultHideRoom . _not -> maybe (i18nCell MsgTableTutorialRoomIsUnset) roomReferenceCell $ views (resultTutorial . _entityVal) tutorialRoom res
| otherwise -> i18nCell MsgTableTutorialRoomIsHidden & addCellClass ("explanation" :: Text)
, sortable Nothing (i18nCell MsgTableTutorialTime) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> occurrencesCell tutorialTime
, sortable Nothing (i18nCell MsgTableTutorialTime) $ \res ->
let roomHidden = res ^. resultHideRoom
ttime = res ^. resultTutorial . _entityVal . _tutorialTime
in occurrencesCell roomHidden ttime
, sortable (Just "register-from") (i18nCell MsgTutorialRegisterFrom) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> maybeDateTimeCell tutorialRegisterFrom
, sortable (Just "register-to") (i18nCell MsgTutorialRegisterTo) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> maybeDateTimeCell tutorialRegisterTo
, sortable (Just "deregister-until") (i18nCell MsgTableTutorialDeregisterUntil) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> maybeDateTimeCell tutorialDeregisterUntil

2
src/Handler/Course/User.hs
View File

@ -445,7 +445,7 @@ courseUserTutorialsSection (Entity cid Course{..}) (Entity uid _) = do
^{userEmailWidget usr}
|]
, sortable (Just "room") (i18nCell MsgTableTutorialRoom) $ maybe (i18nCell MsgTableTutorialRoomIsUnset) roomReferenceCell . view (_dbrOutput . _1 . _entityVal . _tutorialRoom)
, sortable Nothing (i18nCell MsgTableTutorialTime) $ occurrencesCell . view (_dbrOutput . _1 . _entityVal . _tutorialTime)
, sortable Nothing (i18nCell MsgTableTutorialTime) $ occurrencesCell False . view (_dbrOutput . _1 . _entityVal . _tutorialTime)
]
dbtSorting = mconcat
[ singletonMap "type" . SortColumn $ \(tutorial `E.InnerJoin` _) -> tutorial E.^. TutorialType

19
src/Handler/Tutorial/List.hs
View File

@ -29,18 +29,18 @@ getCTutorialListR tid ssh csh = do
tutorialDBTable = DBTable{..}
where
resultTutorial :: Lens' (DBRow (Entity Tutorial, Int, Bool)) (Entity Tutorial)
resultTutorial = _dbrOutput . _1
resultTutorial = _dbrOutput . _1
resultParticipants = _dbrOutput . _2
resultShowRoom = _dbrOutput . _3
resultHideRoom = _dbrOutput . _3
dbtSQLQuery tutorial = do
E.where_ $ tutorial E.^. TutorialCourse E.==. E.val cid
let participants :: E.SqlExpr (E.Value Int)
participants = E.subSelectCount . E.from $ \tutorialParticipant ->
E.where_ $ tutorialParticipant E.^. TutorialParticipantTutorial E.==. tutorial E.^. TutorialId
let showRoom = maybe E.false (flip showTutorialRoom tutorial . E.val) muid
E.||. E.not_ (tutorial E.^. TutorialRoomHidden)
return (tutorial, participants, showRoom)
let hideRoom = maybe E.true (E.not__ . flip showTutorialRoom tutorial . E.val) muid
E.&&. (tutorial E.^. TutorialRoomHidden)
return (tutorial, participants, hideRoom)
dbtRowKey = (E.^. TutorialId)
dbtProj = over (_dbrOutput . _2) E.unValue . over (_dbrOutput . _3) E.unValue <$> dbtProjId
dbtColonnade = dbColonnade $ mconcat
@ -61,10 +61,13 @@ getCTutorialListR tid ssh csh = do
|]
, sortable (Just "participants") (i18nCell MsgTutorialParticipants) $ \(view $ $(multifocusL 2) (resultTutorial . _entityVal) resultParticipants -> (Tutorial{..}, n)) -> anchorCell (CTutorialR tid ssh csh tutorialName TUsersR) $ tshow n
, sortable (Just "capacity") (i18nCell MsgTutorialCapacity) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> maybe mempty (textCell . tshow) tutorialCapacity
, sortable (Just "room") (i18nCell MsgTableTutorialRoom) $ \res -> if
| res ^. resultShowRoom -> maybe (i18nCell MsgTableTutorialRoomIsUnset) roomReferenceCell $ views (resultTutorial . _entityVal) tutorialRoom res
, sortable (Just "room") (i18nCell MsgTableTutorialRoom) $ \res -> if -- TODO REMOVE
| res ^. resultHideRoom . _not -> cellMaybe roomReferenceCell $ views (resultTutorial . _entityVal) tutorialRoom res
| otherwise -> i18nCell MsgTableTutorialRoomIsHidden & addCellClass ("explanation" :: Text)
, sortable Nothing (i18nCell MsgTableTutorialTime) $ \(view $ resultTutorial . _entityVal . _tutorialTime -> ttime) -> occurrencesCell ttime
, sortable Nothing (i18nCell MsgTableTutorialTime) $ \res ->
let roomHidden = res ^. resultHideRoom
ttime = res ^. resultTutorial . _entityVal . _tutorialTime
in occurrencesCell roomHidden ttime
, sortable (Just "register-group") (i18nCell MsgTutorialRegGroup) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> maybe mempty (textCell . CI.original) tutorialRegGroup
, sortable (Just "register-from") (i18nCell MsgRegisterFrom) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> maybeDateTimeCell tutorialRegisterFrom
, sortable (Just "register-to") (i18nCell MsgRegisterTo) $ \(view $ resultTutorial . _entityVal -> Tutorial{..}) -> maybeDateTimeCell tutorialRegisterTo

3
src/Handler/Utils/Form/Occurrences.hs
View File

@ -8,6 +8,7 @@ module Handler.Utils.Form.Occurrences
import Import
import Handler.Utils.Form
import Handler.Utils.Widgets
import Handler.Utils.DateTime
import qualified Data.Set as Set
@ -60,6 +61,7 @@ occurrencesAForm (toPathPiece -> miIdent') mPrev = wFormToAForm $ do
<$> apreq (selectField' Nothing optionsFinite) (fslI MsgOccurrenceWeekDay & addName (nudge "occur-week-day")) Nothing
<*> apreq timeFieldTypeTime (fslI MsgOccurrenceStart & addName (nudge "occur-start")) Nothing
<*> apreq timeFieldTypeTime (fslI MsgOccurrenceEnd & addName (nudge "occur-end")) Nothing
<*> roomReferenceFormOpt (fslI MsgTableTutorialRoom) Nothing
)
]
) (fslI MsgScheduleRegularKind & addName (nudge "kind")) Nothing
@ -96,6 +98,7 @@ occurrencesAForm (toPathPiece -> miIdent') mPrev = wFormToAForm $ do
<$> apreq dayField (fslI MsgDay & addName (nudge "occur-day")) Nothing
<*> apreq timeFieldTypeTime (fslI MsgOccurrenceStart & addName (nudge "occur-start")) Nothing
<*> apreq timeFieldTypeTime (fslI MsgOccurrenceEnd & addName (nudge "occur-end")) Nothing
<*> roomReferenceFormOpt (fslI MsgTableTutorialRoom) Nothing
)
, ( ExceptionKindNoOccur
, ExceptNoOccur

12
src/Handler/Utils/Occurrences.hs
View File

@ -19,6 +19,7 @@ import Utils.Holidays (isWeekend)
import Utils.Occurrences
import Handler.Utils.DateTime
import Handler.Utils.Widgets (roomReferenceWidget)
-- import Text.Read (read) -- for DEBUGGING only
@ -34,15 +35,15 @@ data LessonTime = LessonTime { lessonStart, lessonEnd :: LocalTime }
deriving (Eq, Ord, Read, Show, Generic) -- BEWARE: Ord instance might not be intuitive, but needed for Set
occurringLessons :: Term -> Occurrences -> Set LessonTime
occurringLessons t Occurrences{..} = Set.union exceptOcc $ Set.filter isExcept scheduledLessons
occurringLessons term Occurrences{..} = Set.union exceptOcc $ Set.filter isExcept scheduledLessons
where
scheduledLessons = occurrenceScheduleToLessons t `foldMap` occurrencesScheduled
scheduledLessons = occurrenceScheduleToLessons term `foldMap` occurrencesScheduled
(exceptOcc, exceptNo) = occurrenceExceptionToLessons occurrencesExceptions
isExcept LessonTime{lessonStart} = Set.notMember lessonStart exceptNo
occurrenceScheduleToLessons :: Term -> OccurrenceSchedule -> Set LessonTime
occurrenceScheduleToLessons Term{..} =
let setHolidays = Set.fromList termHolidays
let setHolidays = Set.fromList termHolidays -- ensure that the conversion is performed only once for repeated calls
in \ScheduleWeekly{..} ->
let occDays = daysOfWeekBetween (termLectureStart, termLectureEnd) scheduleDayOfWeek \\ setHolidays
toLesson d = LessonTime { lessonStart = LocalTime d scheduleStart
@ -66,9 +67,8 @@ occurrenceExceptionToLessons = Set.foldr aux mempty
-- Occurrences --
-----------------
occurrencesWidget :: JSONB Occurrences -> Widget
occurrencesWidget (normalizeOccurrences . unJSONB -> Occurrences{..}) = do
occurrencesWidget :: Bool -> JSONB Occurrences -> Widget
occurrencesWidget roomHidden (normalizeOccurrences . unJSONB -> Occurrences{..}) = do
let occurrencesScheduled' = flip map (Set.toList occurrencesScheduled) $ \case
ScheduleWeekly{..} -> do
scheduleStart' <- formatTime SelFormatTime scheduleStart

7
src/Handler/Utils/Table/Cells.hs
View File

@ -48,10 +48,11 @@ addIndicatorCell = tellCell $ Any True
writerCell :: IsDBTable m w => WriterT w m () -> DBCell m w
writerCell act = mempty & cellContents %~ (<* act)
-- for documentation purposes
-- for documentation purposes and better error message
cellMaybe :: IsDBTable m b => (a -> DBCell m b) -> Maybe a -> DBCell m b
cellMaybe = foldMap
-- for documentation purposes and better error message
maybeCell :: IsDBTable m b => Maybe a -> (a -> DBCell m b) -> DBCell m b
maybeCell = flip foldMap
@ -509,8 +510,8 @@ correctorLoadCell :: IsDBTable m a => SheetCorrector -> DBCell m a
correctorLoadCell sc =
i18nCell $ sheetCorrectorLoad sc
occurrencesCell :: IsDBTable m a => JSONB Occurrences -> DBCell m a
occurrencesCell = cell . occurrencesWidget
occurrencesCell :: IsDBTable m a => Bool -> JSONB Occurrences -> DBCell m a
occurrencesCell roomHidden occs = cell $ occurrencesWidget roomHidden occs
roomReferenceCell :: IsDBTable m a => RoomReference -> DBCell m a
roomReferenceCell = cell . roomReferenceWidget

4
src/Handler/Utils/Widgets.hs
View File

@ -293,8 +293,8 @@ examOccurrenceMappingDescriptionWidget rule descriptions = $(widgetFile "widgets
roomReferenceWidget :: RoomReference -> Widget
roomReferenceWidget RoomReferenceSimple{..} = toWidget roomRefText
roomReferenceWidget RoomReferenceLink{..} = $(widgetFile "widgets/room-reference/link")
roomReferenceWidget RoomReferenceSimple{..} = msg2widget $ MsgRoomReferenceSimpleAt roomRefText
roomReferenceWidget RoomReferenceLink{..} = $(widgetFile "widgets/room-reference/link")
where
linkText = uriToString id roomRefLink mempty
instrModal = modal (i18n MsgRoomReferenceLinkInstructions) $ Right $(widgetFile "widgets/room-reference/link-instructions-modal")

17
src/Model/Types/DateTime.hs
View File

@ -14,6 +14,7 @@ module Model.Types.DateTime
) where
import Import.NoModel
import Model.Types.Room
-- import qualified Data.Set as Set
import Data.Ratio ((%))
@ -167,8 +168,9 @@ data OccurrenceSchedule = ScheduleWeekly
{ scheduleDayOfWeek :: WeekDay
, scheduleStart :: TimeOfDay
, scheduleEnd :: TimeOfDay
, scheduleRoom :: Maybe RoomReference
}
deriving (Eq, Ord, Read, Show, Generic)
deriving (Eq, Ord, Show, Generic)
deriving anyclass (NFData)
deriveJSON defaultOptions
@ -182,11 +184,12 @@ data OccurrenceException = ExceptOccur
{ exceptDay :: Day
, exceptStart :: TimeOfDay
, exceptEnd :: TimeOfDay
, exceptRoom :: Maybe RoomReference -- ignored in Ord instance
}
| ExceptNoOccur
{ exceptTime :: LocalTime
}
deriving (Eq, Read, Show, Generic)
deriving (Eq, Show, Generic)
deriving anyclass (NFData)
-- Handler.Utils.Occurrences.occurrencesAddBusinessDays assumes that OccurrenceException is ordered chronologically
@ -218,7 +221,7 @@ data Occurrences = Occurrences
{ occurrencesScheduled :: Set OccurrenceSchedule
, occurrencesExceptions :: Set OccurrenceException
}
deriving (Eq, Ord, Read, Show, Generic)
deriving (Eq, Ord, Show, Generic)
deriving anyclass (NFData)
deriveJSON defaultOptions
@ -256,10 +259,10 @@ nullaryPathPiece ''DayOfWeek camelToPathPiece
-- yesterday = addUTCTime (negate nominalDay) now
-- lt3 = utcToLocalTime tz yesterday
-- pure
-- [ ExceptOccur (utctDay tomorrow ) midday midnight
-- , ExceptOccur (utctDay now ) midnight midnight
-- , ExceptOccur (utctDay now ) midday midnight
-- , ExceptOccur (utctDay yesterday) midday midnight
-- [ ExceptOccur (utctDay tomorrow ) midday midnight Nothing
-- , ExceptOccur (utctDay now ) midnight midnight Nothing
-- , ExceptOccur (utctDay now ) midday midnight Nothing
-- , ExceptOccur (utctDay yesterday) midday midnight Nothing
-- , ExceptNoOccur lt3
-- , ExceptNoOccur lt1
-- , ExceptNoOccur lt2

9
src/Utils.hs
View File

@ -923,7 +923,14 @@ toNothing = const Nothing
toNothingS :: String -> Maybe b
toNothingS = const Nothing
-- | change second of maybe pair to Nothing, if both are Just and equal
infix 4 ==~
-- | Equality treating `Nothing` as an always matching wildcard
(==~) :: Eq a => Maybe a -> Maybe a -> Bool
(==~) (Just x) (Just y) = x == y
(==~) _ _ = True
-- | change second of maybe pair to `Nothing`, if both are `Just` and equal
eq2nothing :: Eq a => (Maybe a, Maybe a) -> (Maybe a, Maybe a)
eq2nothing (mx@(Just x), Just y) | x==y = (mx, Nothing)
eq2nothing p = p

15
src/Utils/Occurrences.hs
View File

@ -44,13 +44,15 @@ normalizeOccurrences initial
let
merge b@ScheduleWeekly{}
| scheduleDayOfWeek a == scheduleDayOfWeek b -- b starts during a
, scheduleStart a <= scheduleStart b
, scheduleEnd a >= scheduleStart b
= Just $ ScheduleWeekly (scheduleDayOfWeek a) (scheduleStart a) ((max `on` scheduleEnd) a b)
, scheduleStart a <= scheduleStart b
, scheduleEnd a >= scheduleStart b
, scheduleRoom a ==~ scheduleRoom b
= Just $ ScheduleWeekly (scheduleDayOfWeek a) (scheduleStart a) ((max `on` scheduleEnd) a b) (scheduleRoom a <|> scheduleRoom b)
| scheduleDayOfWeek a == scheduleDayOfWeek b -- b ends during a
, scheduleStart a <= scheduleEnd b
, scheduleEnd a >= scheduleEnd b
= Just $ ScheduleWeekly (scheduleDayOfWeek a) ((min `on` scheduleStart) a b) (scheduleEnd a)
, scheduleStart a <= scheduleEnd b
, scheduleEnd a >= scheduleEnd b
, scheduleRoom a ==~ scheduleRoom b
= Just $ ScheduleWeekly (scheduleDayOfWeek a) ((min `on` scheduleStart) a b) (scheduleEnd a) (scheduleRoom a <|> scheduleRoom b)
| otherwise
= Nothing
merge _ = Nothing
@ -83,6 +85,7 @@ normalizeOccurrences initial
[ scheduleDayOfWeek == localWeekDay
, scheduleStart == exceptStart
, scheduleEnd == exceptEnd
, scheduleRoom ==~ exceptRoom
]
unless needed $
throwE =<< asks (over _occurrencesExceptions $ Set.filter (not . withinNeedle) . Set.delete needle)

2
templates/course.hamlet
View File

@ -255,7 +255,7 @@ $# $if NTop (Just 0) < NTop (courseCapacity course)
#{courseEventType}
<td .table__td>
<div .table__td-content>
^{occurrencesWidget courseEventTime}
^{occurrencesWidget (not showRoom) courseEventTime}
<td .table__td>
$if showRoom
<div .table__td-content>

2
templates/tutorial-participants.hamlet
View File

@ -8,7 +8,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
<dl .deflist>
<dt .deflist__dt>_{MsgTableTutorialTime}
<dd .deflist__dd>
^{occurrencesWidget tutorialTime}
^{occurrencesWidget tutorialRoomHidden tutorialTime}
<dt .deflist__dt>_{MsgTableTutorialTutors}
<dd .deflist__dd>
<ul>

7
templates/widgets/occurrence/cell/except-no-occurr.hamlet
View File

@ -1,7 +0,0 @@
$newline never
$# SPDX-FileCopyrightText: 2022 Sarah Vaupel <vaupel.sarah@campus.lmu.de>
$#
$# SPDX-License-Identifier: AGPL-3.0-or-later
_{MsgExceptionKindNoOccur}: #{exceptTime'}

4
templates/widgets/occurrence/cell/except-occur.hamlet
View File

@ -5,6 +5,8 @@ $#
$# SPDX-License-Identifier: AGPL-3.0-or-later
$if not (null occurrencesScheduled')
_{MsgExceptionKindOccur}: #{exceptStart'}–#{exceptEnd'}
_{MsgExceptionKindOccur}: #{exceptStart'}–#{exceptEnd'}
$if not roomHidden
^{foldMap roomReferenceWidget exceptRoom}
$else
#{exceptStart'}–#{exceptEnd'}

7
templates/widgets/occurrence/cell/except-occurr.hamlet
View File

@ -1,7 +0,0 @@
$newline never
$# SPDX-FileCopyrightText: 2022 Sarah Vaupel <vaupel.sarah@campus.lmu.de>
$#
$# SPDX-License-Identifier: AGPL-3.0-or-later
_{MsgExceptionKindOccur}: #{exceptStart'}–#{exceptEnd'}

4
templates/widgets/occurrence/cell/weekly.hamlet
View File

@ -4,4 +4,6 @@ $# SPDX-FileCopyrightText: 2022 Sarah Vaupel <vaupel.sarah@campus.lmu.de>
$#
$# SPDX-License-Identifier: AGPL-3.0-or-later
_{ShortWeekDay scheduleDayOfWeek} #{scheduleStart'}–#{scheduleEnd'}
_{ShortWeekDay scheduleDayOfWeek} #{scheduleStart'}–#{scheduleEnd'}
$if not roomHidden
^{foldMap roomReferenceWidget scheduleRoom}

2
templates/widgets/occurrence/form/except-occur.hamlet
View File

@ -7,4 +7,4 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
<td>
_{ExceptionKindOccur}
<td>
#{exceptStart'}–#{exceptEnd'}
#{exceptStart'}–#{exceptEnd'} ^{foldMap roomReferenceWidget exceptRoom}

2
templates/widgets/occurrence/form/weekly.hamlet
View File

@ -7,4 +7,4 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
<td>
_{ScheduleKindWeekly}
<td>
_{scheduleDayOfWeek}, #{scheduleStart'}–#{scheduleEnd'}
_{scheduleDayOfWeek}, #{scheduleStart'}–#{scheduleEnd'} ^{foldMap roomReferenceWidget scheduleRoom}

13
test/Database/Fill.hs
View File

@ -1081,16 +1081,19 @@ fillDb = do
{ scheduleDayOfWeek = Thursday
, scheduleStart = TimeOfDay 11 11 0
, scheduleEnd = TimeOfDay 12 22 0
, scheduleRoom = Just $ RoomReferenceSimple "B777"
}
, ScheduleWeekly
{ scheduleDayOfWeek = Friday
, scheduleStart = TimeOfDay 13 33 0
, scheduleEnd = TimeOfDay 14 44 0
, scheduleRoom = Just $ RoomReferenceSimple "A320neo"
}
, ScheduleWeekly
{ scheduleDayOfWeek = Sunday
, scheduleStart = TimeOfDay 15 55 0
, scheduleEnd = TimeOfDay 16 06 0
, scheduleRoom = Nothing
}
]
, occurrencesExceptions = Set.fromList
@ -1098,16 +1101,19 @@ fillDb = do
{ exceptDay = nTimes 7 succ firstDay
, exceptStart = TimeOfDay 8 30 0
, exceptEnd = TimeOfDay 16 0 0
, exceptRoom = Just $ RoomReferenceSimple "A380"
}
, ExceptOccur
{ exceptDay = nTimes 8 succ secondDay
, exceptStart = TimeOfDay 9 0 0
, exceptEnd = TimeOfDay 16 0 0
, exceptRoom = Just $ RoomReferenceSimple "B747"
}
, ExceptOccur
{ exceptDay = nowaday
, exceptStart = TimeOfDay 9 10 0
, exceptEnd = TimeOfDay 16 10 0
, exceptRoom = Nothing
}
]
}
@ -1139,21 +1145,25 @@ fillDb = do
{ exceptDay = firstDay
, exceptStart = TimeOfDay 8 30 0
, exceptEnd = TimeOfDay 16 0 0
, exceptRoom = Nothing
}
, ExceptOccur
{ exceptDay = succ firstDay
, exceptStart = TimeOfDay 9 0 0
, exceptEnd = TimeOfDay 16 0 0
, exceptRoom = Nothing
}
, ExceptOccur
{ exceptDay = secondDay
, exceptStart = TimeOfDay 10 12 0
, exceptEnd = TimeOfDay 12 13 0
, exceptRoom = Nothing
}
, ExceptOccur
{ exceptDay = nowaday
, exceptStart = TimeOfDay 17 10 0
, exceptEnd = TimeOfDay 18 10 0
, exceptRoom = Nothing
}
]
}
@ -1184,16 +1194,19 @@ fillDb = do
{ exceptDay = succ $ succ firstDay
, exceptStart = TimeOfDay 8 25 0
, exceptEnd = TimeOfDay 16 25 0
, exceptRoom = Nothing
}
, ExceptOccur
{ exceptDay = succ $ succ $ succ $ succ firstDay
, exceptStart = TimeOfDay 9 20 0
, exceptEnd = TimeOfDay 16 20 0
, exceptRoom = Nothing
}
, ExceptOccur
{ exceptDay = succ $ succ secondDay
, exceptStart = TimeOfDay 10 12 0
, exceptEnd = TimeOfDay 12 13 0
, exceptRoom = Nothing
}
]
}