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

fix: ensure termination for non-{'A'..'Z']-names

Browse Source
This commit is contained in:
Wolfgang Witt 2021-02-11 15:36:20 +01:00 committed by Wolfgang Witt
parent dbd7726bbb
commit 873d5a02ad
1 changed files with 22 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -534,14 +534,15 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
)
postprocess result = seq resultAscList (resultAscList, resultUsers)
where
maxTagLength :: Int
maxTagLength = maximum $ map (length . snd) result
rangeAlphabet :: [CI Char]
rangeAlphabet
| ExamRoomSurname <- rule
= map CI.mk ['A'..'Z']
| ExamRoomMatriculation <- rule
= map CI.mk ['0'..'9']
| otherwise
= []
rangeAlphabet = case rule of
ExamRoomSurname -> map CI.mk ['A'..'Z']
-- ExamRoomSurname -> map CI.mk [c | c <- universeF, isPrint c] -- all printable unicode characters
ExamRoomMatriculation-> map CI.mk ['0'..'9']
_rule -> []
resultAscList :: Map ExamOccurrenceId (Set ExamOccurrenceMappingDescription)
resultAscList = case fromNullable rangeAlphabet of
@ -559,8 +560,12 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
eaomrEnd = replicate (length start) $ last alphabet
go start acc ((_occurrenceId, []):t) = go start acc t
go start acc ((occurrenceId, userTags):t)
| matchMappingDescription mappingDescription userTags = go nextStart ((occurrenceId, mappingDescription) : acc) t
| otherwise = go (impureNonNull $ replicate (succ $ length start) $ head alphabet) [] result
| matchMappingDescription mappingDescription userTags
= go nextStart ((occurrenceId, mappingDescription) : acc) t
| length start < maxTagLength
= go (impureNonNull $ replicate (succ $ length start) $ head alphabet) [] result
| otherwise
= Map.empty
where
mappingDescription :: ExamOccurrenceMappingDescription
mappingDescription = ExamOccurrenceMappingRange (toNullable start) end
@ -595,7 +600,14 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
= nextChar : cs
where
nextChar :: CI Char
nextChar = dropWhile (/= c) alphabetCycle List.!! 1
nextChar
| c `elem` alphabet
= dropWhile (/= c) alphabetCycle List.!! 1
| c < head alphabet -- includes padding char
= head alphabet
| c > last alphabet -- basically all non-ascii printable characters
= head alphabet
-- TODO what if the border is between to non-ascii characters?
transformTag :: (MonoFoldable f) => f -> [CI Char] -> [CI Char]
transformTag (length -> l) tag = case rule of