fix(exam-form): sort occurrences and parts

This commit is contained in:
Gregor Kleen 2020-09-18 15:16:55 +02:00
parent d8d6ae1ce1
commit 6d475497c0
3 changed files with 64 additions and 2 deletions

View File

@ -52,7 +52,18 @@ data ExamOccurrenceForm = ExamOccurrenceForm
, eofStart :: UTCTime , eofStart :: UTCTime
, eofEnd :: Maybe UTCTime , eofEnd :: Maybe UTCTime
, eofDescription :: Maybe Html , 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 data ExamPartForm = ExamPartForm
{ epfId :: Maybe CryptoUUIDExamPart { epfId :: Maybe CryptoUUIDExamPart
@ -60,7 +71,16 @@ data ExamPartForm = ExamPartForm
, epfName :: Maybe ExamPartName , epfName :: Maybe ExamPartName
, epfMaxPoints :: Maybe Points , epfMaxPoints :: Maybe Points
, epfWeight :: Rational , 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 makeLenses_ ''ExamForm

View File

@ -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 ]

View File

@ -37,6 +37,8 @@ import Data.Word.Word24
import qualified Data.Binary as Binary import qualified Data.Binary as Binary
import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy as LBS
import qualified Data.CaseInsensitive as CI
instance (Arbitrary a, MonoFoldable a) => Arbitrary (NonNull a) where instance (Arbitrary a, MonoFoldable a) => Arbitrary (NonNull a) where
arbitrary = arbitrary `suchThatMap` fromNullable arbitrary = arbitrary `suchThatMap` fromNullable
@ -287,6 +289,9 @@ instance Arbitrary Sex where
instance Arbitrary Word24 where instance Arbitrary Word24 where
arbitrary = arbitraryBoundedRandom arbitrary = arbitraryBoundedRandom
instance Arbitrary ExamPartNumber where
arbitrary = review _ExamPartNumber . CI.mk . pack . getPrintableString <$> arbitrary
shrink = map (review _ExamPartNumber) . shrink . view _ExamPartNumber
spec :: Spec spec :: Spec
@ -380,6 +385,8 @@ spec = do
[ eqLaws, ordLaws, showReadLaws, boundedEnumLaws, finiteLaws, pathPieceLaws ] [ eqLaws, ordLaws, showReadLaws, boundedEnumLaws, finiteLaws, pathPieceLaws ]
lawsCheckHspec (Proxy @Word24) lawsCheckHspec (Proxy @Word24)
[ persistFieldLaws, jsonLaws, binaryLaws ] [ persistFieldLaws, jsonLaws, binaryLaws ]
lawsCheckHspec (Proxy @ExamPartNumber)
[ persistFieldLaws, jsonLaws, pathPieceLaws, csvFieldLaws, eqLaws, ordLaws ]
describe "TermIdentifier" $ do describe "TermIdentifier" $ do
it "has compatible encoding/decoding to/from Text" . property $ it "has compatible encoding/decoding to/from Text" . property $