Gregor Kleen
parent
0b3c88407b
commit
ced6ef2874
5
.dir-locals.el
Normal file
5
.dir-locals.el
Normal file
@ -0,0 +1,5 @@
|
||||
;;; Directory Local Variables
|
||||
;;; For more information see (info "(emacs) Directory Variables")
|
||||
|
||||
((nil
|
||||
(indent-tabs-mode)))
|
||||
@ -155,7 +155,7 @@ export class Alerts {
|
||||
alertCloser.classList.add(ALERT_CLOSER_CLASS);
|
||||
|
||||
const alertIcon = document.createElement('div');
|
||||
alertIcon.classList.add(ALERT_ICON_CLASS, 'fas', 'fa-fw', 'fa-' + icon);
|
||||
alertIcon.classList.add(ALERT_ICON_CLASS, 'fas', 'fa-' + icon);
|
||||
|
||||
const alertContent = document.createElement('div');
|
||||
alertContent.classList.add(ALERT_CONTENT_CLASS);
|
||||
|
||||
@ -166,6 +166,9 @@ CourseUserTutorial: Angemeldetes Tutorium
|
||||
CourseUserTutorials: Angemeldete Tutorien
|
||||
CourseUserExam: Angemeldete Prüfung
|
||||
CourseUserExams: Angemeldete Prüfungen
|
||||
CourseSingleUserExams: Prüfungen
|
||||
CourseSingleUserTutorials: Tutorien
|
||||
CourseUserCorrections: Abgaben
|
||||
CourseUserNote: Notiz
|
||||
CourseUserNoteTooltip: Nur für Verwalter dieses Kurses einsehbar
|
||||
CourseUserNoteSaved: Notizänderungen gespeichert
|
||||
@ -533,6 +536,9 @@ CloseAlert: Schliessen
|
||||
|
||||
Name: Name
|
||||
MatrikelNr: Matrikelnummer
|
||||
Surname: Nachname(n)
|
||||
FirstName: Vorname(n)
|
||||
Title: Titel
|
||||
LdapSynced: LDAP-Synchronisiert
|
||||
LdapSyncedBefore: Letzte LDAP-Synchronisation vor
|
||||
NoMatrikelKnown: Keine Matrikelnummer
|
||||
@ -1710,6 +1716,7 @@ ExamRegistered: Zur Prüfung angemeldet
|
||||
ExamNotRegistered: Nicht zur Prüfung angemeldet
|
||||
ExamRegistration: Prüfungsanmeldung
|
||||
ExamLoginToRegister: Um sich zum Kurs anzumelden müssen Sie zunächst in Uni2work anmelden
|
||||
ExamRegistrationTime: Angemeldet seit
|
||||
|
||||
ExamRegisterToMustBeAfterRegisterFrom: "Anmeldung ab" muss vor "Anmeldung bis" liegen
|
||||
ExamDeregisterUntilMustBeAfterRegisterFrom: "Abmeldung bis" muss nach "Anmeldung bis" liegen
|
||||
@ -1749,6 +1756,12 @@ ExamUsersResultsReset count@Int64: Prüfungsergebnis für #{show count} Teilnehm
|
||||
ExamUsersPartResultsSet count@Int64: Teilprüfungsergebnis für #{show count} Teilnehmer angepasst
|
||||
ExamUsersBonusSet count@Int64: Bonuspunkte für #{show count} Teilnehmer angepasst
|
||||
ExamUsersResultSet count@Int64: Prüfungsergebnis für #{show count} Teilnehmer angepasst
|
||||
CourseUserTutorialsDeregistered count@Int64: Teilnehmer von #{show count} #{pluralDE count "Tutorium" "Tutorien"} abgemeldet
|
||||
CourseUserNoTutorialsDeregistered: Teilnehmer ist zu keinem der gewählten Tutorien angemeldet
|
||||
CourseUserExamsDeregistered count@Int64: Teilnehmer von #{show count} #{pluralDE count "Prüfung" "Prüfungen"} abgemeldet
|
||||
CourseUserNoExamsDeregistered: Teilnehmer ist zu keiner der gewählten Prüfungen angemeldet
|
||||
CourseUserExamsResultSet count@Int64: Ergebnis zu #{show count} #{pluralDE count "Prüfung" "Prüfungen"} erfolgreich angepasst
|
||||
CourseUserExamResultDoesNotMatchMode examn@ExamName: Gewähtes Ergebnis passt nicht zu Bewertungsmodus von Prüfung „#{examn}“.
|
||||
|
||||
ExamUserSynchronised: Synchronisiert
|
||||
ExamUserSyncOfficeName: Name
|
||||
|
||||
@ -8,6 +8,11 @@ module Handler.Corrections
|
||||
, getCorrectionsGradeR, postCorrectionsGradeR
|
||||
, getCAssignR, postCAssignR
|
||||
, getSAssignR, postSAssignR
|
||||
, correctionsR'
|
||||
, ratedBy, courseIs, sheetIs, userIs
|
||||
, colTerm, colSchool, colCourse, colSheet, colCorrector, colSubmissionLink, colSelect, colSubmittors, colSMatrikel, colRating, colAssigned, colRated, colPseudonyms, colRatedField, colPointsField, colMaxPointsField, colCommentField, colLastEdit
|
||||
, makeCorrectionsTable
|
||||
, ActionCorrections(..), downloadAction, deleteAction, assignAction, autoAssignAction
|
||||
) where
|
||||
|
||||
import Import hiding (link)
|
||||
@ -94,6 +99,12 @@ courseIs cid (( course `E.InnerJoin` _sheet `E.InnerJoin` _submission) `E.LeftO
|
||||
sheetIs :: Key Sheet -> CorrectionTableWhere
|
||||
sheetIs shid ((_course `E.InnerJoin` sheet `E.InnerJoin` _submission) `E.LeftOuterJoin` _corrector) = sheet E.^. SheetId E.==. E.val shid
|
||||
|
||||
userIs :: Key User -> CorrectionTableWhere
|
||||
userIs uid ((_course `E.InnerJoin` _sheet `E.InnerJoin` submission) `E.LeftOuterJoin` _corrector) = E.exists . E.from $ \submissionUser ->
|
||||
E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId
|
||||
E.&&. submissionUser E.^. SubmissionUserUser E.==. E.val uid
|
||||
|
||||
|
||||
|
||||
-- Columns
|
||||
colTerm :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a)
|
||||
@ -417,6 +428,14 @@ data ActionCorrectionsData = CorrDownloadData
|
||||
|
||||
correctionsR :: _ -> _ -> _ -> _ -> Map ActionCorrections (AForm (HandlerFor UniWorX) ActionCorrectionsData) -> Handler TypedContent
|
||||
correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do
|
||||
(table, statistics) <- correctionsR' whereClause displayColumns dbtFilterUI psValidator actions
|
||||
|
||||
fmap toTypedContent . defaultLayout $ do
|
||||
setTitleI MsgCourseCorrectionsTitle
|
||||
$(widgetFile "corrections")
|
||||
|
||||
correctionsR' :: _ -> _ -> _ -> _ -> Map ActionCorrections (AForm (HandlerFor UniWorX) ActionCorrectionsData) -> Handler (Widget, SheetTypeSummary)
|
||||
correctionsR' whereClause displayColumns dbtFilterUI psValidator actions = do
|
||||
currentRoute <- fromMaybe (error "correctionsR called from 404-handler") <$> getCurrentRoute -- This should never be called from a 404 handler
|
||||
|
||||
postDeleteR $ \drRecords -> (submissionDeleteRoute drRecords)
|
||||
@ -450,14 +469,12 @@ correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do
|
||||
& mapped._1 %~ fromMaybe (error "By consctruction the form should always return an action") . getLast
|
||||
auditAllSubEdit = mapM_ $ \sId -> getJust sId >>= \sub -> audit $ TransactionSubmissionEdit sId $ sub ^. _submissionSheet
|
||||
|
||||
case actionRes of
|
||||
FormFailure errs -> mapM_ (addMessage Warning . toHtml) errs
|
||||
FormMissing -> return ()
|
||||
FormSuccess (CorrDownloadData, subs) -> do
|
||||
formResult actionRes $ \case
|
||||
(CorrDownloadData, subs) -> do
|
||||
ids <- Set.fromList <$> forM (Set.toList subs) decrypt -- Set is not traversable
|
||||
addHeader "Content-Disposition" [st|attachment; filename="corrections.zip"|]
|
||||
sendResponse =<< submissionMultiArchive ids
|
||||
FormSuccess (CorrSetCorrectorData (Just uid), subs') -> do
|
||||
(CorrSetCorrectorData (Just uid), subs') -> do
|
||||
subs <- mapM decrypt $ Set.toList subs'
|
||||
now <- liftIO getCurrentTime
|
||||
runDB $ do
|
||||
@ -490,7 +507,7 @@ correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do
|
||||
return (E.countRows :: E.SqlExpr (E.Value Int64))
|
||||
when (selfCorrectors > 0) $ addMessageI Warning $ MsgSelfCorrectors selfCorrectors
|
||||
redirect currentRoute
|
||||
FormSuccess (CorrSetCorrectorData Nothing, subs') -> do -- delete corrections
|
||||
(CorrSetCorrectorData Nothing, subs') -> do -- delete corrections
|
||||
subs <- mapM decrypt $ Set.toList subs'
|
||||
runDB $ do
|
||||
num <- updateWhereCount [SubmissionId <-. subs]
|
||||
@ -503,7 +520,7 @@ correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do
|
||||
addMessageI Success $ MsgRemovedCorrections num
|
||||
auditAllSubEdit subs
|
||||
redirect currentRoute
|
||||
FormSuccess (CorrAutoSetCorrectorData shid, subs') -> do
|
||||
(CorrAutoSetCorrectorData shid, subs') -> do
|
||||
subs <- mapM decrypt $ Set.toList subs'
|
||||
let
|
||||
assignExceptions :: AssignSubmissionException -> Handler ()
|
||||
@ -540,16 +557,14 @@ correctionsR whereClause displayColumns dbtFilterUI psValidator actions = do
|
||||
unassigned' <- forM (Set.toList stillUnassigned) $ \sid -> encrypt sid :: DB CryptoFileNameSubmission
|
||||
addMessage Warning =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsNotAssignedAuto.hamlet") mr)
|
||||
redirect currentRoute
|
||||
FormSuccess (CorrDeleteData, subs) -> do
|
||||
(CorrDeleteData, subs) -> do
|
||||
subs' <- Set.fromList <$> forM (Set.toList subs) decrypt -- Set is not traversable
|
||||
getDeleteR (submissionDeleteRoute subs')
|
||||
{ drAbort = SomeRoute currentRoute
|
||||
, drSuccess = SomeRoute currentRoute
|
||||
}
|
||||
|
||||
fmap toTypedContent . defaultLayout $ do
|
||||
setTitleI MsgCourseCorrectionsTitle
|
||||
$(widgetFile "corrections")
|
||||
return (table, statistics)
|
||||
|
||||
where
|
||||
authorizedToAssign :: SubmissionId -> DB Bool
|
||||
|
||||
@ -127,7 +127,7 @@ getCShowR tid ssh csh = do
|
||||
dbtColonnade = dbColonnade $ mconcat
|
||||
[ sortable (Just "type") (i18nCell MsgTutorialType) $ \DBRow{ dbrOutput = Entity _ Tutorial{..} } -> textCell $ CI.original tutorialType
|
||||
, sortable (Just "name") (i18nCell MsgTutorialName) $ \DBRow{ dbrOutput = Entity _ Tutorial{..} } -> indicatorCell <> anchorCell (CTutorialR tid ssh csh tutorialName TUsersR) [whamlet|#{tutorialName}|]
|
||||
, sortable Nothing (i18nCell MsgTutorialTutors) $ \DBRow{ dbrOutput = Entity tutid _ } -> sqlCell $ do
|
||||
, sortable (Just "tutors") (i18nCell MsgTutorialTutors) $ \DBRow{ dbrOutput = Entity tutid _ } -> sqlCell $ do
|
||||
tutTutors <- fmap (map $(unValueN 3)) . E.select . E.from $ \(tutor `E.InnerJoin` user) -> do
|
||||
E.on $ tutor E.^. TutorUser E.==. user E.^. UserId
|
||||
E.where_ $ tutor E.^. TutorTutorial E.==. E.val tutid
|
||||
@ -176,6 +176,12 @@ getCShowR tid ssh csh = do
|
||||
, ("register-from", SortColumn $ \tutorial -> tutorial E.^. TutorialRegisterFrom )
|
||||
, ("register-to", SortColumn $ \tutorial -> tutorial E.^. TutorialRegisterTo )
|
||||
, ("deregister-until", SortColumn $ \tutorial -> tutorial E.^. TutorialDeregisterUntil )
|
||||
, ( "tutors"
|
||||
, SortColumn $ \tutorial -> E.subSelectMaybe . E.from $ \(tutor `E.InnerJoin` user) -> do
|
||||
E.on $ tutor E.^. TutorUser E.==. user E.^. UserId
|
||||
E.where_ $ tutorial E.^. TutorialId E.==. tutor E.^. TutorTutorial
|
||||
return . E.min_ $ user E.^. UserSurname
|
||||
)
|
||||
]
|
||||
dbtFilter = Map.empty
|
||||
dbtFilterUI = const mempty
|
||||
|
||||
@ -6,9 +6,13 @@ import Import
|
||||
|
||||
import Utils.Form
|
||||
import Handler.Utils
|
||||
import Handler.Utils.SheetType
|
||||
import Database.Esqueleto.Utils.TH
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
import qualified Database.Esqueleto.Utils as E
|
||||
|
||||
import Database.Persist.Sql (deleteWhereCount)
|
||||
|
||||
import Text.Blaze.Html.Renderer.Text (renderHtml)
|
||||
|
||||
@ -16,6 +20,31 @@ import Handler.Course.Register
|
||||
|
||||
import Jobs.Queue
|
||||
|
||||
import Handler.Corrections
|
||||
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
|
||||
data ExamAction = ExamDeregister
|
||||
| ExamSetResult
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
|
||||
deriving anyclass (Universe, Finite)
|
||||
nullaryPathPiece ''ExamAction $ camelToPathPiece' 1
|
||||
embedRenderMessage ''UniWorX ''ExamAction $ Text.replace "Exam" "ExamUser"
|
||||
|
||||
data ExamActionData = ExamDeregisterData
|
||||
| ExamSetResultData (Maybe ExamResultPassedGrade)
|
||||
|
||||
data TutorialAction = TutorialDeregister
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
|
||||
deriving anyclass (Universe, Finite)
|
||||
nullaryPathPiece ''TutorialAction $ camelToPathPiece' 1
|
||||
embedRenderMessage ''UniWorX ''TutorialAction $ Text.replace "Tutorial" "TutorialUser"
|
||||
|
||||
data TutorialActionData = TutorialDeregisterData
|
||||
|
||||
|
||||
getCUserR, postCUserR :: TermId -> SchoolId -> CourseShorthand -> CryptoUUIDUser -> Handler Html
|
||||
getCUserR = postCUserR
|
||||
@ -33,6 +62,9 @@ postCUserR tid ssh csh uCId = do
|
||||
sections <- mapM (runMaybeT . ($ user) . ($ course))
|
||||
[ courseUserProfileSection
|
||||
, courseUserNoteSection
|
||||
, courseUserExamsSection
|
||||
, courseUserTutorialsSection
|
||||
, courseUserSubmissionsSection
|
||||
]
|
||||
|
||||
-- generate output
|
||||
@ -208,3 +240,280 @@ courseUserNoteSection (Entity cid _) (Entity uid _) = do
|
||||
redirect $ currentRoute :#: noteFrag -- reload page after post
|
||||
|
||||
return $(widgetFile "course/user/note")
|
||||
|
||||
|
||||
courseUserSubmissionsSection :: Entity Course -> Entity User -> MaybeT Handler Widget
|
||||
courseUserSubmissionsSection (Entity cid _) (Entity uid _) = do
|
||||
let whereClause = (E.&&.) <$> courseIs cid <*> userIs uid
|
||||
colonnade = mconcat -- should match getSSubsR for consistent UX
|
||||
[ colSelect
|
||||
, colSheet
|
||||
, colSMatrikel
|
||||
, colSubmittors
|
||||
, colSubmissionLink
|
||||
, colLastEdit
|
||||
, colRating
|
||||
, colRated
|
||||
, colCorrector
|
||||
, colAssigned
|
||||
] -- Continue here
|
||||
filterUI = Just $ \mPrev -> mconcat
|
||||
[ prismAForm (singletonFilter "user-name-email") mPrev $ aopt textField (fslI MsgCourseMembers)
|
||||
, prismAForm (singletonFilter "user-matriclenumber") mPrev $ aopt textField (fslI MsgMatrikelNr)
|
||||
-- "pseudonym" TODO DB only stores Word24
|
||||
, Map.singleton "sheet-search" . maybeToList <$> aopt textField (fslI MsgSheet) (Just <$> listToMaybe =<< ((Map.lookup "sheet-search" =<< mPrev) <|> (Map.lookup "sheet" =<< mPrev)))
|
||||
, prismAForm (singletonFilter "corrector-name-email") mPrev $ aopt textField (fslI MsgCorrector)
|
||||
, prismAForm (singletonFilter "isassigned" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgHasCorrector)
|
||||
, prismAForm (singletonFilter "israted" . maybePrism _PathPiece) mPrev $ aopt (boolField . Just $ SomeMessage MsgBoolIrrelevant) (fslI MsgRatingTime)
|
||||
, prismAForm (singletonFilter "submission") mPrev $ aopt (lift `hoistField` textField) (fslI MsgSubmission)
|
||||
]
|
||||
psValidator = def & defaultPagesize PagesizeAll -- Assisstant always want to see them all at once anyway
|
||||
(cWdgt, statistics) <- lift . correctionsR' whereClause colonnade filterUI psValidator $ Map.fromList
|
||||
[ downloadAction
|
||||
, assignAction (Left cid)
|
||||
, deleteAction
|
||||
]
|
||||
|
||||
guard $ statistics /= mempty
|
||||
|
||||
return $(widgetFile "course/user/corrections")
|
||||
|
||||
|
||||
courseUserExamsSection :: Entity Course -> Entity User -> MaybeT Handler Widget
|
||||
courseUserExamsSection (Entity cid Course{..}) (Entity uid _) = do
|
||||
uCID <- encrypt uid
|
||||
|
||||
let
|
||||
examDBTable = DBTable{..}
|
||||
where
|
||||
dbtSQLQuery exam = do
|
||||
E.where_ $ exam E.^. ExamCourse E.==. E.val cid
|
||||
E.where_ $ E.or
|
||||
[ E.exists . E.from $ \examRegistration ->
|
||||
E.where_ $ examRegistration E.^. ExamRegistrationUser E.==. E.val uid
|
||||
E.&&. examRegistration E.^. ExamRegistrationExam E.==. exam E.^. ExamId
|
||||
, E.exists . E.from $ \(examPart `E.InnerJoin` examPartResult) -> do
|
||||
E.on $ examPart E.^. ExamPartId E.==. examPartResult E.^. ExamPartResultExamPart
|
||||
E.where_ $ examPartResult E.^. ExamPartResultUser E.==. E.val uid
|
||||
E.&&. examPart E.^. ExamPartExam E.==. exam E.^. ExamId
|
||||
, E.exists . E.from $ \examBonus ->
|
||||
E.where_ $ examBonus E.^. ExamBonusUser E.==. E.val uid
|
||||
E.&&. examBonus E.^. ExamBonusExam E.==. exam E.^. ExamId
|
||||
, E.exists . E.from $ \examResult ->
|
||||
E.where_ $ examResult E.^. ExamResultUser E.==. E.val uid
|
||||
E.&&. examResult E.^. ExamResultExam E.==. exam E.^. ExamId
|
||||
]
|
||||
return exam
|
||||
dbtRowKey = (E.^. ExamId)
|
||||
dbtProj = traverse $ \exam@(Entity eId _) -> do
|
||||
registration <- getBy $ UniqueExamRegistration eId uid
|
||||
occurrence <- runMaybeT $ do
|
||||
Entity _ ExamRegistration{..} <- hoistMaybe registration
|
||||
occId <- hoistMaybe examRegistrationOccurrence
|
||||
MaybeT $ getEntity occId
|
||||
bonus <- getBy $ UniqueExamBonus eId uid
|
||||
result <- getBy $ UniqueExamResult eId uid
|
||||
|
||||
return ( exam
|
||||
, occurrence
|
||||
, bonus
|
||||
, result
|
||||
, registration
|
||||
)
|
||||
dbtColonnade = mconcat
|
||||
[ dbSelect (_2 . applying _2) _1 $ return . view (_dbrOutput . _1 . _entityKey)
|
||||
, sortable (Just "name") (i18nCell MsgExamName) $ tellCell (Any True, mempty) . anchorCell' (\(view $ _dbrOutput . _1 . _entityVal -> Exam{..}) -> CExamR courseTerm courseSchool courseShorthand examName EShowR) (view $ _dbrOutput . _1 . _entityVal . _examName)
|
||||
, sortable (Just "occurrence") (i18nCell MsgExamOccurrence) $ maybe mempty (cell . toWidget) . preview (_dbrOutput . _2 . _Just . _entityVal . _examOccurrenceName)
|
||||
, sortable (Just "registration-time") (i18nCell MsgExamRegistrationTime) $ maybe mempty (cell . formatTimeW SelFormatDateTime) . preview (_dbrOutput . _5 . _Just . _entityVal . _examRegistrationTime)
|
||||
, sortable (Just "bonus") (i18nCell MsgExamBonusAchieved) $ maybe mempty i18nCell . preview (_dbrOutput . _3 . _Just . _entityVal . _examBonusBonus)
|
||||
, sortable (Just "result") (i18nCell MsgExamResult) $ maybe mempty i18nCell . preview (_dbrOutput . _4 . _Just . _entityVal . _examResultResult)
|
||||
]
|
||||
dbtSorting = mconcat
|
||||
[ singletonMap "name" . SortColumn $ \exam -> exam E.^. ExamName
|
||||
, singletonMap "occurrence" . SortColumn $ \exam -> E.subSelectMaybe . E.from $ \(examOccurrence `E.InnerJoin` examRegistration) -> do
|
||||
E.on $ examRegistration E.^. ExamRegistrationOccurrence E.==. E.just (examOccurrence E.^. ExamOccurrenceId)
|
||||
E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. exam E.^. ExamId
|
||||
E.&&. examRegistration E.^. ExamRegistrationUser E.==. E.val uid
|
||||
return . E.just $ examOccurrence E.^. ExamOccurrenceName
|
||||
, singletonMap "registration-time" . SortColumn $ \exam -> E.subSelectMaybe . E.from $ \examRegistration -> do
|
||||
E.where_ $ examRegistration E.^. ExamRegistrationExam E.==. exam E.^. ExamId
|
||||
E.&&. examRegistration E.^. ExamRegistrationUser E.==. E.val uid
|
||||
return . E.just $ examRegistration E.^. ExamRegistrationTime
|
||||
, singletonMap "bonus" . SortColumn $ \exam -> E.subSelectMaybe . E.from $ \examBonus -> do
|
||||
E.where_ $ examBonus E.^. ExamBonusExam E.==. exam E.^. ExamId
|
||||
E.&&. examBonus E.^. ExamBonusUser E.==. E.val uid
|
||||
return . E.just $ examBonus E.^. ExamBonusBonus
|
||||
, singletonMap "result" . SortColumn $ \exam -> E.subSelectMaybe . E.from $ \examResult -> do
|
||||
E.where_ $ examResult E.^. ExamResultExam E.==. exam E.^. ExamId
|
||||
E.&&. examResult E.^. ExamResultUser E.==. E.val uid
|
||||
return . E.just $ examResult E.^. ExamResultResult
|
||||
]
|
||||
dbtFilter = mempty
|
||||
dbtFilterUI _mPrev = mempty
|
||||
dbtStyle = def
|
||||
dbtParams = DBParamsForm
|
||||
{ dbParamsFormMethod = POST
|
||||
, dbParamsFormAction = Just . SomeRoute . CourseR courseTerm courseSchool courseShorthand $ CUserR uCID
|
||||
, dbParamsFormAttrs = []
|
||||
, dbParamsFormSubmit = FormSubmit
|
||||
, dbParamsFormAdditional = \csrf -> do
|
||||
let
|
||||
actionMap :: Map ExamAction (AForm Handler ExamActionData)
|
||||
actionMap = mconcat
|
||||
[ singletonMap ExamDeregister $
|
||||
pure ExamDeregisterData
|
||||
, singletonMap ExamSetResult $
|
||||
ExamSetResultData <$> aopt (examResultModeField (Just $ SomeMessage MsgExamResultNone) ExamGradingMixed) (fslI MsgExamResult) Nothing
|
||||
]
|
||||
|
||||
(res, formWgt) <- multiActionM actionMap (fslI MsgAction) Nothing csrf
|
||||
let formRes = (, mempty) . First . Just <$> res
|
||||
return (formRes, formWgt)
|
||||
, dbParamsFormEvaluate = liftHandler . runFormPost
|
||||
, dbParamsFormResult = _2
|
||||
, dbParamsFormIdent = def
|
||||
}
|
||||
dbtIdent :: Text
|
||||
dbtIdent = "course-user-exams"
|
||||
dbtCsvEncode = noCsvEncode
|
||||
dbtCsvDecode = Nothing
|
||||
examDBTableValidator = def & defaultSorting [SortAscBy "registration-time"]
|
||||
postprocess :: FormResult (First ExamActionData, DBFormResult ExamId (Bool, _) _) -> FormResult (ExamActionData, Map ExamId _)
|
||||
postprocess inp = do
|
||||
(First (Just act), regMap) <- inp
|
||||
let regMap' = Map.mapMaybe (uncurry guardOn) $ getDBFormResult (False,) regMap
|
||||
return (act, regMap')
|
||||
((Any hasExams, actRes), examTable) <- lift . runDB $ over (_1 . _2) postprocess <$> dbTable examDBTableValidator examDBTable
|
||||
|
||||
lift . formResult actRes $ \case
|
||||
(ExamDeregisterData, Map.keys -> selectedExams) -> do
|
||||
nrDel <- runDB $ deleteWhereCount
|
||||
[ ExamRegistrationUser ==. uid
|
||||
, ExamRegistrationExam <-. selectedExams
|
||||
]
|
||||
if | nrDel > 0 -> addMessageI Success $ MsgCourseUserExamsDeregistered nrDel
|
||||
| otherwise -> addMessageI Info MsgCourseUserNoExamsDeregistered
|
||||
redirect . CourseR courseTerm courseSchool courseShorthand $ CUserR uCID
|
||||
(ExamSetResultData mRes, selectedExams) -> do
|
||||
now <- liftIO getCurrentTime
|
||||
Sum nrUpdated <- runDB . flip ifoldMapM selectedExams $ \eId (view $ _dbrOutput . _1 . _entityVal -> Exam{..}) -> if
|
||||
| hasExamGradingGrades examGradingMode || isn't (_Just . _ExamAttended . _Right) mRes
|
||||
, hasExamGradingPass examGradingMode || isn't (_Just . _ExamAttended . _Left ) mRes
|
||||
-> do
|
||||
oldResult <- getBy $ UniqueExamResult eId uid
|
||||
case mRes of
|
||||
Just res
|
||||
| maybe True ((/= res) . examResultResult . entityVal) oldResult -> do
|
||||
void $ upsert
|
||||
ExamResult
|
||||
{ examResultExam = eId
|
||||
, examResultUser = uid
|
||||
, examResultResult = res
|
||||
, examResultLastChanged = now
|
||||
}
|
||||
[ ExamResultResult =. res, ExamResultLastChanged =. now ]
|
||||
audit $ TransactionExamResultEdit eId uid
|
||||
return $ Sum 1
|
||||
Nothing
|
||||
| is _Just oldResult -> do
|
||||
deleteBy $ UniqueExamResult eId uid
|
||||
audit $ TransactionExamResultDeleted eId uid
|
||||
return $ Sum 1
|
||||
_other -> return mempty
|
||||
| otherwise -> mempty <$ addMessageI Error (MsgCourseUserExamResultDoesNotMatchMode examName)
|
||||
when (nrUpdated > 0) . addMessageI Success $ MsgCourseUserExamsResultSet nrUpdated
|
||||
redirect . CourseR courseTerm courseSchool courseShorthand $ CUserR uCID
|
||||
|
||||
guard hasExams
|
||||
|
||||
return $(widgetFile "course/user/exams")
|
||||
|
||||
|
||||
courseUserTutorialsSection :: Entity Course -> Entity User -> MaybeT Handler Widget
|
||||
courseUserTutorialsSection (Entity cid Course{..}) (Entity uid _) = do
|
||||
uCID <- encrypt uid
|
||||
|
||||
let
|
||||
tutorialDBTable = DBTable{..}
|
||||
where
|
||||
dbtSQLQuery (tutorial `E.InnerJoin` tutorialParticipant) = do
|
||||
E.on $ tutorial E.^. TutorialId E.==. tutorialParticipant E.^. TutorialParticipantTutorial
|
||||
E.where_ $ tutorial E.^. TutorialCourse E.==. E.val cid
|
||||
E.&&. tutorialParticipant E.^. TutorialParticipantUser E.==. E.val uid
|
||||
return (tutorial, tutorialParticipant)
|
||||
dbtRowKey (_ `E.InnerJoin` tutorialParticipant) = tutorialParticipant E.^. TutorialParticipantId
|
||||
dbtProj = traverse $ \(tutorial, tutorialParticipant) -> do
|
||||
tutors <- E.select . E.from $ \(tutor `E.InnerJoin` user) -> do
|
||||
E.on $ tutor E.^. TutorUser E.==. user E.^. UserId
|
||||
E.where_ $ tutor E.^. TutorTutorial E.==. E.val (tutorial ^. _entityKey)
|
||||
return user
|
||||
return (tutorial, tutorialParticipant, tutors)
|
||||
dbtColonnade = mconcat
|
||||
[ dbSelect (_2 . applying _2) _1 $ return . view (_dbrOutput . _2 . _entityKey)
|
||||
, sortable (Just "type") (i18nCell MsgTutorialType) $ textCell . CI.original . view (_dbrOutput . _1 . _entityVal . _tutorialType)
|
||||
, sortable (Just "name") (i18nCell MsgTutorialName) $ tellCell (Any True, mempty) . anchorCell' (\(view $ _dbrOutput . _1 . _entityVal . _tutorialName -> tutn) -> CTutorialR courseTerm courseSchool courseShorthand tutn TUsersR) (view $ _dbrOutput . _1 . _entityVal . _tutorialName)
|
||||
, sortable (Just "tutors") (i18nCell MsgTutorialTutors) $ \(view $ _dbrOutput . _3 -> tutors) -> cell
|
||||
[whamlet|
|
||||
$newline never
|
||||
<ul .list--iconless .list--inline .list--comma-separated>
|
||||
$forall (Entity _ User{userEmail, userDisplayName, userSurname}) <- tutors
|
||||
<li>
|
||||
^{nameEmailWidget userEmail userDisplayName userSurname}
|
||||
|]
|
||||
, sortable (Just "room") (i18nCell MsgTutorialRoom) $ maybe mempty textCell . view (_dbrOutput . _1 . _entityVal . _tutorialRoom)
|
||||
, sortable Nothing (i18nCell MsgTutorialTime) $ occurrencesCell . view (_dbrOutput . _1 . _entityVal . _tutorialTime)
|
||||
]
|
||||
dbtSorting = mconcat
|
||||
[ singletonMap "type" . SortColumn $ \(tutorial `E.InnerJoin` _) -> tutorial E.^. TutorialType
|
||||
, singletonMap "name" . SortColumn $ \(tutorial `E.InnerJoin` _) -> tutorial E.^. TutorialName
|
||||
, singletonMap "room" . SortColumn $ \(tutorial `E.InnerJoin` _) -> tutorial E.^. TutorialRoom
|
||||
, singletonMap "tutors" . SortColumn $ \(tutorial `E.InnerJoin` _) -> E.subSelectMaybe . E.from $ \(tutor `E.InnerJoin` user) -> do
|
||||
E.on $ tutor E.^. TutorUser E.==. user E.^. UserId
|
||||
E.where_ $ tutorial E.^. TutorialId E.==. tutor E.^. TutorTutorial
|
||||
return . E.min_ $ user E.^. UserSurname
|
||||
]
|
||||
dbtFilter = mempty
|
||||
dbtFilterUI _mPrev = mempty
|
||||
dbtStyle = def
|
||||
dbtParams = DBParamsForm
|
||||
{ dbParamsFormMethod = POST
|
||||
, dbParamsFormAction = Just . SomeRoute . CourseR courseTerm courseSchool courseShorthand $ CUserR uCID
|
||||
, dbParamsFormAttrs = []
|
||||
, dbParamsFormSubmit = FormSubmit
|
||||
, dbParamsFormAdditional = \csrf -> do
|
||||
let
|
||||
actionMap :: Map TutorialAction (AForm Handler TutorialActionData)
|
||||
actionMap = mconcat
|
||||
[ singletonMap TutorialDeregister $
|
||||
pure TutorialDeregisterData
|
||||
]
|
||||
|
||||
(res, formWgt) <- multiActionM actionMap (fslI MsgAction) Nothing csrf
|
||||
let formRes = (, mempty) . First . Just <$> res
|
||||
return (formRes, formWgt)
|
||||
, dbParamsFormEvaluate = liftHandler . runFormPost
|
||||
, dbParamsFormResult = _2
|
||||
, dbParamsFormIdent = def
|
||||
}
|
||||
dbtIdent :: Text
|
||||
dbtIdent = "tutorials"
|
||||
dbtCsvEncode = noCsvEncode
|
||||
dbtCsvDecode = Nothing
|
||||
tutorialDBTableValidator = def & defaultSorting [SortAscBy "type", SortAscBy "name"]
|
||||
postprocess :: FormResult (First TutorialActionData, DBFormResult TutorialParticipantId (Bool, _) _) -> FormResult (TutorialActionData, Map TutorialParticipantId _)
|
||||
postprocess inp = do
|
||||
(First (Just act), regMap) <- inp
|
||||
let regMap' = Map.mapMaybe (uncurry guardOn) $ getDBFormResult (False,) regMap
|
||||
return (act, regMap')
|
||||
((Any hasTutorials, actRes), tutorialTable) <- lift . runDB $ over (_1 . _2) postprocess <$> dbTable tutorialDBTableValidator tutorialDBTable
|
||||
|
||||
lift . formResult actRes $ \case
|
||||
(TutorialDeregisterData, Map.keys -> selectedTutParts) -> do
|
||||
nrDel <- runDB $ deleteWhereCount [ TutorialParticipantId <-. selectedTutParts ]
|
||||
if | nrDel > 0 -> addMessageI Success $ MsgCourseUserTutorialsDeregistered nrDel
|
||||
| otherwise -> addMessageI Info MsgCourseUserNoTutorialsDeregistered
|
||||
redirect . CourseR courseTerm courseSchool courseShorthand $ CUserR uCID
|
||||
|
||||
guard hasTutorials
|
||||
|
||||
return $(widgetFile "course/user/tutorials")
|
||||
|
||||
@ -778,8 +778,8 @@ instance Monoid' x => IsDBTable (RWST (Maybe (Env, FileEnv), UniWorX, [Lang]) En
|
||||
= fmap ((\(res, (wdgt, x)) -> (x & dbParamsFormResult .~ res, wdgt)) . view _1)
|
||||
. dbParamsFormEvaluate
|
||||
. fmap (fmap $ \(x, wdgt) -> (x ^. dbParamsFormResult, (wdgt, x)))
|
||||
. dbParamsFormWrap dbtable dbtParams
|
||||
. maybe id (identifyForm' dbParamsFormResult) (unDBParamsFormIdent dbtable dbParamsFormIdent)
|
||||
. dbParamsFormWrap dbtable dbtParams
|
||||
. addPIHiddenField dbtable pi
|
||||
. addPreviousHiddenField dbtable pKeys
|
||||
. withFragment
|
||||
@ -894,9 +894,9 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
|
||||
referencePagesize = psLimit . snd . runPSValidator dbtable $ Just prevPi
|
||||
|
||||
(((filterRes, filterWdgt), filterEnc), ((pagesizeRes, pagesizeWdgt), pagesizeEnc)) <- mdo
|
||||
(filterRes'@((filterRes, _), _)) <- runFormGet . identifyForm FIDDBTableFilter . addPIHiddenField dbtable (prevPi & _piFilter .~ Nothing & _piPage .~ Nothing & _piLimit .~ (formResult' pagesizeRes <|> piLimit prevPi)) . renderAForm FormDBTableFilter $ dbtFilterUI (piFilter prevPi)
|
||||
(filterRes'@((filterRes, _), _)) <- runFormGet . identifyForm (FIDDBTableFilter dbtIdent) . addPIHiddenField dbtable (prevPi & _piFilter .~ Nothing & _piPage .~ Nothing & _piLimit .~ (formResult' pagesizeRes <|> piLimit prevPi)) . renderAForm FormDBTableFilter $ dbtFilterUI (piFilter prevPi)
|
||||
|
||||
(pagesizeRes'@((pagesizeRes, _), _)) <- lift . runFormGet . identifyForm FIDDBTablePagesize . addPIHiddenField dbtable (prevPi & _piPage .~ Nothing & _piLimit .~ Nothing & _piFilter .~ (formResult' filterRes <|> piFilter prevPi)) . renderAForm FormDBTablePagesize $
|
||||
(pagesizeRes'@((pagesizeRes, _), _)) <- lift . runFormGet . identifyForm (FIDDBTablePagesize dbtIdent) . addPIHiddenField dbtable (prevPi & _piPage .~ Nothing & _piLimit .~ Nothing & _piFilter .~ (formResult' filterRes <|> piFilter prevPi)) . renderAForm FormDBTablePagesize $
|
||||
areq (pagesizeField referencePagesize) (fslI MsgDBTablePagesize & addName (wIdent "pagesize") & addClass ("select--pagesize" :: Text)) (Just referencePagesize)
|
||||
return (filterRes', pagesizeRes')
|
||||
|
||||
@ -919,7 +919,10 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
|
||||
= (, def) $ runPSValidator dbtable Nothing
|
||||
psSorting' = map (\SortingSetting{..} -> (Map.findWithDefault (error $ "Invalid sorting key: " <> show sortKey) sortKey dbtSorting, sortDir)) psSorting
|
||||
|
||||
mapM_ (addMessageI Warning) errs
|
||||
forM_ errs $ \err -> do
|
||||
mr <- getMessageRender
|
||||
$logDebugS "dbTable paginationSettings" $ mr err
|
||||
addMessageI Warning err
|
||||
|
||||
currentRoute <- fromMaybe (error "dbTable called from 404-handler") <$> getCurrentRoute
|
||||
getParams <- liftHandler $ queryToQueryText . Wai.queryString . reqWaiRequest <$> getRequest
|
||||
@ -942,7 +945,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
|
||||
| otherwise
|
||||
= True
|
||||
|
||||
((csvExportRes, csvExportWdgt), csvExportEnctype) <- bool runFormPost runFormGet noExportData . identifyForm FIDDBTableCsvExport . renderAForm FormDBTableCsvExport . fmap DBCsvExport $ case dbtCsvEncode of
|
||||
((csvExportRes, csvExportWdgt), csvExportEnctype) <- bool runFormPost runFormGet noExportData . identifyForm (FIDDBTableCsvExport dbtIdent) . renderAForm FormDBTableCsvExport . fmap DBCsvExport $ case dbtCsvEncode of
|
||||
Just DBTCsvEncode{..}
|
||||
| Just (cloneIso -> noExportData') <- dbtCsvNoExportData
|
||||
-> toDyn . view (noExportData' . from noExportData') <$> dbtCsvExportForm
|
||||
@ -958,7 +961,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
|
||||
-> return [BtnCsvImport]
|
||||
handleBtnAbort _ (FormSuccess BtnCsvImportAbort) = pure DBCsvAbort
|
||||
handleBtnAbort x btn = x <* btn
|
||||
((csvImportRes, csvImportWdgt), csvImportEnctype) <- lift . runFormPost . withGlobalPostParam PostDBCsvReImport () . withButtonFormCombM' handleBtnAbort importButtons . identifyForm FIDDBTableCsvImport . renderAForm FormDBTableCsvImport $ DBCsvImport
|
||||
((csvImportRes, csvImportWdgt), csvImportEnctype) <- lift . runFormPost . withGlobalPostParam PostDBCsvReImport () . withButtonFormCombM' handleBtnAbort importButtons . identifyForm (FIDDBTableCsvImport dbtIdent) . renderAForm FormDBTableCsvImport $ DBCsvImport
|
||||
<$> areq fileFieldMultiple (fslI MsgCsvFile) Nothing
|
||||
exportExampleRes <- guardOn <$> hasGlobalGetParam GetCsvExampleData <*> pure DBCsvExportExample
|
||||
|
||||
@ -1159,7 +1162,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
|
||||
<input id=#{theId} *{attrs} type=checkbox name=#{name} value=#{either id id val} :defaultChecked (dbtCsvClassifyAction act):checked>
|
||||
|]
|
||||
fieldView sJsonField (actionIdent act) (toPathPiece PostDBCsvImportAction) vAttrs (Right act) False
|
||||
(csvImportConfirmForm', csvImportConfirmEnctype) <- liftHandler . generateFormPost . withButtonForm' [BtnCsvImportConfirm, BtnCsvImportAbort] . identifyForm FIDDBTableCsvImportConfirm $ \csrf -> return (error "No meaningful FormResult", $(widgetFile "csv-import-confirmation"))
|
||||
(csvImportConfirmForm', csvImportConfirmEnctype) <- liftHandler . generateFormPost . withButtonForm' [BtnCsvImportConfirm, BtnCsvImportAbort] . identifyForm (FIDDBTableCsvImportConfirm dbtIdent) $ \csrf -> return (error "No meaningful FormResult", $(widgetFile "csv-import-confirmation"))
|
||||
let csvImportConfirmForm = wrapForm csvImportConfirmForm' FormSettings
|
||||
{ formMethod = POST
|
||||
, formAction = Just $ tblLink id
|
||||
@ -1318,7 +1321,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
|
||||
|
||||
((csvImportConfirmRes, _confirmView), _enctype) <- case dbtCsvDecode of
|
||||
Just (DBTCsvDecode{dbtCsvExecuteActions} :: DBTCsvDecode r' k' csv) -> do
|
||||
lift . runFormPost . withButtonForm' [BtnCsvImportConfirm, BtnCsvImportAbort] . identifyForm FIDDBTableCsvImportConfirm $ \_csrf -> do
|
||||
lift . runFormPost . withButtonForm' [BtnCsvImportConfirm, BtnCsvImportAbort] . identifyForm (FIDDBTableCsvImportConfirm dbtIdent) $ \_csrf -> do
|
||||
acts <- globalPostParamFields PostDBCsvImportAction secretJsonField
|
||||
return . (, mempty) $ if
|
||||
| null acts -> FormSuccess $ do
|
||||
|
||||
@ -206,12 +206,11 @@ data FormIdentifier
|
||||
| FIDSystemMessageModify
|
||||
| FIDSystemMessageModifyTranslation UUID
|
||||
| FIDSystemMessageAddTranslation
|
||||
| FIDDBTableFilter
|
||||
| FIDDBTablePagesize
|
||||
| FIDDBTable
|
||||
| FIDDBTableCsvExport
|
||||
| FIDDBTableCsvImport
|
||||
| FIDDBTableCsvImportConfirm
|
||||
| FIDDBTableFilter Text
|
||||
| FIDDBTablePagesize Text
|
||||
| FIDDBTableCsvExport Text
|
||||
| FIDDBTableCsvImport Text
|
||||
| FIDDBTableCsvImportConfirm Text
|
||||
| FIDDelete
|
||||
| FIDCourseRegister
|
||||
| FIDuserRights
|
||||
@ -234,7 +233,7 @@ instance PathPiece FormIdentifier where
|
||||
toPathPiece = showToPathPiece
|
||||
|
||||
|
||||
identifyForm' :: (Monad m, PathPiece ident, Eq ident)
|
||||
identifyForm' :: (MonadLogger m, PathPiece ident, Eq ident)
|
||||
=> Lens' x (FormResult a)
|
||||
-> ident -- ^ Form identification
|
||||
-> (Html -> MForm m (x, widget))
|
||||
@ -243,12 +242,16 @@ identifyForm' resLens identVal form fragment = do
|
||||
-- Create hidden <input>.
|
||||
let fragment' =
|
||||
[shamlet|
|
||||
$newline never
|
||||
<input .form-identifier type=hidden name=#{toPathPiece PostFormIdentifier} value=#{toPathPiece identVal}>
|
||||
#{fragment}
|
||||
|]
|
||||
|
||||
-- Check if we got its value back.
|
||||
hasIdent <- (== Just identVal) <$> lookupGlobalPostParamForm PostFormIdentifier
|
||||
identVal' <- lookupGlobalPostParamForm PostFormIdentifier
|
||||
let hasIdent = identVal' == Just identVal
|
||||
|
||||
$logDebugS "identifyForm'" $ tshow (toPathPiece <$> identVal', toPathPiece identVal, hasIdent)
|
||||
|
||||
-- Run the form proper (with our hidden <input>). If the
|
||||
-- data is missing, then do not provide any params to the
|
||||
@ -256,9 +259,9 @@ identifyForm' resLens identVal form fragment = do
|
||||
-- doing this avoids having lots of fields with red errors.
|
||||
let eraseParams | not hasIdent = local (\(_, h, l) -> (Nothing, h, l))
|
||||
| otherwise = id
|
||||
fmap (over (_1 . resLens) $ bool (const FormMissing) id hasIdent) . eraseParams $ form fragment'
|
||||
bool (set (mapped . _1 . resLens) FormMissing . eraseParams) id hasIdent $ form fragment'
|
||||
|
||||
identifyForm :: (Monad m, PathPiece ident, Eq ident) => ident -> (Html -> MForm m (FormResult a, widget)) -> (Html -> MForm m (FormResult a, widget))
|
||||
identifyForm :: (MonadLogger m, PathPiece ident, Eq ident) => ident -> (Html -> MForm m (FormResult a, widget)) -> (Html -> MForm m (FormResult a, widget))
|
||||
identifyForm = identifyForm' id
|
||||
|
||||
|
||||
@ -946,7 +949,11 @@ formResult :: MonadHandler m => FormResult a -> (a -> m ()) -> m ()
|
||||
formResult res f = void . formResultMaybe res $ \x -> Nothing <$ f x
|
||||
|
||||
formResultMaybe :: MonadHandler m => FormResult a -> (a -> m (Maybe b)) -> m (Maybe b)
|
||||
formResultMaybe (FormFailure errs) _ = Nothing <$ forM_ errs (addMessage Error . toHtml)
|
||||
formResultMaybe (FormFailure errs) _ = do
|
||||
forM_ errs $ \err -> do
|
||||
$logDebugS "formResultMaybe" err
|
||||
addMessage Error $ toHtml err
|
||||
return Nothing
|
||||
formResultMaybe FormMissing _ = return Nothing
|
||||
formResultMaybe (FormSuccess res) f = f res
|
||||
|
||||
|
||||
@ -190,6 +190,7 @@ makeLenses_ ''ExamResult
|
||||
makeLenses_ ''ExamBonus
|
||||
makeLenses_ ''ExamPart
|
||||
makeLenses_ ''ExamPartResult
|
||||
makeLenses_ ''ExamRegistration
|
||||
|
||||
makeLenses_ ''UTCTime
|
||||
|
||||
|
||||
@ -1,3 +1,4 @@
|
||||
$newline never
|
||||
<section>
|
||||
^{table}
|
||||
$if statistics /= mempty
|
||||
|
||||
5
templates/course/user/corrections.hamlet
Normal file
5
templates/course/user/corrections.hamlet
Normal file
@ -0,0 +1,5 @@
|
||||
$newline never
|
||||
<section>
|
||||
<h2>_{MsgCourseUserCorrections}
|
||||
^{cWdgt}
|
||||
^{gradeSummaryWidget MsgSubmissionGradingSummaryTitle statistics}
|
||||
4
templates/course/user/exams.hamlet
Normal file
4
templates/course/user/exams.hamlet
Normal file
@ -0,0 +1,4 @@
|
||||
$newline never
|
||||
<section>
|
||||
<h2>_{MsgCourseSingleUserExams}
|
||||
^{examTable}
|
||||
@ -1,3 +1,4 @@
|
||||
$newline never
|
||||
<section>
|
||||
<h2>_{MsgCourseUserNote}
|
||||
^{noteWidget}
|
||||
|
||||
@ -2,49 +2,56 @@ $newline never
|
||||
<section>
|
||||
<div .profile>
|
||||
<dl .deflist.profile-dl>
|
||||
$maybe sex <- guardOn showSex =<< userSex
|
||||
<dt .deflist__dt> _{MsgSex}
|
||||
<dd .deflist__dd> _{sex}
|
||||
<dt .deflist__dt> _{MsgEMail}
|
||||
<dd .deflist__dd> #{mailtoHtml userEmail}
|
||||
<dt .deflist__dt> _{MsgMatrikelNr}
|
||||
$maybe title <- userTitle
|
||||
<dt .deflist__dt>_{MsgTitle}
|
||||
<dd .deflist__dd>#{title}
|
||||
<dt .deflist__dt>_{MsgSurname}
|
||||
<dd .deflist__dd>#{userSurname}
|
||||
<dt .deflist__dt>_{MsgFirstName}
|
||||
<dd .deflist__dd>#{userFirstName}
|
||||
<dt .deflist__dt>_{MsgMatrikelNr}
|
||||
<dd .deflist__dd>
|
||||
$maybe matnr <- userMatrikelnummer
|
||||
#{matnr}
|
||||
$nothing
|
||||
_{MsgNoMatrikelKnown}
|
||||
$maybe sex <- guardOn showSex =<< userSex
|
||||
<dt .deflist__dt>_{MsgSex}
|
||||
<dd .deflist__dd>_{sex}
|
||||
<dt .deflist__dt>_{MsgEMail}
|
||||
<dd .deflist__dd>#{mailtoHtml userEmail}
|
||||
$maybe date <- mRegAt
|
||||
<dt .deflist__dt>_{MsgRegisteredSince}
|
||||
<dd .deflist__dd>#{date}
|
||||
$if mayRegister
|
||||
<dt .deflist__dt>
|
||||
<dd .deflist__dd>
|
||||
$maybe matnr <- userMatrikelnummer
|
||||
#{matnr}
|
||||
$nothing
|
||||
_{MsgNoMatrikelKnown}
|
||||
$maybe date <- mRegAt
|
||||
<dt .deflist__dt>_{MsgRegisteredSince}
|
||||
<dd .deflist__dd>#{date}
|
||||
$if mayRegister
|
||||
<dt .deflist__dt>
|
||||
<dd .deflist__dd>
|
||||
^{regButtonWidget}
|
||||
$maybe _ <- mRegistration
|
||||
<p>
|
||||
_{MsgCourseDeregisterLecturerTip}
|
||||
<dt .deflist__dt>_{MsgStudyTerms}
|
||||
<dd .deflist__dd>
|
||||
$if null studies
|
||||
_{MsgNoStudyTermsKnown}
|
||||
$else
|
||||
<div .scrolltable>
|
||||
<table .table.table--striped.table--hover.table--condensed>
|
||||
^{regButtonWidget}
|
||||
$maybe _ <- mRegistration
|
||||
<p>
|
||||
_{MsgCourseDeregisterLecturerTip}
|
||||
<dt .deflist__dt>_{MsgStudyTerms}
|
||||
<dd .deflist__dd>
|
||||
$if null studies
|
||||
_{MsgNoStudyTermsKnown}
|
||||
$else
|
||||
<div .scrolltable>
|
||||
<table .table.table--striped.table--hover.table--condensed>
|
||||
<tr .table__row>
|
||||
<th .table__th>_{MsgStudyTerm}
|
||||
<th .table__th>_{MsgStudyFeatureDegree}
|
||||
<th .table__th>_{MsgStudyFeatureType}
|
||||
<th .table__th>_{MsgStudyFeatureAge}
|
||||
<th .table__th>_{MsgStudyFeatureValid}
|
||||
<th .table__th>_{MsgStudyFeatureUpdate}
|
||||
$forall ((Entity _ StudyFeatures{studyFeaturesType, studyFeaturesSemester, studyFeaturesValid, studyFeaturesUpdated}), (Entity _ degree), (Entity _ field)) <- studies
|
||||
<tr .table__row>
|
||||
<th .table__th>_{MsgStudyTerm}
|
||||
<th .table__th>_{MsgStudyFeatureDegree}
|
||||
<th .table__th>_{MsgStudyFeatureType}
|
||||
<th .table__th>_{MsgStudyFeatureAge}
|
||||
<th .table__th>_{MsgStudyFeatureValid}
|
||||
<th .table__th>_{MsgStudyFeatureUpdate}
|
||||
$forall ((Entity _ StudyFeatures{studyFeaturesType, studyFeaturesSemester, studyFeaturesValid, studyFeaturesUpdated}), (Entity _ degree), (Entity _ field)) <- studies
|
||||
<tr .table__row>
|
||||
<td .table__td>_{field}
|
||||
<td .table__td>_{degree}
|
||||
<td .table__td>_{studyFeaturesType}
|
||||
<td .table__td>#{studyFeaturesSemester}
|
||||
<td .table__td>#{hasTickmark studyFeaturesValid}
|
||||
<td .table__td>^{formatTimeW SelFormatDate studyFeaturesUpdated}
|
||||
$maybe _ <- mRegistration
|
||||
<dt .deflist__dt>_{MsgCourseStudyFeature}
|
||||
<dd .deflist__dd>^{regFieldWidget}
|
||||
<td .table__td>_{field}
|
||||
<td .table__td>_{degree}
|
||||
<td .table__td>_{studyFeaturesType}
|
||||
<td .table__td>#{studyFeaturesSemester}
|
||||
<td .table__td>#{hasTickmark studyFeaturesValid}
|
||||
<td .table__td>^{formatTimeW SelFormatDate studyFeaturesUpdated}
|
||||
$maybe _ <- mRegistration
|
||||
<dt .deflist__dt>_{MsgCourseStudyFeature}
|
||||
<dd .deflist__dd>^{regFieldWidget}
|
||||
|
||||
4
templates/course/user/tutorials.hamlet
Normal file
4
templates/course/user/tutorials.hamlet
Normal file
@ -0,0 +1,4 @@
|
||||
$newline never
|
||||
<section>
|
||||
<h2>_{MsgCourseSingleUserTutorials}
|
||||
^{tutorialTable}
|
||||
Loading…
Reference in New Issue
Block a user