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:
parent
4f4cd394db
commit
7e1b75c2e1
@ -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
Loading…
Reference in New Issue
Block a user