refactor(daily): user company discrepancies

assets/icons-src/fontawesome.json

@@ -76,7 +76,7 @@
 "submission-no-users": "user-slash",
 "reset": "arrow-rotate-left",
 "blocked": "ban",
-"certificate": "person-circle-check",
+"certificate": "car-side",
 "print-center": "envelopes-bulk",
 "letter": "envelopes-bulk",
 "at": "at",
@@ -90,6 +90,7 @@
 "trash": "trash",
 "reset-tries": "trash-can-arrow-up",
 "company": "building",
+"company-warning": "building-circle-exclamation",
 "edit": "pen-to-square",
 "user-edit": "user-pen",
 "loading": "spinner",

src/Handler/School/DayTasks.hs

@@ -256,7 +256,7 @@ colParticipantPermitField :: Colonnade Sortable DailyTableData (DBCell _ (FormRe
 colParticipantPermitField = colParticipantPermitField' _dailyFormDrivingPermit
 
 colParticipantPermitField' :: ASetter' a (Maybe UserDrivingPermit) -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId a DailyTableData)))
-colParticipantPermitField' l = sortable (Just "permit") (i18nCell MsgTutorialDrivingPermit) $ formCell id -- lens focussing on the form result within the larger DBResult; id iff the form delivers the only result of the table
+colParticipantPermitField' l = sortable (Just "permit") (i18nCell MsgTutorialDrivingPermit) $ (cellAttrs <>~ [("style","width:1%")]) <$> formCell id -- lens focussing on the form result within the larger DBResult; id iff the form delivers the only result of the table
   (views (resultParticipant . _entityKey) return) -- generate row identfifiers for use in form result
   (\(view (resultParticipant . _entityVal . _tutorialParticipantDrivingPermit) -> x) mkUnique ->
     over (_1.mapped) (l .~) . over _2 fvWidget <$> mopt drivingPermitField (fsUniq mkUnique "permit") (Just x)
@@ -266,7 +266,7 @@ colParticipantEyeExamField :: Colonnade Sortable DailyTableData (DBCell _ (FormR
 colParticipantEyeExamField = colParticipantEyeExamField' _dailyFormEyeExam
 
 colParticipantEyeExamField' :: ASetter' a (Maybe UserEyeExam) -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId a DailyTableData)))
-colParticipantEyeExamField' l = sortable (Just "eye-exam") (i18nCell MsgTutorialEyeExam) $ formCell id
+colParticipantEyeExamField' l = sortable (Just "eye-exam") (i18nCell MsgTutorialEyeExam) $ (cellAttrs <>~ [("style","width:2%")]) <$> formCell id
   (views (resultParticipant . _entityKey) return)
   (\(view (resultParticipant . _entityVal . _tutorialParticipantEyeExam) -> x) mkUnique ->
     over (_1.mapped) (l .~) . over _2 fvWidget <$> mopt eyeExamField (fsUniq mkUnique "eye-exam") (Just x)
@@ -357,8 +357,27 @@ mkDailyTable isAdmin ssh nd = do
           cellMaybe ((`listInlineCell` roomReferenceCell) . nubOrd) $ mapMM lessonRoom $ 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
+      -- , 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-company") (i18nCell MsgTableBookingCompany) $ \(view $ resultParticipant . _entityVal . _tutorialParticipantCompany -> mcid) -> cellMaybe companyIdCell mcid
+      , sortable (Just "booking-company") (i18nCell MsgTableBookingCompany) $ \row ->
+          let bookComp = row ^. resultParticipant . _entityVal . _tutorialParticipantCompany
+              primComp = row ^? resultCompanyId
+              bookLink = cellMaybe companyIdCell bookComp
+              result
+                | primComp /= bookComp
+                , Just (unCompanyKey -> csh) <- primComp
+                  = bookLink
+                  <> spacerCell
+                  <> cell (modal (toWidget iconCompanyWarning) (Right -- TODO: use iconCompanyWarning instead!
+                      [whamlet|
+                        <h2>
+                          ^{userWidget row}
+                        <p>
+                          _{MsgAvsPrimaryCompany}: ^{companyWidget True (csh, csh, False)}
+                      |]
+                      ))
+                | otherwise = bookLink <> iconCell IconCertificate
+          in result
       , colUserNameModalHdr MsgCourseParticipant ForProfileDataR
       , colUserMatriclenr isAdmin
       , sortable (Just "card-no") (i18nCell MsgAvsCardNo) $ \(preview $ resultUserAvs . _userAvsLastCardNo . _Just -> cn :: Maybe AvsFullCardNo) -> cellMaybe (textCell . tshowAvsFullCardNo) cn

src/Utils/Icon.hs

@@ -115,7 +115,7 @@ data Icon
   | IconRemoveUser
   | IconReset
   | IconBlocked
-  | IconCertificate
+  | IconCertificate       -- currently always a car not always suitable?!
   | IconPrintCenter
   | IconLetter            -- only to be used for postal matters
   | IconAt
@@ -128,6 +128,7 @@ data Icon
   | IconUnlocked
   | IconResetTries        -- also see IconReset
   | IconCompany
+  | IconCompanyWarning    -- Company-related problems
   | IconEdit
   | IconUserEdit
   --  IconMagic           -- indicates automatic updates
@@ -249,8 +250,8 @@ iconLetterOrEmail True  = icon IconLetter
 iconLetterOrEmail False = icon IconAt
 
 iconQualificationBlock :: Bool -> Markup
-iconQualificationBlock True   = icon IconCertificate
+iconQualificationBlock True   = iconFixed IconCertificate
-iconQualificationBlock False  = icon IconBlocked
+iconQualificationBlock False  = iconFixed IconBlocked
 
 iconWriteReadOnly :: Bool -> Markup
 iconWriteReadOnly True  = icon IconEdit