chore(daily): implement left-over todos and i18n

messages/uniworx/categories/avs/de-de-formal.msg

@@ -1,4 +1,4 @@
-# SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
+# SPDX-FileCopyrightText: 2022-24 Steffen Jost <s.jost@fraport.de>
 #
 # SPDX-License-Identifier: AGPL-3.0-or-later
 AvsPersonInfo: AVS Personendaten
@@ -54,10 +54,13 @@ AvsUserUnassociated user@UserDisplayName: AVS Id unbekannt für Nutzer #{user}
 AvsUserUnknownByAvs api@AvsPersonId: AVS kennt Id #{tshow api} nicht (mehr)
 AvsUserAmbiguous api@AvsPersonId: AVS Id #{tshow api} ist nicht eindeutig
 AvsStatusSearchEmpty: AVS lieferte keine Ausweisinformationen
-AvsPersonSearchEmpty: AVS Suche lieferte leeres Ergebnis
+AvsPersonSearchEmpty: Suche im AVS lieferte kein Ergebnis
-AvsPersonSearchAmbiguous: AVS Suche lieferte mehrere uneindeutige Ergebnisse
+AvsPersonSearchAmbiguous: Suche im AVS lieferte mehrere uneindeutige Ergebnisse
 AvsSetLicencesFailed reason@Text: Setzen der Fahrlizenz im AVS fehlgeschlagen. Grund: #{reason}
 AvsIdMismatch api1@AvsPersonId api2@AvsPersonId: AVS Suche für Id #{tshow api1} lieferte stattdessen Id #{tshow api2}
 AvsUserCreationFailed api@AvsPersonId: Für AVS Id #{tshow api} konnte kein neuer Benutzer angelegt werden, da es eine gemeinsame Id (z.B. Personalnummer) mit einem existierenden, aber verschiedenen Nutzer gibt.
-AvsCardsEmpty: AVS Suche lieferte keinerlei Ausweiskarten
+AvsCardsEmpty: Suche im AVS lieferte keinerlei Ausweiskarten
-AvsCurrentData: Alle angezeigte Daten wurden kürzlich direkt über die AVS Schnittstelle abgerufen.
+AvsCurrentData: Alle angezeigte Daten wurden kürzlich direkt über die AVS Schnittstelle abgerufen.
+
+AvsNoApronCard: Kein gültiger Ausweis mit Vorfeld-Zugang vorhanden
+AvsNoCompanyCard mcn@(Maybe CompanyName): Für buchende Firma #{maybeEmpty mcn ciOriginal} liegt kein gültiger Ausweis vor

messages/uniworx/categories/avs/en-eu.msg

@@ -1,4 +1,4 @@
-# SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>
+# SPDX-FileCopyrightText: 2022-24 Steffen Jost <s.jost@fraport.de>
 #
 # SPDX-License-Identifier: AGPL-3.0-or-later
 AvsPersonInfo: AVS person info
@@ -61,4 +61,7 @@ AvsSetLicencesFailed reason: Set driving licence within AVS failed. Reason: #{re
 AvsIdMismatch api1 api2: AVS search for id #{tshow api1} returned id #{tshow api2} instead
 AvsUserCreationFailed api@AvsPersonId: No new user could be created for AVS Id #{tshow api}, since an existing user shares at least one id presumed as unique
 AvsCardsEmpty: AVS search returned no id cards
-AvsCurrentData: All shown data has been recently received via the AVS interface.
+AvsCurrentData: All shown data has been recently received via the AVS interface.
+
+AvsNoApronCard: No valid card granting apron access found
+AvsNoCompanyCard mcn@(Maybe CompanyName): No valid card for booking company #{maybeEmpty mcn ciOriginal} found

messages/uniworx/categories/courses/tutorial/de-de-formal.msg

@@ -56,4 +56,7 @@ TutorialEyeExam: Sehtest
 TutorialNote: Kursnotiz
 TutorialDayAttendance day@Text: Anwesenheit #{day}
 TutorialDayNote day@Text: Anwesenheitsnotiz #{day}
-TutorialParticipantsDayEdits day@Text: Kursteilnehmer-Tagesnotizen aktualisiert für #{day}
+TutorialParticipantsDayEdits day@Text: Kursteilnehmer-Tagesnotizen aktualisiert für #{day}
+
+CheckEyePermitMissing: Sehtest oder Führerschein fehlen noch
+CheckEyePermitIncompatible: Sehtest und Führerschein passen nicht zusammen

messages/uniworx/categories/courses/tutorial/en-eu.msg

@@ -57,4 +57,7 @@ TutorialEyeExam: Eye exam
 TutorialNote: Course note
 TutorialDayAttendance day: Attendance #{day}
 TutorialDayNote day: Attendance note #{day}
-TutorialParticipantsDayEdits day: course participant day notes updated for #{day}
+TutorialParticipantsDayEdits day: course participant day notes updated for #{day}
+
+CheckEyePermitMissing: Eye exam or driving permit missing
+CheckEyePermitIncompatible: Eye exam and driving permit are incompatible

messages/uniworx/misc/de-de-formal.msg

@@ -31,4 +31,5 @@ PaginationPage: Angzeigte Seite
 PaginationError: Paginierung Parameter dürfen nicht negativ sein
 
 NullDeletes: Zum Löschen NULL eingeben.
-SortPriority: Sortierungspriorität
+SortPriority: Sortierungspriorität
+NoProblem: Keine Probleme gefunden

messages/uniworx/misc/en-eu.msg

@@ -31,4 +31,5 @@ PaginationPage: Page to show
 PaginationError: Pagination parameter must not be negative
 
 NullDeletes:  Enter NULL to delete.
-SortPriority: Sort order priority
+SortPriority: Sort order priority
+NoProblem: No Probleme found

messages/uniworx/utils/buttons/de-de-formal.msg

@@ -1,4 +1,4 @@
-# SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>
+# SPDX-FileCopyrightText: 2022-24 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
 #
 # SPDX-License-Identifier: AGPL-3.0-or-later
 
@@ -57,4 +57,5 @@ BtnFinishExam: Prüfungsergebnisse sichtbar schalten
 BtnConfirm: Bestätigen
 BtnCourseRegisterAdd: Personen suchen
 BtnCourseRegisterConfirm: Ausgewählte Personen anmelden
-BtnCourseRegisterAbort: Abbrechen
+BtnCourseRegisterAbort: Abbrechen
+BtnCloseReload: Schließen und aktualisieren

messages/uniworx/utils/buttons/en-eu.msg

@@ -1,4 +1,4 @@
-# SPDX-FileCopyrightText: 2022 Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>
+# SPDX-FileCopyrightText: 2022-24 Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Steffen Jost <s.jost@fraport.de>
 #
 # SPDX-License-Identifier: AGPL-3.0-or-later
 
@@ -57,4 +57,5 @@ BtnFinishExam: Make results visible
 BtnConfirm: Confirm
 BtnCourseRegisterAdd: Search persons
 BtnCourseRegisterConfirm: Register selected persons
-BtnCourseRegisterAbort: Abort
+BtnCourseRegisterAbort: Abort
+BtnCloseReload: Close and reload

src/Handler/School/DayTasks.hs

@@ -4,8 +4,7 @@
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} -- TODO during development only
+{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
-{-# OPTIONS_GHC -fno-warn-unused-imports #-} -- TODO during development only
 
 module Handler.School.DayTasks
   ( getSchoolDayR, postSchoolDayR
@@ -16,7 +15,8 @@ import Import
 
 import Handler.Utils
 import Handler.Utils.Company
-import Handler.Utils.Occurrences
+-- import Handler.Utils.Occurrences
+import Handler.Utils.Avs
 
 import qualified Data.Set as Set
 import qualified Data.Map as Map
@@ -29,8 +29,8 @@ import qualified Database.Esqueleto.Experimental as E
 import qualified Database.Esqueleto.PostgreSQL as E
 import qualified Database.Esqueleto.Legacy as EL (on, from) -- only `on` and `from` are different, needed for dbTable using Esqueleto.Legacy
 import qualified Database.Esqueleto.Utils as E
-import           Database.Esqueleto.PostgreSQL.JSON ((@>.))
+-- import           Database.Esqueleto.PostgreSQL.JSON ((@>.))
-import qualified Database.Esqueleto.PostgreSQL.JSON as E hiding ((?.))
+-- import qualified Database.Esqueleto.PostgreSQL.JSON as E hiding ((?.))
 import Database.Esqueleto.Utils.TH
 
 
@@ -528,7 +528,7 @@ mkDailyTable isAdmin ssh nd dcrs = getDayTutorials ssh (nd,nd) >>= \case
           --     in result
           , maybeEmpty dcrs $ \DayCheckResults{..} ->
             sortable (Just "check-fail") (timeCell dcrTimestamp) $ \(view $ resultParticipant . _entityKey -> tpid) ->
-              maybeCell (Map.lookup tpid dcrResults) $ wgtCell . dcr2widget' Nothing
+              maybeCell (Map.lookup tpid dcrResults) $ wgtCell . dcr2widgetIcn Nothing
           , colUserNameModalHdr MsgCourseParticipant ForProfileDataR
           , colUserMatriclenr isAdmin
           , sortable (Just "card-no") (i18nCell MsgAvsCardNo) $ \(preview $ resultUserAvs . _userAvsLastCardNo . _Just -> cn :: Maybe AvsFullCardNo) -> cellMaybe (textCell . tshowAvsFullCardNo) cn
@@ -682,6 +682,7 @@ postSchoolDayR ssh nd = do
     setTitleI (MsgMenuSchoolDay ssh dday)
     $(i18nWidgetFile "day-view")
 
+
 -- | A wrapper for several check results on tutorial participants
 data DayCheckResult = DayCheckResult
       { dcEyeFitsPermit :: Maybe Bool
@@ -689,7 +690,7 @@ data DayCheckResult = DayCheckResult
       , dcApronAccess   :: Bool
       , dcBookingFirmOk :: Bool
       }
-  deriving (Show, Generic, Binary)
+  deriving (Eq, Show, Generic, Binary)
 
 data DayCheckResults = DayCheckResults
       { dcrTimestamp :: UTCTime
@@ -697,13 +698,72 @@ data DayCheckResults = DayCheckResults
       }
   deriving (Show, Generic, Binary)
 
-type ParticipantCheckData = (Entity TutorialParticipant, UserDisplayName, UserSurname, Maybe AvsPersonId, Maybe CompanyName)
+-- | True iff there is no problem at all
+dcrIsOk :: DayCheckResult -> Bool
+dcrIsOk (DayCheckResult (Just True) True True True) = True
+dcrIsOk _ = False
 
+-- | defines categories on DayCheckResult, implying an ordering, with most severe being least
+dcrSeverity :: DayCheckResult -> Int
+dcrSeverity DayCheckResult{dcAvsKnown      = False     } =  1
+dcrSeverity DayCheckResult{dcApronAccess   = False     } =  2
+dcrSeverity DayCheckResult{dcBookingFirmOk = False     } =  3
+dcrSeverity DayCheckResult{dcEyeFitsPermit = Nothing   } =  4
+dcrSeverity DayCheckResult{dcEyeFitsPermit = Just False} =  5
+dcrSeverity _                                            = 99
+
+instance Ord DayCheckResult where
+  compare = compare `on` dcrSeverity
+
+type DayCheckGroups = ( Set TutorialParticipantId -- 1 severity
+                      , Set TutorialParticipantId -- 2
+                      , Set TutorialParticipantId -- 3
+                      , Set TutorialParticipantId -- 4
+                      , Set TutorialParticipantId -- 5
+                      )
+
+dcrSeverityGroups :: Map TutorialParticipantId DayCheckResult -> DayCheckGroups
+dcrSeverityGroups = Map.foldMapWithKey groupBySeverity
+  where
+    groupBySeverity :: TutorialParticipantId -> DayCheckResult -> DayCheckGroups
+    groupBySeverity tpid dcr =
+      let sempty = mempty :: DayCheckGroups
+      in case dcrSeverity dcr of
+        1 -> set _1 (Set.singleton tpid) sempty
+        2 -> set _2 (Set.singleton tpid) sempty
+        3 -> set _3 (Set.singleton tpid) sempty
+        4 -> set _4 (Set.singleton tpid) sempty
+        5 -> set _5 (Set.singleton tpid) sempty
+        _ ->                             sempty
+
+-- | Show most important problem as text
+dcr2widgetTxt :: Maybe CompanyName -> DayCheckResult -> Widget
+dcr2widgetTxt _    DayCheckResult{dcAvsKnown=False}          = i18n   MsgAvsPersonSearchEmpty
+dcr2widgetTxt _    DayCheckResult{dcApronAccess=False}       = i18n   MsgAvsNoApronCard
+dcr2widgetTxt mcn  DayCheckResult{dcBookingFirmOk=False}     = i18n $ MsgAvsNoCompanyCard mcn
+dcr2widgetTxt _    DayCheckResult{dcEyeFitsPermit=Nothing}   = i18n   MsgCheckEyePermitMissing
+dcr2widgetTxt _    DayCheckResult{dcEyeFitsPermit=Just False}= i18n   MsgCheckEyePermitIncompatible
+dcr2widgetTxt _    _                                         = i18n   MsgNoProblem
+
+-- | Show all problems as icon with tooltip
+dcr2widgetIcn :: Maybe CompanyName -> DayCheckResult -> Widget
+dcr2widgetIcn mcn DayCheckResult{..} = mconcat [avsChk, apronChk, bookChk, permitChk]
+  where
+    mkTooltip ico msg = iconTooltip msg (Just ico) True
+
+    avsChk    = guardMonoid (not dcAvsKnown)      $ mkTooltip IconUserUnknown     (i18n   MsgAvsPersonSearchEmpty)
+    apronChk  = guardMonoid (not dcApronAccess)   $ mkTooltip IconUserBadge       (i18n   MsgAvsNoApronCard)
+    bookChk   = guardMonoid (not dcBookingFirmOk) $ mkTooltip IconCompanyWarning  (i18n $ MsgAvsNoCompanyCard mcn)
+    permitChk | isNothing dcEyeFitsPermit         = mkTooltip IconFileMissing     (i18n   MsgCheckEyePermitMissing)
+              | dcEyeFitsPermit == Just False     = mkTooltip IconGlasses         (i18n   MsgCheckEyePermitIncompatible)
+              | otherwise = mempty
+
+type ParticipantCheckData = (Entity TutorialParticipant, UserDisplayName, UserSurname, Maybe AvsPersonId, Maybe CompanyName)
 
 dayCheckParticipant :: Map AvsPersonId AvsDataPerson
                     -> ParticipantCheckData
                     -> DayCheckResult
-dayCheckParticipant avsStats (Entity {entityVal=TutorialParticipant{..}}, udn, usn, mapi, mcmp) =
+dayCheckParticipant avsStats (Entity {entityVal=TutorialParticipant{..}}, _udn, _usn, mapi, mcmp) =
     let dcEyeFitsPermit = liftM2 eyeExamFitsDrivingPermit tutorialParticipantEyeExam tutorialParticipantDrivingPermit
         (dcAvsKnown, (dcApronAccess, dcBookingFirmOk))
           | Just AvsDataPerson{avsPersonPersonCards = apcs} <- lookupMaybe avsStats mapi
@@ -721,57 +781,6 @@ dayCheckParticipant avsStats (Entity {entityVal=TutorialParticipant{..}}, udn, u
     fitsBooking (Just cn) AvsDataPersonCard{avsDataValid=True,avsDataFirm=Just df}  = Any $ cn == stripCI df
     fitsBooking _ _ = Any False
 
-dcrIsOk :: DayCheckResult -> Bool
-dcrIsOk (DayCheckResult (Just True) True True True) = True
-dcrIsOk _ = False
-
--- TODO: i18n and use icons to show all results at once
--- TODO: using memcache, display icons in column in daily view, if cache is filled
-dcr2widget :: Maybe CompanyName -> DayCheckResult -> Widget
-dcr2widget _    DayCheckResult{dcAvsKnown=False}          = text2widget "AVS Abfrage fehlgeschlagen"
-dcr2widget _    DayCheckResult{dcApronAccess=False}       = text2widget "Kein gültiger Ausweis mit Vorfeld-Zugang gefunden"
-dcr2widget mcn  DayCheckResult{dcBookingFirmOk=False}     = [whamlet|Für buchende Firma #{maybeMonoid mcn} liegt kein gültiger Ausweis vor|]
-dcr2widget _    DayCheckResult{dcEyeFitsPermit=Nothing}   = text2widget "Sehtest oder Führerschein fehlen noch"
-dcr2widget _    DayCheckResult{dcEyeFitsPermit=Just False}= text2widget "Sehtest und Führerschein passen nicht zusammen"
-dcr2widget _    _                                         = text2widget "Kein Problem vorhanden"
-
-
-dcrSeverity :: DayCheckResult -> Int
-dcrSeverity DayCheckResult{dcAvsKnown=False}            =  1
-dcrSeverity DayCheckResult{dcApronAccess=False}         =  2
-dcrSeverity DayCheckResult{dcBookingFirmOk=False}       =  3
-dcrSeverity DayCheckResult{dcEyeFitsPermit=Nothing}     =  4
-dcrSeverity DayCheckResult{dcEyeFitsPermit=Just False}  =  5
-dcrSeverity _                                           = 99
-
-dcrSeverityGroups :: Map TutorialParticipantId DayCheckResult -> (Set TutorialParticipantId,Set TutorialParticipantId,Set TutorialParticipantId,Set TutorialParticipantId,Set TutorialParticipantId)
-dcrSeverityGroups dcrs = Map.foldMapWithKey groupBySeverity mempty
-  where
-    groupBySeverity :: TutorialParticipantId -> DayCheckResult -> (Set TutorialParticipantId,Set TutorialParticipantId,Set TutorialParticipantId,Set TutorialParticipantId,Set TutorialParticipantId)
-    groupBySeverity tpid dcr =
-      let sempty = mempty :: (Set TutorialParticipantId,Set TutorialParticipantId,Set TutorialParticipantId,Set TutorialParticipantId,Set TutorialParticipantId)
-      in case dcrSeverity dcr of
-        1 -> set _1 (Set.singleton tpid) sempty
-        2 -> set _2 (Set.singleton tpid) sempty
-        3 -> set _3 (Set.singleton tpid) sempty
-        4 -> set _4 (Set.singleton tpid) sempty
-        5 -> set _5 (Set.singleton tpid) sempty
-        _ ->                             sempty
-
--- Alternative version using icons to display everything at once
-dcr2widget' :: Maybe CompanyName -> DayCheckResult -> Widget
-dcr2widget' mcn DayCheckResult{..} = mconcat [avsChk, apronChk, bookChk, permitChk]
-  where
-    mkTooltip ico msg = iconTooltip msg (Just ico) True
-
-    avsChk    = guardMonoid (not dcAvsKnown)      $ mkTooltip IconUserUnknown     (text2widget "AVS Abfrage fehlgeschlagen")
-    apronChk  = guardMonoid (not dcApronAccess)   $ mkTooltip IconUserBadge       (text2widget "Kein gültiger Ausweis mit Vorfeld-Zugang gefunden")
-    bookChk   = guardMonoid (not dcBookingFirmOk) $ mkTooltip IconCompanyWarning  [whamlet|Für buchende Firma #{maybeMonoid mcn} liegt kein gültiger Ausweis vor|]
-    permitChk | isNothing dcEyeFitsPermit         = mkTooltip IconFileMissing     (text2widget "Sehtest oder Führerschein fehlen noch")
-              | dcEyeFitsPermit == Just False     = mkTooltip IconGlasses         (text2widget "Sehtest und Führerschein passen nicht zusammen")
-              | otherwise = mempty
-
-
 -- | Prüft die Teilnehmer der Tagesansicht: AVS online aktualisieren, gültigen Vorfeldausweis prüfen, buchende Firma mit Ausweisnummer aus AVS abgleichen
 getSchoolDayCheckR :: SchoolId -> Day -> Handler Html
 getSchoolDayCheckR ssh nd = do
@@ -813,25 +822,25 @@ getSchoolDayCheckR ssh nd = do
             udn = pcd ^. _2
             ok  = maybe False dcrIsOk $ Map.lookup pid participantResults
         in if ok then acc else Map.insertWith (<>) tid (Map.singleton (udn,pid) pcd) acc
-      badTutPartMap :: Map TutorialId (Map (UserDisplayName, TutorialParticipantId) ParticipantCheckData)
+      badTutPartMap :: Map TutorialId (Map (UserDisplayName, TutorialParticipantId) ParticipantCheckData) -- UserDisplayName as Key ensures proper sort order
       badTutPartMap = foldl' sortBadParticipant mempty parts_avs
 
       mkBaddieWgt :: TutorialParticipantId -> ParticipantCheckData -> Widget
       mkBaddieWgt pid pcd =
         let name = nameWidget (pcd ^. _2) (pcd ^. _3)
             bookFirm = pcd ^. _5
-            problems  = maybe (text2widget "???") (dcr2widget bookFirm) (Map.lookup pid participantResults)
+            problemText  = maybe (text2widget "???") (dcr2widgetTxt bookFirm) (Map.lookup pid participantResults)
-            problems' = maybe mempty              (dcr2widget' bookFirm) (Map.lookup pid participantResults) -- TODO: decide which version to use
+            problemIcons = maybe mempty              (dcr2widgetIcn bookFirm) (Map.lookup pid participantResults)
-        in [whamlet|^{name}: ^{problems'} ^{problems}|]
+        in [whamlet|^{name}: ^{problemIcons} ^{problemText}|]
 
   siteLayoutMsg MsgMenuSchoolDayCheck $ do
-    setTitleI MsgMenuSchoolDayCheck -- TODO: i18n
+    setTitleI MsgMenuSchoolDayCheck
     [whamlet|
       <h2>
         _{MsgMenuSchoolDay ssh dday}
       <p>
         $if Map.null badTutPartMap
-          Es wurden keine Probleme gefunden.
+          _{MsgNoProblem}.
         $else
           <dl .deflist.profile-dl>
             $forall (tid,badis)  <- Map.toList badTutPartMap
@@ -839,9 +848,9 @@ getSchoolDayCheckR ssh nd = do
                 #{maybe "???" fst (Map.lookup tid tuts)}
               <dd .deflist__dd>
                 <ul>
-                  $forall ((udn,pid),pcd) <- Map.toList badis
+                  $forall ((_udn,pid),pcd) <- Map.toList badis
                     <li>
                       ^{mkBaddieWgt pid pcd}
       <p>
-        ^{linkButton mempty (text2widget "Schliessen") [BCIsButton, BCPrimary] (SomeRoute (SchoolR ssh (SchoolDayR nd)))}
+        ^{linkButton mempty (i18n MsgBtnCloseReload) [BCIsButton, BCPrimary] (SomeRoute (SchoolR ssh (SchoolDayR nd)))}
     |]

src/Utils.hs

@@ -420,6 +420,7 @@ int2widget i = [whamlet|#{tshow i}|]
 word2widget :: Word64 -> WidgetFor site ()
 word2widget i = [whamlet|#{tshow i}|]
 
+-- | for convenience, alternative use Utils.Widgets.i18n directly
 msg2widget :: RenderMessage site a => a -> WidgetFor site ()
 msg2widget msg = [whamlet|_{msg}|]