diff --git a/messages/uniworx/categories/courses/tutorial/de-de-formal.msg b/messages/uniworx/categories/courses/tutorial/de-de-formal.msg index b7087be47..2e278a5ba 100644 --- a/messages/uniworx/categories/courses/tutorial/de-de-formal.msg +++ b/messages/uniworx/categories/courses/tutorial/de-de-formal.msg @@ -62,3 +62,6 @@ TutorialParticipantsDayEdits day@Text: Kursteilnehmer-Tagesnotizen aktualisiert CheckEyePermitMissing: Sehtest oder Führerschein fehlen noch CheckEyePermitIncompatible: Sehtest und Führerschein passen nicht zusammen + +GenTutActOccCopy: Prüfungstermine von früherem Kurs kopieren +GenTutActOccEdit: Relevante Prüfungstermine bearbeiten diff --git a/messages/uniworx/categories/courses/tutorial/en-eu.msg b/messages/uniworx/categories/courses/tutorial/en-eu.msg index d205f11f6..3ce1cdc86 100644 --- a/messages/uniworx/categories/courses/tutorial/en-eu.msg +++ b/messages/uniworx/categories/courses/tutorial/en-eu.msg @@ -63,3 +63,6 @@ TutorialParticipantsDayEdits day: course participant day notes updated for #{day CheckEyePermitMissing: Eye exam or driving permit missing CheckEyePermitIncompatible: Eye exam and driving permit are incompatible + +GenTutActOccCopy: Copy exam occurrences from previous course +GenTutActOccEdit: Edit relevant exam occurrences diff --git a/messages/uniworx/utils/navigation/menu/de-de-formal.msg b/messages/uniworx/utils/navigation/menu/de-de-formal.msg index 039498fe8..866c86c8b 100644 --- a/messages/uniworx/utils/navigation/menu/de-de-formal.msg +++ b/messages/uniworx/utils/navigation/menu/de-de-formal.msg @@ -88,6 +88,7 @@ MenuTutorialComm: Mitteilung an Teilnehmer:innen MenuExamList: Prüfungen MenuExamNew: Neue Prüfung anlegen MenuExamEdit: Prüfung bearbeiten +MenuExamEditComplete: Prüfung vollständig überarbeiten MenuExamUsers: Teilnehmer:innen MenuExamGrades: Prüfungsleistungen MenuExamAddMembers: Prüfungsteilnehmer hinzufügen diff --git a/messages/uniworx/utils/navigation/menu/en-eu.msg b/messages/uniworx/utils/navigation/menu/en-eu.msg index 13a3dd6fe..eaf59831d 100644 --- a/messages/uniworx/utils/navigation/menu/en-eu.msg +++ b/messages/uniworx/utils/navigation/menu/en-eu.msg @@ -88,6 +88,7 @@ MenuTutorialComm: Send course type message MenuExamList: Exams MenuExamNew: Create new exam MenuExamEdit: Edit exam +MenuExamEditComplete: Revise entire exam MenuExamUsers: Participants MenuExamGrades: Exam results MenuExamAddMembers: Add exam participants diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index cca5a0290..d6171f120 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -1795,6 +1795,12 @@ pageActions (CTutorialR tid ssh csh tutn TUsersR) = do } } ] +pageActions (CTutorialR tid ssh csh _tutn (TExamR ename)) = return + [ NavPageActionPrimary + { navLink = defNavLink MsgMenuExamEditComplete $ CourseR tid ssh csh $ ExamR ename EEditR + , navChildren = [] + } + ] pageActions (CourseR tid ssh csh CExamListR) = return [ NavPageActionPrimary { navLink = NavLink diff --git a/src/Handler/Tutorial/Users.hs b/src/Handler/Tutorial/Users.hs index 9962b7390..6055f7bd3 100644 --- a/src/Handler/Tutorial/Users.hs +++ b/src/Handler/Tutorial/Users.hs @@ -37,32 +37,6 @@ import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications import Handler.Course.Users --- TODO: Idee: MultiAction für jedes Exam, um so die einzelnen Occurrences zu markieren! --- Default muss auch entsprechend generiert werden, wenn keine Occurrences für den Tag existieren --- Im Form sollten die neuen markiert werden als ungespeichert! Generell wünschenswert für MassInput! - - --- | Generate multiForm with one entry for each course exam showing only day-relevant exam occurrences -mkExamOccurrenceForm :: [(Entity Exam, CryptoUUIDExam, Widget)] -> ExamOccurrenceMap -> Form (CryptoUUIDExam, Set CryptoUUIDExamOccurrence, Set ExamOccurrenceForm) -mkExamOccurrenceForm exs eom = renderAForm FormStandard maa - where - maa = multiActionA acts (fslI MsgCourseExam) Nothing - eid2eos = convertExamOccurrenceMap eom - - acts :: Map Text (AForm Handler (CryptoUUIDExam, Set CryptoUUIDExamOccurrence, Set ExamOccurrenceForm)) - acts = Map.fromList $ map mkAct exs - - mkAct :: (Entity Exam, CryptoUUIDExam, Widget) -> (Text, AForm Handler (CryptoUUIDExam, Set CryptoUUIDExamOccurrence, Set ExamOccurrenceForm)) - mkAct (Entity{entityKey=eId, entityVal=Exam{examName=eName, examDescription=eDescr}}, cueId, ewgt) = (ciOriginal eName, - let (cuEoIds, eos) = munzip $ Map.lookup eId eid2eos - in (,,) - <$ for_ eDescr (aformInfoWidget . toWgt) - <*> apreq hiddenField "" (Just cueId) - <*> apreq (mkSetField hiddenField) "" cuEoIds - <* aformInfoWidget ewgt - <*> examOccurrenceMultiForm eos -- TODO filter occurrences to cuEoIds - ) - data TutorialUserAction = TutorialUserAssignExam | TutorialUserPrintQualification @@ -93,6 +67,32 @@ data TutorialUserActionData } deriving (Eq, Ord, Read, Show, Generic) +-- non-table form for general tutorial actions +data GenTutAction + = GenTutActOccCopy + | GenTutActOccEdit + deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) + deriving anyclass (Universe, Finite) + +nullaryPathPiece ''GenTutAction $ camelToPathPiece' 1 +embedRenderMessage ''UniWorX ''GenTutAction id + +data GenTutActionData + = GenTutActOccCopyData { gtaExam :: ExamId } + | GenTutActOccEditData { gtaExamMb :: Maybe ExamId } + deriving (Eq, Ord, Show, Generic) + +mkGenTutForm :: [Filter Exam] -> Form GenTutActionData +mkGenTutForm fltr = renderAForm FormStandard maa + where + maa = multiActionA acts (fslI MsgCourseExam) Nothing + + acts :: Map GenTutAction (AForm Handler GenTutActionData) + acts = Map.fromList + [ (GenTutActOccCopy, GenTutActOccCopyData <$> areq (examFieldFilter (Just $ SomeMessage MsgMenuExamNew) fltr) (fslI MsgCourseExam) Nothing) + , (GenTutActOccEdit, GenTutActOccEditData <$> aopt (examFieldFilter (Just $ SomeMessage MsgMenuExamNew) fltr) (fslI MsgCourseExam) Nothing) + ] + getTUsersR, postTUsersR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Handler TypedContent getTUsersR = postTUsersR @@ -222,46 +222,37 @@ postTUsersR tid ssh csh tutn = do _other -> addMessageI Error MsgErrorUnknownFormAction >> return Nothing case tcontent of - Just act -> act -- execute action and return produced content - Nothing -> do -- no table action, continue normally - let (fmap (toMidnight . succ) -> tbegin, fmap toMidnight -> tend) = munzip timespan - $logInfoS "ExamOccurrenceForm" [st|Exam from #{tshow tbegin} until #{tshow tend}.|] - (openExams, tutors) <- runDBRead $ (,) - <$> selectList ([ExamCourse ==. cid, ExamStart <=. tend] ++ ([ExamEnd >=. tbegin] ||. [ExamEnd ==. Nothing])) [Asc ExamName] - <*> E.select (do - (tutor :& user) <- E.from $ E.table @Tutor `E.innerJoin` E.table @User - `E.on` (\(tutor :& user) -> tutor E.^. TutorUser E.==. user E.^. UserId) - E.where_ $ tutor E.^. TutorTutorial E.==. E.val tutid - return user - ) - - let mkExamCreateBtn = linkButton mempty (msg2widget MsgMenuExamNew) [BCIsButton, BCPrimary] $ SomeRoute $ CourseR tid ssh csh CExamNewR - mkExamEditBtn ename = linkButton mempty (msg2widget MsgMenuExamEdit) [BCIsButton, BCDefault] $ SomeRoute $ CourseR tid ssh csh $ ExamR ename EEditR - examOccWgt <- if null openExams - then return $(i18nWidgetFile "exam-missing") - else do - openExamsUUIDs <- forM openExams $ \ent@Entity{entityKey=k, entityVal=Exam{examName}} -> (ent,,) <$> encrypt k <*> pure (mkExamEditBtn examName) - ((gtaRes, gtaWgt), gtaEnctype) <- runFormPost . identifyForm ("FIDGeneralTutorialAction"::Text) $ mkExamOccurrenceForm openExamsUUIDs exOccs -- TODO also TODO: occurrence name auto generation - let gtaAnchor = "general-tutorial-action-form" :: Text - gtaRoute = croute :#: gtaAnchor - gtaForm = wrapForm gtaWgt FormSettings - { formMethod = POST - , formAction = Just . SomeRoute $ gtaRoute - , formEncoding = gtaEnctype - , formAttrs = [] - , formSubmit = FormSubmit - , formAnchor = Just gtaAnchor - } - $logInfoS "ExamOccurrenceEdit" $ tshow (Set.map (eofName &&& eofId) . trd3 <$> gtaRes) - formResult gtaRes $ \(cEId, cEOIds, occs) -> do -- (CryptoUUIDExam, Set CryptoUUIDExamOccurrence, Set ExamOccurrenceForm) - let ceoidsDelete = cEOIds `Set.difference` setMapMaybe eofId occs - eId <- decrypt cEId - eoIdsDelete <- mapM decrypt $ Set.toList ceoidsDelete - $logInfoS "ExamOccurrenceEdit" [st|Exam-Edit: #{length cEOIds} old occurrences, #{length eoIdsDelete} to delete, #{length $ Set.filter (isNothing . eofId) occs} to insert, #{length $ Set.filter (isJust . eofId) occs} to edit|] - runDB do - deleteWhere [ExamOccurrenceExam ==. eId, ExamOccurrenceId <-. eoIdsDelete] - void $ upsertExamOccurrences eId $ Set.toList occs - return gtaForm + Just act -> act -- execute action and return produced content (i.e. pdf) + Nothing -> do -- no table action content to return, continue normally + let mkExamCreateBtn = linkButton mempty (msg2widget MsgMenuExamNew) [BCIsButton, BCPrimary] $ SomeRoute $ CourseR tid ssh csh CExamNewR + (fmap (toMidnight . succ) -> tbegin, fmap toMidnight -> tend) = munzip timespan + exmFltr = ([ExamEnd >=. tbegin] ||. [ExamEnd ==. Nothing]) ++ [ExamCourse ==. cid, ExamStart <=. tend] + $logInfoS "ExamOccurrenceForm" [st|Exams from #{tshow tbegin} until #{tshow tend}.|] + ((gtaRes, gtaWgt), gtaEnctype) <- runFormPost . identifyForm ("FIDGeneralTutorialAction"::Text) $ mkGenTutForm exmFltr + let gtaAnchor = "general-tutorial-action-form" :: Text + gtaRoute = croute :#: gtaAnchor + gtaForm = wrapForm gtaWgt FormSettings + { formMethod = POST + , formAction = Just . SomeRoute $ gtaRoute + , formEncoding = gtaEnctype + , formAttrs = [] + , formSubmit = FormSubmit + , formAnchor = Just gtaAnchor + } + formResult gtaRes $ \case + GenTutActOccEditData { gtaExamMb=Nothing } -> do + redirect $ CourseR tid ssh csh CExamNewR + GenTutActOccEditData { gtaExamMb=Just eId } -> do + Exam{examName=ename} <- runDBRead $ get404 eId + redirect $ CTutorialR tid ssh csh tutn $ TExamR ename + GenTutActOccCopyData { gtaExam=eId } -> do + error "TODO" + tutors <- runDBRead $ E.select do + (tutor :& user) <- E.from $ E.table @Tutor `E.innerJoin` E.table @User + `E.on` (\(tutor :& user) -> tutor E.^. TutorUser E.==. user E.^. UserId) + E.where_ $ tutor E.^. TutorTutorial E.==. E.val tutid + return user + -- $(i18nWidgetFile "exam-missing") let heading = prependCourseTitle tid ssh csh $ CI.original tutorialName html <- siteLayoutMsg heading do setTitleI heading diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 0a2616255..bd7e2b9ab 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -2074,8 +2074,15 @@ examField :: forall m. , HandlerSite m ~ UniWorX ) => Maybe (SomeMessage UniWorX) -> CourseId -> Field m ExamId -examField optMsg cId = hoistField liftHandler . selectField' optMsg . fmap (fmap entityKey) $ - optionsPersistCryptoId [ExamCourse ==. cId] [Asc ExamName] examName +examField optMsg cId = examFieldFilter optMsg [ExamCourse ==. cId] + +examFieldFilter :: forall m. + ( MonadHandler m + , HandlerSite m ~ UniWorX + ) + => Maybe (SomeMessage UniWorX) -> [Filter Exam] -> Field m ExamId +examFieldFilter optMsg fltr = hoistField liftHandler . selectField' optMsg . fmap (fmap entityKey) $ + optionsPersistCryptoId fltr [Asc ExamName] examName data CsvFormatOptions' = CsvFormatOptionsPreset' CsvPreset diff --git a/templates/tutorial-participants.hamlet b/templates/tutorial-participants.hamlet index bef9804b9..151ea7df3 100644 --- a/templates/tutorial-participants.hamlet +++ b/templates/tutorial-participants.hamlet @@ -23,4 +23,4 @@ $#
- ^{examOccWgt} \ No newline at end of file + ^{gtaForm} \ No newline at end of file