fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

corrections list for sheet

Browse Source
This commit is contained in:
Gregor Kleen 2018-06-29 20:29:05 +02:00
parent f367c7347b
commit 1dce109ac1
3 changed files with 48 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
routes
View File

@ -51,7 +51,7 @@
/show CShowR GET !free /show CShowR GET !free
/register CRegisterR POST !time /register CRegisterR POST !time
/edit CEditR GET POST /edit CEditR GET POST
/corrections CourseCorrectionsR GET POST /subs CourseCorrectionsR GET POST
/ex SheetListR GET !registered !materials /ex SheetListR GET !registered !materials
!/ex/new SheetNewR GET POST !/ex/new SheetNewR GET POST
/ex/#Text SheetR: /ex/#Text SheetR:
@ -63,6 +63,7 @@
!/sub/own SubmissionOwnR GET !free !/sub/own SubmissionOwnR GET !free
!/sub/#CryptoFileNameSubmission SubmissionR GET POST !owner !corrector !/sub/#CryptoFileNameSubmission SubmissionR GET POST !owner !corrector
/correctors SCorrR GET POST /correctors SCorrR GET POST
/subs SSubsR GET POST
/corrections CorrectionsR GET POST !free /corrections CorrectionsR GET POST !free

10
src/Foundation.hs
View File

@ -587,6 +587,7 @@ instance YesodBreadcrumbs UniWorX where
breadcrumb (CourseR term course CShowR) = return (course, Just $ TermCourseListR term) breadcrumb (CourseR term course CShowR) = return (course, Just $ TermCourseListR term)
breadcrumb CourseNewR = return ("Neu", Just CourseListR) breadcrumb CourseNewR = return ("Neu", Just CourseListR)
breadcrumb (CourseR tid csh CEditR) = return ("Editieren", Just $ CourseR tid csh CShowR) 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 SheetListR) = return ("Übungen",Just $ CourseR tid csh CShowR)
breadcrumb (CourseR tid csh SheetNewR ) = return ("Neu", Just $ CourseR tid csh SheetListR) 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 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 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 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 (CSheetR tid csh shn (SubmissionR _)) = return ("Abgabe", Just $ CSheetR tid csh shn SShowR)
breadcrumb SubmissionListR = return ("Abgaben", Just HomeR) breadcrumb SubmissionListR = return ("Abgaben", Just HomeR)
breadcrumb CorrectionsR = return ("Korrekturen", Just HomeR)
breadcrumb HomeR = return ("UniWorkY", Nothing) breadcrumb HomeR = return ("UniWorkY", Nothing)
breadcrumb (AuthR _) = return ("Login", Just HomeR) breadcrumb (AuthR _) = return ("Login", Just HomeR)
@ -669,6 +673,12 @@ pageActions (CSheetR tid csh shn SShowR) =
, menuItemRoute = CSheetR tid csh shn SCorrR , menuItemRoute = CSheetR tid csh shn SCorrR
, menuItemAccessCallback' = return True , menuItemAccessCallback' = return True
} }
, PageActionPrime $ MenuItem
{ menuItemLabel = "Abgaben"
, menuItemIcon = Nothing
, menuItemRoute = CSheetR tid csh shn SSubsR
, menuItemAccessCallback' = return True
}
] ]
pageActions TermShowR = pageActions TermShowR =
[ PageActionPrime $ MenuItem [ PageActionPrime $ MenuItem

52
src/Handler/Corrections.hs
View File

@ -66,6 +66,9 @@ ratedBy uid (_course,_sheet,submission) = submission E.^. SubmissionRatingBy E.=
courseIs :: Key Course -> CorrectionsWhere courseIs :: Key Course -> CorrectionsWhere
courseIs cid (course,_sheet,_submission) = course E.^. CourseId E.==. E.val cid 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)) 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) , return (pure CorrDownloadData, mempty)
) )
assignAction :: CourseId -> ActionCorrections' assignAction :: Either CourseId SheetId -> ActionCorrections'
assignAction cId = ( CorrSetCorrector assignAction selId = ( CorrSetCorrector
, do , do
correctors <- liftHandlerT . runDB . E.select . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` sheetCorrector `E.InnerJoin` user) -> 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 $ user E.^. UserId E.==. sheetCorrector E.^. SheetCorrectorUser
E.on $ sheet E.^. SheetId E.==. sheetCorrector E.^. SheetCorrectorSheet E.on $ sheet E.^. SheetId E.==. sheetCorrector E.^. SheetCorrectorSheet
E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse 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 ($ mempty) . renderAForm FormStandard . wFormToAForm $ do
cId <- wreq (selectFieldList correctors' :: Field (HandlerT UniWorX IO) (Maybe CryptoUUIDUser)) (fslI MsgCorrector) Nothing cId <- wreq (selectFieldList correctors' :: Field (HandlerT UniWorX IO) (Maybe CryptoUUIDUser)) (fslI MsgCorrector) Nothing
fmap CorrSetCorrectorData <$> (traverse.traverse) decrypt cId fmap CorrSetCorrectorData <$> (traverse.traverse) decrypt cId
) )
getCorrectionsR, postCorrectionsR :: Handler TypedContent getCorrectionsR, postCorrectionsR :: Handler TypedContent
getCorrectionsR = postCorrectionsR getCorrectionsR = postCorrectionsR
@ -289,5 +292,22 @@ postCourseCorrectionsR tid csh = do
psValidator = def psValidator = def
correctionsR whereClause colonnade psValidator $ Map.fromList correctionsR whereClause colonnade psValidator $ Map.fromList
[ downloadAction [ 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)
] ]