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

chore(lms): csv export compiles again -- horray!

Browse Source
This commit is contained in:
Steffen Jost 2022-07-29 10:54:49 +02:00
parent 8aab8b7b6b
commit b6254bc399
1 changed files with 37 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

59
src/Handler/LMS.hs
View File

@ -187,7 +187,7 @@ makeLenses_ ''LmsTableCsv
ltcOptions :: Csv.Options
ltcOptions = Csv.defaultOptions { Csv.fieldLabelModifier = renameLtc }
where
where
renameLtc "ltcDisplayName" = "licensee"
renameLtc "ltcLmsDatePin" = prefixLms "pin-created"
renameLtc "ltcLmsReceived" = prefixLms "last-update"
@ -228,10 +228,10 @@ lmsTableCsvHeader = Csv.header $ fst <$> lmsTableCsvHeaderList (error "lmsTableC
}
-}
instance Csv.ToNamedRecord LmsTableCsv where
instance Csv.ToNamedRecord LmsTableCsv where
toNamedRecord ltc = Csv.namedRecord $ lmsTableCsvHeaderList ltc
instance CsvColumnsExplained LmsTableCsv
instance CsvColumnsExplained LmsTableCsv
-- where csvColumnsExplanations _ = ??
@ -279,18 +279,18 @@ embedRenderMessage ''UniWorX ''LmsTableAction id
-- Not yet needed, since there is no additional data for now:
data LmsTableActionData = LmsActNotifyData
| LmsActRenewNotifyData
| LmsActRenewPinData
| LmsActRenewPinData
deriving (Eq, Ord, Read, Show, Generic, Typeable)
isNotifyAct :: LmsTableActionData -> Bool
isNotifyAct LmsActNotifyData = True
isNotifyAct LmsActRenewNotifyData = True
isNotifyAct LmsActRenewPinData = False
isNotifyAct LmsActRenewNotifyData = True
isNotifyAct LmsActRenewPinData = False
isRenewPinAct :: LmsTableActionData -> Bool
isRenewPinAct LmsActNotifyData = False
isRenewPinAct LmsActRenewNotifyData = True
isRenewPinAct LmsActRenewPinData = True
isRenewPinAct LmsActRenewNotifyData = True
isRenewPinAct LmsActRenewPinData = True
lmsTableQuery :: QualificationId -> LmsTableExpr -> E.SqlQuery ( E.SqlExpr (Entity QualificationUser)
, E.SqlExpr (Entity User)
@ -324,7 +324,7 @@ mkLmsTable (Entity qid quali) acts restrict cols psValidator = do
mbRenewal = addGregorianDurationClip <$> qualificationRefreshWithin quali <*> Just nowaday
dbtSQLQuery q = lmsTableQuery qid q <* E.where_ (restrict q)
dbtRowKey = queryUser >>> (E.^. UserId)
dbtProj = dbtProjFilteredPostId
dbtProj = dbtProjFilteredPostId
dbtColonnade = cols
dbtSorting = mconcat
[ single $ sortUserNameLink queryUser
@ -366,22 +366,37 @@ mkLmsTable (Entity qid quali) acts restrict cols psValidator = do
{ dbtCsvExportForm = pure ()
, dbtCsvDoEncode = \() -> C.map (doEncode' . view _2)
, dbtCsvName = "TODO" :: Text
, dbtCsvSheetName = "TODO" :: Text
, dbtCsvSheetName = "TODO" :: Text
, dbtCsvNoExportData = Just id
, dbtCsvHeader = const $ return lmsTableCsvHeader
, dbtCsvExampleData = Nothing -- TODO
{-
Just
[ LmsTableCsv{csvLRTident = LmsIdent lid, csvLRTsuccess = LmsDay $ addDays (-dos) now_day }
| (lid,dos) <- zip ["abcdefgh", "12345678", "ident8ch"] [1..]
]
Just
[ LmsTableCsv{csvLRTident = LmsIdent lid, csvLRTsuccess = LmsDay $ addDays (-dos) now_day }
| (lid,dos) <- zip ["abcdefgh", "12345678", "ident8ch"] [1..]
]
-}
}
where
where
doEncode' :: LmsTableData -> LmsTableCsv
doEncode' = LmsTableCsv
doEncode' ltd = LmsTableCsv {
ltcDisplayName = ltd ^. (resultUser . _entityVal . _userDisplayName)
, ltcEmail = ltd ^. (resultUser . _entityVal . _userEmail)
, ltcValidUntil = ltd ^. (resultQualUser . _entityVal . _qualificationUserValidUntil)
, ltcLastRefresh = ltd ^. (resultQualUser . _entityVal . _qualificationUserLastRefresh)
, ltcFirstHeld = ltd ^. (resultQualUser . _entityVal . _qualificationUserFirstHeld)
, ltcLmsIdent = ltd ^? (resultLmsUser . _entityVal . _lmsUserIdent)
, ltcLmsStatus = join $ ltd ^? (resultLmsUser . _entityVal . _lmsUserStatus)
, ltcLmsStarted = ltd ^? (resultLmsUser . _entityVal . _lmsUserStarted)
, ltcLmsDatePin = ltd ^? (resultLmsUser . _entityVal . _lmsUserDatePin)
, ltcLmsReceived = join $ ltd ^? (resultLmsUser . _entityVal . _lmsUserReceived)
, ltcLmsEnded = join $ ltd ^? (_dbrOutput . _3 . _Just . _entityVal . _lmsUserEnded)
}
{-
doEncode' = LmsTableCsv
<$> view (resultUser . _entityVal . _userDisplayName)
<*> view (resultUser . _entityVal . _userEmail)
<*> view (resultUser . _entityVal . _userEmail)
<*> view (resultQualUser . _entityVal . _qualificationUserValidUntil)
<*> view (resultQualUser . _entityVal . _qualificationUserLastRefresh)
<*> view (resultQualUser . _entityVal . _qualificationUserFirstHeld)
@ -390,8 +405,8 @@ mkLmsTable (Entity qid quali) acts restrict cols psValidator = do
<*> preview (resultLmsUser . _entityVal . _lmsUserStarted)
<*> preview (resultLmsUser . _entityVal . _lmsUserDatePin)
<*> view (resultLmsUser . _entityVal . _lmsUserReceived)
<*> view (resultLmsUser . _entityVal . _lmsUserEnded)
<*> view (resultLmsUser . _entityVal . _lmsUserEnded)
-}
dbtCsvDecode = Nothing
dbtExtraReps = []
@ -467,11 +482,11 @@ postLmsR sid qsh = do
forM_ okUsers $ \(Entity lid LmsUser {lmsUserUser = uid, lmsUserQualification = qid'}) -> do
when (isRenewPinAct action) $ do
newPin <- liftIO randomLMSpw
update lid [LmsUserPin =. newPin, LmsUserDatePin =. now]
when (isNotifyAct action) $
update lid [LmsUserPin =. newPin, LmsUserDatePin =. now]
when (isNotifyAct action) $
queueDBJob $ JobSendNotification { jRecipient = uid, jNotification = NotificationQualificationRenewal qid' }
return $ length okUsers
let numSelected = length selectedUsers
let numSelected = length selectedUsers
diffSelected = numSelected - numExaminees
when (isRenewPinAct action) $ addMessageI Success $ MsgLmsPinRenewal numExaminees
when (isNotifyAct action) $ addMessageI Success $ MsgLmsNotificationSend numExaminees