chore: create ExamRoomCapacity-type
_examRoomCapacityIso for convenience
This commit is contained in:
parent
9ce54efd28
commit
d3661b69fd
@ -19,6 +19,8 @@ module Model.Types.Exam
|
|||||||
, _examOccurrenceMappingRule
|
, _examOccurrenceMappingRule
|
||||||
, _examOccurrenceMappingMapping
|
, _examOccurrenceMappingMapping
|
||||||
, traverseExamOccurrenceMapping
|
, traverseExamOccurrenceMapping
|
||||||
|
, ExamOccurrenceCapacity(..)
|
||||||
|
, _examOccurrenceCapacityIso
|
||||||
, ExamGrade(..)
|
, ExamGrade(..)
|
||||||
, numberGrade
|
, numberGrade
|
||||||
, ExamGradeDefCenter(..)
|
, ExamGradeDefCenter(..)
|
||||||
@ -225,6 +227,33 @@ traverseExamOccurrenceMapping :: Ord roomId'
|
|||||||
=> Traversal (ExamOccurrenceMapping roomId) (ExamOccurrenceMapping roomId') roomId roomId'
|
=> Traversal (ExamOccurrenceMapping roomId) (ExamOccurrenceMapping roomId') roomId roomId'
|
||||||
traverseExamOccurrenceMapping = _examOccurrenceMappingMapping . iso Map.toList (Map.fromListWith Set.union) . traverse . _1
|
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
|
data ExamGrade
|
||||||
= Grade50
|
= Grade50
|
||||||
|
|||||||
Reference in New Issue
Block a user