chore(lms): message action done for firm views

messages/uniworx/categories/firm/de-de-formal.msg

@@ -16,7 +16,9 @@ FirmSuperActRMSuperAll: Als aktiven Ansprechpartner komplett entfernen
 FirmsNotification: Firmen Benachrichtigung versenden
 FirmNotification fsh@CompanyShorthand: Benachrichtigung an #{fsh} versenden
 FilterSupervisor: Hat aktiven Ansprechpartner
-FilterSupervisorCompany fsh@CompanyShorthand: Hat aktiven Ansprechpartner, der #{fsh} angehört
+FilterSupervisorCompany fsh@CompanyShorthand: Hat aktiven Ansprechpartner, #{fsh} der angehört
 FilterSupervisorForeign fsh@CompanyShorthand: Hat aktiven Ansprechpartner, der selbst nicht #{fsh} angehört
 FilterForeignSupervisor: Hat firmenfremde Ansprechpartner
 FilterFirmPostalAddress: Postalische Firmenadresse vorhanden
+FirmSupervisorOf fsh@CompanyShorthand: Ansprechpartner #{fsh} angehörig
+FirmEmployeeOf fsh@CompanyShorthand: Firmenangehörige #{fsh}

messages/uniworx/categories/firm/en-eu.msg

@@ -20,3 +20,5 @@ FilterSupervisorCompany fsh: Has active company supervisor belonging to #{fsh}
 FilterSupervisorForeign fsh: Has active supervisor not belonging to #{fsh}
 FilterForeignSupervisor: Has company-external supervisors
 FilterFirmPostalAddress: Postal company addresse known
+FirmSupervisorOf fsh@CompanyShorthand: Supervisors belonging to #{fsh}
+FirmEmployeeOf fsh@CompanyShorthand: #{fsh} associated users

routes

@@ -116,7 +116,7 @@
 /firms                          FirmAllR            GET POST		!supervisor
 /firms/comm    									FirmsCommR          GET POST
 /firm/#CompanyShorthand         FirmR               GET POST
-/firm/#CompanyShorthand/comm    FirmCommR 	        GET POST
+/firm/#CompanyShorthand/comm    FirmCommR						GET POST
 /firm/#CompanyShorthand/users   FirmUsersR          GET POST    !supervisor
 /firm/#CompanyShorthand/supers  FirmSupersR         GET POST    !supervisor
 

src/Handler/Firm.hs

@@ -367,8 +367,14 @@ postFirmAllR = do
   isAdmin <- hasReadAccessTo AdminR
   (firmRes, firmTable) <- runDB $ mkFirmAllTable isAdmin uid -- filters to associated companies for non-admins
   formResult firmRes $ \case    
-    (FirmAllActNotifyData          , fids) -> addMessage Info $ text2Html $ "Notify " <> tshow (length fids) <> " companies. TODO"
     (FirmAllActResetSupervisionData, fids) -> addMessage Info $ text2Html $ "Reset "  <> tshow (length fids) <> " companies. TODO"    
+    (FirmAllActNotifyData          , fids) -> do
+      usrs <- runDB $ E.select $ E.distinct $ do
+        (usr :& uc) <- E.from $ E.table @User `E.innerJoin` E.table @UserCompany `E.on` (\(emp :& uc) -> emp E.^. UserId E.==. uc E.^. UserCompanyUser)
+        E.where_ $ uc E.^. UserCompanyCompany `E.in_` E.valList (Set.toList fids)
+        return $ usr E.^. UserId
+      cuids <- traverse (encrypt . E.unValue) usrs :: Handler [CryptoUUIDUser]
+      redirect (FirmsCommR, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids])
   siteLayoutMsg MsgMenuFirms $ do
     setTitleI MsgMenuFirms
     $(i18nWidgetFile "firm-all")
@@ -742,9 +748,12 @@ postFirmSupersR fsh = do
     <*> mkFirmSuperTable isAdmin fshId
 
   formResult fsprRes $ \case
-    (FirmSuperActNotifyData    , fids) -> addMessage Info $ text2Html $ "Notify " <> tshow (length fids) <> " supervisors. TODO"
     (FirmSuperActRMSuperDefData, fids) -> addMessage Info $ text2Html $ "Remove "  <> tshow (length fids) <> " default supervisors. TODO"
     (FirmSuperActRMSuperAllData, fids) -> addMessage Info $ text2Html $ "Make "  <> tshow (length fids) <> " default and active supervisors. TODO"
+    (FirmSuperActNotifyData    , fids) -> do 
+      cuids <- traverse encrypt $ Set.toList fids :: Handler [CryptoUUIDUser]
+      redirect (FirmCommR fsh, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids])
+
 
   siteLayout (citext2widget fsh) $ do
     setTitle $ citext2Html fsh
@@ -834,7 +843,7 @@ handleFirmCommR ultDest mbFsh = do
     , crRecipientAuth = Nothing -- :: Maybe (UserId -> DB AuthResult) -- an optional filter passed to guardAuthResult 
     , crRecipients = -- :: [(RecipientGroup, SqlQuery (SqlExpr (Entity User)))]
       [(RGFirmSupervisor $ unCompanyKey acid, queryCmpy True  acid)  | acid <- cmpys ] <>
-      [(RGFirmEmployees  $ unCompanyKey acid, queryCmpy False acid)  | acid <- cmpys ]
+      [(RGFirmEmployees  $ unCompanyKey acid, queryCmpy False acid)  | acid <- cmpys, maybe True (acid ==) mbCid]
     }
 
   {- Auswahlbox für Mitteilung:

src/Handler/Utils/Communication.hs

@@ -28,6 +28,7 @@ import qualified Data.Conduit.Combinators as C
 
 
 data RecipientGroup = RGCourseParticipants | RGCourseLecturers | RGCourseCorrectors | RGCourseTutors | RGCourseParticipantsInTutorial | RGCourseUnacceptedApplicants
+  -- WARNING: no RenderMessage instance, but a pattern match in templates/widgets/communication/recipientLayout.hamlet that needs to be extended
                     | RGTutorialParticipants CryptoUUIDTutorial
                     | RGExamRegistered CryptoUUIDExam
                     | RGSheetSubmittor CryptoUUIDSheet

templates/widgets/communication/recipientLayout.hamlet

@@ -31,6 +31,10 @@ $if not (null activeCategories)
               ^{rgSheetSubmittorCaption sid}
             $of RecipientGroup RGCourseUnacceptedApplicants
               _{MsgRGCourseUnacceptedApplicants}
+            $of RecipientGroup (RGFirmSupervisor fsh)
+              _{MsgFirmSupervisorOf fsh}
+            $of RecipientGroup (RGFirmEmployees  fsh)
+              _{MsgFirmEmployeeOf fsh}
 
         $if hasContent category
           <fieldset .recipient-category__fieldset uw-interactive-fieldset .interactive-fieldset__target data-conditional-input=#{checkedIdent category}>