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) postprocess result = seq resultAscList (resultAscList, resultUsers)
where where
maxTagLength :: Int
maxTagLength = maximum $ map (length . snd) result
rangeAlphabet :: [CI Char] rangeAlphabet :: [CI Char]
rangeAlphabet rangeAlphabet = case rule of
| ExamRoomSurname <- rule ExamRoomSurname -> map CI.mk ['A'..'Z']
= map CI.mk ['A'..'Z'] -- ExamRoomSurname -> map CI.mk [c | c <- universeF, isPrint c] -- all printable unicode characters
| ExamRoomMatriculation <- rule ExamRoomMatriculation-> map CI.mk ['0'..'9']
= map CI.mk ['0'..'9'] _rule -> []
| otherwise
= []
resultAscList :: Map ExamOccurrenceId (Set ExamOccurrenceMappingDescription) resultAscList :: Map ExamOccurrenceId (Set ExamOccurrenceMappingDescription)
resultAscList = case fromNullable rangeAlphabet of resultAscList = case fromNullable rangeAlphabet of
@ -559,8 +560,12 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
eaomrEnd = replicate (length start) $ last alphabet eaomrEnd = replicate (length start) $ last alphabet
go start acc ((_occurrenceId, []):t) = go start acc t go start acc ((_occurrenceId, []):t) = go start acc t
go start acc ((occurrenceId, userTags):t) go start acc ((occurrenceId, userTags):t)
| matchMappingDescription mappingDescription userTags = go nextStart ((occurrenceId, mappingDescription) : acc) t | matchMappingDescription mappingDescription userTags
| otherwise = go (impureNonNull $ replicate (succ $ length start) $ head alphabet) [] result = go nextStart ((occurrenceId, mappingDescription) : acc) t
| length start < maxTagLength
= go (impureNonNull $ replicate (succ $ length start) $ head alphabet) [] result
| otherwise
= Map.empty
where where
mappingDescription :: ExamOccurrenceMappingDescription mappingDescription :: ExamOccurrenceMappingDescription
mappingDescription = ExamOccurrenceMappingRange (toNullable start) end mappingDescription = ExamOccurrenceMappingRange (toNullable start) end
@ -595,7 +600,14 @@ examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences
= nextChar : cs = nextChar : cs
where where
nextChar :: CI Char 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 :: (MonoFoldable f) => f -> [CI Char] -> [CI Char]
transformTag (length -> l) tag = case rule of transformTag (length -> l) tag = case rule of