diff --git a/messages/uniworx/categories/avs/de-de-formal.msg b/messages/uniworx/categories/avs/de-de-formal.msg index 19c6684c4..5a3270182 100644 --- a/messages/uniworx/categories/avs/de-de-formal.msg +++ b/messages/uniworx/categories/avs/de-de-formal.msg @@ -4,7 +4,9 @@ AvsPersonInfo: AVS Personendaten AvsPersonId: AVS Personen Id AvsPersonNo: AVS Personennummer +AvsPersonNoNotId: AVS Personennummer dient zur menschlichen Kommunikation mit der Ausweisstelle und darf nicht verwechselt werden mit der maschinell verwendeten AVS Personen Id AvsPersonNoMismatch: AVS Personennummer hat sich geändert und wurde in FRADrive noch nicht aktualisiert +AvsPersonNoDiffers: Es sind derzeit zwei verschiedene AVS Personennummern zugeordnet. Bitte einen Administrator kontaktieren. AvsCardNo: Ausweiskartennummer AvsFirstName: Vorname AvsLastName: Nachname @@ -15,7 +17,6 @@ AvsQueryNeeded: Benötigt Verbindung zum AVS. AvsQueryEmpty: Bitte mindestens ein Anfragefeld ausfüllen! AvsQueryStatusInvalid t@Text: Nur numerische IDs eingeben, durch Komma getrennt! Erhalten: #{show t} AvsLicence: Fahrberechtigung -AvsPersonNoNotId: AVS Personennummer dient zur menschlichen Kommunikation mit der Ausweisstelle und darf nicht verwechselt werden mit der maschinell verwendeten AVS Personen Id AvsTitleLicenceSynch: Abgleich Fahrberechtigungen zwischen AVS und FRADrive BtnAvsRevokeUnknown: Fahrberechtigungen im AVS sofort entziehen BtnAvsImportUnknown: AVS Daten unbekannter Personen importieren diff --git a/messages/uniworx/categories/avs/en-eu.msg b/messages/uniworx/categories/avs/en-eu.msg index f42c75318..1b3a7b5a0 100644 --- a/messages/uniworx/categories/avs/en-eu.msg +++ b/messages/uniworx/categories/avs/en-eu.msg @@ -4,7 +4,9 @@ AvsPersonInfo: AVS person info AvsPersonId: AVS person id AvsPersonNo: AVS person number +AvsPersonNoNotId: AVS person number is used in human communication only and must not be mistaken for the AVS personen id used in machine communications AvsPersonNoMismatch: AVS person number has changed and was not yet updated in FRADrive +AvsPersonNoDiffers: There are currently two differing AVS person numbers associated with this user. Please contact an administrator to resolve this. AvsCardNo: Card number AvsFirstName: First name AvsLastName: Last name @@ -15,7 +17,7 @@ AvsQueryNeeded: AVS connection required. AvsQueryEmpty: At least one query field must be filled! AvsQueryStatusInvalid t: Numeric IDs only, comma seperated! #{show t} AvsLicence: Driving Licence -AvsPersonNoNotId: AVS person number is used in human communication only and must not be mistaken for the AVS personen id used in machine communications + AvsTitleLicenceSynch: Synchronisation driving licences between AVS and FRADrive BtnAvsRevokeUnknown: Revoke AVS driving licences for unknown persons immediately BtnAvsImportUnknown: Import AVS data for unknown persons diff --git a/messages/uniworx/categories/settings/personal_settings/de-de-formal.msg b/messages/uniworx/categories/settings/personal_settings/de-de-formal.msg index 31d8305d1..9512318eb 100644 --- a/messages/uniworx/categories/settings/personal_settings/de-de-formal.msg +++ b/messages/uniworx/categories/settings/personal_settings/de-de-formal.msg @@ -25,13 +25,14 @@ PersonalInfoTutorialsWip: Die Anzeige von Kurse, zu denen Sie angemeldet sind wi ProfileGroupSubmissionDates: Bei Gruppenabgaben wird kein Datum angezeigt, wenn Sie die Gruppenabgabe nie selbst hochgeladen haben. ProfileCorrectorRemark: Die oberhalb angezeigte Tabelle zeigt nur prinzipielle Einteilungen als Korrektor zu einem Übungsblatt. Auch ohne Einteilung können Korrekturen einzeln zugewiesen werden, welche hier dann nicht aufgeführt werden. ProfileCorrections: Auflistung aller zugewiesenen Korrekturen -Remarks: Hinweise +Remarks: Hinweis: -ProfileSupervisor n@Int m@Int: #{n} #{pluralDE n "übergeordneter" "übergeordnete"} Ansprechpartner#{noneMoreDE m "" ", davon " <> tshow m <> " mit Benachrichtigungsumleitung"} -ProfileNoSupervisor: Keine übergeordneten Ansprechpartner vorhanden. -ProfileSupervisee: Ist Ansprechpartner für -ProfileNoSupervisee: Ist kein Ansprechpartner für irgendjemand. -ProfileSuperviseeReroute: Umleitungen erfolgen per +ProfileNoSupervisor: Keine übergeordneten Ansprechpartner vorhanden +ProfileSupervisor n@Int m@Int: #{n} #{pluralDE n "übergeordneter" "übergeordnete"} Ansprechpartner#{noneMoreDE m "" (", davon " <> tshow m <> " mit Benachrichtigungsumleitung")} +ProfileSupervisorRemark n@Int m@Int l@Int: #{m}/#{n} #{pluralDE m "übergeordneter" "übergeordnete"} Ansprechpartner mit Benachrichtigungsumleitung#{noneMoreDE l "" (", davon " <> tshow l <> " mit postalischer Benachrichtigung")} +ProfileNoSupervisee: Ist kein Ansprechpartner für irgendjemand +ProfileSupervisee n@Int m@Int: Ist Ansprechpartner für #{n} #{pluralDE n "Person" "Personen"}#{noneMoreDE m "" (", davon " <> tshow m <> " mit Benachrichtigungsumleitung")} +ProfileSuperviseeRemark n@Int m@Int: Dieser Nutzer ist Ansprechpartner für #{n} #{pluralDE n "Person" "Personen"}#{noneMoreDE m "" (", davon " <> tshow m <> " mit Benachrichtigungsumleitung")} UserTelephone: Telefon UserMobile: Mobiltelefon diff --git a/messages/uniworx/categories/settings/personal_settings/en-eu.msg b/messages/uniworx/categories/settings/personal_settings/en-eu.msg index 9c0947c41..3bbb8cec4 100644 --- a/messages/uniworx/categories/settings/personal_settings/en-eu.msg +++ b/messages/uniworx/categories/settings/personal_settings/en-eu.msg @@ -25,13 +25,14 @@ PersonalInfoTutorialsWip: The feature to display courses you have registered for ProfileGroupSubmissionDates: No date is shown for group submissions if you have never uploaded the submission yourself. ProfileCorrectorRemark: The table above only shows registration as a corrector in principle. Even without registration corrections can be assigned individually and are not listed. ProfileCorrections: List of all assigned corrections -Remarks: Remarks +Remarks: Remark: -ProfileSupervisor n m: #{pluralENsN n "Supervisor"}#{noneMoreEN m "" " with " <> tshow m <> " active notification rerouting"} -ProfileNoSupervisor: Is not supervised by anynone. -ProfileSupervisee: Supervises -ProfileNoSupervisee: Does not supervise anynone. -ProfileSuperviseeReroute: Reroutes reach this supervisor via +ProfileNoSupervisor: Is not supervised by anynone +ProfileSupervisor n m: #{pluralENsN n "supervisor"} #{noneMoreEN m "" ("with " <> tshow m <> " active notification rerouting")} +ProfileSupervisorRemark n@Int m@Int l@Int: #{m}/#{n} #{pluralENs m "supervisor"} with active notification rerouting#{noneMoreEN l "" (", and " <> tshow l <> "of these prefer postal notifications")} +ProfileNoSupervisee: Does not supervise anynone +ProfileSupervisee n m: Supervises #{pluralENsN n "person"} #{noneMoreEN m "" ("with " <> tshow m <> " active notification rerouting")} +ProfileSuperviseeRemark n m: This person supervises #{pluralENsN n "person"}#{noneMoreEN m "" (" with " <> tshow m <> " having active notifications rerouting to this user")} UserTelephone: Phone UserMobile: Mobile diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index c39eb30e4..71c1c2e89 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -665,10 +665,15 @@ makeProfileData usrEnt@(Entity uid usrVal@User{..}) = do correctionsTable <- mkCorrectionsTable uid -- Tabelle mit allen Korrektor-Aufgaben qualificationsTable <- mkQualificationsTable now uid -- Tabelle mit allen Qualifikationen supervisorsTable <- mkSupervisorsTable uid -- Tabelle mit allen Supervisors - superviseesTable <- mkSuperviseesTable uid -- Tabelle mit allen Supervisees + superviseesTable <- mkSuperviseesTable actualPrefersPostal uid -- Tabelle mit allen Supervisees let supervisorsWgt :: Widget = - let ((getSum -> nrSupers, getSum -> nrReroute, getSum -> _nrLetter), tWgt) = supervisorsTable - in maybeTable' (MsgProfileSupervisor nrSupers nrReroute) (Just MsgProfileNoSupervisor) Nothing (Any $ nrSupers > 0, tWgt) + let ((getSum -> nrSupers, getSum -> nrReroute, getSum -> nrLetter), tWgt) = supervisorsTable + in maybeTable' (MsgProfileSupervisor nrSupers nrReroute) (Just MsgProfileNoSupervisor) + (toMaybe (nrReroute > 0) $ msg2widget $ MsgProfileSupervisorRemark nrSupers nrReroute nrLetter) (nrSupers > 0, tWgt) + superviseesWgt :: Widget = + let ((getSum -> nrSubs, getSum -> nrReroute), tWgt) = superviseesTable + in maybeTable' (MsgProfileSupervisee nrSubs nrReroute) (Just MsgProfileNoSupervisee) + (toMaybe (nrReroute > 0) $ msg2widget $ MsgProfileSuperviseeRemark nrSubs nrReroute) (nrSubs > 0, tWgt) -- let examTable, ownTutorialTable, tutorialTable :: Widget -- examTable = i18n MsgPersonalInfoExamAchievementsWip -- ownTutorialTable = i18n MsgPersonalInfoOwnTutorialsWip @@ -677,8 +682,9 @@ makeProfileData usrEnt@(Entity uid usrVal@User{..}) = do cID <- encrypt uid mCRoute <- getCurrentRoute showAdminInfo <- pure (mCRoute == Just (AdminUserR cID)) `or2M` hasReadAccessTo (AdminUserR cID) - tooltipAvsPersNo <- messageI Info MsgAvsPersonNoNotId - tooltipInvalidEmail <- messageI Error MsgInvalidEmailAddress + tooltipAvsPersNo <- messageI Info MsgAvsPersonNoNotId + tooltipAvsPersNoDiffers <- messageI Error MsgAvsPersonNoDiffers + tooltipInvalidEmail <- messageI Error MsgInvalidEmailAddress let profileRemarks = $(i18nWidgetFile "profile-remarks") return $(widgetFile "profileData") @@ -755,7 +761,7 @@ mkEnrolledCoursesTable = , dbtRowKey = \(course `E.InnerJoin` _) -> course E.^. CourseId , dbtProj = dbtProjId <&> _dbrOutput . _2 %~ E.unValue , dbtColonnade = mconcat - [ sortable (Just "term") (i18nCell MsgTableTerm) $ + [ sortable (Just "term") (i18nCell MsgTableTerm) $ fmap addIndicatorCell termCell <$> view (_dbrOutput . _1 . _entityVal . _courseTerm) , sortable (Just "school") (i18nCell MsgTableCourseSchool) . magnify (_dbrOutput . _1 . _entityVal) $ schoolCell <$> view _courseTerm @@ -822,7 +828,7 @@ mkSubmissionTable = <&> _dbrOutput . _4 %~ E.unValue dbtColonnade = mconcat - [ sortable (Just "term") (i18nCell MsgTableTerm) $ + [ sortable (Just "term") (i18nCell MsgTableTerm) $ fmap addIndicatorCell termCell <$> view (_dbrOutput . _1 . _1) , sortable (Just "school") (i18nCell MsgTableCourseSchool) . magnify (_dbrOutput . _1 ) $ schoolCell <$> view _1 @@ -892,7 +898,7 @@ mkSubmissionGroupTable = <&> _dbrOutput . _1 %~ $(E.unValueN 3) dbtColonnade = mconcat - [ sortable (Just "term") (i18nCell MsgTableTerm) $ + [ sortable (Just "term") (i18nCell MsgTableTerm) $ fmap addIndicatorCell termCell <$> view (_dbrOutput . _1 . _1) , sortable (Just "school") (i18nCell MsgTableCourseSchool) . magnify (_dbrOutput . _1 ) $ schoolCell <$> view _1 @@ -957,7 +963,7 @@ mkCorrectionsTable = <&> _dbrOutput . _2 %~ E.unValue dbtColonnade = mconcat - [ sortable (Just "term") (i18nCell MsgTableTerm) $ + [ sortable (Just "term") (i18nCell MsgTableTerm) $ fmap addIndicatorCell termCellCL <$> view (_dbrOutput . _1) , sortable (Just "school") (i18nCell MsgTableCourseSchool) $ schoolCellCL <$> view (_dbrOutput . _1) @@ -1017,7 +1023,7 @@ mkQualificationsTable = , dbtProj = dbtProjId , dbtColonnade = mconcat [ colSchool (_dbrOutput . _1 . _entityVal . _qualificationSchool) - , sortable (Just "quali") (i18nCell MsgQualificationName) $ qualificationDescrCell <$> view (_dbrOutput . _1 . _entityVal) + , sortable (Just "quali") (i18nCell MsgQualificationName) $ qualificationDescrCell <$> view (_dbrOutput . _1 . _entityVal) , sortable (Just "first-held") (i18nCell MsgTableQualificationFirstHeld) $ dayCell <$> view (_dbrOutput . _2 . _entityVal . _qualificationUserFirstHeld ) , sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh) $ dayCell <$> view (_dbrOutput . _2 . _entityVal . _qualificationUserLastRefresh) , sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ dayCell <$> view (_dbrOutput . _2 . _entityVal . _qualificationUserValidUntil ) @@ -1083,9 +1089,9 @@ mkSupervisorsTable uid = dbTableWidget validator DBTable{..} let isReroute = row ^. resultUserSupervisor . _entityVal ._userSupervisorRerouteNotifications isLetter = row ^. resultUser . _userPrefersPostal in tellCell (Sum 1, Sum $ fromEnum isReroute, Sum $ fromEnum $ isReroute && isLetter) $ - ifIconCell isReroute IconReroute - <> spacerCell <> - iconFixedCell (iconLetterOrEmail isLetter) + if isReroute + then iconCell IconReroute <> spacerCell <> iconFixedCell (iconLetterOrEmail isLetter) + else mempty , sortable (Just "cshort") (i18nCell MsgTableCompany) $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorCompany -> mc) -> maybeCell mc (\(unCompanyKey -> c) -> anchorCell (FirmUsersR c) $ citext2widget c) , sortable (Just "reason") (i18nCell MsgSupervisorReason) $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorReason -> mr) -> maybeCell mr textCell ] @@ -1114,8 +1120,8 @@ mkSupervisorsTable uid = dbTableWidget validator DBTable{..} -- | Table listing all persons supervised by the given user -mkSuperviseesTable :: UserId -> DB (Bool, Widget) -mkSuperviseesTable uid = over _1 getAny <$> dbTableWidget validator DBTable{..} +mkSuperviseesTable ::Bool -> UserId -> DB ((Sum Int, Sum Int), Widget) +mkSuperviseesTable userPrefersPostal uid = dbTableWidget validator DBTable{..} where dbtIdent = "userSupervisedBy" :: Text dbtStyle = def @@ -1127,12 +1133,15 @@ mkSuperviseesTable uid = over _1 getAny <$> dbTableWidget validator DBTable{..} dbtRowKey (_ `E.InnerJoin` spr) = spr E.^. UserSupervisorId dbtProj = dbtProjId + iconCellLetterOrEmail = spacerCell <> iconFixedCell (iconLetterOrEmail userPrefersPostal) -- only notification type of supervisor matters here dbtColonnade = mconcat - [ sortable Nothing mempty $ const indicatorCell - , colUserNameModalHdr MsgTableSupervisee ForProfileDataR - -- , colUserEmail - , sortable (Just "rerouted") (i18nCell MsgTableRerouteActive) $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorRerouteNotifications -> b) -> ifIconCell b IconReroute + [ colUserNameModalHdr MsgTableSupervisee ForProfileDataR + , colUserEmail + -- , sortable (Just "rerouted") (i18nCell MsgTableRerouteActive) $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorRerouteNotifications -> b) -> ifIconCell b IconReroute -- , sortable (Just "postal-pref") (i18nCell MsgPrefersPostal) $ \(view $ resultUser . _userPrefersPostal -> b) -> iconFixedCell $ iconLetterOrEmail b + , sortable (Just "reroute") (i18nCell MsgTableRerouteActive) $ \row -> + let isReroute = row ^. resultUserSupervisor . _entityVal ._userSupervisorRerouteNotifications + in tellCell (Sum 1, Sum $ fromEnum isReroute) $ boolCell isReroute $ iconCell IconReroute <> iconCellLetterOrEmail , sortable (Just "cshort") (i18nCell MsgTableCompany) $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorCompany -> mc) -> maybeCell mc (\(unCompanyKey -> c) -> anchorCell (FirmUsersR c) $ citext2widget c) , sortable (Just "reason") (i18nCell MsgSupervisorReason) $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorReason -> mr) -> maybeCell mr textCell ] @@ -1140,8 +1149,12 @@ mkSuperviseesTable uid = over _1 getAny <$> dbTableWidget validator DBTable{..} dbtSorting = mconcat [ singletonMap & uncurry $ sortUserNameLink queryUser , singletonMap & uncurry $ sortUserEmail queryUser - , singletonMap "postal-pref" $ SortColumn $ queryUser >>> (E.^. UserPrefersPostal) - , singletonMap "rerouted" $ SortColumn $ queryUserSupervisor >>> (E.^. UserSupervisorRerouteNotifications) + -- , singletonMap "postal-pref" $ SortColumn $ queryUser >>> (E.^. UserPrefersPostal) + -- , singletonMap "rerouted" $ SortColumn $ queryUserSupervisor >>> (E.^. UserSupervisorRerouteNotifications) + , singletonMap "reroute" $ SortColumns $ \row -> + [ SomeExprValue $ queryUserSupervisor row E.^. UserSupervisorRerouteNotifications + , SomeExprValue $ queryUser row E.^. UserPrefersPostal + ] , singletonMap "cshort" $ SortColumn $ queryUserSupervisor >>> (E.^. UserSupervisorCompany) , singletonMap "reason" $ SortColumn $ queryUserSupervisor >>> (E.^. UserSupervisorReason) ] diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs index 18b2186fb..1c62f37a8 100644 --- a/src/Handler/Utils/Table/Cells.hs +++ b/src/Handler/Utils/Table/Cells.hs @@ -14,7 +14,7 @@ import Handler.Utils.DateTime import Handler.Utils.Widgets import Handler.Utils.Occurrences import Handler.Utils.LMS (lmsUserStatusWidget) -import Handler.Utils.Qualification (isValidQualification) +import Handler.Utils.Qualification (isValidQualification) type CourseLink = (TermId, SchoolId, CourseShorthand) -- TODO: Refactor with WithHoles ! @@ -41,16 +41,23 @@ cellTell = flip tellCell indicatorCell :: IsDBTable m Any => DBCell m Any -- For dbTables that return a Bool to indicate content indicatorCell = writerCell . tell $ Any True +addIndicatorCell :: IsDBTable m Any => DBCell m Any -> DBCell m Any +addIndicatorCell = tellCell $ Any True + writerCell :: IsDBTable m w => WriterT w m () -> DBCell m w writerCell act = mempty & cellContents %~ (<* act) --- for documentation purposes +-- for documentation purposes cellMaybe :: IsDBTable m b => (a -> DBCell m b) -> Maybe a -> DBCell m b cellMaybe = foldMap maybeCell :: IsDBTable m b => Maybe a -> (a -> DBCell m b) -> DBCell m b maybeCell = flip foldMap +boolCell :: IsDBTable m b => Bool -> DBCell m b -> DBCell m b +boolCell True c = c +boolCell False _ = mempty + htmlCell :: (IsDBTable m a, ToMarkup c) => c -> DBCell m a htmlCell = cell . toWidget . toMarkup @@ -62,7 +69,7 @@ sqlCell :: (IsDBTable (YesodDB UniWorX) a) => YesodDB UniWorX Widget -> DBCell ( sqlCell act = mempty & cellContents .~ lift act -- TODO: Formulate variant of sqlCell that types for tables having actions, i.e. MForm istead of YesodDB? --- sqlCell' :: (IsDBTable (MForm Handler) a) => _ -> DBCell (MForm Handler) a +-- sqlCell' :: (IsDBTable (MForm Handler) a) => _ -> DBCell (MForm Handler) a -- sqlCell' = flip (set' cellContents) mempty -- | Highlight table cells with warning: Is not yet implemented in frontend. @@ -158,14 +165,14 @@ modalCell content = cell $ modal (toWidget $ hasComment True) (Right $ toWidget -- | Show Text if it is small, create modal otherwise modalCellLarge :: (IsDBTable m a, ToWidget UniWorX t, MonoFoldable t, Element t ~ Char) => t -> DBCell m a -modalCellLarge content +modalCellLarge content | length content > 32 = modalCell content | otherwise = stringCell content markupCellLargeModal :: IsDBTable m a => StoredMarkup -> DBCell m a markupCellLargeModal mup | markupIsSmallish mup = cell $ toWidget mup - | otherwise = modalCell mup + | otherwise = modalCell mup ----------------- -- Datatype cells @@ -221,44 +228,44 @@ cellHasUserLink toLink user = -- | like `cellHasUserLink` but opens the user in a modal instead; link is only displayed if the user has sufficient rights cellHasUserModal :: (IsDBTable m c, HasEntity u User) => (CryptoUUIDUser -> Route UniWorX) -> u -> DBCell m c -cellHasUserModal toLink user = +cellHasUserModal toLink user = let userEntity = user ^. hasEntityUser uid = userEntity ^. _entityKey nWdgt = nameWidget (userEntity ^. _entityVal . _userDisplayName) (userEntity ^. _entityVal . _userSurname) - lWdgt = do + lWdgt = do uuid <- liftHandler $ encrypt uid - modalAccess nWdgt nWdgt False $ toLink uuid + modalAccess nWdgt nWdgt False $ toLink uuid in cell lWdgt -- | like `cellHasUserModal` but but always display link without prior access rights checks cellHasUserModalAdmin :: (IsDBTable m c, HasEntity u User) => (CryptoUUIDUser -> Route UniWorX) -> u -> DBCell m c -cellHasUserModalAdmin toLink user = +cellHasUserModalAdmin toLink user = let userEntity = user ^. hasEntityUser uid = userEntity ^. _entityKey nWdgt = nameWidget (userEntity ^. _entityVal . _userDisplayName) (userEntity ^. _entityVal . _userSurname) - lWdgt = do + lWdgt = do uuid <- liftHandler $ encrypt uid - modal nWdgt $ Left $ SomeRoute $ toLink uuid + modal nWdgt $ Left $ SomeRoute $ toLink uuid in cell lWdgt -- | like `cellHasUserModal` but with fixed route and showing an edit icon instead; link is only displayed if the user has sufficient rights cellEditUserModal :: (IsDBTable m c, HasEntity u User) => u -> DBCell m c -cellEditUserModal user = +cellEditUserModal user = let userEntity = user ^. hasEntityUser uid = userEntity ^. _entityKey - nWdgt = toWidget $ icon IconUserEdit - lWdgt = do + nWdgt = toWidget $ icon IconUserEdit + lWdgt = do uuid <- liftHandler $ encrypt uid modalAccess mempty nWdgt True $ ForProfileR uuid in cell lWdgt -- | like `cellEditUserModal` but always displays the link without prior access rights checks cellEditUserModalAdmin :: (IsDBTable m c, HasEntity u User) => u -> DBCell m c -cellEditUserModalAdmin user = +cellEditUserModalAdmin user = let userEntity = user ^. hasEntityUser uid = userEntity ^. _entityKey - nWdgt = toWidget $ icon IconUserEdit - lWdgt = do + nWdgt = toWidget $ icon IconUserEdit + lWdgt = do uuid <- liftHandler $ encrypt uid modal nWdgt (Left $ SomeRoute $ ForProfileR uuid) in cell lWdgt @@ -267,23 +274,23 @@ cellHasMatrikelnummer :: (IsDBTable m a, HasUser u) => u -> DBCell m a cellHasMatrikelnummer = maybe mempty textCell . view _userMatrikelnummer cellHasMatrikelnummerLinked :: (IsDBTable m a, HasEntity u User) => Bool -> u -> DBCell m a -cellHasMatrikelnummerLinked isAdmin usr - | Just matNr <- usrEntity ^. _userMatrikelnummer = cell $ do +cellHasMatrikelnummerLinked isAdmin usr + | Just matNr <- usrEntity ^. _userMatrikelnummer = cell $ do uuid <- liftHandler $ encrypt $ usrEntity ^. _entityKey if isAdmin then modal (text2widget matNr) (Left $ SomeRoute $ AdminAvsUserR uuid) else modalAccess mempty (text2widget matNr) False (AdminAvsUserR uuid) | otherwise = mempty - where + where usrEntity = usr ^. hasEntityUser cellHasMatrikelnummerLinkedAdmin :: (IsDBTable m a, HasEntity u User) => u -> DBCell m a -cellHasMatrikelnummerLinkedAdmin usr - | Just matNr <- usrEntity ^. _userMatrikelnummer = cell $ do +cellHasMatrikelnummerLinkedAdmin usr + | Just matNr <- usrEntity ^. _userMatrikelnummer = cell $ do uuid <- liftHandler $ encrypt $ usrEntity ^. _entityKey - modal (text2widget matNr) (Left $ SomeRoute $ AdminAvsUserR uuid) + modal (text2widget matNr) (Left $ SomeRoute $ AdminAvsUserR uuid) | otherwise = mempty - where + where usrEntity = usr ^. hasEntityUser @@ -393,7 +400,7 @@ qualificationDescrCell (view hasQualification -> q@Qualification{..}) = qualific qualificationValidIconCell :: (IsDBTable m c, HasQualificationUser a, HasQualificationUserBlock b) => Day -> Maybe b -> a -> DBCell m c qualificationValidIconCell d qb qu = do blockIcon $ isValidQualification d qu qb - where + where blockIcon = cell . toWidget . iconQualificationBlock qualificationValidUntilCell :: (IsDBTable m c, HasQualificationUser a, HasQualificationUserBlock b) => Day -> Maybe b -> a -> DBCell m c @@ -402,11 +409,11 @@ qualificationValidUntilCell = qualificationValidUntilCell' (Just LmsUserAllR) qualificationValidUntilCell' :: (IsDBTable m c, HasQualificationUser a, HasQualificationUserBlock b) => Maybe (CryptoUUIDUser -> Route UniWorX) -> Day -> Maybe b -> a -> DBCell m c qualificationValidUntilCell' mbToLink d qb qu = cell $ case mbToLink of Nothing -> headWgt <> dateWgt - Just toLink -> do + Just toLink -> do uuid <- liftHandler $ encrypt $ qu ^. hasQualificationUser . _qualificationUserUser let modalWgt = modalAccess dateWgt dateWgt False $ toLink uuid headWgt <> modalWgt - where + where dateWgt = formatTimeW SelFormatDate (qu ^. hasQualificationUser . _qualificationUserValidUntil) iconWgt = toWidget $ iconQualificationBlock $ isValidQualification d qu qb headWgt = iconWgt <> [whamlet| |] @@ -416,18 +423,18 @@ qualificationValidReasonCell = qualificationValidReasonCell' (Just LmsUserAllR) qualificationValidReasonCell' :: (IsDBTable m c, HasQualificationUser a, HasQualificationUserBlock b) => Maybe (CryptoUUIDUser -> Route UniWorX) -> Bool -> Day -> Maybe b -> a -> DBCell m c qualificationValidReasonCell' mbToLink showReason d qb qu = ic <> foldMap blc qb - where + where ic = cell . toWidget . iconQualificationBlock $ isValidQualification d qu qb blc (view hasQualificationUserBlock -> QualificationUserBlock{..}) - | showReason = spacerCell <> dc qualificationUserBlockFrom <> spacerCell <> modalCellLarge qualificationUserBlockReason + | showReason = spacerCell <> dc qualificationUserBlockFrom <> spacerCell <> modalCellLarge qualificationUserBlockReason | qualificationUserBlockUnblock = mempty | otherwise = spacerCell <> dateCell qualificationUserBlockFrom - dc tstamp + dc tstamp | Just toLink <- mbToLink = cell $ do uuid <- liftHandler $ encrypt uid let dWgt = formatTimeW SelFormatDate tstamp modalAccess dWgt dWgt False $ toLink uuid - -- anchorCellM (toLink <$> encrypt uid) + -- anchorCellM (toLink <$> encrypt uid) | otherwise = dateCell tstamp uid = qu ^. hasQualificationUser . _qualificationUserUser @@ -438,15 +445,15 @@ qualificationValidReasonCell'' mbToLink showReason d qb qu extValid = ic <> icEr icErr = cell . toWidget . isBad $ quValid /= extValid ic = cell . toWidget $ iconQualificationBlock quValid blc (view hasQualificationUserBlock -> QualificationUserBlock{..}) - | showReason = spacerCell <> dc qualificationUserBlockFrom <> spacerCell <> modalCellLarge qualificationUserBlockReason + | showReason = spacerCell <> dc qualificationUserBlockFrom <> spacerCell <> modalCellLarge qualificationUserBlockReason | qualificationUserBlockUnblock = mempty | otherwise = spacerCell <> dateCell qualificationUserBlockFrom - dc tstamp + dc tstamp | Just toLink <- mbToLink = cell $ do uuid <- liftHandler $ encrypt uid let dWgt = formatTimeW SelFormatDate tstamp modalAccess dWgt dWgt False $ toLink uuid - -- anchorCellM (toLink <$> encrypt uid) + -- anchorCellM (toLink <$> encrypt uid) | otherwise = dateCell tstamp uid = qu ^. hasQualificationUser . _qualificationUserUser @@ -496,7 +503,7 @@ lmsStatusCell extendedInfo mkLink = wgtCell . lmsUserStatusWidget extendedInfo m lmsStateCell :: IsDBTable m a => LmsState -> DBCell m a lmsStateCell LmsFailed = iconBoolCell False -lmsStateCell LmsOpen = iconSpacerCell +lmsStateCell LmsOpen = iconSpacerCell lmsStateCell LmsPassed = iconBoolCell True avsPersonNoCell :: (IsDBTable m c, HasUserAvs a) => a -> DBCell m c @@ -515,7 +522,7 @@ avsPersonNoLinkedCellAdmin a = cell $ do modal nWgt (Left $ SomeRoute $ AdminAvsUserR uuid) avsPersonCardCell :: (IsDBTable m c) => Set AvsDataPersonCard -> DBCell m c -avsPersonCardCell cards = wgtCell +avsPersonCardCell cards = wgtCell [whamlet| $newline never