diff --git a/messages/uniworx/utils/navigation/menu/de-de-formal.msg b/messages/uniworx/utils/navigation/menu/de-de-formal.msg index f32d016e8..f8914c000 100644 --- a/messages/uniworx/utils/navigation/menu/de-de-formal.msg +++ b/messages/uniworx/utils/navigation/menu/de-de-formal.msg @@ -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 diff --git a/messages/uniworx/utils/navigation/menu/en-eu.msg b/messages/uniworx/utils/navigation/menu/en-eu.msg index c2d78331e..f3aad5cdf 100644 --- a/messages/uniworx/utils/navigation/menu/en-eu.msg +++ b/messages/uniworx/utils/navigation/menu/en-eu.msg @@ -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 diff --git a/routes b/routes index e98c74113..efde6ff6a 100644 --- a/routes +++ b/routes @@ -1,4 +1,4 @@ --- SPDX-FileCopyrightText: 2022-2025 Sarah Vaupel , Gregor Kleen , Sarah Vaupel , Steffen Jost , Wolfgang Witt ,Steffen Jost +-- SPDX-FileCopyrightText: 2022-2025 Sarah Vaupel , Gregor Kleen , Sarah Vaupel , Steffen Jost , Wolfgang Witt , Steffen Jost -- -- 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 diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index a96d74073..87fba1772 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -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 = [] diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index d271019d1..b8e72abd7 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -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 diff --git a/src/Handler/PrintCenter.hs b/src/Handler/PrintCenter.hs index 485031ec9..eb35c85ec 100644 --- a/src/Handler/PrintCenter.hs +++ b/src/Handler/PrintCenter.hs @@ -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 diff --git a/src/Handler/Qualification/Edit.hs b/src/Handler/Qualification/Edit.hs index 36a3403db..3ad537260 100644 --- a/src/Handler/Qualification/Edit.hs +++ b/src/Handler/Qualification/Edit.hs @@ -112,4 +112,4 @@ handleQualificationEdit ssh templ = do $maybe _ <- templ

_{MsgQualificationEditNote} - |] + |] \ No newline at end of file diff --git a/src/Handler/School/DayTasks.hs b/src/Handler/School/DayTasks.hs index e21e24bb5..7655eb6f4 100644 --- a/src/Handler/School/DayTasks.hs +++ b/src/Handler/School/DayTasks.hs @@ -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") diff --git a/src/Handler/Utils/Avs.hs b/src/Handler/Utils/Avs.hs index 8ab9ae13d..bf7c35b34 100644 --- a/src/Handler/Utils/Avs.hs +++ b/src/Handler/Utils/Avs.hs @@ -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) diff --git a/src/Handler/Utils/LMS.hs b/src/Handler/Utils/LMS.hs index 895708d83..268d2d73d 100644 --- a/src/Handler/Utils/LMS.hs +++ b/src/Handler/Utils/LMS.hs @@ -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 diff --git a/src/Handler/Utils/Memcached.hs b/src/Handler/Utils/Memcached.hs index d6f455c16..2600fd191 100644 --- a/src/Handler/Utils/Memcached.hs +++ b/src/Handler/Utils/Memcached.hs @@ -1,4 +1,4 @@ --- SPDX-FileCopyrightText: 2022-2024 Sarah Vaupel , Gregor Kleen ,Steffen Jost +-- SPDX-FileCopyrightText: 2022-2024 Sarah Vaupel , Gregor Kleen , Steffen Jost -- -- SPDX-License-Identifier: AGPL-3.0-or-later diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs index f8ecbbb53..3e6ff7337 100644 --- a/src/Handler/Utils/Table/Cells.hs +++ b/src/Handler/Utils/Table/Cells.hs @@ -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 diff --git a/src/Jobs/Handler/LMS.hs b/src/Jobs/Handler/LMS.hs index 76b9c63a3..ac69bf126 100644 --- a/src/Jobs/Handler/LMS.hs +++ b/src/Jobs/Handler/LMS.hs @@ -1,4 +1,4 @@ --- SPDX-FileCopyrightText: 2022-2025 Steffen Jost +-- SPDX-FileCopyrightText: 2022-25 Steffen Jost -- -- 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 ) diff --git a/src/Jobs/Handler/SynchroniseAvs.hs b/src/Jobs/Handler/SynchroniseAvs.hs index 67f9a9399..a65ac5f37 100644 --- a/src/Jobs/Handler/SynchroniseAvs.hs +++ b/src/Jobs/Handler/SynchroniseAvs.hs @@ -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 \ No newline at end of file diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs index e1eaa1de3..ee48fc99a 100644 --- a/src/Jobs/Types.hs +++ b/src/Jobs/Types.hs @@ -102,6 +102,9 @@ data Job , jIteration :: Natural , jSynchAfter :: Maybe Day } + | JobSynchroniseByAvsDataContact + { jAvsDataContact :: AvsDataContact + } -- JobSynchroniseAvsUser { jUser :: UserId -- , jSynchAfter :: Maybe Day -- } diff --git a/src/Model/Types/Avs.hs b/src/Model/Types/Avs.hs index 264d7eca8..9911d748c 100644 --- a/src/Model/Types/Avs.hs +++ b/src/Model/Types/Avs.hs @@ -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 diff --git a/src/Model/Types/User.hs b/src/Model/Types/User.hs index 0abcd42af..4c106917c 100644 --- a/src/Model/Types/User.hs +++ b/src/Model/Types/User.hs @@ -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 \ No newline at end of file diff --git a/src/Utils.hs b/src/Utils.hs index 74b5a8d42..285740f6a 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -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] diff --git a/templates/i18n/day-view/de-de-formal.hamlet b/templates/i18n/day-view/de-de-formal.hamlet index ce8f630c5..014b9247d 100644 --- a/templates/i18n/day-view/de-de-formal.hamlet +++ b/templates/i18n/day-view/de-de-formal.hamlet @@ -6,7 +6,10 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later $maybe tbl <- tableDaily

- ^{tbl} +

+ ^{tbl} +

+ ^{consistencyBtn}

Hinweise zu den Formularspalten
diff --git a/templates/i18n/day-view/en-eu.hamlet b/templates/i18n/day-view/en-eu.hamlet index 603b66abc..455d6ba90 100644 --- a/templates/i18n/day-view/en-eu.hamlet +++ b/templates/i18n/day-view/en-eu.hamlet @@ -4,9 +4,12 @@ $# SPDX-FileCopyrightText: 2024 Steffen Jost $# $# SPDX-License-Identifier: AGPL-3.0-or-later -$maybe tbl <- tableDaily +$maybe tbl <- tableDaily
- ^{tbl} +

+ ^{tbl} +

+ ^{consistencyBtn}

Note how form data is saved
diff --git a/templates/i18n/user-receivers/de-de-formal.hamlet b/templates/i18n/user-receivers/de-de-formal.hamlet index 43924669f..1323d55ad 100644 --- a/templates/i18n/user-receivers/de-de-formal.hamlet +++ b/templates/i18n/user-receivers/de-de-formal.hamlet @@ -1,46 +1,46 @@ -$newline never - -$# SPDX-FileCopyrightText: 2025 Steffen Jost -$# -$# SPDX-License-Identifier: AGPL-3.0-or-later - - -
-

- 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 -

- ^{tbl} -

- $maybe usrCmps <- mbUsrCmps -

- _{MsgCompany} ^{usrWgt}: -
    - ^{usrCmps} - $nothing - Für ^{usrWgt} ist momentan keine Firmenzugehörigkeit bekannt. -

    -

    - 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 +$# +$# SPDX-License-Identifier: AGPL-3.0-or-later + + +
    +

    + 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 +

    + ^{tbl} +

    + $maybe usrCmps <- mbUsrCmps +

    + _{MsgCompany} ^{usrWgt}: +
      + ^{usrCmps} + $nothing + Für ^{usrWgt} ist momentan keine Firmenzugehörigkeit bekannt. +

      +

      + 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. \ No newline at end of file