feat(participants): second version, Intersection added

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: 
+AllUsersUnion: Vereinigung aller Teilnehmer:innen: 
+AllUsersIntersection: Schnitt aller Teilneher:innen: 

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: 
+AllUsersUnion: Union of all participants: 
+AllUsersIntersection: Intersection of all participants: 

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{..}

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)

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

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}
+    _{MsgAllUsersUnion}
+    #{allUsersUnion}
+  <p> 
+    _{MsgAllUsersIntersection}
+    #{allUsersIntersection}