From 6acfd849aeb473a018f7a9c34e69f61b3c22b6f8 Mon Sep 17 00:00:00 2001 From: Steffen Date: Wed, 5 Jun 2024 12:02:23 +0200 Subject: [PATCH 1/6] fix(lette): adjust window for new pin letters --- templates/letter/din5008with_pin_new.latex | 4 ++-- templates/letter/fraport_renewal_new.md | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/templates/letter/din5008with_pin_new.latex b/templates/letter/din5008with_pin_new.latex index 83eaf63fd..2505e02ef 100644 --- a/templates/letter/din5008with_pin_new.latex +++ b/templates/letter/din5008with_pin_new.latex @@ -162,7 +162,7 @@ $endif$ \opening{$en-opening$} $endif$ - \begin{textblock}{65}(84,232)%hpos,vpos + \begin{textblock}{65}(92,236)%hpos,vpos Werte in mm \textcolor{black!39}{ \begin{labeling}{Password:}%Achtung! Die Position des Logins muss sprachunabhängig immer an der gleichen Position sein, sonst kannn die Rückmeldung der Druckerei den Ident nicht mehr identifizieren! $if(is-de)$ @@ -192,7 +192,7 @@ $endif$ $endif$ $if(notice)$ - \begin{textblock}{170}(20,258)%hpos,vpos + \begin{textblock}{170}(20,262)%hpos,vpos Werte in mm \scriptsize \textbf{Hinweise für den Schulungsteilnehmer:} \newline diff --git a/templates/letter/fraport_renewal_new.md b/templates/letter/fraport_renewal_new.md index e90db735b..010b8cf55 100644 --- a/templates/letter/fraport_renewal_new.md +++ b/templates/letter/fraport_renewal_new.md @@ -13,10 +13,10 @@ de-opening: Liebe Fahrberechtigungsinhaber, en-opening: Dear driver, de-closing: | Mit freundlichen Grüßen, - Ihre Fraport Fahrerausbildung + Ihre Fahrerausbildung en-closing: | With kind regards, - Your Fraport Driver Training + Your Driver Training encludes: hyperrefoptions: hidelinks From aa1d230e497f0e59dbea9f4fd5c7da773f5a4280 Mon Sep 17 00:00:00 2001 From: Steffen Date: Fri, 7 Jun 2024 12:31:54 +0200 Subject: [PATCH 2/6] fix(avs): steps towards #164 - link avs nr to status on profile page - link companies on profile page - swap icons for isAutomatic - improve jsonWidget number display for integers and small floats --- src/Handler/Profile.hs | 6 ++---- src/Handler/Utils/Table/Cells.hs | 5 +++-- src/Handler/Utils/Widgets.hs | 15 ++++++++++++++- src/Utils/Avs.hs | 2 +- src/Utils/Icon.hs | 10 +++++----- templates/profileData.hamlet | 16 ++++++++-------- 6 files changed, 33 insertions(+), 21 deletions(-) diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 8429c04c7..ee965626e 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -605,10 +605,8 @@ makeProfileData usrEnt@(Entity uid User{..}) = do E.on $ usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid E.orderBy [E.asc (comp E.^. CompanyName)] -- E.desc (usrComp E.^. UserCompanySupervisor), - return (comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor) - let companies = intersperse (text2markup ", ") $ - (\(E.Value cmpName, E.Value cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> companies' - icnSuper = text2markup " " <> icon IconSupervisor + return (comp E.^. CompanyShorthand, comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor) + let companies = intersperse (text2widget ", ") $ companyWidget . $(E.unValueN 3) <$> companies' supervisors' <- E.select $ E.from $ \(spvr `E.InnerJoin` usrSpvr) -> do E.on $ spvr E.^. UserSupervisorSupervisor E.==. usrSpvr E.^. UserId E.where_ $ spvr E.^. UserSupervisorUser E.==. E.val uid diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs index 48c2e4444..18b2186fb 100644 --- a/src/Handler/Utils/Table/Cells.hs +++ b/src/Handler/Utils/Table/Cells.hs @@ -356,10 +356,11 @@ courseCell Course{..} = anchorCell link name `mappend` desc ^{modal "Beschreibung" (Right $ toWidget descr)} |] +-- also see Handler.Utils.Widgets.companyWidget companyCell :: IsDBTable m a => CompanyShorthand -> CompanyName -> Bool -> DBCell m a -companyCell csh cname isSupervisor = anchorCell link name +companyCell csh cname isSupervisor = anchorCell curl name where - link = FirmUsersR csh + curl = FirmUsersR csh corg = ciOriginal cname name | isSupervisor = text2markup (corg <> " ") <> icon IconSupervisor diff --git a/src/Handler/Utils/Widgets.hs b/src/Handler/Utils/Widgets.hs index 1e5f6bdc2..3f6b1fe89 100644 --- a/src/Handler/Utils/Widgets.hs +++ b/src/Handler/Utils/Widgets.hs @@ -14,6 +14,7 @@ import Handler.Utils.DateTime import qualified Data.Char as Char import qualified Data.HashMap.Strict as Aeson -- ON UPDATE replace with: import qualified Data.Aeson.KeyMap as Aeson +import Data.Scientific --------- -- Simple utilities for consistent display @@ -131,6 +132,16 @@ modalAccess wdgtNo wdgtYes writeAccess route = do then modal wdgtYes (Left $ SomeRoute route) else wdgtNo +-- also see Handler.Utils.Table.Cells.companyCell +companyWidget :: (CompanyShorthand, CompanyName, Bool) -> Widget +companyWidget (csh, cname, isSupervisor) = simpleLink (toWgt name) curl + where + curl = FirmUsersR csh + corg = ciOriginal cname + name + | isSupervisor = text2markup (corg <> " ") <> icon IconSupervisor + | otherwise = text2markup corg + ---------- -- HEAT -- ---------- @@ -253,7 +264,9 @@ jsonWidget x = jsonWidgetAux $ toJSON x jsonWidgetAux Null = [whamlet|Null|] jsonWidgetAux (Bool b) = toWidget $ boolSymbol b jsonWidgetAux (String s) = [whamlet|#{s}|] - jsonWidgetAux (Number n) = [whamlet|#{show n}|] + jsonWidgetAux (Number n) + | isInteger n = [whamlet|#{formatScientific Fixed (Just 0) n}|] + | otherwise = [whamlet|#{formatScientific Generic Nothing n}|] jsonWidgetAux (Array l) | 1 >= length l = foldMap jsonWidgetAux l -- empty arrays don't show | otherwise = diff --git a/src/Utils/Avs.hs b/src/Utils/Avs.hs index c54b80864..704459f51 100644 --- a/src/Utils/Avs.hs +++ b/src/Utils/Avs.hs @@ -102,7 +102,7 @@ mkAvsQuery _ _ _ = AvsQuery AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00006666"), avsPersonQueryVersionNo=Just "4"} -> AvsResponsePerson $ sumpfi1 <> sumpfi2 <> sumpfi3 AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00007777"), avsPersonQueryVersionNo=Just "4"} -> AvsResponsePerson $ sumpfi1 <> sumpfi2 <> sumpfi3 AvsQueryPerson{avsPersonQueryCardNo=Just (AvsCardNo "00008888"), avsPersonQueryVersionNo=Just "4"} -> AvsResponsePerson $ sumpfi1 <> sumpfi2 <> sumpfi3 - _ -> AvsResponsePerson mempty + _ -> AvsResponsePerson steffen fakeStatus :: AvsQueryStatus -> AvsResponseStatus fakeStatus (AvsQueryStatus (Set.toList -> (api:_))) = AvsResponseStatus $ Set.singleton $ AvsStatusPerson api $ Set.fromList diff --git a/src/Utils/Icon.hs b/src/Utils/Icon.hs index 0ec91a144..db18d2772 100644 --- a/src/Utils/Icon.hs +++ b/src/Utils/Icon.hs @@ -118,7 +118,7 @@ data Icon | IconCompany | IconEdit | IconUserEdit - | IconMagic -- indicates automatic updates + -- | IconMagic -- indicates automatic updates deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic) deriving anyclass (Universe, Finite, NFData) @@ -215,7 +215,7 @@ iconText = \case IconCompany -> "building" IconEdit -> "edit" IconUserEdit -> "user-edit" - IconMagic -> "wand-magic" + -- IconMagic -> "wand-magic" nullaryPathPiece ''Icon $ camelToPathPiece' 1 deriveLift ''Icon @@ -298,10 +298,10 @@ isNew :: Bool -> Markup isNew True = icon IconNew isNew False = mempty --- ^ Maybe display an icon that denotes that something™ is automagically updated or derived +-- ^ Maybe display an icon that denotes that something™ is NOT automagically updated or derived, but had been edited isAutomatic :: Bool -> Markup -isAutomatic True = icon IconMagic -isAutomatic False = mempty +isAutomatic True = mempty -- icon IconMagic +isAutomatic False = icon IconLocked -- IconEdit boolSymbol :: Bool -> Markup boolSymbol True = icon IconOK diff --git a/templates/profileData.hamlet b/templates/profileData.hamlet index b33419227..2c51809a5 100644 --- a/templates/profileData.hamlet +++ b/templates/profileData.hamlet @@ -37,7 +37,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
_{MsgTableMatrikelNr}
- #{matnr} + ^{modalAccess (text2widget matnr) (text2widget matnr) False (AdminAvsUserR cID)} $maybe sex <- userSex
_{MsgTableSex} @@ -57,9 +57,9 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later $maybe addr <- actualPostAddress
_{MsgAdminUserPostAddress} -
- #{isAutomatic postalAutomatic} # - #{addr} +
+ #{addr} # + #{isAutomatic postalAutomatic} $if (not postalAutomatic) $maybe postUpdate <- userPostLastUpdate
@@ -69,9 +69,9 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
_{MsgUserDisplayEmail}
- $maybe primaryEmail <- actualDisplayEmail - #{isAutomatic emailAutomatic} # - #{mailtoHtml primaryEmail} + $maybe primaryEmail <- actualDisplayEmail + #{mailtoHtml primaryEmail} # + #{isAutomatic emailAutomatic} $nothing ^{messageTooltip tooltipInvalidEmail} # #{mailtoHtml userDisplayEmail} @@ -113,7 +113,7 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
_{MsgCompany}
- ^{toWgt (mconcat companies)} + ^{mconcat companies} $if numSupervisors > 0
_{MsgProfileSupervisor} $if numSupervisors > 3 From 5b9d757ca4ba3d3f9066d82ac119b674e8ab4203 Mon Sep 17 00:00:00 2001 From: Steffen Date: Fri, 7 Jun 2024 12:57:35 +0200 Subject: [PATCH 3/6] chore(avs): person search triggers status and contact search for unique results for added convenience --- src/Handler/Admin/Avs.hs | 49 ++++++++++++++++++++++++---------------- templates/avs.hamlet | 4 ++++ 2 files changed, 33 insertions(+), 20 deletions(-) diff --git a/src/Handler/Admin/Avs.hs b/src/Handler/Admin/Avs.hs index 82d739bb8..d117376e8 100644 --- a/src/Handler/Admin/Avs.hs +++ b/src/Handler/Admin/Avs.hs @@ -93,7 +93,7 @@ validateAvsQueryPerson = do is _Just avsPersonQueryInternalPersonalNo || is _Just avsPersonQueryVersionNo -makeAvsStatusForm :: Maybe AvsQueryStatus -> Form AvsQueryStatus +makeAvsStatusForm :: Maybe AvsPersonId -> Form AvsQueryStatus makeAvsStatusForm tmpl = identifyForm FIDAvsQueryStatus . validateForm validateAvsQueryStatus $ \html -> flip (renderAForm FormStandard) html $ parseAvsIds <$> areq textField (fslI MsgAvsPersonId) (unparseAvsIds <$> tmpl) @@ -103,15 +103,15 @@ makeAvsStatusForm tmpl = identifyForm FIDAvsQueryStatus . validateForm validateA where nonemptys = filter (not . Text.null) $ Text.strip <$> Text.split (==',') txt ids = mapMaybe readMay nonemptys - unparseAvsIds :: AvsQueryStatus -> Text - unparseAvsIds (AvsQueryStatus ids) = Text.intercalate ", " $ tshow <$> Set.toAscList ids + unparseAvsIds :: AvsPersonId -> Text + unparseAvsIds = tshow . avsPersonId validateAvsQueryStatus :: FormValidator AvsQueryStatus Handler () validateAvsQueryStatus = do AvsQueryStatus ids <- State.get guardValidation (MsgAvsQueryStatusInvalid $ tshow ids) $ not (null ids) -makeAvsContactForm :: Maybe AvsQueryContact -> Form AvsQueryContact +makeAvsContactForm :: Maybe AvsPersonId -> Form AvsQueryContact makeAvsContactForm tmpl = identifyForm FIDAvsQueryContact . validateForm validateAvsQueryContact $ \html -> flip (renderAForm FormStandard) html $ parseAvsIds <$> areq textField (fslI MsgAvsPersonId) (unparseAvsIds <$> tmpl) -- consider using cfAnySeparatedSet here @@ -121,8 +121,9 @@ makeAvsContactForm tmpl = identifyForm FIDAvsQueryContact . validateForm validat where nonemptys = filter (not . Text.null) $ Text.strip <$> Text.split (==',') txt ids = mapMaybe (fmap AvsObjPersonId . readMay) nonemptys - unparseAvsIds :: AvsQueryContact -> Text - unparseAvsIds (AvsQueryContact ids) = Text.intercalate ", " $ tshow <$> Set.toAscList ids + unparseAvsIds :: AvsPersonId -> Text + unparseAvsIds = tshow . avsPersonId + --unparseAvsIds (AvsQueryContact ids) = Text.intercalate ", " $ tshow <$> Set.toAscList ids validateAvsQueryContact :: FormValidator AvsQueryContact Handler () validateAvsQueryContact = do @@ -161,19 +162,26 @@ postAdminAvsR = do ((presult, pwidget), penctype) <- runFormPost $ makeAvsPersonForm Nothing - let procFormPerson fr = do + let procFormPerson :: AvsQueryPerson -> Handler (Maybe (Maybe Widget, Maybe AvsPersonId)) + procFormPerson fr = do addMessage Info $ text2Html $ "Query: " <> tshow (toJSON fr) - tryShow $ do - AvsResponsePerson pns <- avsQuery fr - return [whamlet| -