From 02354f0998e61c236bc982848b9d709c927690f5 Mon Sep 17 00:00:00 2001
From: ros <ros@cip.ifi.lmu.de>
Date: Mon, 24 May 2021 12:20:26 +0200
Subject: [PATCH] feat(participants): second version, Intersection added

---
 .../categories/courses/participants/de-de-formal.msg     | 3 ++-
 .../uniworx/categories/courses/participants/en-eu.msg    | 3 ++-
 src/Application.hs                                       | 2 +-
 src/Handler/Participants.hs                              | 5 +++--
 src/Utils/Set.hs                                         | 7 +++++++
 templates/participants-intersect.hamlet                  | 9 ++++++---
 6 files changed, 21 insertions(+), 8 deletions(-)

diff --git a/messages/uniworx/categories/courses/participants/de-de-formal.msg b/messages/uniworx/categories/courses/participants/de-de-formal.msg
index 98827240b..0a169d688 100644
--- a/messages/uniworx/categories/courses/participants/de-de-formal.msg
+++ b/messages/uniworx/categories/courses/participants/de-de-formal.msg
@@ -7,4 +7,5 @@ CourseParticipantsRegisteredWithoutField n@Int: #{n} #{pluralDE n "Teilnehmeri:i
 ParticipantsCsvSheetName tid@TermId ssh@SchoolId: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)} Kursteilnehmer:innen
 CourseParticipants n@Int: Derzeit #{n} angemeldete Kursteilnehmer:innen
 ParticipantsIntersectNotOne: Schnitt 
-AllUsers: Vereinigung aller Teilnehmer:innen: 
\ No newline at end of file
+AllUsersUnion: Vereinigung aller Teilnehmer:innen: 
+AllUsersIntersection: Schnitt aller Teilneher:innen: 
\ No newline at end of file
diff --git a/messages/uniworx/categories/courses/participants/en-eu.msg b/messages/uniworx/categories/courses/participants/en-eu.msg
index 3183e260e..3d110bd7e 100644
--- a/messages/uniworx/categories/courses/participants/en-eu.msg
+++ b/messages/uniworx/categories/courses/participants/en-eu.msg
@@ -7,4 +7,5 @@ CourseParticipantsRegisteredWithoutField n: #{n} #{pluralEN n "participant was"
 ParticipantsCsvSheetName tid ssh: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)} Participants
 CourseParticipants n: Currently #{n} course #{pluralEN n "participant" "participants"}
 ParticipantsIntersectNotOne: Intersection
-AllUsers: Union of all participants: 
\ No newline at end of file
+AllUsersUnion: Union of all participants: 
+AllUsersIntersection: Intersection of all participants: 
\ No newline at end of file
diff --git a/src/Application.hs b/src/Application.hs
index bcaf1edda..ab3bb8886 100644
--- a/src/Application.hs
+++ b/src/Application.hs
@@ -707,4 +707,4 @@ addPWEntry :: User
 addPWEntry User{ userAuthentication = _, ..} (Text.encodeUtf8 -> pw) = db' $ do
   PWHashConf{..} <- getsYesod $ view _appAuthPWHash
   (AuthPWHash . Text.decodeUtf8 -> userAuthentication) <- liftIO $ makePasswordWith pwHashAlgorithm pw pwHashStrength
-  void $ insert User{..}
+  void $ insert User{..}
\ No newline at end of file
diff --git a/src/Handler/Participants.hs b/src/Handler/Participants.hs
index 319c758cc..83842fa77 100644
--- a/src/Handler/Participants.hs
+++ b/src/Handler/Participants.hs
@@ -110,9 +110,10 @@ postParticipantsIntersectR = do
           -> Set.size $ Map.findWithDefault Set.empty lCid courseUsers `Set.intersection` Map.findWithDefault Set.empty uCid courseUsers
         selfIntersections = Map.mapKeysMonotonic (\cid -> (cid, cid)) $ Set.size <$> courseUsers
         intersections' = Map.union intersections selfIntersections 
-    let allUsers = setUnionAll $ Map.elems courseUsers
+    let allUsersUnion = setUnionAll $ Map.elems courseUsers
     let mapIntersect = mapIntersectNotOne courseUsers
-    return (courses, intersections', mapIntersect, allUsers)
+    let allUsersIntersection = setIntersectionAll $ Map.elems courseUsers
+    return (courses, intersections', mapIntersect, allUsersUnion, allUsersIntersection)
 
   let
     symmIntersection intersections lCid uCid = fromMaybe 0 $ intersections !? (lCid, uCid) <|> intersections !? (uCid, lCid)
diff --git a/src/Utils/Set.hs b/src/Utils/Set.hs
index 2697b183a..c612dbd82 100644
--- a/src/Utils/Set.hs
+++ b/src/Utils/Set.hs
@@ -1,5 +1,6 @@
 module Utils.Set
 ( setUnionAll
+, setIntersectionAll
 , setIntersectNotOne
 , setIntersections
 , setMapMaybe
@@ -36,6 +37,12 @@ setUnionOthers [] = Set.empty
 setUnionOthers [x] = x
 setUnionOthers (x:y:z) = setUnionOthers (xy:z) where xy = Set.union x y
 
+-- | cardinal number of a Set
+setIntersectionAll :: Ord a => [Set.Set a] -> Int
+setIntersectionAll [] = 0
+setIntersectionAll [x] = Set.size x
+setIntersectionAll (x:y:z) = setIntersectionAll (xy:z) where xy = Set.intersection x y
+
 ----------------------------------
 -- Functions fro Particiants.hs --
 ----------------------------------
diff --git a/templates/participants-intersect.hamlet b/templates/participants-intersect.hamlet
index a2586a7a2..573c8726f 100644
--- a/templates/participants-intersect.hamlet
+++ b/templates/participants-intersect.hamlet
@@ -1,7 +1,7 @@
 $newline never
 <section>
   ^{formWidget}
-$maybe (courses, intersections, mapIntersect, allUsers) <- intersectionsRes
+$maybe (courses, intersections, mapIntersect, allUsersUnion, allUsersIntersection) <- intersectionsRes
   <section>
     <div .scrolltable .scrolltable--bordered>
       <table .table .table--hover .table--condensed>
@@ -30,5 +30,8 @@ $maybe (courses, intersections, mapIntersect, allUsers) <- intersectionsRes
                 <td .table__td .text--center .table__td--automatic>
                   #{num}
   <p> 
-    _{MsgAllUsers}
-    #{allUsers}
\ No newline at end of file
+    _{MsgAllUsersUnion}
+    #{allUsersUnion}
+  <p> 
+    _{MsgAllUsersIntersection}
+    #{allUsersIntersection}
\ No newline at end of file