From 9fe78541d7125fb8192a8a0ec01493c55bab9753 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Fri, 24 Jan 2025 17:28:58 +0100 Subject: [PATCH] refactor(tutorial): exam occurrence form function and appearance --- messages/uniworx/misc/de-de-formal.msg | 1 + messages/uniworx/misc/en-eu.msg | 3 +- .../uniworx/utils/buttons/de-de-formal.msg | 1 + messages/uniworx/utils/buttons/en-eu.msg | 1 + src/Handler/Tutorial/Users.hs | 43 ++++++++++++------- src/Handler/Utils/Form.hs | 10 +++++ templates/tutorial-participants.hamlet | 2 +- 7 files changed, 44 insertions(+), 17 deletions(-) diff --git a/messages/uniworx/misc/de-de-formal.msg b/messages/uniworx/misc/de-de-formal.msg index 6bc384490..b44820cfc 100644 --- a/messages/uniworx/misc/de-de-formal.msg +++ b/messages/uniworx/misc/de-de-formal.msg @@ -37,3 +37,4 @@ Unknown: ist unbekannt UnknownOrNotAllowed: ist unbekannt oder hier nicht erlaubt Ambiguous: ist uneindeutig Action: Aktion +For: für \ No newline at end of file diff --git a/messages/uniworx/misc/en-eu.msg b/messages/uniworx/misc/en-eu.msg index 14a75bfc2..f0e05210a 100644 --- a/messages/uniworx/misc/en-eu.msg +++ b/messages/uniworx/misc/en-eu.msg @@ -36,4 +36,5 @@ NoProblem: No Probleme found Unknown: is unknown UnknownOrNotAllowed: is unknown or not allowed here Ambiguous: is ambiguous -Action: Action \ No newline at end of file +Action: Action +For: for \ No newline at end of file diff --git a/messages/uniworx/utils/buttons/de-de-formal.msg b/messages/uniworx/utils/buttons/de-de-formal.msg index 7c999bd06..7ac6b8081 100644 --- a/messages/uniworx/utils/buttons/de-de-formal.msg +++ b/messages/uniworx/utils/buttons/de-de-formal.msg @@ -55,6 +55,7 @@ BtnUserAssimilate: Assimilieren BtnCloseExam: Prüfung abschließen BtnFinishExam: Prüfungsergebnisse sichtbar schalten BtnConfirm: Bestätigen +BtnPerform: Ausführen BtnCourseRegisterAdd: Personen suchen BtnCourseRegisterConfirm: Ausgewählte Personen anmelden BtnCourseRegisterAbort: Abbrechen diff --git a/messages/uniworx/utils/buttons/en-eu.msg b/messages/uniworx/utils/buttons/en-eu.msg index 4d5924f08..1f4a6133a 100644 --- a/messages/uniworx/utils/buttons/en-eu.msg +++ b/messages/uniworx/utils/buttons/en-eu.msg @@ -55,6 +55,7 @@ BtnUserAssimilate: Assimilate BtnCloseExam: Close exam BtnFinishExam: Make results visible BtnConfirm: Confirm +BtnPerform: Perform BtnCourseRegisterAdd: Search persons BtnCourseRegisterConfirm: Register selected persons BtnCourseRegisterAbort: Abort diff --git a/src/Handler/Tutorial/Users.hs b/src/Handler/Tutorial/Users.hs index 6055f7bd3..71d212e29 100644 --- a/src/Handler/Tutorial/Users.hs +++ b/src/Handler/Tutorial/Users.hs @@ -78,20 +78,35 @@ nullaryPathPiece ''GenTutAction $ camelToPathPiece' 1 embedRenderMessage ''UniWorX ''GenTutAction id data GenTutActionData - = GenTutActOccCopyData { gtaExam :: ExamId } - | GenTutActOccEditData { gtaExamMb :: Maybe ExamId } + = GenTutActOccCopyData { gtaExam :: ExamId } + | GenTutActOccEditData { gtaExamMb :: ExamId } deriving (Eq, Ord, Show, Generic) -mkGenTutForm :: [Filter Exam] -> Form GenTutActionData -mkGenTutForm fltr = renderAForm FormStandard maa - where - maa = multiActionA acts (fslI MsgCourseExam) Nothing +-- 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) - ] +-- 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) +-- ] +mkGenTutForm :: [Filter Exam] -> Form GenTutActionData +mkGenTutForm fltr html = do + (actRes, actView) <- mreq (selectFieldList ((\a->(a,a)) <$> universeF)) (fslI MsgCourseExam) Nothing + (exmRes, exmView) <- mreq (examFieldFilter (Just $ SomeMessage MsgMenuExamNew) fltr) (fslI MsgCourseExam) Nothing + let res :: FormResult GenTutAction -> FormResult ExamId -> FormResult GenTutActionData + res (FormSuccess GenTutActOccCopy) (FormSuccess eid) = FormSuccess $ GenTutActOccCopyData eid + res (FormSuccess GenTutActOccEdit) (FormSuccess eid) = FormSuccess $ GenTutActOccEditData eid + res (FormFailure e) _ = FormFailure e + res _ (FormFailure e) = FormFailure e + res _ _ = FormMissing + viw = [whamlet| +

+ #{html}^{fvInput actView} _{MsgFor} ^{fvInput exmView} + |] + return (res actRes exmRes, viw) getTUsersR, postTUsersR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Handler TypedContent @@ -231,7 +246,7 @@ postTUsersR tid ssh csh tutn = do ((gtaRes, gtaWgt), gtaEnctype) <- runFormPost . identifyForm ("FIDGeneralTutorialAction"::Text) $ mkGenTutForm exmFltr let gtaAnchor = "general-tutorial-action-form" :: Text gtaRoute = croute :#: gtaAnchor - gtaForm = wrapForm gtaWgt FormSettings + gtaForm = wrapForm' BtnPerform gtaWgt FormSettings { formMethod = POST , formAction = Just . SomeRoute $ gtaRoute , formEncoding = gtaEnctype @@ -240,9 +255,7 @@ postTUsersR tid ssh csh tutn = do , formAnchor = Just gtaAnchor } formResult gtaRes $ \case - GenTutActOccEditData { gtaExamMb=Nothing } -> do - redirect $ CourseR tid ssh csh CExamNewR - GenTutActOccEditData { gtaExamMb=Just eId } -> do + GenTutActOccEditData { gtaExamMb=eId } -> do Exam{examName=ename} <- runDBRead $ get404 eId redirect $ CTutorialR tid ssh csh tutn $ TExamR ename GenTutActOccCopyData { gtaExam=eId } -> do diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index bd7e2b9ab..fef1889db 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -138,6 +138,16 @@ instance Button UniWorX ButtonConfirm where --confirmButton :: (Button (HandlerSite m) ButtonConfirm, MonadHandler m) => AForm m () --confirmButton = combinedButtonFieldF_ (Proxy @ButtonConfirm) "" +data ButtonPerform = BtnPerform + deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic) +instance Universe ButtonPerform +instance Finite ButtonPerform + +nullaryPathPiece ''ButtonPerform $ camelToPathPiece' 1 + +embedRenderMessage ''UniWorX ''ButtonPerform id +instance Button UniWorX ButtonPerform where + btnClasses BtnPerform = [BCIsButton, BCPrimary] data ButtonRegister = BtnRegister | BtnDeregister diff --git a/templates/tutorial-participants.hamlet b/templates/tutorial-participants.hamlet index 151ea7df3..960cbf20e 100644 --- a/templates/tutorial-participants.hamlet +++ b/templates/tutorial-participants.hamlet @@ -23,4 +23,4 @@ $#

_{MsgExamFormOccurrences}

- ^{gtaForm} \ No newline at end of file + ^{gtaForm} ^{mkExamCreateBtn} \ No newline at end of file