diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 13055bc32..856e4e3ec 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -245,6 +245,7 @@ CorrUploadField: Korrekturen CorrUpload: Korrekturen hochladen CorrSetCorrector: Korrektor zuweisen CorrAutoSetCorrector: Korrekturen verteilen +CorrDelete: Abgaben löschen NatField name@Text: #{name} muss eine natürliche Zahl sein! JSONFieldDecodeFailure aesonFailure@String: Konnte JSON nicht parsen: #{aesonFailure} SecretJSONFieldDecryptFailure: Konnte versteckte vertrauliche Daten nicht entschlüsseln diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 946ad1ae9..b9a9c60ee 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -8,6 +8,7 @@ import Handler.Utils import Handler.Utils.Submission import Handler.Utils.Table.Cells import Handler.Utils.SheetType +import Handler.Utils.Delete -- import Handler.Utils.Zip import Utils.Lens @@ -39,8 +40,6 @@ import qualified Database.Esqueleto as E -- import Network.Mime -import Web.PathPieces - import Text.Hamlet (ihamletFile) import Database.Persist.Sql (updateWhereCount) @@ -287,24 +286,29 @@ makeCorrectionsTable whereClause dbtColonnade psValidator dbtProj' dbtParams = d data ActionCorrections = CorrDownload | CorrSetCorrector | CorrAutoSetCorrector + | CorrDelete deriving (Eq, Ord, Read, Show, Enum, Bounded) -instance PathPiece ActionCorrections where - fromPathPiece = readFromPathPiece - toPathPiece = showToPathPiece -instance RenderMessage UniWorX ActionCorrections where - renderMessage m ls CorrDownload = renderMessage m ls MsgCorrDownload - renderMessage m ls CorrSetCorrector = renderMessage m ls MsgCorrSetCorrector - renderMessage m ls CorrAutoSetCorrector = renderMessage m ls MsgCorrAutoSetCorrector +instance Universe ActionCorrections +instance Finite ActionCorrections + +nullaryPathPiece ''ActionCorrections $ camelToPathPiece' 1 +embedRenderMessage ''UniWorX ''ActionCorrections id data ActionCorrectionsData = CorrDownloadData | CorrSetCorrectorData (Maybe UserId) | CorrAutoSetCorrectorData SheetId + | CorrDeleteData correctionsR :: _ -> _ -> _ -> Map ActionCorrections (AForm (HandlerT UniWorX IO) ActionCorrectionsData) -> Handler TypedContent correctionsR whereClause (formColonnade -> displayColumns) psValidator actions = do Just currentRoute <- getCurrentRoute -- This should never be called from a 404 handler + postDeleteR $ \drRecords -> (submissionDeleteRoute drRecords) + { drAbort = SomeRoute currentRoute + , drSuccess = SomeRoute currentRoute + } + ((actionRes', table), statistics) <- runDB $ do -- Query for Table tableRes <- makeCorrectionsTable whereClause displayColumns psValidator return def @@ -396,6 +400,12 @@ correctionsR whereClause (formColonnade -> displayColumns) psValidator actions = unassigned' <- forM (Set.toList stillUnassigned) $ \sid -> encrypt sid :: DB CryptoFileNameSubmission addMessage Warning =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsNotAssignedAuto.hamlet") mr) redirect currentRoute + FormSuccess (CorrDeleteData, subs) -> do + subs' <- Set.fromList <$> forM (Set.toList subs) decrypt -- Set is not traversable + getDeleteR (submissionDeleteRoute subs') + { drAbort = SomeRoute currentRoute + , drSuccess = SomeRoute currentRoute + } fmap toTypedContent . defaultLayout $ do setTitleI MsgCourseCorrectionsTitle @@ -416,10 +426,13 @@ correctionsR whereClause (formColonnade -> displayColumns) psValidator actions = type ActionCorrections' = (ActionCorrections, AForm (HandlerT UniWorX IO) ActionCorrectionsData) -downloadAction :: ActionCorrections' +downloadAction, deleteAction :: ActionCorrections' downloadAction = ( CorrDownload , pure CorrDownloadData ) +deleteAction = ( CorrDelete + , pure CorrDeleteData + ) assignAction :: Either CourseId SheetId -> ActionCorrections' assignAction selId = ( CorrSetCorrector @@ -491,6 +504,7 @@ postCCorrectionsR tid ssh csh = do correctionsR whereClause colonnade psValidator $ Map.fromList [ downloadAction , assignAction (Left cid) + , deleteAction ] getSSubsR, postSSubsR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler TypedContent @@ -514,6 +528,7 @@ postSSubsR tid ssh csh shn = do [ downloadAction , assignAction (Right shid) , autoAssignAction shid + , deleteAction ] correctionData :: TermId -> SchoolId -> CourseShorthand -> SheetName -> _ -- CryptoFileNameSubmission -> _ diff --git a/src/Handler/Utils/Delete.hs b/src/Handler/Utils/Delete.hs index 3fa94d8dc..c35d2a14f 100644 --- a/src/Handler/Utils/Delete.hs +++ b/src/Handler/Utils/Delete.hs @@ -87,7 +87,7 @@ getDeleteR DeleteRoute{..} = do let confirmString = Text.unlines $ view _2 <$> targets - ((_, deleteFormWdgt), deleteFormEnctype) <- runFormPost $ confirmForm' drRecords confirmString + (deleteFormWdgt, deleteFormEnctype) <- generateFormPost $ confirmForm' drRecords confirmString Just targetRoute <- getCurrentRoute