+ _{MsgRoomReferenceLinkLink}
+$if is _Just roomRefInstructions
+ , ^{instrModal}
diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs
index 180646383..d5949e301 100644
--- a/test/Database/Fill.hs
+++ b/test/Database/Fill.hs
@@ -372,8 +372,8 @@ fillDb = do
, termLectureEnd
, termActive = term >= currentTerm
}
- ifi <- insert' $ School "Institut für Informatik" "IfI" (Just $ 14 * nominalDay) (Just $ 10 * nominalDay) True (ExamModeDNF predDNFFalse)
- mi <- insert' $ School "Institut für Mathematik" "MI" Nothing Nothing False (ExamModeDNF predDNFFalse)
+ ifi <- insert' $ School "Institut für Informatik" "IfI" (Just $ 14 * nominalDay) (Just $ 10 * nominalDay) True (ExamModeDNF predDNFFalse) (ExamCloseOnFinished True)
+ mi <- insert' $ School "Institut für Mathematik" "MI" Nothing Nothing False (ExamModeDNF predDNFFalse) (ExamCloseOnFinished False)
void . insert' $ UserFunction gkleen ifi SchoolAdmin
void . insert' $ UserFunction gkleen mi SchoolAdmin
void . insert' $ UserFunction fhamann ifi SchoolAdmin
@@ -386,6 +386,8 @@ fillDb = do
void . insert' $ UserFunction jost ifi SchoolLecturer
void . insert' $ UserFunction svaupel ifi SchoolLecturer
void . insert' $ UserFunction gkleen ifi SchoolAllocation
+ void . insert' $ UserFunction gkleen ifi SchoolExamOffice
+ void . insert' $ UserFunction gkleen mi SchoolExamOffice
for_ [gkleen, fhamann, jost, maxMuster, svaupel] $ \uid ->
void . insert' $ UserSchool uid ifi False
for_ [gkleen, tinaTester] $ \uid ->
@@ -560,7 +562,7 @@ fillDb = do
nbrs = [1,2,3,27,7,1]
ffp <- insert' Course
{ courseName = "Fortgeschrittene Funktionale Programmierung"
- , courseDescription = Just [shamlet|
+ , courseDescription = Just $ htmlToStoredMarkup [shamlet|
It is fun!
Come to where the functional is!
@@ -911,6 +913,7 @@ fillDb = do
, tutorialType = "Tutorium"
, tutorialCapacity = Just 30
, tutorialRoom = Just "Hilbert-Raum"
+ , tutorialRoomHidden = True
, tutorialTime = Occurrences
{ occurrencesScheduled = Set.singleton $ ScheduleWeekly Tuesday (TimeOfDay 08 15 00) (TimeOfDay 10 00 00)
, occurrencesExceptions = Set.empty
@@ -930,6 +933,7 @@ fillDb = do
, tutorialType = "Tutorium"
, tutorialCapacity = Just 30
, tutorialRoom = Just "Hilbert-Raum"
+ , tutorialRoomHidden = True
, tutorialTime = Occurrences
{ occurrencesScheduled = Set.singleton $ ScheduleWeekly Tuesday (TimeOfDay 10 15 00) (TimeOfDay 12 00 00)
, occurrencesExceptions = Set.empty
diff --git a/test/Handler/Exam/FormSpec.hs b/test/Handler/Exam/FormSpec.hs
index d49dbac6c..100f16aa2 100644
--- a/test/Handler/Exam/FormSpec.hs
+++ b/test/Handler/Exam/FormSpec.hs
@@ -16,6 +16,7 @@ instance Arbitrary ExamOccurrenceForm where
<*> arbitrary
<*> arbitrary
<*> arbitrary
+ <*> arbitrary
instance Arbitrary ExamPartForm where
arbitrary = ExamPartForm
@@ -30,6 +31,6 @@ spec :: Spec
spec = do
parallel $ do
lawsCheckHspec (Proxy @ExamOccurrenceForm)
- [ eqLaws, ordLaws, showReadLaws ]
+ [ eqLaws, ordLaws ]
lawsCheckHspec (Proxy @ExamPartForm)
[ eqLaws, ordLaws ]
diff --git a/test/Model/TypesSpec.hs b/test/Model/TypesSpec.hs
index 69db4d2f6..145febcf7 100644
--- a/test/Model/TypesSpec.hs
+++ b/test/Model/TypesSpec.hs
@@ -42,6 +42,9 @@ import Model.Types.WorkflowSpec as Model.TypesSpec ()
import Text.Blaze.TestInstances ()
+import qualified Data.Text.Lazy as LT
+
+
instance Arbitrary Season where
arbitrary = genericArbitrary
@@ -213,6 +216,16 @@ instance {-# OVERLAPPABLE #-} ToBackendKey SqlBackend record => Arbitrary (Key r
arbitrary = toSqlKey <$> arbitrary
shrink = map toSqlKey . shrink . fromSqlKey
+instance Arbitrary Html where
+ arbitrary = (preEscapedToHtml :: String -> Html) . getPrintableString <$> arbitrary
+ shrink = map preEscapedToHtml . shrink . renderHtml
+
+instance Arbitrary StoredMarkup where
+ arbitrary = (`suchThat` (not . null . LT.strip . renderHtml . markupOutput)) $ oneof
+ [ htmlToStoredMarkup <$> arbitrary
+ , plaintextToStoredMarkup . getPrintableString <$> arbitrary
+ ]
+
instance Arbitrary OccurrenceSchedule where
arbitrary = genericArbitrary
shrink = genericShrink
@@ -291,6 +304,21 @@ instance Arbitrary ExamPartNumber where
arbitrary = review _ExamPartNumber . CI.mk . pack . getPrintableString <$> arbitrary
shrink = map (review _ExamPartNumber) . shrink . view _ExamPartNumber
+instance Arbitrary ExamCloseMode where
+ arbitrary = genericArbitrary
+ shrink = genericShrink
+
+instance Arbitrary RoomReference where
+ arbitrary = oneof
+ [ RoomReferenceSimple . pack <$> suchThat (getPrintableString <$> arbitrary) (not . null)
+ , RoomReferenceLink
+ <$> arbitrary
+ <*> arbitrary
+ ]
+
+instance Arbitrary RoomReference' where
+ arbitrary = genericArbitrary
+
spec :: Spec
spec = do
@@ -385,6 +413,14 @@ spec = do
[ persistFieldLaws, jsonLaws, binaryLaws ]
lawsCheckHspec (Proxy @ExamPartNumber)
[ persistFieldLaws, jsonLaws, pathPieceLaws, csvFieldLaws, eqLaws, ordLaws ]
+ lawsCheckHspec (Proxy @StoredMarkup)
+ [ persistFieldLaws, jsonLaws, eqLaws, ordLaws, showReadLaws, monoidLaws, semigroupLaws, semigroupMonoidLaws, csvFieldLaws ]
+ lawsCheckHspec (Proxy @ExamCloseMode)
+ [ persistFieldLaws, jsonLaws, eqLaws, ordLaws, showReadLaws, pathPieceLaws, jsonKeyLaws, finiteLaws, httpApiDataLaws, binaryLaws ]
+ lawsCheckHspec (Proxy @RoomReference)
+ [ persistFieldLaws, jsonLaws, eqLaws, ordLaws ]
+ lawsCheckHspec (Proxy @RoomReference')
+ [ eqLaws, ordLaws, finiteLaws, showReadLaws, pathPieceLaws, boundedEnumLaws ]
describe "TermIdentifier" $ do
it "has compatible encoding/decoding to/from Text" . property $
@@ -444,6 +480,24 @@ spec = do
t "{\"user\": {\"mode\": \"upload-specific\", \"specific-files\": [{\"name\": \"abgabe6.pdf\", \"label\": \"Abgabe 6\", \"required\": true}]}, \"corrector\": false}"
t "{\"user\": {\"mode\": \"upload-specific\", \"specific-files\": [{\"name\": \"abgabe10.pdf\", \"label\": \"Abgabe 10\", \"required\": true}, {\"name\": \"deckblatt10.pdf\", \"label\": \"Deckblatt 10\", \"required\": true}]}, \"corrector\": false}"
t "{\"user\": {\"mode\": \"no-upload\"}, \"corrector\": false}"
+ describe "StoredMarkup" $ do
+ it "decodes from Html via json" . property $
+ \html -> case Aeson.eitherDecode (Aeson.encode html) of
+ Left _ -> False
+ Right StoredMarkup{..} -> ((==) `on` renderHtml) markupOutput html
+ && markupInputFormat == MarkupHtml
+ && renderHtml html == markupInput
+ it "decodes from Html via persistent" . property $
+ \html -> case fromPersistValue (toPersistValue html) of
+ Left _ -> False
+ Right StoredMarkup{..} -> ((==) `on` renderHtml) markupOutput html
+ && markupInputFormat == MarkupHtml
+ && renderHtml html == markupInput
+ describe "ExamCloseMode" $ do
+ it "PathPiece instance matches expectations" . example $ do
+ toPathPiece ExamCloseSeparate `shouldBe` "separate"
+ toPathPiece (ExamCloseOnFinished False) `shouldBe` "on-finished"
+ toPathPiece (ExamCloseOnFinished True) `shouldBe` "on-finished-hidden"
termExample :: (TermIdentifier, Text) -> Expectation
termExample (term, encoded) = example $ do
diff --git a/test/ModelSpec.hs b/test/ModelSpec.hs
index 6e1c6096b..ad4d38e95 100644
--- a/test/ModelSpec.hs
+++ b/test/ModelSpec.hs
@@ -76,7 +76,8 @@ instance Arbitrary Tutorial where
<*> arbitrary
<*> (CI.mk . pack . getPrintableString <$> arbitrary)
<*> (fmap getPositive <$> arbitrary)
- <*> (assertM' (not . null) . pack . getPrintableString <$> arbitrary)
+ <*> arbitrary
+ <*> arbitrary
<*> arbitrary
<*> (fmap (CI.mk . pack . getPrintableString) <$> arbitrary)
<*> arbitrary
@@ -160,6 +161,7 @@ instance Arbitrary School where
schoolExamMinimumRegisterDuration <- arbitrary
schoolExamRequireModeForRegistration <- arbitrary
schoolExamDiscouragedModes <- arbitrary
+ schoolExamCloseMode <- arbitrary
return School{..}
instance Arbitrary Term where
diff --git a/test/TestImport.hs b/test/TestImport.hs
index a38b9a5e2..3c370f3af 100644
--- a/test/TestImport.hs
+++ b/test/TestImport.hs
@@ -42,6 +42,7 @@ import Data.UUID as X (UUID)
import System.IO as X (hPrint, hPutStrLn)
import Jobs (handleJobs)
import Numeric.Natural as X
+import Network.URI.Arbitrary as X ()
import Control.Lens as X hiding ((<.), elements)