From 1758a1d1ce8226e2cf8d020e77ca484666c5bcad Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Fri, 29 Jun 2018 09:58:17 +0200
Subject: [PATCH] cleanup multiAction

---
 src/Handler/Corrections.hs | 47 +++++++++++++++++++++++---------------
 1 file changed, 29 insertions(+), 18 deletions(-)

diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs
index 2eb34aad1..df3bae1ca 100644
--- a/src/Handler/Corrections.hs
+++ b/src/Handler/Corrections.hs
@@ -151,33 +151,43 @@ instance RenderMessage UniWorX ActionCorrections where
   renderMessage m ls CorrDownload = renderMessage m ls MsgCorrDownload
   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
   tableForm <- makeCorrectionsTable whereClause displayColumns
   ((actionRes, table), tableEncoding) <- runFormPost $ \csrf -> do
     ((fmap (Map.keysSet . Map.filter id . getDBFormResult (const False)) -> selectionRes), table) <- tableForm csrf
     (actionRes, action) <- multiAction actions
-    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 
+    return ((,) <$> actionRes <*> selectionRes, table <> action)
 
-  
-downloadAction :: (ActionCorrections, MForm (HandlerT UniWorX IO) (FormResult (Set CryptoFileNameSubmission -> Handler TypedContent), Widget))
-downloadAction = ( CorrDownload
-                 , return (pure downloadAction', mempty)
-                 )
-  where
-    downloadAction' subs = do
+  case actionRes of
+    FormFailure errs -> mapM_ (addMessage "danger" . toHtml) errs
+    FormMissing      -> return ()
+    FormSuccess (CorrDownloadData, subs) -> do
       (Set.fromList -> ids) <- forM (Set.toList subs) decrypt
       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
@@ -210,4 +220,5 @@ postCourseCorrectionsR tid csh = do
         ] -- Continue here
   correctionsR whereClause colonnade $ Map.fromList
     [ downloadAction
+    , assignAction
     ]