Bulk deletion of submissions

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

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
+instance Universe ActionCorrections
-  renderMessage m ls CorrDownload = renderMessage m ls MsgCorrDownload
+instance Finite ActionCorrections
-  renderMessage m ls CorrSetCorrector = renderMessage m ls MsgCorrSetCorrector
+
-  renderMessage m ls CorrAutoSetCorrector = renderMessage m ls MsgCorrAutoSetCorrector
+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 -> _

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