Tighten check for empty course

src/Foundation.hs

@@ -491,8 +491,11 @@ tagAccessPredicate AuthEmpty = APDB $ \route _ -> case route of
   CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgCourseNotEmpty) $ do
     -- Entity cid Course{..} <- MaybeT . getBy $ TermSchoolCourseShort tid ssh csh
     cid <- MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh
-    registered <- lift $ fromIntegral <$> count [ CourseParticipantCourse ==. cid ]
-    guard $ registered <= 0
+    assertM_ (<= 0) . lift $ count [ CourseParticipantCourse ==. cid ]
+    assertM_ ((<= 0) :: Int -> Bool) . lift . fmap (E.unValue . unsafeHead) $ E.select . E.from $ \(sheet `E.InnerJoin` submission) -> do
+      E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet
+      E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
+      return E.countRows
     return Authorized
   r -> $unsupportedAuthPredicate AuthEmpty r
 tagAccessPredicate AuthMaterials = APDB $ \route _ -> case route of

src/Utils.hs

@@ -448,6 +448,9 @@ guardM f = guard =<< f
 assertM :: MonadPlus m => (a -> Bool) -> m a -> m a
 assertM f x = x >>= assertM' f
 
+assertM_ :: MonadPlus m => (a -> Bool) -> m a -> m ()
+assertM_ f x = guard . f =<< x
+
 assertM' :: MonadPlus m => (a -> Bool) -> a -> m a
 assertM' f x = x <$ guard (f x)