chore(test): inform test about changed type signature

src/Handler/Utils/Exam.hs

@@ -9,6 +9,7 @@ module Handler.Utils.Exam
   , ExamAutoOccurrenceConfig
   , eaocMinimizeRooms, eaocFinenessCost, eaocNudge, eaocNudgeSize
   , _eaocMinimizeRooms, _eaocFinenessCost, _eaocNudge, _eaocNudgeSize
+  , ExamAutoOccurrenceException(..)
   , examAutoOccurrence
   , deregisterExamUsersCount, deregisterExamUsers
   , examAidsPresetWidget, examOnlinePresetWidget, examSynchronicityPresetWidget, examRequiredEquipmentPresetWidget

test/Handler/Utils/ExamSpec.hs

@@ -90,15 +90,6 @@ instance Show UserProperties where
         ++ ", userMatrikelnummer=" ++ show userMatrikelnummer ++ "}"
 
 -- function Handler.Utils.examAutoOccurrence
--- examAutoOccurrence :: forall seed.
---                       Hashable seed
---                    => seed
---                    -> ExamOccurrenceRule
---                    -> ExamAutoOccurrenceConfig
---                    -> Map ExamOccurrenceId Natural
---                    -> Map UserId (User, Maybe ExamOccurrenceId)
---                    -> (Maybe (ExamOccurrenceMapping ExamOccurrenceId), Map UserId (Maybe ExamOccurrenceId))
--- examAutoOccurrence (hash -> seed) rule ExamAutoOccurrenceConfig{..} occurrences users
 spec :: Spec
 spec = do
     describe "examAutoOccurrence" $ do
@@ -125,16 +116,16 @@ spec = do
                                 in foldM (genNudge nudgeFrequency) Map.empty $ Map.keys occurrences
             let config :: ExamAutoOccurrenceConfig
                 config = def {eaocNudge}
-                (maybeMapping, userMap) = examAutoOccurrence seed rule config occurrences users
+                autoOccurrenceResult = examAutoOccurrence seed rule config occurrences users
             pure $ ioProperty $ do
-                -- user count stays constant
-                myAnnotate "number of users changed" $ shouldBe (length userMap) (length users)
-                -- no room is overfull
                 let userProperties :: Map UserId (UserProperties, Maybe ExamOccurrenceId)
                     userProperties = Map.map (first UserProperties) users
-                myAnnotate "room capacity exceeded" $ shouldSatisfy (userProperties, occurrences, userMap) $ uncurry3 fitsInRooms
+                case autoOccurrenceResult of
-                case maybeMapping of
+                    (Right (occurrenceMapping, userMap)) -> do
-                    (Just occurrenceMapping) -> do
+                        -- user count stays constant
+                        myAnnotate "number of users changed" $ shouldBe (length userMap) (length users)
+                        -- no room is overfull
+                        myAnnotate "room capacity exceeded" $ shouldSatisfy (userProperties, occurrences, userMap) $ uncurry3 fitsInRooms
                         -- mapping is a valid description
                         myAnnotate "invalid mapping description" $ shouldSatisfy (rule, occurrenceMapping) $ uncurry validRangeDescription
                         -- every (relevant) user got assigned a room
@@ -151,10 +142,10 @@ spec = do
                         myAnnotate "shown ranges don't match userMap"
                             $ shouldSatisfy (rule, userProperties, occurrenceMapping, userMap) $ uncurry4 showsCorrectRanges
                     -- is a nullResult justified?
-                    Nothing -> 
+                    (Left autoOccurrenceException) -> 
                         -- disabled for now, probably not correct with the current implementation
                         myAnnotate "unjustified nullResult"
-                            $ shouldSatisfy (rule, userProperties, occurrences) $ uncurry3 isNullResultJustified
+                            $ shouldSatisfy (autoOccurrenceException, rule, userProperties, occurrences) $ uncurry4 isNullResultJustified
         -- | generate users without any pre-assigned rooms
         genUsersWithOccurrences :: Preselection -> Gen (Map UserId (User, Maybe ExamOccurrenceId), Map ExamOccurrenceId Natural)
         genUsersWithOccurrences preselection = do
@@ -234,9 +225,11 @@ spec = do
                 endAfterStart
                     ExamOccurrenceMappingRange {eaomrStart=(pack . map CI.foldedCase -> start), eaomrEnd=(pack . map CI.foldedCase -> end)}
                     = RFC5051.compareUnicode start end /= GT
-                endAfterStart ExamOccurrenceMappingSpecial {} = True
+                endAfterStart _mappingDescription = True
                 -- also check for equal length with ExamRoomMatriculation
                 noDirectOverlap :: ExamOccurrenceMappingDescription -> ExamOccurrenceMappingDescription -> Bool
+                noDirectOverlap ExamOccurrenceMappingRandom other = other == ExamOccurrenceMappingRandom
+                noDirectOverlap other ExamOccurrenceMappingRandom = other == ExamOccurrenceMappingRandom
                 noDirectOverlap
                     ExamOccurrenceMappingRange {eaomrStart=cs0@(pack . map CI.foldedCase -> s0), eaomrEnd=ce0@(pack . map CI.foldedCase -> e0)} 
                     ExamOccurrenceMappingRange {eaomrStart=cs1@(pack . map CI.foldedCase -> s1), eaomrEnd=ce1@(pack . map CI.foldedCase -> e1)}
@@ -294,6 +287,7 @@ spec = do
                                     _rule -> Nothing
                                 fitsInRange :: ExamOccurrenceMappingDescription -> Bool
                                 fitsInRange mappingDescription = case (ciTag, mappingDescription) of
+                                    (_tag, ExamOccurrenceMappingRandom) -> True
                                     (Nothing, _mappingDescription) -> True
                                     (Just tag, ExamOccurrenceMappingRange {eaomrStart=(pack . map CI.foldedCase -> start), eaomrEnd=(pack . map CI.foldedCase-> end)})
                                         -> (RFC5051.compareUnicode start (pack $ map CI.foldedCase $ transformTag start tag) /= GT)
@@ -309,25 +303,37 @@ spec = do
                                     ExamRoomMatriculation -> isSuffixOf
                                     _rule -> isPrefixOf
                         _otherwise -> (rule /= ExamRoomSurname) && (rule /= ExamRoomMatriculation)
-        -- | Is mapping impossible?
+        -- | Is mapping impossible due to the given reason?
-        isNullResultJustified :: ExamOccurrenceRule
+        isNullResultJustified :: ExamAutoOccurrenceException
+                                -> ExamOccurrenceRule
                                 -> Map UserId (UserProperties, Maybe ExamOccurrenceId)
                                 -> Map ExamOccurrenceId Natural -> Bool
-        isNullResultJustified rule userProperties occurrences
+        isNullResultJustified ExamAutoOccurrenceExceptionRuleNoOp rule _userProperties _occurrences
-            = noRelevantUsers rule userProperties || mappingImpossible rule userProperties occurrences || True
+            = not $ examOccurrenceRuleAutomatic rule
+        isNullResultJustified ExamAutoOccurrenceExceptionNotEnoughSpace rule userProperties occurrences
+            = fromIntegral (length $ relevantUsers rule userProperties) > sum occurrences
+        isNullResultJustified ExamAutoOccurrenceExceptionNoUsers rule userProperties _occurrences
+            = noRelevantUsers rule userProperties
+        isNullResultJustified ExamAutoOccurrenceExceptionRoomTooSmall rule userProperties occurrences
+            = mappingImpossible rule userProperties occurrences
         noRelevantUsers :: ExamOccurrenceRule -> Map UserId (UserProperties, Maybe ExamOccurrenceId) -> Bool
-        noRelevantUsers rule = null . Map.filter (isRelevantUser rule)
+        noRelevantUsers rule = null . relevantUsers rule
+        relevantUsers  :: ExamOccurrenceRule
+                        -> Map UserId (UserProperties, Maybe ExamOccurrenceId)
+                        -> Map UserId (UserProperties, Maybe ExamOccurrenceId)
+        relevantUsers rule = Map.filter $ isRelevantUser rule
         isRelevantUser :: ExamOccurrenceRule -> (UserProperties, Maybe ExamOccurrenceId) -> Bool
         isRelevantUser _rule (_user, Just _assignedRoom) = False
         isRelevantUser rule (UserProperties User {userSurname, userMatrikelnummer}, Nothing) = case rule of
             ExamRoomSurname -> not $ null userSurname
             ExamRoomMatriculation -> maybe False (not . null) userMatrikelnummer
+            ExamRoomRandom -> True
             _rule -> False
         mappingImpossible :: ExamOccurrenceRule -> Map UserId (UserProperties, Maybe ExamOccurrenceId) -> Map ExamOccurrenceId Natural -> Bool
         mappingImpossible
             rule
-            userProperties@(sort . map (ruleProperty rule . fst) . Map.elems . Map.filter (isRelevantUser rule) -> relevantUsers)
+            userProperties@(sort . map (ruleProperty rule . fst) . Map.elems . relevantUsers rule -> users')
-            (map snd . Map.toList . adjustOccurrences userProperties -> occurrences') = go 0 relevantUsers occurrences'
+            (map snd . Map.toList . adjustOccurrences userProperties -> occurrences') = go 0 users' occurrences'
             where
                 smallestRoom :: Natural
                 smallestRoom = maybe 0 minimum $ fromNullable occurrences'