diff --git a/messages/uniworx/categories/qualification/en-eu.msg b/messages/uniworx/categories/qualification/en-eu.msg index 51aa90ba7..2e15e3c97 100644 --- a/messages/uniworx/categories/qualification/en-eu.msg +++ b/messages/uniworx/categories/qualification/en-eu.msg @@ -14,9 +14,9 @@ TableQualificationCountActive: Active TableQualificationCountActiveTooltip: Number of currently valid qualification holders TableQualificationCountTotal: Total TableQualificationIsAvsLicence: AVS Driving License -TableQualificationIsAvsLicenceTooltip: Is this Qualification synchronized with AVS? Only applies to qualification holders having an AVS PersonID. +TableQualificationIsAvsLicenceTooltip: Under which name is this qualification synchronized with AVS, if any? Only applies to qualification holders having an AVS PersonID. TableQualificationSapExport: Sent to SAP -TableQualificationSapExportTooltip: Is this Qualification transmitted to SAP? Only applies to qualification holder having a Fraport Personnelnumber. +TableQualificationSapExportTooltip: Is this qualification transmitted to SAP? Only applies to qualification holder having a Fraport AG personnel number. LmsQualificationValidUntil: Valid until TableQualificationLastRefresh: Last renewed TableQualificationFirstHeld: First held diff --git a/messages/uniworx/categories/user/de-de-formal.msg b/messages/uniworx/categories/user/de-de-formal.msg index 6777920d1..e5572b77d 100644 --- a/messages/uniworx/categories/user/de-de-formal.msg +++ b/messages/uniworx/categories/user/de-de-formal.msg @@ -13,7 +13,7 @@ AdminUserAuth: Authentifizierung AdminUserMatriculation: Matrikelnummer AdminUserSex: Geschlecht AdminUserTelephone: Telefonnummer -AdminUserMobile: Mobiltelefonmummer +AdminUserMobile: Mobiltelefonnummer AdminUserFPersonalNumber: Personalnummer (nur Fraport AG) AdminUserFDepartment: Abteilung AdminUserPostAddress: Postalische Anschrift diff --git a/routes b/routes index 435ca94d3..da4defb88 100644 --- a/routes +++ b/routes @@ -285,7 +285,7 @@ /qualification/#SchoolId/#QualificationShorthand QualificationR GET -- TODO repurpose -- SAP export -/qualifications/sap/direct QualificationSAPDirectR GET !system-sap +/qualifications/sap/direct QualificationSAPDirectR GET !token -- OSIS CSV Export Demo /lms LmsAllR GET POST !free -- TODO verify that this is ok /lms/#SchoolId LmsSchoolR GET !free -- TODO verify that this is ok diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index 6722a3ac8..83101e26f 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -83,8 +83,9 @@ postLmsAllR = do FormMissing -> return () _other -> addMessage Warning "Kein korrekter LMS Knopf erkannt" + isAdmin <- hasReadAccessTo AdminR lmsTable <- runDB $ do - view _2 <$> mkLmsAllTable + view _2 <$> mkLmsAllTable isAdmin siteLayoutMsg MsgMenuQualifications $ do setTitleI MsgMenuQualifications $(widgetFile "lms-all") @@ -100,9 +101,10 @@ resultAllQualificationTotal :: Lens' AllQualificationTableData Word64 resultAllQualificationTotal = _dbrOutput . _3 . _unValue -mkLmsAllTable :: DB (Any, Widget) -mkLmsAllTable = do +mkLmsAllTable :: Bool -> DB (Any, Widget) +mkLmsAllTable isAdmin = do now <- liftIO getCurrentTime + let resultDBTable = DBTable{..} where @@ -139,7 +141,12 @@ mkLmsAllTable = do , sortable Nothing (i18nCell MsgTableQualificationIsAvsLicence & cellTooltip MsgTableQualificationIsAvsLicenceTooltip) $ \(view (resultAllQualification . _qualificationAvsLicence) -> licence) -> maybeCell licence $ textCell . T.singleton . licence2char , sortable Nothing (i18nCell MsgTableQualificationSapExport & cellTooltip MsgTableQualificationSapExportTooltip) - $ \(view (resultAllQualification . _qualificationSapId) -> sapid) -> tickmarkCell $ isJust sapid + $ \(view (resultAllQualification . _qualificationSapId) -> mbSapId) -> + let icn = IconOK -- change icon here, if desired + in case mbSapId of + Nothing -> mempty + Just sapId | isAdmin -> cellTooltipIcon (Just icn) (text2message sapId) mempty + Just _ -> iconCell icn , sortable Nothing (i18nCell MsgTableQualificationCountActive & cellTooltip MsgTableQualificationCountActiveTooltip) $ \(view resultAllQualificationActive -> n) -> wgtCell $ word2widget n , sortable Nothing (i18nCell MsgTableQualificationCountTotal) $ wgtCell . word2widget . view resultAllQualificationTotal diff --git a/src/Handler/Utils/Avs.hs b/src/Handler/Utils/Avs.hs index 99b8bdf38..c1316fb23 100644 --- a/src/Handler/Utils/Avs.hs +++ b/src/Handler/Utils/Avs.hs @@ -4,7 +4,7 @@ {-# LANGUAGE TypeApplications #-} -{-# OPTIONS_GHC -fno-warn-unused-imports #-} +{-# OPTIONS_GHC -fno-warn-unused-imports #-} -- TODO: remove this line, once the module is completed module Handler.Utils.Avs ( upsertAvsUser, upsertAvsUserById, upsertAvsUserByCard @@ -118,7 +118,7 @@ setLicencesAvs pls = do -- Only react to changes as compared to last seen status in avs.model -- TODO: turn into a job, once the interface is actually available checkLicences :: Handler () -checkLicences = do +checkLicences = do {- AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery AvsResponseGetLicences licences <- throwLeftM avsQueryGetAllLicences @@ -146,7 +146,15 @@ checkLicences = do `E.innerJoin` E.table @UserAvs `E.on` (\(_ E.:& qualUser E.:& usrAvs) -> qualUser E.^. QualificationUserUser E.==. usrAvs E.^. UserAvsUser) E.where_ $ E.isJust (quali E.^. QualificationAvsLicence) - E.&&. (usrAvs E.^. QualificationAvsLicence `E.notIn` E.valList + E.&&. (usrAvs E.^. QualificationAvsLicence `E.notIn` E.valList idsRollfeld) + + SELECT * + FROM sometable + FULL OUTER JOIN + (VALUES {{1,2,3},{4,5,6}}) AS t(x,y,z) + ON sometable.x = t.x + WHERE either IS NULL -- Use ERaw + -- WAS WILL ICH HIER WIRKLICH: -- Liefere alle avsIds, welche die falsche Qualifikation zugewiesen bekommen haben? @@ -164,7 +172,7 @@ checkLicences = do upsertAvsUser :: Text -> Handler (Maybe UserId) -upsertAvsUser (discernAvsCardPersonalNo -> Just someid) = upsertAvsUserByCard someid -- Note: Right case is a number, it could be AvsPersonId or AvsInternalPersonalNumber; we cannot know, but the latter is much more likely and useful to users! +upsertAvsUser (discernAvsCardPersonalNo -> Just someid) = upsertAvsUserByCard someid -- Note: Right case is a number, it could be AvsCardNumber or AvsInternalPersonalNumber; we cannot know, but the latter is much more likely and useful to users! upsertAvsUser _other = return Nothing -- TODO: attempt LDAP lookup to find by eMail; merely for convenience, not necessary right now {- maybe this code helps? upsRes :: Either CampusUserConversionException (Entity User) diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index ab86cf28f..6a885ad65 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -48,7 +48,7 @@ module Handler.Utils.Table.Pagination , linkEitherCell, linkEitherCellM, linkEitherCellM' , maybeAnchorCellM, maybeAnchorCellM', maybeLinkEitherCellM' , anchorCellC, anchorCellCM, anchorCellCM', linkEitherCellCM', maybeLinkEitherCellCM' - , cellTooltip + , cellTooltip, cellTooltipIcon , listCell, listCell', listCellOf, listCellOf' , ilistCell, ilistCell', ilistCellOf, ilistCellOf' , formCell, DBFormResult(..), getDBFormResult @@ -1691,10 +1691,13 @@ i18nCell msg = cell $ do toWidget $ mr msg cellTooltip :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a -> DBCell m a -cellTooltip msg = cellContents.mapped %~ (<> tipWdgt) +cellTooltip = cellTooltipIcon Nothing + +cellTooltipIcon :: (RenderMessage UniWorX msg, IsDBTable m a) => Maybe Icon -> msg -> DBCell m a -> DBCell m a +cellTooltipIcon icn msg = cellContents.mapped %~ (<> tipWdgt) where - tipWdgt = iconTooltip (msg2widget msg) Nothing True - + tipWdgt = iconTooltip (msg2widget msg) icn True + -- | Always display widget; maybe a link if user is Authorized. -- Also see variant `linkEmptyCell` anchorCell :: (HasRoute UniWorX url, ToWidget UniWorX wgt, IsDBTable m a) => url -> wgt -> DBCell m a diff --git a/src/Model/Types/Avs.hs b/src/Model/Types/Avs.hs index 6e3549cfe..2eb1210dc 100644 --- a/src/Model/Types/Avs.hs +++ b/src/Model/Types/Avs.hs @@ -45,7 +45,7 @@ o .:?~ key = o .: key <|> maybe empty parseJSON go -- Like (.:?) but maps Just null to Nothing, ie. Nothing instead of Just "" (.:?!) :: (MonoFoldable a, FromJSON a) => Object -> Text -> Parser (Maybe a) -(.:?!) o k = null2nothing <$> (o .:? k) +(.:?!) o k = canonical <$> (o .:? k) -- | `SloppyBool` successfully parses different variations of true/false @@ -256,18 +256,18 @@ instance Ord AvsDataPersonCard where makeLenses_ ''AvsDataPersonCard {- instance Canonical AvsDataPersonCard where - canonical proto = proto { avsDataStreet = null2nothing $ avsDataStreet proto - , avsDataPostalCode = null2nothing $ avsDataPostalCode proto - , avsDataCity = null2nothing $ avsDataCity proto - , avsDataFirm = null2nothing $ avsDataFirm proto + canonical proto = proto { avsDataStreet = canonical $ avsDataStreet proto + , avsDataPostalCode = canonical $ avsDataPostalCode proto + , avsDataCity = canonical $ avsDataCity proto + , avsDataFirm = canonical $ avsDataFirm proto } -} instance Canonical AvsDataPersonCard where canonical proto = - proto & _avsDataStreet %~ null2nothing - & _avsDataPostalCode %~ null2nothing - & _avsDataCity %~ null2nothing - & _avsDataFirm %~ null2nothing + proto & _avsDataStreet %~ canonical + & _avsDataPostalCode %~ canonical + & _avsDataCity %~ canonical + & _avsDataFirm %~ canonical -- TODO: use canonical in FromJSON/ToJSON instances for consistency instance FromJSON AvsDataPersonCard where @@ -289,10 +289,10 @@ instance ToJSON AvsDataPersonCard where catMaybes [ ("ValidTo" .=) <$> avsDataValidTo , ("IssueDate" .=) <$> avsDataIssueDate - , ("Street" .=) <$> (avsDataStreet & null2nothing) - , ("PostalCode" .=) <$> (avsDataPostalCode & null2nothing) - , ("City" .=) <$> (avsDataCity & null2nothing) - , ("Firm" .=) <$> (avsDataFirm & null2nothing) + , ("Street" .=) <$> (avsDataStreet & canonical) + , ("PostalCode" .=) <$> (avsDataPostalCode & canonical) + , ("City" .=) <$> (avsDataCity & canonical) + , ("Firm" .=) <$> (avsDataFirm & canonical) ] <> [ "Valid" .= show avsDataValid @@ -332,7 +332,7 @@ data AvsDataPerson = AvsDataPerson makeLenses_ ''AvsDataPerson instance Canonical AvsDataPerson where - canonical = over _avsPersonInternalPersonalNo null2nothing + canonical = over _avsPersonInternalPersonalNo canonical . over _avsPersonPersonCards canonical @@ -347,7 +347,7 @@ instance FromJSON AvsDataPerson where instance ToJSON AvsDataPerson where toJSON AvsDataPerson{..} = object $ - catMaybes [ ("InternalPersonalNo" .=) <$> (avsPersonInternalPersonalNo & null2nothing) ] + catMaybes [ ("InternalPersonalNo" .=) <$> (avsPersonInternalPersonalNo & canonical) ] <> [ "FirstName" .= avsPersonFirstName , "LastName" .= avsPersonLastName diff --git a/src/Utils.hs b/src/Utils.hs index 42c8d3b11..575ac8fd5 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -816,10 +816,10 @@ toNothing = const Nothing toNothingS :: String -> Maybe b toNothingS = const Nothing --- a more general formulation probably possible -null2nothing :: MonoFoldable a => Maybe a -> Maybe a -null2nothing (Just x) | null x = Nothing -null2nothing other = other +-- replaced by a more general formulation, see canonical +-- null2nothing :: MonoFoldable a => Maybe a -> Maybe a +-- null2nothing (Just x) | null x = Nothing +-- null2nothing other = other -- | Swap 'Nothing' for 'Just' and vice versa -- This belongs into Module 'Utils' but we have a weird cyclic @@ -1872,5 +1872,15 @@ makePrisms ''ExitCase class Canonical a where canonical :: a -> a +instance MonoFoldable mono => Canonical (Maybe mono) where + canonical (Just t) | null t = Nothing + canonical other = other + +-- instance (Canonical mono, MonoFoldable mono) => Canonical (Maybe mono) where +-- canonical (Just t) | null t = Nothing +-- canonical (Just t) = Just $ canonical t +-- canonical other = other + +-- this instance is more of a convenient abuse of the class (expand to Foldable) instance (Ord a, Canonical a) => Canonical (Set a) where canonical = Set.map canonical diff --git a/test/Utils/TypesSpec.hs b/test/Utils/TypesSpec.hs index dde67f33b..f5dfafb0f 100644 --- a/test/Utils/TypesSpec.hs +++ b/test/Utils/TypesSpec.hs @@ -55,7 +55,7 @@ instance Arbitrary AvsLicenceResponse where shrink = genericShrink instance Arbitrary AvsResponsePerson where - arbitrary = genericArbitrary + arbitrary = resize 5 genericArbitrary shrink = genericShrink instance Arbitrary AvsResponseStatus where