From 4ca7ebd6f17c9d83059ead2887a7fe9547c1281e Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Sun, 1 Jul 2018 12:32:26 +0200
Subject: [PATCH] =?UTF-8?q?Logik=20f=C3=BCr=20Abgabe=20ansehen/anlegen?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Fixes #78
---
 src/Foundation.hs | 25 +++++++++++++++++++++++--
 1 file changed, 23 insertions(+), 2 deletions(-)

diff --git a/src/Foundation.hs b/src/Foundation.hs
index cf10ff20d..cdd887b07 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -613,6 +613,19 @@ instance YesodBreadcrumbs UniWorX where
   -- Others
   breadcrumb  _ = return ("Uni2work", Nothing) -- Default is no breadcrumb at all
 
+submissionList :: TermId -> Text -> Text -> UserId -> DB [E.Value SubmissionId]
+submissionList tid csh shn uid = E.select . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` submission `E.InnerJoin` submissionUser) -> do
+  E.on $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
+  E.on $ submission E.^. SubmissionSheet E.==. sheet E.^. SheetId
+  E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
+
+  E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val uid
+       E.&&. sheet E.^. SheetName E.==. E.val shn
+       E.&&. course E.^. CourseShorthand E.==. E.val csh
+       E.&&. course E.^. CourseTerm E.==. E.val tid
+
+  return $ submission E.^. SubmissionId
+
 pageActions :: Route UniWorX -> [MenuTypes]
 pageActions (CourseR tid csh CShowR) =
   [ PageActionPrime $ MenuItem
@@ -663,13 +676,21 @@ pageActions (CSheetR tid csh shn SShowR) =
       { menuItemLabel = "Abgabe anlegen"
       , menuItemIcon  = Nothing
       , menuItemRoute = CSheetR tid csh shn SubmissionNewR
-      , menuItemAccessCallback' = return True -- TODO: check that no submission already exists
+      , menuItemAccessCallback' = runDB . maybeT (return False) $ do
+          uid <- MaybeT $ liftHandlerT maybeAuthId
+          submissions <- lift $ submissionList tid csh shn uid
+          guard $ null submissions
+          return True
       }
   , PageActionPrime $ MenuItem
       { menuItemLabel = "Abgabe ansehen"
       , menuItemIcon  = Nothing
       , menuItemRoute = CSheetR tid csh shn SubmissionOwnR
-      , menuItemAccessCallback' = return True -- TODO: check that a submission already exists
+      , menuItemAccessCallback' = runDB . maybeT (return False) $ do
+          uid <- MaybeT $ liftHandlerT maybeAuthId
+          submissions <- lift $ submissionList tid csh shn uid
+          guard . not $ null submissions
+          return True
       }
   , PageActionPrime $ MenuItem
       { menuItemLabel = "Korrektoren"