chore(firm): add supervisor reset utility functions

src/Handler/Firm.hs

@@ -28,11 +28,11 @@ import qualified Data.Map as Map
 -- import qualified Data.Text as T
 import qualified Data.CaseInsensitive as CI
 -- import qualified Data.Conduit.List as C
--- import Database.Persist.Sql (updateWhereCount)
+import Database.Persist.Sql (deleteWhereCount)
 import           Database.Esqueleto.Experimental ((:&)(..))
 import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications Lang-Pragma
 import qualified Database.Esqueleto.Legacy as EL (from, on)
--- import qualified Database.Esqueleto.PostgreSQL as E
+import qualified Database.Esqueleto.PostgreSQL as E
 import qualified Database.Esqueleto.Utils as E
 import Database.Esqueleto.Utils.TH
 
@@ -42,6 +42,56 @@ single :: (k,a) -> Map k a
 single = uncurry Map.singleton
 
 
+---------------------------
+-- Firm specific utilities
+-- for filters and counts see before FirmAllR Handlers
+
+-- remove supervisors:
+deleteSupervisors :: NonEmpty UserId -> DB Int64
+deleteSupervisors usrs = deleteWhereCount [UserSupervisorUser <-. toList usrs]
+
+-- reset supervisors given employees of a company to default company supervision, deleting all other supervisors
+resetSupervisors :: CompanyId -> NonEmpty UserId -> DB Int64
+resetSupervisors cid employees = do
+  nr_del <- deleteSupervisors employees
+  nr_add <- addDefaultSupervisors cid employees
+  return $ max nr_del nr_add
+
+-- adds the default company supervisors as supervisor to a given set of users, which themselves may belong to any company
+addDefaultSupervisors :: CompanyId -> NonEmpty UserId -> DB Int64
+addDefaultSupervisors cid employees = do 
+  E.insertSelectWithConflictCount UniqueUserSupervisor
+    (do 
+      (spr :& usr) <- E.from $ E.table @UserCompany `E.crossJoin` E.toValues employees
+      E.where_ $ spr E.^. UserCompanyCompany E.==. E.val cid
+          E.&&.  spr E.^. UserCompanySupervisor
+      return $ UserSupervisor
+        E.<#  (spr E.^. UserCompanyUser)
+        E.<&>  usr
+        E.<&> (spr E.^. UserCompanySupervisorReroute)
+    )
+    (\_old new -> [UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications] )
+
+-- like `addDefaultSupervisors`, but selects all employees from database
+addDefaultSupervisorsAll :: CompanyId -> DB Int64
+addDefaultSupervisorsAll cid = 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.&&.  spr E.^. UserCompanySupervisor                    
+      return $ UserSupervisor
+        E.<#  (spr E.^. UserCompanyUser)
+        E.<&> (usr E.^. UserCompanyUser)
+        E.<&> (spr E.^. UserCompanySupervisorReroute)
+    )
+    (\_old new -> [UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications] )
+
+
+
+------------------
+-- Debug Handler
+
 getFirmR,  postFirmR :: CompanyShorthand -> Handler Html
 getFirmR = postFirmR
 postFirmR fsh = do