Merge branch 'fradrive/company'
This commit is contained in:
commit
fcceef265d
@ -3,16 +3,29 @@
|
||||
# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
FirmAssociates: Firmenangehörige
|
||||
FirmContact: Firmenkontakt
|
||||
FirmNoContact: Keine allgemeinen Kontaktinformationen bekannt.
|
||||
FirmEmail: Allgemeine Email
|
||||
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
|
||||
FirmAction: Firmenweite Aktion
|
||||
FirmActionInfo: Betrifft alle Firmenangehörigen.
|
||||
FirmActNotify: Mitteilung versenden
|
||||
FirmActResetSupervision: Ansprechpartner für alle Firmenangehörigen zurücksetzen
|
||||
FirmActResetSuperKeep: Bisherige Ansprechpartner der Firmenangehörigen zusätzlich beibehalten?
|
||||
FirmActResetMutualSupervision: Ansprechpartner beaufsichtigen sich gegenseitig
|
||||
FirmActAddSupersvisors: Ansprechpartner hinzufügen
|
||||
FirmActAddSupersEmpty: Es konnten keine Ansprechpartner hinzugefügt werden
|
||||
FirmActAddSupersSet n@Int64 postal@(Maybe Bool): #{n} Standardansprechpartner eingetragen #{maybeBoolMessage postal "" "und auf Briefversand geschaltet" "und Benachrichtigungen per Email gesetzt"}, aber nicht nicht aktiviert.
|
||||
RemoveSupervisors ndef@Int64 nact@Int64: #{ndef} Standard Ansprechpartner entfernt#{bool ", aber noch nicht deaktiviert" (", " <> tshow nact <> " aktive Ansprechpartnerbeziehungen gelöscht") (nact > 0)}
|
||||
FirmActChangeContactUser: Kontaktinformationen von Firmenangehörigen ändern
|
||||
FirmActChangeContactFirm: Kontaktinformationen der Firma ändern
|
||||
FirmActChangeContactFirmInfo: Firmenkontaktinformationen werden nur für neue Firmenangehörige verwendet, für die sonst keine Kontaktinformationen vorliegen.
|
||||
FirmActChangeContactFirmResult: Firmenkontaktinformationen geändert. Betrifft nur neue Firmenangehörige ohne eigene Kontaktinformationen
|
||||
FirmUserActNotify: Mitteilung versenden
|
||||
FirmUserActResetSupervision: Ansprechpartner auf Firmenstandard zurücksetzen
|
||||
FirmUserActMkSuper: Zum Firmenansprechpartner ernennen
|
||||
FirmUserActChangeContact: Kontaktinformationen für ausgewählte Firmenangehörige ändern
|
||||
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
|
||||
@ -29,12 +42,9 @@ FilterFirmExtern: Externe Firma
|
||||
FirmSupervisorOf fsh@CompanyShorthand: Ansprechpartner #{fsh} angehörig
|
||||
FirmSupervisorIndependent: Ansprechpartner ohne jegliche Firmenzugehörigkeit
|
||||
FirmEmployeeOf fsh@CompanyShorthand: Firmenangehörige #{fsh}
|
||||
NoCompanySelected: Bitte wählen Sie mindestens eine Firm aus.
|
||||
NoCompanySelected: Bitte wählen Sie mindestens eine Firma aus.
|
||||
TableIsDefaultSupervisor: Standardansprechpartner
|
||||
TableIsDefaultReroute: Standardumleitung
|
||||
FormReqPostal: Benachrichtigungseinstellung
|
||||
FormReqPostalTip: Gilt für alle Benachrichtigungen an diese Person, nicht nur für Umleitungen an diesen Ansprechpartner
|
||||
ASReqEmpty: Es konnten keine Ansprechpartner hinzugefügt werden
|
||||
ASReqSetSupers n@Int64 postal@(Maybe Bool): #{n} Standardansprechpartner eingetragen #{maybeBoolMessage postal "" "und auf Briefversand geschaltet" "und Benachrichtigungen per Email gesetzt"}, aber nicht nicht aktiviert.
|
||||
RemoveSupervisors ndef@Int64 nact@Int64: #{ndef} Standard Ansprechpartner entfernt#{bool ", aber noch nicht deaktiviert" (", " <> tshow nact <> " aktive Ansprechpartnerbeziehungen gelöscht") (nact > 0)}
|
||||
FormFieldPostal: Benachrichtigungseinstellung
|
||||
FormFieldPostalTip: Gilt für alle Benachrichtigungen an diese Person, nicht nur für Umleitungen an diesen Ansprechpartner
|
||||
FirmUserChanges n@Int64: Benachrichtigungseinstellung für #{n} Firmenangehörige wurden geändert
|
||||
@ -3,16 +3,29 @@
|
||||
# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
FirmAssociates: Company associated users
|
||||
FirmContact: Company Contact
|
||||
FirmNoContact: No general contact information known.
|
||||
FirmEmail: General company email
|
||||
FirmAddress: Postal address
|
||||
FirmDefaultPreferenceInfo: Default setting for new company associates only
|
||||
FirmAllActNotify: Send message
|
||||
FirmAllActResetSupervision: Reset supervisors for all company associates
|
||||
FirmAction: Companywide action
|
||||
FirmActionInfo: Affects alle company associates.
|
||||
FirmActNotify: Send message
|
||||
FirmActResetSupervision: Reset supervisors for all company associates
|
||||
FirmActResetSuperKeep: Additionally keep existing supervisors of company associates?
|
||||
FirmActResetMutualSupervision: Supervisors supervise each other
|
||||
FirmActAddSupersvisors: Add supervisors
|
||||
FirmActAddSupersEmpty: No supervisors added
|
||||
FirmActAddSupersSet n postal: #{n} default company supervisors set #{maybeBoolMessage postal "" "and switched to postal notifications" "and switched to email notifications"}, but not yet activated.
|
||||
RemoveSupervisors ndef nact: #{ndef} default supervisors removed#{bool ", but not yet deactivated" (" and " <> tshow nact <> " active supervisons terminated") (nact > 0)}
|
||||
FirmActChangeContactUser: Change contact data for company associates
|
||||
FirmActChangeContactFirm: Change company contact data
|
||||
FirmActChangeContactFirmInfo: The company contact data is only used for new company associates that would habe no contact information of their own otherwise.
|
||||
FirmActChangeContactFirmResult: Company contact data changed, affecting future company associates without contact information only
|
||||
FirmUserActNotify: Send message
|
||||
FirmAllActResetSuperKeep: Additionally keep existing supervisors of company associates?
|
||||
FirmAllActResetMutualSupervision: Supervisors supervise each other
|
||||
FirmUserActResetSupervision: Reset supervisors to company default
|
||||
FirmResetSupervision rem set: #{tshow set} supervisors set#{bool mempty (", " <> tshow rem <> " deleted before") (rem > 0)}
|
||||
FirmUserActChangeContact: Change contact data for selected company associates
|
||||
FirmUserActMkSuper: Mark as company supervisor
|
||||
FirmSuperActNotify: Send message
|
||||
FirmSuperActRMSuperDef: Remove as default supervisor
|
||||
@ -32,9 +45,6 @@ FirmEmployeeOf fsh@CompanyShorthand: #{fsh} associated users
|
||||
NoCompanySelected: Select at least one company, please.
|
||||
TableIsDefaultSupervisor: Default supervisor
|
||||
TableIsDefaultReroute: Default reroute
|
||||
FormReqPostal: Notification type
|
||||
FormReqPostalTip: Affects all notifications to this person, not just reroutes to this supervisor
|
||||
ASReqEmpty: No supervisors added
|
||||
ASReqSetSupers n postal: #{n} default company supervisors set #{maybeBoolMessage postal "" "and switched to postal notifications" "and switched to email notifications"}, but not yet activated.
|
||||
RemoveSupervisors ndef nact: #{ndef} default supervisors removed#{bool ", but not yet deactivated" (" and " <> tshow nact <> " active supervisons terminated") (nact > 0)}
|
||||
FormFieldPostal: Notification type
|
||||
FormFieldPostalTip: Affects all notifications to this person, not just reroutes to this supervisor
|
||||
FirmUserChanges n: Notification settings changed for #{n} company associates
|
||||
@ -34,7 +34,7 @@ User json -- Each Uni2work user has a corresponding row in this table; create
|
||||
timeFormat DateTimeFormat "default='%R'" -- preferred Time-only display format for user; user-defined
|
||||
downloadFiles Bool default=false -- Should files be opened in browser or downloaded? (users often oblivious that their browser has a setting for this)
|
||||
languages Languages Maybe -- Preferred language; user-defined
|
||||
notificationSettings NotificationSettings "default='{}'::jsonb" -- Bit-array for which events email notifications are requested by user; user-defined
|
||||
notificationSettings NotificationSettings "default='{}'::jsonb" -- Bit-array for which events email notifications are requested by user; user-defined; missing fields in json object will be parsed to default trigger
|
||||
warningDays NominalDiffTime default=1209600 -- timedistance to pending deadlines for homepage infos
|
||||
csvOptions CsvOptions "default='{}'::jsonb"
|
||||
sex Sex Maybe -- currently ignored
|
||||
|
||||
4
routes
4
routes
@ -115,9 +115,9 @@
|
||||
|
||||
/firms FirmAllR GET POST !supervisor
|
||||
/firms/comm/+Companies FirmsCommR GET POST
|
||||
/firm/#CompanyShorthand FirmR GET POST
|
||||
/firm/#CompanyShorthand/debug FirmR GET POST
|
||||
/firm/#CompanyShorthand/comm FirmCommR GET POST
|
||||
/firm/#CompanyShorthand/users FirmUsersR GET POST !supervisor
|
||||
/firm/#CompanyShorthand FirmUsersR GET POST !supervisor
|
||||
/firm/#CompanyShorthand/supers FirmSupersR GET POST !supervisor
|
||||
|
||||
/exam-office ExamOfficeR !exam-office:
|
||||
|
||||
@ -223,7 +223,7 @@ let
|
||||
fi
|
||||
'';
|
||||
|
||||
killallUni2work = pkgs.writeScriptBin "killall-uni2work" ''
|
||||
killallUni2work = pkgs.writeScriptBin "killuni2work" ''
|
||||
#!${pkgs.zsh}/bin/zsh
|
||||
|
||||
set -o pipefail
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
{-# OPTIONS -Wno-unused-top-binds -Wno-unused-imports -Wno-unused-binds #-} -- TODO: remove me, for debugging only
|
||||
{-# OPTIONS -Wno-unused-top-binds #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-} -- needed for HasEntity instances
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
@ -32,7 +32,7 @@ import qualified Data.CaseInsensitive as CI
|
||||
import Database.Persist.Sql (deleteWhereCount, updateWhereCount)
|
||||
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.Legacy as EL (on)
|
||||
import qualified Database.Esqueleto.PostgreSQL as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
import Database.Esqueleto.Utils.TH
|
||||
@ -42,18 +42,186 @@ import Database.Esqueleto.Utils.TH
|
||||
single :: (k,a) -> Map k a
|
||||
single = uncurry Map.singleton
|
||||
|
||||
decryptUser :: (MonadHandler m, HandlerSite m ~ UniWorX) => CryptoUUIDUser -> m UserId
|
||||
decryptUser = decrypt
|
||||
-- decryptUser :: (MonadHandler m, HandlerSite m ~ UniWorX) => CryptoUUIDUser -> m UserId
|
||||
-- decryptUser = decrypt
|
||||
|
||||
encryptUser :: (MonadHandler m, HandlerSite m ~ UniWorX) => UserId -> m CryptoUUIDUser
|
||||
encryptUser = encrypt
|
||||
encryptUser = encrypt
|
||||
|
||||
postalEmailField :: (MonadHandler m, HandlerSite m ~ UniWorX) => Field m Bool
|
||||
postalEmailField = boolFieldCustom (SomeMessage MsgUtilPostal) (SomeMessage MsgUtilEMail) $ Just $ SomeMessage MsgUtilUnchanged
|
||||
|
||||
---------------------------------
|
||||
-- General firm affecting actions
|
||||
|
||||
data FirmAction = FirmActNotify
|
||||
| FirmActResetSupervision
|
||||
| FirmActAddSupersvisors
|
||||
| FirmActChangeContactFirm
|
||||
| FirmActChangeContactUser
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
|
||||
deriving anyclass (Universe, Finite)
|
||||
|
||||
nullaryPathPiece ''FirmAction $ camelToPathPiece' 1
|
||||
embedRenderMessage ''UniWorX ''FirmAction id
|
||||
|
||||
data FirmActionData = FirmActNotifyData
|
||||
| FirmActResetSupervisionData
|
||||
{ firmActResetKeepOldSupers :: Maybe Bool
|
||||
, firmActResetMutualSupervision :: Maybe Bool
|
||||
}
|
||||
| FirmActAddSupersvisorsData
|
||||
{ firmActAddSupervisorIds :: Set Text
|
||||
, firmActAddSupervisorReroute :: Bool
|
||||
, firmActAddSupervisorPostal :: Maybe Bool
|
||||
}
|
||||
| FirmActChangeContactFirmData
|
||||
{ firmActCCFPostalAddr :: Maybe StoredMarkup
|
||||
, firmActCCFEmail :: Maybe UserEmail
|
||||
, firmActCCFPostalPref :: Maybe Bool
|
||||
}
|
||||
| FirmActChangeContactUserData
|
||||
{ firmActCCUPostalAddr :: Maybe StoredMarkup
|
||||
, firmActCCUPostalPref :: Maybe Bool
|
||||
}
|
||||
deriving (Eq, Ord, Read, Show, Generic)
|
||||
|
||||
firmActionMap :: _ -> Bool -> [FirmAction] -> Map FirmAction (AForm Handler FirmActionData)
|
||||
firmActionMap mr isAdmin acts = mconcat (mkAct isAdmin <$> acts)
|
||||
where
|
||||
mkAct True FirmActNotify = singletonMap FirmActNotify $ pure FirmActNotifyData
|
||||
mkAct _ FirmActResetSupervision = singletonMap FirmActResetSupervision $ FirmActResetSupervisionData
|
||||
<$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep) (Just $ Just False)
|
||||
<*> aopt checkBoxField (fslI MsgFirmActResetMutualSupervision) (Just $ Just True )
|
||||
mkAct _ FirmActAddSupersvisors = singletonMap FirmActAddSupersvisors $ FirmActAddSupersvisorsData
|
||||
<$> areq (textField & cfAnySeparatedSet) (fslI MsgTableIsDefaultSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) Nothing
|
||||
<*> areq checkBoxField (fslI MsgTableIsDefaultReroute ) (Just True)
|
||||
<*> aopt postalEmailField (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip) Nothing
|
||||
mkAct _ FirmActChangeContactFirm = singletonMap FirmActChangeContactFirm $ FirmActChangeContactFirmData
|
||||
<$> aopt htmlField (fslI MsgPostAddress & setTooltip MsgPostAddressTip) Nothing
|
||||
<*> aopt (emailField & cfStrip & cfCI) (fslI MsgUserDisplayEmail) Nothing
|
||||
<*> aopt postalEmailField (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip) Nothing
|
||||
<* aformMessage (Message Info (toHtml $ mr MsgFirmActChangeContactFirmInfo) (Just IconNotificationNonactive))
|
||||
mkAct _ FirmActChangeContactUser = singletonMap FirmActChangeContactUser $ FirmActChangeContactUserData
|
||||
<$> aopt htmlField (fslI MsgPostAddress & setTooltip MsgPostAddressTip) Nothing
|
||||
<*> aopt postalEmailField (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip) Nothing
|
||||
mkAct _ _ = mempty
|
||||
|
||||
firmActionForm :: () -> Bool -> [FirmAction] -> AForm Handler FirmActionData
|
||||
firmActionForm mr isAdmin acts = multiActionA (firmActionMap mr isAdmin acts) (fslI MsgTableAction) Nothing
|
||||
|
||||
makeFirmActionForm :: CompanyId -> _ -> [FirmAction] -> Form (FirmActionData, Set CompanyId)
|
||||
makeFirmActionForm cid mr acts html = flip (renderAForm FormStandard) html $ (,Set.singleton cid) <$> firmActionForm mr acts
|
||||
|
||||
firmActionHandler :: Route UniWorX -> FormResult (FirmActionData, Set CompanyId) -> Handler ()
|
||||
firmActionHandler route = flip formResult faHandler
|
||||
where
|
||||
faHandler (_,fids) | null fids = addMessageI Error MsgNoCompanySelected
|
||||
faHandler (FirmActResetSupervisionData{..}, fids) = do
|
||||
runDB $ do
|
||||
delSupers <- if firmActResetKeepOldSupers == 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 (firmActResetMutualSupervision /= Just False) fids
|
||||
addMessageI Success $ MsgFirmResetSupervision delSupers newSupers
|
||||
reloadKeepGetParams route -- reload to reflect changes
|
||||
|
||||
faHandler (FirmActNotifyData, 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)
|
||||
E.where_ $ uc E.^. UserCompanyCompany `E.in_` E.valList fids
|
||||
return $ usr E.^. UserId
|
||||
cuids <- traverse (encrypt . E.unValue) usrs :: Handler [CryptoUUIDUser]
|
||||
redirect (FirmsCommR $ fmap unCompanyKey fids, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids])
|
||||
|
||||
faHandler (FirmActAddSupersvisorsData{..}, Set.toList -> [cid]) = do
|
||||
avsUsers :: Map Text (Maybe UserId) <- sequenceA $ Map.fromSet guessAvsUser firmActAddSupervisorIds
|
||||
let (usersFound', usersNotFound) = partition (is _Just . view _2) $ Map.toList avsUsers
|
||||
usersFound = mapMaybe snd usersFound'
|
||||
unless (null usersNotFound) $
|
||||
let msgContent = [whamlet|
|
||||
$newline never
|
||||
<ul>
|
||||
$forall (usr,_) <- usersNotFound
|
||||
<li>#{usr}
|
||||
|]
|
||||
in addMessageModal Error (i18n . MsgCourseParticipantsRegisterNotFoundInAvs $ length usersNotFound) (Right msgContent)
|
||||
when (null usersFound) $ do
|
||||
addMessageI Warning MsgFirmActAddSupersEmpty
|
||||
reloadKeepGetParams route
|
||||
runDB $ do
|
||||
putMany [UserCompany uid cid True firmActAddSupervisorReroute | uid <- usersFound]
|
||||
whenIsJust firmActAddSupervisorPostal $ \prefPostal ->
|
||||
updateWhere [UserId <-. usersFound] [UserPrefersPostal =. prefPostal]
|
||||
addMessageI Success $ MsgFirmActAddSupersSet (fromIntegral $ length usersFound) firmActAddSupervisorPostal
|
||||
redirect route
|
||||
|
||||
faHandler (FirmActChangeContactFirmData{..}, Set.toList -> [cid]) =
|
||||
let changes = catMaybes
|
||||
[ (CompanyPostAddress =.) . Just <$> canonical firmActCCFPostalAddr
|
||||
, (CompanyEmail =.) . Just <$> canonical firmActCCFEmail
|
||||
, (CompanyPrefersPostal =.) <$> firmActCCFPostalPref
|
||||
]
|
||||
in unless (null changes) $ do
|
||||
runDB $ updateBy (UniqueCompanyShorthand $ unCompanyKey cid) changes
|
||||
addMessageI Success MsgFirmActChangeContactFirmResult
|
||||
reloadKeepGetParams route
|
||||
|
||||
faHandler (FirmActChangeContactUserData{..}, Set.toList -> [cid]) =
|
||||
let changes = catMaybes
|
||||
[ (UserPostAddress E.=.) . E.justVal <$> canonical firmActCCUPostalAddr -- note that Nothing means no change and not delete address!
|
||||
, (UserPrefersPostal E.=.) . E.val <$> firmActCCUPostalPref
|
||||
]
|
||||
in unless (null changes) $ do
|
||||
nrChanged <- runDB $ E.updateCount $ \usr -> do
|
||||
E.set usr changes
|
||||
E.where_ $ E.exists $ do
|
||||
usrCmpy <- E.from $ E.table @UserCompany
|
||||
E.where_ $ usrCmpy E.^. UserCompanyCompany E.==. E.val cid
|
||||
E.&&. usrCmpy E.^. UserCompanyUser E.==. usr E.^. UserId
|
||||
addMessageI Success $ MsgFirmUserChanges nrChanged
|
||||
reloadKeepGetParams route -- reload to reflect changes
|
||||
|
||||
faHandler _ = addMessageI Error MsgErrorUnknownFormAction
|
||||
|
||||
|
||||
runFirmActionFormPost :: CompanyId -> Route UniWorX -> Bool -> [FirmAction] -> Handler Widget
|
||||
runFirmActionFormPost cid route isAdmin acts = do
|
||||
mr <- getMessageRender
|
||||
((faRes, faWgt), faEnctype) <- runFormPost . identifyForm FIDFirmAction $ makeFirmActionForm cid mr isAdmin acts
|
||||
let faAnchor = "firm-action-form" :: Text
|
||||
faRoute = route :#: faAnchor
|
||||
faForm = wrapForm faWgt FormSettings
|
||||
{ formMethod = POST
|
||||
, formAction = Just . SomeRoute $ faRoute
|
||||
, formEncoding = faEnctype
|
||||
, formAttrs = []
|
||||
, formSubmit = FormSubmit
|
||||
, formAnchor = Just faAnchor
|
||||
}
|
||||
firmActionHandler route faRes
|
||||
return [whamlet|
|
||||
<section>
|
||||
<h2 .show-hide__toggle uw-show-hide data-show-hide-collapsed>
|
||||
_{MsgFirmAction}
|
||||
<div>
|
||||
<p>
|
||||
_{MsgFirmActionInfo}
|
||||
<P>
|
||||
^{faForm}
|
||||
|]
|
||||
|
||||
|
||||
---------------------------
|
||||
-- Firm specific utilities
|
||||
-- for filters and counts also see before FirmAllR Handlers
|
||||
|
||||
postalEmailField :: (MonadHandler m, HandlerSite m ~ UniWorX) => Field m Bool
|
||||
postalEmailField = boolFieldCustom (SomeMessage MsgUtilPostal) (SomeMessage MsgUtilEMail) $ Just $ SomeMessage MsgUtilUnchanged
|
||||
|
||||
|
||||
-- remove supervisors:
|
||||
deleteSupervisors :: NonEmpty UserId -> DB Int64
|
||||
@ -68,9 +236,9 @@ resetSupervisors cid employees = do
|
||||
|
||||
-- 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
|
||||
addDefaultSupervisors cid employees = do
|
||||
E.insertSelectWithConflictCount UniqueUserSupervisor
|
||||
(do
|
||||
(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
|
||||
@ -83,12 +251,12 @@ addDefaultSupervisors cid employees = do
|
||||
|
||||
-- like `addDefaultSupervisors`, but selects all employees of given companies from database
|
||||
addDefaultSupervisorsAll :: (CompanyId ~ Element mono, MonoFoldable mono) => Bool -> mono -> DB Int64
|
||||
addDefaultSupervisorsAll mutualSupervision cids = do
|
||||
addDefaultSupervisorsAll mutualSupervision cids = do
|
||||
E.insertSelectWithConflictCount UniqueUserSupervisor
|
||||
(do
|
||||
(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_ $ E.and $ guardMonoid (not mutualSupervision)
|
||||
[ E.not_ $ usr E.^. UserCompanySupervisor ]
|
||||
E.where_ $ E.and $ guardMonoid (not mutualSupervision)
|
||||
[ E.not_ $ usr E.^. UserCompanySupervisor ]
|
||||
<> [ spr E.^. UserCompanySupervisor
|
||||
, spr E.^. UserCompanyCompany `E.in_` E.vals cids
|
||||
, usr E.^. UserCompanyCompany `E.in_` E.vals cids
|
||||
@ -142,7 +310,7 @@ firmCountEmployeeSupervised = E.subSelectCount . fromUserCompany (Just fltr)
|
||||
|
||||
firmCountEmployeeRerouted :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
|
||||
firmCountEmployeeRerouted = E.subSelectCount . fromUserCompany (Just fltr)
|
||||
where
|
||||
where
|
||||
fltr usrc = E.exists $ do
|
||||
usrSuper <- E.from $ E.table @UserSupervisor
|
||||
E.where_ $ usrSuper E.^. UserSupervisorUser E.==. usrc E.^. UserCompanyUser
|
||||
@ -150,7 +318,7 @@ firmCountEmployeeRerouted = E.subSelectCount . fromUserCompany (Just fltr)
|
||||
|
||||
firmCountEmployeeRerPost :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64)
|
||||
firmCountEmployeeRerPost = E.subSelectCount . fromUserCompany (Just fltr)
|
||||
where
|
||||
where
|
||||
fltr usrc = E.exists $ do
|
||||
(usrSuper :& usr) <-
|
||||
E.from $ E.table @UserSupervisor
|
||||
@ -208,7 +376,7 @@ firmCountUserSupervisors :: E.SqlExpr (Entity UserCompany) -> E.SqlExpr (E.Value
|
||||
firmCountUserSupervisors usrCmp = E.subSelectCount $ do
|
||||
usrSpr <- E.from $ E.table @UserSupervisor
|
||||
E.where_ $ usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser
|
||||
|
||||
|
||||
firmCountUserSupervisorsReroute :: E.SqlExpr (Entity UserCompany) -> E.SqlExpr (E.Value Word64)
|
||||
firmCountUserSupervisorsReroute usrCmp = E.subSelectCount $ do
|
||||
usrSpr <- E.from $ E.table @UserSupervisor
|
||||
@ -245,7 +413,7 @@ postFirmR fsh = do
|
||||
siteLayoutMsg (SomeMessage fsh) $ do
|
||||
setTitle $ citext2Html fsh
|
||||
[whamlet|
|
||||
<h2>PROVISORISCHE DEBUG SEITE
|
||||
<h2>PROVISORISCHE DEBUG SEITE
|
||||
<p>Diese Seite wird in der finalen Version nicht mehr enthalten sein.
|
||||
|
||||
<h3>#{length csuper} Company Default Supervisors (non-foreign only)
|
||||
@ -278,21 +446,6 @@ postFirmR fsh = do
|
||||
-----------------------
|
||||
-- All Firms Table
|
||||
|
||||
data FirmAllAction = FirmAllActNotify
|
||||
| FirmAllActResetSupervision
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
|
||||
deriving anyclass (Universe, Finite)
|
||||
|
||||
nullaryPathPiece ''FirmAllAction $ camelToPathPiece' 3
|
||||
embedRenderMessage ''UniWorX ''FirmAllAction id
|
||||
|
||||
data FirmAllActionData = FirmAllActNotifyData
|
||||
| FirmAllActResetSupervisionData
|
||||
{ firmAllActResetKeepOldSupers :: Maybe Bool
|
||||
, firmAllActResetMutualSupervision :: Maybe Bool
|
||||
}
|
||||
deriving (Eq, Ord, Read, Show, Generic)
|
||||
|
||||
-- just in case for future extensions
|
||||
type AllCompanyTableExpr = E.SqlExpr (Entity Company)
|
||||
queryAllCompany :: AllCompanyTableExpr -> E.SqlExpr (Entity Company)
|
||||
@ -315,9 +468,10 @@ resultAllCompanyDefaultReroutes :: Lens' AllCompanyTableData Bool
|
||||
resultAllCompanyDefaultReroutes = _dbrOutput . _4 . _unValue
|
||||
|
||||
|
||||
mkFirmAllTable :: Bool -> UserId -> DB (FormResult (FirmAllActionData, Set CompanyId), Widget)
|
||||
mkFirmAllTable :: Bool -> UserId -> DB (FormResult (FirmActionData, Set CompanyId), Widget)
|
||||
mkFirmAllTable isAdmin uid = do
|
||||
-- now <- liftIO getCurrentTime
|
||||
mr <- getMessageRender
|
||||
let
|
||||
resultDBTable = DBTable{..}
|
||||
where
|
||||
@ -325,7 +479,12 @@ mkFirmAllTable isAdmin uid = do
|
||||
unless isAdmin $ E.where_ $ E.exists $ do -- only show associated companies
|
||||
usrCmpy <- E.from $ E.table @UserCompany
|
||||
E.where_ $ usrCmpy E.^. UserCompanyCompany E.==. cmpy E.^. CompanyId
|
||||
E.&&. usrCmpy E.^. UserCompanyUser E.==. E.val uid
|
||||
E.&&. ((usrCmpy E.^. UserCompanyUser E.==. E.val uid E.&&. usrCmpy E.^. UserCompanySupervisor)
|
||||
E.||. E.exists (do
|
||||
usrSpr <- E.from $ E.table @UserSupervisor
|
||||
E.where_ $ usrSpr E.^. UserSupervisorUser E.==. usrCmpy E.^. UserCompanyUser
|
||||
E.&&. usrSpr E.^. UserSupervisorSupervisor E.==. E.val uid
|
||||
))
|
||||
return ( cmpy -- 1
|
||||
, cmpy & firmCountUsers -- 2
|
||||
, cmpy & firmHasSupervisors -- 3
|
||||
@ -349,12 +508,12 @@ mkFirmAllTable isAdmin uid = do
|
||||
, sortable (Just "avsnr") (i18nCell MsgTableCompanyNo) $ \(view resultAllCompany -> firm) ->
|
||||
anchorCell (FirmR $ companyShorthand firm) $ toWgt $ companyAvsId firm
|
||||
, sortable (Just "users") (i18nCell MsgTableCompanyNrUsers) $ \(view resultAllCompanyUsers -> nr) -> wgtCell $ word2widget nr
|
||||
, sortable (Just "supervisors") (i18nCell MsgTableCompanyNrSupersDefault) $ \row ->
|
||||
, 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
|
||||
-- , sortable (Just "emp-supervised")(i18nCell MsgTableCompanyNrEmpSupervised) $ \(view resultAllCompanyEmployeeSupervised -> nr) -> wgtCell $ word2widget nr
|
||||
-- , sortable (Just "emp-rerouted") (i18nCell MsgTableCompanyNrEmpRerouted) $ \(view resultAllCompanyEmployeeRerouted -> nr) -> wgtCell $ word2widget nr
|
||||
-- , sortable (Just "emp-rer-post") (i18nCell MsgTableCompanyNrEmpRerPost) $ \(view resultAllCompanyEmpRerPost -> nr) -> wgtCell $ word2widget nr
|
||||
-- , sortable (Just "emp-rer-post") (i18nCell MsgTableCompanyNrEmpRerPost) $ \(view resultAllCompanyEmpRerPost -> nr) -> wgtCell $ word2widget nr
|
||||
-- , sortable (Just "foreigners") (i18nCell MsgTableCompanyNrForeignSupers) $ \(view resultAllCompanyForeignSupers -> nr) -> wgtCell $ word2widget nr
|
||||
-- , sortable (Just "reroute-act") (i18nCell MsgTableCompanyNrRerouteActive) $ \(view resultAllCompanyActiveReroutes -> nr) -> wgtCell $ word2widget nr
|
||||
-- , sortable (Just "reroute-all") (i18nCell MsgTableCompanyNrRerouteActive) $ \(view resultAllCompanyActiveReroutes' -> nr) -> wgtCell $ word2widget nr
|
||||
@ -381,14 +540,14 @@ mkFirmAllTable isAdmin uid = do
|
||||
, single ("is-supervisor" , FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do
|
||||
(usr :& usrCmp) <- E.from $ E.table @User
|
||||
`E.innerJoin` E.table @UserCompany
|
||||
`E.on` (\(usr :& usrCmp) -> usr E.^. UserId E.==. usrCmp E.^. UserCompanyUser)
|
||||
`E.on` (\(usr :& usrCmp) -> usr E.^. UserId E.==. usrCmp E.^. UserCompanyUser)
|
||||
E.where_ $ usrCmp E.^. UserCompanyCompany E.==. queryAllCompany row E.^. CompanyId
|
||||
E.&&. ( (usr E.^. UserDisplayName `E.hasInfix` E.val criterion)
|
||||
E.||. (usr E.^. UserDisplayEmail `E.hasInfix` E.val (CI.mk criterion))
|
||||
E.||. (usr E.^. UserSurname `E.hasInfix` E.val criterion)
|
||||
)
|
||||
)
|
||||
, single ("foreign-supervisor", FilterColumn $ \row (getLast -> criterion) ->
|
||||
, single ("foreign-supervisor", FilterColumn $ \row (getLast -> criterion) ->
|
||||
-- let checkSuper = do -- expensive
|
||||
-- usrSpr <- E.from $ E.table @UserSupervisor
|
||||
-- E.where_ $ E.notExists (do
|
||||
@ -419,7 +578,7 @@ mkFirmAllTable isAdmin uid = do
|
||||
)
|
||||
, single ("company-postal", FilterColumn $ E.mkExactFilterLast $ views (to queryAllCompany) (E.isJust . (E.^. CompanyPostAddress)))
|
||||
]
|
||||
dbtFilterUI mPrev = mconcat
|
||||
dbtFilterUI mPrev = mconcat
|
||||
[ fltrCompanyNameUI mPrev
|
||||
, prismAForm (singletonFilter "company-number") mPrev $ aopt textField (fslI MsgTableCompanyNo)
|
||||
, prismAForm (singletonFilter "is-supervisor") mPrev $ aopt textField (fslI MsgTableSupervisor)
|
||||
@ -427,21 +586,12 @@ mkFirmAllTable isAdmin uid = do
|
||||
, prismAForm (singletonFilter "company-postal" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterFirmExtern)
|
||||
]
|
||||
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
|
||||
acts :: Map FirmAllAction (AForm Handler FirmAllActionData)
|
||||
acts = mconcat
|
||||
[ singletonMap FirmAllActNotify $ pure FirmAllActNotifyData
|
||||
, singletonMap FirmAllActResetSupervision $ FirmAllActResetSupervisionData
|
||||
<$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmAllActResetSuperKeep) (Just $ Just False)
|
||||
<*> aopt checkBoxField (fslI MsgFirmAllActResetMutualSupervision) (Just $ Just True )
|
||||
]
|
||||
dbtParams = DBParamsForm
|
||||
{ dbParamsFormMethod = POST
|
||||
, dbParamsFormAction = Nothing
|
||||
, dbParamsFormAttrs = []
|
||||
, dbParamsFormSubmit = FormSubmit
|
||||
, dbParamsFormAdditional
|
||||
= renderAForm FormStandard $ (, mempty) . First . Just
|
||||
<$> multiActionA acts (fslI MsgTableAction) Nothing
|
||||
, dbParamsFormAdditional = renderAForm FormStandard $ (, mempty) . First . Just <$> firmActionForm mr isAdmin [FirmActNotify, FirmActResetSupervision]
|
||||
, dbParamsFormEvaluate = liftHandler . runFormPost
|
||||
, dbParamsFormResult = id
|
||||
, dbParamsFormIdent = def
|
||||
@ -452,14 +602,14 @@ mkFirmAllTable isAdmin uid = do
|
||||
dbtCsvDecode = Nothing
|
||||
dbtExtraReps = []
|
||||
|
||||
postprocess :: FormResult (First FirmAllActionData, DBFormResult CompanyId Bool AllCompanyTableData)
|
||||
-> FormResult ( FirmAllActionData, Set CompanyId)
|
||||
postprocess :: FormResult (First FirmActionData, DBFormResult CompanyId Bool AllCompanyTableData)
|
||||
-> FormResult ( FirmActionData, Set CompanyId)
|
||||
postprocess inp = do
|
||||
(First (Just act), cmpMap) <- inp
|
||||
let cmpSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) cmpMap
|
||||
return (act, cmpSet)
|
||||
|
||||
-- resultDBTableValidator :: PSValidator (MForm Handler) (FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData))
|
||||
-- resultDBTableValidator :: PSValidator (MForm Handler) (FormResult (First FirmActionData, DBFormResult CompanyId Bool FirmActionData))
|
||||
resultDBTableValidator = def
|
||||
& defaultSorting [SortAscBy "short"]
|
||||
over _1 postprocess <$> dbTable resultDBTableValidator resultDBTable
|
||||
@ -469,33 +619,9 @@ getFirmAllR, postFirmAllR :: Handler Html
|
||||
getFirmAllR = postFirmAllR
|
||||
postFirmAllR = do
|
||||
uid <- requireAuthId
|
||||
isAdmin <- hasReadAccessTo AdminR
|
||||
isAdmin <- checkAdmin
|
||||
(firmRes, firmTable) <- runDB $ mkFirmAllTable isAdmin uid -- filters to associated companies for non-admins
|
||||
formResult firmRes $ \case
|
||||
(_, fids) | null fids -> addMessageI Error MsgNoCompanySelected
|
||||
|
||||
(FirmAllActResetSupervisionData{..}, fids) -> do
|
||||
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 delSupers newSupers
|
||||
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)
|
||||
E.where_ $ uc E.^. UserCompanyCompany `E.in_` E.valList fids
|
||||
return $ usr E.^. UserId
|
||||
cuids <- traverse (encrypt . E.unValue) usrs :: Handler [CryptoUUIDUser]
|
||||
redirect (FirmsCommR $ fmap unCompanyKey fids, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids])
|
||||
|
||||
firmActionHandler FirmAllR firmRes
|
||||
siteLayoutMsg MsgMenuFirms $ do
|
||||
setTitleI MsgMenuFirms
|
||||
$(i18nWidgetFile "firm-all")
|
||||
@ -504,28 +630,11 @@ postFirmAllR = do
|
||||
-----------------------
|
||||
-- Firm Users Table
|
||||
|
||||
data FirmUserChangeRequest = FirmUserChangeRequest
|
||||
{ fucrPostalPref :: Maybe Bool
|
||||
, fucrPostalAddr :: Maybe StoredMarkup
|
||||
}
|
||||
deriving (Eq, Ord, Show, Generic)
|
||||
|
||||
instance Default FirmUserChangeRequest where
|
||||
def = FirmUserChangeRequest
|
||||
{ fucrPostalPref = Nothing
|
||||
, fucrPostalAddr = Nothing
|
||||
}
|
||||
|
||||
makeFirmUserChangeRequestForm :: Maybe FirmUserChangeRequest -> Form FirmUserChangeRequest
|
||||
makeFirmUserChangeRequestForm template html = do
|
||||
flip (renderAForm FormStandard) html $ FirmUserChangeRequest
|
||||
<$> aopt postalEmailField (fslI MsgFormReqPostal & setTooltip MsgFormReqPostalTip) (fucrPostalPref <$> template)
|
||||
<*> aopt htmlField (fslI MsgPostAddress & setTooltip MsgPostAddressTip) (fucrPostalAddr <$> template)
|
||||
|
||||
|
||||
data FirmUserAction = FirmUserActNotify
|
||||
data FirmUserAction = FirmUserActNotify
|
||||
| FirmUserActResetSupervision
|
||||
| FirmUserActMkSuper
|
||||
| FirmUserActChangeContact
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
|
||||
deriving anyclass (Universe, Finite)
|
||||
|
||||
@ -534,12 +643,15 @@ embedRenderMessage ''UniWorX ''FirmUserAction id
|
||||
|
||||
data FirmUserActionData = FirmUserActNotifyData
|
||||
| FirmUserActResetSupervisionData
|
||||
{ firmUserActResetKeepOldSupers :: Maybe Bool
|
||||
{ firmUserActResetKeepOldSupers :: Maybe Bool
|
||||
-- , firmUserActResetMutualSupervision :: Maybe Bool
|
||||
}
|
||||
| FirmUserActMkSuperData
|
||||
{ firmUserActMkSuperReroute :: Maybe Bool }
|
||||
|
||||
| FirmUserActChangeContactData
|
||||
{ firmUserActPostalAddr :: Maybe StoredMarkup
|
||||
, firmUserActPostalPref :: Maybe Bool
|
||||
}
|
||||
deriving (Eq, Ord, Show, Generic)
|
||||
|
||||
type UserCompanyTableExpr = E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity UserCompany)
|
||||
@ -553,7 +665,7 @@ queryUserUserCompany = $(sqlIJproj 2 2)
|
||||
type UserCompanyTableData = DBRow (Entity User, Entity UserCompany, E.Value Word64, E.Value Word64)
|
||||
|
||||
resultUserUser :: Lens' UserCompanyTableData (Entity User)
|
||||
resultUserUser = _dbrOutput . _1
|
||||
resultUserUser = _dbrOutput . _1
|
||||
|
||||
resultUserUserCompany :: Lens' UserCompanyTableData (Entity UserCompany)
|
||||
resultUserUserCompany = _dbrOutput . _2
|
||||
@ -564,10 +676,10 @@ resultUserCompanySupervisors = _dbrOutput . _3 . _unValue
|
||||
resultUserCompanyReroutes :: Lens' UserCompanyTableData Word64
|
||||
resultUserCompanyReroutes = _dbrOutput . _4 . _unValue
|
||||
|
||||
instance HasEntity UserCompanyTableData User where
|
||||
instance HasEntity UserCompanyTableData User where
|
||||
hasEntity = resultUserUser
|
||||
|
||||
instance HasUser UserCompanyTableData where
|
||||
instance HasUser UserCompanyTableData where
|
||||
hasUser = resultUserUser . _entityVal
|
||||
|
||||
|
||||
@ -579,7 +691,7 @@ mkFirmUserTable isAdmin cid = do
|
||||
return Option{ optionDisplay = udn, optionInternalValue = uid, optionExternalValue = uuid }
|
||||
procOptions = fmap mkOptionList . traverse mkSprOption
|
||||
|
||||
rawSupers <- E.select $ do
|
||||
rawSupers <- E.select $ do
|
||||
usr <- E.from $ E.table @User
|
||||
E.where_ $ E.exists $ firmQuerySupervisedBy cid Nothing usr
|
||||
return (usr E.^. UserId, usr E.^. UserDisplayName)
|
||||
@ -619,16 +731,16 @@ mkFirmUserTable isAdmin cid = do
|
||||
]
|
||||
dbtFilter = mconcat
|
||||
[ single $ fltrUserNameEmail queryUserUser
|
||||
, singletonMap "has-supervisor" $ FilterColumn $ \row (getLast -> criterion) ->
|
||||
let checkSuper = do
|
||||
, singletonMap "has-supervisor" $ FilterColumn $ \row (getLast -> criterion) ->
|
||||
let checkSuper = do
|
||||
usrSpr <- E.from $ E.table @UserSupervisor
|
||||
E.where_ $ usrSpr E.^. UserSupervisorUser E.==. queryUserUser row E.^. UserId
|
||||
in case criterion of
|
||||
Nothing -> E.true
|
||||
Just True -> E.exists checkSuper
|
||||
Just False -> E.notExists checkSuper
|
||||
, singletonMap "has-company-supervisor" $ FilterColumn $ \row (getLast -> criterion) ->
|
||||
let checkSuper = do
|
||||
, singletonMap "has-company-supervisor" $ FilterColumn $ \row (getLast -> criterion) ->
|
||||
let checkSuper = do
|
||||
usrSpr <- E.from $ E.table @UserSupervisor
|
||||
E.where_ $ usrSpr E.^. UserSupervisorUser E.==. queryUserUser row E.^. UserId
|
||||
E.&&. E.exists (do
|
||||
@ -640,8 +752,8 @@ mkFirmUserTable isAdmin cid = do
|
||||
Nothing -> E.true
|
||||
Just True -> E.exists checkSuper
|
||||
Just False -> E.notExists checkSuper
|
||||
, singletonMap "has-foreign-supervisor" $ FilterColumn $ \row (getLast -> criterion) ->
|
||||
let checkSuper = do
|
||||
, singletonMap "has-foreign-supervisor" $ FilterColumn $ \row (getLast -> criterion) ->
|
||||
let checkSuper = do
|
||||
usrSpr <- E.from $ E.table @UserSupervisor
|
||||
E.where_ $ usrSpr E.^. UserSupervisorUser E.==. queryUserUser row E.^. UserId
|
||||
E.&&. E.notExists (do
|
||||
@ -654,20 +766,20 @@ mkFirmUserTable isAdmin cid = do
|
||||
Just True -> E.exists checkSuper
|
||||
Just False -> E.notExists checkSuper
|
||||
, singletonMap "supervisor-is" $ FilterColumn $ \row (getLast -> criterion) ->
|
||||
case criterion of
|
||||
Just uid -> do
|
||||
case criterion of
|
||||
Just uid -> do
|
||||
-- uid <- decryptUser uuid
|
||||
E.exists $ do
|
||||
E.exists $ do
|
||||
usrSpr <- E.from $ E.table @UserSupervisor
|
||||
E.where_ $ usrSpr E.^. UserSupervisorUser E.==. queryUserUser row E.^. UserId
|
||||
E.&&. usrSpr E.^. UserSupervisorSupervisor E.==. E.val uid
|
||||
_otherwise -> E.true
|
||||
, singletonMap "supervisors-are" $ FilterColumn $ \row criteria ->
|
||||
case criteria of
|
||||
case criteria of
|
||||
_ | Set.null criteria -> E.true
|
||||
| otherwise -> do
|
||||
-- uids <- traverse decryptUser criteria
|
||||
E.exists $ do
|
||||
E.exists $ do
|
||||
usrSpr <- E.from $ E.table @UserSupervisor
|
||||
E.where_ $ usrSpr E.^. UserSupervisorUser E.==. queryUserUser row E.^. UserId
|
||||
E.&&. usrSpr E.^. UserSupervisorSupervisor `E.in_` E.vals criteria
|
||||
@ -675,8 +787,8 @@ mkFirmUserTable isAdmin cid = do
|
||||
-- superField = selectField $ ????
|
||||
dbtFilterUI mPrev = mconcat
|
||||
[ fltrUserNameEmailHdrUI MsgTableCompanyUser mPrev
|
||||
, prismAForm (singletonFilter "supervisor-is" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift supervisorField) (fslI MsgFilterSupervisor)
|
||||
-- , prismAForm (multiFilter "supervisors-are" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift supervisorsField) (fslI MsgFilterSupervisor)
|
||||
, prismAForm (singletonFilter "supervisor-is" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift supervisorField) (fslI MsgFilterSupervisor)
|
||||
, prismAForm (multiFilter "supervisors-are" . maybePrism monoPathPieces) mPrev $ aopt (hoistField lift supervisorsField) (fslI MsgFilterSupervisor)
|
||||
, prismAForm (singletonFilter "has-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterSupervisor)
|
||||
, prismAForm (singletonFilter "has-company-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI $ MsgFilterSupervisorCompany fsh)
|
||||
, prismAForm (singletonFilter "has-foreign-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI $ MsgFilterSupervisorForeign fsh)
|
||||
@ -686,10 +798,13 @@ mkFirmUserTable isAdmin cid = do
|
||||
acts = mconcat
|
||||
[ singletonMap FirmUserActNotify $ pure FirmUserActNotifyData
|
||||
, singletonMap FirmUserActResetSupervision $ FirmUserActResetSupervisionData
|
||||
<$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmAllActResetSuperKeep) (Just $ Just False)
|
||||
-- <*> aopt checkBoxField (fslI MsgFirmAllActResetMutualSupervision) (Just $ Just True )
|
||||
<$> aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFirmActResetSuperKeep) (Just $ Just False)
|
||||
-- <*> aopt checkBoxField (fslI MsgFirmActResetMutualSupervision) (Just $ Just True )
|
||||
, singletonMap FirmUserActMkSuper $ FirmUserActMkSuperData
|
||||
<$> aopt checkBoxField (fslI MsgTableIsDefaultReroute) (Just $ Just True)
|
||||
, singletonMap FirmUserActChangeContact $ FirmUserActChangeContactData
|
||||
<$> aopt htmlField (fslI MsgPostAddress & setTooltip MsgPostAddressTip) Nothing
|
||||
<*> aopt postalEmailField (fslI MsgFormFieldPostal & setTooltip MsgFormFieldPostalTip) Nothing
|
||||
]
|
||||
dbtParams = DBParamsForm
|
||||
{ dbParamsFormMethod = POST
|
||||
@ -716,7 +831,7 @@ mkFirmUserTable isAdmin cid = do
|
||||
let s = Map.keysSet . Map.filter id $ getDBFormResult (const False) m
|
||||
return (act, s)
|
||||
|
||||
-- resultDBTableValidator :: PSValidator (MForm Handler) (FormResult (First FirmAllActionData, DBFormResult CompanyId Bool FirmAllActionData))
|
||||
-- resultDBTableValidator :: PSValidator (MForm Handler) (FormResult (First FirmActionData, DBFormResult CompanyId Bool FirmActionData))
|
||||
resultDBTableValidator = def
|
||||
& defaultSorting [SortAscBy "user-name"]
|
||||
over _1 postprocess <$> dbTable resultDBTableValidator resultDBTable
|
||||
@ -725,7 +840,7 @@ mkFirmUserTable isAdmin cid = do
|
||||
getFirmUsersR, postFirmUsersR :: CompanyShorthand -> Handler Html
|
||||
getFirmUsersR = postFirmUsersR
|
||||
postFirmUsersR fsh = do
|
||||
isAdmin <- hasReadAccessTo AdminR
|
||||
isAdmin <- checkAdmin
|
||||
let cid = CompanyKey fsh
|
||||
(( Entity{entityVal=Company{..}}
|
||||
, E.Value nrCompanyUsers
|
||||
@ -736,7 +851,7 @@ postFirmUsersR fsh = do
|
||||
, E.Value nrCompanyEmployeeRerPost
|
||||
, E.Value nrCompanyDefaultReroutes
|
||||
, E.Value nrCompanyActiveReroutes
|
||||
) , (fusrRes, fusrTable)) <- runDB $ (,)
|
||||
) , (fusrRes, fusrTable)) <- runDB $ (,)
|
||||
<$> fromMaybeM notFound (E.selectOne $ do
|
||||
cmpy <- E.from $ E.table @Company
|
||||
E.where_ $ cmpy E.^. CompanyId E.==. E.val cid
|
||||
@ -750,17 +865,17 @@ postFirmUsersR fsh = do
|
||||
, cmpy & firmCountDefaultReroutes
|
||||
, cmpy & firmCountActiveReroutes
|
||||
))
|
||||
-- superVs <- E.select $ do
|
||||
-- superVs <- E.select $ do
|
||||
-- usr <- E.from $ E.table @User
|
||||
-- E.where_ $ E.exists $ firmQuerySupervisedBy cmpyId Nothing usr
|
||||
-- return usr
|
||||
<*> mkFirmUserTable isAdmin cid
|
||||
<*> mkFirmUserTable isAdmin cid
|
||||
|
||||
formResult fusrRes $ \case
|
||||
formResult fusrRes $ \case
|
||||
(_, uids) | null uids -> addMessageI Error MsgUtilEmptyChoice
|
||||
(FirmUserActMkSuperData{..}, Set.toList -> uids) -> do
|
||||
(FirmUserActMkSuperData{..}, Set.toList -> uids) -> do
|
||||
nrMkSuper <- runDB $ updateWhereCount [UserCompanyUser <-. uids, UserCompanyCompany ==. cid] [UserCompanySupervisor =. True, UserCompanySupervisorReroute =. (firmUserActMkSuperReroute == Just True)]
|
||||
addMessageI Info $ MsgASReqSetSupers nrMkSuper Nothing
|
||||
addMessageI Info $ MsgFirmActAddSupersSet nrMkSuper Nothing
|
||||
reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
|
||||
(FirmUserActNotifyData , uids) -> do
|
||||
cuids <- traverse encrypt $ Set.toList uids :: Handler [CryptoUUIDUser]
|
||||
@ -769,45 +884,34 @@ postFirmUsersR fsh = do
|
||||
runDB $ do
|
||||
delSupers <- if firmUserActResetKeepOldSupers == Just False
|
||||
then deleteSupervisors uids
|
||||
else return 0
|
||||
else return 0
|
||||
newSupers <- addDefaultSupervisors cid uids
|
||||
addMessageI Info $ MsgFirmResetSupervision delSupers newSupers
|
||||
reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
|
||||
|
||||
((fucrRes, fucrWgt), fucrEnctype) <- runFormPost . identifyForm FIDFirmUserChangeRequest $ makeFirmUserChangeRequestForm (Just def)
|
||||
let addFormAnchor = "firm-user-change-form" :: Text
|
||||
routeForm = FirmUsersR fsh :#: addFormAnchor
|
||||
fucrForm = wrapForm fucrWgt FormSettings
|
||||
{ formMethod = POST
|
||||
, formAction = Just . SomeRoute $ routeForm
|
||||
, formEncoding = fucrEnctype
|
||||
, formAttrs = []
|
||||
, formSubmit = FormSubmit
|
||||
, formAnchor = Just addFormAnchor
|
||||
}
|
||||
formResult fucrRes $ \FirmUserChangeRequest{..} -> when (isJust fucrPostalPref || isJust fucrPostalAddr) $ do
|
||||
let changes = foldMap (\pp -> [UserPrefersPostal E.=. E.val pp]) fucrPostalPref <>
|
||||
foldMap (\pa -> [UserPostAddress E.=. E.justVal pa]) fucrPostalAddr -- seems weird, but: Nothing means no change, and not delete address!
|
||||
nrChanged <- runDB $ E.updateCount $ \usr -> do
|
||||
E.set usr changes
|
||||
E.where_ $ E.exists $ do
|
||||
usrCmpy <- E.from $ E.table @UserCompany
|
||||
E.where_ $ usrCmpy E.^. UserCompanyCompany E.==. E.val cid
|
||||
E.&&. usrCmpy E.^. UserCompanyUser E.==. usr E.^. UserId
|
||||
addMessageI Info $ MsgFirmUserChanges nrChanged
|
||||
reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
|
||||
(FirmUserActChangeContactData{..}, Set.toList -> uids) ->
|
||||
let changes = catMaybes
|
||||
[ (UserPostAddress =.) . Just <$> canonical firmUserActPostalAddr -- note that Nothing means no change and not delete address!
|
||||
, (UserPrefersPostal =.) <$> firmUserActPostalPref
|
||||
]
|
||||
in unless (null changes) $ do
|
||||
nrChanged <- runDB $ updateWhereCount [UserId <-. uids] changes
|
||||
addMessageI Success $ MsgFirmUserChanges nrChanged
|
||||
reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
|
||||
|
||||
formFirmAction <- runFirmActionFormPost cid (FirmUsersR fsh) isAdmin [FirmActNotify, FirmActResetSupervision, FirmActAddSupersvisors, FirmActChangeContactFirm, FirmActChangeContactUser]
|
||||
|
||||
siteLayout (citext2widget companyName) $ do
|
||||
setTitle $ toHtml $ CI.original companyShorthand <> "-" <> tshow companyAvsId
|
||||
let firmContactInfo = $(widgetFile "firm-contact-info")
|
||||
$(widgetFile "firm-users")
|
||||
|
||||
|
||||
-----------------------------
|
||||
-- Firm Supervisors Table
|
||||
|
||||
data FirmSuperAction = FirmSuperActNotify
|
||||
data FirmSuperAction = FirmSuperActNotify
|
||||
| FirmSuperActRMSuperDef
|
||||
|
||||
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
|
||||
deriving anyclass (Universe, Finite)
|
||||
|
||||
@ -817,32 +921,10 @@ embedRenderMessage ''UniWorX ''FirmSuperAction id
|
||||
data FirmSuperActionData = FirmSuperActNotifyData
|
||||
| FirmSuperActRMSuperDefData
|
||||
{ firmSuperActRMSuperActive :: Maybe Bool }
|
||||
|
||||
|
||||
deriving (Eq, Ord, Show, Generic)
|
||||
|
||||
|
||||
data AddSupervisorRequest = AddSupervisorRequest
|
||||
{ asReqSupers :: Set Text
|
||||
, asReqReroute :: Bool
|
||||
, asReqPostal :: Maybe Bool
|
||||
} deriving (Eq, Ord, Show, Generic)
|
||||
|
||||
instance Default AddSupervisorRequest where
|
||||
def = AddSupervisorRequest
|
||||
{ asReqSupers = mempty
|
||||
, asReqReroute = True
|
||||
, asReqPostal = Nothing
|
||||
}
|
||||
|
||||
makeAddSupervisorForm :: Maybe AddSupervisorRequest -> Form AddSupervisorRequest
|
||||
makeAddSupervisorForm template html = do
|
||||
flip (renderAForm FormStandard) html $ AddSupervisorRequest
|
||||
<$> areq (textField & cfAnySeparatedSet)
|
||||
(fslI MsgTableIsDefaultSupervisor & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) (asReqSupers <$> template)
|
||||
<*> areq checkBoxField (fslI MsgTableIsDefaultReroute ) (asReqReroute <$> template)
|
||||
<*> aopt postalEmailField (fslI MsgFormReqPostal & setTooltip MsgFormReqPostalTip) (asReqPostal <$> template)
|
||||
|
||||
|
||||
type SuperCompanyTableExpr = E.SqlExpr (Entity User) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity UserCompany))
|
||||
|
||||
querySuperUser :: SuperCompanyTableExpr -> E.SqlExpr (Entity User)
|
||||
@ -857,7 +939,7 @@ type SuperCompanyTableData = DBRow (Entity User, E.Value Word64, E.Value Word64
|
||||
)
|
||||
|
||||
resultSuperUser :: Lens' SuperCompanyTableData (Entity User)
|
||||
resultSuperUser = _dbrOutput . _1
|
||||
resultSuperUser = _dbrOutput . _1
|
||||
|
||||
resultSuperCompanySupervised :: Lens' SuperCompanyTableData Word64
|
||||
resultSuperCompanySupervised = _dbrOutput . _2 . _unValue
|
||||
@ -874,10 +956,10 @@ resultSuperCompanyDefaultSuper = _dbrOutput . _5 . _unValue
|
||||
resultSuperCompanyDefaultReroute :: Lens' SuperCompanyTableData (Maybe Bool)
|
||||
resultSuperCompanyDefaultReroute = _dbrOutput . _6 . _unValue
|
||||
|
||||
instance HasEntity SuperCompanyTableData User where
|
||||
instance HasEntity SuperCompanyTableData User where
|
||||
hasEntity = resultSuperUser
|
||||
|
||||
instance HasUser SuperCompanyTableData where
|
||||
instance HasUser SuperCompanyTableData where
|
||||
hasUser = resultSuperUser . _entityVal
|
||||
|
||||
|
||||
@ -899,7 +981,7 @@ mkFirmSuperTable isAdmin cid = do
|
||||
)
|
||||
dbtRowKey = querySuperUser >>> (E.^. UserId)
|
||||
dbtProj = dbtProjSimple $ \(usr, supervised, rerouted, supervisor, reroute) -> do
|
||||
cmps <- E.select $ do
|
||||
cmps <- E.select $ do
|
||||
(cmp :& usrCmp) <- E.from $ E.table @Company `E.innerJoin` E.table @UserCompany `E.on` (\(cmp :& usrCmp) -> cmp E.^. CompanyId E.==. usrCmp E.^. UserCompanyCompany)
|
||||
E.where_ $ usrCmp E.^. UserCompanyUser E.==. E.val (entityKey usr)
|
||||
E.orderBy [E.asc $ cmp E.^. CompanyName]
|
||||
@ -922,7 +1004,7 @@ mkFirmSuperTable isAdmin cid = do
|
||||
]
|
||||
dbtSorting = mconcat
|
||||
[ single $ sortUserNameLink querySuperUser
|
||||
, single $ sortUserEmail querySuperUser
|
||||
, single $ sortUserEmail querySuperUser
|
||||
, singletonMap "matriculation" $ SortColumn $ querySuperUser >>> (E.^. UserMatrikelnummer)
|
||||
, singletonMap "personal-number" $ SortColumn $ querySuperUser >>> (E.^. UserCompanyPersonalNumber)
|
||||
, singletonMap "postal-pref" $ SortColumn $ querySuperUser >>> (E.^. UserPrefersPostal)
|
||||
@ -947,7 +1029,7 @@ mkFirmSuperTable isAdmin cid = do
|
||||
acts :: Map FirmSuperAction (AForm Handler FirmSuperActionData)
|
||||
acts = mconcat
|
||||
[ singletonMap FirmSuperActNotify $ pure FirmSuperActNotifyData
|
||||
, singletonMap FirmSuperActRMSuperDef $ FirmSuperActRMSuperDefData
|
||||
, singletonMap FirmSuperActRMSuperDef $ FirmSuperActRMSuperDefData
|
||||
<$> aopt checkBoxField (fslI MsgFirmSuperActRMSuperActive) (Just $ Just True)
|
||||
]
|
||||
dbtParams = DBParamsForm
|
||||
@ -974,7 +1056,7 @@ mkFirmSuperTable isAdmin cid = do
|
||||
(First (Just act), m) <- inp
|
||||
let s = Map.keysSet . Map.filter id $ getDBFormResult (const False) m
|
||||
return (act, s)
|
||||
|
||||
|
||||
resultDBTableValidator = def
|
||||
& defaultSorting [SortAscBy "user-name"]
|
||||
over _1 postprocess <$> dbTable resultDBTableValidator resultDBTable
|
||||
@ -983,7 +1065,7 @@ mkFirmSuperTable isAdmin cid = do
|
||||
getFirmSupersR, postFirmSupersR :: CompanyShorthand -> Handler Html
|
||||
getFirmSupersR = postFirmSupersR
|
||||
postFirmSupersR fsh = do
|
||||
isAdmin <- hasReadAccessTo AdminR
|
||||
isAdmin <- checkAdmin
|
||||
let cid = CompanyKey fsh
|
||||
(Company{..},(fsprRes,fsprTable)) <- runDB $ (,)
|
||||
<$> get404 cid
|
||||
@ -991,7 +1073,7 @@ postFirmSupersR fsh = do
|
||||
|
||||
formResult fsprRes $ \case
|
||||
(_, uids) | null uids -> addMessageI Error MsgUtilEmptyChoice
|
||||
(FirmSuperActRMSuperDefData{..}, Set.toList -> uids) -> do
|
||||
(FirmSuperActRMSuperDefData{..}, Set.toList -> uids) -> do
|
||||
(nrRmSuper,nrRmActual) <- runDB $ (,)
|
||||
<$> updateWhereCount [UserCompanyUser <-. uids, UserCompanyCompany ==. cid] [UserCompanySupervisor =. False, UserCompanySupervisorReroute =. False]
|
||||
<*> if firmSuperActRMSuperActive /= Just True
|
||||
@ -1002,52 +1084,26 @@ postFirmSupersR fsh = do
|
||||
E.&&. E.exists (do
|
||||
usr <- E.from $ E.table @UserCompany
|
||||
E.where_ $ usr E.^. UserCompanyCompany E.==. E.val cid
|
||||
E.&&. usr E.^. UserCompanyUser E.==. spr E.^. UserSupervisorUser
|
||||
)
|
||||
E.&&. usr E.^. UserCompanyUser E.==. spr E.^. UserSupervisorUser
|
||||
)
|
||||
addMessageI Info $ MsgRemoveSupervisors nrRmSuper nrRmActual
|
||||
reloadKeepGetParams $ FirmUsersR fsh -- reload to reflect changes
|
||||
|
||||
(FirmSuperActNotifyData , uids) -> do
|
||||
|
||||
(FirmSuperActNotifyData , uids) -> do
|
||||
cuids <- traverse encrypt $ Set.toList uids :: Handler [CryptoUUIDUser]
|
||||
redirect (FirmCommR fsh, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cuids])
|
||||
|
||||
((asReqRes, asReqWgt), asReqEnctype) <- runFormPost . identifyForm FIDAddSupervisor $ makeAddSupervisorForm (Just def)
|
||||
let addSuperAnchor = "add-supervisors-form" :: Text
|
||||
routeAddSuperForm = FirmSupersR fsh :#: addSuperAnchor
|
||||
addSuperForm = wrapForm asReqWgt FormSettings
|
||||
{ formMethod = POST
|
||||
, formAction = Just . SomeRoute $ routeAddSuperForm
|
||||
, formEncoding = asReqEnctype
|
||||
, formAttrs = []
|
||||
, formSubmit = FormSubmit
|
||||
, formAnchor = Just addSuperAnchor
|
||||
}
|
||||
formResult asReqRes $ \AddSupervisorRequest{..} -> do
|
||||
avsUsers :: Map Text (Maybe UserId) <- sequenceA $ Map.fromSet guessAvsUser asReqSupers
|
||||
let (usersFound', usersNotFound) = partition (is _Just . view _2) $ Map.toList avsUsers
|
||||
usersFound = mapMaybe snd usersFound'
|
||||
unless (null usersNotFound) $
|
||||
let msgContent = [whamlet|
|
||||
$newline never
|
||||
<ul>
|
||||
$forall (usr,_) <- usersNotFound
|
||||
<li>#{usr}
|
||||
|]
|
||||
in addMessageModal Error (i18n . MsgCourseParticipantsRegisterNotFoundInAvs $ length usersNotFound) (Right msgContent)
|
||||
when (null usersFound) $ do
|
||||
addMessageI Warning MsgASReqEmpty
|
||||
redirect routeAddSuperForm
|
||||
runDB $ do
|
||||
putMany [UserCompany uid cid True asReqReroute | uid <- usersFound]
|
||||
whenIsJust asReqPostal $ \prefPostal ->
|
||||
updateWhere [UserId <-. usersFound] [UserPrefersPostal =. prefPostal]
|
||||
addMessageI Info $ MsgASReqSetSupers (fromIntegral $ length usersFound) asReqPostal
|
||||
redirect $ FirmSupersR fsh
|
||||
formFirmAction <- runFirmActionFormPost cid (FirmSupersR fsh) isAdmin [FirmActAddSupersvisors, FirmActResetSupervision, FirmActChangeContactFirm]
|
||||
|
||||
siteLayout (citext2widget fsh) $ do
|
||||
setTitle $ citext2Html $ fsh <> " Supers"
|
||||
let firmContactInfo = $(widgetFile "firm-contact-info")
|
||||
$(i18nWidgetFile "firm-supervisors")
|
||||
|
||||
|
||||
|
||||
------------------------
|
||||
-- Firm Communications
|
||||
|
||||
|
||||
getFirmCommR, postFirmCommR :: CompanyShorthand -> Handler Html
|
||||
getFirmCommR = postFirmCommR
|
||||
@ -1062,9 +1118,9 @@ postFirmsCommR = handleFirmCommR (SomeRoute FirmAllR)
|
||||
handleFirmCommR :: SomeRoute UniWorX -> Companies -> Handler Html
|
||||
handleFirmCommR _ [] = invalidArgs ["At least one company name must be provided."]
|
||||
handleFirmCommR ultDest cs = do
|
||||
let
|
||||
let
|
||||
queryGiven :: [UserId] -> E.SqlQuery (E.SqlExpr (Entity User)) -- get users from a list of UserIds
|
||||
queryGiven usrs = do
|
||||
queryGiven usrs = do
|
||||
usr <- E.from $ E.table @User
|
||||
E.where_ $ usr E.^. UserId `E.in_` E.valList usrs
|
||||
return usr
|
||||
@ -1074,14 +1130,14 @@ handleFirmCommR ultDest cs = do
|
||||
csKeys = CompanyKey <$> cs
|
||||
mbUser <- maybeAuthId
|
||||
-- get employees of chosen companies
|
||||
empys <- mkCompanyUsrList <$> runDB (E.select $ do
|
||||
empys <- mkCompanyUsrList <$> runDB (E.select $ do
|
||||
(emp :& cmp) <- E.from $ E.table @User `E.innerJoin` E.table @UserCompany `E.on` (\(emp :& cmp) -> emp E.^. UserId E.==. cmp E.^. UserCompanyUser)
|
||||
E.where_ $ cmp E.^. UserCompanyCompany `E.in_` E.valList csKeys
|
||||
E.where_ $ cmp E.^. UserCompanyCompany `E.in_` E.valList csKeys
|
||||
E.orderBy [E.ascNullsFirst $ cmp E.^. UserCompanyCompany]
|
||||
return (E.just $ cmp E.^. UserCompanyCompany, emp E.^. UserId)
|
||||
)
|
||||
-- get supervisors of employees
|
||||
sprs <- mkCompanyUsrList <$> runDB (E.select $ do
|
||||
-- get supervisors of employees
|
||||
sprs <- mkCompanyUsrList <$> runDB (E.select $ do
|
||||
(spr :& cmp) <- E.from $ E.table @User `E.leftJoin` E.table @UserCompany `E.on` (\(spr :& cmp) -> spr E.^. UserId E.=?. cmp E.?. UserCompanyUser)
|
||||
E.where_ $ (E.isTrue (cmp E.?. UserCompanySupervisor) E.&&. cmp E.?. UserCompanyCompany `E.in_` E.justValList csKeys)
|
||||
E.||. (spr E.^. UserId E.=?. E.val mbUser)
|
||||
@ -1092,24 +1148,24 @@ handleFirmCommR ultDest cs = do
|
||||
)
|
||||
E.orderBy [E.ascNullsFirst $ cmp E.?. UserCompanyCompany]
|
||||
return (cmp E.?. UserCompanyCompany, spr E.^. UserId)
|
||||
)
|
||||
|
||||
)
|
||||
|
||||
commR CommunicationRoute
|
||||
{ crHeading = SomeMessage $ case cs of { [c] -> MsgFirmNotification c ; _ -> MsgFirmsNotification }
|
||||
, crTitle = SomeMessage $ case cs of { [c] -> MsgFirmNotificationTitle c ; _ -> MsgFirmsNotificationTitle }
|
||||
, crUltDest = ultDest
|
||||
, crJobs = crJobsFirmCommunication cs -- :: Communication -> ConduitT () Job (YesodDB UniWorX) ()
|
||||
, crTestJobs = crTestFirmCommunication cs -- :: Communication -> ConduitT () Job (YesodDB UniWorX) ()
|
||||
, crRecipientAuth = Nothing -- :: Maybe (UserId -> DB AuthResult) -- an optional filter passed to guardAuthResult
|
||||
, crRecipients = -- :: [(RecipientGroup, SqlQuery (SqlExpr (Entity User)))]
|
||||
, crJobs = crJobsFirmCommunication cs -- :: Communication -> ConduitT () Job (YesodDB UniWorX) ()
|
||||
, crTestJobs = crTestFirmCommunication cs -- :: Communication -> ConduitT () Job (YesodDB UniWorX) ()
|
||||
, crRecipientAuth = Nothing -- :: Maybe (UserId -> DB AuthResult) -- an optional filter passed to guardAuthResult
|
||||
, crRecipients = -- :: [(RecipientGroup, SqlQuery (SqlExpr (Entity User)))]
|
||||
[(toGrp acid, queryGiven usrs) | (acid, usrs) <- Map.toAscList sprs ] ++
|
||||
[(RGFirmEmployees $ unCompanyKey acid, queryGiven usrs) | (Just acid, usrs) <- Map.toAscList empys ]
|
||||
}
|
||||
|
||||
{- Auswahlbox für Mitteilung:
|
||||
Wenn Firma gewählt, dann zeige:
|
||||
Alle Supervisor von Leuten in X, gruppiert nach deren Firma
|
||||
Alle Teilnehmer von X
|
||||
Alle Supervisor von Leuten in X, gruppiert nach deren Firma
|
||||
Alle Teilnehmer von X
|
||||
Wenn keine Firma gewählt, dann zeige:
|
||||
Alle Supervisor von gewählten Leuten, gruppiert nach deren Firma
|
||||
Alle gewählten Personen, gruppiert nach deren Firma
|
||||
|
||||
@ -70,6 +70,9 @@ data SettingsForm = SettingsForm
|
||||
, stgPrefersPostal :: Bool
|
||||
, stgPostAddress :: Maybe StoredMarkup
|
||||
|
||||
, stgTelephone :: Maybe Text
|
||||
, stgMobile :: Maybe Text
|
||||
|
||||
, stgExamOfficeSettings :: ExamOfficeSettings
|
||||
, stgSchools :: Set SchoolId
|
||||
, stgNotificationSettings :: NotificationSettings
|
||||
@ -129,9 +132,12 @@ makeSettingForm template html = do
|
||||
<*> apopt checkBoxField (fslI MsgShowSex & setTooltip MsgShowSexTip) (stgShowSex <$> template)
|
||||
|
||||
<* aformSection MsgFormNotifications
|
||||
<*> aopt (textField & cfStrip) (fslI MsgPDFPassword & setTooltip MsgPDFPasswordTip) (stgPinPassword <$> template)
|
||||
<*> aopt (textField & cfStrip) (fslI MsgPDFPassword & setTooltip MsgPDFPasswordTip) (stgPinPassword <$> template)
|
||||
<*> apopt checkBoxField (fslI MsgPrefersPostalExp & setTooltip MsgPostalTip) (stgPrefersPostal <$> template)
|
||||
<*> aopt htmlField (fslI MsgPostAddress & setTooltip MsgPostAddressTip) (stgPostAddress <$> template)
|
||||
<*> aopt htmlField (fslI MsgPostAddress & setTooltip MsgPostAddressTip) (stgPostAddress <$> template)
|
||||
|
||||
<*> aopt (textField & cfStrip) (fslI MsgUserTelephone) (stgTelephone <$> template)
|
||||
<*> aopt (textField & cfStrip) (fslI MsgUserMobile ) (stgMobile <$> template)
|
||||
|
||||
<*> examOfficeForm (stgExamOfficeSettings <$> template)
|
||||
<*> schoolsForm (stgSchools <$> template)
|
||||
@ -362,14 +368,14 @@ validateSettings User{..} = do
|
||||
validEmail' userDisplayEmail'
|
||||
|
||||
userPostAddress' <- use _stgPostAddress
|
||||
let postalNotSet = isNothing userPostAddress'
|
||||
let postalNotSet = isNothing userPostAddress' -- TODO $ canonical userPostAddress'
|
||||
postalIsValid = validPostAddress userPostAddress'
|
||||
guardValidation MsgUserPostalInvalid $
|
||||
postalNotSet || postalIsValid
|
||||
|
||||
userPrefersPostal' <- use _stgPrefersPostal
|
||||
guardValidation MsgUserPrefersPostalInvalid $
|
||||
not $ userPrefersPostal' && (postalNotSet || isJust userCompanyDepartment)
|
||||
not $ userPrefersPostal' && postalNotSet && isNothing userCompanyDepartment
|
||||
|
||||
userPinPassword' <- use _stgPinPassword
|
||||
let pinBad = validCmdArgument =<< userPinPassword'
|
||||
@ -439,6 +445,8 @@ serveProfileR (uid, user@User{..}) = do
|
||||
, stgPinPassword = userPinPassword
|
||||
, stgPostAddress = userPostAddress
|
||||
, stgPrefersPostal = userPrefersPostal
|
||||
, stgTelephone = userTelephone
|
||||
, stgMobile = userMobile
|
||||
, stgExamOfficeSettings = ExamOfficeSettings
|
||||
{ eosettingsGetSynced = userExamOfficeGetSynced
|
||||
, eosettingsGetLabels = userExamOfficeGetLabels
|
||||
@ -467,9 +475,11 @@ serveProfileR (uid, user@User{..}) = do
|
||||
, UserWarningDays =. stgWarningDays
|
||||
, UserNotificationSettings =. stgNotificationSettings
|
||||
, UserShowSex =. stgShowSex
|
||||
, UserPinPassword =. stgPinPassword
|
||||
, UserPostAddress =. stgPostAddress
|
||||
, UserPinPassword =. (stgPinPassword & canonical)
|
||||
, UserPostAddress =. (stgPostAddress & canonical)
|
||||
, UserPrefersPostal =. stgPrefersPostal
|
||||
, UserTelephone =. (stgTelephone & canonical)
|
||||
, UserMobile =. (stgMobile & canonical)
|
||||
, UserExamOfficeGetSynced =. (stgExamOfficeSettings & eosettingsGetSynced)
|
||||
, UserExamOfficeGetLabels =. (stgExamOfficeSettings & eosettingsGetLabels)
|
||||
]
|
||||
|
||||
@ -397,7 +397,7 @@ colSubmissionLink = sortable (Just "submission") (i18nCell MsgTableSubmission) $
|
||||
csh = x ^. resultCourseShorthand
|
||||
shn = x ^. resultSheet . _entityVal . _sheetName
|
||||
subCID = x ^. resultCryptoID
|
||||
in anchorCellC $cacheIdentHere (CSubmissionR tid ssh csh shn subCID SubShowR) (toPathPiece subCID)
|
||||
in anchorCell (CSubmissionR tid ssh csh shn subCID SubShowR) (toPathPiece subCID)
|
||||
|
||||
colSelect :: forall act h epId. (Semigroup act, Monoid act, Headedness h, Ord epId) => Colonnade h CorrectionTableData (DBCell _ (FormResult (act, DBFormResult CryptoFileNameSubmission Bool CorrectionTableData), SheetTypeSummary epId))
|
||||
colSelect = dbSelect (_1 . applying _2) id $ views resultCryptoID return
|
||||
|
||||
@ -146,7 +146,7 @@ redirectAlternatives = go
|
||||
reload :: (MonadHandler m, HandlerSite m ~ UniWorX) => Route (HandlerSite m) -> m a
|
||||
reload r = getCurrentRoute >>= redirect . fromMaybe r
|
||||
|
||||
-- | like `reload`, preserving all GET parameters
|
||||
-- | like `reload` to current route, but also preserving all GET parameters, using the current route, if known
|
||||
reloadKeepGetParams :: (MonadHandler m, HandlerSite m ~ UniWorX) => Route (HandlerSite m) -> m a
|
||||
reloadKeepGetParams r = liftHandler $ do
|
||||
getps <- reqGetParams <$> getRequest
|
||||
@ -155,7 +155,7 @@ reloadKeepGetParams r = liftHandler $ do
|
||||
-- RECALL: redirect GET parameters are used like so: -- redirect (UsersR, [("users-user-company","fraport")])
|
||||
redirect (route, getps)
|
||||
|
||||
-- | redirect preserving all GET parameters
|
||||
-- | like `reloadKeepGetParams`, but always leading to the specific route instead of the current route
|
||||
redirectKeepGetParams :: (MonadHandler m, HandlerSite m ~ UniWorX) => Route (HandlerSite m) -> m a
|
||||
redirectKeepGetParams route = liftHandler $ do
|
||||
getps <- reqGetParams <$> getRequest
|
||||
|
||||
@ -226,7 +226,7 @@ cellHasUserModal toLink user =
|
||||
nWdgt = nameWidget (userEntity ^. _entityVal . _userDisplayName) (userEntity ^. _entityVal . _userSurname)
|
||||
lWdgt = do
|
||||
uuid <- liftHandler $ encrypt uid
|
||||
modal nWdgt (Left $ SomeRoute $ toLink uuid)
|
||||
modalAccess False nWdgt nWdgt $ toLink uuid
|
||||
in cell lWdgt
|
||||
|
||||
-- | like `cellHasUserModal` but with fixed route and showing an edit icon instead
|
||||
@ -234,10 +234,10 @@ cellEditUserModal :: (IsDBTable m c, HasEntity u User) => u -> DBCell m c
|
||||
cellEditUserModal user =
|
||||
let userEntity = user ^. hasEntityUser
|
||||
uid = userEntity ^. _entityKey
|
||||
nWdgt = toWidget $ icon IconUserEdit
|
||||
nWdgt = toWidget $ icon IconUserEdit
|
||||
lWdgt = do
|
||||
uuid <- liftHandler $ encrypt uid
|
||||
modal nWdgt (Left $ SomeRoute $ ForProfileR uuid)
|
||||
modalAccess True nWdgt mempty $ ForProfileR uuid
|
||||
in cell lWdgt
|
||||
cellHasMatrikelnummer :: (IsDBTable m a, HasUser u) => u -> DBCell m a
|
||||
cellHasMatrikelnummer = maybe mempty textCell . view _userMatrikelnummer
|
||||
@ -246,7 +246,7 @@ cellHasMatrikelnummerLinked :: (IsDBTable m a, HasEntity u User) => u -> DBCell
|
||||
cellHasMatrikelnummerLinked usr
|
||||
| Just matNr <- usrEntity ^. _userMatrikelnummer = cell $ do
|
||||
uuid <- liftHandler $ encrypt $ usrEntity ^. _entityKey
|
||||
modal (text2widget matNr) (Left $ SomeRoute $ AdminAvsUserR uuid)
|
||||
modalAccess False (text2widget matNr) mempty (AdminAvsUserR uuid)
|
||||
| otherwise = mempty
|
||||
where
|
||||
usrEntity = usr ^. hasEntityUser
|
||||
@ -364,7 +364,7 @@ qualificationValidUntilCell' mbToLink d qb qu = cell $ case mbToLink of
|
||||
Nothing -> headWgt <> dateWgt
|
||||
Just toLink -> do
|
||||
uuid <- liftHandler $ encrypt $ qu ^. hasQualificationUser . _qualificationUserUser
|
||||
let modalWgt = modal dateWgt (Left $ SomeRoute $ toLink uuid)
|
||||
let modalWgt = modalAccess False dateWgt dateWgt $ toLink uuid
|
||||
headWgt <> modalWgt
|
||||
where
|
||||
dateWgt = formatTimeW SelFormatDate (qu ^. hasQualificationUser . _qualificationUserValidUntil)
|
||||
@ -385,7 +385,8 @@ qualificationValidReasonCell' mbToLink showReason d qb qu = ic <> foldMap blc qb
|
||||
dc tstamp
|
||||
| Just toLink <- mbToLink = cell $ do
|
||||
uuid <- liftHandler $ encrypt uid
|
||||
modal (formatTimeW SelFormatDate tstamp) (Left $ SomeRoute $ toLink uuid)
|
||||
let dWgt = formatTimeW SelFormatDate tstamp
|
||||
modalAccess False dWgt dWgt $ toLink uuid
|
||||
-- anchorCellM (toLink <$> encrypt uid)
|
||||
| otherwise = dateCell tstamp
|
||||
uid = qu ^. hasQualificationUser . _qualificationUserUser
|
||||
@ -403,7 +404,8 @@ qualificationValidReasonCell'' mbToLink showReason d qb qu extValid = ic <> icEr
|
||||
dc tstamp
|
||||
| Just toLink <- mbToLink = cell $ do
|
||||
uuid <- liftHandler $ encrypt uid
|
||||
modal (formatTimeW SelFormatDate tstamp) (Left $ SomeRoute $ toLink uuid)
|
||||
let dWgt = formatTimeW SelFormatDate tstamp
|
||||
modalAccess False dWgt dWgt $ toLink uuid
|
||||
-- anchorCellM (toLink <$> encrypt uid)
|
||||
| otherwise = dateCell tstamp
|
||||
uid = qu ^. hasQualificationUser . _qualificationUserUser
|
||||
@ -463,7 +465,8 @@ avsPersonNoCell = numCell . view _userAvsNoPerson
|
||||
avsPersonNoLinkedCell :: (IsDBTable m c, HasUserAvs a) => a -> DBCell m c
|
||||
avsPersonNoLinkedCell a = cell $ do
|
||||
uuid <- liftHandler $ encrypt $ a ^. _userAvsUser
|
||||
modal (toWgt $ toMessage $ a ^. _userAvsNoPerson) (Left $ SomeRoute $ AdminAvsUserR uuid)
|
||||
let nWgt = toWgt $ toMessage $ a ^. _userAvsNoPerson
|
||||
modalAccess False nWgt nWgt $ AdminAvsUserR uuid
|
||||
|
||||
avsPersonCardCell :: (IsDBTable m c) => Set AvsDataPersonCard -> DBCell m c
|
||||
avsPersonCardCell cards = wgtCell
|
||||
|
||||
@ -123,6 +123,15 @@ editedByW fmt tm usr = do
|
||||
[whamlet|_{MsgUtilEditedBy usr ft}|]
|
||||
|
||||
|
||||
-- | like `modal`, but checks access rights to the link
|
||||
modalAccess :: Bool -> Widget -> Widget -> Route UniWorX -> Widget
|
||||
modalAccess writeAccess wdgtYes wdgtNo route = do
|
||||
authOk <- liftHandler $ bool hasReadAccessTo hasWriteAccessTo writeAccess route
|
||||
if authOk
|
||||
then modal wdgtYes (Left $ SomeRoute route)
|
||||
else wdgtNo
|
||||
|
||||
|
||||
----------
|
||||
-- HEAT --
|
||||
----------
|
||||
|
||||
@ -50,6 +50,13 @@ data StoredMarkup = StoredMarkup
|
||||
deriving (Read, Show, Generic)
|
||||
deriving anyclass (Binary, Hashable, NFData)
|
||||
|
||||
instance Canonical (Maybe StoredMarkup) where
|
||||
canonical Nothing = Nothing
|
||||
canonical r@(Just s@StoredMarkup{..}) = let mi' = LT.strip markupInput in if
|
||||
| LT.null mi' -> Nothing
|
||||
| markupInput == mi' -> r
|
||||
| otherwise -> Just s{markupInput = mi'}
|
||||
|
||||
htmlToStoredMarkup :: Html -> StoredMarkup
|
||||
htmlToStoredMarkup html = StoredMarkup
|
||||
{ markupInputFormat = MarkupHtml
|
||||
|
||||
14
src/Utils.hs
14
src/Utils.hs
@ -1986,3 +1986,17 @@ instance {-# OVERLAPPABLE #-} (Canonical mono, MonoFoldable mono, Eq mono) => Ca
|
||||
-- this instance is more of a convenient abuse of the class (expand to Foldable)
|
||||
instance (Ord a, Canonical a) => Canonical (Set a) where
|
||||
canonical = Set.map canonical
|
||||
|
||||
instance Canonical (Maybe Text) where -- a split into Canonical Text and Canonical a => Maybe seems nicer, but the latter instance would be troublesome
|
||||
canonical Nothing = Nothing
|
||||
canonical r@(Just t) = let t' = Text.strip t in if
|
||||
| Text.null t' -> Nothing
|
||||
| t == t' -> r
|
||||
| otherwise -> Just t'
|
||||
|
||||
instance Canonical (Maybe (CI Text)) where -- a split into Canonical Text and Canonical a => Maybe seems nicer, but the latter instance would be troublesome
|
||||
canonical Nothing = Nothing
|
||||
canonical r@(Just t) = let t' = CI.map Text.strip t in if
|
||||
| mempty == t'-> Nothing
|
||||
| t == t' -> r
|
||||
| otherwise -> Just t'
|
||||
|
||||
@ -318,6 +318,7 @@ data FormIdentifier
|
||||
| FIDHijackUser
|
||||
| FIDAddSupervisor
|
||||
| FIDFirmUserChangeRequest
|
||||
| FIDFirmAction
|
||||
deriving (Eq, Ord, Read, Show)
|
||||
|
||||
instance PathPiece FormIdentifier where
|
||||
|
||||
@ -38,7 +38,7 @@ customModal Modal{..} = do
|
||||
route <- traverse toTextUrl $ modalContent ^? _Left
|
||||
modalTrigger route triggerId'
|
||||
|
||||
-- | Create a link to a modal
|
||||
-- | Create a link to a modal, does not check link, see `Handler.Utils.Widget.modalAccess` for a checking variant
|
||||
modal :: WidgetFor site () -- ^ Widget that represents the link
|
||||
-> Either (SomeRoute site) (WidgetFor site ()) -- ^ Modal contant: either dynamic link or static widget
|
||||
-> WidgetFor site () -- ^ result widget
|
||||
|
||||
27
templates/firm-contact-info.hamlet
Normal file
27
templates/firm-contact-info.hamlet
Normal file
@ -0,0 +1,27 @@
|
||||
$newline never
|
||||
|
||||
$# SPDX-FileCopyrightText: 2023 Steffen Jost <jost@tcs.ifi.lmu.de>
|
||||
$#
|
||||
$# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
<section .profile>
|
||||
<h2>_{MsgFirmContact}
|
||||
<dl .deflist.profile-dl>
|
||||
$maybe fem <- companyEmail
|
||||
<dt .deflist__dt>
|
||||
_{MsgFirmEmail}
|
||||
$if not companyPrefersPostal
|
||||
#{iconLetterOrEmail False}
|
||||
<dd .deflist__dd .email>
|
||||
#{mailtoHtml fem}
|
||||
$maybe addr <- companyPostAddress
|
||||
<dt .deflist__dt>
|
||||
_{MsgFirmAddress}
|
||||
$if companyPrefersPostal
|
||||
#{iconLetterOrEmail True}
|
||||
<dd .deflist__dd>
|
||||
#{addr}
|
||||
$nothing
|
||||
$maybe _ <- companyEmail
|
||||
$nothing
|
||||
_{MsgFirmNoContact}
|
||||
@ -4,18 +4,9 @@ $# SPDX-FileCopyrightText: 2023 Steffen Jost <jost@tcs.ifi.lmu.de>
|
||||
$#
|
||||
$# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
<section .profile>
|
||||
<dl .deflist.profile-dl>
|
||||
$maybe fem <- companyEmail
|
||||
<dt .deflist__dt>
|
||||
_{MsgFirmEmail} #{iconLetterOrEmail False}
|
||||
<dd .deflist__dd .email>
|
||||
#{mailtoHtml fem}
|
||||
$maybe addr <- companyPostAddress
|
||||
<dt .deflist__dt>
|
||||
_{MsgFirmAddress} #{iconLetterOrEmail True}
|
||||
<dd .deflist__dd>
|
||||
#{addr}
|
||||
^{firmContactInfo}
|
||||
|
||||
^{formFirmAction}
|
||||
|
||||
<section>
|
||||
<div .scrolltable .scrolltable--bordered>
|
||||
@ -66,6 +57,3 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
_{MsgFirmAssociates}
|
||||
<p>
|
||||
^{fusrTable}
|
||||
|
||||
<section>
|
||||
^{fucrForm}
|
||||
@ -9,19 +9,13 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
Daraus folgt zum Beispiel, dass wenn <em>x</em> ein Standard-Ansprechpartner für Firma <em>a</em> ist
|
||||
und wenn <em>y</em> sowohl Firma <em>a</em> als auch <em>b</em> angehört,
|
||||
dass dann <em>x</em> als firmenfremd in der Liste der Ansprechpartner von Firma <em>b</em> angezeigt wird.
|
||||
<section .profile>
|
||||
<dl .deflist.profile-dl>
|
||||
$maybe fem <- companyEmail
|
||||
<dt .deflist__dt>
|
||||
_{MsgFirmEmail} #{iconLetterOrEmail False}
|
||||
<dd .deflist__dd .email>
|
||||
#{mailtoHtml fem}
|
||||
$maybe addr <- companyPostAddress
|
||||
<dt .deflist__dt>
|
||||
_{MsgFirmAddress} #{iconLetterOrEmail True}
|
||||
<dd .deflist__dd>
|
||||
#{addr}
|
||||
|
||||
^{firmContactInfo}
|
||||
|
||||
^{formFirmAction}
|
||||
|
||||
<section>
|
||||
^{fsprTable}
|
||||
<section>
|
||||
^{addSuperForm}
|
||||
<h2>
|
||||
_{MsgTableSupervisor}
|
||||
<div>
|
||||
^{fsprTable}
|
||||
|
||||
@ -8,19 +8,14 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
Note that supervision is company independent.
|
||||
For example, if <em>x</em> is a regular supervisor for company <em>a</em> and <em>y</em> belongs to companies <em>a</em> and <em>b</em>,
|
||||
then <em>x</em> will be listed as a foreign supervisor for company <em>b</em>.
|
||||
<section .profile>
|
||||
<dl .deflist.profile-dl>
|
||||
$maybe fem <- companyEmail
|
||||
<dt .deflist__dt>
|
||||
_{MsgFirmEmail} #{iconLetterOrEmail False}
|
||||
<dd .deflist__dd .email>
|
||||
#{mailtoHtml fem}
|
||||
$maybe addr <- companyPostAddress
|
||||
<dt .deflist__dt>
|
||||
_{MsgFirmAddress} #{iconLetterOrEmail True}
|
||||
<dd .deflist__dd>
|
||||
#{addr}
|
||||
|
||||
^{firmContactInfo}
|
||||
|
||||
^{formFirmAction}
|
||||
|
||||
<section>
|
||||
^{fsprTable}
|
||||
<section>
|
||||
^{addSuperForm}
|
||||
<h2>
|
||||
_{MsgTableSupervisor}
|
||||
<div>
|
||||
^{fsprTable}
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user