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

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

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

routes

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

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 = []

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

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

src/Handler/Qualification/Edit.hs

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

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

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)
 

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
 

src/Handler/Utils/Memcached.hs

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

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

src/Jobs/Handler/LMS.hs

@@ -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 (
+        let luserFltrNew luser =  E.isNothing (luser E.^. LmsUserReceived)  -- not seen before, just starting
-                          E.||.   E.isNothing (luser E.^. LmsUserNotified)        -- a previous notification has failed AND
+                            E.||. E.isNothing (luser E.^. LmsUserNotified)  -- a previous notification has failed
-                            -- 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
             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        )

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

src/Jobs/Types.hs

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

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 (Eq, Ord, Show, Read, Generic)
-  deriving newtype (NFData, PathPiece, PersistField, PersistFieldSql, Csv.ToField, Csv.FromField, Binary)
+  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
 

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

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]
 

templates/i18n/day-view/de-de-formal.hamlet

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

templates/i18n/day-view/en-eu.hamlet

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

templates/i18n/user-receivers/de-de-formal.hamlet

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