Profile-Data: Submissions shown
This commit is contained in:
SJost
parent
f426739868
commit
c4c5a6b05c
@ -127,6 +127,7 @@ SubmissionArchive: Zip-Archiv der Abgabedatei(en)
|
||||
SubmissionFile: Datei zur Abgabe
|
||||
SubmissionFiles: Abgegebene Dateien
|
||||
SubmissionAlreadyExistsFor email@UserEmail: #{email} hat bereits eine Abgabe zu diesem bÜbungsblatt.
|
||||
SubmissionEditUser: Ihre letzte Bearbeitung
|
||||
|
||||
CorrectionsTitle: Zugewiesene Korrekturen
|
||||
CourseCorrectionsTitle: Korrekturen für diesen Kurs
|
||||
|
||||
@ -86,17 +86,17 @@ 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 csh = course ^. _2
|
||||
tid = course ^. _3
|
||||
let tid = course ^. _3
|
||||
ssh = course ^. _4
|
||||
csh = course ^. _2
|
||||
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 csh = course ^. _2
|
||||
tid = course ^. _3
|
||||
let tid = course ^. _3
|
||||
ssh = course ^. _4
|
||||
csh = course ^. _2
|
||||
shn = sheetName $ entityVal sheet
|
||||
in anchorCell (CSheetR tid ssh csh shn SShowR) [whamlet|#{display shn}|]
|
||||
|
||||
|
||||
@ -187,7 +187,7 @@ instance HasCourse a => HasCourse (DBRow a) where
|
||||
--
|
||||
|
||||
-- type CourseTableData = E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)
|
||||
-- NOTE: use procData instead as a flexible inlines Type signature
|
||||
-- NOTE: use withType instead as a flexible inlines Type signature
|
||||
|
||||
getProfileDataR :: Handler Html
|
||||
getProfileDataR = do
|
||||
@ -196,9 +196,9 @@ getProfileDataR = do
|
||||
|
||||
-- Tabelle mit eigenen Kursen
|
||||
ownCourseTable <- do -- TODO: only display when non-empty
|
||||
let procData :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Lecturer)) -> a)
|
||||
let withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Lecturer)) -> a)
|
||||
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Lecturer)) -> a)
|
||||
procData = id
|
||||
withType = id
|
||||
dbTableWidget' def $ DBTable
|
||||
{ dbtIdent = "courseOwnership" :: Text
|
||||
, dbtStyle = def
|
||||
@ -212,27 +212,27 @@ getProfileDataR = do
|
||||
)
|
||||
, dbtColonnade = mconcat
|
||||
[ colsCourseLink' $ _dbrOutput
|
||||
-- [ colsCourseLink $ (over each _unValue) . o_dbrOutput
|
||||
-- [ colsCourseLink $ (over each _unValue) . _dbrOutput -- different types in Tupel prevents "over each"
|
||||
]
|
||||
, dbtProj = return
|
||||
, dbtSorting = Map.fromList
|
||||
[ ( "course", SortColumn $ procData $ \(crse `E.InnerJoin` _) -> crse E.^. CourseShorthand)
|
||||
, ( "term" , SortColumn $ procData $ \(crse `E.InnerJoin` _) -> crse E.^. CourseTerm )
|
||||
, ( "school", SortColumn $ procData $ \(crse `E.InnerJoin` _) -> crse E.^. CourseSchool )
|
||||
[ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseShorthand)
|
||||
, ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseTerm )
|
||||
, ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseSchool )
|
||||
]
|
||||
, dbtFilter = Map.fromList
|
||||
[ ( "course", FilterColumn $ procData $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand)
|
||||
, ( "term", FilterColumn $ procData $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm )
|
||||
, ( "school", FilterColumn $ procData $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool )
|
||||
[ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand)
|
||||
, ( "term", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm )
|
||||
, ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool )
|
||||
]
|
||||
}
|
||||
|
||||
-- Tabelle mit allen Teilnehmer: Kurs (link), Datum
|
||||
courseTable <- do
|
||||
let
|
||||
procData :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a)
|
||||
withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a)
|
||||
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) -> a)
|
||||
procData = id
|
||||
withType = id
|
||||
|
||||
-- should be inlined
|
||||
-- courseCol :: IsDBTable m a => Colonnade Sortable (DBRow (Entity Course, E.Value UTCTime)) (DBCell m a)
|
||||
@ -262,15 +262,15 @@ getProfileDataR = do
|
||||
]
|
||||
, dbtProj = return
|
||||
, dbtSorting = Map.fromList
|
||||
[ ( "course", SortColumn $ procData $ \(crse `E.InnerJoin` _) -> crse E.^. CourseName )
|
||||
, ( "term" , SortColumn $ procData $ \(crse `E.InnerJoin` _) -> crse E.^. CourseTerm )
|
||||
, ( "school", SortColumn $ procData $ \(crse `E.InnerJoin` _) -> crse E.^. CourseSchool)
|
||||
[ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseName )
|
||||
, ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseTerm )
|
||||
, ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _) -> crse E.^. CourseSchool)
|
||||
, ( "time" , SortColumn $ \(_ `E.InnerJoin` participant) -> participant E.^. CourseParticipantRegistration)
|
||||
]
|
||||
, dbtFilter = Map.fromList
|
||||
[ ( "course", FilterColumn $ procData $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseName )
|
||||
, ( "term" , FilterColumn $ procData $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm )
|
||||
, ( "school", FilterColumn $ procData $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool)
|
||||
[ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseName )
|
||||
, ( "term" , FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm )
|
||||
, ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool)
|
||||
-- , ( "time" , FilterColumn $ \(_ `E.InnerJoin` part :: CourseTableData) -> emptyOrIn $ part E.^. CourseParticipantRegistration )
|
||||
]
|
||||
, dbtStyle = def
|
||||
@ -278,10 +278,76 @@ getProfileDataR = do
|
||||
|
||||
-- Tabelle mit allen Abgaben und Abgabe-Gruppen
|
||||
submissionTable <- do
|
||||
let procData :: ((_)->a)
|
||||
-> ((_)->a)
|
||||
procData = id
|
||||
return ()
|
||||
let withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)`E.InnerJoin` E.SqlExpr (Entity SubmissionUser) )->a)
|
||||
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)`E.InnerJoin` E.SqlExpr (Entity SubmissionUser) )->a)
|
||||
withType = id
|
||||
let 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")
|
||||
dbTableWidget' validator $ DBTable
|
||||
{ dbtIdent = "submissions" :: Text
|
||||
, dbtStyle = def
|
||||
, dbtSQLQuery = \(course `E.InnerJoin` sheet `E.InnerJoin` submission `E.InnerJoin` subUser) -> do
|
||||
E.on $ submission E.^. SubmissionId E.==. subUser E.^. SubmissionUserSubmission
|
||||
E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet
|
||||
E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
|
||||
E.where_ $ subUser E.^. SubmissionUserUser E.==. E.val uid
|
||||
let subEdit = E.sub_select . E.from $ \subEdit -> do
|
||||
E.where_ $ subEdit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId
|
||||
E.&&. subEdit E.^. SubmissionEditUser E.==. E.val uid
|
||||
return . E.max_ $ subEdit E.^. SubmissionEditTime
|
||||
let crse = ( course E.^. CourseTerm
|
||||
, course E.^. CourseSchool
|
||||
, course E.^. CourseId
|
||||
, course E.^. CourseShorthand
|
||||
)
|
||||
let sht = ( sheet E.^. SheetName
|
||||
)
|
||||
return (crse, sht, submission, subEdit)
|
||||
, dbtColonnade = mconcat
|
||||
[ colsCourseLink' $ _dbrOutput . _1
|
||||
, sortable (Just "sheet") (i18nCell MsgSheet) $ do
|
||||
shn <- view $ _dbrOutput . _2 . _unValue
|
||||
crse <- view $ _dbrOutput . _1
|
||||
let tid = crse ^. _1 . _unValue
|
||||
ssh = crse ^. _2 . _unValue
|
||||
csh = crse ^. _4 . _unValue
|
||||
link= CSheetR tid ssh csh shn SShowR
|
||||
return $ anchorCell link $ display2widget shn
|
||||
|
||||
, sortable (toNothing "submission") (i18nCell MsgSubmission) $ do
|
||||
shn <- view $ _dbrOutput . _2 . _unValue
|
||||
sid <- view $ _dbrOutput . _3 . _entityKey
|
||||
crse <- view $ _dbrOutput . _1
|
||||
let tid = crse ^. _1 . _unValue
|
||||
ssh = crse ^. _2 . _unValue
|
||||
csh = crse ^. _4 . _unValue
|
||||
mkCid = encrypt (sid :: SubmissionId) -- TODO: executed twice
|
||||
mkRoute = do
|
||||
cid <- mkCid
|
||||
return $ CSubmissionR tid ssh csh shn cid SubShowR
|
||||
return $ anchorCellM mkRoute (mkCid >>= \cid -> [whamlet|#{display cid}|])
|
||||
, sortable (const Nothing $ Just "edit") (i18nCell MsgSubmissionEditUser) $ do
|
||||
regTime <- view $ _dbrOutput . _4 . _unValue
|
||||
return $ maybe mempty timeCell regTime
|
||||
]
|
||||
, dbtProj = return
|
||||
, dbtSorting = Map.fromList
|
||||
[ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> crse E.^. CourseShorthand)
|
||||
, ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> crse E.^. CourseTerm )
|
||||
, ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> crse E.^. CourseSchool )
|
||||
-- , ( "time" , error "Time Sorting not yet supported") -- TODO
|
||||
, ( "sheet" , SortColumn $ withType $ \(_ `E.InnerJoin` sheet `E.InnerJoin` _ `E.InnerJoin` _) -> sheet E.^. SheetName )
|
||||
]
|
||||
, dbtFilter = Map.fromList
|
||||
[ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand)
|
||||
, ( "term", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm )
|
||||
, ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool )
|
||||
]
|
||||
}
|
||||
|
||||
-- Tabelle mit allen Abgabegruppen
|
||||
--TODO
|
||||
-- Tabelle mit allen Tutorials
|
||||
tutorialTable <- return [whamlet| TOOD: Tutorials anzeigen |] -- TODO
|
||||
-- Tabelle mit allen Korrektor-Aufgaben
|
||||
|
||||
10
src/Utils.hs
10
src/Utils.hs
@ -113,6 +113,9 @@ str2widget :: (MonadBaseControl IO m, MonadThrow m, MonadIO m) =>
|
||||
String -> WidgetT site m ()
|
||||
str2widget s = [whamlet|#{s}|]
|
||||
|
||||
display2widget :: (MonadBaseControl IO m, MonadThrow m, MonadIO m, DisplayAble a) =>
|
||||
a -> WidgetT site m ()
|
||||
display2widget = text2widget . display
|
||||
|
||||
withFragment :: ( Monad m
|
||||
) => MForm m (a, WidgetT site IO ()) -> Markup -> MForm m (a, WidgetT site IO ())
|
||||
@ -228,6 +231,9 @@ toMaybe :: Bool -> a -> Maybe a
|
||||
toMaybe True = Just
|
||||
toMaybe False = const Nothing
|
||||
|
||||
toNothing :: a -> Maybe b
|
||||
toNothing = const Nothing
|
||||
|
||||
maybeAdd :: Num a => Maybe a -> Maybe a -> Maybe a -- treats Nothing as neutral/zero, unlike fmap
|
||||
maybeAdd (Just x) (Just y) = Just (x + y)
|
||||
maybeAdd Nothing y = y
|
||||
@ -296,11 +302,11 @@ catchIfMExceptT err p act = catchIf p (lift act) (throwE <=< lift . err)
|
||||
------------
|
||||
|
||||
shortCircuitM :: Monad m => (a -> Bool) -> m a -> m a -> (a -> a -> a) -> m a
|
||||
shortCircuitM sc mx my op = do
|
||||
shortCircuitM sc mx my bop = do
|
||||
x <- mx
|
||||
case sc x of
|
||||
True -> return x
|
||||
False -> op <$> pure x <*> my
|
||||
False -> bop <$> pure x <*> my
|
||||
|
||||
|
||||
guardM :: MonadPlus m => m Bool -> m ()
|
||||
|
||||
@ -24,7 +24,15 @@
|
||||
^{tutorialTable}
|
||||
|
||||
<div .container>
|
||||
<h2> Korrekturen
|
||||
<h2> Abgaben
|
||||
<div .container>
|
||||
^{submissionTable}
|
||||
<em>Hinweis:
|
||||
Bei Gruppenabgaben wird kein Datum angezeigt,
|
||||
falls Sie die Gruppenabgabe nie selbst hochgeladen haben.
|
||||
|
||||
<div .container>
|
||||
<h2> _{MsgCorrector}
|
||||
<div .container>
|
||||
^{correctorTable}
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user