From 3c1a1a9be6ad2c4bab395553b7ef701a19e0338a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?David=20P=C3=A4tzel?= <david.paetzel@posteo.de>
Date: Sat, 19 Oct 2019 15:49:37 +0200
Subject: [PATCH] Rewrite 'Seminar.valid' check with tests

---
 src/Seminar.hs | 49 +++++++++++++++++++++++++++++++++++++++++++++----
 1 file changed, 45 insertions(+), 4 deletions(-)

diff --git a/src/Seminar.hs b/src/Seminar.hs
index c839fa1..d787cc6 100644
--- a/src/Seminar.hs
+++ b/src/Seminar.hs
@@ -4,7 +4,8 @@
 
 module Seminar where
 
-import Data.List ((!!), lookup, nub, zipWith3)
+import Data.List ((!!), lookup, zipWith3)
+import Data.List.Extra (nub)
 import Data.Random
 import Data.Random.Distribution.Uniform
 import qualified Data.Text as T
@@ -158,10 +159,50 @@ switch i' j' xs
      in left ++ [(fst ei, snd ej)] ++ middle ++ [(fst ej, snd ei)] ++ right
   | otherwise = xs
 
+{-|
+Whether the given assignment is valid (every student occurs at most once, as
+does every topic).
+-}
 valid :: Assignment -> Bool
-valid a =
-  length a == length (nub $ fst <$> a)
-    && length a == length (nub $ snd <$> a)
+valid a = unique students && (unique . filter (/= NoT)) topics
+  where
+    students = fmap fst a
+    topics = fmap snd a
+
+{-|
+Whether the given list only contains unique elements.
+-}
+unique xs = length xs == (length . nub) xs
+
+prop_valid_empty = valid []
+
+prop_valid_dupNoT ss = unique ss ==> valid (ss `zip` repeat NoT)
+
+prop_valid_dupT ss ts =
+  unique ss
+    && unique ts
+    && length ss > length ts
+    && not (null ts)
+    && NoT `notElem` ts
+      ==> not . valid $ ss `zip` cycle ts
+
+prop_valid_noDups =
+  forAll noDupsList $ \ss ->
+    forAll noDupsList $ \ts ->
+                          valid $ ss `zip` ts
+
+{-|
+Generator for lists fulfilling 'unique', that is, only containing unique
+elements.
+-}
+noDupsList :: (Arbitrary a, Eq a) => Gen [a]
+noDupsList = nub <$> arbitrary
+
+prop_noDupsList = forAll (noDupsList :: Gen [Int]) unique
+
+-- NEXT find out why after x thousand repetitions, sometimes, bad solutions
+-- occur with duplicate students
+-- probably due to error in 'switch' implementation
 return []
 
 runTests = $quickCheckAll