From 5faf4d1208bd8ca3e27a53e867a30caffa182c83 Mon Sep 17 00:00:00 2001 From: SJost Date: Wed, 30 Jan 2019 10:08:56 +0100 Subject: [PATCH 1/2] Menu translation fix --- src/Foundation.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Foundation.hs b/src/Foundation.hs index 94287ba49..8948568d7 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -1469,7 +1469,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 From 3ef6c08ac166c32187a3ecee0f2231462d9e25f1 Mon Sep 17 00:00:00 2001 From: SJost Date: Wed, 30 Jan 2019 10:48:32 +0100 Subject: [PATCH 2/2] Fixes #272 --- messages/uniworx/de.msg | 2 +- routes | 2 +- src/Foundation.hs | 10 +++++++--- src/Handler/Sheet.hs | 22 +++++----------------- src/Import/NoFoundation.hs | 1 + src/Utils/Sheet.hs | 24 ++++++++++++++++++++++++ 6 files changed, 39 insertions(+), 22 deletions(-) create mode 100644 src/Utils/Sheet.hs diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index c75a4fb73..4f6f91a82 100644 --- a/messages/uniworx/de.msg +++ b/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 diff --git a/routes b/routes index 6e3015dfd..ebd3e5973 100644 --- a/routes +++ b/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 diff --git a/src/Foundation.hs b/src/Foundation.hs index 8948568d7..901c6c124 100644 --- a/src/Foundation.hs +++ b/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 diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 2995c3b7d..ef30c1293 100644 --- a/src/Handler/Sheet.hs +++ b/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 -getSheetLastInactiveR tid ssh csh = runDB $ do - -- TODO: deliver oldest sheet with unassigned submissions instead!!! - 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.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 - +getSheetOldUnassigned :: TermId -> SchoolId -> CourseShorthand -> Handler () +getSheetOldUnassigned tid ssh csh = runDB $ do + shn' <- sheetOldUnassigned tid ssh csh + maybe notFound (\shn -> redirectAccess $ CSheetR tid ssh csh shn SSubsR) shn' getSheetListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getSheetListR tid ssh csh = do diff --git a/src/Import/NoFoundation.hs b/src/Import/NoFoundation.hs index 308b5a6dd..1f1220787 100644 --- a/src/Import/NoFoundation.hs +++ b/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) diff --git a/src/Utils/Sheet.hs b/src/Utils/Sheet.hs new file mode 100644 index 000000000..21f4ab310 --- /dev/null +++ b/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"