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

chore: include non-ascii names in range-calculation

Browse Source
This commit is contained in:
Wolfgang Witt 2021-02-19 16:28:56 +01:00 committed by Wolfgang Witt
parent 8e4cb0917d
commit a559ac74cb
1 changed files with 23 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
src/Handler/Utils/Exam.hs
View File

@ -583,14 +583,33 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
specialMapping = [ExamOccurrenceMappingSpecial $ transformTag borderLength tag | tag <- specialTags] specialMapping = [ExamOccurrenceMappingSpecial $ transformTag borderLength tag | tag <- specialTags]
alphabetTags, specialTags :: [[CI Char]] alphabetTags, specialTags :: [[CI Char]]
(alphabetTags, specialTags) = partition (all (`elem` alphabet) . take (length start)) userTags (alphabetTags, specialTags) = partition (all (`elem` alphabet) . transformTag borderLength) userTags
-- | pre/suffix of largest user tag -- | pre/suffix of largest user tag
-- special (i.e. non-ascii) tags use the largest smaller ascii-char according to RFC5051.compareUnicode
maybeEnd :: Maybe [CI Char] maybeEnd :: Maybe [CI Char]
maybeEnd = case t of maybeEnd = case t of
-- TODO account for special tags
-- e.g. don't stop at T if Ù is in the special prefix set
[] -> Just $ replicate borderLength $ last alphabet [] -> Just $ replicate borderLength $ last alphabet
_nonEmpty -> transformTag borderLength . maximum <$> fromNullable alphabetTags _nonEmpty -> max alphabetEnd specialEnd
where
alphabetEnd :: Maybe [CI Char]
alphabetEnd = transformTag borderLength . maximum <$> fromNullable alphabetTags
specialEnd :: Maybe [CI Char]
specialEnd
= withAlphabetChars
. transformTag borderLength
. maximumBy (\a b -> RFC5051.compareUnicode (pack $ map CI.foldedCase a) (pack $ map CI.foldedCase b))
<$> fromNullable specialTags
withAlphabetChars :: [CI Char] -> [CI Char]
withAlphabetChars [] = []
withAlphabetChars (c:cs)
| elem c alphabet = c : withAlphabetChars cs
| otherwise= case previousAlphabetChar c of
Nothing -> []
(Just c') -> c' : withAlphabetChars cs
previousAlphabetChar :: CI Char -> Maybe (CI Char)
previousAlphabetChar c = fmap last $ fromNullable $ nfilter ((== GT) . compareChars c) alphabet
compareChars :: CI Char -> CI Char -> Ordering
compareChars a b = RFC5051.compareUnicode (pack [CI.foldedCase a]) (pack [CI.foldedCase b])
nextStart :: NonNull [CI Char] nextStart :: NonNull [CI Char]
-- end is guaranteed nonNull, all empty tags are filtered out in users' -- end is guaranteed nonNull, all empty tags are filtered out in users'
nextStart nextStart