From 1dce109ac1993bf4d826dc49a1f122617450b741 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 29 Jun 2018 20:29:05 +0200 Subject: [PATCH] corrections list for sheet --- routes | 3 ++- src/Foundation.hs | 10 ++++++++ src/Handler/Corrections.hs | 52 ++++++++++++++++++++++++++------------ 3 files changed, 48 insertions(+), 17 deletions(-) diff --git a/routes b/routes index bc7a61877..7c13ce3e1 100644 --- a/routes +++ b/routes @@ -51,7 +51,7 @@ /show CShowR GET !free /register CRegisterR POST !time /edit CEditR GET POST - /corrections CourseCorrectionsR GET POST + /subs CourseCorrectionsR GET POST /ex SheetListR GET !registered !materials !/ex/new SheetNewR GET POST /ex/#Text SheetR: @@ -63,6 +63,7 @@ !/sub/own SubmissionOwnR GET !free !/sub/#CryptoFileNameSubmission SubmissionR GET POST !owner !corrector /correctors SCorrR GET POST + /subs SSubsR GET POST /corrections CorrectionsR GET POST !free diff --git a/src/Foundation.hs b/src/Foundation.hs index a8230a582..e07c059d2 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -587,6 +587,7 @@ instance YesodBreadcrumbs UniWorX where breadcrumb (CourseR term course CShowR) = return (course, Just $ TermCourseListR term) breadcrumb CourseNewR = return ("Neu", Just CourseListR) breadcrumb (CourseR tid csh CEditR) = return ("Editieren", Just $ CourseR tid csh CShowR) + breadcrumb (CourseR tid csh CourseCorrectionsR) = return ("Abgaben", Just $ CourseR tid csh CShowR) breadcrumb (CourseR tid csh SheetListR) = return ("Übungen",Just $ CourseR tid csh CShowR) breadcrumb (CourseR tid csh SheetNewR ) = return ("Neu", Just $ CourseR tid csh SheetListR) @@ -594,10 +595,13 @@ instance YesodBreadcrumbs UniWorX where breadcrumb (CSheetR tid csh shn SEditR) = return ("Edit", Just $ CSheetR tid csh shn SShowR) breadcrumb (CSheetR tid csh shn SDelR ) = return ("DELETE", Just $ CSheetR tid csh shn SShowR) breadcrumb (CSheetR tid csh shn SCorrR) = return ("Korrektoren", Just $ CSheetR tid csh shn SShowR) + breadcrumb (CSheetR tid csh shn SSubsR) = return ("Abgaben", Just $ CSheetR tid csh shn SShowR) breadcrumb (CSheetR tid csh shn (SubmissionR _)) = return ("Abgabe", Just $ CSheetR tid csh shn SShowR) breadcrumb SubmissionListR = return ("Abgaben", Just HomeR) + breadcrumb CorrectionsR = return ("Korrekturen", Just HomeR) + breadcrumb HomeR = return ("UniWorkY", Nothing) breadcrumb (AuthR _) = return ("Login", Just HomeR) @@ -669,6 +673,12 @@ pageActions (CSheetR tid csh shn SShowR) = , menuItemRoute = CSheetR tid csh shn SCorrR , menuItemAccessCallback' = return True } + , PageActionPrime $ MenuItem + { menuItemLabel = "Abgaben" + , menuItemIcon = Nothing + , menuItemRoute = CSheetR tid csh shn SSubsR + , menuItemAccessCallback' = return True + } ] pageActions TermShowR = [ PageActionPrime $ MenuItem diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index d35909517..66bcb2aa3 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -66,6 +66,9 @@ ratedBy uid (_course,_sheet,submission) = submission E.^. SubmissionRatingBy E.= courseIs :: Key Course -> CorrectionsWhere courseIs cid (course,_sheet,_submission) = course E.^. CourseId E.==. E.val cid +sheetIs :: Key Sheet -> CorrectionsWhere +sheetIs shid (_course,sheet,_submission) = sheet E.^. SheetId E.==. E.val shid + type CorrectionTableData = DBRow (Entity Submission, Entity Sheet, (E.Value Text, E.Value Text, E.Value (Key Term), E.Value (Key School)), Maybe (Entity User)) @@ -233,26 +236,26 @@ downloadAction = ( CorrDownload , return (pure CorrDownloadData, mempty) ) -assignAction :: CourseId -> ActionCorrections' -assignAction cId = ( CorrSetCorrector - , do - correctors <- liftHandlerT . runDB . E.select . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` sheetCorrector `E.InnerJoin` user) -> do - E.on $ user E.^. UserId E.==. sheetCorrector E.^. SheetCorrectorUser - E.on $ sheet E.^. SheetId E.==. sheetCorrector E.^. SheetCorrectorSheet - E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse +assignAction :: Either CourseId SheetId -> ActionCorrections' +assignAction selId = ( CorrSetCorrector + , do + correctors <- liftHandlerT . runDB . E.select . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` sheetCorrector `E.InnerJoin` user) -> do + E.on $ user E.^. UserId E.==. sheetCorrector E.^. SheetCorrectorUser + E.on $ sheet E.^. SheetId E.==. sheetCorrector E.^. SheetCorrectorSheet + E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse - E.where_ $ course E.^. CourseId E.==. E.val cId + E.where_ $ either (\cId -> course E.^. CourseId E.==. E.val cId) (\shId -> sheet E.^. SheetId E.==. E.val shId) selId - return user + return user - mr <- getMessageRender + mr <- getMessageRender - correctors' <- fmap ((mr MsgNoCorrector, Nothing) :) . forM correctors $ \Entity{ entityKey, entityVal = User{..} } -> (display userDisplayName, ) . Just <$> encrypt entityKey + correctors' <- fmap ((mr MsgNoCorrector, Nothing) :) . forM correctors $ \Entity{ entityKey, entityVal = User{..} } -> (display userDisplayName, ) . Just <$> encrypt entityKey - ($ mempty) . renderAForm FormStandard . wFormToAForm $ do - cId <- wreq (selectFieldList correctors' :: Field (HandlerT UniWorX IO) (Maybe CryptoUUIDUser)) (fslI MsgCorrector) Nothing - fmap CorrSetCorrectorData <$> (traverse.traverse) decrypt cId - ) + ($ mempty) . renderAForm FormStandard . wFormToAForm $ do + cId <- wreq (selectFieldList correctors' :: Field (HandlerT UniWorX IO) (Maybe CryptoUUIDUser)) (fslI MsgCorrector) Nothing + fmap CorrSetCorrectorData <$> (traverse.traverse) decrypt cId + ) getCorrectionsR, postCorrectionsR :: Handler TypedContent getCorrectionsR = postCorrectionsR @@ -289,5 +292,22 @@ postCourseCorrectionsR tid csh = do psValidator = def correctionsR whereClause colonnade psValidator $ Map.fromList [ downloadAction - , assignAction cid + , assignAction (Left cid) + ] + +getSSubsR, postSSubsR :: TermId -> Text -> Text -> Handler TypedContent +getSSubsR = postSSubsR +postSSubsR tid csh shn = do + shid <- runDB $ fetchSheetId tid csh shn + let whereClause = sheetIs shid + colonnade = mconcat + [ colSelect + , dbRow + , colCorrector + , colSubmissionLink + ] + psValidator = def + correctionsR whereClause colonnade psValidator $ Map.fromList + [ downloadAction + , assignAction (Right shid) ]