Merge branch 'master' of gitlab.cip.ifi.lmu.de:jost/UniWorX

messages/uniworx/de.msg

@@ -568,7 +568,7 @@ MenuSubmissions: Abgaben
 MenuSheetList: Übungsblätter
 MenuSheetNew: Neues Übungsblatt anlegen
 MenuSheetCurrent: Aktuelles Übungsblatt
-MenuSheetLastInactive: Zuletzt abgegebenes Übungsblatt
+MenuSheetOldUnassigned: Abgaben ohne Korrektor
 MenuCourseEdit: Kurs editieren
 MenuCourseNewTemplate: Als neuen Kurs klonen
 MenuCourseDelete: Kurs löschen

routes

@@ -74,7 +74,7 @@
   /ex                         SheetListR      GET             !registered !materials !corrector
   !/ex/new                    SheetNewR       GET POST
   !/ex/current                 SheetCurrentR   GET             !free -- just a redirect
-  !/ex/lastinactive            SheetLastInactiveR GET          !free -- just a redirect
+  !/ex/lastinactive            SheetOldUnassigned GET          !free -- just a redirect
   /ex/#SheetName SheetR:
     /show                       SShowR        GET             !timeANDregistered !timeANDmaterials !corrector
     /edit                       SEditR        GET POST

src/Foundation.hs

@@ -63,6 +63,7 @@ import Handler.Utils.StudyFeatures
 import Handler.Utils.Templates
 import Utils.Lens
 import Utils.Form
+import Utils.Sheet
 import Utils.SystemMessage
 
 import Text.Shakespeare.Text (st)
@@ -1304,11 +1305,14 @@ pageActions (CourseR tid ssh csh SheetListR) =
       }
   , MenuItem
       { menuItemType = PageActionPrime
-      , menuItemLabel = MsgMenuSheetLastInactive
+      , menuItemLabel = MsgMenuSheetOldUnassigned
       , menuItemIcon  = Nothing
-      , menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetLastInactiveR
+      , menuItemRoute = SomeRoute $ CourseR tid ssh csh SheetOldUnassigned
       , menuItemModal = False
-      , menuItemAccessCallback' = (== Authorized) <$> evalAccessCorrector tid ssh csh
+      , menuItemAccessCallback' = runDB . maybeT (return False) $ do
+          guardM $ (== Authorized) <$> evalAccessCorrector tid ssh csh
+          void . MaybeT $ sheetOldUnassigned tid ssh csh
+          return True
       }
   , MenuItem
       { menuItemType = PageActionPrime
@@ -1469,7 +1473,7 @@ pageActions (CSubmissionR tid ssh csh shn cid CorrectionR) =
 pageActions (CSheetR tid ssh csh shn SCorrR) =
   [ MenuItem
       { menuItemType = PageActionPrime
-      , menuItemLabel = MsgMenuCorrections
+      , menuItemLabel = MsgMenuSubmissions
       , menuItemIcon = Nothing
       , menuItemRoute = SomeRoute $ CSheetR tid ssh csh shn SSubsR
       , menuItemModal = False

src/Handler/Sheet.hs

@@ -3,6 +3,7 @@ module Handler.Sheet where
 import Import
 import System.FilePath (takeFileName)
 
+import Utils.Sheet
 import Handler.Utils
 -- import Handler.Utils.Zip
 import Handler.Utils.Table.Cells
@@ -157,23 +158,10 @@ getSheetCurrentR tid ssh csh = runDB $ do
     (E.Value shn):_ -> redirectAccess $ CSheetR tid ssh csh shn SShowR
     _ -> notFound
 
-getSheetLastInactiveR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
+getSheetOldUnassigned :: TermId -> SchoolId -> CourseShorthand -> Handler ()
-getSheetLastInactiveR tid ssh csh = runDB $ do
+getSheetOldUnassigned tid ssh csh = runDB $ do
-  -- TODO: deliver oldest sheet with unassigned submissions instead!!!
+  shn' <- sheetOldUnassigned tid ssh csh
-  now <- liftIO getCurrentTime
+  maybe notFound (\shn -> redirectAccess $ CSheetR tid ssh csh shn SSubsR) shn'
-  sheets <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
-    E.on $ sheet     E.^. SheetCourse     E.==. course E.^. CourseId
-    E.where_ $ sheet E.^. SheetActiveTo   E.<=. E.val now
-        E.&&. course E.^. CourseTerm      E.==. E.val tid
-        E.&&. course E.^. CourseSchool    E.==. E.val ssh
-        E.&&. course E.^. CourseShorthand E.==. E.val csh
-    E.orderBy [E.desc $ sheet E.^. SheetActiveTo]
-    E.limit 1
-    return $ sheet E.^. SheetName
-  case sheets of
-    (E.Value shn):_ -> redirectAccess $ CSheetR tid ssh csh shn SShowR
-    _ -> notFound
-
 
 getSheetListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getSheetListR tid ssh csh = do

src/Import/NoFoundation.hs

@@ -59,6 +59,7 @@ import Ldap.Client.Pool as Import
 
 import Database.Esqueleto.Instances as Import ()
 import Database.Persist.Sql.Instances as Import ()
+import Database.Persist.Sql as Import (SqlReadT,SqlWriteT)
 
 
 import Control.Monad.Trans.RWS (RWST)

src/Utils/Sheet.hs

@@ -0,0 +1,24 @@
+module Utils.Sheet where
+
+import Import.NoFoundation
+import qualified Database.Esqueleto as E
+
+sheetOldUnassigned :: MonadIO m => TermId -> SchoolId -> CourseShorthand -> SqlReadT m (Maybe SheetName)
+sheetOldUnassigned tid ssh csh = do
+  now <- liftIO getCurrentTime
+  sheets <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do
+    E.on $ sheet     E.^. SheetCourse     E.==. course E.^. CourseId
+    E.where_ $ sheet E.^. SheetActiveTo   E.<=. E.val now
+        E.&&. course E.^. CourseTerm      E.==. E.val tid
+        E.&&. course E.^. CourseSchool    E.==. E.val ssh
+        E.&&. course E.^. CourseShorthand E.==. E.val csh
+    E.where_ . E.exists . E.from $ \submission -> do
+        E.where_ $ submission E.^. SubmissionSheet E.==. sheet E.^. SheetId
+          E.&&.  E.isNothing (submission E.^. SubmissionRatingBy)
+    E.orderBy [E.desc $ sheet E.^. SheetActiveTo]
+    E.limit 1
+    return $ sheet E.^. SheetName
+  return $ case sheets of
+    [] -> Nothing
+    [E.Value shn] -> Just shn
+    _ -> error "SQL Query with limit 1 returned more than one result"