Towards #364 for task 1

messages/uniworx/de.msg

@@ -210,6 +210,7 @@ SubmissionFiles: Abgegebene Dateien
 SubmissionAlreadyExistsFor email@UserEmail: #{email} hat bereits eine Abgabe zu diesem Übungsblatt.
 SubmissionUsersEmpty: Es kann keine Abgabe ohne Abgebende erstellt werden
 SubmissionUserAlreadyAdded: Dieser Nutzer ist bereits als Mitabgebende(r) eingetragen
+NoOpenSubmissions: Keine unkorrigierten Abgaben vorhanden
 
 SubmissionsDeleteQuestion n@Int: Wollen Sie #{pluralDE n "die unten aufgeführte Abgabe" "die unten aufgeführten Abgaben"} wirklich löschen?
 SubmissionsDeleted n@Int: #{pluralDE n "Abgabe gelöscht" "Abgaben gelöscht"}
@@ -793,8 +794,9 @@ MenuSheetEdit: Übungsblatt editieren
 MenuSheetDelete: Übungsblatt löschen
 MenuSheetClone:  Als neues Übungsblatt klonen
 MenuCorrectionsUpload: Korrekturen hochladen
+MenuCorrectionsDownload: Abgaben herunterladen
 MenuCorrectionsCreate: Abgaben registrieren
-MenuCorrectionsGrade: Abgaben bewerten
+MenuCorrectionsGrade: Abgaben online korrigieren
 MenuAuthPreds: Authorisierungseinstellungen
 MenuTutorialDelete: Tutorium löschen
 MenuTutorialEdit: Tutorium editieren

package.yaml

@@ -185,6 +185,7 @@ ghc-options:
   - -fno-warn-unrecognised-pragmas
   - -fno-warn-partial-type-signatures
   - -fno-max-relevant-binds
+  - -j2
 
 when:
   - condition: flag(pedantic)

routes

@@ -137,10 +137,11 @@
     /tutor-invite             TInviteR         GET POST
 
 
-/subs  CorrectionsR GET POST !corrector !lecturer
-/subs/upload CorrectionsUploadR GET POST !corrector !lecturer
-/subs/create CorrectionsCreateR GET POST !corrector !lecturer
-/subs/grade CorrectionsGradeR GET POST !corrector !lecturer
+/subs          CorrectionsR          GET POST !corrector !lecturer
+/subs/upload   CorrectionsUploadR    GET POST !corrector !lecturer
+/subs/create   CorrectionsCreateR    GET POST !corrector !lecturer
+/subs/grade    CorrectionsGradeR     GET POST !corrector !lecturer
+/subs/download CorrectionsDownloadR  GET      !corrector !lecturer
 
 
 /msgs                           MessageListR GET POST

src/Database/Esqueleto/Utils/TH.hs

@@ -50,7 +50,8 @@ sqlInTuple arity = do
     ]
 
 -- | Generic unValuing of Tuples of Values, i.e.
---   $(unValueN 3) :: (E.Value a, E.Value b, E.Value c) -> (a,b,c)
+--
+--   > $(unValueN 3) :: (E.Value a, E.Value b, E.Value c) -> (a,b,c)
 unValueN :: Int -> ExpQ
 unValueN arity = do
     vs <- replicateM arity $ newName "v"
@@ -60,7 +61,8 @@ unValueN arity = do
     lam1E pat rhs
 
 -- | Generic unValuing of certain indices of a Tuple, i.e.
---   $(unValueNIs 3 [1,3]) :: (E.Value a, b, E.Value c) -> (a,b,c)
+--
+--   > $(unValueNIs 3 [1,3]) :: (E.Value a, b, E.Value c) -> (a,b,c)
 unValueNIs :: Int -> [Int] -> ExpQ
 unValueNIs arity uvIdx = do
     vs <- replicateM arity $ newName "v"
@@ -74,8 +76,9 @@ unValueNIs arity uvIdx = do
 
 
 -- | Generic projections for InnerJoin-tuples
---   gives I-th element of N-tuple of left-associative InnerJoin-pairs,
---   i.e. @$(projN n m) :: (t1 `E.InnerJoin` .. `E.InnerJoin` tn) -> tm@ (for m<=n)
+--   gives I-th element of N-tuple of left-associative InnerJoin-pairs, i.e.
+--
+--   > $(projN n m) :: (t1 `E.InnerJoin` .. `E.InnerJoin` tn) -> tm@ (for m<=n)
 sqlIJproj :: Int -> Int -> ExpQ
 sqlIJproj = leftAssociativePairProjection 'E.InnerJoin
 

src/Foundation.hs

@@ -2231,6 +2231,14 @@ pageActions (CSheetR tid ssh csh shn SCorrR) =
   ]
 pageActions (CorrectionsR) =
   [ MenuItem
+      { menuItemType = PageActionPrime
+      , menuItemLabel = MsgMenuCorrectionsDownload
+      , menuItemIcon = Nothing
+      , menuItemRoute = SomeRoute CorrectionsDownloadR
+      , menuItemModal = True
+      , menuItemAccessCallback' = return True
+      }
+  , MenuItem
       { menuItemType = PageActionPrime
       , menuItemLabel = MsgMenuCorrectionsUpload
       , menuItemIcon = Nothing

src/Handler/Corrections.hs

@@ -502,7 +502,7 @@ postCorrectionsR = do
   let whereClause = ratedBy uid
       colonnade = mconcat
         [ colSelect
-        , dbRow
+        -- , dbRow
         , colSchool
         , colTerm
         , colCourse

src/Handler/Submission.hs

@@ -600,3 +600,16 @@ postSubDelR tid ssh csh shn cID = do
     { drAbort = SomeRoute $ CSubmissionR tid ssh csh shn cID SubShowR
     , drSuccess = SomeRoute $ CSheetR tid ssh csh shn SShowR
     }
+
+
+getCorrectionsDownloadR :: Handler TypedContent
+getCorrectionsDownloadR = do -- download all assigned and open submissions
+  uid <- requireAuthId
+  subs <- runDB $ selectKeysList
+            [ SubmissionRatingBy   ==. Just uid
+            , SubmissionRatingTime ==. Nothing
+            ] []
+  when (null subs) $ do
+    addMessageI Info MsgNoOpenSubmissions
+    redirect CorrectionsR
+  submissionMultiArchive $ Set.fromList subs

src/Handler/Utils/Submission.hs

@@ -19,7 +19,7 @@ import Yesod.Core.Types (HandlerContents(..), ErrorResponse(..))
 import Utils.Lens
 
 import Control.Monad.State hiding (forM_, mapM_,foldM)
-import Control.Monad.Writer (MonadWriter(..), execWriterT)
+import Control.Monad.Writer (MonadWriter(..), execWriterT, execWriter)
 import Control.Monad.RWS.Lazy (RWST)
 import qualified Control.Monad.Random as Rand
 import qualified System.Random.Shuffle as Rand (shuffleM)
@@ -43,6 +43,7 @@ import qualified Handler.Utils.Rating as Rating (extractRatings)
 import Handler.Utils.Delete
 
 import qualified Database.Esqueleto as E
+import qualified Database.Esqueleto.Utils.TH as E
 
 import qualified Data.Conduit.List as Conduit
 import Data.Conduit.ResumableSink
@@ -223,17 +224,34 @@ submissionMultiArchive (Set.toList -> ids) = do
   (dbrunner, cleanup) <- getDBRunner
 
   ratedSubmissions <- runDBRunner dbrunner $ do
-    submissions <- selectList [ SubmissionId <-. ids ] []
-    forM submissions $ \s@(Entity submissionId _) -> maybe (invalidArgs ["Invalid submission numbers"]) (return . (, s)) =<< getRating submissionId
+    submissions <- E.select . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` submission) -> do
+      E.on $ sheet E.^. SheetId     E.==. submission E.^. SubmissionSheet
+      E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
+      E.where_ $ submission E.^. SubmissionId `E.in_` E.valList ids
+      return (submission, (sheet E.^. SheetName, course E.^. CourseShorthand, course E.^. CourseSchool, course E.^. CourseTerm))
+
+    forM submissions $ \(s@(Entity submissionId _), courseSheetInfo) ->
+       maybe (invalidArgs ["Invalid submission numbers"]) (return . (, s, $(E.unValueN 4) courseSheetInfo)) =<< getRating submissionId
+  let (setSheet,setCourse,setSchool,setTerm) =
+        execWriter . forM ratedSubmissions $ \(_rating,_submission,(shn,csh,ssh,tid)) ->
+          tell (Set.singleton shn, Set.singleton csh, Set.singleton ssh, Set.singleton tid)
 
   (<* cleanup) . respondSource "application/zip" . transPipe (runDBRunner dbrunner) $ do
     let
-      fileEntitySource' :: (Rating, Entity Submission) -> Source (YesodDB UniWorX) File
-      fileEntitySource' (rating, Entity submissionID Submission{..}) = do
+      fileEntitySource' :: (Rating, Entity Submission, (SheetName,CourseShorthand,SchoolId,TermId)) -> Source (YesodDB UniWorX) File
+      fileEntitySource' (rating, Entity submissionID Submission{..},(shn,csh,ssh,tid)) = do
         cID <- encrypt submissionID
 
         let
-          directoryName = Text.unpack $ toPathPiece (cID :: CryptoFileNameSubmission)
+          dirFrag :: PathPiece p => p -> FilePath
+          dirFrag = Text.unpack . toPathPiece
+          submissionDirectory  = dirFrag (cID :: CryptoFileNameSubmission)
+          directoryName
+            | Set.size setTerm   > 1 = dirFrag tid </> dirFrag ssh </> dirFrag csh </> dirFrag shn </> submissionDirectory
+            | Set.size setSchool > 1 =                 dirFrag ssh </> dirFrag csh </> dirFrag shn </> submissionDirectory
+            | Set.size setCourse > 1 =                                 dirFrag csh </> dirFrag shn </> submissionDirectory
+            | Set.size setSheet  > 1 =                                                 dirFrag shn </> submissionDirectory
+            | otherwise              =                                                                 submissionDirectory
 
           fileEntitySource = do
             submissionFileSource submissionID =$= Conduit.map entityVal

src/Utils/Sheet.hs

@@ -3,7 +3,7 @@ module Utils.Sheet where
 import Import.NoFoundation
 import qualified Database.Esqueleto as E
 
-import Database.Esqueleto.Internal.Language (From) -- How to avoid this import?
+import Database.Esqueleto.Internal.Language (From) -- cannot be avoided here
 
 -- DB Queries for Sheets that are used in several places
 
@@ -85,7 +85,6 @@ sheetFilesAllQuery tid ssh csh shn sft = E.select $ E.from $
 
 -- | Check whether a sheet has any files for a given file type
 hasSheetFileQuery :: Database.Esqueleto.Internal.Language.From query expr backend (expr (Entity SheetFile))
--- hasSheetFileQuery :: (E.Esqueleto query expr backend)
   => expr (Entity Sheet) -> SheetFileType -> expr (E.Value Bool)
 hasSheetFileQuery sheet sft =
   E.exists $ E.from $ \sFile ->

templates/i18n/README_i18n.txt

@@ -0,0 +1,6 @@
+This directories contains all language dependent widgets.
+
+Each widget requires its own directories, the name of which is needed in the source code, e.g. for directory "imprint"
+  $(i18nWidgetFile "imprint")
+inside this directory must be one file per language "de.hamlet", etc. 
+