diff --git a/src/Handler/Exam/Form.hs b/src/Handler/Exam/Form.hs index 1bfa7f79a..7674d6ef3 100644 --- a/src/Handler/Exam/Form.hs +++ b/src/Handler/Exam/Form.hs @@ -52,7 +52,18 @@ data ExamOccurrenceForm = ExamOccurrenceForm , eofStart :: UTCTime , eofEnd :: Maybe UTCTime , eofDescription :: Maybe Html - } deriving (Read, Show, Eq, Ord, Generic, Typeable) + } deriving (Read, Show, Eq, Generic, Typeable) + +instance Ord ExamOccurrenceForm where + compare = mconcat + [ comparing eofName + , comparing eofStart + , comparing eofRoom + , comparing eofEnd + , comparing eofCapacity + , comparing eofDescription + , comparing eofId + ] data ExamPartForm = ExamPartForm { epfId :: Maybe CryptoUUIDExamPart @@ -60,7 +71,16 @@ data ExamPartForm = ExamPartForm , epfName :: Maybe ExamPartName , epfMaxPoints :: Maybe Points , epfWeight :: Rational - } deriving (Read, Show, Eq, Ord, Generic, Typeable) + } deriving (Read, Show, Eq, Generic, Typeable) + +instance Ord ExamPartForm where + compare = mconcat + [ comparing epfNumber + , comparing epfName + , comparing epfMaxPoints + , comparing epfWeight + , comparing epfId + ] makeLenses_ ''ExamForm diff --git a/test/Handler/Exam/FormSpec.hs b/test/Handler/Exam/FormSpec.hs new file mode 100644 index 000000000..d49dbac6c --- /dev/null +++ b/test/Handler/Exam/FormSpec.hs @@ -0,0 +1,35 @@ +module Handler.Exam.FormSpec where + +import TestImport +import ModelSpec () +import CryptoID + +import Handler.Exam.Form + + +instance Arbitrary ExamOccurrenceForm where + arbitrary = ExamOccurrenceForm + <$> (fmap (view _2) <$> (arbitrary :: Gen (Maybe (ExamOccurrenceId, CryptoUUIDExamOccurrence)))) + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + +instance Arbitrary ExamPartForm where + arbitrary = ExamPartForm + <$> (fmap (view _2) <$> (arbitrary :: Gen (Maybe (ExamPartId, CryptoUUIDExamPart)))) + <*> arbitrary + <*> arbitrary + <*> arbitrary + <*> arbitrary + + +spec :: Spec +spec = do + parallel $ do + lawsCheckHspec (Proxy @ExamOccurrenceForm) + [ eqLaws, ordLaws, showReadLaws ] + lawsCheckHspec (Proxy @ExamPartForm) + [ eqLaws, ordLaws ] diff --git a/test/Model/TypesSpec.hs b/test/Model/TypesSpec.hs index 9606efd6b..5c975a6d0 100644 --- a/test/Model/TypesSpec.hs +++ b/test/Model/TypesSpec.hs @@ -37,6 +37,8 @@ import Data.Word.Word24 import qualified Data.Binary as Binary import qualified Data.ByteString.Lazy as LBS +import qualified Data.CaseInsensitive as CI + instance (Arbitrary a, MonoFoldable a) => Arbitrary (NonNull a) where arbitrary = arbitrary `suchThatMap` fromNullable @@ -287,6 +289,9 @@ instance Arbitrary Sex where instance Arbitrary Word24 where arbitrary = arbitraryBoundedRandom +instance Arbitrary ExamPartNumber where + arbitrary = review _ExamPartNumber . CI.mk . pack . getPrintableString <$> arbitrary + shrink = map (review _ExamPartNumber) . shrink . view _ExamPartNumber spec :: Spec @@ -380,6 +385,8 @@ spec = do [ eqLaws, ordLaws, showReadLaws, boundedEnumLaws, finiteLaws, pathPieceLaws ] lawsCheckHspec (Proxy @Word24) [ persistFieldLaws, jsonLaws, binaryLaws ] + lawsCheckHspec (Proxy @ExamPartNumber) + [ persistFieldLaws, jsonLaws, pathPieceLaws, csvFieldLaws, eqLaws, ordLaws ] describe "TermIdentifier" $ do it "has compatible encoding/decoding to/from Text" . property $