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

fix(widgets): fix erroneous whitespace in name widget

Browse Source
This commit is contained in:
Steffen Jost 2025-02-24 15:34:04 +01:00
parent c51fb7ea7d
commit 89b0d87bde
1 changed files with 11 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/Handler/Utils/Widgets.hs
View File

@ -1,4 +1,4 @@
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
-- SPDX-FileCopyrightText: 2022-25 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later
@ -99,14 +99,14 @@ nameHtml displayName surname
in [shamlet|$newline never
#{prefix} #
<b .surname>#{surname}
\ #{suffix}
#{withLeadingSpace suffix}
|]
| (suffix:prefixes) <- reverse $ T.splitOn (fullyNormalize surname) (fullyNormalize displayName), notNull prefixes ->
let prefix = T.intercalate surname $ reverse prefixes
in [shamlet|$newline never
#{prefix} #
<b .surname>#{surname}
\ #{suffix}
#{withLeadingSpace suffix}
|]
| otherwise -> [shamlet|$newline never
#{displayName} (
@ -115,15 +115,21 @@ nameHtml displayName surname
(suffix:prefixes) ->
let prefix = T.intercalate surname $ reverse prefixes
in [shamlet|$newline never
#{prefix} #
#{prefix}
<b .surname>#{surname}
\ #{suffix}
#{withLeadingSpace suffix}
|]
[] -> error "Data.Text.splitOn returned empty list in violation of specification."
where
fullyNormalize :: Text -> Text
fullyNormalize = T.toTitle . T.unwords . map text2asciiAlphaNum . T.words
withLeadingSpace :: Text -> Text
withLeadingSpace t
| T.null t = t
| Just (' ', _) <- T.uncons t = t
| otherwise = T.cons ' ' t
nameHtml' :: HasUser u => u -> Html
nameHtml' u = nameHtml (u ^. _userDisplayName) (u ^. _userSurname)