chore(daily): add page actions #90

This commit is contained in:
Steffen Jost 2024-09-13 16:18:38 +02:00 committed by Sarah Vaupel
parent 11ef856b2b
commit 4dbe005709
6 changed files with 32 additions and 11 deletions

View File

@ -20,3 +20,7 @@ ExceptionNoOccurAt: Termin
ExceptionKind: Termin ...
ExceptionKindOccur: Findet statt
ExceptionKindNoOccur: Findet nicht statt
DayNext: Folgetag
DayPrev: Vortag
WeekNext: Nächste Woche
WeekPrev: Vorherige Woche

View File

@ -20,3 +20,7 @@ ExceptionNoOccurAt: Event
ExceptionKind: Event ...
ExceptionKindOccur: Does occur
ExceptionKindNoOccur: Does not occur
DayNext: Next day
DayPrev: Previous day
WeekNext: Next week
WeekPrev: Previous week

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>,Steffen Jost <jost@cip.ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.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>,Steffen Jost <jost@cip.ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later
@ -1201,6 +1201,13 @@ pageActions SchoolListR = return
, navChildren = []
}
]
pageActions (SchoolR ssh (SchoolDayR nd)) = return
[ NavPageActionPrimary
{ navLink = defNavLink msg $ SchoolR ssh (SchoolDayR $ addDays n nd)
, navChildren = []
}
| (msg, n) <- [(MsgWeekPrev, -7), (MsgDayPrev, -1), (MsgDayNext, 1), (MsgWeekNext, 7)]
]
pageActions UsersR = return
[ NavPageActionPrimary
{ navLink = NavLink
@ -2583,7 +2590,7 @@ submissionList tid csh shn uid = withReaderT (projectBackend @SqlReadBackend) .
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val uid
E.&&. sheet E.^. SheetName E.==. E.val shn
E.&&. sheet E.^. SheetName E.==. E.val shn
E.&&. course E.^. CourseShorthand E.==. E.val csh
E.&&. course E.^. CourseTerm E.==. E.val tid

View File

@ -82,17 +82,22 @@ mkDailyTable ssh nd = do
EL.on $ course E.^. CourseId E.==. tut E.^. TutorialCourse
E.where_ $ course E.^. CourseSchool E.==. E.val ssh
E.&&. (E.just (tut E.^. TutorialTime) @>. E.jsonbVal (occurrenceDayValue nd))
E.&&. E.exists $ do
E.&&. E.exists (do
trm <- E.from $ E.table @Term
E.where_ $ E.between (E.val nd) (trm E.^. TermStart, trm E.^. TermEnd)
E.&&. trm E.^. TermId E.==. course E.^. CourseTerm
)
return (course, tut)
dbtRowKey = queryTutorial >>> (E.^. TutorialId)
dbtProj = dbtProjId
dbtColonnade = mconcat
[ -- dbSelect (applying _2) id (return . view (resultTutorial . _entityKey))
sortable (Just "course") (i18nCell MsgFilterCourse) $ \(view $ resultCourse . _entityVal . _courseName . _CI -> t) -> textCell t
, sortable (Just "tutorial") (i18nCell MsgCourseTutorial) $ \(view $ resultTutorial . _entityVal . _tutorialName . _CI -> t) -> textCell t
sortable (Just "course") (i18nCell MsgFilterCourse) $ \(view $ resultCourse . _entityVal -> c) -> courseCell c
, sortable (Just "tutorial") (i18nCell MsgCourseTutorial) $ \row ->
let Course{courseTerm=tid, courseSchool=cssh, courseShorthand=csh}
= row ^. resultCourse . _entityVal
tutName = row ^. resultTutorial . _entityVal . _tutorialName
in anchorCell (CTutorialR tid cssh csh tutName TUsersR) $ citext2widget tutName
]
dbtSorting = Map.fromList
[ ("course" , SortColumn $ queryCourse >>> (E.^. CourseName))

View File

@ -2,6 +2,8 @@
--
-- SPDX-License-Identifier: AGPL-3.0-or-later
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Import.NoModel
( module Import
, MForm
@ -270,3 +272,8 @@ import Control.Monad.Trans.RWS (RWST)
type MForm m = RWST (Maybe (Env, FileEnv), HandlerSite m, [Lang]) Enctype Ints m
type WeekDay = DayOfWeek
-- TODO: maybe move elsewhere
deriving newtype instance NFData a => NFData (JSONB a)
deriving newtype instance Semigroup a => Semigroup (JSONB a)
deriving newtype instance Monoid a => Monoid (JSONB a)

View File

@ -233,11 +233,6 @@ instance Semigroup Occurrences where
instance Monoid Occurrences where
mempty = Occurrences mempty mempty
-- TODO: move elsewhere
deriving newtype instance NFData a => NFData (JSONB a)
deriving newtype instance Semigroup a => Semigroup (JSONB a)
deriving newtype instance Monoid a => Monoid (JSONB a)
jsonbOCCUR :: Maybe (JSONB Occurrences) -> Occurrences
jsonbOCCUR = foldMap unJSONB
@ -248,7 +243,6 @@ _Occurrences :: Iso' (JSONB Occurrences) Occurrences
_Occurrences = iso unJSONB JSONB
nullaryPathPiece ''DayOfWeek camelToPathPiece
-- test :: IO [OccurrenceException]