diff --git a/src/Model/Types/Exam.hs b/src/Model/Types/Exam.hs index 3910f402a..b63f21159 100644 --- a/src/Model/Types/Exam.hs +++ b/src/Model/Types/Exam.hs @@ -19,6 +19,8 @@ module Model.Types.Exam , _examOccurrenceMappingRule , _examOccurrenceMappingMapping , traverseExamOccurrenceMapping + , ExamOccurrenceCapacity(..) + , _examOccurrenceCapacityIso , ExamGrade(..) , numberGrade , ExamGradeDefCenter(..) @@ -225,6 +227,33 @@ traverseExamOccurrenceMapping :: Ord roomId' => Traversal (ExamOccurrenceMapping roomId) (ExamOccurrenceMapping roomId') roomId roomId' traverseExamOccurrenceMapping = _examOccurrenceMappingMapping . iso Map.toList (Map.fromListWith Set.union) . traverse . _1 +-- | Natural extended by representation for Infinity. +-- +-- Maybe doesn't work, because the 'Ord' instance puts 'Nothing' below 0 +-- instead of above every other number. +data ExamOccurrenceCapacity = Unrestricted | Restricted Natural + deriving (Show, Eq) + +-- | Unrestricted is bigger then everything else, otherwise use instance from 'Natural'. +instance Ord ExamOccurrenceCapacity where + compare Unrestricted Unrestricted = EQ + compare Unrestricted (Restricted _n) = GT + compare (Restricted _n) Unrestricted = LT + compare (Restricted a) (Restricted b) = compare a b + +-- | Addition monoid with 'Unrestricted' interpreted as infinity. +instance Semigroup ExamOccurrenceCapacity where + (<>) Unrestricted _b = Unrestricted + (<>) _a Unrestricted = Unrestricted + (<>) (Restricted a) (Restricted b) = Restricted $ a + b + +-- | Addition monoid with 'Unrestricted' interpreted as infinity. +instance Monoid ExamOccurrenceCapacity where + mempty = Restricted 0 + +_examOccurrenceCapacityIso :: Iso' ExamOccurrenceCapacity (Maybe Natural) +_examOccurrenceCapacityIso = iso (\case {Unrestricted -> Nothing; Restricted n -> Just n}) + (\case {Nothing -> Unrestricted; Just n -> Restricted n}) data ExamGrade = Grade50