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

Manual copy from branch merge-rewrite-jost due to botched-merge

Browse Source
This commit is contained in:
Steffen Jost 2025-03-03 11:32:14 +01:00
parent 088587549d
commit 1fc948711a
21 changed files with 114 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

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

@ -100,6 +100,7 @@ MenuLecturerInvite: Add functionaries
MenuSchoolList: Departments
MenuSchoolNew: Create new department
MenuSchoolDay ssh d: #{d} #{unSchoolKey ssh} Agenda
MenuSchoolDayCheck: Consistence check
MenuExternalExamGrades: Exam results
MenuExternalExamUsers: Participants
MenuExternalExamEdit: Edit

3
routes
View File

@ -1,4 +1,4 @@
-- SPDX-FileCopyrightText: 2022-2025 Sarah Vaupel <sarah.vaupel@uniworx.de>, Gregor Kleen <gregor.kleen@ifi.lmu.de>, Sarah Vaupel <sarah.vaupel@ifi.lmu.de>, Steffen Jost <jost@tcs.ifi.lmu.de>, Wolfgang Witt <Wolfgang.Witt@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
-- SPDX-FileCopyrightText: 2022-2025 Sarah Vaupel <sarah.vaupel@uniworx.de>, Gregor Kleen <gregor.kleen@ifi.lmu.de>, Sarah Vaupel <sarah.vaupel@ifi.lmu.de>, Steffen Jost <jost@tcs.ifi.lmu.de>, Wolfgang Witt <Wolfgang.Witt@campus.lmu.de>, Steffen Jost <s.jost@fraport.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later
@ -161,6 +161,7 @@
/school/#SchoolId SchoolR:
/edit SchoolEditR GET POST
/day/#Day SchoolDayR GET POST
/day/#Day/check SchoolDayCheckR GET
/participants ParticipantsListR GET !evaluation
/participants/#TermId/#SchoolId ParticipantsR GET !evaluation

13
src/Foundation/Navigation.hs
View File

@ -147,7 +147,7 @@ breadcrumb PrintAckR{} = i18nCrumb MsgMenuPrintSend $ Just PrintCenter
breadcrumb PrintAckDirectR{}= i18nCrumb MsgMenuPrintAck $ Just PrintCenterR
breadcrumb PrintLogR = i18nCrumb MsgMenuPrintLog $ Just PrintCenterR
breadcrumb SchoolListR = i18nCrumb MsgMenuSchoolList $ Just AdminR
breadcrumb SchoolListR = i18nCrumb MsgMenuSchoolList $ Just AdminR
breadcrumb (SchoolR ssh SchoolEditR) =
useRunDB . maybeT (i18nCrumb MsgBreadcrumbSchool $ Just SchoolListR) $ do
School{..} <- MaybeT $ get ssh
@ -157,7 +157,9 @@ breadcrumb (SchoolR ssh (SchoolDayR d)) = do
dt <- formatTime SelFormatDate d
mr <- getMessageRender
return (mr $ MsgMenuSchoolDay ssh dt, Just SchoolListR)
breadcrumb SchoolNewR = i18nCrumb MsgMenuSchoolNew $ Just SchoolListR
breadcrumb (SchoolR ssh (SchoolDayCheckR d))
= i18nCrumb MsgMenuSchoolDayCheck $ Just (SchoolR ssh (SchoolDayR d))
breadcrumb SchoolNewR = i18nCrumb MsgMenuSchoolNew $ Just SchoolListR
breadcrumb (ExamOfficeR EOExamsR) = i18nCrumb MsgMenuExamOfficeExams Nothing
breadcrumb (ExamOfficeR EOFieldsR) = i18nCrumb MsgMenuExamOfficeFields . Just $ ExamOfficeR EOExamsR
@ -1208,7 +1210,12 @@ pageActions SchoolListR = return
, navChildren = []
}
]
pageActions (SchoolR ssh (SchoolDayR nd)) = return
pageActions (SchoolR ssh (SchoolDayR nd)) = return $
( NavPageActionPrimary
{ navLink = defNavLinkModal MsgMenuSchoolDayCheck $ SchoolR ssh $ SchoolDayCheckR nd
, navChildren = []
}
) :
[ NavPageActionPrimary
{ navLink = defNavLink msg $ SchoolR ssh (SchoolDayR $ addDays n nd)
, navChildren = []

3
src/Handler/LMS.hs
View File

@ -112,9 +112,6 @@ resultAllQualificationTotal = _dbrOutput . _3 . _unValue
resultAllQualificationOrphans :: Lens' AllQualificationTableData Word64
resultAllQualificationOrphans = _dbrOutput . _4 . _unValue
resultAllQualificationOrphans :: Lens' AllQualificationTableData Word64
resultAllQualificationOrphans = _dbrOutput . _4 . _unValue
mkLmsAllTable :: Bool -> DB (Any, Widget)
mkLmsAllTable isAdmin = do

4
src/Handler/PrintCenter.hs
View File

@ -28,7 +28,7 @@ import Database.Esqueleto.Utils.TH
import Utils.Print
import qualified Data.Aeson as Aeson
import qualified Data.Text as Text
-- import qualified Data.Text as Text
-- import qualified Data.Set as Set
import Handler.Utils
@ -451,7 +451,7 @@ postPrintAckR ackDay numAck chksm = do
-- | otherwise = pure "ERROR"
saveApcident :: UTCTime -> Natural -> Text -> JobDB Natural
saveApcident t i apci = insert_ (PrintAcknowledge (Text.strip apci) t False) >> return (succ i)
saveApcident t i apci = insert_ (PrintAcknowledge apci t False) >> return (succ i)
makeAckUploadForm :: Form FileInfo

2
src/Handler/Qualification/Edit.hs
View File

@ -112,4 +112,4 @@ handleQualificationEdit ssh templ = do
$maybe _ <- templ
<p>
_{MsgQualificationEditNote}
|]
|]

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

@ -201,7 +201,7 @@ colParticipantEyeExamField' l = sortable (Just "eye-exam") (i18nCell MsgTutorial
-- )
colParticipantNoteField :: Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData)))
colParticipantNoteField = sortable (Just "note-tutorial") (i18nCell MsgTutorialNote) $ -- (cellAttrs <>~ [("style","width:60%")]) <$>
colParticipantNoteField = sortable (Just "note-tutorial") (i18nCell MsgTutorialNote) $ (cellAttrs <>~ [("style","min-width:12em")]) <$>
formCell id
(views (resultParticipant . _entityKey) return)
(\row mkUnique ->
@ -322,7 +322,7 @@ colAttendanceField dday = sortable (Just "attendance") (i18nCell $ MsgTutorialDa
)
colAttendanceNoteField :: Text -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData)))
colAttendanceNoteField dday = sortable (Just "note-attend") (i18nCell $ MsgTutorialDayNote dday) $ -- (cellAttrs <>~ [("style","width:10%"), ("style","height:200px")]) <$>
colAttendanceNoteField dday = sortable (Just "note-attend") (i18nCell $ MsgTutorialDayNote dday) $ (cellAttrs <>~ [("style","min-width:12em")]) <$>
formCell id
(views (resultParticipant . _entityKey) return)
(\row mkUnique ->
@ -395,10 +395,10 @@ mkDailyTable isAdmin ssh nd dcrs = getDayTutorials ssh (nd,nd) >>= \case
= row ^. resultCourse . _entityVal
tutName = row ^. resultTutorial . _entityVal . _tutorialName
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 MsgTableTutorialOccurrence) $ \(view $ resultTutorial . _entityKey -> tutId) -> cellMaybe (lessonTimesCell False . snd) $ Map.lookup tutId tutLessons
, sortable Nothing (i18nCell MsgTableTutorialRoom) $ \(view $ resultTutorial . _entityKey -> tutId) ->
-- listInlineCell (nubOrd . concat $ mapMM lessonRoom $ Map.lookup tutId tutLessons) roomReferenceCell
cellMaybe ((`listInlineCell` roomReferenceCell) . nubOrd) $ mapMM lessonRoom $ Map.lookup tutId tutLessons
cellMaybe ((`listInlineCell` roomReferenceCell) . nubOrd) $ mapMM lessonRoom $ snd <$> 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
@ -579,7 +579,7 @@ postSchoolDayR ssh nd = do
then flip upsertBy_ (UserDay tutorialParticipantUser nd dailyFormParkingToken) -- upsert if a permit was issued
else updateBy -- only update to no permit, if the record exists, but do not create a fresh record with parkingToken==False
updateUserDay udUq [ UserDayParkingToken =. dailyFormParkingToken]
return $ tutorialParticipantTutorial
return tutorialParticipantTutorial
forM_ tuts $ \tid -> do
memcachedByInvalidate (CacheKeySuggsParticipantNote ssh tid) $ Proxy @(OptionListCacheable Text)
memcachedByInvalidate (CacheKeySuggsAttendanceNote ssh tid) $ Proxy @(OptionListCacheable Text)
@ -589,6 +589,7 @@ postSchoolDayR ssh nd = do
redirect $ SchoolR ssh $ SchoolDayR nd
siteLayoutMsg (MsgMenuSchoolDay ssh dday) $ do
let consistencyBtn = btnModal MsgMenuSchoolDayCheck [BCIsButton, BCDefault] (Left $ SomeRoute $ SchoolR ssh $ SchoolDayCheckR nd)
setTitleI (MsgMenuSchoolDay ssh dday)
$(i18nWidgetFile "day-view")

3
src/Handler/Utils/Avs.hs
View File

@ -13,6 +13,7 @@ module Handler.Utils.Avs
, upsertAvsUserByCard
, upsertAvsUserById
, updateAvsUserByIds
, updateAvsUserByADC
, linktoAvsUserByUIDs
, queueAvsUpdateByUID, queueAvsUpdateByAID
-- , getLicence, getLicenceDB, getLicenceByAvsId -- not supported by interface
@ -29,6 +30,7 @@ module Handler.Utils.Avs
-- CR3
, SomeAvsQuery(..)
, queryAvsCardNo, queryAvsCardNos
, catchAVShandler
) where
import Import
@ -731,6 +733,7 @@ upsertCompanySuperior Entity{entityKey=cid, entityVal=Company{}} newAfi oldAfi u
oldSupId <- getOldId
reportAdminProblem $ AdminProblemCompanySuperiorNotFound usrId mbSupEmail cid oldSupId
-- | queue AVS synch for several UserIds, if a day is given, the last synch must be before the date to trigger an update
queueAvsUpdateByUID :: (MonoFoldable mono, UserId ~ Element mono) => mono -> Maybe Day -> DB Int64
queueAvsUpdateByUID uids = queueAvsUpdateAux (E.table @User) (E.^. UserId) (\usr -> usr E.^. UserId `E.in_` E.vals uids)

2
src/Handler/Utils/LMS.hs
View File

@ -129,7 +129,7 @@ lmsDeletionDate now qualiAuditDuration =
-- | Decide whether LMS platform should delete an identifier
lmsUserToDeleteExpr :: UTCTime -> E.SqlExpr (Entity LmsUser) -> E.SqlExpr (E.Value Bool)
lmsUserToDeleteExpr cutoff lmslist = E.isNothing (lmslist E.^. LmsUserEnded)
-- E.&&. E.isJust (lmslist E.^. LmsUserStatus)
E.&&. E.isJust (lmslist E.^. LmsUserStatus)
E.&&. E.isJust (lmslist E.^. LmsUserStatusDay)
E.&&. lmslist E.^. LmsUserStatusDay E.<=. E.justVal cutoff

2
src/Handler/Utils/Memcached.hs
View File

@ -1,4 +1,4 @@
-- SPDX-FileCopyrightText: 2022-2024 Sarah Vaupel <sarah.vaupel@uniworx.de>, Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
-- SPDX-FileCopyrightText: 2022-2024 Sarah Vaupel <sarah.vaupel@uniworx.de>, Gregor Kleen <gregor.kleen@ifi.lmu.de>, Steffen Jost <s.jost@fraport.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

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

@ -400,17 +400,6 @@ examOccurrenceCell Entity{entityVal = ExamOccurrence{..}} =
wgtCell [whamlet|#{examOccurrenceName}:^{formatTimeRangeW SelFormatDateTime examOccurrenceStart examOccurrenceEnd}|]
examCell :: IsDBTable m a => Course -> Exam -> DBCell m a
examCell Course{..} Exam{..} = anchorCell link name <> addModalDescriptionCell examDescription
where
link = CExamR courseTerm courseSchool courseShorthand examName EShowR
name = citext2widget examName
examOccurrenceCell :: IsDBTable m a => Entity ExamOccurrence -> DBCell m a
examOccurrenceCell Entity{entityVal = ExamOccurrence{..}} =
wgtCell [whamlet|#{examOccurrenceName}:^{formatTimeRangeW SelFormatDateTime examOccurrenceStart examOccurrenceEnd}|]
-- also see Handler.Utils.Widgets.companyWidget
companyCell :: IsDBTable m a => CompanyShorthand -> CompanyName -> Bool -> DBCell m a
companyCell csh cname isSupervisor = anchorCell curl name

15
src/Jobs/Handler/LMS.hs
View File

@ -1,4 +1,4 @@
-- SPDX-FileCopyrightText: 2022-2025 Steffen Jost <s.jost@fraport.de>
-- SPDX-FileCopyrightText: 2022-25 Steffen Jost <s.jost@fraport.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later
@ -321,13 +321,10 @@ dispatchJobLmsReports qid = JobHandlerAtomic act
E.&&. lreport E.^. LmsReportLock E.==. E.true
)
-- B) notify all newly reported users that lms is available
let luserFltrNew luser = E.isNothing (luser E.^. LmsUserReceived) -- not seen before, just starting OR (
E.||. E.isNothing (luser E.^. LmsUserNotified) -- a previous notification has failed AND
-- E.&&. E.not__ (luser E.^. LmsUserLocked) -- user is not to be locked)
repFltr _ lreport = lreport E.^. LmsReportResult E.==. E.val LmsOpen -- LMS is open now
E.&&. E.not__ (lreport E.^. LmsReportLock) -- never notify currently locked users
let luserFltrNew luser = E.isNothing (luser E.^. LmsUserReceived) -- not seen before, just starting
E.||. E.isNothing (luser E.^. LmsUserNotified) -- a previous notification has failed
notifyNewLearner (E.Value uid) = queueDBJob JobUserNotification { jRecipient = uid, jNotification = NotificationQualificationRenewal { nQualification = qid, nReminder = False } }
in luserQry luserFltrNew repFltr >>= mapM_ notifyNewLearner
in luserQry luserFltrNew (const $ const E.true) >>= mapM_ notifyNewLearner
-- C) block qualifications for failed learners by calling qualificationUserBlocking [uids] (includes audit), notified during expiry
let lrFltrBlock luser lreport = E.isNothing (luser E.^. LmsUserStatus) E.&&. lreport E.^. LmsReportResult E.==. E.val LmsFailed
procBlock (Entity luid luser, Entity _ lreport) = do
@ -434,9 +431,9 @@ dispatchJobLmsReports qid = JobHandlerAtomic act
E.orderBy [E.desc $ lrl E.^. LmsReportLogTimestamp]
return $ lreport E.^. LmsReportResult E.==. lrl E.^. LmsReportLogResult
E.&&. lreport E.^. LmsReportLock E.==. lrl E.^. LmsReportLogLock
E.&&. E.not__ (lrl E.^. LmsReportLogMissing)
E.&&. E.not_ (lrl E.^. LmsReportLogMissing)
E.where_ $ lreport E.^. LmsReportQualification E.==. E.val qid
E.&&. E.not__ (E.isTrue samelog)
E.&&. E.not_ (E.isTrue samelog)
return (LmsReportLog
E.<# (lreport E.^. LmsReportQualification)
E.<&> (lreport E.^. LmsReportIdent )

6
src/Jobs/Handler/SynchroniseAvs.hs
View File

@ -8,6 +8,7 @@ module Jobs.Handler.SynchroniseAvs
-- , dispatchJobSynchroniseAvsUser
, dispatchJobSynchroniseAvsQueue
, dispatchJobSynchroniseAvsLicences
, dispatchJobSynchroniseByAvsDataContact
) where
import Import
@ -185,3 +186,8 @@ dispatchJobSynchroniseAvsLicences = JobHandlerException $ do -- when (synchLevel
when (synchLevel >= 3) $ procLic AvsLicenceVorfeld False $ fltrIds avsLicenceDiffRevokeRollfeld --downgrade Rollfeld -> Vorfeld
when (synchLevel >= 4) $ procLic AvsLicenceRollfeld True $ fltrIds avsLicenceDiffGrantRollfeld --grant Rollfeld
-- | delayed exection of already received contact info
dispatchJobSynchroniseByAvsDataContact :: AvsDataContact -> JobHandler UniWorX
dispatchJobSynchroniseByAvsDataContact adc =
JobHandlerException . runDB . void $ updateAvsUserByADC adc

3
src/Jobs/Types.hs
View File

@ -102,6 +102,9 @@ data Job
, jIteration :: Natural
, jSynchAfter :: Maybe Day
}
| JobSynchroniseByAvsDataContact
{ jAvsDataContact :: AvsDataContact
}
-- JobSynchroniseAvsUser { jUser :: UserId
-- , jSynchAfter :: Maybe Day
-- }

14
src/Model/Types/Avs.hs
View File

@ -104,8 +104,8 @@ composeAddress street zipcode city country = toMaybe (notNull compAddr) compAddr
-------------------
newtype AvsInternalPersonalNo = AvsInternalPersonalNo { avsInternalPersonalNo :: Text } -- ought to be all digits
deriving (Eq, Ord, Show, Generic)
deriving newtype (NFData, PathPiece, PersistField, PersistFieldSql, Csv.ToField, Csv.FromField, Binary)
deriving (Eq, Ord, Show, Read, Generic)
deriving newtype (NFData, PathPiece, PersistField, PersistFieldSql, Csv.ToField, Csv.FromField, Binary, Hashable)
instance E.SqlString AvsInternalPersonalNo
-- AvsInternalPersonalNo is an untagged Text with respect to FromJSON/ToJSON, as needed by AVS API
@ -346,7 +346,7 @@ instance FromJSON AvsDataCardColor where
parseJSON invalid = prependFailure "parsing AvsDataCardColor failed, " (typeMismatch "String" invalid)
data AvsDataPersonCard = AvsDataPersonCard
data AvsDataPersonCard = AvsDataPersonCard -- returned by AvsQueryPerson and partially by AvsQueryStatus
{ avsDataValid :: Bool -- card currently valid? Note that AVS encodes booleans as JSON String "true" and "false" and not as JSON booleans
, avsDataValidTo :: Maybe Day -- Nothing if returned with AvsResponseStatus
, avsDataIssueDate :: Maybe Day -- Nothing if returned with AvsResponseStatus
@ -548,7 +548,7 @@ data AvsPersonInfo = AvsPersonInfo
, avsInfoPersonEMail :: Maybe Text
, avsInfoPersonMobilePhoneNo :: Maybe Text
, avsInfoInternalPersonalNo :: Maybe AvsInternalPersonalNo -- Fraport Personalnummer
} deriving (Eq, Ord, Show, Generic, NFData, Binary)
} deriving (Eq, Ord, Show, Read, Generic, NFData, Binary, Hashable)
makeLenses_ ''AvsPersonInfo
@ -594,7 +594,7 @@ data AvsFirmCommunication = AvsFirmCommunication
, avsCommunicationCountry :: Maybe Text
, avsCommunicationStreetANDHouseNo :: Maybe Text
, avsCommunicationEMail :: Maybe Text
} deriving (Eq, Ord, Show, Generic, NFData, Binary)
} deriving (Eq, Ord, Show, Read, Generic, NFData, Binary, Hashable)
instance {-# OVERLAPS #-} Canonical (Maybe AvsFirmCommunication) where
canonical (Just AvsFirmCommunication{..})
@ -641,7 +641,7 @@ data AvsFirmInfo = AvsFirmInfo
, avsFirmEMail :: Maybe Text
, avsFirmEMailSuperior :: Maybe Text
, avsFirmCommunication :: Maybe AvsFirmCommunication
} deriving (Eq, Ord, Show, Generic, NFData, Binary)
} deriving (Eq, Ord, Show, Read, Generic, NFData, Binary, Hashable)
makeLenses_ ''AvsFirmInfo
-- additional convenience lenses:
@ -725,7 +725,7 @@ data AvsDataContact = AvsDataContact
{ avsContactPersonID :: AvsPersonId
, avsContactPersonInfo :: AvsPersonInfo
, avsContactFirmInfo :: AvsFirmInfo
} deriving (Eq, Ord, Show, Generic, NFData, Binary)
} deriving (Eq, Ord, Show, Read, Generic, NFData, Binary, Hashable)
makeLenses_ ''AvsDataContact

9
src/Model/Types/User.hs
View File

@ -36,7 +36,7 @@ data UserDrivingPermit = UserDrivingPermitB
instance Show UserDrivingPermit where
show UserDrivingPermitB = "B"
show UserDrivingPermitB01 = "B01"
show UserDrivingPermitB01 = "B01" -- Brille notwendig
instance RenderMessage a UserDrivingPermit where
renderMessage _foundation _languages = tshow
@ -53,7 +53,7 @@ data UserEyeExam = UserEyeExamSX
instance Show UserEyeExam where
show UserEyeExamSX = "SX"
show UserEyeExamS01 = "S01"
show UserEyeExamS01 = "S01" -- Brille notwendig
instance RenderMessage a UserEyeExam where
renderMessage _foundation _languages = tshow
@ -63,3 +63,8 @@ deriveJSON defaultOptions
} ''UserEyeExam
derivePersistFieldJSON ''UserEyeExam
nullaryPathPiece ''UserEyeExam $ camelToPathPiece' 3
eyeExamFitsDrivingPermit :: UserEyeExam -> UserDrivingPermit -> Bool
eyeExamFitsDrivingPermit UserEyeExamSX _ = True
eyeExamFitsDrivingPermit UserEyeExamS01 UserDrivingPermitB01 = True
eyeExamFitsDrivingPermit _ _ = False

4
src/Utils.hs
View File

@ -879,7 +879,6 @@ listBracket b@(s,e) (h:t)
infixl 5 !!!
(!!!) :: (Ord k, Monoid v) => Map k v -> k -> v
(!!!) m k = fromMaybe mempty $ Map.lookup k m
@ -888,6 +887,9 @@ lookupSome :: (Monad m, Ord k, Monoid (m v)) => Map k (m v) -> m k -> m v
-- lookupSome m ks = ks >>= (m !!!)
lookupSome = (=<<) . (!!!)
lookupMaybe :: Ord k => Map k a -> Maybe k -> Maybe a
lookupMaybe = (=<<) . flip Map.lookup
groupMap :: (Ord k, Ord v) => [(k,v)] -> Map k (Set v)
groupMap l = Map.fromListWith mappend [(k, Set.singleton v) | (k,v) <- l]

5
templates/i18n/day-view/de-de-formal.hamlet
View File

@ -6,7 +6,10 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
$maybe tbl <- tableDaily
<section>
^{tbl}
<p>
^{tbl}
<p>
^{consistencyBtn}
<section .profile>
<h3>Hinweise zu den Formularspalten
<dl .deflist.profile-dl>

7
templates/i18n/day-view/en-eu.hamlet
View File

@ -4,9 +4,12 @@ $# SPDX-FileCopyrightText: 2024 Steffen Jost <s.jost@fraport.de>
$#
$# SPDX-License-Identifier: AGPL-3.0-or-later
$maybe tbl <- tableDaily
$maybe tbl <- tableDaily
<section>
^{tbl}
<p>
^{tbl}
<p>
^{consistencyBtn}
<section .profile>
<h3>Note how form data is saved
<dl .deflist.profile-dl>

90
templates/i18n/user-receivers/de-de-formal.hamlet
View File

@ -1,46 +1,46 @@
$newline never
$# SPDX-FileCopyrightText: 2025 Steffen Jost <jost@tcs.ifi.lmu.de>
$#
$# SPDX-License-Identifier: AGPL-3.0-or-later
<section>
<p>
Benachrichtigungen für ^{usrWgt} ^{widgetMailPrefPin usr} #
$if usrReceives
gehen #
$maybe _ <- mrtbl
ebenfalls an die unten aufgeführten Personen:
$nothing
nur an diese Person selbst.
$else
$maybe _ <- mrtbl
gehen tatsächlich nur an die unten aufgeführten Personen:
$nothing
werden momentan an niemanden zugestellt!
$maybe (tbl, mbUsrCmps) <- mrtbl
<p>
^{tbl}
<p>
$maybe usrCmps <- mbUsrCmps
<h4>
_{MsgCompany} ^{usrWgt}:
<ul .list--inline .list--comma-separated>
^{usrCmps}
$nothing
Für ^{usrWgt} ist momentan keine Firmenzugehörigkeit bekannt.
<p>
<h4>
Hinweis:
Mit welchem Passwort PDF Anhänge geschützt werden, hängt vom Nachrichtentyp ab. #
Zum Beispiel werden Pin Briefe für ablaufende Qualifikationen #
$if hasPwd
mit dem Passwort von ^{usrWgt} geschützt. #
$else
nicht geschützt, da kein Pin Passwort gesetzt ist. #
Für andere Benachrichtigungen wird meist das Passwort des tatsächlichen Empfängers gewählt, sofern eins gesetzt wurde.
$newline never
$# SPDX-FileCopyrightText: 2025 Steffen Jost <jost@tcs.ifi.lmu.de>
$#
$# SPDX-License-Identifier: AGPL-3.0-or-later
<section>
<p>
Benachrichtigungen für ^{usrWgt} ^{widgetMailPrefPin usr} #
$if usrReceives
gehen #
$maybe _ <- mrtbl
ebenfalls an die unten aufgeführten Personen:
$nothing
nur an diese Person selbst.
$else
$maybe _ <- mrtbl
gehen tatsächlich nur an die unten aufgeführten Personen:
$nothing
werden momentan an niemanden zugestellt!
$maybe (tbl, mbUsrCmps) <- mrtbl
<p>
^{tbl}
<p>
$maybe usrCmps <- mbUsrCmps
<h4>
_{MsgCompany} ^{usrWgt}:
<ul .list--inline .list--comma-separated>
^{usrCmps}
$nothing
Für ^{usrWgt} ist momentan keine Firmenzugehörigkeit bekannt.
<p>
<h4>
Hinweis:
Mit welchem Passwort PDF Anhänge geschützt werden, hängt vom Nachrichtentyp ab. #
Zum Beispiel werden Pin Briefe für ablaufende Qualifikationen #
$if hasPwd
mit dem Passwort von ^{usrWgt} geschützt. #
$else
nicht geschützt, da kein Pin Passwort gesetzt ist. #
Für andere Benachrichtigungen wird meist das Passwort des tatsächlichen Empfängers gewählt, sofern eins gesetzt wurde.
Die Voreinstellung für das PDF Passwort ist die Hauptausweisnummer, inklusive Punkt.