fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(mail): add modal computing actual receivers at postal pref columns

Browse Source
This commit is contained in:
Steffen Jost 2025-02-06 19:02:04 +01:00
parent cc7abf9a94
commit 39a4ebef2a
17 changed files with 215 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
messages/uniworx/categories/print/de-de-formal.msg
View File

@ -17,7 +17,7 @@ PrintJobReprint n@Int m@Int: #{n}/#{m} #{pluralDE n "Druckauftrag" "Druckaufräg
PrintJobAcknowledgeFailed: Keine Druckaufträge bestätigt aufgrund zwischenzeitlicher Änderungen. Bitte die Seite im Browser aktualisieren!
PrintJobAcknowledgeQuestion n@Int d@Text: #{n} #{pluralDE n "Druckauftrag" "Druckaufräge"} vom #{d} als gedruckt und versendet bestätigen?
PrintJobAcknowledgements: Versanddatum von Briefen an
PrintRecipient: Empfänger
PrintRecipient: Empfänger:innen
PrintAffected: Betroffener
PrintSender !ident-ok: Sender
PrintCourse: Kursarten

1
messages/uniworx/categories/user/de-de-formal.msg
View File

@ -43,6 +43,7 @@ SynchroniseAvsAllUsersQueued n@Int64: AVS-Synchronisation von allen #{n} #{plura
SynchroniseLdapUserQueued n@Int: LDAP-Synchronisation von #{n} #{pluralDE n "Benutzer:in" "Benutzer:innen"} angestoßen, die Ausführung wird mehrere Minuten benötigen!
SynchroniseLdapAllUsersQueued: LDAP-Synchronisation von allen Benutzer:innen angestoßen, die Ausführung kann eine Weile brauchen!
UserListTitle: Komprehensive Benutzerliste
UserRecipientsTitle name@Text: Benachrichtigungsempfänger für #{name}
AccessRightsSaved: Berechtigungen erfolgreich verändert
AccessRightsNotChanged: Berechtigungen wurden nicht verändert
AuthLDAPLookupFailed: Nutzer:in konnte aufgrund eines LDAP-Fehlers nicht nachgeschlagen werden

1
messages/uniworx/categories/user/en-eu.msg
View File

@ -43,6 +43,7 @@ SynchroniseAvsAllUsersQueued n: Triggered AVS synchronisation of all #{n} #{plur
SynchroniseLdapUserQueued n: Triggered LDAP synchronisation of #{n} #{pluralEN n "user" "users"}, which may take several minutes to complete.
SynchroniseLdapAllUsersQueued: Triggered LDAP synchronisation of all users, which may take quite a while to complete.
UserListTitle: Comprehensive list of users
UserRecipientsTitle name: Notificationrecipients for #{name}
AccessRightsSaved: Successfully updated permissions
AccessRightsNotChanged: Permissions left unchanged
AuthLDAPLookupFailed: User could not be looked up due to a LDAP error

4
messages/uniworx/misc/de-de-formal.msg
View File

@ -39,4 +39,6 @@ Unknown: ist unbekannt
UnknownOrNotAllowed: ist unbekannt oder hier nicht erlaubt
Ambiguous: ist uneindeutig
Action: Aktion
For: für
For: für
Address: Adresse
NoContactAddress: Keinerlei Kontaktdaten bekannt!

4
messages/uniworx/misc/en-eu.msg
View File

@ -39,4 +39,6 @@ Unknown: is unknown
UnknownOrNotAllowed: is unknown or not allowed here
Ambiguous: is ambiguous
Action: Action
For: for
For: for
Address: Address
NoContactAddress: No contact details known!

1
messages/uniworx/utils/navigation/breadcrumbs/de-de-formal.msg
View File

@ -71,6 +71,7 @@ BreadcrumbError: Fehler
BreadcrumbUpload !ident-ok: Upload
BreadcrumbUserAdd: Benutzer:in anlegen
BreadcrumbUserNotifications: Benachrichtigungs-Einstellungen
BreadcrumbUserRecipients: Benachrichtigungs-Empfänger
BreadcrumbUserPassword: Passwort
BreadcrumbAdminHeading !ident-ok: Administration
BreadcrumbAdminFeaturesHeading: Studiengänge

1
messages/uniworx/utils/navigation/breadcrumbs/en-eu.msg
View File

@ -71,6 +71,7 @@ BreadcrumbError: Error
BreadcrumbUpload: Upload
BreadcrumbUserAdd: Add user
BreadcrumbUserNotifications: Notification settings
BreadcrumbUserRecipients: Notification recipients
BreadcrumbUserPassword: Password
BreadcrumbAdminHeading: Administration
BreadcrumbAdminFeaturesHeading: Features of study

1
routes
View File

@ -58,6 +58,7 @@
/users/#CryptoUUIDUser/hijack AdminHijackUserR GET POST !adminANDno-escalation
/users/#CryptoUUIDUser/notifications UserNotificationR GET POST !self
/users/#CryptoUUIDUser/password UserPasswordR GET POST !selfANDis-pw-hash
/users/#CryptoUUIDUser/recipients UserRecipientsR GET !self
!/users/functionary-invite/new AdminNewFunctionaryInviteR GET POST
!/users/functionary-invite AdminFunctionaryInviteR GET POST
!/users/add AdminUserAddR GET POST

1
src/Foundation/Navigation.hs
View File

@ -103,6 +103,7 @@ breadcrumb (UserPasswordR cID) = useRunDB $ do
-> i18nCrumb MsgMenuUserPassword . Just $ AdminUserR cID
| otherwise
-> i18nCrumb MsgMenuUserPassword $ Just ProfileR
breadcrumb (UserRecipientsR cID) = i18nCrumb MsgBreadcrumbUserRecipients . Just $ AdminUserR cID
breadcrumb AdminNewFunctionaryInviteR = i18nCrumb MsgMenuLecturerInvite $ Just UsersR
breadcrumb AdminFunctionaryInviteR = i18nCrumb MsgBreadcrumbFunctionaryInvite Nothing

150
src/Handler/Profile.hs
View File

@ -14,11 +14,13 @@ module Handler.Profile
, getSetDisplayEmailR, postSetDisplayEmailR
, getCsvOptionsR, postCsvOptionsR
, postLangR
, getUserRecipientsR
) where
import Import
import Handler.Utils
import Handler.Utils.Avs
import Handler.Utils.AvsUpdate
import Handler.Utils.Profile
import Handler.Utils.Users
@ -1125,9 +1127,8 @@ mkSupervisorsTable uid = dbTableWidget' validator DBTable{..}
-- , sortable (Just "postal-pref") (i18nCell MsgPrefersPostal) $ \(view $ resultUser . _userPrefersPostal -> b) -> iconFixedCell $ iconLetterOrEmail b
, sortable (Just "reroute") (i18nCell MsgTableRerouteActive) $ \row ->
let isReroute = row ^. resultUserSupervisor . _entityVal ._userSupervisorRerouteNotifications
isLetter = row ^. resultUser . _userPrefersPostal
in if isReroute
then iconCell IconReroute <> spacerCell <> iconFixedCell (iconLetterOrEmail isLetter)
then iconCell IconReroute <> blankCell <> cellMailPrefPin (row ^. resultUser)
else mempty
, sortable (Just "cshort") (i18nCell MsgTableCompany) $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorCompany -> mc) -> maybeCell mc (\(unCompanyKey -> c) -> anchorCell (FirmUsersR c) $ citext2widget c)
, sortable (Just "reason") (i18nCell MsgTableReason) $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorReason -> mr) -> maybeCell mr textCell
@ -1205,6 +1206,102 @@ mkSuperviseesTable userPrefersPostal uid = dbTableWidget' validator DBTable{..}
dbtExtraReps = []
type TblReceiverData = DBRow (Entity User, Maybe (Entity UserSupervisor))
instance HasEntity TblReceiverData User where
hasEntity = _dbrOutput . _1
instance HasUser TblReceiverData where
hasUser = _dbrOutput . _1 . _entityVal
-- | Table listing all supervisor of the given user
mkReceiversTable :: UserId -> [Entity User] -> DB Widget
mkReceiversTable uid receivers = dbTableDB' validator DBTable{..}
where
dbtIdent = "receivers" :: Text
dbtStyle = def
queryReceiver :: E.SqlExpr (Entity User) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity UserSupervisor)) -> E.SqlExpr (Entity User)
queryReceiver = $(E.sqlLOJproj 2 1)
queryReceiverSupervisor :: E.SqlExpr (Entity User) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity UserSupervisor)) -> E.SqlExpr (Maybe (Entity UserSupervisor))
queryReceiverSupervisor = $(E.sqlLOJproj 2 2)
resultReceiver :: Lens' TblReceiverData (Entity User)
resultReceiver = _dbrOutput . _1
resultReceiverSupervisor :: Traversal' TblReceiverData (Entity UserSupervisor)
resultReceiverSupervisor = _dbrOutput . _2 . _Just
dbtSQLQuery (usr `E.LeftOuterJoin` spr) = do
EL.on $ spr E.?. UserSupervisorSupervisor E.?=. usr E.^. UserId
E.&&. spr E.?. UserSupervisorUser E.?=. E.val uid
E.where_ $ usr E.^. UserId `E.in_` E.vals (entityKey <$> receivers)
return (usr, spr)
dbtRowKey (usr `E.LeftOuterJoin` _) = usr E.^. UserId
dbtProj = dbtProjId
dbtColonnade = mconcat
[ colUserNameModalHdr MsgCommRecipients ForProfileDataR
-- , colUserEmail
, sortable Nothing (i18nCell MsgAddress) $ \(view resultReceiver -> rcvr) -> sqlCell $ -- recall: requires dbTableDB' above!
getPostalPreferenceAndAddress' rcvr >>= \case
(False, _, (Just eml, auto)) -> do -- email
return [whamlet|
<p>
^{widgetMailPrefPin rcvr} #
^{updateAutomatic auto} #
<p>
#{mailtoHtml eml}
|]
(True, (Just postal, auto), _) -> do -- postal
return [whamlet|
<p>
^{widgetMailPrefPin rcvr} #
^{updateAutomatic auto}
<p>
#{postal}
|]
_ -> return $ msg2widget MsgNoContactAddress
, sortable (Just "user-company") (i18nCell MsgTableCompanies) $ \(view $ resultReceiver . _entityKey -> ruid) -> sqlCell
(maybeMonoid <$> wgtCompanies ruid) -- TODO: user wgtCompanies' to check mismatch in companies
-- , colUserLetterEmailPin
-- , sortable (Just "rerouted") (i18nCell MsgTableRerouteActive) $ \(view $ resultUserSupervisor . _entityVal . _userSupervisorRerouteNotifications -> b) -> indicatorCell <> ifIconCell b IconReroute
-- , sortable (Just "postal-pref") (i18nCell MsgPrefersPostal) $ \(view $ resultUser . _userPrefersPostal -> b) -> iconFixedCell $ iconLetterOrEmail b
-- , sortable (Just "reroute") (i18nCell MsgTableRerouteActive) $ \row ->
-- let isReroute = row ^. resultUserSupervisor . _entityVal ._userSupervisorRerouteNotifications
-- in if isReroute
-- then iconCell IconReroute <> blankCell <> cellMailPrefPin (row ^. resultUser)
-- else mempty
, sortable (Just "cshort") (i18nCell MsgTableCompany) $ \(preview $ resultReceiverSupervisor . _entityVal . _userSupervisorCompany . _Just -> mc) -> maybeCell mc (\(unCompanyKey -> c) -> anchorCell (FirmUsersR c) $ citext2widget c)
, sortable (Just "reason") (i18nCell MsgTableReason) $ \(preview $ resultReceiverSupervisor . _entityVal . _userSupervisorReason . _Just -> mr) -> maybeCell mr textCell
]
validator = def -- & defaultSorting [ SortAscBy "cshort", SortAscBy "user-name" ]
dbtSorting = Map.fromList
[ sortUserNameLink queryReceiver
-- , sortUserLetterEmailPin queryReceiver
, sortUserEmail queryReceiver
, ("user-company" , SortColumn (\row -> E.subSelect $ 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.==. queryReceiver row E.^. UserId
E.orderBy [E.asc $ cmp E.^. CompanyName]
return (cmp E.^. CompanyName)
))
-- , singletonMap "postal-pref" $ SortColumn $ queryUser >>> (E.^. UserPrefersPostal)
-- , singletonMap "rerouted" $ SortColumn $ queryUserSupervisor >>> (E.^. UserSupervisorRerouteNotifications)
-- -- , singletonMap "reroute" $ SortColumn $ queryUserSupervisor &&& queryUser >>> (\(spr,usr) -> mTuple (spr E.^. UserSupervisorRerouteNotifications) (usr E.^. UserPrefersPostal))
-- , singletonMap "reroute" $ SortColumns $ \row ->
-- [ SomeExprValue $ queryUserSupervisor row E.^. UserSupervisorRerouteNotifications
-- , SomeExprValue $ queryUser row E.^. UserPrefersPostal
-- ]
, ("cshort", SortColumn $ queryReceiverSupervisor >>> (E.?. UserSupervisorCompany))
, ("reason", SortColumn $ queryReceiverSupervisor >>> (E.?. UserSupervisorReason))
]
dbtFilter = mconcat
[ singletonMap & uncurry $ fltrUserNameEmail queryReceiver
]
dbtFilterUI = mempty
dbtParams = def
dbtCsvEncode = noCsvEncode
dbtCsvDecode = Nothing
dbtExtraReps = []
getAuthPredsR, postAuthPredsR :: Handler Html
getAuthPredsR = postAuthPredsR
postAuthPredsR = do
@ -1356,3 +1453,52 @@ postLangR = do
addMessage Success . toHtml $ mr MsgLanguageChanged
redirect . fromMaybe NewsR =<< lookupGlobalGetParam GetReferer
getUserRecipientsR :: CryptoUUIDUser -> Handler Html
getUserRecipientsR uuid = do
uid <- decrypt uuid
(usr, receivers, usrReceives) <- updateReceivers uid -- if this is two due to the AVS queries, try Handler.Utils.getReceivers instead
mrtbl <- case receivers of
[] -> return Nothing -- no receivers
[_] | usrReceives -> return Nothing -- only user receives for themself
_ -> Just <$> runDB (mkReceiversTable uid receivers)
let heading = MsgUserRecipientsTitle $ usr ^. _userDisplayName
usrWgt = userWidget usr
hasPwd = isJust $ usr ^. _userPinPassword
siteLayoutMsg heading $ do
setTitleI heading -- TODO: translate to i18nWidgetFile
[whamlet|
<section>
<p>
Benachrichtigungen für ^{usrWgt} ^{widgetMailPrefPin usr} #
$if usrReceives
gehen #
$maybe _ <- mrtbl
ebenfalls an die unten aufgeführten Personen:
$nothing
nur an diese Person selbst.
$else
$maybe _ <- mrtbl
gehen tatsächlich nur an die unten aufgeführten Personen:
$nothing
werden momentan an niemanden zugestellt!
$maybe tbl <- mrtbl
<p>
^{tbl}
<p>
<h4>
Hinweise:
Mit welchem Passwort PDF Anhänge geschützt werden, hängt von der Nachricht ab. #
Zum Beispiel werden Pin Briefe für ablaufende Qualifikationen #
$if hasPwd
mit dem Passwort von ^{usrWgt} geschützt. #
$else
nicht geschützt, da kein Pin Passwort gesetzt ist. #
Für andere Benachrichtigungen wird meist das Passwort des tatsächlichen Empfängers gewählt, sofern eins gesetzt wurde.
Die Voreinstellung für das PDF Passwort ist die Hauptausweisnummer, inklusive Punkt.
|]

2
src/Handler/Users.hs
View File

@ -132,6 +132,7 @@ postUsersR = do
, sortable (Just "last-login") (i18nCell MsgLastLogin) $ \DBRow{ dbrOutput = Entity _ User{..} } -> maybe mempty dateTimeCell userLastAuthentication
, sortable (Just "auth-ldap") (i18nCell MsgAuthMode) $ \DBRow{ dbrOutput = Entity _ User{..} } -> i18nCell userAuthentication
, colUserEmail
, colUserLetterEmailPin
, sortable (Just "ldap-sync") (i18nCell MsgLdapSynced) $ \DBRow{ dbrOutput = Entity _ User{..} } -> maybe mempty dateTimeCell userLastLdapSynchronisation
, flip foldMap universeF $ \function ->
sortable (Just $ SortingKey $ CI.mk $ toPathPiece function) (i18nCell function) $ \DBRow{ dbrOutput = Entity uid _ } -> flip (set' cellContents) mempty $ do
@ -223,6 +224,7 @@ postUsersR = do
) | function <- universeF
] ++
[ sortUserEmail id
, sortUserLetterEmailPin id
, ( "name"
, SortColumn (E.^. UserSurname)
)

20
src/Handler/Utils/Company.hs
View File

@ -38,14 +38,18 @@ company2msg :: CompanyId -> SomeMessage UniWorX
company2msg = text2message . ciOriginal . unCompanyKey
wgtCompanies :: UserId -> DB (Maybe Widget)
wgtCompanies = \uid -> do
wgtCompanies = (fst <<$>>) . wgtCompanies'
-- | Given a UserId, create widgets showing top-companies (with internal link) and associated companies (unlinked)
wgtCompanies' :: UserId -> DB (Maybe (Widget, [CompanyShorthand]))
wgtCompanies' uid = do
companies <- E.select $ do
(usrComp :& comp) <- E.from $ E.table @UserCompany `E.innerJoin` E.table @Company
`E.on` (\(usrComp :& comp) -> usrComp E.^. UserCompanyCompany E.==. comp E.^. CompanyId)
E.where_ $ usrComp E.^. UserCompanyUser E.==. E.val uid
E.orderBy [E.asc (comp E.^. CompanyName)]
return (comp E.^. CompanyShorthand, comp E.^. CompanyName, usrComp E.^. UserCompanySupervisor, usrComp E.^. UserCompanyPriority)
let (mPri, topCmp, otherCmp) = procCmp mPri companies
let (mPri, topCmp, otherCmp, topIds) = procCmp mPri companies
resWgt =
[whamlet|
$forall c <- topCmp
@ -55,14 +59,18 @@ wgtCompanies = \uid -> do
<p>
^{c}
|]
return $ toMaybe (notNull topCmp) resWgt
return $ toMaybe (notNull topCmp) (resWgt, topIds)
where
procCmp _ [] = (0, [], [])
procCmp _ [] = (0, [], [], [])
procCmp maxPri ((E.Value cmpSh, E.Value cmpName, E.Value cmpSpr, E.Value cmpPrio) : cs) =
let isTop = cmpPrio >= maxPri
cmpWgt = companyWidget isTop (cmpSh, cmpName, cmpSpr)
(accPri,accTop,accRem) = procCmp maxPri cs
in (max cmpPrio accPri, bool accTop (cmpWgt : accTop) isTop, bool (cmpWgt : accRem) accRem isTop) -- lazy evaluation after repmin example, don't factor out the bool!
(accPri,accTop,accRem,accTopId) = procCmp maxPri cs
in ( max cmpPrio accPri
, bool accTop (cmpWgt : accTop) isTop -- lazy evaluation after repmin example, don't factor out the bool!
, bool (cmpWgt : accRem) accRem isTop
, bool accTopId (cmpSh : accTopId) isTop
)
type AnySuperReason = Either SupervisorReason (Maybe Text)

25
src/Handler/Utils/Table/Cells.hs
View File

@ -32,6 +32,9 @@ spacerCell = cell [whamlet|&emsp;|]
semicolonCell :: IsDBTable m a => DBCell m a
semicolonCell = cell [whamlet|;&emsp;|]
blankCell :: IsDBTable m a => DBCell m a
blankCell = textCell " "
-- | Contribute to DBResult. BEWARE: only shown cells are executed; pagination makes tellCell useless for rowcounts; instead use dbtProj for computations on all rows regardless of pagination
tellCell :: IsDBTable m a => a -> DBCell m a -> DBCell m a
tellCell = flip mappend . writerCell . tell
@ -116,7 +119,7 @@ iconBoolCell :: IsDBTable m a => Bool -> DBCell m a
iconBoolCell = cell . toWidget . boolSymbol
ifIconCell :: IsDBTable m a => Bool -> Icon -> DBCell m a
ifIconCell True = iconCell
ifIconCell True = iconFixedCell . icon
ifIconCell False = const iconSpacerCell
addIconFixedWidth :: IsDBTable m a => DBCell m a -> DBCell m a
@ -218,12 +221,22 @@ emailCell :: IsDBTable m a => CI Text -> DBCell m a
emailCell email = cell $(widgetFile "widgets/link-email")
where linkText= toWgt email
cellMailPrefPin :: (IsDBTable m a, HasUser u) => u -> DBCell m a
cellMailPrefPin :: (IsDBTable m a, HasEntity u User) => u -> DBCell m a
cellMailPrefPin usr =
iconFixedCell (iconLetterOrEmail prefPost) <> ifIconCell (not prefPost && hasPin) IconPinProtect
where
prefPost = usr ^. _userPrefersPostal
hasPin = isJust (usr ^. _userPinPassword)
let userEntity = usr ^. hasEntityUser
uid = userEntity ^. _entityKey
rwgt = do
uuid <- liftHandler $ encrypt uid
modal (widgetMailPrefPin userEntity) (Left $ SomeRoute $ UserRecipientsR uuid)
in cell rwgt -- addIconFixedWidth
-- cellMailPrefPin :: (IsDBTable m a, HasUser u) => u -> DBCell m a
-- cellMailPrefPin usr =
-- iconFixedCell (iconLetterOrEmail prefPost) <> blankCell <> ifIconCell (not prefPost && hasPin) IconPinProtect
-- where
-- prefPost = usr ^. _userPrefersPostal
-- hasPin = isJust (usr ^. _userPinPassword)
cellHasUser :: (IsDBTable m c, HasUser a) => a -> DBCell m c
cellHasUser = liftA2 userCell (view _userDisplayName) (view _userSurname)

2
src/Handler/Utils/Table/Columns.hs
View File

@ -495,7 +495,7 @@ fltrUserEmailUI mPrev =
-- | Icon column showing whether the user prefers emails, and if so, whether a pdf password is set
colUserLetterEmailPin :: (IsDBTable m c, HasUser a) => Colonnade Sortable a (DBCell m c)
colUserLetterEmailPin :: (IsDBTable m c, HasEntity a User) => Colonnade Sortable a (DBCell m c)
colUserLetterEmailPin = sortable (Just "user-mail-pref-pin") (i18nCell MsgPrefersPostal) cellMailPrefPin
sortUserLetterEmailPin :: IsString d => (t -> E.SqlExpr (Entity User)) -> (d, SortColumn t r')

3
src/Handler/Utils/Users.hs
View File

@ -91,7 +91,8 @@ getUserPrimaryCompanyAddress uid prj = runMaybeT $ do
MaybeT $ pure $ prj company
-- | result (True, Nothing, Nothing) indicates that neither userEmail nor userPostAddress is known
-- | Compute actual address for user; returning True for Postal preference, as well as address (user or company) and primary e-mail
-- result (True, Nothing, Nothing) indicates that neither userEmail nor userPostAddress is known
getPostalPreferenceAndAddress :: Entity User -> DB (Bool, Maybe [Text], Maybe UserEmail)
getPostalPreferenceAndAddress usr = do
pa <- getPostalAddress usr

9
src/Handler/Utils/Widgets.hs
View File

@ -172,6 +172,15 @@ companyWidget isPrimary (csh, cname, isSupervisor)
| isSupervisor = text2markup (corg <> " ")
| otherwise = text2markup corg
widgetMailPrefPin :: HasUser u => u -> Widget -- TODO: move to appropriate module
widgetMailPrefPin usr = if not prefPost && hasPin
then [whamlet|^{modWgt} ^{pinWgt}|]
else modWgt
where
prefPost :: Bool = usr ^. _userPrefersPostal
hasPin :: Bool = isJust (usr ^. _userPinPassword)
modWgt :: Widget = toWidget $ iconLetterOrEmail prefPost
pinWgt :: Widget = toWidget iconPinProtect
---------------------
-- Status Tooltips --

14
test/Database/Fill.hs
View File

@ -645,13 +645,13 @@ fillDb = do
I am aware that violations in the form plagiarism or collaboration with third parties will lead to expulsion from the course.
|]
}
fraportAg <- insert' $ Company "Fraport AG" "Fraport" 1 True (Just $ markdownToStoredMarkup ("Frankfurt Airport Services Worldwide\n60547 Frankfurt am Main"::Text)) (Just "fraport@fraport.de")
fraGround <- insert' $ Company "Fraport Ground Handling Professionals GmbH" "FraGround" 2 True (Just $ markdownToStoredMarkup ("Sauerbierstraße 772 \nBürokomplex 80/C/1\n112233 Nieder-Tupfing-Hohen-Kreisingen\nTöpferbezirk"::Text)) Nothing
nice <- insert' $ Company "N*ICE Aircraft Services & Support GmbH" "N*ICE" 33 False (Just $ markdownToStoredMarkup ("69 Nevermore Blvd.\nHarlaemn\nNew York\nUSA"::Text)) (Just "badguy@nice.com")
ffacil <- insert' $ Company "Fraport Facility Services GmbH" "GCS" 44 False Nothing $ Just "gcs@gcs.com"
bpol <- insert' $ Company "Bundespolizeidirektion Flughafen Frankfurt am Main" "BPol" 5555 False Nothing Nothing
_noone <- insert' $ Company "Vollautomaten GmbH" "NoOne" 3 True Nothing Nothing
randComps <- insertMany [Company rcName rcShort n neven Nothing Nothing | n <- [1001..2002]
fraportAg <- insert' $ Company "Fraport AG" "Fraport" 1 True (Just $ markdownToStoredMarkup ("Frankfurt Airport Services Worldwide\n60547 Frankfurt am Main"::Text)) (Just "fraport@fraport.de") False
fraGround <- insert' $ Company "Fraport Ground Handling Professionals GmbH" "FraGround" 2 True (Just $ markdownToStoredMarkup ("Sauerbierstraße 772 \nBürokomplex 80/C/1\n112233 Nieder-Tupfing-Hohen-Kreisingen\nTöpferbezirk"::Text)) Nothing True
nice <- insert' $ Company "N*ICE Aircraft Services & Support GmbH" "N*ICE" 33 False (Just $ markdownToStoredMarkup ("69 Nevermore Blvd.\nHarlaemn\nNew York\nUSA"::Text)) (Just "badguy@nice.com") False
ffacil <- insert' $ Company "Fraport Facility Services GmbH" "GCS" 44 False Nothing(Just "gcs@gcs.com") True
bpol <- insert' $ Company "Bundespolizeidirektion Flughafen Frankfurt am Main" "BPol" 5555 False Nothing Nothing False
_noone <- insert' $ Company "Vollautomaten GmbH" "NoOne" 3 True Nothing Nothing True
randComps <- insertMany [Company rcName rcShort n neven Nothing Nothing True | n <- [1001..2002]
, let neven = even n
, let rcName = CI.mk $ "Random Corp " <> tshow n <> bool "" " GmbH" (even n)
, let rcShort = CI.mk $ "RC" <> tshow n