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

chore(csv): export company in csv

Browse Source
This commit is contained in:
Steffen Jost 2023-04-26 15:36:23 +00:00
parent 412c56e78c
commit 26463c6032
3 changed files with 53 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -25,6 +25,7 @@ TableQualificationBlockedTooltip: Wann wurde die Qualifikation vorübergehend au
TableQualificationBlockedTooltipSimple: Wann wurde die Qualifikation aus besonderem Grund wiederrufen? TableQualificationBlockedTooltipSimple: Wann wurde die Qualifikation aus besonderem Grund wiederrufen?
TableQualificationNoRenewal: Auslaufend TableQualificationNoRenewal: Auslaufend
TableQualificationNoRenewalTooltip: Es wird keine Benachrichtigung mehr versendet, wenn diese Qualifikation ablaufen sollte. Die Qualifikation kann noch weiterhin gültig sein. TableQualificationNoRenewalTooltip: Es wird keine Benachrichtigung mehr versendet, wenn diese Qualifikation ablaufen sollte. Die Qualifikation kann noch weiterhin gültig sein.
QualificationScheduleRenewalTooltip: Wird eine Benachrichtigung versendet, falls diese Qualikation bald ablaufen sollte?
QualificationUserNoRenewal: Läuft ohne Benachrichtigung aus QualificationUserNoRenewal: Läuft ohne Benachrichtigung aus
QualificationUserNone: Für diese Person sind keine Qualifikationen registriert. QualificationUserNone: Für diese Person sind keine Qualifikationen registriert.
QualificationBlockReason: Entzugsbegründung QualificationBlockReason: Entzugsbegründung

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

@ -25,6 +25,7 @@ TableQualificationBlockedTooltip: Why and when was this qualification temporaril
TableQualificationBlockedTooltipSimple: When was this qualification revoked due to extraordinary reasons? TableQualificationBlockedTooltipSimple: When was this qualification revoked due to extraordinary reasons?
TableQualificationNoRenewal: Discontinued TableQualificationNoRenewal: Discontinued
TableQualificationNoRenewalTooltip: No renewal notifications will be send for this qualification upon expiry. The qualification may still be valid. TableQualificationNoRenewalTooltip: No renewal notifications will be send for this qualification upon expiry. The qualification may still be valid.
QualificationScheduleRenewalTooltip: Will there be a notification, if this qualification is about to expire soon?
QualificationUserNoRenewal: Expires without further notification QualificationUserNoRenewal: Expires without further notification
QualificationUserNone: No registered qualifications for this person. QualificationUserNone: No registered qualifications for this person.
QualificationBlockReason: Reason for revoking QualificationBlockReason: Reason for revoking

81
src/Handler/Qualification.hs
View File

@ -151,26 +151,30 @@ mkQualificationAllTable = do
-- postQualificationEditR = error "TODO" -- postQualificationEditR = error "TODO"
data QualificationTableCsv = QualificationTableCsv -- Q..T..C.. -> qtc.. data QualificationTableCsv = QualificationTableCsv -- Q..T..C.. -> qtc..
{ qtcDisplayName :: UserDisplayName { qtcDisplayName :: UserDisplayName
, qtcEmail :: UserEmail , qtcEmail :: UserEmail
, qtcValidUntil :: Day , qtcCompany :: Maybe Text
, qtcLastRefresh :: Day , qtcValidUntil :: Day
, qtcBlocked :: Maybe Day , qtcLastRefresh :: Day
, qtcLmsStatusTxt :: Maybe Text , qtcBlocked :: Maybe Day
, qtcLmsStatusDay :: Maybe Day , qtcScheduleRenewal:: Bool
, qtcLmsStatusTxt :: Maybe Text
, qtcLmsStatusDay :: Maybe Day
} }
deriving Generic deriving Generic
makeLenses_ ''QualificationTableCsv makeLenses_ ''QualificationTableCsv
qtcExample :: QualificationTableCsv qtcExample :: QualificationTableCsv
qtcExample = QualificationTableCsv qtcExample = QualificationTableCsv
{ qtcDisplayName = "Max Mustermann" { qtcDisplayName = "Max Mustermann"
, qtcEmail = "m.mustermann@example.com" , qtcEmail = "m.mustermann@example.com"
, qtcValidUntil = compDay , qtcCompany = Just "Example Brothers LLC"
, qtcLastRefresh = compDay , qtcValidUntil = compDay
, qtcBlocked = Nothing , qtcLastRefresh = compDay
, qtcLmsStatusTxt = Just "Success" , qtcBlocked = Nothing
, qtcLmsStatusDay = Just compDay , qtcScheduleRenewal= True
, qtcLmsStatusTxt = Just "Success"
, qtcLmsStatusDay = Just compDay
} }
where where
compTime :: UTCTime compTime :: UTCTime
@ -185,7 +189,7 @@ qtcOptions = Csv.defaultOptions { Csv.fieldLabelModifier = renameLtc }
renameLtc other = replaceLtc $ camelToPathPiece' 1 other renameLtc other = replaceLtc $ camelToPathPiece' 1 other
replaceLtc ('l':'m':'s':'-':t) = prefixLms t replaceLtc ('l':'m':'s':'-':t) = prefixLms t
replaceLtc other = other replaceLtc other = other
prefixLms = ("e-learn-" <>) prefixLms = ("elearn-" <>)
instance Csv.ToNamedRecord QualificationTableCsv where instance Csv.ToNamedRecord QualificationTableCsv where
toNamedRecord = Csv.genericToNamedRecord qtcOptions toNamedRecord = Csv.genericToNamedRecord qtcOptions
@ -195,30 +199,37 @@ instance Csv.DefaultOrdered QualificationTableCsv where
instance CsvColumnsExplained QualificationTableCsv where instance CsvColumnsExplained QualificationTableCsv where
csvColumnsExplanations = genericCsvColumnsExplanations qtcOptions $ Map.fromList csvColumnsExplanations = genericCsvColumnsExplanations qtcOptions $ Map.fromList
[ ('qtcDisplayName, MsgLmsUser) [ ('qtcDisplayName , SomeMessage MsgLmsUser)
, ('qtcEmail , MsgTableLmsEmail) , ('qtcEmail , SomeMessage MsgTableLmsEmail)
, ('qtcValidUntil , MsgLmsQualificationValidUntil) , ('qtcCompany , SomeMessage MsgTableCompany)
, ('qtcLastRefresh, MsgTableQualificationLastRefresh) , ('qtcValidUntil , SomeMessage MsgLmsQualificationValidUntil)
, ('qtcLmsStatusTxt, MsgTableLmsStatus) , ('qtcLastRefresh , SomeMessage MsgTableQualificationLastRefresh)
, ('qtcLmsStatusDay, MsgTableLmsStatusDay) , ('qtcScheduleRenewal, SomeMessage MsgQualificationScheduleRenewalTooltip)
, ('qtcLmsStatusTxt , SomeMessage MsgTableLmsStatus)
, ('qtcLmsStatusDay , SomeMessage MsgTableLmsStatusDay)
] ]
type QualificationTableExpr = ( E.SqlExpr (Entity QualificationUser) type QualificationTableExpr = ( E.SqlExpr (Entity QualificationUser)
`E.InnerJoin` E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity User)
) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity LmsUser)) ) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity LmsUser))
`E.LeftOuterJoin` ( E.SqlExpr (Maybe (Entity UserCompany))
`E.InnerJoin` E.SqlExpr (Maybe (Entity Company)))
queryQualUser :: QualificationTableExpr -> E.SqlExpr (Entity QualificationUser) queryQualUser :: QualificationTableExpr -> E.SqlExpr (Entity QualificationUser)
queryQualUser = $(sqlIJproj 2 1) . $(sqlLOJproj 2 1) queryQualUser = $(sqlIJproj 2 1) . $(sqlLOJproj 3 1)
queryUser :: QualificationTableExpr -> E.SqlExpr (Entity User) queryUser :: QualificationTableExpr -> E.SqlExpr (Entity User)
queryUser = $(sqlIJproj 2 2) . $(sqlLOJproj 2 1) queryUser = $(sqlIJproj 2 2) . $(sqlLOJproj 3 1)
queryLmsUser :: QualificationTableExpr -> E.SqlExpr (Maybe (Entity LmsUser)) queryLmsUser :: QualificationTableExpr -> E.SqlExpr (Maybe (Entity LmsUser))
queryLmsUser = $(sqlLOJproj 2 2) queryLmsUser = $(sqlLOJproj 3 2)
queryCompany :: QualificationTableExpr -> E.SqlExpr (Maybe (Entity Company))
queryCompany = $(sqlIJproj 2 2) . $(sqlLOJproj 3 3)
type QualificationTableData = DBRow (Entity QualificationUser, Entity User, Maybe (Entity LmsUser)) type QualificationTableData = DBRow (Entity QualificationUser, Entity User, Maybe (Entity LmsUser), Maybe (Entity Company))
resultQualUser :: Lens' QualificationTableData (Entity QualificationUser) resultQualUser :: Lens' QualificationTableData (Entity QualificationUser)
resultQualUser = _dbrOutput . _1 resultQualUser = _dbrOutput . _1
@ -229,6 +240,9 @@ resultUser = _dbrOutput . _2
resultLmsUser :: Traversal' QualificationTableData (Entity LmsUser) resultLmsUser :: Traversal' QualificationTableData (Entity LmsUser)
resultLmsUser = _dbrOutput . _3 . _Just resultLmsUser = _dbrOutput . _3 . _Just
resultCompany :: Traversal' QualificationTableData (Entity Company)
resultCompany = _dbrOutput . _4 . _Just
instance HasEntity QualificationTableData User where instance HasEntity QualificationTableData User where
hasEntity = resultUser hasEntity = resultUser
@ -273,13 +287,16 @@ qualificationTableQuery :: QualificationId -> (_ -> E.SqlExpr (E.Value Bool)) ->
-> E.SqlQuery ( E.SqlExpr (Entity QualificationUser) -> E.SqlQuery ( E.SqlExpr (Entity QualificationUser)
, E.SqlExpr (Entity User) , E.SqlExpr (Entity User)
, E.SqlExpr (Maybe (Entity LmsUser)) , E.SqlExpr (Maybe (Entity LmsUser))
, E.SqlExpr (Maybe (Entity Company))
) )
qualificationTableQuery qid fltr (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser) = do qualificationTableQuery qid fltr (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser `E.LeftOuterJoin` (usrComp `E.InnerJoin` company)) = do
E.on $ usrComp E.?. UserCompanyCompany E.==. company E.?. CompanyId
E.on $ usrComp E.?. UserCompanyUser E.?=. user E.^. UserId
E.on $ user E.^. UserId E.=?. lmsUser E.?. LmsUserUser E.on $ user E.^. UserId E.=?. lmsUser E.?. LmsUserUser
E.&&. E.val qid E.=?. lmsUser E.?. LmsUserQualification -- NOTE: condition was once erroneously placed in where-clause, which does not work E.&&. E.val qid E.=?. lmsUser E.?. LmsUserQualification -- NOTE: condition was once erroneously placed in where-clause, which does not work
E.on $ user E.^. UserId E.==. qualUser E.^. QualificationUserUser E.on $ user E.^. UserId E.==. qualUser E.^. QualificationUserUser
E.where_ $ fltr qualUser E.&&. (E.val qid E.==. qualUser E.^. QualificationUserQualification) E.where_ $ fltr qualUser E.&&. (E.val qid E.==. qualUser E.^. QualificationUserQualification)
return (qualUser, user, lmsUser) return (qualUser, user, lmsUser, company)
mkQualificationTable :: mkQualificationTable ::
@ -324,6 +341,7 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
E.orderBy [E.asc (comp E.^. CompanyName)] E.orderBy [E.asc (comp E.^. CompanyName)]
return (comp E.^. CompanyName) return (comp E.^. CompanyName)
) )
, single ( "company", SortColumn $ queryCompany >>> (E.?. CompanyName))
] ]
dbtFilter = mconcat dbtFilter = mconcat
[ single $ fltrUserNameEmail queryUser [ single $ fltrUserNameEmail queryUser
@ -372,9 +390,11 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
doEncode' = QualificationTableCsv doEncode' = QualificationTableCsv
<$> view (resultUser . _entityVal . _userDisplayName) <$> view (resultUser . _entityVal . _userDisplayName)
<*> view (resultUser . _entityVal . _userDisplayEmail) <*> view (resultUser . _entityVal . _userDisplayEmail)
<*> preview (resultCompany . _entityVal . _companyName . _CI)
<*> view (resultQualUser . _entityVal . _qualificationUserValidUntil) <*> view (resultQualUser . _entityVal . _qualificationUserValidUntil)
<*> view (resultQualUser . _entityVal . _qualificationUserLastRefresh) <*> view (resultQualUser . _entityVal . _qualificationUserLastRefresh)
<*> preview (resultQualUser . _entityVal . _qualificationUserBlockedDue . _Just . _qualificationBlockedDay) <*> preview (resultQualUser . _entityVal . _qualificationUserBlockedDue . _Just . _qualificationBlockedDay)
<*> view (resultQualUser . _entityVal . _qualificationUserScheduleRenewal)
<*> getStatusPlusTxt <*> getStatusPlusTxt
<*> getStatusPlusDay <*> getStatusPlusDay
getStatusPlusTxt = getStatusPlusTxt =
@ -450,6 +470,7 @@ postQualificationR sid qsh = do
(\(E.Value cmpName, E.Value cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> companies' (\(E.Value cmpName, E.Value cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> companies'
icnSuper = text2markup " " <> icon IconSupervisor icnSuper = text2markup " " <> icon IconSupervisor
pure $ toWgt $ mconcat companies pure $ toWgt $ mconcat companies
, sortable (Just "company") (i18nCell MsgTableCompany) $ \( preview $ resultCompany . _entityVal . _companyName . _CI -> cn) -> cellMaybe textCell cn
, guardMonoid isAdmin colUserMatriclenr , guardMonoid isAdmin colUserMatriclenr
, sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \( view $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> dayCell d , sortable (Just "valid-until") (i18nCell MsgLmsQualificationValidUntil) $ \( view $ resultQualUser . _entityVal . _qualificationUserValidUntil -> d) -> dayCell d
, sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \( view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> dayCell d , sortable (Just "last-refresh") (i18nCell MsgTableQualificationLastRefresh)$ \( view $ resultQualUser . _entityVal . _qualificationUserLastRefresh -> d) -> dayCell d