fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(messages): Add SomeMessages newtype

Browse Source 
SomeMessages provides a RenderMessage instance for a list of messages.
This commit is contained in:
Steffen Jost 2023-11-27 12:07:17 +01:00
parent 06bb44cf71
commit 640a2e61d1
5 changed files with 24 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
messages/uniworx/utils/utils/de-de-formal.msg
View File

@ -97,6 +97,7 @@ RoomReferenceLinkLinkPlaceholder !ident-ok: URL
RoomReferenceLinkInstructions: Anweisungen
RoomReferenceLinkInstructionsPlaceholder: Anweisungen
UtilEmptyChoice: Auswahl war leer
UtilEmptyNoChangeTip: Eine leere Eingabe belässt den vorherigen Wert unverändert.
#invitation.hs
InvitationAction: Aktion

1
messages/uniworx/utils/utils/en-eu.msg
View File

@ -97,6 +97,7 @@ RoomReferenceLinkLinkPlaceholder: URL
RoomReferenceLinkInstructions: Instructions
RoomReferenceLinkInstructionsPlaceholder: Instructions
UtilEmptyChoice: Empty selection
UtilEmptyNoChangeTip: Existing values remain unchanged if this field is left empty.
#invitation.hs
InvitationAction: Action

14
src/Foundation/I18n.hs
View File

@ -43,6 +43,8 @@ module Foundation.I18n
, UniWorXMessages(..)
, uniworxMessages
, unRenderMessage, unRenderMessage', unRenderMessageLenient
, SomeMessages(..)
, someMessages
, module Foundation.I18n.TH
) where
@ -266,6 +268,18 @@ mkMessageAddition ''UniWorX "Avs" "messages/uniworx/categories/avs" "de-de-forma
embedRenderMessage ''UniWorX ''LmsStatus (uncurry ((<>) . (<> "Status")) . Text.splitAt 3)
newtype SomeMessages master = SomeMessages [SomeMessage master]
deriving newtype (Semigroup, Monoid)
instance master ~ master' => RenderMessage master (SomeMessages master') where
renderMessage a b (SomeMessages msgs) = Text.intercalate " " $ renderMessage a b <$> msgs
-- | convenienience function if all messages happen to belong to the exact same type
someMessages :: RenderMessage master msg => [msg] -> SomeMessages master
someMessages msgs = SomeMessages $ SomeMessage <$> msgs
instance RenderMessage UniWorX (Maybe LmsStatus) where -- useful for Filter with optionsFinite
renderMessage f ls (Just s) = renderMessage f ls s
renderMessage f ls Nothing = renderMessage f ls MsgLmsStateOpen

14
src/Handler/Firm.hs
View File

@ -98,13 +98,13 @@ firmActionMap mr isAdmin acts = mconcat (mkAct isAdmin <$> acts)
<*> areq checkBoxField (fslI MsgTableIsDefaultReroute ) (Just True)
<*> aopt postalEmailField (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip) Nothing
mkAct _ FirmActChangeContactFirm = singletonMap FirmActChangeContactFirm $ FirmActChangeContactFirmData
<$> aopt htmlField (fslI MsgPostAddress & setTooltip MsgPostAddressTip) Nothing
<*> aopt (emailField & cfStrip & cfCI) (fslI MsgUserDisplayEmail) Nothing
<*> aopt postalEmailField (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip) Nothing
<$> aopt htmlField (fslI MsgPostAddress & setTooltip (SomeMessages [SomeMessage MsgPostAddressTip, SomeMessage MsgUtilEmptyNoChangeTip])) Nothing
<*> aopt (emailField & cfStrip & cfCI) (fslI MsgUserDisplayEmail & setTooltip MsgUtilEmptyNoChangeTip) Nothing
<*> aopt postalEmailField (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip) Nothing
<* aformMessage (Message Info (toHtml $ mr MsgFirmActChangeContactFirmInfo) (Just IconNotificationNonactive))
mkAct _ FirmActChangeContactUser = singletonMap FirmActChangeContactUser $ FirmActChangeContactUserData
<$> aopt htmlField (fslI MsgPostAddress & setTooltip MsgPostAddressTip) Nothing
<*> aopt postalEmailField (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip) Nothing
<$> aopt htmlField (fslI MsgPostAddress & setTooltip (SomeMessages [SomeMessage MsgPostAddressTip, SomeMessage MsgUtilEmptyNoChangeTip])) Nothing
<*> aopt postalEmailField (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip) Nothing
mkAct _ _ = mempty
firmActionForm :: _ -> Bool -> [FirmAction] -> AForm Handler FirmActionData
@ -803,8 +803,8 @@ mkFirmUserTable isAdmin cid = do
, singletonMap FirmUserActMkSuper $ FirmUserActMkSuperData
<$> aopt checkBoxField (fslI MsgTableIsDefaultReroute) (Just $ Just True)
, singletonMap FirmUserActChangeContact $ FirmUserActChangeContactData
<$> aopt htmlField (fslI MsgPostAddress & setTooltip MsgPostAddressTip) Nothing
<*> aopt postalEmailField (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip) Nothing
<$> aopt htmlField (fslI MsgPostAddress & setTooltip (SomeMessages [SomeMessage MsgPostAddressTip, SomeMessage MsgUtilEmptyNoChangeTip])) Nothing
<*> aopt postalEmailField (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip) Nothing
]
dbtParams = DBParamsForm
{ dbParamsFormMethod = POST

1
src/Handler/Utils/Table/Pagination.hs
View File

@ -1723,6 +1723,7 @@ i18nCell msg = cell $ do
cellTooltip :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a -> DBCell m a
cellTooltip = cellTooltipIcon Nothing
-- note that you can also use `cellTooltip` with `SomeMessages`, which uses ' ' for separation only
cellTooltips :: (RenderMessage UniWorX msg, IsDBTable m a) => [msg] -> DBCell m a -> DBCell m a
cellTooltips msgs = cellTooltipWgt Nothing [whamlet|
$forall msg <- msgs