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

cleanup multiAction

Browse Source
This commit is contained in:
Gregor Kleen 2018-06-29 09:58:17 +02:00
parent 9290052fe7
commit 1758a1d1ce
1 changed files with 29 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
src/Handler/Corrections.hs
View File

@ -151,33 +151,43 @@ instance RenderMessage UniWorX ActionCorrections where
renderMessage m ls CorrDownload = renderMessage m ls MsgCorrDownload renderMessage m ls CorrDownload = renderMessage m ls MsgCorrDownload
renderMessage m ls CorrSetCorrector = renderMessage m ls MsgCorrSetCorrector renderMessage m ls CorrSetCorrector = renderMessage m ls MsgCorrSetCorrector
correctionsR :: _ -> _ -> Map ActionCorrections (MForm (HandlerT UniWorX IO) (FormResult (Set CryptoFileNameSubmission -> Handler TypedContent), Widget)) -> Handler TypedContent data ActionCorrectionsData = CorrDownloadData
| CorrSetCorrectorData UserId
correctionsR :: _ -> _ -> Map ActionCorrections (MForm (HandlerT UniWorX IO) (FormResult ActionCorrectionsData, Widget)) -> Handler TypedContent
correctionsR whereClause (formColonnade -> displayColumns) actions = do correctionsR whereClause (formColonnade -> displayColumns) actions = do
tableForm <- makeCorrectionsTable whereClause displayColumns tableForm <- makeCorrectionsTable whereClause displayColumns
((actionRes, table), tableEncoding) <- runFormPost $ \csrf -> do ((actionRes, table), tableEncoding) <- runFormPost $ \csrf -> do
((fmap (Map.keysSet . Map.filter id . getDBFormResult (const False)) -> selectionRes), table) <- tableForm csrf ((fmap (Map.keysSet . Map.filter id . getDBFormResult (const False)) -> selectionRes), table) <- tableForm csrf
(actionRes, action) <- multiAction actions (actionRes, action) <- multiAction actions
return (actionRes <*> selectionRes, table <> action) return ((,) <$> actionRes <*> selectionRes, table <> action)
let
defaultAction = fmap toTypedContent . defaultLayout $ do
setTitleI MsgCourseCorrectionsTitle
$(widgetFile "corrections")
case actionRes of
FormFailure errs -> mapM_ (addMessage "danger" . toHtml) errs >> defaultAction
FormMissing -> defaultAction
FormSuccess act -> act
case actionRes of
downloadAction :: (ActionCorrections, MForm (HandlerT UniWorX IO) (FormResult (Set CryptoFileNameSubmission -> Handler TypedContent), Widget)) FormFailure errs -> mapM_ (addMessage "danger" . toHtml) errs
downloadAction = ( CorrDownload FormMissing -> return ()
, return (pure downloadAction', mempty) FormSuccess (CorrDownloadData, subs) -> do
)
where
downloadAction' subs = do
(Set.fromList -> ids) <- forM (Set.toList subs) decrypt (Set.fromList -> ids) <- forM (Set.toList subs) decrypt
addHeader "Content-Disposition" "attachment; filename=\"corrections.zip\"" addHeader "Content-Disposition" "attachment; filename=\"corrections.zip\""
submissionMultiArchive ids sendResponse =<< submissionMultiArchive ids
FormSuccess (CorrSetCorrectorData uid, subs) -> do
addMessage "danger" $ "Setting correctors not implemented yet" -- TODO
Just currentRoute <- getCurrentRoute -- This should never be called from a 404 handler
redirect currentRoute
fmap toTypedContent . defaultLayout $ do
setTitleI MsgCourseCorrectionsTitle
$(widgetFile "corrections")
downloadAction :: (ActionCorrections, MForm (HandlerT UniWorX IO) (FormResult ActionCorrectionsData, Widget))
downloadAction = ( CorrDownload
, return (pure CorrDownloadData, mempty)
)
assignAction :: (ActionCorrections, MForm (HandlerT UniWorX IO) (FormResult ActionCorrectionsData, Widget))
assignAction = ( CorrSetCorrector
, return (pure undefined, mempty) -- TODO
)
getCorrectionsR, postCorrectionsR :: Handler TypedContent getCorrectionsR, postCorrectionsR :: Handler TypedContent
getCorrectionsR = postCorrectionsR getCorrectionsR = postCorrectionsR
@ -210,4 +220,5 @@ postCourseCorrectionsR tid csh = do
] -- Continue here ] -- Continue here
correctionsR whereClause colonnade $ Map.fromList correctionsR whereClause colonnade $ Map.fromList
[ downloadAction [ downloadAction
, assignAction
] ]