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

chore(test): abuse Show+Enum+Bounded for more concise test specification

Browse Source
This commit is contained in:
Wolfgang Witt 2021-02-01 15:58:50 +01:00 committed by Wolfgang Witt
parent 4fc05351fa
commit abb2342ab5
1 changed files with 11 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
test/Handler/Utils/ExamSpec.hs
View File

@ -1,5 +1,3 @@
{-# OPTIONS_GHC -Wwarn #-}
module Handler.Utils.ExamSpec where
import TestImport
@ -9,6 +7,7 @@ import ModelSpec () -- instance Arbitrary User
import Test.Hspec.QuickCheck (prop)
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.CaseInsensitive as CI
@ -30,8 +29,10 @@ instance Arbitrary ExamOccurrence where
data Preselection = NoPreselection | SomePreselection
deriving (Show, Bounded, Enum)
data Nudges = NoNudges | SmallNudges | LargeNudges
deriving (Show, Bounded, Enum)
-- function Handler.Utils.examAutoOccurrence
-- examAutoOccurrence :: forall seed.
@ -49,19 +50,9 @@ spec = do
describe "Surname" $ do
let rule :: ExamOccurrenceRule
rule = ExamRoomSurname
describe "No Nudges" $ do
let nudges = NoNudges
prop "no preselected" $ propertyTest rule nudges NoPreselection
prop "some preselected" $ propertyTest rule nudges SomePreselection
describe "Small Nudges" $ do
let nudges = SmallNudges
prop "no preselected" $ propertyTest rule nudges NoPreselection
prop "some preselected" $ propertyTest rule nudges SomePreselection
describe "Large Nudges" $ do
let nudges = LargeNudges
prop "no preselected" $ propertyTest rule nudges NoPreselection
prop "some preselected" $ propertyTest rule nudges SomePreselection
-- TODO test with some users fixed/preselected to certain rooms
forM_ [minBound .. maxBound] $ \nudges -> describe (show nudges) $
forM_ [minBound .. maxBound] $ \preselection ->
prop (show preselection) $ propertyTest rule nudges preselection
-- TODO test with ExamRoomManual, ExamRoomFifo, (ExamRoomSurname), ExamRoomMatriculation, ExamRoomRandom
where
seed :: ()
@ -87,7 +78,7 @@ spec = do
shouldBe (length userMap) (length users)
shouldSatisfy userMap $ all isJust
-- no room is overfull
shouldSatisfy (occurrences, userMap) $ uncurry fitsInRooms
shouldSatisfy (occurrences, userMap) $ uncurry $ fitsInRooms users
-- all users match the shown ranges
shouldSatisfy (users, result) $ uncurry showsCorrectRanges
-- | generate users without any pre-assigned rooms
@ -141,16 +132,18 @@ spec = do
appendJust Nothing _userId = id
appendJust (Just occurrenceId) userId = Map.insertWith (++) occurrenceId [userId]
-- | Are all rooms large enough to hold all assigned Users?
fitsInRooms :: Map ExamOccurrenceId Natural
fitsInRooms :: Map UserId (User, Maybe ExamOccurrenceId)
-> Map ExamOccurrenceId Natural
-> Map UserId (Maybe ExamOccurrenceId)
-> Bool
fitsInRooms occurrences userMap
fitsInRooms users occurrences userMap
= all roomIsBigEnough $ Map.toAscList $ occurrenceMap userMap
where
roomIsBigEnough :: (ExamOccurrenceId, [UserId]) -> Bool
roomIsBigEnough (roomId, userIds) = case lookup roomId occurrences of
Nothing -> False
(Just capacity) -> length userIds <= fromIntegral capacity
|| all (isJust . snd) (Map.restrictKeys users $ Set.fromList userIds)
-- | Does the (currently surname) User fit to the displayed ranges?
-- Users with a previously assigned room are checked if the assignment stays the same, regardless of the ranges.
showsCorrectRanges :: Map UserId (User, Maybe ExamOccurrenceId)