diff --git a/messages/uniworx/categories/firm/de-de-formal.msg b/messages/uniworx/categories/firm/de-de-formal.msg index 786e57dd6..4fb1d392d 100644 --- a/messages/uniworx/categories/firm/de-de-formal.msg +++ b/messages/uniworx/categories/firm/de-de-formal.msg @@ -2,9 +2,19 @@ # # SPDX-License-Identifier: AGPL-3.0-or-later +FirmAssociates: Firmenangehörige +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 FirmUserActNotify: Mitteilung versenden FirmUserActMkSuper: Zum Firmenansprechpartner ernennen +FirmSuperActNotify: Mitteilung versenden +FirmSuperActRMSuperDef: Standard Firmenansprechpartner entfernen +FirmSuperActRMSuperAll: Als aktiven Ansprechpartner komplett entfernen FilterSupervisor: Hat aktiven Ansprechpartner FilterSupervisorCompany fsh@CompanyShorthand: Hat aktiven Ansprechpartner, der #{fsh} angehört +FilterSupervisorForeign fsh@CompanyShorthand: Hat aktiven Ansprechpartner, der selbst nicht #{fsh} angehört +FilterForeignSupervisor: Hat firmenfremde Ansprechpartner +FilterFirmPostalAddress: Postalische Firmenadresse vorhanden \ No newline at end of file diff --git a/messages/uniworx/categories/firm/en-eu.msg b/messages/uniworx/categories/firm/en-eu.msg index a9e105cc3..a4df65482 100644 --- a/messages/uniworx/categories/firm/en-eu.msg +++ b/messages/uniworx/categories/firm/en-eu.msg @@ -2,9 +2,19 @@ # # SPDX-License-Identifier: AGPL-3.0-or-later +FirmAssociates: Company associated users +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 FirmUserActNotify: Send message FirmUserActMkSuper: Mark as company supervisor +FirmSuperActNotify: Send message +FirmSuperActRMSuperDef: Remove as default supervisor +FirmSuperActRMSuperAll: Remove all active supervisions for this company FilterSupervisor: Has active supervisor -FilterSupervisorCompany fsh: Has active company supervisor belonging to #{fsh} \ No newline at end of file +FilterSupervisorCompany fsh: Has active company supervisor belonging to #{fsh} +FilterSupervisorForeign fsh: Has active supervisor not belonging to #{fsh} +FilterForeignSupervisor: Has company-external supervisors +FilterFirmPostalAddress: Postal company addresse known \ No newline at end of file diff --git a/messages/uniworx/utils/table_column/de-de-formal.msg b/messages/uniworx/utils/table_column/de-de-formal.msg index 579e8ddf0..295648b7e 100644 --- a/messages/uniworx/utils/table_column/de-de-formal.msg +++ b/messages/uniworx/utils/table_column/de-de-formal.msg @@ -103,4 +103,5 @@ ActJobDelete: Job entfernen TableJobActDeleteFeedback n@Int m@Int: #{n}/#{m} Jobs entfernt TableFilterComma: Es können mehrere alternative Suchkriterien mit Komma getrennt angegeben werden, wovon mindestens eines erfüllt werden muss. TableFilterCommaPlus: Mehrere alternative Suchkriterien mit Komma trennen. Mindestens ein Suchkriterium muss erfüllt werden, zusätzlich zu allen Suchkriterien mit vorangestelltem Plus-Symbol. +TableFilterCommaName: Mehrere Namen mit Komma trennen. TableFilterCommaNameNr: Mehrere Namen oder Nummern mit Komma trennen. Nummern werden nur exakt gesucht. \ No newline at end of file diff --git a/messages/uniworx/utils/table_column/en-eu.msg b/messages/uniworx/utils/table_column/en-eu.msg index b441ea783..5839e332c 100644 --- a/messages/uniworx/utils/table_column/en-eu.msg +++ b/messages/uniworx/utils/table_column/en-eu.msg @@ -103,4 +103,5 @@ ActJobDelete: Delete job TableJobActDeleteFeedback n@Int m@Int: #{n}/#{m} queued jobs deleted TableFilterComma: Separate multiple alternative filter criteria by comma, at least one of which must be fulfilled. TableFilterCommaPlus: Separate multiple alternative filter criteria by comma, at least one of which must be fulfilled in addition to all criteria preceded by a plus symbol. +TableFilterCommaName: Separate names by comma. TableFilterCommaNameNr: Separate names and numbers by comma. Numbers have to match exact. \ No newline at end of file diff --git a/models/company.model b/models/company.model index 5443b64b0..c022ad5f1 100644 --- a/models/company.model +++ b/models/company.model @@ -9,7 +9,8 @@ Company shorthand CompanyShorthand -- == (CI Text) and CompanyKey :: CompanyShorthand -> CompanyId FUTURE TODO: a shorthand will become available through the AVS interface in the future avsId Int default=0 -- primary key from avs prefersPostal Bool default=false -- new company users prefers letters by post instead of email - postAddress StoredMarkup Maybe -- default company postal address + postAddress StoredMarkup Maybe -- default company postal address + email UserEmail Maybe -- Case-insensitive generic company eMail address UniqueCompanyName name UniqueCompanyShorthand shorthand -- UniqueCompanyAvsId avsId -- should be the case, unclear if enforcing works here, since we cannot query avs by company id diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs index 060a4df98..3cba53920 100644 --- a/src/Database/Esqueleto/Utils.hs +++ b/src/Database/Esqueleto/Utils.hs @@ -287,14 +287,14 @@ mkExactFilterWith cast lenslike row criterias -- | like `mkExactFilterWith` but splits comma separared Texts into multiple criteria mkExactFilterWithComma :: (PersistField b) - => (Text -> b) -- ^ type conversion + => (Text -> Maybe b) -- ^ type conversion -> (t -> E.SqlExpr (E.Value b)) -- ^ getter from query to searched element -> t -- ^ query row -> Set.Set Text -- ^ needle collection -> E.SqlExpr (E.Value Bool) mkExactFilterWithComma cast lenslike row (foldMap commaSeparatedText -> criterias) | Set.null criterias = true - | otherwise = lenslike row `E.in_` E.valList (cast <$> Set.toList criterias) + | otherwise = lenslike row `E.in_` E.valList (mapMaybe cast $ Set.toList criterias) -- | generic filter creation for dbTable -- Given a lens-like function, make filter for exact matches against last element of a collection diff --git a/src/Handler/Firm.hs b/src/Handler/Firm.hs index 4fcad5788..3f6d46207 100644 --- a/src/Handler/Firm.hs +++ b/src/Handler/Firm.hs @@ -115,7 +115,7 @@ type AllCompanyTableExpr = E.SqlExpr (Entity Company) queryAllCompany :: AllCompanyTableExpr -> E.SqlExpr (Entity Company) queryAllCompany = id -type AllCompanyTableData = DBRow (Entity Company, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64, E.Value Word64) +type AllCompanyTableData = DBRow (Entity Company, E.Value Word64, E.Value Bool, E.Value Bool) resultAllCompanyEntity :: Lens' AllCompanyTableData (Entity Company) resultAllCompanyEntity = _dbrOutput . _1 @@ -125,29 +125,12 @@ resultAllCompany = resultAllCompanyEntity . _entityVal resultAllCompanyUsers :: Lens' AllCompanyTableData Word64 resultAllCompanyUsers = _dbrOutput . _2 . _unValue -resultAllCompanySupervisors :: Lens' AllCompanyTableData Word64 +resultAllCompanySupervisors :: Lens' AllCompanyTableData Bool resultAllCompanySupervisors = _dbrOutput . _3 . _unValue -resultAllCompanyEmployeeSupervised :: Lens' AllCompanyTableData Word64 -resultAllCompanyEmployeeSupervised = _dbrOutput . _4 . _unValue +resultAllCompanyDefaultReroutes :: Lens' AllCompanyTableData Bool +resultAllCompanyDefaultReroutes = _dbrOutput . _4 . _unValue -resultAllCompanyEmployeeRerouted :: Lens' AllCompanyTableData Word64 -resultAllCompanyEmployeeRerouted = _dbrOutput . _5 . _unValue - -resultAllCompanyEmpRerPost :: Lens' AllCompanyTableData Word64 -resultAllCompanyEmpRerPost = _dbrOutput . _6 . _unValue - -resultAllCompanyForeignSupers :: Lens' AllCompanyTableData Word64 -resultAllCompanyForeignSupers = _dbrOutput . _7 . _unValue - -resultAllCompanyDefaultReroutes :: Lens' AllCompanyTableData Word64 -resultAllCompanyDefaultReroutes = _dbrOutput . _8 . _unValue - -resultAllCompanyActiveReroutes :: Lens' AllCompanyTableData Word64 -resultAllCompanyActiveReroutes = _dbrOutput . _9 . _unValue - -resultAllCompanyActiveReroutes' :: Lens' AllCompanyTableData Word64 -resultAllCompanyActiveReroutes' = _dbrOutput . _10 . _unValue fromUserCompany :: Maybe (E.SqlExpr (Entity UserCompany) -> E.SqlExpr (E.Value Bool)) -> E.SqlExpr (Entity Company) -> E.SqlQuery () fromUserCompany mbFltr cmpy = do @@ -167,9 +150,16 @@ firmCountSupervisors = E.subSelectCount . fromUserCompany (Just (E.^. UserCompa -- E.&&. (usrCmpy E.^. UserCompanySupervisor E.==. E.true) -- return $ usrCmpy E.^. UserCompanyUser +firmHasSupervisors :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Bool) +firmHasSupervisors = E.exists . fromUserCompany (Just (E.^. UserCompanySupervisor)) + + firmCountDefaultReroutes :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64) firmCountDefaultReroutes = E.subSelectCount . fromUserCompany (Just (\uc -> uc E.^. UserCompanySupervisor E.&&. uc E.^. UserCompanySupervisorReroute)) +firmHasDefaultReroutes :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Bool) +firmHasDefaultReroutes = E.exists . fromUserCompany (Just (\uc -> uc E.^. UserCompanySupervisor E.&&. uc E.^. UserCompanySupervisorReroute)) + firmCountEmployeeSupervised :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64) firmCountEmployeeSupervised = E.subSelectCount . fromUserCompany (Just fltr) where @@ -217,15 +207,15 @@ firmCountForeignSupervisors cmpy = E.subSelectCountDistinct $ do E.&&. E.notExists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorSupervisor) cmpy) pure $ usrSuper E.^. UserSupervisorSupervisor -firmCountActiveReroutes :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64) -firmCountActiveReroutes cmpy = E.subSelectCountDistinct $ do - usrSuper <- E.from $ E.table @UserSupervisor - E.where_ $ E.exists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorUser) cmpy) - E.&&. usrSuper E.^. UserSupervisorRerouteNotifications - pure $ usrSuper E.^. UserSupervisorSupervisor +-- firmCountActiveReroutes :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64) +-- firmCountActiveReroutes cmpy = E.subSelectCountDistinct $ do +-- usrSuper <- E.from $ E.table @UserSupervisor +-- E.where_ $ E.exists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorUser) cmpy) +-- E.&&. usrSuper E.^. UserSupervisorRerouteNotifications +-- pure $ usrSuper E.^. UserSupervisorSupervisor -firmCountActiveReroutes' :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64) -firmCountActiveReroutes' cmpy = E.subSelectCount $ do +firmCountActiveReroutes :: E.SqlExpr (Entity Company) -> E.SqlExpr (E.Value Word64) +firmCountActiveReroutes cmpy = E.subSelectCount $ do usrSuper <- E.from $ E.table @UserSupervisor E.where_ $ E.exists (fromUserCompany (Just $ \usrCmpy -> usrCmpy E.^. UserCompanyUser E.==. usrSuper E.^. UserSupervisorUser) cmpy) E.&&. usrSuper E.^. UserSupervisorRerouteNotifications @@ -244,14 +234,14 @@ mkFirmAllTable isAdmin uid = do E.&&. usrCmpy E.^. UserCompanyUser E.==. E.val uid return ( cmpy -- 1 , cmpy & firmCountUsers -- 2 - , cmpy & firmCountSupervisors -- 3 - , cmpy & firmCountEmployeeSupervised -- 4 - , cmpy & firmCountEmployeeRerouted -- 5 - , cmpy & firmCountEmployeeRerPost -- 6 - , cmpy & firmCountForeignSupervisors -- 7 - , cmpy & firmCountDefaultReroutes -- 8 - , cmpy & firmCountActiveReroutes -- 9 - , cmpy & firmCountActiveReroutes' -- 10 + , cmpy & firmHasSupervisors -- 3 + , cmpy & firmHasDefaultReroutes -- 4 + -- , cmpy & firmCountEmployeeSupervised -- 4 + -- , cmpy & firmCountEmployeeRerouted -- 5 + -- , cmpy & firmCountEmployeeRerPost -- 6 + -- , cmpy & firmCountForeignSupervisors -- 7 + -- , cmpy & firmCountActiveReroutes -- 9 + -- , cmpy & firmCountActiveReroutes' -- 10 ) dbtRowKey = (E.^. CompanyId) dbtProj = dbtProjId @@ -266,14 +256,14 @@ mkFirmAllTable isAdmin uid = do anchorCell (FirmR $ companyShorthand firm) $ toWgt $ companyAvsId firm , sortable (Just "users") (i18nCell MsgTableCompanyNrUsers) $ \(view resultAllCompanyUsers -> nr) -> wgtCell $ word2widget nr , sortable (Just "supervisors") (i18nCell MsgTableCompanyNrSupersDefault) $ \row -> - anchorCell (FirmSupersR $ row ^. resultAllCompany . _companyShorthand) $ word2widget $ row ^. resultAllCompanySupervisors - , sortable (Just "reroute-def") (i18nCell MsgTableCompanyNrRerouteDefault) $ \(view resultAllCompanyDefaultReroutes -> nr) -> wgtCell $ word2widget nr - , 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 "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 + 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 "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 , sortable (Just "postal-pref") (i18nCell MsgTableCompanyPostalPreference) $ \(view $ resultAllCompany . _companyPrefersPostal -> b) -> iconFixedCell $ iconLetterOrEmail b ] dbtSorting = mconcat @@ -283,17 +273,18 @@ mkFirmAllTable isAdmin uid = do , singletonMap "postal-pref" $ SortColumn (E.^. CompanyPrefersPostal) , singletonMap "users" $ SortColumn firmCountUsers , singletonMap "supervisors" $ SortColumn firmCountSupervisors - , singletonMap "emp-supervised" $ SortColumn firmCountEmployeeSupervised - , singletonMap "emp-rerouted" $ SortColumn firmCountEmployeeRerouted - , singletonMap "emp-rer-post" $ SortColumn firmCountEmployeeRerPost + -- , singletonMap "emp-supervised" $ SortColumn firmCountEmployeeSupervised + -- , singletonMap "emp-rerouted" $ SortColumn firmCountEmployeeRerouted + -- , singletonMap "emp-rer-post" $ SortColumn firmCountEmployeeRerPost , singletonMap "reroute-def" $ SortColumn firmCountDefaultReroutes - , singletonMap "foreigners" $ SortColumn firmCountForeignSupervisors - , singletonMap "reroute-act" $ SortColumn firmCountActiveReroutes - , singletonMap "reroute-all" $ SortColumn firmCountActiveReroutes' + -- , singletonMap "foreigners" $ SortColumn firmCountForeignSupervisors + -- , singletonMap "reroute-act" $ SortColumn firmCountActiveReroutes + -- , singletonMap "reroute-all" $ SortColumn firmCountActiveReroutes' ] dbtFilter = mconcat [ single $ fltrCompanyNameNr queryAllCompany - , single ("is-supervisor", FilterColumn . E.mkExistsFilter $ \row (criterion :: Text) -> do + , single ("company-number", FilterColumn $ E.mkExactFilterWithComma readMay (queryAllCompany >>> (E.^. CompanyAvsId))) + , 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) @@ -303,10 +294,31 @@ mkFirmAllTable isAdmin uid = do E.||. (usr E.^. UserSurname `E.hasInfix` E.val criterion) ) ) + , single ("foreign-supervisor", FilterColumn $ \row (getLast -> criterion) -> + let checkSuper = do + usrSpr <- E.from $ E.table @UserSupervisor + E.where_ $ E.notExists (do + spr <- E.from $ E.table @UserCompany + E.where_ $ spr E.^. UserCompanyCompany E.==. queryAllCompany row E.^. CompanyId + E.&&. spr E.^. UserCompanyUser E.==. usrSpr E.^. UserSupervisorSupervisor + ) E.&&. E.exists (do + usr <- E.from $ E.table @UserCompany + E.where_ $ usr E.^. UserCompanyCompany E.==. queryAllCompany row E.^. CompanyId + E.&&. usr E.^. UserCompanyUser E.==. usrSpr E.^. UserSupervisorUser + ) + in case criterion of + Nothing -> E.true + Just True -> E.exists checkSuper + Just False -> E.notExists checkSuper + ) + , single ("company-postal", FilterColumn $ E.mkExactFilterLast $ views (to queryAllCompany) (E.isJust . (E.^. CompanyPostAddress))) ] dbtFilterUI mPrev = mconcat - [ fltrCompanyNameNrUI mPrev - , prismAForm (singletonFilter "is-supervisor") mPrev $ aopt textField (fslI MsgTableSupervisor) + [ fltrCompanyNameUI mPrev + , prismAForm (singletonFilter "company-number") mPrev $ aopt textField (fslI MsgTableCompanyNo) + , prismAForm (singletonFilter "is-supervisor") mPrev $ aopt textField (fslI MsgTableSupervisor) + , prismAForm (singletonFilter "foreign-supervisor" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterForeignSupervisor) + , prismAForm (singletonFilter "company-postal" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgFilterFirmPostalAddress) ] dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } acts :: Map FirmAllAction (AForm Handler FirmAllActionData) @@ -468,11 +480,25 @@ 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 + usrSpr <- E.from $ E.table @UserSupervisor + E.where_ $ usrSpr E.^. UserSupervisorUser E.==. queryUserUser row E.^. UserId + E.&&. E.notExists (do + spr <- E.from $ E.table @UserCompany + E.where_ $ spr E.^. UserCompanyCompany E.==. E.val cid + E.&&. spr E.^. UserCompanyUser E.==. usrSpr E.^. UserSupervisorSupervisor + ) + in case criterion of + Nothing -> E.true + Just True -> E.exists checkSuper + Just False -> E.notExists checkSuper ] dbtFilterUI mPrev = mconcat [ fltrUserNameEmailHdrUI MsgTableCompanyUser mPrev , 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) ] dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } acts :: Map FirmUserAction (AForm Handler FirmUserActionData) @@ -516,39 +542,196 @@ getFirmUsersR = postFirmUsersR postFirmUsersR fsh = do isAdmin <- hasReadAccessTo AdminR let fshId = CompanyKey fsh - (Company{..}, (fusrRes, fusrTable)) <- runDB $ (,) - <$> get404 fshId - <*> mkFirmUserTable isAdmin fshId + (( Entity{entityVal=Company{..}} + , E.Value nrCompanyUsers + , E.Value nrCompanySupervisors + , E.Value nrCompanyForeignSupers + , E.Value nrCompanyEmployeeSupervised + , E.Value nrCompanyEmployeeRerouted + , E.Value nrCompanyEmployeeRerPost + , E.Value nrCompanyDefaultReroutes + , E.Value nrCompanyActiveReroutes + ) , (fusrRes, fusrTable)) <- runDB $ (,) + <$> fromMaybeM notFound (E.selectOne $ do + cmpy <- E.from $ E.table @Company + E.where_ $ cmpy E.^. CompanyId E.==. E.val fshId + return ( cmpy + , cmpy & firmCountUsers + , cmpy & firmCountSupervisors + , cmpy & firmCountForeignSupervisors + , cmpy & firmCountEmployeeSupervised + , cmpy & firmCountEmployeeRerouted + , cmpy & firmCountEmployeeRerPost + , cmpy & firmCountDefaultReroutes + , cmpy & firmCountActiveReroutes + )) + <*> mkFirmUserTable isAdmin fshId + formResult fusrRes $ \case (FirmUserActNotifyData , fids) -> addMessage Info $ text2Html $ "Notify " <> tshow (length fids) <> " employees. TODO" (FirmUserActMkSuperData, fids) -> addMessage Info $ text2Html $ "Make " <> tshow (length fids) <> " employees to supervisors. TODO" siteLayout (citext2widget companyName) $ do setTitle $ toHtml $ CI.original companyShorthand <> " (" <> tshow companyAvsId <> ")" - [whamlet| -
-

- #{companyPostAddress} -

- Benachrichtigungs-Voreinstellung für neue Firmangehörige: # - $if companyPrefersPostal - #{icon IconLetter} Briefversand - $else - #{icon IconAt} Email -

-

- Company associated users, excluding foreign supervisors -

- ^{fusrTable} - |] + $(widgetFile "firm-users") ----------------------------- -- Firm Supervisors Table +data FirmSuperAction = FirmSuperActNotify + | FirmSuperActRMSuperDef + | FirmSuperActRMSuperAll + deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) + deriving anyclass (Universe, Finite) + +nullaryPathPiece ''FirmSuperAction $ camelToPathPiece' 3 +embedRenderMessage ''UniWorX ''FirmSuperAction id + +data FirmSuperActionData = FirmSuperActNotifyData + | FirmSuperActRMSuperDefData + | FirmSuperActRMSuperAllData + deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) + +type SuperCompanyTableExpr = E.SqlExpr (Entity User) + +querySuperUser :: SuperCompanyTableExpr -> E.SqlExpr (Entity User) +querySuperUser = id + +type SuperCompanyTableData = DBRow (Entity User, E.Value Word64, E.Value Word64) + +resultSuperUser :: Lens' SuperCompanyTableData (Entity User) +resultSuperUser = _dbrOutput . _1 + +resultSuperCompanySupervised :: Lens' SuperCompanyTableData Word64 +resultSuperCompanySupervised = _dbrOutput . _2 . _unValue + +resultSuperCompanyReroutes :: Lens' SuperCompanyTableData Word64 +resultSuperCompanyReroutes = _dbrOutput . _3 . _unValue + +instance HasEntity SuperCompanyTableData User where + hasEntity = resultSuperUser + +instance HasUser SuperCompanyTableData where + hasUser = resultSuperUser . _entityVal + + +mkFirmSuperTable :: Bool -> CompanyId -> DB (FormResult (FirmSuperActionData, Set UserId), Widget) +mkFirmSuperTable isAdmin cid = do + let + -- fsh = unCompanyKey cid + resultDBTable = DBTable{..} + where + dbtSQLQuery = \usr -> do + -- refactor this + let subs = do + (usrSpr :& usrCmp) <- E.from $ E.table @UserSupervisor + `E.innerJoin` E.table @UserCompany + `E.on` (\(usrSpr :& usrCmp) -> usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser) + E.where_ $ usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId + E.&&. usrCmp E.^. UserCompanyCompany E.==. E.val cid + subs' = do + (usrSpr :& usrCmp) <- E.from $ E.table @UserSupervisor + `E.innerJoin` E.table @UserCompany + `E.on` (\(usrSpr :& usrCmp) -> usrSpr E.^. UserSupervisorUser E.==. usrCmp E.^. UserCompanyUser) + E.where_ $ usrSpr E.^. UserSupervisorSupervisor E.==. usr E.^. UserId + E.&&. usrCmp E.^. UserCompanyCompany E.==. E.val cid + E.&&. usrSpr E.^. UserSupervisorRerouteNotifications + E.where_ $ E.exists subs + return (usr, E.subSelectCount subs, E.subSelectCount subs') + dbtRowKey = querySuperUser >>> (E.^. UserId) + dbtProj = dbtProjId + dbtColonnade = formColonnade $ mconcat + [ guardMonoid isAdmin $ dbSelect (applying _2) id (return . view (resultSuperUser . _entityKey)) + , colUserNameModalHdr MsgTableSupervisor ForProfileDataR + , sortable (Just "matriculation") (i18nCell MsgTableMatrikelNr) $ \(view resultSuperUser -> entUsr) -> cellHasMatrikelnummerLinked entUsr + , sortable (Just "personal-number") (i18nCell MsgCompanyPersonalNumber) $ \(view $ resultSuperUser . _userCompanyPersonalNumber -> t) -> foldMap textCell t + , sortable (Just "postal-pref") (i18nCell MsgPrefersPostal) $ \(view $ resultSuperUser . _userPrefersPostal -> b) -> iconFixedCell $ iconLetterOrEmail b + , colUserEmail + , sortable Nothing (i18nCell MsgTableCompanyNrEmpSupervised) $ \(view resultSuperCompanySupervised -> nr) -> wgtCell $ word2widget nr + , sortable Nothing (i18nCell MsgTableCompanyNrEmpRerouted ) $ \(view resultSuperCompanyReroutes -> nr) -> wgtCell $ word2widget nr + ] + dbtSorting = mconcat + [ single $ sortUserNameLink querySuperUser + , single $ sortUserEmail querySuperUser + , singletonMap "matriculation" $ SortColumn $ querySuperUser >>> (E.^. UserMatrikelnummer) + , singletonMap "personal-number" $ SortColumn $ querySuperUser >>> (E.^. UserCompanyPersonalNumber) + , singletonMap "postal-pref" $ SortColumn $ querySuperUser >>> (E.^. UserPrefersPostal) + ] + dbtFilter = mconcat + [ single $ fltrUserNameEmail querySuperUser + ] + dbtFilterUI mPrev = mconcat + [ fltrUserNameEmailHdrUI MsgTableSupervisor mPrev + ] + dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } + acts :: Map FirmSuperAction (AForm Handler FirmSuperActionData) + acts = mconcat + [ singletonMap FirmSuperActNotify $ pure FirmSuperActNotifyData + , singletonMap FirmSuperActRMSuperDef $ pure FirmSuperActRMSuperDefData + , singletonMap FirmSuperActRMSuperAll $ pure FirmSuperActRMSuperAllData + ] + dbtParams = DBParamsForm + { dbParamsFormMethod = POST + , dbParamsFormAction = Nothing + , dbParamsFormAttrs = [] + , dbParamsFormSubmit = FormSubmit + , dbParamsFormAdditional + = renderAForm FormStandard $ (, mempty) . First . Just + <$> multiActionA acts (fslI MsgTableAction) Nothing + , dbParamsFormEvaluate = liftHandler . runFormPost + , dbParamsFormResult = id + , dbParamsFormIdent = def + } + dbtIdent :: Text + dbtIdent = "firm-supervisors" + dbtCsvEncode = noCsvEncode + dbtCsvDecode = Nothing + dbtExtraReps = [] + + postprocess :: FormResult (First FirmSuperActionData, DBFormResult UserId Bool SuperCompanyTableData) + -> FormResult ( FirmSuperActionData, Set UserId) + postprocess inp = 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 + + getFirmSupersR, postFirmSupersR :: CompanyShorthand -> Handler Html getFirmSupersR = postFirmSupersR postFirmSupersR fsh = do - let _fshId = CompanyKey fsh + isAdmin <- hasReadAccessTo AdminR + let fshId = CompanyKey fsh + (Company{..},(fsprRes,fsprTable)) <- runDB $ (,) + <$> get404 fshId + <*> mkFirmSuperTable isAdmin fshId + + formResult fsprRes $ \case + (FirmSuperActNotifyData , fids) -> addMessage Info $ text2Html $ "Notify " <> tshow (length fids) <> " supervisors. TODO" + (FirmSuperActRMSuperDefData, fids) -> addMessage Info $ text2Html $ "Remove " <> tshow (length fids) <> " default supervisors. TODO" + (FirmSuperActRMSuperAllData, fids) -> addMessage Info $ text2Html $ "Make " <> tshow (length fids) <> " default and active supervisors. TODO" + siteLayout (citext2widget fsh) $ do setTitle $ citext2Html fsh - [whamlet|!!!STUB!!!TO DO!!!|] + -- TODO: factor out company info section hamlet here and from user table + [whamlet| +

+

!!!STUB!!!TO DO!!! +
+
+ $maybe fem <- companyEmail +
+ _{MsgFirmEmail} #{iconLetterOrEmail False} +
+ #{mailtoHtml fem} + $maybe addr <- companyPostAddress +
+ _{MsgFirmAddress} #{iconLetterOrEmail True} +
+ #{addr} +
+ ^{fsprTable} + |] diff --git a/src/Handler/Utils/Company.hs b/src/Handler/Utils/Company.hs index 1b8b9dafa..440f6c8fa 100644 --- a/src/Handler/Utils/Company.hs +++ b/src/Handler/Utils/Company.hs @@ -40,14 +40,14 @@ upsertCompany cName cAddr = Nothing -> do let cShort = companyShorthandFromName cName cShort' <- findShort cName' $ CI.mk cShort - let compy = Company cName' cShort' 0 False cAddr -- TODO: Fix this once AVS CR3 SCF-165 is implemented + let compy = Company cName' cShort' 0 False cAddr Nothing -- TODO: Fix this once AVS CR3 SCF-165 is implemented either entityKey id <$> insertBy compy where findShort :: CompanyName -> CompanyShorthand -> DB CompanyShorthand findShort fna fsh = aux 0 where aux n = let fsh' = if n==0 then fsh else fsh <> CI.mk (tshow n) in - checkUnique (Company fna fsh' 0 False Nothing) >>= \case + checkUnique (Company fna fsh' 0 False Nothing Nothing) >>= \case Nothing -> return fsh' _other -> aux (n+1) diff --git a/src/Handler/Utils/Table/Columns.hs b/src/Handler/Utils/Table/Columns.hs index ce4147b03..6184d1314 100644 --- a/src/Handler/Utils/Table/Columns.hs +++ b/src/Handler/Utils/Table/Columns.hs @@ -753,16 +753,25 @@ sortUserCompany queryUser = ( "user-company" return (comp E.^. CompanyName) )) --- | Search companies by name, shorthand oder AVS nr --- fltrCompanyNameNr :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d) --- => (a -> E.SqlExpr (Entity Company)) --- -> (d, FilterColumn t fs) --- fltrCompanyNameNr query = ( "company-name-number", FilterColumn $ anyFilter --- [ mkContainsFilterWithComma CI.mk $ query >>> (E.^. CompanyName) --- , mkContainsFilterWithComma CI.mk $ query >>> (E.^. CompanyShorthand) --- , mkExactFilterWithComma id $ query >>> (E.num2text . (E.^. CompanyAvsId)) --- ] --- ) +-- | Search companies by name or shorthand +fltrCompanyName :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d) + => (a -> E.SqlExpr (Entity Company)) + -> (d, FilterColumn t fs) +fltrCompanyName query = ( "company-name", FilterColumn $ anyFilter + [ mkContainsFilterWithComma CI.mk $ query >>> (E.^. CompanyName) + , mkContainsFilterWithComma CI.mk $ query >>> (E.^. CompanyShorthand) + -- , mkExactFilterWithComma id $ query >>> (E.num2text . (E.^. CompanyAvsId)) + ] + ) + +fltrCompanyNameUI :: Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text]) +fltrCompanyNameUI = fltrCompanyNameNrHdrUI MsgTableCompany + +fltrCompanyNameHdrUI :: (RenderMessage UniWorX msg) => msg -> Maybe (Map FilterKey [Text]) -> AForm (YesodDB UniWorX) (Map FilterKey [Text]) +fltrCompanyNameHdrUI msg mPrev = + prismAForm (singletonFilter "company-name") mPrev $ aopt textField (fslI msg & setTooltip MsgTableFilterCommaNameNr) + + fltrCompanyNameNr :: (IsFilterColumn t (a -> Set Text -> E.SqlExpr (E.Value Bool)), IsString d) => (a -> E.SqlExpr (Entity Company)) diff --git a/templates/firm-users.hamlet b/templates/firm-users.hamlet new file mode 100644 index 000000000..0da59383f --- /dev/null +++ b/templates/firm-users.hamlet @@ -0,0 +1,69 @@ +$newline never + +$# SPDX-FileCopyrightText: 2023 Steffen Jost +$# +$# SPDX-License-Identifier: AGPL-3.0-or-later + +
+
+ $maybe fem <- companyEmail +
+ _{MsgFirmEmail} #{iconLetterOrEmail False} +
+ #{mailtoHtml fem} + $maybe addr <- companyPostAddress +
+ _{MsgFirmAddress} #{iconLetterOrEmail True} +
+ #{addr} + +
+
+ + + + + + + + +
_{MsgTableCompanyNrSupersDefault} + _{MsgTableCompanyNrRerouteDefault} + _{MsgPrefersPostal} + +
#{nrCompanySupervisors} + #{nrCompanyDefaultReroutes} + #{iconLetterOrEmail companyPrefersPostal} + _{MsgFirmDefaultPreferenceInfo} +
_{MsgTableCompanyNrUsers} + _{MsgTableCompanyNrForeignSupers} +
#{nrCompanyUsers} + #{nrCompanyForeignSupers} + + Anzahl der firmenfremden Ansprechpartner, welche mindestens einen Firmenangehörigen betreuen. Bei manchen Firmen ist es normal, dass die Ansprechpartner einer anderen Firma angehören, aber oft ist nur ein Fehler durch Firmenwechsel. + +
_{MsgTableCompanyNrEmpSupervised} + _{MsgTableCompanyNrEmpRerouted} + _{MsgTableCompanyNrEmpRerPost} + _{MsgTableCompanyNrRerouteActive} +
#{nrCompanyEmployeeSupervised} + #{nrCompanyEmployeeRerouted} + #{nrCompanyEmployeeRerPost} + #{nrCompanyActiveReroutes} +
+ Ansprechpartner müssen nicht notwendigerweise der gleichen Firma angehören! + + Mindestens ein Ansprechpartner mit Umleitung. + + Email oder Brief ist individuelle Einstellung des Ansprechpartners und gilt für alle Benachrichtigungen an diesen Ansprechpartner. + + Gesamtzahl aller aktiven Benachrichtigungsumleitungen. # + + Beispiel: Für eine Firma mit 2 Angehörigen, für die ein Mitarbeiter 1 Ansprechpartner mit aktiver Umleitung und einen Mitarbeiter mit 3 Ansprechpartnern mit aktiver Umleitung hätte, # + würde hier die Zahl 4 stehen, da bei einer Benachrichtigung an beide Mitarbeiter insgesamt 4 Briefe oder Emails versendet würden. + +
+

+ _{MsgFirmAssociates} +

+ ^{fusrTable} \ No newline at end of file diff --git a/templates/i18n/firm-all/de-de-formal.hamlet b/templates/i18n/firm-all/de-de-formal.hamlet index 49ab8a1d5..480a6fbe9 100644 --- a/templates/i18n/firm-all/de-de-formal.hamlet +++ b/templates/i18n/firm-all/de-de-formal.hamlet @@ -8,36 +8,8 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later

- Die Daten der Firmen wurden aus dem Ausweisverwaltungssystem (AVS) der Fraport AG - importiert und werden regelmäßig aktualisiert, + Die Daten der Firmen wurden aus dem Ausweisverwaltungssystem (AVS) der Fraport AG # + importiert und werden regelmäßig aktualisiert, # wenn Fahrlizenzinhaber oder deren Verwalter über das AVS einer Firma zugeordnet wurden.

^{firmTable} - -

Hinweis zur Entwicklungsversion -

- Die Spalten zeigen derzeit folgende Informationen -

    -
  1. Firmenname -
  2. Firmenkürzel -
  3. AVS Firmennummer -
  4. Anzahl der derzeit zugeordneten Firmenangehörigen. Eine Personen kann mehreren Firmen gleichzeitig angehören. -
  5. Anzahl der Standard Ansprechpartner, welche einer neu in FRADrive eingetragnen Person dieser Firma derzeit zugeordnet werden. Eine Person kann beliebig viele Ansprechpartner haben. Wirkt sich nicht auf vorhandene Firmenangehörige aus. -
  6. Anzahl der Standard Ansprechpartner der Firma mit Benachrichtigungsumleitung. Hat eine Person mehrere Ansprechpartner mit Umleitung, so wird ein Brief oder Email an alle Ansprechpartner verschickt. # - Ein Person kann auch ihr eigener Ansprechpartner sein, um eine Benachrichtigung sowohl an die Person selbst als auch an einen Ansprechpartner zu senden. # - Wirkt sich nicht auf vorhandene Firmenangehörige aus, sondern nur auf neu in FRADrive hinzukommende Firmenangehörige. -
  7. Anzahl Firmenangehörige, für die derzeit mindestens ein Ansprechpartner eingetragen ist. Ansprechpartner müssen nicht notwendigerweise der gleichen Firma angehören! -
  8. Anzahl Firmenangehörige, für die derzeit mindestens eine Benachrichtigungsumleitung an einen Ansprechpartner eingetragen ist. Ansprechpartner müssen nicht notwendigerweise der gleichen Firma angehören! -
  9. Anzahl Firmenangehörige, für die derzeit mindestens eine Benachrichtigungsumleitung an einen Ansprechpartner eingetragen ist, welcher den Versand per Briefpost bevorzugt. # - Ob ein Ansprechpartner Email oder Briefpost wünscht ist eine individuelle Einstellung des Ansprechpartners und gilt für alle Benachrichtigungen an diesen Ansprechpartner. -
  10. Anzahl der firmenfremden Ansprechpartner, welche mindestens einen Firmenangehörigen betreuen. Bei manchen Firmen ist es normal, dass die Ansprechpartner einer anderen Firma angehören, aber oft ist nur ein Fehler durch Firmenwechsel. -
  11. Anzahl der Ansprechpartner mit derzeit aktiver Benachrichtigungsumleitung, egal ob Brief oder Email. -
  12. Gesamtzahl der Brief und Emails, welche bei Benachrichtigung aller Firmenangehörigen derzeit verschickt würden. -

    - Dies ist also die Gesamtzahl aller derzeit aktiven Benachrichtigungsumleitungen. -

    - - Beispiel: Für eine Firma mit 2 Angehörigen, für die ein Mitarbeiter 1 Ansprechpartner mit aktiver Umleitung und einen Mitarbeiter mit 3 Ansprechpartnern mit aktiver Umleitung hätte, # - würde hier die Zahl 4 stehen, da bei einer Benachrichtigung an beide Mitarbeiter insgesamt 4 Briefe oder Emails versendet würden. -

  13. Voreinstellung der persönlichen Benachrichtigungspreferenz für Firmenangehörige welche neu aus dem AVS importiert werden (erst mit Umsetzung CR3 effektiv). - diff --git a/templates/i18n/firm-all/en-eu.hamlet b/templates/i18n/firm-all/en-eu.hamlet index e8a2ccfb0..2e32522f3 100644 --- a/templates/i18n/firm-all/en-eu.hamlet +++ b/templates/i18n/firm-all/en-eu.hamlet @@ -14,31 +14,3 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later

    ^{firmTable} - -

    Development Version Notes (TODO: translated paragraph) -

    - Die Spalten zeigen derzeit folgende Informationen -

      -
    1. Firmenname -
    2. Firmenkürzel -
    3. AVS Firmennummer -
    4. Anzahl der derzeit zugeordneten Firmenangehörigen. Eine Personen kann mehreren Firmen gleichzeitig angehören. -
    5. Anzahl der Standard Ansprechpartner, welche einer neu in FRADrive eingetragnen Person dieser Firma derzeit zugeordnet werden. Eine Person kann beliebig viele Ansprechpartner haben. Wirkt sich nicht auf vorhandene Firmenangehörige aus. -
    6. Anzahl der Standard Ansprechpartner der Firma mit Benachrichtigungsumleitung. Hat eine Person mehrere Ansprechpartner mit Umleitung, so wird ein Brief oder Email an alle Ansprechpartner verschickt. # - Ein Person kann auch ihr eigener Ansprechpartner sein, um eine Benachrichtigung sowohl an die Person selbst als auch an einen Ansprechpartner zu senden. # - Wirkt sich nicht auf vorhandene Firmenangehörige aus, sondern nur auf neu in FRADrive hinzukommende Firmenangehörige. -
    7. Anzahl Firmenangehörige, für die derzeit mindestens ein Ansprechpartner eingetragen ist. Ansprechpartner müssen nicht notwendigerweise der gleichen Firma angehören! -
    8. Anzahl Firmenangehörige, für die derzeit mindestens eine Benachrichtigungsumleitung an einen Ansprechpartner eingetragen ist. Ansprechpartner müssen nicht notwendigerweise der gleichen Firma angehören! -
    9. Anzahl Firmenangehörige, für die derzeit mindestens eine Benachrichtigungsumleitung an einen Ansprechpartner eingetragen ist, welcher den Versand per Briefpost bevorzugt. # - Ob ein Ansprechpartner Email oder Briefpost wünscht ist eine individuelle Einstellung des Ansprechpartners und gilt für alle Benachrichtigungen an diesen Ansprechpartner. -
    10. Anzahl der firmenfremden Ansprechpartner, welche mindestens einen Firmenangehörigen betreuen. Bei manchen Firmen ist es normal, dass die Ansprechpartner einer anderen Firma angehören, aber oft ist nur ein Fehler durch Firmenwechsel. -
    11. Anzahl der Ansprechpartner mit derzeit aktiver Benachrichtigungsumleitung, egal ob Brief oder Email. -
    12. Gesamtzahl der Brief und Emails, welche bei Benachrichtigung aller Firmenangehörigen derzeit verschickt würden. -

      - Dies ist also die Gesamtzahl aller derzeit aktiven Benachrichtigungsumleitungen. -

      - - Beispiel: Für eine Firma mit 2 Angehörigen, für die ein Mitarbeiter 1 Ansprechpartner mit aktiver Umleitung und einen Mitarbeiter mit 3 Ansprechpartnern mit aktiver Umleitung hätte, # - würde hier die Zahl 4 stehen, da bei einer Benachrichtigung an beide Mitarbeiter insgesamt 4 Briefe oder Emails versendet würden. -

    13. Voreinstellung der persönlichen Benachrichtigungspreferenz für Firmenangehörige welche neu aus dem AVS importiert werden (erst mit Umsetzung CR3 effektiv). - diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index 2343751ff..9e1b9cea6 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -624,11 +624,12 @@ 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) - 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) - nice <- insert' $ Company "N*ICE Aircraft Services & Support GmbH" "N*ICE" 33 False $ Just $ markdownToStoredMarkup ("69 Nevermore Blvd.\nHarlaemn\nNew York\nUSA"::Text) - ffacil <- insert' $ Company "Fraport Facility Services GmbH" "GCS" 44 False Nothing - bpol <- insert' $ Company "Bundespolizeidirektion Flughafen Frankfurt am Main" "BPol" 5555 False Nothing + 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 void . insert' $ UserCompany jost fraportAg True True void . insert' $ UserCompany svaupel nice True False void . insert' $ UserCompany gkleen nice False False @@ -660,7 +661,7 @@ fillDb = do , UserSupervisor gkleen gkleen True , UserSupervisor tinaTester tinaTester False ] - ++ take 333 [ UserSupervisor fhamann uid True | Entity uid _ <- matUsers ] + ++ take 333 [ UserSupervisor fhamann uid True | Entity uid _ <- matUsers, uid /= jost] ++ take 111 [ UserSupervisor gkleen uid True | Entity uid _ <- drop 300 matUsers ] ++ take 11 [ UserSupervisor jost uid False | Entity uid _ <- drop 401 matUsers ] upsertManyWhere supvs [] [] []