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

chore(lms): wip add actions to lms table

Browse Source
This commit is contained in:
Steffen Jost 2022-05-20 13:57:55 +02:00
parent 549a9b5d9b
commit 9859d9bbc1
2 changed files with 20 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
src/Handler/LMS.hs
View File

@ -214,8 +214,9 @@ data LmsTableActionData = LmsActNotifyData
mkLmsTable :: Entity Qualification -> DB (FormResult (LmsTableActionData, Set UserId), Widget)
mkLmsTable (Entity qid quali) = do
now <- liftIO getCurrentTime
currentRoute <- fromMaybe (error "mkLmsAllTable called from 404-handler") <$> liftHandler getCurrentRoute
-- currentRoute <- fromMaybe (error "mkLmsAllTable called from 404-handler") <$> liftHandler getCurrentRoute -- we know the route precisely heres
let
currentRoute = LmsR (qualificationSchool quali) (qualificationShorthand quali)
nowaday = utctDay now
mbRenewal = addGregorianDurationClip <$> qualificationRefreshWithin quali <*> Just nowaday
resultDBTable = DBTable{..}
@ -231,7 +232,7 @@ mkLmsTable (Entity qid quali) = do
E.where_ $ E.val qid E.==. qualUser E.^. QualificationUserQualification
return (qualUser, user, lmsUser)
dbtRowKey = queryUser >>> (E.^. UserId)
dbtProj = dbtProjFilteredPostId -- TODO: or dbtProjSimple what is the difference?
dbtProj = dbtProjFilteredPostId
dbtColonnade = dbColonnade $ mconcat
[ colUserNameLinkHdr MsgTableLmsUser AdminUserR
, colUserEmail
@ -245,7 +246,7 @@ mkLmsTable (Entity qid quali) = do
, sortable (Just "lms-ended") (i18nLms MsgTableLmsEnded) $ \(preview $ resultLmsUser . _entityVal . _lmsUserEnded -> d) -> foldMap dateTimeCell $ join d
]
where
i18nLms :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a
-- i18nLms :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a
i18nLms msg = cell [whamlet|LMS #|] <> i18nCell msg
dbtSorting = mconcat
[ single $ sortUserNameLink queryUser
@ -310,6 +311,7 @@ mkLmsTable (Entity qid quali) = do
let usrSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) usrMap
return (act, usrSet)
-- resultDBTableValidator :: PSValidator (MForm Handler) (FormResult (First LmsTableActionData, DBFormResult UserId Bool LmsTableActionData))
resultDBTableValidator = def
-- & defaultSorting [SortAscBy csvLmsIdent]
over _1 postprocess <$> dbTable resultDBTableValidator resultDBTable
@ -317,10 +319,20 @@ mkLmsTable (Entity qid quali) = do
getLmsR, postLmsR :: SchoolId -> QualificationShorthand -> Handler Html
getLmsR = postLmsR
postLmsR sid qsh = do
(lmsTable, quali) <- runDB $ do
qent@(Entity _qid quali) <- getBy404 $ SchoolQualificationShort sid qsh
tbl <- view _2 <$> mkLmsTable qent
return (tbl, quali)
((lmsRes, lmsTable), Entity qid quali) <- runDB $ do
qent <- getBy404 $ SchoolQualificationShort sid qsh
tbl <- mkLmsTable qent
return (tbl, qent)
formResult lmsRes $ \case
(LmsActNotifyData, selectedUsers) -> do
forM_ selectedUsers $ \uid ->
runDBJobs $ queueDBJob (JobSendNotification { jRecipient = uid, jNotification = NotificationQualificationRenewal qid})
(LmsActRenewPinData, selectedUsers) -> do
--TODO Dummy, we need a DB action here
forM_ selectedUsers $ \uid ->
runDBJobs $ queueDBJob (JobSendNotification { jRecipient = uid, jNotification = NotificationQualificationRenewal qid})
let heading = citext2widget $ qualificationName quali
siteLayout heading $ do
setTitle $ toHtml $ unSchoolKey sid <> "-" <> qsh

2
src/Handler/LMS/Result.hs
View File

@ -268,7 +268,7 @@ postLmsResultDirectR sid qsh = do
.| decodeCsv
.| foldMC (saveResultCsv qid) 0
case enr of
Left (e :: SomeException) -> do
Left (e :: SomeException) -> do -- catch all to avoid ok220 in case of any error
$logWarnS "LMS" $ "Result upload failed parsing: " <> tshow e
return (badRequest400, "Exception: " <> tshow e)
Right nr -> do