From 65e06882d2491da5e30b1401db6ecc81efcac58b Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gregor.kleen@ifi.lmu.de>
Date: Thu, 17 Sep 2020 13:31:41 +0200
Subject: [PATCH] fix: tests

---
 .hlint.yaml                 |  1 +
 src/Model/Migration.hs      |  4 ++--
 src/Model/Types/Security.hs |  2 +-
 test/ModelSpec.hs           | 18 ++++++++++++++++++
 4 files changed, 22 insertions(+), 3 deletions(-)

diff --git a/.hlint.yaml b/.hlint.yaml
index f12dfd72c..5414d2724 100644
--- a/.hlint.yaml
+++ b/.hlint.yaml
@@ -12,6 +12,7 @@
   - ignore: { name: "Use ***" }
   - ignore: { name: "Redundant void" }
   - ignore: { name: "Too strict maybe" }
+  - ignore: { name: "Use Just" }
 
   - arguments:
       - -XQuasiQuotes
diff --git a/src/Model/Migration.hs b/src/Model/Migration.hs
index 79b42f8ec..55d1ee4ca 100644
--- a/src/Model/Migration.hs
+++ b/src/Model/Migration.hs
@@ -952,11 +952,11 @@ customMigrations = Map.fromListWith (>>)
     )
   , ( AppliedMigrationKey [migrationVersion|41.0.0|] [version|42.0.0|]
     , do
-        whenM (tableExists "exam") $
+        whenM (tableExists "exam")
           [executeQQ|
             ALTER TABLE exam ADD COLUMN "exam_mode" jsonb NOT NULL DEFAULT #{ExamMode Nothing Nothing Nothing Nothing};
           |]
-        whenM (tableExists "school") $
+        whenM (tableExists "school")
           [executeQQ|
             ALTER TABLE school ADD COLUMN "exam_discouraged_modes" jsonb NOT NULL DEFAULT #{ExamModeDNF predDNFFalse};
           |]
diff --git a/src/Model/Types/Security.hs b/src/Model/Types/Security.hs
index bd2e27c02..f984a38d9 100644
--- a/src/Model/Types/Security.hs
+++ b/src/Model/Types/Security.hs
@@ -185,7 +185,7 @@ dnfAssumeValue var val
     disagrees PLVariable{..} = plVar == var && not val
 
 predDNFFalse :: PredDNF a
-predDNFFalse = PredDNF $ Set.empty
+predDNFFalse = PredDNF Set.empty
 
 
 data UserGroupName
diff --git a/test/ModelSpec.hs b/test/ModelSpec.hs
index 043786e83..cb7708b2f 100644
--- a/test/ModelSpec.hs
+++ b/test/ModelSpec.hs
@@ -39,6 +39,8 @@ import qualified Data.Conduit.Combinators as C
 
 import Data.Ratio ((%))
 
+import Data.Universe
+
 
 instance Arbitrary EmailAddress where
     arbitrary = do
@@ -167,6 +169,18 @@ instance Monad m => Arbitrary (File m) where
         | otherwise
         = False
 
+instance Arbitrary ExamModePredicate where
+  arbitrary = elements universeF
+
+instance Arbitrary p => Arbitrary (PredLiteral p) where
+  arbitrary = elements [PLVariable, PLNegated] <*> arbitrary
+
+instance (Arbitrary p, Ord p) => Arbitrary (PredDNF p) where
+  arbitrary = PredDNF . Set.fromList . mapMaybe (fromNullable . Set.fromList) <$> arbitrary
+  shrink = fmap (PredDNF . Set.fromList . mapMaybe (fromNullable . Set.fromList)) . shrink . map otoList . otoList . dnfTerms
+
+deriving newtype instance Arbitrary ExamModeDNF
+
 instance Arbitrary School where
   arbitrary = do
     names <- listOf1 $ pack . getPrintableString <$> arbitrary
@@ -174,6 +188,10 @@ instance Arbitrary School where
       name = Text.toTitle $ unwords names
       schoolShorthand = CI.mk $ Text.filter Char.isUpper name
       schoolName = CI.mk name
+    schoolExamMinimumRegisterBeforeStart <- arbitrary
+    schoolExamMinimumRegisterDuration <- arbitrary
+    schoolExamRequireModeForRegistration <- arbitrary
+    schoolExamDiscouragedModes <- arbitrary
     return School{..}
 
 instance Arbitrary Term where