Fixes #179
This commit is contained in:
SJost
parent
918141da4c
commit
cc4c8a897e
@ -267,7 +267,7 @@ AmbiguousUTCTime: Der angegebene Zeitpunkt lässt sich nicht eindeutig zu UTC ko
|
||||
IllDefinedUTCTime: Der angegebene Zeitpunkt lässt sich nicht zu UTC konvertieren
|
||||
|
||||
LastEdits: Letzte Änderungen
|
||||
EditedBy name@Text time@Text: Durch #{name} um #{time}
|
||||
EditedBy name@Text time@Text: #{time} durch #{name}
|
||||
LastEdit: Letzte Änderung
|
||||
LastEditByUser: Ihre letzte Bearbeitung
|
||||
NoEditByUser: Nicht von Ihnen bearbeitet
|
||||
|
||||
@ -160,16 +160,16 @@ getProfileDataR = do
|
||||
(hasRows, ownedCoursesTable) <- mkOwnedCoursesTable uid
|
||||
-- Tabelle mit allen Teilnehmer: Kurs (link), Datum
|
||||
enrolledCoursesTable <- mkEnrolledCoursesTable uid
|
||||
-- Tabelle mit allen Klausuren und Noten
|
||||
examTable <- return [whamlet| TOOD: Klausuranmeldungen anzeigen |] -- TODO
|
||||
-- Tabelle mit allen Abgaben und Abgabe-Gruppen
|
||||
submissionTable <- mkSubmissionTable uid
|
||||
-- Tabelle mit allen Abgabegruppen
|
||||
submissionGroupTable <- mkSubmissionGroupTable uid
|
||||
-- Tabelle mit allen Korrektor-Aufgaben
|
||||
correctionsTable <- mkCorrectionsTable uid
|
||||
-- Tabelle mit allen Tutorials
|
||||
tutorialTable <- return [whamlet| TOOD: Tutorials anzeigen |] -- TODO
|
||||
-- Tabelle mit allen Korrektor-Aufgaben
|
||||
correctorTable <- return [whamlet| TOOD: Korrekturen anzeigen |] -- TODO
|
||||
-- Tabelle mit allen Klausuren und Noten
|
||||
examTable <- return [whamlet| TOOD: Klausuranmeldungen anzeigen |] -- TODO
|
||||
defaultLayout $ do
|
||||
$(widgetFile "profileData")
|
||||
$(widgetFile "dsgvDisclaimer")
|
||||
@ -346,6 +346,10 @@ mkSubmissionTable =
|
||||
in \uid -> let dbtSQLQuery = dbtSQLQuery' uid
|
||||
dbtSorting = dbtSorting' uid
|
||||
in dbTableWidget' validator $ DBTable {..}
|
||||
-- in do dbtSQLQuery <- dbtSQLQuery'
|
||||
-- dbtSorting <- dbtSorting'
|
||||
-- return $ dbTableWidget' validator $ DBTable {..}
|
||||
|
||||
|
||||
|
||||
mkSubmissionGroupTable :: UserId -> Handler Widget
|
||||
@ -353,7 +357,6 @@ mkSubmissionGroupTable :: UserId -> Handler Widget
|
||||
mkSubmissionGroupTable =
|
||||
let dbtIdent = "subGroups" :: Text
|
||||
dbtStyle = def
|
||||
|
||||
withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroup) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroupUser) )->a)
|
||||
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroup) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroupUser) )->a)
|
||||
withType = id
|
||||
@ -411,8 +414,71 @@ mkSubmissionGroupTable =
|
||||
]
|
||||
in \uid -> let dbtSQLQuery = dbtSQLQuery' uid
|
||||
in dbTableWidget' validator $ DBTable {..}
|
||||
-- in do dbtSQLQuery <- dbtSQLQuery'
|
||||
-- dbtSorting <- dbtSorting'
|
||||
-- return $ dbTableWidget' validator $ DBTable {..}
|
||||
|
||||
|
||||
|
||||
mkCorrectionsTable :: UserId -> Handler Widget
|
||||
-- Table listing all corrections made by the given user
|
||||
mkCorrectionsTable =
|
||||
let dbtIdent = "corrections" :: Text
|
||||
dbtStyle = def
|
||||
-- TODO Continue here
|
||||
withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroup) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroupUser) )->a)
|
||||
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroup) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroupUser) )->a)
|
||||
withType = id
|
||||
|
||||
dbtSQLQuery' uid = \(course `E.InnerJoin` sgroup `E.InnerJoin` sguser) -> do
|
||||
E.on $ sguser E.^. SubmissionGroupUserSubmissionGroup E.==. sgroup E.^. SubmissionGroupId
|
||||
E.on $ sgroup E.^. SubmissionGroupCourse E.==. course E.^. CourseId
|
||||
E.where_ $ sguser E.^. SubmissionGroupUserUser E.==. E.val uid
|
||||
let crse = ( course E.^. CourseTerm
|
||||
, course E.^. CourseSchool
|
||||
, course E.^. CourseShorthand
|
||||
)
|
||||
return (crse, sgroup, lastSGEdit sgroup)
|
||||
|
||||
lastSGEdit sgroup = -- latest Edit-Time of this Submission Group by a user
|
||||
E.sub_select . E.from $ \(user `E.InnerJoin` sgEdit) -> do
|
||||
E.on $ user E.^. UserId E.==. sgEdit E.^. SubmissionGroupEditUser
|
||||
E.where_ $ sgEdit E.^. SubmissionGroupEditSubmissionGroup E.==. sgroup E.^. SubmissionGroupId
|
||||
return . E.max_ $ sgEdit E.^. SubmissionGroupEditTime
|
||||
|
||||
dbtProj = \x -> return $ x
|
||||
& _dbrOutput . _1 %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh))
|
||||
& _dbrOutput . _3 %~ E.unValue
|
||||
|
||||
dbtColonnade = mconcat
|
||||
[ dbRow
|
||||
, sortable (Just "term") (i18nCell MsgTerm) $
|
||||
termCell <$> view (_dbrOutput . _1 . _1)
|
||||
, sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 ) $
|
||||
schoolCell <$> view ( _1. re _Just)
|
||||
<*> view ( _2 )
|
||||
, sortable (Just "course") (i18nCell MsgCourse) $
|
||||
courseLinkCell <$> view (_dbrOutput . _1)
|
||||
, sortable (Just "submissiongroup") (i18nCell MsgSubmissionGroupName) . magnify (_dbrOutput . _2 . _entityVal) $
|
||||
maybe mempty textCell <$> view _submissionGroupName
|
||||
, sortable (Just "edit") (i18nCell MsgLastEdit) $
|
||||
maybe mempty timeCell <$> view (_dbrOutput . _3)
|
||||
]
|
||||
|
||||
validator = def -- DUPLICATED CODE: Handler.Corrections
|
||||
& restrictFilter (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information
|
||||
& restrictSorting (\name _ -> name /= "corrector")
|
||||
& defaultSorting [("edit",SortDesc)]
|
||||
dbtSorting = Map.fromList
|
||||
[ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseShorthand)
|
||||
, ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseTerm )
|
||||
, ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseSchool )
|
||||
, ( "submissiongroup" , SortColumn $ withType $ \(_ `E.InnerJoin` sgroup `E.InnerJoin` _) -> sgroup E.^. SubmissionGroupName )
|
||||
, ( "edit" , SortColumn $ withType $ \(_ `E.InnerJoin` sgroup `E.InnerJoin` _ ) -> lastSGEdit sgroup)
|
||||
]
|
||||
dbtFilter = Map.fromList
|
||||
[ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand)
|
||||
, ( "term", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm )
|
||||
, ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool )
|
||||
]
|
||||
in \uid -> let dbtSQLQuery = dbtSQLQuery' uid
|
||||
in dbTableWidget' validator $ DBTable {..}
|
||||
|
||||
|
||||
|
||||
@ -31,6 +31,7 @@ import Control.Monad.Trans.Maybe
|
||||
import Control.Monad.State.Class
|
||||
import Control.Monad.Trans.State.Strict (StateT)
|
||||
|
||||
import Data.Monoid (Any(..))
|
||||
import Data.Maybe (fromJust)
|
||||
import qualified Data.Maybe
|
||||
import qualified Data.Text as Text
|
||||
@ -106,9 +107,12 @@ getSubmissionOwnR tid ssh csh shn = do
|
||||
|
||||
submissionHelper :: TermId -> SchoolId -> CourseShorthand -> SheetName -> SubmissionMode -> Handler Html
|
||||
submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
|
||||
uid <- requireAuthId
|
||||
msmid <- traverse decrypt mcid
|
||||
(Entity shid Sheet{..}, buddies, lastEdits, lastEditsUser) <- runDB $ do
|
||||
uid <- requireAuthId
|
||||
msmid <- traverse decrypt mcid
|
||||
actionUrl <- Data.Maybe.fromJust <$> getCurrentRoute
|
||||
maySubmit <- (== Authorized) <$> isAuthorized actionUrl True -- affects visibility of Edit-Dates, Submission-Button, etc.
|
||||
|
||||
(Entity shid Sheet{..}, buddies, lastEdits) <- runDB $ do
|
||||
sheet@(Entity shid Sheet{..}) <- fetchSheet tid ssh csh shn
|
||||
case msmid of
|
||||
Nothing -> do
|
||||
@ -136,7 +140,7 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
|
||||
E.&&. submissionUser E.^. SubmissionUserUser E.!=. E.val uid
|
||||
E.orderBy [E.asc $ user E.^. UserEmail]
|
||||
return $ user E.^. UserEmail
|
||||
return (sheet,buddies,[],[])
|
||||
return (sheet, map E.unValue buddies, [])
|
||||
(E.Value smid:_) -> do
|
||||
cID <- encrypt smid
|
||||
addMessageI "info" $ MsgSubmissionAlreadyExists
|
||||
@ -146,30 +150,31 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
|
||||
|
||||
shid' <- submissionSheet <$> get404 smid
|
||||
-- fetch buddies from current submission
|
||||
buddies <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
|
||||
E.on (submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId)
|
||||
E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val smid
|
||||
E.&&. submissionUser E.^. SubmissionUserUser E.!=. E.val uid
|
||||
E.orderBy [E.asc $ user E.^. UserEmail]
|
||||
return $ user E.^. UserEmail
|
||||
-- mLastEdit <- selectFirst [SubmissionEditSubmission ==. smid] [Desc SubmissionEditTime]
|
||||
lastEditValues <- E.select . E.from $ \(user `E.InnerJoin` submissionEdit) -> do
|
||||
E.on (user E.^. UserId E.==. submissionEdit E.^. SubmissionEditUser)
|
||||
E.where_ $ submissionEdit E.^. SubmissionEditSubmission E.==. E.val smid
|
||||
E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime]
|
||||
-- E.limit numberOfSubmissionEditDates -- DEPRECATED we shall show all edits
|
||||
return $ (user E.^. UserDisplayName, submissionEdit E.^. SubmissionEditTime)
|
||||
lastEdits <- forM lastEditValues $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time
|
||||
lastEditUserValues <- E.select . E.from $ \(submissionEdit) -> do
|
||||
E.where_ $ submissionEdit E.^. SubmissionEditSubmission E.==. E.val smid
|
||||
E.&&. submissionEdit E.^. SubmissionEditUser E.==. E.val uid
|
||||
E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime]
|
||||
E.limit 1
|
||||
return $ submissionEdit E.^. SubmissionEditTime
|
||||
lastEditsUser <- forM lastEditUserValues $ \(E.Value time) -> formatTime SelFormatDateTime time
|
||||
return (sheet,buddies,lastEdits,lastEditsUser)
|
||||
(Any isOwner, buddies) <- do
|
||||
submittors <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do
|
||||
E.on (submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId)
|
||||
E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val smid
|
||||
E.orderBy [E.asc $ user E.^. UserEmail]
|
||||
return $ (user E.^. UserId, user E.^. UserEmail)
|
||||
let breakUserFromBuddies (E.Value userID, E.Value email)
|
||||
| uid == userID = (Any True , [])
|
||||
| otherwise = (Any False, [email])
|
||||
return $ foldMap breakUserFromBuddies submittors
|
||||
|
||||
lastEdits <- do
|
||||
raw <- E.select . E.from $ \(user `E.InnerJoin` submissionEdit) -> do
|
||||
E.on (user E.^. UserId E.==. submissionEdit E.^. SubmissionEditUser)
|
||||
E.where_ $ submissionEdit E.^. SubmissionEditSubmission E.==. E.val smid
|
||||
E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime]
|
||||
-- E.limit numberOfSubmissionEditDates -- DEPRECATED we always show all edit times
|
||||
let userName = if maySubmit || isOwner
|
||||
then E.just $ user E.^. UserDisplayName
|
||||
else E.nothing
|
||||
return $ (userName, submissionEdit E.^. SubmissionEditTime)
|
||||
forM raw $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time
|
||||
return (sheet,buddies,lastEdits)
|
||||
let unpackZips = True -- undefined -- TODO
|
||||
((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm msmid unpackZips sheetGrouping $ map E.unValue buddies
|
||||
((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm msmid unpackZips sheetGrouping buddies
|
||||
mCID <- runDB $ do
|
||||
res' <- case res of
|
||||
(FormMissing ) -> return $ FormMissing
|
||||
@ -250,9 +255,6 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
|
||||
Just cID -> redirect $ CSubmissionR tid ssh csh shn cID SubShowR
|
||||
Nothing -> return ()
|
||||
|
||||
actionUrl <- Data.Maybe.fromJust <$> getCurrentRoute
|
||||
maySubmit <- (== Authorized) <$> isAuthorized actionUrl True
|
||||
|
||||
-- Maybe construct a table to display uploaded archive files
|
||||
let colonnadeFiles :: _ -> Colonnade Sortable _ (DBCell (HandlerT UniWorX IO) ())
|
||||
colonnadeFiles cid = mconcat
|
||||
@ -311,6 +313,8 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
|
||||
|
||||
defaultLayout $ do
|
||||
setTitleI $ MsgSubmissionEditHead tid ssh csh shn
|
||||
let urlArchive cID = CSubmissionR tid ssh csh shn cID (SubArchiveR (ZIPArchiveName SubmissionCorrected))
|
||||
urlOriginal cID = CSubmissionR tid ssh csh shn cID (SubArchiveR (ZIPArchiveName SubmissionOriginal))
|
||||
$(widgetFile "submission")
|
||||
|
||||
|
||||
|
||||
@ -19,6 +19,11 @@
|
||||
<div .container>
|
||||
^{enrolledCoursesTable}
|
||||
|
||||
<div .container>
|
||||
<h2> Noten
|
||||
<div .container>
|
||||
^{examTable}
|
||||
|
||||
<div .container>
|
||||
<h2> Übungsgruppen
|
||||
<div .container>
|
||||
@ -40,12 +45,7 @@
|
||||
<div .container>
|
||||
<h2> _{MsgCorrector}
|
||||
<div .container>
|
||||
^{correctorTable}
|
||||
|
||||
<div .container>
|
||||
<h2> Klausuren
|
||||
<div .container>
|
||||
^{examTable}
|
||||
^{correctionsTable}
|
||||
|
||||
<h2>
|
||||
<em> TODO: Knopf zum Löschen aller Daten erstellen
|
||||
|
||||
@ -1,8 +1,8 @@
|
||||
$maybe cID <- mcid
|
||||
<section>
|
||||
<h2>
|
||||
<a href=@{CSubmissionR tid ssh csh shn cID (SubArchiveR (ZIPArchiveName SubmissionCorrected))}>Archiv
|
||||
(<a href=@{CSubmissionR tid ssh csh shn cID (SubArchiveR (ZIPArchiveName SubmissionOriginal))}>Original</a>)
|
||||
<a href=@{urlArchive cID}>Archiv
|
||||
(<a href=@{urlOriginal cID}>Original</a>)
|
||||
|
||||
$maybe fileTable <- mFileTable
|
||||
<h3>_{MsgSubmissionFiles}
|
||||
@ -11,15 +11,11 @@ $maybe cID <- mcid
|
||||
$if not (null lastEdits)
|
||||
<h3>_{MsgLastEdits}
|
||||
<ul>
|
||||
$forall (name,time) <- lastEdits
|
||||
<li>_{MsgEditedBy name time}
|
||||
|
||||
_{MsgLastEditByUser}: #
|
||||
$if null lastEditsUser
|
||||
_{MsgNoEditByUser}
|
||||
$else
|
||||
$forall time <- lastEditsUser
|
||||
#{display time}
|
||||
$forall (mbName,time) <- lastEdits
|
||||
$maybe name <- mbName
|
||||
<li>_{MsgEditedBy name time}
|
||||
$nothing
|
||||
<li>#{display time}
|
||||
|
||||
|
||||
$if maySubmit
|
||||
|
||||
Loading…
Reference in New Issue
Block a user