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

chore(daily): basic functionality #1939 completed and checked

Browse Source 
- filters now work as intended
- textField suggestions now work as intended
This commit is contained in:
Steffen Jost 2024-11-27 12:56:29 +01:00
parent df3f60709e
commit 2af3ffb73a
11 changed files with 138 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
messages/uniworx/categories/courses/courses/en-eu.msg
View File

@ -2,7 +2,7 @@
# #
# SPDX-License-Identifier: AGPL-3.0-or-later # SPDX-License-Identifier: AGPL-3.0-or-later
FilterCourse: Course FilterCourse: Course type
FilterCourseShort: Shorthand FilterCourseShort: Shorthand
FilterTerm: Year FilterTerm: Year
FilterCourseSchoolShort: Department FilterCourseSchoolShort: Department

2
messages/uniworx/categories/courses/tutorial/de-de-formal.msg
View File

@ -55,5 +55,5 @@ TutorialDrivingPermit: Führerschein
TutorialEyeExam: Sehtest TutorialEyeExam: Sehtest
TutorialNote: Kursnotiz TutorialNote: Kursnotiz
TutorialDayAttendance day@Text: Anwesenheit #{day} TutorialDayAttendance day@Text: Anwesenheit #{day}
TutorialDayNote day@Text: Anwesenheitsnotiz für #{day} TutorialDayNote day@Text: Anwesenheitsnotiz #{day}
TutorialParticipantsDayEdits day@Text: Kursteilnehmer-Tagesnotizen aktualisiert für #{day} TutorialParticipantsDayEdits day@Text: Kursteilnehmer-Tagesnotizen aktualisiert für #{day}

2
messages/uniworx/utils/navigation/menu/de-de-formal.msg
View File

@ -97,7 +97,7 @@ MenuExamOfficeUsers: Benutzer:innen
MenuLecturerInvite: Funktionäre hinzufügen MenuLecturerInvite: Funktionäre hinzufügen
MenuSchoolList: Bereiche MenuSchoolList: Bereiche
MenuSchoolNew: Neuen Bereich anlegen MenuSchoolNew: Neuen Bereich anlegen
MenuSchoolDay ssh@SchoolId d@Text: #{unSchoolKey ssh} #{d} Tagesansicht MenuSchoolDay ssh@SchoolId d@Text: #{d} #{unSchoolKey ssh} Tagesansicht
MenuExternalExamGrades: Prüfungsleistungen MenuExternalExamGrades: Prüfungsleistungen
MenuExternalExamUsers: Teilnehmer:innen MenuExternalExamUsers: Teilnehmer:innen
MenuExternalExamEdit: Bearbeiten MenuExternalExamEdit: Bearbeiten

2
messages/uniworx/utils/navigation/menu/en-eu.msg
View File

@ -97,7 +97,7 @@ MenuExamOfficeUsers: Users
MenuLecturerInvite: Add functionaries MenuLecturerInvite: Add functionaries
MenuSchoolList: Departments MenuSchoolList: Departments
MenuSchoolNew: Create new department MenuSchoolNew: Create new department
MenuSchoolDay ssh d: #{unSchoolKey ssh} #{d} Day MenuSchoolDay ssh d: #{d} #{unSchoolKey ssh} Agenda
MenuExternalExamGrades: Exam results MenuExternalExamGrades: Exam results
MenuExternalExamUsers: Participants MenuExternalExamUsers: Participants
MenuExternalExamEdit: Edit MenuExternalExamEdit: Edit

4
messages/uniworx/utils/table_column/de-de-formal.msg
View File

@ -80,7 +80,9 @@ TableCompanyFilter: Firma oder Nummer
TableCompanyShort: Firmenkürzel TableCompanyShort: Firmenkürzel
TableCompanies: Firmen TableCompanies: Firmen
TablePrimeCompany: Primäre Firma TablePrimeCompany: Primäre Firma
TablePrimeCompanyShort: Kürzel primäre Firma
TableBookingCompany: Buchende Firma TableBookingCompany: Buchende Firma
TableBookingCompanyShort: Kürzel buchende Firma
TableCompanyNo: Firmennummer TableCompanyNo: Firmennummer
TableCompanyNos: Firmennummern TableCompanyNos: Firmennummern
TableCompanyUser: Firmenangehöriger TableCompanyUser: Firmenangehöriger
@ -118,4 +120,4 @@ TableFilterCommaName: Mehrere Namen mit Komma trennen.
TableFilterCommaNameNr: Mehrere Namen oder Nummern mit Komma trennen. Nummern werden nur exakt gesucht. TableFilterCommaNameNr: Mehrere Namen oder Nummern mit Komma trennen. Nummern werden nur exakt gesucht.
TableUserEdit: Benutzer bearbeiten TableUserEdit: Benutzer bearbeiten
TableRows: Zeilen TableRows: Zeilen
TableUserParkingToken: Parkmarke TableUserParkingToken day@Text: Parkmarke #{day}

6
messages/uniworx/utils/table_column/en-eu.msg
View File

@ -20,7 +20,7 @@ TableMatrikelNr: AVS person no
TableSex: Sex TableSex: Sex
TableBirthday: Birthday TableBirthday: Birthday
TableSchool: Department TableSchool: Department
TableCourse: Course TableCourse: Course type
TableCourseMembers: Participants TableCourseMembers: Participants
TableExamOccurrence: Occurrence/room TableExamOccurrence: Occurrence/room
TableExamName: Name TableExamName: Name
@ -80,7 +80,9 @@ TableCompanyFilter: Company/Nr
TableCompanyShort: Company shorthand TableCompanyShort: Company shorthand
TableCompanies: Companies TableCompanies: Companies
TablePrimeCompany: Primary company TablePrimeCompany: Primary company
TablePrimeCompanyShort: Primary company shorthand
TableBookingCompany: Booking company TableBookingCompany: Booking company
TableBookingCompanyShort: Booking company shorthand
TableCompanyNo: Company number TableCompanyNo: Company number
TableCompanyNos: Company numbers TableCompanyNos: Company numbers
TableCompanyUser: Associate TableCompanyUser: Associate
@ -118,4 +120,4 @@ TableFilterCommaName: Separate names by comma.
TableFilterCommaNameNr: Separate names and numbers by comma. Numbers have to match exact. TableFilterCommaNameNr: Separate names and numbers by comma. Numbers have to match exact.
TableUserEdit: Edit user TableUserEdit: Edit user
TableRows: Rows TableRows: Rows
TableUserParkingToken: Parking token TableUserParkingToken day: Parking token #{day}

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

@ -191,8 +191,8 @@ queryTutorial :: DailyTableExpr -> E.SqlExpr (Entity Tutorial)
queryTutorial = $(sqlMIXproj' ''DailyTableExpr 2) queryTutorial = $(sqlMIXproj' ''DailyTableExpr 2)
queryParticipant :: DailyTableExpr -> E.SqlExpr (Entity TutorialParticipant) queryParticipant :: DailyTableExpr -> E.SqlExpr (Entity TutorialParticipant)
queryParticipant = $(sqlMIXproj' ''DailyTableExpr 3) -- TODO reify seems problematic for now queryParticipant = $(sqlMIXproj' ''DailyTableExpr 3)
-- queryParticipant = $(sqlMIXproj DAILY_TABLE_JOIN 3) -- queryParticipant = $(sqlMIXproj DAILY_TABLE_JOIN 3) -- reify seems problematic for now
queryUser :: DailyTableExpr -> E.SqlExpr (Entity User) queryUser :: DailyTableExpr -> E.SqlExpr (Entity User)
queryUser = $(sqlMIXproj' ''DailyTableExpr 4) queryUser = $(sqlMIXproj' ''DailyTableExpr 4)
@ -286,7 +286,8 @@ colParticipantEyeExamField' l = sortable (Just "eye-exam") (i18nCell MsgTutorial
-- ) -- )
colParticipantNoteField :: Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData))) colParticipantNoteField :: Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData)))
colParticipantNoteField = sortable (Just "note-tutorial") (i18nCell MsgTutorialNote) $ (cellAttrs <>~ [("style","width:60%")]) <$> formCell id colParticipantNoteField = sortable (Just "note-tutorial") (i18nCell MsgTutorialNote) $ -- (cellAttrs <>~ [("style","width:60%")]) <$>
formCell id
(views (resultParticipant . _entityKey) return) (views (resultParticipant . _entityKey) return)
(\row mkUnique -> (\row mkUnique ->
let note = row ^. resultParticipant . _entityVal . _tutorialParticipantNote let note = row ^. resultParticipant . _entityVal . _tutorialParticipantNote
@ -348,7 +349,7 @@ suggsParticipantNote sid cid tid = do
-- $logInfoS "NOTE-SUGGS *** B: " $ tshow ol -- $logInfoS "NOTE-SUGGS *** B: " $ tshow ol
pure $ mkOptionListFromCacheable ol pure $ mkOptionListFromCacheable ol
suggsAttendanceNote :: SchoolId -> CourseId -> TutorialId -> Handler (OptionList Textarea) suggsAttendanceNote :: SchoolId -> CourseId -> TutorialId -> Handler (OptionList Text)
suggsAttendanceNote sid cid tid = do suggsAttendanceNote sid cid tid = do
ol <- $(memcachedByHere) (Just . Right $ 12 * diffSecond) (sid,cid,tid) $ do -- memcached key good enough? ol <- $(memcachedByHere) (Just . Right $ 12 * diffSecond) (sid,cid,tid) $ do -- memcached key good enough?
suggs <- runDB $ E.select $ do suggs <- runDB $ E.select $ do
@ -362,41 +363,39 @@ suggsAttendanceNote sid cid tid = do
E.orderBy [E.desc $ tpa E.^. TutorialParticipantDayDay, E.desc countRows'] E.orderBy [E.desc $ tpa E.^. TutorialParticipantDayDay, E.desc countRows']
E.limit maxSuggestions E.limit maxSuggestions
pure (tpa E.^. TutorialParticipantDayNote, E.val (1 :: Int64)) pure (tpa E.^. TutorialParticipantDayNote, E.val (1 :: Int64))
-- ) `E.unionAll_` ) `E.unionAll_`
-- ( do ( do
-- (tpa :& tut) <- E.from $ E.table @TutorialParticipantDay (tpa :& tut) <- E.from $ E.table @TutorialParticipantDay
-- `E.innerJoin` E.table @Tutorial `E.innerJoin` E.table @Tutorial
-- `E.on` (\(tpa :& tut) -> tut E.^. TutorialId E.==. tpa E.^. TutorialParticipantDayTutorial) `E.on` (\(tpa :& tut) -> tut E.^. TutorialId E.==. tpa E.^. TutorialParticipantDayTutorial)
-- E.where_ $ E.isJust (tpa E.^. TutorialParticipantDayNote) E.where_ $ E.isJust (tpa E.^. TutorialParticipantDayNote)
-- E.&&. tpa E.^. TutorialParticipantDayTutorial E.!=. E.val tid E.&&. tpa E.^. TutorialParticipantDayTutorial E.!=. E.val tid
-- E.&&. tut E.^. TutorialCourse E.==. E.val cid E.&&. tut E.^. TutorialCourse E.==. E.val cid
-- E.groupBy (tut E.^. TutorialLastChanged, tpa E.^. TutorialParticipantDayNote) E.groupBy (tpa E.^. TutorialParticipantDayNote, tpa E.^. TutorialParticipantDayDay, tut E.^. TutorialLastChanged)
-- E.orderBy [E.desc $ tut E.^. TutorialLastChanged, E.desc $ tpa E.^. TutorialParticipantDayDay, E.desc countRows'] E.orderBy [E.desc $ tpa E.^. TutorialParticipantDayDay, E.desc $ tut E.^. TutorialLastChanged, E.desc countRows']
-- E.limit maxSuggestions E.limit maxSuggestions
-- pure (tpa E.^. TutorialParticipantDayNote, E.val 2) pure (tpa E.^. TutorialParticipantDayNote, E.val 2)
-- ) `E.unionAll_` ) `E.unionAll_`
-- ( do ( do
-- tpa :& tut :& crs <- E.from $ E.table @TutorialParticipantDay tpa :& tut :& crs <- E.from $ E.table @TutorialParticipantDay
-- `E.innerJoin` E.table @Tutorial `E.innerJoin` E.table @Tutorial
-- `E.on` (\(tpa :& tut) -> tut E.^. TutorialId E.==. tpa E.^. TutorialParticipantDayTutorial) `E.on` (\(tpa :& tut) -> tut E.^. TutorialId E.==. tpa E.^. TutorialParticipantDayTutorial)
-- `E.innerJoin` E.table @Course `E.innerJoin` E.table @Course
-- `E.on` (\(_ :& tut :& crs) -> tut E.^. TutorialCourse E.==. crs E.^. CourseId) `E.on` (\(_ :& tut :& crs) -> tut E.^. TutorialCourse E.==. crs E.^. CourseId)
-- E.where_ $ E.isJust (tpa E.^. TutorialParticipantDayNote) E.where_ $ E.isJust (tpa E.^. TutorialParticipantDayNote)
-- E.&&. tpa E.^. TutorialParticipantDayTutorial E.!=. E.val tid E.&&. tpa E.^. TutorialParticipantDayTutorial E.!=. E.val tid
-- E.&&. tut E.^. TutorialCourse E.!=. E.val cid E.&&. tut E.^. TutorialCourse E.!=. E.val cid
-- E.&&. crs E.^. CourseSchool E.==. E.val sid E.&&. crs E.^. CourseSchool E.==. E.val sid
-- E.groupBy (tut E.^. TutorialLastChanged, tpa E.^. TutorialParticipantDayNote) E.groupBy (tpa E.^. TutorialParticipantDayNote, tpa E.^. TutorialParticipantDayDay, tut E.^. TutorialLastChanged)
-- E.orderBy [E.desc $ tut E.^. TutorialLastChanged, E.desc countRows'] E.orderBy [E.desc $ tpa E.^. TutorialParticipantDayDay, E.desc $ tut E.^. TutorialLastChanged, E.desc countRows']
-- E.limit maxSuggestions E.limit maxSuggestions
-- pure (tpa E.^. TutorialParticipantDayNote, E.val 3) pure (tpa E.^. TutorialParticipantDayNote, E.val 3)
) )
E.groupBy (tpn, prio) E.groupBy (tpn, prio)
E.orderBy [E.asc prio, E.asc tpn] E.orderBy [E.asc prio, E.asc tpn]
E.limit maxSuggestions E.limit maxSuggestions
pure $ E.coalesceDefault [tpn] $ E.val "" -- default never used due to where_ condtions, but conveniently changes type pure $ E.coalesceDefault [tpn] $ E.val "" -- default never used due to where_ condtions, but conveniently changes type
-- $logInfoS "NOTE-SUGGS *** A: " $ tshow suggs pure $ mkOptionListCacheable $ mkOptionText <$> nubOrd suggs -- NOTE: datalist does not work on textarea inputs
pure $ mkOptionListCacheable $ fmap Textarea . mkOptionText <$> nubOrd suggs -- TODO: datalist does not work on textarea inputs!
-- $logInfoS "NOTE-SUGGS *** B: " $ tshow ol
pure $ mkOptionListFromCacheable ol pure $ mkOptionListFromCacheable ol
@ -416,16 +415,18 @@ colAttendanceNoteField dday = sortable (Just "note-attend") (i18nCell $ MsgTutor
sid = row ^. resultCourse . _entityVal . _courseSchool sid = row ^. resultCourse . _entityVal . _courseSchool
cid = row ^. resultCourse . _entityKey cid = row ^. resultCourse . _entityKey
tid = row ^. resultTutorial . _entityKey tid = row ^. resultTutorial . _entityKey
in over (_1.mapped) ((_dailyFormAttendanceNote .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvWidget <$> in over (_1.mapped) ((_dailyFormAttendanceNote .~) . assertM (not . null) . fmap Text.strip) . over _2 fvWidget <$> -- For Textarea use: fmap (Text.strip . unTextarea)
mopt (textareaField & addDatalist (suggsAttendanceNote sid cid tid)) -- TODO: datalist does not work on textarea inputs! mopt (textField & cfStrip & addDatalist (suggsAttendanceNote sid cid tid)) (fsUniq mkUnique "note-attendance") note
(fsUniq mkUnique "note-attendance" & addClass' "uwx-short" ---- Version für Textare
-- & addAttr "rows" "2" -- does not work without class uwx-short -- mopt (textareaField) -- & addDatalist (suggsAttendanceNote sid cid tid)) -- NOTE: datalist does not work on textarea inputs
-- & addAttr "cols" "12" -- let it stretch -- (fsUniq mkUnique "note-attendance" & addClass' "uwx-short"
-- & addAutosubmit -- submits while typing -- -- & addAttr "rows" "2" -- does not work without class uwx-short
) (Textarea <<$>> note) -- -- & addAttr "cols" "12" -- let it stretch
-- -- & addAutosubmit -- submits while typing
-- ) (Textarea <<$>> note)
) )
colParkingField :: Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData))) colParkingField :: Text -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData)))
colParkingField = colParkingField' _dailyFormParkingToken colParkingField = colParkingField' _dailyFormParkingToken
-- colParkingField' :: ASetter' a Bool -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId a DailyTableData))) -- colParkingField' :: ASetter' a Bool -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId a DailyTableData)))
@ -435,18 +436,18 @@ colParkingField = colParkingField' _dailyFormParkingToken
-- over (_1.mapped) (l .~) . over _2 fvWidget <$> mreq checkBoxField (fsUniq mkUnique "parktoken") parking -- over (_1.mapped) (l .~) . over _2 fvWidget <$> mreq checkBoxField (fsUniq mkUnique "parktoken") parking
-- ) -- )
colParkingField' :: ASetter' a Bool -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId a DailyTableData))) colParkingField' :: ASetter' a Bool -> Text -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId a DailyTableData)))
colParkingField' l = sortable (Just "parking") (i18nCell MsgTableUserParkingToken) $ (cellAttrs %~ addAttrsClass "text--center") <$> formCell colParkingField' l dday = sortable (Just "parking") (i18nCell $ MsgTableUserParkingToken dday) $ (cellAttrs %~ addAttrsClass "text--center") <$> formCell
id -- TODO: this should not be id! Refactor to simplify the thrid argument below id -- TODO: this should not be id! Refactor to simplify the thrid argument below
(views (resultParticipant . _entityKey) return) (views (resultParticipant . _entityKey) return)
(\(preview (resultUserDay . _userDayParkingToken) -> parking) mkUnique -> (\(preview (resultUserDay . _userDayParkingToken) -> parking) mkUnique ->
over (_1.mapped) (l .~) . over _2 fvWidget <$> mreq checkBoxField (fsUniq mkUnique "parktoken") parking over (_1.mapped) (l .~) . over _2 fvWidget <$> mreq checkBoxField (fsUniq mkUnique "parktoken") parking
) )
mkDailyTable :: Bool -> SchoolId -> Day -> DB (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData), Widget) mkDailyTable :: Bool -> SchoolId -> Day -> DB (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData), Maybe Widget)
mkDailyTable isAdmin ssh nd = getDayTutorials' ssh (nd,nd) >>= \case mkDailyTable isAdmin ssh nd = getDayTutorials' ssh (nd,nd) >>= \case
tutLessons tutLessons
| Map.null tutLessons -> return (FormMissing, [whamlet|No tutorials on this day|]) | Map.null tutLessons -> return (FormMissing, Nothing)
| otherwise -> do | otherwise -> do
dday <- formatTime SelFormatDate nd dday <- formatTime SelFormatDate nd
let let
@ -473,7 +474,7 @@ mkDailyTable isAdmin ssh nd = getDayTutorials' ssh (nd,nd) >>= \case
dbtProj = dbtProjId dbtProj = dbtProjId
dbtColonnade = formColonnade $ mconcat dbtColonnade = formColonnade $ mconcat
[ -- dbSelect (applying _2) id (return . view (resultTutorial . _entityKey)) [ -- dbSelect (applying _2) id (return . view (resultTutorial . _entityKey))
sortable (Just "course") (i18nCell MsgFilterCourse) $ \(view $ resultCourse . _entityVal -> c) -> courseCell c sortable (Just "course") (i18nCell MsgTableCourse) $ \(view $ resultCourse . _entityVal -> c) -> courseCell c
, sortable (Just "tutorial") (i18nCell MsgCourseTutorial) $ \row -> , sortable (Just "tutorial") (i18nCell MsgCourseTutorial) $ \row ->
let Course{courseTerm=tid, courseSchool=cssh, courseShorthand=csh} let Course{courseTerm=tid, courseSchool=cssh, courseShorthand=csh}
= row ^. resultCourse . _entityVal = row ^. resultCourse . _entityVal
@ -486,8 +487,8 @@ mkDailyTable isAdmin ssh nd = getDayTutorials' ssh (nd,nd) >>= \case
-- , 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 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 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 "user-company") (i18nCell MsgTablePrimeCompany) $ \(preview resultCompanyId -> mcid) -> cellMaybe companyIdCell mcid
-- , sortable (Just "booking-company") (i18nCell MsgTableBookingCompany) $ \(view $ resultParticipant . _entityVal . _tutorialParticipantCompany -> mcid) -> cellMaybe companyIdCell mcid -- , sortable (Just "booking-firm") (i18nCell MsgTableBookingCompany) $ \(view $ resultParticipant . _entityVal . _tutorialParticipantCompany -> mcid) -> cellMaybe companyIdCell mcid
, sortable (Just "booking-company") (i18nCell MsgTableBookingCompany) $ \row -> , sortable (Just "booking-firm") (i18nCell MsgTableBookingCompany) $ \row ->
let bookComp = row ^. resultParticipant . _entityVal . _tutorialParticipantCompany let bookComp = row ^. resultParticipant . _entityVal . _tutorialParticipantCompany
primComp = row ^? resultCompanyId primComp = row ^? resultCompanyId
bookLink = cellMaybe companyIdCell bookComp bookLink = cellMaybe companyIdCell bookComp
@ -500,7 +501,7 @@ mkDailyTable isAdmin ssh nd = getDayTutorials' ssh (nd,nd) >>= \case
(Just IconCompanyWarning) True) (Just IconCompanyWarning) True)
| otherwise = bookLink | otherwise = bookLink
in result in result
-- , sortable (Just "booking-company") (i18nCell MsgTableBookingCompany) $ \row -> -- , sortable (Just "booking-firm") (i18nCell MsgTableBookingCompany) $ \row ->
-- let bookComp = row ^. resultParticipant . _entityVal . _tutorialParticipantCompany -- let bookComp = row ^. resultParticipant . _entityVal . _tutorialParticipantCompany
-- primComp = row ^? resultCompanyId -- primComp = row ^? resultCompanyId
-- bookLink = cellMaybe companyIdCell bookComp -- bookLink = cellMaybe companyIdCell bookComp
@ -510,7 +511,7 @@ mkDailyTable isAdmin ssh nd = getDayTutorials' ssh (nd,nd) >>= \case
-- , Just (unCompanyKey -> csh) <- primComp -- , Just (unCompanyKey -> csh) <- primComp
-- = bookLink -- = bookLink
-- <> spacerCell -- <> spacerCell
-- <> cell (modal (warnIcon csh) (Right -- TODO: use iconCompanyWarning instead! -- <> cell (modal (warnIcon csh) (Right -- maybe just use iconCompanyWarning instead of modal?
-- [whamlet| -- [whamlet|
-- <h2> -- <h2>
-- ^{userWidget row} -- ^{userWidget row}
@ -528,8 +529,8 @@ mkDailyTable isAdmin ssh nd = getDayTutorials' ssh (nd,nd) >>= \case
, colParticipantNoteField , colParticipantNoteField
, colAttendanceField dday , colAttendanceField dday
, colAttendanceNoteField dday , colAttendanceNoteField dday
, colParkingField , colParkingField dday
-- FOR DEBUGGING ONLY -- FOR DEBUGGING ONLY:
-- , sortable (Just "permit") (i18nCell MsgTutorialDrivingPermit) $ \(view $ resultParticipant . _entityVal . _tutorialParticipantDrivingPermit -> x) -> x & cellMaybe i18nCell -- , sortable (Just "permit") (i18nCell MsgTutorialDrivingPermit) $ \(view $ resultParticipant . _entityVal . _tutorialParticipantDrivingPermit -> x) -> x & cellMaybe i18nCell
-- , sortable (Just "eye-exam") (i18nCell MsgTutorialEyeExam) $ \(view $ resultParticipant . _entityVal . _tutorialParticipantEyeExam -> x) -> x & cellMaybe i18nCell -- , sortable (Just "eye-exam") (i18nCell MsgTutorialEyeExam) $ \(view $ resultParticipant . _entityVal . _tutorialParticipantEyeExam -> x) -> x & cellMaybe i18nCell
-- , sortable (Just "note-tutorial") (i18nCell MsgTutorialNote) $ \(view $ resultParticipant . _entityVal . _tutorialParticipantNote -> x) -> x & cellMaybe textCell -- , sortable (Just "note-tutorial") (i18nCell MsgTutorialNote) $ \(view $ resultParticipant . _entityVal . _tutorialParticipantNote -> x) -> x & cellMaybe textCell
@ -543,7 +544,7 @@ mkDailyTable isAdmin ssh nd = getDayTutorials' ssh (nd,nd) >>= \case
, ("course" , SortColumn $ queryCourse >>> (E.^. CourseName)) , ("course" , SortColumn $ queryCourse >>> (E.^. CourseName))
, ("tutorial" , SortColumn $ queryTutorial >>> (E.^. TutorialName)) , ("tutorial" , SortColumn $ queryTutorial >>> (E.^. TutorialName))
, ("user-company" , SortColumn $ queryUser >>> selectCompanyUserPrime) , ("user-company" , SortColumn $ queryUser >>> selectCompanyUserPrime)
, ("booking-company", SortColumn $ queryParticipant >>> (E.^. TutorialParticipantCompany)) , ("booking-firm" , SortColumn $ queryParticipant >>> (E.^. TutorialParticipantCompany))
, ("card-no" , SortColumn $ queryUserAvs >>> (E.?. UserAvsLastCardNo)) , ("card-no" , SortColumn $ queryUserAvs >>> (E.?. UserAvsLastCardNo))
, ("permit" , SortColumnNullsInv $ queryParticipant >>> (E.^. TutorialParticipantDrivingPermit)) , ("permit" , SortColumnNullsInv $ queryParticipant >>> (E.^. TutorialParticipantDrivingPermit))
, ("eye-exam" , SortColumnNullsInv $ queryParticipant >>> (E.^. TutorialParticipantEyeExam)) , ("eye-exam" , SortColumnNullsInv $ queryParticipant >>> (E.^. TutorialParticipantEyeExam))
@ -557,12 +558,14 @@ mkDailyTable isAdmin ssh nd = getDayTutorials' ssh (nd,nd) >>= \case
, fltrUserMatriclenr queryUser , fltrUserMatriclenr queryUser
, ("course" , FilterColumn . E.mkContainsFilter $ queryCourse >>> (E.^. CourseName)) , ("course" , FilterColumn . E.mkContainsFilter $ queryCourse >>> (E.^. CourseName))
, ("tutorial" , FilterColumn . E.mkContainsFilter $ queryTutorial >>> (E.^. TutorialName)) , ("tutorial" , FilterColumn . E.mkContainsFilter $ queryTutorial >>> (E.^. TutorialName))
, ("user-company" , FilterColumn . E.mkContainsFilter $ queryUser >>> selectCompanyUserPrime) , ("booking-firm" , FilterColumn . E.mkContainsFilterWith Just $ queryParticipant >>> (E.^. TutorialParticipantCompany))
, ("user-company" , FilterColumn . E.mkContainsFilterWith Just $ queryUser >>> selectCompanyUserPrime)
] ]
dbtFilterUI mPrev = mconcat dbtFilterUI mPrev = mconcat
[ prismAForm (singletonFilter "course" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgFilterCourse) [ prismAForm (singletonFilter "course" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgFilterCourse)
, prismAForm (singletonFilter "tutorial" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgCourseTutorial) , prismAForm (singletonFilter "tutorial" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgCourseTutorial)
, prismAForm (singletonFilter "user-company" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTablePrimeCompany) , prismAForm (singletonFilter "booking-firm" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableBookingCompanyShort)
, prismAForm (singletonFilter "user-company" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTablePrimeCompanyShort)
, fltrUserNameEmailUI mPrev , fltrUserNameEmailUI mPrev
, fltrUserMatriclenrUI mPrev , fltrUserMatriclenrUI mPrev
] ]
@ -605,7 +608,7 @@ mkDailyTable isAdmin ssh nd = getDayTutorials' ssh (nd,nd) >>= \case
-- return (act, jobSet) -- return (act, jobSet)
psValidator = def & defaultSorting [SortAscBy "user-name", SortAscBy "course", SortAscBy "tutorial"] psValidator = def & defaultSorting [SortAscBy "user-name", SortAscBy "course", SortAscBy "tutorial"]
-- over _1 postprocess <$> dbTable psValidator DBTable{..} -- over _1 postprocess <$> dbTable psValidator DBTable{..}
dbTable psValidator DBTable{..} (over _2 Just) <$> dbTable psValidator DBTable{..}
getSchoolDayR, postSchoolDayR :: SchoolId -> Day -> Handler Html getSchoolDayR, postSchoolDayR :: SchoolId -> Day -> Handler Html
@ -622,12 +625,12 @@ postSchoolDayR ssh nd = do
, dailyFormAttendanceNote = row ^? resultParticipantDay ._tutorialParticipantDayNote . _Just , dailyFormAttendanceNote = row ^? resultParticipantDay ._tutorialParticipantDayNote . _Just
, dailyFormParkingToken = row ^? resultUserDay . _userDayParkingToken & fromMaybe False , dailyFormParkingToken = row ^? resultUserDay . _userDayParkingToken & fromMaybe False
} }
(fmap unFormResult -> tableRes,tableDaily) <- runDB $ mkDailyTable isAdmin ssh nd (fmap unFormResult -> tableRes, tableDaily) <- runDB $ mkDailyTable isAdmin ssh nd
$logInfoS "****DailyTable****" $ tshow tableRes -- logInfoS "****DailyTable****" $ tshow tableRes
formResult tableRes $ \resMap -> do formResult tableRes $ \resMap -> do
runDB $ do runDB $ do
forM_ (Map.toList resMap) $ \(tpid, DailyFormData{..}) -> do forM_ (Map.toList resMap) $ \(tpid, DailyFormData{..}) -> do
-- $logDebugS "TableForm" (tshow dfd) -- logDebugS "TableForm" (tshow dfd)
TutorialParticipant{..} <- get404 tpid -- needed anyway to find the ParticipantDay/UserDay updated TutorialParticipant{..} <- get404 tpid -- needed anyway to find the ParticipantDay/UserDay updated
when ( tutorialParticipantDrivingPermit /= dailyFormDrivingPermit when ( tutorialParticipantDrivingPermit /= dailyFormDrivingPermit
|| tutorialParticipantEyeExam /= dailyFormEyeExam || tutorialParticipantEyeExam /= dailyFormEyeExam
@ -654,6 +657,5 @@ postSchoolDayR ssh nd = do
siteLayoutMsg (MsgMenuSchoolDay ssh dday) $ do siteLayoutMsg (MsgMenuSchoolDay ssh dday) $ do
setTitleI (MsgMenuSchoolDay ssh dday) setTitleI (MsgMenuSchoolDay ssh dday)
[whamlet|TODO Overview School #{ciOriginal (unSchoolKey ssh)} $(i18nWidgetFile "day-view")
^{tableDaily}
|]

29
templates/i18n/day-view/de-de-formal.hamlet Normal file
View File

@ -0,0 +1,29 @@
$newline never
$# SPDX-FileCopyrightText: 2024 Steffen Jost <s.jost@fraport.de>
$#
$# SPDX-License-Identifier: AGPL-3.0-or-later
$maybe tbl <- tableDaily
<section>
^{tbl}
<section .profile>
<h3>Hinweise zu den Formularspalten
<dl .deflist.profile-dl>
<dt .deflist__dt>
_{MsgTutorialDrivingPermit}, _{MsgTutorialEyeExam}, _{MsgTutorialNote}
<dd .deflist__dd>
Pro Kurs und Teilnehmer wird je ein Wert gespeichert.
<dt .deflist__dt>
_{MsgTutorialDayAttendance mempty}, _{MsgTutorialDayNote mempty}
<dd .deflist__dd>
Pro Tag, Kurs und Teilnehmer wird je ein Wert gespeichert.
<dt .deflist__dt>
_{MsgTableUserParkingToken mempty}
<dd .deflist__dd>
Pro Tag und Teilnehmer wird ein Wert gespeichert, d.h. unabhängig vom Kurs.
\ Daraus folgt, dass die Parkmarke immer in allen Zeilen des gleichen Teilnehmers geändert werden muss.
$nothing
<section>
An diesem Tag sind zur Zeit keine Kurse eingetragen.

29
templates/i18n/day-view/en-eu.hamlet Normal file
View File

@ -0,0 +1,29 @@
$newline never
$# SPDX-FileCopyrightText: 2024 Steffen Jost <s.jost@fraport.de>
$#
$# SPDX-License-Identifier: AGPL-3.0-or-later
$maybe tbl <- tableDaily
<section>
^{tbl}
<section .profile>
<h3>Note how form data is saved
<dl .deflist.profile-dl>
<dt .deflist__dt>
_{MsgTutorialDrivingPermit}, _{MsgTutorialEyeExam}, _{MsgTutorialNote}
<dd .deflist__dd>
For each course and participant pairing, one value is stored each.
<dt .deflist__dt>
_{MsgTutorialDayAttendance mempty}, _{MsgTutorialDayNote mempty}
<dd .deflist__dd>
For each day, course and participant, one value is stored each.
<dt .deflist__dt>
_{MsgTableUserParkingToken mempty}
<dd .deflist__dd>
For each day and participant, one value is stored, i.e., indipendant of the course.
\ This requires that a change is performed in all rows of the same participant.
$nothing
<section>
No courses are currently scheduled on this day.

2
templates/i18n/profile-remarks/de-de-formal.hamlet
View File

@ -11,6 +11,8 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
Nicht aufgeführt sind Zeitstempel mit Benutzerinformationen, z.B. bei der Editierung und Korrektur von Übungen, Kursleiterschaft, Raumbuchungen, etc. Nicht aufgeführt sind Zeitstempel mit Benutzerinformationen, z.B. bei der Editierung und Korrektur von Übungen, Kursleiterschaft, Raumbuchungen, etc.
<li> <li>
Nicht aufgeführt sind die an diesen Benutzer versendeten Benachrichtigungen per E-Mail oder Briefpost. Nicht aufgeführt sind die an diesen Benutzer versendeten Benachrichtigungen per E-Mail oder Briefpost.
<li>
Nicht aufgeführt sind personenbezogene Vermerke, z.B. über Anwesenheit, Erhalt von Parkmarken, etc.
<li> <li>
<p> <p>
Sie können die Sie können die

2
templates/i18n/profile-remarks/en-eu.hamlet
View File

@ -11,6 +11,8 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
Timestamps with user information (e.g. editing of corrections, submission groups, rooms, ...) are not shown here. Timestamps with user information (e.g. editing of corrections, submission groups, rooms, ...) are not shown here.
<li> <li>
Sent notifications by email or letter are not shown here. Sent notifications by email or letter are not shown here.
<li>
Some personal notes (e.g. about attendance, receipt of parking permits, ...) are not shown here."
<li> <li>
<p> <p>
You can request your data be deleted by opening You can request your data be deleted by opening