chore(firm): reset supervisors for FirmAllR working

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

@@ -8,8 +8,11 @@ FirmAddress: Postanschrift
 FirmDefaultPreferenceInfo: Diese Voreinstellungen gelten nur für neue Firmenangehörige
 FirmAllActNotify: Mitteilung versenden
 FirmAllActResetSupervision: Ansprechpartner für alle Firmenangehörigen zurücksetzen
+FirmAllActResetSuperKeep: Bisherige Ansprechpartner der Firmenangehörigen zusätzlich beibehalten?
+FirmAllActResetMutualSupervision: Ansprechpartner beaufsichtigen sich gegenseitig
 FirmUserActNotify: Mitteilung versenden
 FirmUserActMkSuper: Zum Firmenansprechpartner ernennen
+FirmResetSupervision rem@Int64 set@Int64: #{tshow set} Ansprechpartner gesetzt#{bool mempty (", " <> tshow rem <> " zuvor gelöscht") (rem > 0)}
 FirmSuperActNotify: Mitteilung versenden
 FirmSuperActRMSuperDef: Standard Firmenansprechpartner entfernen
 FirmSuperActRMSuperAll: Als aktiven Ansprechpartner komplett entfernen
@@ -24,4 +27,5 @@ FilterForeignSupervisor: Hat firmenfremde Ansprechpartner
 FilterFirmExtern: Externe Firma
 FirmSupervisorOf fsh@CompanyShorthand: Ansprechpartner #{fsh} angehörig
 FirmSupervisorIndependent: Ansprechpartner ohne jegliche Firmenzugehörigkeit
-FirmEmployeeOf fsh@CompanyShorthand: Firmenangehörige #{fsh}
+FirmEmployeeOf fsh@CompanyShorthand: Firmenangehörige #{fsh}
+NoCompanySelected: Bitte wählen Sie mindestens eine Firm aus.

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

@@ -9,6 +9,9 @@ FirmDefaultPreferenceInfo: Default setting for new company associates only
 FirmAllActNotify: Send message
 FirmAllActResetSupervision: Reset supervisors for all company associates
 FirmUserActNotify: Send message
+FirmAllActResetSuperKeep: Additionally keep existing supervisors of company associates?
+FirmAllActResetMutualSupervision: Supervisors supervise each other
+FirmResetSupervision rem set: #{tshow set} supervisors set#{bool mempty (", " <> tshow rem <> " deleted before") (rem > 0)}
 FirmUserActMkSuper: Mark as company supervisor
 FirmSuperActNotify: Send message
 FirmSuperActRMSuperDef: Remove as default supervisor
@@ -24,4 +27,5 @@ FilterForeignSupervisor: Has company-external supervisors
 FilterFirmExtern: External company
 FirmSupervisorOf fsh@CompanyShorthand: Supervisors belonging to #{fsh}
 FirmSupervisorIndependent: Independent supervisors
-FirmEmployeeOf fsh@CompanyShorthand: #{fsh} associated users
+FirmEmployeeOf fsh@CompanyShorthand: #{fsh} associated users
+NoCompanySelected: Select at least one company, please.

src/Database/Esqueleto/Utils.hs

@@ -227,8 +227,8 @@ explicitUnsafeCoerceSqlExprValue typ (E.ERaw _m1 f1) = E.ERaw E.noMeta $ \_nPare
       )
 
 and, or :: Foldable f => f (E.SqlExpr (E.Value Bool)) -> E.SqlExpr (E.Value Bool)
-and = F.foldr (E.&&.) true
+and = F.foldl' (E.&&.) true -- we can use foldl' since Postgresql reorders conditions anyway
-or = F.foldr (E.||.) false
+or = F.foldl' (E.||.) false
 
 -- | Given a test and a set of values, check whether anyone succeeds the test
 --   WARNING: SQL leaves it explicitely unspecified whether `||` is short curcuited (i.e. lazily evaluated)

src/Handler/Firm.hs

@@ -70,16 +70,18 @@ addDefaultSupervisors cid employees = do
         E.<&>  usr
         E.<&> (spr E.^. UserCompanySupervisorReroute)
     )
-    (\_old new -> [UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications] )
+    (\_old new -> [UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications])
 
 -- like `addDefaultSupervisors`, but selects all employees from database
-addDefaultSupervisorsAll :: CompanyId -> DB Int64
+addDefaultSupervisorsAll ::  (MonoFoldable mono, CompanyId ~ Element mono) => Bool -> mono -> DB Int64
-addDefaultSupervisorsAll cid = do 
+addDefaultSupervisorsAll mutualSupervision cids = do 
   E.insertSelectWithConflictCount UniqueUserSupervisor
     (do 
       (spr :& usr) <- E.from $ E.table @UserCompany `E.innerJoin` E.table @UserCompany `E.on` (\(spr :& usr) -> spr E.^. UserCompanyCompany E.==. usr E.^. UserCompanyCompany)
-      E.where_ $ spr E.^. UserCompanyCompany E.==. E.val cid
+      E.where_ $ E.and $ guardMonoid (not mutualSupervision) [ E.not_ $ usr E.^. UserCompanySupervisor ] 
-          E.&&.  spr E.^. UserCompanySupervisor                    
+                    <> [ spr E.^. UserCompanyCompany `E.in_` E.vals cids
+                       , spr E.^. UserCompanySupervisor
+                       ]
       return $ UserSupervisor
         E.<#  (spr E.^. UserCompanyUser)
         E.<&> (usr E.^. UserCompanyUser)
@@ -160,8 +162,11 @@ nullaryPathPiece ''FirmAllAction $ camelToPathPiece' 3
 embedRenderMessage ''UniWorX ''FirmAllAction id
 
 data FirmAllActionData = FirmAllActNotifyData
-                   | FirmAllActResetSupervisionData
+                       | FirmAllActResetSupervisionData 
-  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
+                          { firmAllActResetKeepOldSupers      :: Maybe Bool 
+                          , firmAllActResetMutualSupervision  :: Maybe Bool
+                          }
+  deriving (Eq, Ord, Read, Show, Generic)
 
 -- just in case for future extensions
 type AllCompanyTableExpr = E.SqlExpr (Entity Company)
@@ -389,7 +394,9 @@ mkFirmAllTable isAdmin uid = do
         acts :: Map FirmAllAction (AForm Handler FirmAllActionData)
         acts = mconcat
           [ singletonMap FirmAllActNotify           $ pure FirmAllActNotifyData
-          , singletonMap FirmAllActResetSupervision $ pure FirmAllActResetSupervisionData
+          , singletonMap FirmAllActResetSupervision $      FirmAllActResetSupervisionData
+              <$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmAllActResetSuperKeep)         (Just $ Just False)
+              <*> aopt checkBoxField                                      (fslI MsgFirmAllActResetMutualSupervision) (Just $ Just True )
           ]
         dbtParams = DBParamsForm
           { dbParamsFormMethod = POST
@@ -429,7 +436,21 @@ postFirmAllR = do
   isAdmin <- hasReadAccessTo AdminR
   (firmRes, firmTable) <- runDB $ mkFirmAllTable isAdmin uid -- filters to associated companies for non-admins
   formResult firmRes $ \case    
-    (FirmAllActResetSupervisionData, fids) -> addMessage Info $ text2Html $ "Reset "  <> tshow (length fids) <> " companies. TODO"    
+    (_, fids) | null fids -> addMessageI Error MsgNoCompanySelected
+
+    (FirmAllActResetSupervisionData{..}, fids) -> runDB $  do
+      delSupers <- if firmAllActResetKeepOldSupers == Just False
+        then E.deleteCount $ do
+              spr <- E.from $ E.table @UserSupervisor
+              E.where_ $ E.exists $ do
+                usr <- E.from $ E.table @UserCompany
+                E.where_ $ usr E.^. UserCompanyCompany `E.in_` E.vals fids
+                    E.&&.  usr E.^. UserCompanyUser E.==. spr E.^. UserSupervisorUser 
+        else return 0 
+      newSupers <- addDefaultSupervisorsAll (firmAllActResetMutualSupervision /= Just False) fids 
+      addMessageI Info $ MsgFirmResetSupervision newSupers delSupers
+      reloadKeepGetParams FirmAllR -- reload to reflect changes
+
     (FirmAllActNotifyData          , Set.toList -> 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)
@@ -437,6 +458,7 @@ postFirmAllR = do
         return $ usr E.^. UserId
       cuids <- traverse (encrypt . E.unValue) usrs :: Handler [CryptoUUIDUser]
       redirect (FirmsCommR $ fmap unCompanyKey fids, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids])
+
   siteLayoutMsg MsgMenuFirms $ do
     setTitleI MsgMenuFirms
     $(i18nWidgetFile "firm-all")
@@ -887,7 +909,7 @@ handleFirmCommR ultDest cs = do
             sprCmp <- E.from $ E.table @UserCompany
             E.where_ $ sprCmp E.^. UserCompanyUser E.==. spr E.^. UserId
           )
-      return $ spr
+      return spr
 
     queryCmpy :: Bool -> CompanyId -> E.SqlQuery (E.SqlExpr (Entity User))
     queryCmpy sORe acid = do