fix: shown ranges "include" special mappings

previously, they stopped just before leading to clashes with the next range
e.g. Äm would cause Am as mapping end with the next starting at An
Now, the mapping end is AZ with the next starting at BA
This commit is contained in:
Wolfgang Witt 2021-02-24 12:57:37 +01:00 committed by Wolfgang Witt
parent 4f4cd394db
commit 7e1b75c2e1
2 changed files with 31 additions and 49 deletions

View File

@ -597,7 +597,7 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
go start borderLength acc ((_occurrenceId, []):t) = go start borderLength acc t
go start borderLength acc ((occurrenceId, userTags):t)
| matchMappingDescription mappingDescription userTags
&& (null t || Just (toNullable nextStart) > maybeEnd)
&& (null t || toNullable nextStart > end)
= go nextStart borderLength ((occurrenceId, mappingDescription) : acc) t
| borderLength < maxTagLength
= go restartStart restartBorderLength [] result
@ -613,37 +613,33 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
_rule -> singleton $ head alphabet
mappingDescription :: Set ExamOccurrenceMappingDescription
mappingDescription = Set.fromList $ case maybeEnd of
(Just end) -> ExamOccurrenceMappingRange (toNullable start) end : specialMapping
Nothing -> specialMapping
mappingDescription = Set.fromList $ ExamOccurrenceMappingRange (toNullable start) end : specialMapping
specialMapping :: [ExamOccurrenceMappingDescription]
specialMapping = [ExamOccurrenceMappingSpecial $ transformTag borderLength tag | tag <- specialTags]
specialMapping
= [ExamOccurrenceMappingSpecial {eaomrSpecial=tag}
| (transformTag borderLength -> tag) <- userTags
, not $ all (`elem` alphabet) tag]
alphabetTags, specialTags :: [[CI Char]]
(alphabetTags, specialTags) = partition (all (`elem` alphabet) . transformTag borderLength) userTags
-- | 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 = case t of
[] -> Just $ replicate borderLength $ last alphabet
_nonEmpty -> max alphabetEnd specialEnd
-- special (i.e. non-ascii) tags use the largest smaller ascii-char according to RFC5051.compareUnicode,
-- ending the tag with ..ZZZ-padding
end :: [CI Char]
end = case t of
[] -> replicate borderLength $ last alphabet
_nonEmpty -> withAlphabetChars
$ transformTag borderLength
$ maximumBy (\a b -> RFC5051.compareUnicode (pack $ map CI.foldedCase a) (pack $ map CI.foldedCase b))
-- userTags is guaranteed non-null
$ impureNonNull userTags
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
(Just c') -> c' : replicate (length cs) (last alphabet)
previousAlphabetChar :: CI Char -> Maybe (CI Char)
previousAlphabetChar c = fmap last $ fromNullable $ nfilter ((== GT) . compareChars c) alphabet
compareChars :: CI Char -> CI Char -> Ordering
@ -651,11 +647,9 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
nextStart :: NonNull [CI Char]
-- end is guaranteed nonNull, all empty tags are filtered out in users'
nextStart
| Nothing <- maybeEnd
= start
| (Just end) <- maybeEnd, length end < borderLength
| length end < borderLength
= impureNonNull $ end <> [head alphabet]
| (Just end) <- maybeEnd
| otherwise
= impureNonNull $ reverse $ increase $ reverse end
alphabetCycle :: [CI Char]
alphabetCycle = List.cycle $ toNullable alphabet

File diff suppressed because one or more lines are too long