chore(lms): remove debug code
This commit is contained in:
parent
75e4975c52
commit
b1ce55597e
@ -35,7 +35,7 @@ FirmSuperActNotify: Mitteilung versenden
|
||||
FirmSuperActRMSuperDef: Standard Firmenansprechpartner entfernen
|
||||
FirmSuperActRMSuperActive: Auch aktive Ansprechpartnerbeziehungen innerhalb dieser Firma beenden
|
||||
FirmsNotification: Firmen E-Mail versenden
|
||||
FirmNotification fsh@CompanyShorthand: Benachrichtigung an #{fsh} versenden
|
||||
FirmNotification fsh@CompanyShorthand: E-Mail an #{fsh} senden
|
||||
FirmsNotificationTitle: Firmen benachrichtigen
|
||||
FirmNotificationTitle fsh@CompanyShorthand: #{fsh} benachrichtigen
|
||||
FilterSupervisor: Hat aktiven Ansprechpartner
|
||||
|
||||
@ -35,7 +35,7 @@ FirmSuperActNotify: Send message
|
||||
FirmSuperActRMSuperDef: Remove as default supervisor
|
||||
FirmSuperActRMSuperActive: Also remove active supervisions within this company
|
||||
FirmsNotification: Send company notification e-mail
|
||||
FirmNotification fsh: Send notification to company #{fsh}
|
||||
FirmNotification fsh: Send e-mail to #{fsh}
|
||||
FirmsNotificationTitle: Company notification
|
||||
FirmNotificationTitle fsh@CompanyShorthand: #{fsh} notification
|
||||
FilterSupervisor: Has active supervisor
|
||||
|
||||
@ -10,6 +10,7 @@ BoolIrrelevant !ident-ok: —
|
||||
FieldPrimary: Hauptfach
|
||||
FieldSecondary: Nebenfach
|
||||
MultiEmailFieldTip: Es sind mehrere, Komma-separierte, E-Mail-Adressen möglich
|
||||
MultiSelectTip: Mehrfachauswahl mit Strg-Klick
|
||||
WeekDay: Wochentag
|
||||
LdapIdentificationOrEmail: Fraport AG-Kennung / E-Mail-Adresse
|
||||
Months num@Int64: #{num} #{pluralDE num "Monat" "Monate"}
|
||||
|
||||
@ -10,6 +10,7 @@ BoolIrrelevant: —
|
||||
FieldPrimary: Major
|
||||
FieldSecondary: Minor
|
||||
MultiEmailFieldTip: Multiple emails addresses may be specified (comma-separated)
|
||||
MultiSelectTip: Multiple selection via Ctrl-Click
|
||||
WeekDay: Day of the week
|
||||
LdapIdentificationOrEmail: Fraport AG-Kennung / email address
|
||||
Months num: #{num} #{pluralEN num "Month" "Months"}
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
--
|
||||
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
||||
|
||||
-- The files in /models determine the database scheme.
|
||||
-- The files in /models determine t he database scheme.
|
||||
-- The organisational split into several files has no operational effects.
|
||||
-- White-space and case matters: Each SQL table is named in 1st column of this file
|
||||
-- Indendent lower-case lines describe the SQL-columns of the table with name, type and options
|
||||
|
||||
1
routes
1
routes
@ -115,7 +115,6 @@
|
||||
|
||||
/firms FirmAllR GET POST -- not yet !supervisor
|
||||
/firms/comm/+Companies FirmsCommR GET POST
|
||||
/firm/#CompanyShorthand/debug FirmR GET POST
|
||||
/firm/#CompanyShorthand/comm FirmCommR GET POST
|
||||
/firm/#CompanyShorthand FirmUsersR GET POST -- not yet !supervisor
|
||||
/firm/#CompanyShorthand/supers FirmSupersR GET POST -- not yet !supervisor
|
||||
|
||||
@ -125,7 +125,6 @@ breadcrumb ProblemAvsErrorR = i18nCrumb MsgProblemsAvsErrorHeading $ Just
|
||||
|
||||
breadcrumb FirmAllR = i18nCrumb MsgMenuFirms Nothing
|
||||
breadcrumb FirmsCommR{} = i18nCrumb MsgMenuFirmsComm $ Just FirmAllR
|
||||
breadcrumb FirmR{} = i18nCrumb MsgMenuAdminHeading $ Just FirmAllR -- TODO: change heading or remove
|
||||
breadcrumb FirmUsersR{} = i18nCrumb MsgMenuFirmUsers $ Just FirmAllR
|
||||
breadcrumb (FirmSupersR fsh)= i18nCrumb MsgMenuFirmSupervisors $ Just $ FirmUsersR fsh
|
||||
breadcrumb (FirmCommR fsh)= i18nCrumb MsgMenuFirmsComm $ Just $ FirmUsersR fsh
|
||||
@ -2417,16 +2416,6 @@ pageActions ApiDocsR = return
|
||||
, navChildren = []
|
||||
}
|
||||
]
|
||||
pageActions (FirmR fsh) = return
|
||||
[ NavPageActionPrimary
|
||||
{ navLink = defNavLink MsgTableCompanyNrSupers $ FirmSupersR fsh
|
||||
, navChildren = []
|
||||
}
|
||||
, NavPageActionPrimary
|
||||
{ navLink = defNavLink MsgTableCompanyNrUsers $ FirmUsersR fsh
|
||||
, navChildren = []
|
||||
}
|
||||
]
|
||||
pageActions (FirmUsersR fsh) = return
|
||||
[ NavPageActionPrimary
|
||||
{ navLink = defNavLink MsgTableCompanyNrSupers $ FirmSupersR fsh
|
||||
|
||||
@ -558,7 +558,7 @@ mkLicenceTable apidStatus dbtIdent aLic apids = do
|
||||
return (comp E.^. CompanyShorthand, comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor)
|
||||
let icnSuper = toWidget $ text2markup " " <> icon IconSupervisor
|
||||
companies =
|
||||
(\(E.Value cmpSh, E.Value cmpName, E.Value cmpSpr) -> simpleLink (citext2widget cmpName) (FirmR cmpSh) <> bool mempty icnSuper cmpSpr) <$> companies'
|
||||
(\(E.Value cmpSh, E.Value cmpName, E.Value cmpSpr) -> simpleLink (citext2widget cmpName) (FirmUsersR cmpSh) <> bool mempty icnSuper cmpSpr) <$> companies'
|
||||
|
||||
pure $ intercalate (text2widget "; ") companies
|
||||
, sortable (Just "qualification") (i18nCell MsgTableQualifications) $ \(preview resultQualification -> q) -> cellMaybe lmsShortCell q
|
||||
|
||||
@ -7,8 +7,7 @@
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
|
||||
module Handler.Firm
|
||||
( getFirmAllR , postFirmAllR
|
||||
, getFirmR , postFirmR
|
||||
( getFirmAllR , postFirmAllR
|
||||
, getFirmUsersR , postFirmUsersR
|
||||
, getFirmSupersR, postFirmSupersR
|
||||
, getFirmCommR , postFirmCommR
|
||||
@ -415,65 +414,6 @@ firmCountUserSupervisorsReroute usrCmp = E.subSelectCount $ do
|
||||
E.&&. usrSpr E.^. UserSupervisorRerouteNotifications
|
||||
|
||||
|
||||
------------------
|
||||
-- Debug Handler
|
||||
|
||||
getFirmR, postFirmR :: CompanyShorthand -> Handler Html
|
||||
getFirmR = postFirmR
|
||||
postFirmR fsh = do
|
||||
let cid = CompanyKey fsh
|
||||
cusers <- runDB $ do
|
||||
cusers <- selectList [UserCompanyCompany ==. cid] []
|
||||
selectList [UserId <-. fmap (userCompanyUser . entityVal) cusers] [Asc UserDisplayName]
|
||||
csuper <- runDB $ do
|
||||
csuper <- selectList [UserCompanyCompany ==. cid, UserCompanySupervisor ==. True] []
|
||||
selectList [UserId <-. fmap (userCompanyUser . entityVal) csuper] [Asc UserDisplayName]
|
||||
cactSuper <- runDB $ E.select $ do
|
||||
(usr :& spr :& scmpy) <- E.from $
|
||||
E.table @User
|
||||
`E.innerJoin` E.table @UserSupervisor
|
||||
`E.on` (\(usr :& spr ) -> spr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId)
|
||||
`E.leftJoin` E.table @UserCompany
|
||||
`E.on` (\(_ :& spr :& scmpy) -> spr E.^. UserSupervisorSupervisor E.=?. scmpy E.?. UserCompanyUser)
|
||||
E.where_ $ (spr E.^. UserSupervisorUser) `E.in_` E.valList (entityKey <$> cusers)
|
||||
E.groupBy (usr E.^. UserId, usr E.^. UserDisplayName, usr E.^. UserSurname, scmpy E.?. UserCompanyCompany)
|
||||
E.orderBy [E.asc $ usr E.^. UserId, E.asc $ usr E.^. UserDisplayName, E.asc $ usr E.^. UserSurname, E.asc $ scmpy E.?. UserCompanyCompany]
|
||||
let countRows' :: E.SqlExpr (E.Value Int64) = E.countRows
|
||||
return (usr E.^. UserId, usr E.^. UserDisplayName, usr E.^. UserSurname, scmpy E.?. UserCompanyCompany, countRows', usr E.^. UserPrefersPostal)
|
||||
|
||||
siteLayoutMsg (SomeMessage fsh) $ do
|
||||
setTitle $ citext2Html fsh
|
||||
[whamlet|
|
||||
<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)
|
||||
<ul>
|
||||
$forall u <- csuper
|
||||
<li>^{linkUserWidget ForProfileDataR u}
|
||||
|
||||
<h3>#{length cactSuper} Active Supervisors for Employees
|
||||
<ul>
|
||||
$forall (E.Value _, E.Value dn, E.Value sn, E.Value mbCsh, E.Value nr, E.Value prefPost) <- cactSuper
|
||||
<li>#{nr} Employees supervised by ^{nameWidget dn sn} #
|
||||
#{iconLetterOrEmail prefPost} #
|
||||
$maybe csh <- mbCsh
|
||||
$if csh /= cid
|
||||
from foreign company #{unCompanyKey csh}
|
||||
$else
|
||||
from this company
|
||||
$nothing
|
||||
having no associated company
|
||||
|
||||
<h3>#{length cusers} Employees
|
||||
<ul>
|
||||
$forall u <- cusers
|
||||
<li>^{linkUserWidget ForProfileDataR u}
|
||||
|
||||
In the end, this needs to be a dbTable, of course!
|
||||
|]
|
||||
|
||||
|
||||
-----------------------
|
||||
-- All Firms Table
|
||||
|
||||
@ -536,8 +476,7 @@ mkFirmAllTable isAdmin uid = do
|
||||
, sortable (Just "short") (i18nCell MsgTableCompanyShort) $ \(view resultAllCompany -> firm) ->
|
||||
let fsh = companyShorthand firm
|
||||
in anchorCell (FirmSupersR fsh) $ toWgt fsh
|
||||
, sortable (Just "avsnr") (i18nCell MsgTableCompanyNo) $ \(view resultAllCompany -> firm) ->
|
||||
anchorCell (FirmR $ companyShorthand firm) $ toWgt $ companyAvsId firm
|
||||
, sortable (Just "avsnr") (i18nCell MsgTableCompanyNo) $ \(view resultAllCompany -> firm) -> numCell $ companyAvsId firm
|
||||
, sortable (Just "users") (i18nCell MsgTableCompanyNrUsers) $ \(view resultAllCompanyUsers -> nr) -> wgtCell $ word2widget nr
|
||||
, sortable (Just "supervisors") (i18nCell MsgTableCompanyNrSupersDefault) $ \row ->
|
||||
anchorCell (FirmSupersR $ row ^. resultAllCompany . _companyShorthand) $ toWgt $ hasTickmark $ row ^. resultAllCompanySupervisors
|
||||
@ -826,7 +765,7 @@ mkFirmUserTable isAdmin cid = do
|
||||
dbtFilterUI mPrev = mconcat
|
||||
[ fltrUserNameEmailHdrUI MsgTableCompanyUser mPrev
|
||||
-- , 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 (multiFilter "supervisors-are" . maybePrism monoPathPieces) mPrev $ aopt (hoistField lift supervisorsField) (fslI MsgFilterSupervisor & setTooltip MsgMultiSelectTip )
|
||||
, 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)
|
||||
|
||||
@ -109,7 +109,7 @@ postUsersR = do
|
||||
return (comp E.^. CompanyShorthand, comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor)
|
||||
let icnSuper = toWidget $ text2markup " " <> icon IconSupervisor
|
||||
companies =
|
||||
(\(E.Value cmpSh, E.Value cmpName, E.Value cmpSpr) -> simpleLink (citext2widget cmpName) (FirmR cmpSh) <> bool mempty icnSuper cmpSpr) <$> companies'
|
||||
(\(E.Value cmpSh, E.Value cmpName, E.Value cmpSpr) -> simpleLink (citext2widget cmpName) (FirmUsersR cmpSh) <> bool mempty icnSuper cmpSpr) <$> companies'
|
||||
pure $ intercalate (text2widget "; ") companies
|
||||
-- , sortable (Just "personal-number") (i18nCell MsgCompanyPersonalNumber) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM
|
||||
-- (AdminUserR <$> encrypt uid)
|
||||
|
||||
@ -358,7 +358,7 @@ courseCell Course{..} = anchorCell link name `mappend` desc
|
||||
companyCell :: IsDBTable m a => CompanyShorthand -> CompanyName -> Bool -> DBCell m a
|
||||
companyCell cid cname isSupervisor = anchorCell link name
|
||||
where
|
||||
link = FirmR cid
|
||||
link = FirmUsersR cid
|
||||
corg = ciOriginal cname
|
||||
name
|
||||
| isSupervisor = text2markup (corg <> " ") <> icon IconSupervisor
|
||||
|
||||
Loading…
Reference in New Issue
Block a user