chore(csv): export company in csv
This commit is contained in:
parent
412c56e78c
commit
26463c6032
@ -25,6 +25,7 @@ TableQualificationBlockedTooltip: Wann wurde die Qualifikation vorübergehend au
|
||||
TableQualificationBlockedTooltipSimple: Wann wurde die Qualifikation aus besonderem Grund wiederrufen?
|
||||
TableQualificationNoRenewal: Auslaufend
|
||||
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
|
||||
QualificationUserNone: Für diese Person sind keine Qualifikationen registriert.
|
||||
QualificationBlockReason: Entzugsbegründung
|
||||
|
||||
@ -25,6 +25,7 @@ TableQualificationBlockedTooltip: Why and when was this qualification temporaril
|
||||
TableQualificationBlockedTooltipSimple: When was this qualification revoked due to extraordinary reasons?
|
||||
TableQualificationNoRenewal: Discontinued
|
||||
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
|
||||
QualificationUserNone: No registered qualifications for this person.
|
||||
QualificationBlockReason: Reason for revoking
|
||||
|
||||
@ -151,26 +151,30 @@ mkQualificationAllTable = do
|
||||
-- postQualificationEditR = error "TODO"
|
||||
|
||||
data QualificationTableCsv = QualificationTableCsv -- Q..T..C.. -> qtc..
|
||||
{ qtcDisplayName :: UserDisplayName
|
||||
, qtcEmail :: UserEmail
|
||||
, qtcValidUntil :: Day
|
||||
, qtcLastRefresh :: Day
|
||||
, qtcBlocked :: Maybe Day
|
||||
, qtcLmsStatusTxt :: Maybe Text
|
||||
, qtcLmsStatusDay :: Maybe Day
|
||||
{ qtcDisplayName :: UserDisplayName
|
||||
, qtcEmail :: UserEmail
|
||||
, qtcCompany :: Maybe Text
|
||||
, qtcValidUntil :: Day
|
||||
, qtcLastRefresh :: Day
|
||||
, qtcBlocked :: Maybe Day
|
||||
, qtcScheduleRenewal:: Bool
|
||||
, qtcLmsStatusTxt :: Maybe Text
|
||||
, qtcLmsStatusDay :: Maybe Day
|
||||
}
|
||||
deriving Generic
|
||||
makeLenses_ ''QualificationTableCsv
|
||||
|
||||
qtcExample :: QualificationTableCsv
|
||||
qtcExample = QualificationTableCsv
|
||||
{ qtcDisplayName = "Max Mustermann"
|
||||
, qtcEmail = "m.mustermann@example.com"
|
||||
, qtcValidUntil = compDay
|
||||
, qtcLastRefresh = compDay
|
||||
, qtcBlocked = Nothing
|
||||
, qtcLmsStatusTxt = Just "Success"
|
||||
, qtcLmsStatusDay = Just compDay
|
||||
{ qtcDisplayName = "Max Mustermann"
|
||||
, qtcEmail = "m.mustermann@example.com"
|
||||
, qtcCompany = Just "Example Brothers LLC"
|
||||
, qtcValidUntil = compDay
|
||||
, qtcLastRefresh = compDay
|
||||
, qtcBlocked = Nothing
|
||||
, qtcScheduleRenewal= True
|
||||
, qtcLmsStatusTxt = Just "Success"
|
||||
, qtcLmsStatusDay = Just compDay
|
||||
}
|
||||
where
|
||||
compTime :: UTCTime
|
||||
@ -185,7 +189,7 @@ qtcOptions = Csv.defaultOptions { Csv.fieldLabelModifier = renameLtc }
|
||||
renameLtc other = replaceLtc $ camelToPathPiece' 1 other
|
||||
replaceLtc ('l':'m':'s':'-':t) = prefixLms t
|
||||
replaceLtc other = other
|
||||
prefixLms = ("e-learn-" <>)
|
||||
prefixLms = ("elearn-" <>)
|
||||
|
||||
instance Csv.ToNamedRecord QualificationTableCsv where
|
||||
toNamedRecord = Csv.genericToNamedRecord qtcOptions
|
||||
@ -195,30 +199,37 @@ instance Csv.DefaultOrdered QualificationTableCsv where
|
||||
|
||||
instance CsvColumnsExplained QualificationTableCsv where
|
||||
csvColumnsExplanations = genericCsvColumnsExplanations qtcOptions $ Map.fromList
|
||||
[ ('qtcDisplayName, MsgLmsUser)
|
||||
, ('qtcEmail , MsgTableLmsEmail)
|
||||
, ('qtcValidUntil , MsgLmsQualificationValidUntil)
|
||||
, ('qtcLastRefresh, MsgTableQualificationLastRefresh)
|
||||
, ('qtcLmsStatusTxt, MsgTableLmsStatus)
|
||||
, ('qtcLmsStatusDay, MsgTableLmsStatusDay)
|
||||
[ ('qtcDisplayName , SomeMessage MsgLmsUser)
|
||||
, ('qtcEmail , SomeMessage MsgTableLmsEmail)
|
||||
, ('qtcCompany , SomeMessage MsgTableCompany)
|
||||
, ('qtcValidUntil , SomeMessage MsgLmsQualificationValidUntil)
|
||||
, ('qtcLastRefresh , SomeMessage MsgTableQualificationLastRefresh)
|
||||
, ('qtcScheduleRenewal, SomeMessage MsgQualificationScheduleRenewalTooltip)
|
||||
, ('qtcLmsStatusTxt , SomeMessage MsgTableLmsStatus)
|
||||
, ('qtcLmsStatusDay , SomeMessage MsgTableLmsStatusDay)
|
||||
]
|
||||
|
||||
|
||||
type QualificationTableExpr = ( E.SqlExpr (Entity QualificationUser)
|
||||
`E.InnerJoin` E.SqlExpr (Entity User)
|
||||
) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity LmsUser))
|
||||
type QualificationTableExpr = ( E.SqlExpr (Entity QualificationUser)
|
||||
`E.InnerJoin` E.SqlExpr (Entity User)
|
||||
) `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 = $(sqlIJproj 2 1) . $(sqlLOJproj 2 1)
|
||||
queryQualUser = $(sqlIJproj 2 1) . $(sqlLOJproj 3 1)
|
||||
|
||||
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 = $(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 = _dbrOutput . _1
|
||||
@ -229,6 +240,9 @@ resultUser = _dbrOutput . _2
|
||||
resultLmsUser :: Traversal' QualificationTableData (Entity LmsUser)
|
||||
resultLmsUser = _dbrOutput . _3 . _Just
|
||||
|
||||
resultCompany :: Traversal' QualificationTableData (Entity Company)
|
||||
resultCompany = _dbrOutput . _4 . _Just
|
||||
|
||||
|
||||
instance HasEntity QualificationTableData User where
|
||||
hasEntity = resultUser
|
||||
@ -273,13 +287,16 @@ qualificationTableQuery :: QualificationId -> (_ -> E.SqlExpr (E.Value Bool)) ->
|
||||
-> E.SqlQuery ( E.SqlExpr (Entity QualificationUser)
|
||||
, E.SqlExpr (Entity User)
|
||||
, 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.&&. 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.where_ $ fltr qualUser E.&&. (E.val qid E.==. qualUser E.^. QualificationUserQualification)
|
||||
return (qualUser, user, lmsUser)
|
||||
return (qualUser, user, lmsUser, company)
|
||||
|
||||
|
||||
mkQualificationTable ::
|
||||
@ -324,6 +341,7 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
|
||||
E.orderBy [E.asc (comp E.^. CompanyName)]
|
||||
return (comp E.^. CompanyName)
|
||||
)
|
||||
, single ( "company", SortColumn $ queryCompany >>> (E.?. CompanyName))
|
||||
]
|
||||
dbtFilter = mconcat
|
||||
[ single $ fltrUserNameEmail queryUser
|
||||
@ -372,9 +390,11 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
|
||||
doEncode' = QualificationTableCsv
|
||||
<$> view (resultUser . _entityVal . _userDisplayName)
|
||||
<*> view (resultUser . _entityVal . _userDisplayEmail)
|
||||
<*> preview (resultCompany . _entityVal . _companyName . _CI)
|
||||
<*> view (resultQualUser . _entityVal . _qualificationUserValidUntil)
|
||||
<*> view (resultQualUser . _entityVal . _qualificationUserLastRefresh)
|
||||
<*> preview (resultQualUser . _entityVal . _qualificationUserBlockedDue . _Just . _qualificationBlockedDay)
|
||||
<*> view (resultQualUser . _entityVal . _qualificationUserScheduleRenewal)
|
||||
<*> getStatusPlusTxt
|
||||
<*> getStatusPlusDay
|
||||
getStatusPlusTxt =
|
||||
@ -450,6 +470,7 @@ postQualificationR sid qsh = do
|
||||
(\(E.Value cmpName, E.Value cmpSpr) -> text2markup (CI.original cmpName) <> bool mempty icnSuper cmpSpr) <$> companies'
|
||||
icnSuper = text2markup " " <> icon IconSupervisor
|
||||
pure $ toWgt $ mconcat companies
|
||||
, sortable (Just "company") (i18nCell MsgTableCompany) $ \( preview $ resultCompany . _entityVal . _companyName . _CI -> cn) -> cellMaybe textCell cn
|
||||
, guardMonoid isAdmin colUserMatriclenr
|
||||
, 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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user