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 committed by Sarah Vaupel
parent 1f484f7781
commit d7dcf0acf5
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 -- SPDX-License-Identifier: AGPL-3.0-or-later
@ -99,14 +99,14 @@ nameHtml displayName surname
in [shamlet|$newline never in [shamlet|$newline never
#{prefix} # #{prefix} #
<b .surname>#{surname} <b .surname>#{surname}
\ #{suffix} #{withLeadingSpace suffix}
|] |]
| (suffix:prefixes) <- reverse $ T.splitOn (fullyNormalize surname) (fullyNormalize displayName), notNull prefixes -> | (suffix:prefixes) <- reverse $ T.splitOn (fullyNormalize surname) (fullyNormalize displayName), notNull prefixes ->
let prefix = T.intercalate surname $ reverse prefixes let prefix = T.intercalate surname $ reverse prefixes
in [shamlet|$newline never in [shamlet|$newline never
#{prefix} # #{prefix} #
<b .surname>#{surname} <b .surname>#{surname}
\ #{suffix} #{withLeadingSpace suffix}
|] |]
| otherwise -> [shamlet|$newline never | otherwise -> [shamlet|$newline never
#{displayName} ( #{displayName} (
@ -115,15 +115,21 @@ nameHtml displayName surname
(suffix:prefixes) -> (suffix:prefixes) ->
let prefix = T.intercalate surname $ reverse prefixes let prefix = T.intercalate surname $ reverse prefixes
in [shamlet|$newline never in [shamlet|$newline never
#{prefix} # #{prefix}
<b .surname>#{surname} <b .surname>#{surname}
\ #{suffix} #{withLeadingSpace suffix}
|] |]
[] -> error "Data.Text.splitOn returned empty list in violation of specification." [] -> error "Data.Text.splitOn returned empty list in violation of specification."
where where
fullyNormalize :: Text -> Text fullyNormalize :: Text -> Text
fullyNormalize = T.toTitle . T.unwords . map text2asciiAlphaNum . T.words 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' :: HasUser u => u -> Html
nameHtml' u = nameHtml (u ^. _userDisplayName) (u ^. _userSurname) nameHtml' u = nameHtml (u ^. _userDisplayName) (u ^. _userSurname)