refactor(tutorial): exam occurrence form function and appearance

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

messages/uniworx/misc/en-eu.msg

@@ -37,3 +37,4 @@ Unknown: is unknown
 UnknownOrNotAllowed: is unknown or not allowed here
 Ambiguous: is ambiguous
 Action: Action
+For: for

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

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

src/Handler/Tutorial/Users.hs

@@ -78,20 +78,35 @@ nullaryPathPiece ''GenTutAction $ camelToPathPiece' 1
 embedRenderMessage ''UniWorX ''GenTutAction id
 
 data GenTutActionData
-  = GenTutActOccCopyData { gtaExam   ::       ExamId }
+  = GenTutActOccCopyData { gtaExam   :: ExamId }
-  | GenTutActOccEditData { gtaExamMb :: Maybe ExamId }
+  | GenTutActOccEditData { gtaExamMb :: ExamId }
   deriving (Eq, Ord, Show, Generic)
 
-mkGenTutForm :: [Filter Exam] -> Form GenTutActionData
+-- mkGenTutForm :: [Filter Exam] -> Form GenTutActionData
-mkGenTutForm fltr = renderAForm FormStandard maa
+-- mkGenTutForm fltr = renderAForm FormStandard maa
-  where
+--   where
-    maa = multiActionA acts (fslI MsgCourseExam) Nothing
+--     maa = multiActionA acts (fslI MsgCourseExam) Nothing
 
-    acts :: Map GenTutAction (AForm Handler GenTutActionData)
+--     acts :: Map GenTutAction (AForm Handler GenTutActionData)
-    acts = Map.fromList
+--     acts = Map.fromList
-            [ (GenTutActOccCopy, GenTutActOccCopyData <$> areq (examFieldFilter (Just $ SomeMessage MsgMenuExamNew) fltr) (fslI MsgCourseExam) Nothing)
+--             [ (GenTutActOccCopy, GenTutActOccCopyData <$> areq (examFieldFilter (Just $ SomeMessage MsgMenuExamNew) fltr) (fslI MsgCourseExam) Nothing)
-            , (GenTutActOccEdit, GenTutActOccEditData <$> aopt (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|
+              <p>
+                #{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
+        GenTutActOccEditData { gtaExamMb=eId } -> 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

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

templates/tutorial-participants.hamlet

@@ -23,4 +23,4 @@ $#  <h2 .show-hide__toggle uw-show-hide data-show-hide-collapsed>
     _{MsgExamFormOccurrences}
   <div>
     <p>
-      ^{gtaForm}
+      ^{gtaForm}  ^{mkExamCreateBtn}