diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 4af81682c..35914e8ca 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -44,8 +44,10 @@ CourseNewDupShort tid@TermId ssh@SchoolId courseShortHand@CourseShorthand: Kurs CourseEditDupShort tid@TermId ssh@SchoolId courseShortHand@CourseShorthand: Kurs #{display tid}-#{display ssh}-#{courseShortHand} konnte nicht geändert werden: Es gibt bereits einen anderen Kurs mit dem Kürzel #{courseShortHand} in diesem Semester. FFSheetName: Name TermCourseListHeading tid@TermId: Kursübersicht #{display tid} +TermSchoolCourseListHeading tid@TermId school@SchoolName: Kursübersicht #{display tid} für #{display school} CourseListTitle: Alle Kurse TermCourseListTitle tid@TermId: Kurse #{display tid} +TermSchoolCourseListTitle tid@TermId school@SchoolName: Kurse #{display tid} für #{display school} CourseNewHeading: Neuen Kurs anlegen CourseEditHeading tid@TermId ssh@SchoolId courseShortHand@CourseShorthand: Kurs #{display tid}-#{display ssh}-#{courseShortHand} editieren CourseEditTitle: Kurs editieren/anlegen diff --git a/models b/models index f4874ebb3..8d67f95cd 100644 --- a/models +++ b/models @@ -74,8 +74,8 @@ Course deregisterUntil UTCTime Maybe registerSecret Text Maybe -- Falls ein Passwort erforderlich ist materialFree Bool - CourseTermSchoolShort term school shorthand - CourseTermSchoolName term school name + TermSchoolCourseShort term school shorthand + TermSchoolCourseName term school name CourseEdit user UserId time UTCTime diff --git a/routes b/routes index 8d17379bd..d58947041 100644 --- a/routes +++ b/routes @@ -46,7 +46,7 @@ /terms/edit TermEditR GET POST /terms/#TermId/edit TermEditExistR GET !/terms/#TermId TermCourseListR GET !free -!/terms/#TermId/#SchoolId SchoolCourseListR GET !free +!/terms/#TermId/#SchoolId TermSchoolCourseListR GET !free -- For Pattern Synonyms see Foundation diff --git a/src/Foundation.hs b/src/Foundation.hs index b7b796c22..1144412ec 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -331,12 +331,12 @@ knownTags = Map.fromList -- should not throw exceptions, i.e. no getBy404 or req guard $ maybe False (== authId) submissionRatingBy return Authorized CSheetR tid ssh csh shn _ -> maybeT (unauthorizedI MsgUnauthorizedSheetCorrector) $ do - Entity cid _ <- MaybeT . lift . getBy $ CourseTermSchoolShort tid ssh csh + Entity cid _ <- MaybeT . lift . getBy $ TermSchoolCourseShort tid ssh csh Entity sid _ <- MaybeT . lift . getBy $ CourseSheet cid shn guard $ sid `Set.member` fromMaybe Set.empty (resMap !? cid) return Authorized CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgUnauthorizedCorrector) $ do - Entity cid _ <- MaybeT . lift . getBy $ CourseTermSchoolShort tid ssh csh + Entity cid _ <- MaybeT . lift . getBy $ TermSchoolCourseShort tid ssh csh guard $ cid `Set.member` Map.keysSet resMap return Authorized _ -> do @@ -345,7 +345,7 @@ knownTags = Map.fromList -- should not throw exceptions, i.e. no getBy404 or req ) ,("time", APDB $ \route _ -> case route of CSheetR tid ssh csh shn subRoute -> maybeT (unauthorizedI MsgUnauthorizedSheetTime) $ do - Entity cid _ <- MaybeT . getBy $ CourseTermSchoolShort tid ssh csh + Entity cid _ <- MaybeT . getBy $ TermSchoolCourseShort tid ssh csh Entity _sid Sheet{..} <- MaybeT . getBy $ CourseSheet cid shn cTime <- liftIO getCurrentTime let @@ -365,7 +365,7 @@ knownTags = Map.fromList -- should not throw exceptions, i.e. no getBy404 or req return Authorized CourseR tid ssh csh CRegisterR -> maybeT (unauthorizedI MsgUnauthorizedCourseTime) $ do - Entity cid Course{..} <- MaybeT . getBy $ CourseTermSchoolShort tid ssh csh + Entity cid Course{..} <- MaybeT . getBy $ TermSchoolCourseShort tid ssh csh cTime <- (NTop . Just) <$> liftIO getCurrentTime guard $ NTop courseRegisterFrom <= cTime && NTop courseRegisterTo >= cTime @@ -389,7 +389,7 @@ knownTags = Map.fromList -- should not throw exceptions, i.e. no getBy404 or req ) ,("capacity", APDB $ \route _ -> case route of CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgCourseNoCapacity) $ do - Entity cid Course{..} <- MaybeT . getBy $ CourseTermSchoolShort tid ssh csh + Entity cid Course{..} <- MaybeT . getBy $ TermSchoolCourseShort tid ssh csh registered <- lift $ fromIntegral <$> count [ CourseParticipantCourse ==. cid ] guard $ NTop courseCapacity > NTop (Just registered) return Authorized @@ -397,7 +397,7 @@ knownTags = Map.fromList -- should not throw exceptions, i.e. no getBy404 or req ) ,("materials", APDB $ \route _ -> case route of CourseR tid ssh csh _ -> maybeT (unauthorizedI MsgUnfreeMaterials) $ do - Entity _ Course{..} <- MaybeT . getBy $ CourseTermSchoolShort tid ssh csh + Entity _ Course{..} <- MaybeT . getBy $ TermSchoolCourseShort tid ssh csh guard courseMaterialFree return Authorized r -> $unsupportedAuthPredicate "materials" r @@ -488,7 +488,7 @@ instance Yesod UniWorX where now <- liftIO $ getCurrentTime uid <- MaybeT $ liftHandlerT maybeAuthId - cid <- MaybeT . getKeyBy $ CourseTermSchoolShort tid ssh csh + cid <- MaybeT . getKeyBy $ TermSchoolCourseShort tid ssh csh user <- MaybeT $ get uid let courseFavourite = CourseFavourite uid now cid @@ -671,11 +671,11 @@ instance YesodBreadcrumbs UniWorX where breadcrumb (TermEditExistR tid) = return ("Editieren" , Just $ TermCourseListR tid) breadcrumb (TermCourseListR (unTermKey -> tid)) = getMessageRender <&> \mr -> (mr $ ShortTermIdentifier tid, Just TermShowR) - breadcrumb (SchoolCourseListR tid ssh) = return (CI.original $ unSchoolKey ssh, Just $ TermCourseListR tid) + breadcrumb (TermSchoolCourseListR tid ssh) = return (CI.original $ unSchoolKey ssh, Just $ TermCourseListR tid) breadcrumb CourseListR = return ("Kurse" , Just HomeR) breadcrumb CourseNewR = return ("Neu" , Just CourseListR) - breadcrumb (CourseR tid ssh csh CShowR) = return (CI.original csh, Just $ SchoolCourseListR tid ssh) + breadcrumb (CourseR tid ssh csh CShowR) = return (CI.original csh, Just $ TermSchoolCourseListR tid ssh) -- (CourseR tid ssh csh CRegisterR) -- is POST only breadcrumb (CourseR tid ssh csh CEditR) = return ("Editieren", Just $ CourseR tid ssh csh CShowR) breadcrumb (CourseR tid ssh csh CCorrectionsR) = return ("Abgaben",Just $ CourseR tid ssh csh CShowR) @@ -848,7 +848,7 @@ pageActions (CourseR tid ssh csh CShowR) = let sheetRouteAccess shn = (== Authorized) <$> (isAuthorized (CSheetR tid ssh csh shn SShowR) False) muid <- maybeAuthId (sheets,lecturer) <- runDB $ do - cid <- getKeyBy404 $ CourseTermSchoolShort tid ssh csh + cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh sheets <- map (sheetName.entityVal) <$> selectList [SheetCourse ==. cid] [Desc SheetActiveFrom] lecturer <- case muid of Nothing -> return False @@ -984,6 +984,10 @@ pageHeading (TermEditExistR tid) = Just $ i18nHeading $ MsgTermEditTid tid pageHeading (TermCourseListR tid) = Just . i18nHeading . MsgTermCourseListHeading $ tid +pageHeading (TermSchoolCourseListR tid ssh) + = Just $ do + School{schoolName=school} <- handlerToWidget $ runDB $ get404 ssh + i18nHeading $ MsgTermSchoolCourseListHeading tid school pageHeading (CourseListR) = Just $ i18nHeading $ MsgCourseListTitle @@ -991,7 +995,7 @@ pageHeading CourseNewR = Just $ i18nHeading MsgCourseNewHeading pageHeading (CourseR tid ssh csh CShowR) = Just $ do - Entity _ Course{..} <- handlerToWidget . runDB . getBy404 $ CourseTermSchoolShort tid ssh csh + Entity _ Course{..} <- handlerToWidget . runDB . getBy404 $ TermSchoolCourseShort tid ssh csh toWidget courseName -- (CourseR tid csh CRegisterR) -- just for POST pageHeading (CourseR tid ssh csh CEditR) @@ -1059,21 +1063,21 @@ routeNormalizers = tell $ Any True | otherwise = return () ncSchool = maybeOrig $ \route -> do - SchoolCourseListR tid ssh <- return route + TermSchoolCourseListR tid ssh <- return route let schoolShort :: SchoolShorthand schoolShort = unSchoolKey ssh Entity ssh' _ <- MaybeT . lift . getBy $ UniqueSchoolShorthand schoolShort (hasChanged `on` unSchoolKey)ssh ssh' - return $ SchoolCourseListR tid ssh' + return $ TermSchoolCourseListR tid ssh' ncCourse = maybeOrig $ \route -> do CourseR tid ssh csh subRoute <- return route - Entity _ Course{..} <- MaybeT . lift . getBy $ CourseTermSchoolShort tid ssh csh + Entity _ Course{..} <- MaybeT . lift . getBy $ TermSchoolCourseShort tid ssh csh hasChanged csh courseShorthand (hasChanged `on` unSchoolKey) ssh courseSchool return $ CourseR tid courseSchool courseShorthand subRoute ncSheet = maybeOrig $ \route -> do CSheetR tid ssh csh shn subRoute <- return route - Entity cid _ <- MaybeT . lift . getBy $ CourseTermSchoolShort tid ssh csh + Entity cid _ <- MaybeT . lift . getBy $ TermSchoolCourseShort tid ssh csh Entity _ Sheet{..} <- MaybeT . lift . getBy $ CourseSheet cid shn hasChanged shn sheetName return $ CSheetR tid ssh csh sheetName subRoute diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 96ad16794..5e587c624 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -86,17 +86,19 @@ colTerm = sortable (Just "term") (i18nCell MsgTerm) colCourse :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a) colCourse = sortable (Just "course") (i18nCell MsgCourse) $ \DBRow{ dbrOutput=(_, _, course, _, _) } -> - let tid = course ^. _3 - csh = course ^. _2 - in anchorCell (CourseR tid csh CShowR) [whamlet|#{display csh}|] + let csh = course ^. _2 + tid = course ^. _3 + ssh = course ^. _4 + in anchorCell (CourseR tid ssh csh CShowR) [whamlet|#{display csh}|] colSheet :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a) colSheet = sortable (Just "sheet") (i18nCell MsgSheet) $ \DBRow{ dbrOutput=(_, sheet, course, _, _) } -> - let tid = course ^. _3 - csh = course ^. _2 + let csh = course ^. _2 + tid = course ^. _3 + ssh = course ^. _4 shn = sheetName $ entityVal sheet - in anchorCell (CSheetR tid csh shn SShowR) [whamlet|#{display shn}|] + in anchorCell (CSheetR tid ssh csh shn SShowR) [whamlet|#{display shn}|] colCorrector :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a) colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector) $ \case @@ -106,13 +108,14 @@ colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector) $ \case colSubmissionLink :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a) colSubmissionLink = sortable Nothing (i18nCell MsgSubmission) $ \DBRow{ dbrOutput=(submission, sheet, course, _, _) } -> - let tid = course ^. _3 - csh = course ^. _2 + let csh = course ^. _2 + tid = course ^. _3 + ssh = course ^. _4 shn = sheetName $ entityVal sheet mkCid = encrypt (entityKey submission :: SubmissionId) -- TODO: executed twice mkRoute = do cid <- mkCid - return $ CSubmissionR tid csh shn cid SubShowR + return $ CSubmissionR tid ssh csh shn cid SubShowR in anchorCellM mkRoute (mkCid >>= \cid -> [whamlet|#{display cid}|]) colSelect :: Colonnade _ CorrectionTableData (DBCell _ (FormResult (DBFormResult CorrectionTableData CryptoFileNameSubmission Bool))) @@ -125,12 +128,13 @@ colSubmittors = sortable Nothing (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutp colRating :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a) colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(Entity subId Submission{..}, Entity _ Sheet{..}, course, _, _) } -> - let tid = course ^. _3 - csh = course ^. _2 + let csh = course ^. _2 + tid = course ^. _3 + ssh = course ^. _4 -- shn = sheetName mkRoute = do cid <- encrypt subId - return $ CSubmissionR tid csh sheetName cid CorrectionR + return $ CSubmissionR tid ssh csh sheetName cid CorrectionR in anchorCellM mkRoute $(widgetFile "widgets/rating") type CorrectionTableExpr = (E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User)) @@ -340,10 +344,10 @@ postCorrectionsR = do [ downloadAction ] -getCCorrectionsR, postCCorrectionsR :: TermId -> CourseShorthand -> Handler TypedContent +getCCorrectionsR, postCCorrectionsR :: TermId -> SchoolId -> CourseShorthand -> Handler TypedContent getCCorrectionsR = postCCorrectionsR -postCCorrectionsR tid csh = do - Entity cid _ <- runDB $ getBy404 $ CourseTermShort tid csh +postCCorrectionsR tid ssh csh = do + Entity cid _ <- runDB $ getBy404 $ TermSchoolCourseShort tid ssh csh let whereClause = courseIs cid colonnade = mconcat [ colSelect @@ -360,10 +364,10 @@ postCCorrectionsR tid csh = do , assignAction (Left cid) ] -getSSubsR, postSSubsR :: TermId -> CourseShorthand -> SheetName -> Handler TypedContent +getSSubsR, postSSubsR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler TypedContent getSSubsR = postSSubsR -postSSubsR tid csh shn = do - shid <- runDB $ fetchSheetId tid csh shn +postSSubsR tid ssh csh shn = do + shid <- runDB $ fetchSheetId tid ssh csh shn let whereClause = sheetIs shid colonnade = mconcat [ colSelect @@ -380,26 +384,26 @@ postSSubsR tid csh shn = do , autoAssignAction shid ] -correctionData tid csh shn sub = E.select . E.from $ \((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) -> do +correctionData :: TermId -> SchoolId -> CourseShorthand -> SheetName -> _ -- CryptoFileNameSubmission -> _ +correctionData tid ssh csh shn sub = E.select . E.from $ \((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) -> do E.on $ corrector E.?. UserId E.==. submission E.^. SubmissionRatingBy E.on $ submission E.^. SubmissionSheet E.==. sheet E.^. SheetId E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId - - E.where_ $ course E.^. CourseTerm E.==. E.val tid - E.&&. course E.^. CourseShorthand E.==. E.val csh - E.&&. sheet E.^. SheetName E.==. E.val shn + E.where_ $ course E.^. CourseTerm E.==. E.val tid + E.&&. course E.^. CourseSchool E.==. E.val ssh + E.&&. course E.^. CourseShorthand E.==. E.val csh + E.&&. sheet E.^. SheetName E.==. E.val shn E.&&. submission E.^. SubmissionId E.==. E.val sub - return (course, sheet, submission, corrector) -getCorrectionR, getCorrectionUserR, postCorrectionR :: TermId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html -getCorrectionR tid csh shn cid = do - mayPost <- isAuthorized (CSubmissionR tid csh shn cid CorrectionR) True - bool getCorrectionUserR postCorrectionR (mayPost == Authorized) tid csh shn cid -postCorrectionR tid csh shn cid = do +getCorrectionR, getCorrectionUserR, postCorrectionR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> CryptoFileNameSubmission -> Handler Html +getCorrectionR tid ssh csh shn cid = do + mayPost <- isAuthorized (CSubmissionR tid ssh csh shn cid CorrectionR) True + bool getCorrectionUserR postCorrectionR (mayPost == Authorized) tid ssh csh shn cid +postCorrectionR tid ssh csh shn cid = do sub <- decrypt cid - results <- runDB $ correctionData tid csh shn sub + results <- runDB $ correctionData tid ssh csh shn sub case results of [(Entity _ Course{..}, Entity _ Sheet{..}, Entity _ Submission{..}, corrector)] -> do @@ -424,14 +428,14 @@ postCorrectionR tid csh shn cid = do let rated = isJust $ void ratingPoints <|> void ratingComment - update sub [ SubmissionRatingBy =. (uid <$ guard rated) - , SubmissionRatingTime =. (now <$ guard rated) - , SubmissionRatingPoints =. ratingPoints + update sub [ SubmissionRatingBy =. (uid <$ guard rated) + , SubmissionRatingTime =. (now <$ guard rated) + , SubmissionRatingPoints =. ratingPoints , SubmissionRatingComment =. ratingComment ] addMessageI "success" $ bool MsgRatingDeleted MsgRatingUpdated rated - redirect $ CSubmissionR tid csh shn cid CorrectionR + redirect $ CSubmissionR tid ssh csh shn cid CorrectionR case uploadResult of FormMissing -> return () @@ -442,16 +446,16 @@ postCorrectionR tid csh shn cid = do runDB . runConduit $ transPipe lift fileSource .| extractRatingsMsg .| sinkSubmission uid (Right sub) True addMessageI "success" MsgRatingFilesUpdated - redirect $ CSubmissionR tid csh shn cid CorrectionR + redirect $ CSubmissionR tid ssh csh shn cid CorrectionR defaultLayout $ do let userCorrection = $(widgetFile "correction-user") $(widgetFile "correction") _ -> notFound -getCorrectionUserR tid csh shn cid = do +getCorrectionUserR tid ssh csh shn cid = do sub <- decrypt cid - results <- runDB $ correctionData tid csh shn sub + results <- runDB $ correctionData tid ssh csh shn sub case results of [(Entity _ Course{..}, Entity _ Sheet{..}, Entity _ Submission{..}, corrector@(Just _))] -> do diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 2081aa833..465c8f73f 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -81,12 +81,12 @@ colTerm = sortable (Just "term") (i18nCell MsgTerm) colSchool :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) colSchool = sortable (Just "school") (i18nCell MsgCourseSchool) $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, Entity _ School{..}) } -> - anchorCell (SchoolCourseListR courseTerm courseSchool) [whamlet|#{display schoolName}|] + anchorCell (TermSchoolCourseListR courseTerm courseSchool) [whamlet|#{display schoolName}|] colSchoolShort :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) colSchoolShort = sortable (Just "schoolshort") (i18nCell MsgCourseSchoolShort) $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, Entity _ School{..}) } -> - anchorCell (SchoolCourseListR courseTerm courseSchool) [whamlet|#{display schoolShorthand}|] + anchorCell (TermSchoolCourseListR courseTerm courseSchool) [whamlet|#{display schoolShorthand}|] colRegFrom :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) colRegFrom = sortable (Just "register-from") (i18nCell MsgRegisterFrom) @@ -201,6 +201,30 @@ getTermCurrentR = do (Just (maximum -> tid)) -> -- getTermCourseListR tid redirect $ TermCourseListR tid -- redirect avoids problematic breadcrumbs, headings, etc. +getTermSchoolCourseListR :: TermId -> SchoolId -> Handler Html +getTermSchoolCourseListR tid ssh = do + void . runDB $ get404 tid -- Just ensure the term exists + School{schoolName=school} <- runDB $ get404 ssh -- Just ensure the term exists + muid <- maybeAuthId + let colonnade = widgetColonnade $ mconcat + [ dbRow + , colCShortDescr + , colRegFrom + , colRegTo + , colParticipants + , maybe mempty (const colRegistered) muid + ] + whereClause = \(course, _, _) -> + course E.^. CourseTerm E.==. E.val tid + E.&&. course E.^. CourseSchool E.==. E.val ssh + validator = def + & defaultSorting [("cshort", SortAsc)] + ((), coursesTable) <- makeCourseTable whereClause colonnade validator + defaultLayout $ do + setTitleI $ MsgTermSchoolCourseListTitle tid school + $(widgetFile "courses") + + getTermCourseListR :: TermId -> Handler Html getTermCourseListR tid = do void . runDB $ get404 tid -- Just ensure the term exists @@ -226,7 +250,7 @@ getCShowR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getCShowR tid ssh csh = do mbAid <- maybeAuthId (courseEnt,(schoolMB,participants,registered)) <- runDB $ do - courseEnt@(Entity cid course) <- getBy404 $ CourseTermSchoolShort tid ssh csh + courseEnt@(Entity cid course) <- getBy404 $ TermSchoolCourseShort tid ssh csh dependent <- (,,) <$> get (courseSchool course) -- join -- just fetch full school name here <*> count [CourseParticipantCourse ==. cid] -- join @@ -262,7 +286,7 @@ postCRegisterR :: TermId -> SchoolId -> CourseShorthand -> Handler Html postCRegisterR tid ssh csh = do aid <- requireAuthId (cid, course, registered) <- runDB $ do - (Entity cid course) <- getBy404 $ CourseTermSchoolShort tid ssh csh + (Entity cid course) <- getBy404 $ TermSchoolCourseShort tid ssh csh registered <- isJust <$> (getBy $ UniqueParticipant aid cid) return (cid, course, registered) ((regResult,_), _) <- runFormPost $ identifyForm "registerBtn" $ registerForm registered $ courseRegisterSecret course @@ -289,12 +313,12 @@ postCourseNewR = courseEditHandler False Nothing getCEditR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getCEditR tid ssh csh = do - course <- runDB $ getBy $ CourseTermSchoolShort tid ssh csh + course <- runDB $ getBy $ TermSchoolCourseShort tid ssh csh courseEditHandler True course postCEditR :: TermId -> SchoolId -> CourseShorthand -> Handler Html postCEditR tid ssh csh = do - course <- runDB $ getBy $ CourseTermSchoolShort tid ssh csh + course <- runDB $ getBy $ TermSchoolCourseShort tid ssh csh courseEditHandler False course diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index cba7a981f..9d5f95fc2 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -159,7 +159,7 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do getSheetListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getSheetListR tid ssh csh = do muid <- maybeAuthId - Entity cid _ <- runDB . getBy404 $ CourseTermSchoolShort tid ssh csh + Entity cid _ <- runDB . getBy404 $ TermSchoolCourseShort tid ssh csh let sheetData :: E.SqlExpr (Entity Sheet) `E.LeftOuterJoin` (E.SqlExpr (Maybe (Entity Submission)) `E.InnerJoin` (E.SqlExpr (Maybe (Entity SubmissionUser)))) -> E.SqlQuery (E.SqlExpr (Entity Sheet), E.SqlExpr (E.Value (Maybe UTCTime)),E.SqlExpr (Maybe (Entity Submission))) sheetData (sheet `E.LeftOuterJoin` (submission `E.InnerJoin` submissionUser)) = do @@ -411,7 +411,7 @@ handleSheetEdit tid ssh csh msId template dbAction = do (FormSuccess SheetForm{..}) -> do saveOkay <- runDB $ do actTime <- liftIO getCurrentTime - cid <- getKeyBy404 $ CourseTermSchoolShort tid ssh csh + cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh let newSheet = Sheet { sheetCourse = cid , sheetName = sfName diff --git a/src/Handler/Utils/Sheet.hs b/src/Handler/Utils/Sheet.hs index e98182f9c..d38d2e10a 100644 --- a/src/Handler/Utils/Sheet.hs +++ b/src/Handler/Utils/Sheet.hs @@ -29,7 +29,7 @@ fetchSheetAux prj tid ssh csh shn = let cachId = encodeUtf8 $ tshow (tid,ssh,csh,shn) in cachedBy cachId $ do -- Mit Yesod: - -- cid <- getKeyBy404 $ CourseTermSchoolShort tid ssh csh + -- cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh -- getBy404 $ CourseSheet cid shn -- Mit Esqueleto: sheetList <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do