|
|
|
|
@ -236,7 +236,7 @@ runFirmActionFormPost cid route isAdmin acts = do
|
|
|
|
|
deleteSupervisors :: NonEmpty UserId -> [CompanyId] -> DB Int64
|
|
|
|
|
deleteSupervisors usrs cids = deleteWhereCount $ (UserSupervisorUser <-. toList usrs) : restrictByCompany
|
|
|
|
|
where
|
|
|
|
|
restrictByCompany = guardMonoid (notNull cids) [UserSupervisorCompany <-. (Just <$> cids)]
|
|
|
|
|
restrictByCompany = guardMonoid (notNull cids) [UserSupervisorCompany <-. (Just <$> cids)]
|
|
|
|
|
|
|
|
|
|
-- reset supervisors given employees of a company to default company supervision, deleting all previous company-related supervisors
|
|
|
|
|
resetSupervisors :: CompanyId -> NonEmpty UserId -> DB Int64
|
|
|
|
|
@ -260,9 +260,9 @@ addDefaultSupervisors cid employees = do
|
|
|
|
|
E.<&> E.justVal cid
|
|
|
|
|
E.<&> E.nothing
|
|
|
|
|
)
|
|
|
|
|
(\_old new ->
|
|
|
|
|
(\_old new ->
|
|
|
|
|
[ UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications
|
|
|
|
|
, UserSupervisorCompany E.=. E.justVal cid
|
|
|
|
|
, UserSupervisorCompany E.=. E.justVal cid
|
|
|
|
|
-- , UserSupervisorReason E.=. new E.^. UserSupervisorReason -- keep any existing reason
|
|
|
|
|
])
|
|
|
|
|
|
|
|
|
|
@ -290,7 +290,7 @@ addDefaultSupervisorsFor mbSuperId mutualSupervision cids = do
|
|
|
|
|
E.<&> E.just (spr E.^. UserCompanyCompany)
|
|
|
|
|
E.<&> E.nothing
|
|
|
|
|
)
|
|
|
|
|
(\_old new ->
|
|
|
|
|
(\_old new ->
|
|
|
|
|
[ UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications
|
|
|
|
|
, UserSupervisorCompany E.=. new E.^. UserSupervisorCompany
|
|
|
|
|
-- , UserSupervisorReason E.=. new E.^. UserSupervisorReason -- keep any existing reaon
|
|
|
|
|
@ -315,7 +315,7 @@ addDefaultSupervisorsAll mutualSupervision cids = do
|
|
|
|
|
E.<&> E.just (spr E.^. UserCompanyCompany)
|
|
|
|
|
E.<&> E.nothing
|
|
|
|
|
)
|
|
|
|
|
(\_old new ->
|
|
|
|
|
(\_old new ->
|
|
|
|
|
[ UserSupervisorRerouteNotifications E.=. new E.^. UserSupervisorRerouteNotifications
|
|
|
|
|
, UserSupervisorCompany E.=. new E.^. UserSupervisorCompany
|
|
|
|
|
-- , UserSupervisorReason E.=. new E.^. UserSupervisorReason -- keep any existing reaon
|
|
|
|
|
@ -334,6 +334,26 @@ fromUserCompany mbFltr cmpy = do
|
|
|
|
|
firmCountUsers :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
|
|
|
|
|
firmCountUsers = E.subSelectCount . fromUserCompany Nothing
|
|
|
|
|
|
|
|
|
|
firmCountUsersPrimary :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
|
|
|
|
|
firmCountUsersPrimary cmp = E.subSelectCount $ fromUserCompany (Just primFltr) cmp
|
|
|
|
|
where
|
|
|
|
|
primFltr usr = E.notExists (do
|
|
|
|
|
othr <- E.from $ E.table @UserCompany
|
|
|
|
|
E.where_ $ othr E.^. UserCompanyPriority E.>. usr E.^. UserCompanyPriority
|
|
|
|
|
E.&&. othr E.^. UserCompanyUser E.==. usr E.^. UserCompanyUser
|
|
|
|
|
E.&&. othr E.^. UserCompanyCompany E.!=. cmp E.^. CompanyId -- redundant due to > above, but likely performance improving
|
|
|
|
|
)
|
|
|
|
|
|
|
|
|
|
firmCountUsersSecondary :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
|
|
|
|
|
firmCountUsersSecondary cmp = E.subSelectCount $ fromUserCompany (Just primFltr) cmp
|
|
|
|
|
where
|
|
|
|
|
primFltr usr = E.exists (do
|
|
|
|
|
othr <- E.from $ E.table @UserCompany
|
|
|
|
|
E.where_ $ othr E.^. UserCompanyPriority E.>. usr E.^. UserCompanyPriority
|
|
|
|
|
E.&&. othr E.^. UserCompanyUser E.==. usr E.^. UserCompanyUser
|
|
|
|
|
E.&&. othr E.^. UserCompanyCompany E.!=. cmp E.^. CompanyId -- redundant due to > above, but likely performance improving
|
|
|
|
|
)
|
|
|
|
|
|
|
|
|
|
firmCountSupervisors :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
|
|
|
|
|
firmCountSupervisors = E.subSelectCount . fromUserCompany (Just (E.^. UserCompanySupervisor))
|
|
|
|
|
-- firmCountSupervisors :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
|
|
|
|
|
@ -445,7 +465,7 @@ type AllCompanyTableExpr = E.SqlExpr (Entity Company)
|
|
|
|
|
queryAllCompany :: AllCompanyTableExpr -> E.SqlExpr (Entity Company)
|
|
|
|
|
queryAllCompany = id
|
|
|
|
|
|
|
|
|
|
type AllCompanyTableData = DBRow (Entity Company, E.Value Word64, E.Value Bool, E.Value Bool)
|
|
|
|
|
type AllCompanyTableData = DBRow (Entity Company, E.Value Word64, E.Value Bool, E.Value Bool, E.Value Word64)
|
|
|
|
|
resultAllCompanyEntity :: Lens' AllCompanyTableData (Entity Company)
|
|
|
|
|
resultAllCompanyEntity = _dbrOutput . _1
|
|
|
|
|
|
|
|
|
|
@ -461,6 +481,8 @@ resultAllCompanySupervisors = _dbrOutput . _3 . _unValue
|
|
|
|
|
resultAllCompanyDefaultReroutes :: Lens' AllCompanyTableData Bool
|
|
|
|
|
resultAllCompanyDefaultReroutes = _dbrOutput . _4 . _unValue
|
|
|
|
|
|
|
|
|
|
resultAllCompanyUsersSecondary :: Lens' AllCompanyTableData Word64
|
|
|
|
|
resultAllCompanyUsersSecondary = _dbrOutput . _5 . _unValue
|
|
|
|
|
|
|
|
|
|
mkFirmAllTable :: Bool -> UserId -> DB (FormResult (FirmActionData, Set CompanyId), Widget)
|
|
|
|
|
mkFirmAllTable isAdmin uid = do
|
|
|
|
|
@ -483,12 +505,13 @@ mkFirmAllTable isAdmin uid = do
|
|
|
|
|
, cmpy & firmCountUsers -- 2
|
|
|
|
|
, cmpy & firmHasSupervisors -- 3
|
|
|
|
|
, cmpy & firmHasDefaultReroutes -- 4
|
|
|
|
|
-- , cmpy & firmCountEmployeeSupervised -- 4
|
|
|
|
|
-- , cmpy & firmCountEmployeeRerouted -- 5
|
|
|
|
|
-- , cmpy & firmCountEmployeeRerPost -- 6
|
|
|
|
|
-- , cmpy & firmCountForeignSupervisors -- 7
|
|
|
|
|
-- , cmpy & firmCountActiveReroutes -- 9
|
|
|
|
|
-- , cmpy & firmCountActiveReroutes' -- 10
|
|
|
|
|
, cmpy & firmCountUsersSecondary -- 5
|
|
|
|
|
-- , cmpy & firmCountEmployeeSupervised
|
|
|
|
|
-- , cmpy & firmCountEmployeeRerouted
|
|
|
|
|
-- , cmpy & firmCountEmployeeRerPost
|
|
|
|
|
-- , cmpy & firmCountForeignSupervisors
|
|
|
|
|
-- , cmpy & firmCountActiveReroutes
|
|
|
|
|
-- , cmpy & firmCountActiveReroutes'
|
|
|
|
|
)
|
|
|
|
|
dbtRowKey = (E.^. CompanyId)
|
|
|
|
|
dbtProj = dbtProjFilteredPostId
|
|
|
|
|
@ -501,6 +524,7 @@ mkFirmAllTable isAdmin uid = do
|
|
|
|
|
in anchorCell (FirmSupersR fsh) $ toWgt fsh
|
|
|
|
|
, sortable (Just "avsnr") (i18nCell MsgTableCompanyNo) $ \(view resultAllCompany -> firm) -> numCell $ companyAvsId firm
|
|
|
|
|
, sortable (Just "users") (i18nCell MsgTableCompanyNrUsers) $ \(view resultAllCompanyUsers -> nr) -> wgtCell $ word2widget nr
|
|
|
|
|
, sortable (Just "secondary") (i18nCell MsgTableCompanyNrSecondaryUsers) $ \(view resultAllCompanyUsersSecondary -> nr) -> wgtCell $ word2widget nr
|
|
|
|
|
, sortable (Just "supervisors") (i18nCell MsgTableCompanyNrSupersDefault) $ \row ->
|
|
|
|
|
anchorCell (FirmSupersR $ row ^. resultAllCompany . _companyShorthand) $ toWgt $ hasTickmark $ row ^. resultAllCompanySupervisors
|
|
|
|
|
, sortable (Just "reroute-def") (i18nCell MsgTableCompanyNrRerouteDefault) $ \(view resultAllCompanyDefaultReroutes -> ok) -> tickmarkCell ok
|
|
|
|
|
@ -518,6 +542,7 @@ mkFirmAllTable isAdmin uid = do
|
|
|
|
|
, singletonMap "avsnr" $ SortColumn (E.^. CompanyAvsId)
|
|
|
|
|
, singletonMap "postal-pref" $ SortColumn (E.^. CompanyPrefersPostal)
|
|
|
|
|
, singletonMap "users" $ SortColumn firmCountUsers
|
|
|
|
|
, singletonMap "secondary" $ SortColumn firmCountUsersSecondary
|
|
|
|
|
, singletonMap "supervisors" $ SortColumn firmHasSupervisors
|
|
|
|
|
-- , singletonMap "emp-supervised" $ SortColumn firmCountEmployeeSupervised
|
|
|
|
|
-- , singletonMap "emp-rerouted" $ SortColumn firmCountEmployeeRerouted
|
|
|
|
|
@ -598,7 +623,7 @@ mkFirmAllTable isAdmin uid = do
|
|
|
|
|
-- ))
|
|
|
|
|
-- )
|
|
|
|
|
-- )
|
|
|
|
|
-- , single ("is-supervisor", FilterColumn $ \row (getLast -> criterion) ->
|
|
|
|
|
-- , single ("is-supervisor", FilterColumn $ \row (getLast -> criterion) ->
|
|
|
|
|
-- case criterion of
|
|
|
|
|
-- Nothing -> E.true
|
|
|
|
|
-- (Just (crit::Text)) -> E.exists $ do
|
|
|
|
|
@ -618,7 +643,7 @@ mkFirmAllTable isAdmin uid = do
|
|
|
|
|
-- ))
|
|
|
|
|
-- )
|
|
|
|
|
-- )
|
|
|
|
|
, single ("is-supervisor", mkFilterProjectedPost $ \(getLast -> criterion) dbr ->
|
|
|
|
|
, single ("is-supervisor", mkFilterProjectedPost $ \(getLast -> criterion) dbr ->
|
|
|
|
|
case criterion of
|
|
|
|
|
Nothing -> return True :: DB Bool
|
|
|
|
|
(Just (crit::Text)) -> do
|
|
|
|
|
@ -851,7 +876,7 @@ mkFirmUserTable isAdmin cid = do
|
|
|
|
|
(usr :& usrCmp) <- E.from $ E.table @User `E.leftJoin` E.table @UserCompany
|
|
|
|
|
`E.on` (\(usr :& usrCmp) -> usr E.^. UserId E.=?. usrCmp E.?. UserCompanyUser E.&&. usrCmp E.?. UserCompanyCompany E.==. E.justVal cid)
|
|
|
|
|
E.where_ $ E.isTrue (usrCmp E.?. UserCompanySupervisor)
|
|
|
|
|
E.||. E.exists (firmQuerySupervisedBy cid Nothing usr)
|
|
|
|
|
E.||. E.exists (firmQuerySupervisedBy cid Nothing usr)
|
|
|
|
|
return (usr E.^. UserId, usr E.^. UserDisplayName, usrCmp E.?. UserCompanySupervisor)
|
|
|
|
|
let
|
|
|
|
|
-- supervisorField :: Field Handler UserId
|
|
|
|
|
@ -950,7 +975,7 @@ mkFirmUserTable isAdmin cid = do
|
|
|
|
|
let checkPrimary = do
|
|
|
|
|
other <- E.from $ E.table @UserCompany
|
|
|
|
|
E.where_ $ other E.^. UserCompanyUser E.==. queryUserUserCompany row E.^. UserCompanyUser
|
|
|
|
|
E.&&. other E.^. UserCompanyPriority E.>. queryUserUserCompany row E.^. UserCompanyPriority
|
|
|
|
|
E.&&. other E.^. UserCompanyPriority E.>. queryUserUserCompany row E.^. UserCompanyPriority
|
|
|
|
|
in case criterion of
|
|
|
|
|
Nothing -> E.true
|
|
|
|
|
Just False -> E.exists checkPrimary
|
|
|
|
|
|
