course user info shows study terms and matriclenr

This commit is contained in:
Steffen Jost 2019-03-22 18:40:59 +01:00
parent c9ab64e518
commit c2dc23c116
3 changed files with 56 additions and 12 deletions

View File

@ -51,7 +51,7 @@ CourseParticipant -- course enrolement
CourseUserNote -- lecturers of a specific course may share a text note on each enrolled student CourseUserNote -- lecturers of a specific course may share a text note on each enrolled student
course CourseId course CourseId
user UserId user UserId
note Text -- arbitrary user-defined text; visible only to lecturer of this course note Html -- arbitrary user-defined text; visible only to lecturer of this course
UniqueCourseUserNote user course UniqueCourseUserNote user course
CourseUserNoteEdit -- who edited a participants course note when CourseUserNoteEdit -- who edited a participants course note when
user UserId user UserId

View File

@ -29,6 +29,7 @@ import qualified Data.Map as Map
import qualified Database.Esqueleto as E import qualified Database.Esqueleto as E
import Text.Blaze.Html.Renderer.Text (renderHtml)
-- NOTE: Outdated way to use dbTable; see ProfileDataR Handler for a more recent method. -- NOTE: Outdated way to use dbTable; see ProfileDataR Handler for a more recent method.
type CourseTableData = DBRow (Entity Course, Int, Bool, Entity School) type CourseTableData = DBRow (Entity Course, Int, Bool, Entity School)
@ -835,9 +836,11 @@ postCUserR tid ssh csh uCId = do
dozentId <- requireAuthId dozentId <- requireAuthId
uid <- decrypt uCId uid <- decrypt uCId
-- DB reads -- DB reads
(cid, User{..}, thisUniqueNote, noteText, noteEdits ) <- runDB $ do (cid, User{..}, thisUniqueNote, noteText, noteEdits, studies ) <- runDB $ do
cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
-- Abfrage Benutzerdaten
user <- get404 uid user <- get404 uid
-- Abfrage Teilnehmernotiz
let thisUniqueNote = UniqueCourseUserNote uid cid let thisUniqueNote = UniqueCourseUserNote uid cid
mbNoteEnt <- getBy thisUniqueNote mbNoteEnt <- getBy thisUniqueNote
(noteText,noteEdits) <- case mbNoteEnt of (noteText,noteEdits) <- case mbNoteEnt of
@ -850,7 +853,14 @@ postCUserR tid ssh csh uCId = do
E.limit 1 -- more will be shown, if changed here E.limit 1 -- more will be shown, if changed here
return (edit E.^. CourseUserNoteEditTime, usr E.^. UserEmail, usr E.^. UserDisplayName, usr E.^. UserSurname) return (edit E.^. CourseUserNoteEditTime, usr E.^. UserEmail, usr E.^. UserDisplayName, usr E.^. UserSurname)
return (Just courseUserNoteNote, $(unValueN 4) <$> noteEdits) return (Just courseUserNoteNote, $(unValueN 4) <$> noteEdits)
return (cid,user,thisUniqueNote,noteText,noteEdits) -- Abfrage Studiengänge
studies <- E.select $ E.from $ \(studydegree `E.InnerJoin` studyfeat `E.InnerJoin` studyterms) -> do
E.where_ $ studyfeat E.^. StudyFeaturesUser E.==. E.val uid
E.on $ studyfeat E.^. StudyFeaturesField E.==. studyterms E.^. StudyTermsId
E.on $ studyfeat E.^. StudyFeaturesDegree E.==. studydegree E.^. StudyDegreeId
return (studyfeat, studydegree, studyterms)
return (cid,user,thisUniqueNote,noteText,noteEdits,studies)
let editByWgt = [whamlet| let editByWgt = [whamlet|
$forall (etime,_eemail,ename,_esurname) <- noteEdits $forall (etime,_eemail,ename,_esurname) <- noteEdits
<br> <br>
@ -858,32 +868,67 @@ postCUserR tid ssh csh uCId = do
|] -- _{MsgLastEdit} ^{formatTimeW SelFormatDateTime etime} ^{nameWidget ename esurname} |] -- _{MsgLastEdit} ^{formatTimeW SelFormatDateTime etime} ^{nameWidget ename esurname}
((noteRes, noteView), noteEnctype) <- runFormPost . identifyForm FIDcUserNote . renderAForm FormStandard $ ((noteRes, noteView), noteEnctype) <- runFormPost . identifyForm FIDcUserNote . renderAForm FormStandard $
(aopt (annotateField editByWgt textField) (fslpI MsgCourseUserNote "Text" & setTooltip MsgCourseUserNoteTooltip) $ Just noteText) (aopt (annotateField editByWgt htmlField') (fslpI MsgCourseUserNote "Html" & setTooltip MsgCourseUserNoteTooltip) $ Just noteText)
<* submitButton <* submitButton
formResult noteRes $ \mbNote -> (do formResult noteRes $ \mbNote -> (do
let note = foldMap id mbNote -- Maybe Text to maybe empty Text
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
if null note case mbNote of
then do Nothing -> do
runDB $ do runDB $ do
-- must delete all edits due to foreign key constraints, which does not make sense -> refactor! -- must delete all edits due to foreign key constraints, which does not make sense -> refactor!
maybeM (return ()) (\nk -> deleteWhere [CourseUserNoteEditNote ==. nk]) (getKeyBy thisUniqueNote) maybeM (return ()) (\nk -> deleteWhere [CourseUserNoteEditNote ==. nk]) (getKeyBy thisUniqueNote)
deleteBy thisUniqueNote deleteBy thisUniqueNote
addMessageI Info MsgCourseUserNoteDeleted addMessageI Info MsgCourseUserNoteDeleted
else do redirect currentRoute -- reload page after post
_ | (renderHtml <$> mbNote) == (renderHtml <$> noteText) -> return() -- no changes
(Just note) -> do
runDB $ do runDB $ do
(Entity noteKey _) <- upsertBy thisUniqueNote (CourseUserNote cid uid note) [CourseUserNoteNote =. note] (Entity noteKey _) <- upsertBy thisUniqueNote (CourseUserNote cid uid note) [CourseUserNoteNote =. note]
void . insert $ CourseUserNoteEdit dozentId now noteKey void . insert $ CourseUserNoteEdit dozentId now noteKey
addMessageI Success MsgCourseUserNoteSaved addMessageI Success MsgCourseUserNoteSaved
redirect currentRoute -- reload page after post
) )
-- USE src/utils/Form.formResult -- USE src/utils/Form.formResult
defaultLayout -- TODO defaultLayout -- TODO
[whamlet| [whamlet|
<h2>^{nameWidget userDisplayName userSurname} <h2>^{nameWidget userDisplayName userSurname}
#{mailtoHtml userEmail} <section>
<div .profile>
<dl .deflist.profile-dl>
<dt .deflist__dt> _{MsgEMail}
<dd .deflist__dd> #{mailtoHtml userEmail}
<dt .deflist__dt> _{MsgMatrikelNr}
<dd .deflist__dd>
$maybe matnr <- userMatrikelnummer
#{matnr}
$nothing
Keine eingetragene Matrikelnummer
<dt .deflist__dt> Studiengänge
<dd .deflist__dd>
$if null studies
Nicht eingeschrieben
$else
<div .scrolltable>
<table .table.table--striped.table--hover.table--condensed>
<tr .table__row>
<th .table__th> Studiengang
<th .table__th> Abschluss
<th .table__th> Studienart
<th .table__th> Semester
<th .table__th> Aktiv
<th .table__th> Update
$forall ((Entity _ StudyFeatures{..}), (Entity _ degree), (Entity _ field)) <- studies
$with _ <- notUsedT studyFeaturesUser
<tr.table__row>
<td .table__td>_{field}#{notUsedT studyFeaturesField}
<td .table__td>_{degree}#{notUsedT studyFeaturesDegree}
<td .table__td>_{studyFeaturesType}
<td .table__td>#{display studyFeaturesSemester}
<td .table__td>#{hasTickmark studyFeaturesValid}
<td .table__td>^{formatTimeW SelFormatDate studyFeaturesUpdated}
<section> <section>
<a id="note-form"> <a id="note-form">
<form method=post action=@{currentRoute}#note-form enctype=#{noteEnctype}> <form method=post action=@{currentRoute}#note-form enctype=#{noteEnctype}>

View File

@ -7,7 +7,7 @@
<dt .deflist__dt> _{MsgMatrikelNr} <dt .deflist__dt> _{MsgMatrikelNr}
<dd .deflist__dd> #{matnr} <dd .deflist__dd> #{matnr}
<dt .deflist__dt> _{MsgEMail} <dt .deflist__dt> _{MsgEMail}
<dd .deflist__dd> #{display userEmail} <dd .deflist__dd> #{mailtoHtml userEmail}
<dt .deflist__dt> _{MsgIdent} <dt .deflist__dt> _{MsgIdent}
<dd .deflist__dd> #{display userIdent} <dd .deflist__dd> #{display userIdent}
<dt .deflist__dt> _{MsgLastLogin} <dt .deflist__dt> _{MsgLastLogin}
@ -52,7 +52,6 @@
<th .table__th> Aktiv <th .table__th> Aktiv
<th .table__th> Update <th .table__th> Update
$forall ((Entity _ StudyFeatures{..}), (Entity _ degree), (Entity _ field)) <- studies $forall ((Entity _ StudyFeatures{..}), (Entity _ degree), (Entity _ field)) <- studies
$with _ <- notUsedT studyFeaturesUser $with _ <- notUsedT studyFeaturesUser
<tr.table__row> <tr.table__row>