chore(tutorial): towards #2347 add convenience buttons to add exam tutorial (STUB)

This is STUB add a multiform action that is not yet evaluated. Form Handler is to be implemented next.

messages/uniworx/categories/courses/tutorial/de-de-formal.msg

@@ -61,4 +61,9 @@ TutorialDayNote day@Text: Anwesenheitsnotiz #{day}
 TutorialParticipantsDayEdits day@Text: Kursteilnehmer-Tagesnotizen aktualisiert für #{day}
 
 CheckEyePermitMissing: Sehtest oder Führerschein fehlen noch
-CheckEyePermitIncompatible: Sehtest und Führerschein passen nicht zusammen
+CheckEyePermitIncompatible: Sehtest und Führerschein passen nicht zusammen
+
+GenTutActions: Prüfungsaktionen
+GenTutActNone !ident-ok: --
+GenTutActOccAdd: Neuen Prüfungstermin hinzufügen
+GenTutActOccEdit: Prüfungstermin bearbeiten

messages/uniworx/categories/courses/tutorial/en-eu.msg

@@ -62,4 +62,9 @@ TutorialDayNote day: Attendance note #{day}
 TutorialParticipantsDayEdits day: course participant day notes updated for #{day}
 
 CheckEyePermitMissing: Eye exam or driving permit missing
-CheckEyePermitIncompatible: Eye exam and driving permit are incompatible
+CheckEyePermitIncompatible: Eye exam and driving permit are incompatible
+
+GenTutActions: Examination actions
+GenTutActNone: --
+GenTutActOccAdd: Add new exam occurence
+GenTutActOccEdit: Edit exam occurence

src/Handler/Tutorial/Users.hs

@@ -31,6 +31,36 @@ import qualified Database.Esqueleto.Experimental as E -- needs TypeApplications
 import Handler.Course.Users
 
 
+data GenTutAction
+  = GenTutActNone               -- Dummy action to hide form in a more natural way
+  | GenTutActOccAdd
+  | GenTutActOccEdit
+  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic)
+  deriving anyclass (Universe, Finite)
+
+nullaryPathPiece ''GenTutAction $ camelToPathPiece' 1
+embedRenderMessage ''UniWorX ''GenTutAction id
+
+data GenTutActionData
+  = GenTutActNoneData           -- Dummy action to hide form in a more natural way
+  | GenTutActOccAddData
+  | GenTutActOccEditData
+  deriving (Eq, Ord, Read, Show, Generic)
+
+genTutActionMap ::(_ -> Text) -> Map GenTutAction (AForm Handler GenTutActionData)
+genTutActionMap _mr = Map.fromList
+  [ (GenTutActNone
+    , pure GenTutActNoneData )
+  , (GenTutActOccAdd
+    , pure GenTutActOccAddData )
+  , (GenTutActOccEdit
+    , pure GenTutActOccEditData) -- TODO
+  ]
+
+makeGenTutActionForm :: (_ -> Text) -> Form GenTutActionData
+makeGenTutActionForm mr html = flip (renderAForm FormStandard) html $ multiActionA (genTutActionMap mr) (fslI MsgGenTutActions) (Just GenTutActNone)
+
+
 data TutorialUserAction
   = TutorialUserAssignExam
   | TutorialUserPrintQualification
@@ -99,8 +129,7 @@ postTUsersR tid ssh csh tutn = do
         qualOptions = qualificationsOptionList qualifications
         lessons  = occurringLessons trm $ tutEnt ^. _entityVal . _tutorialTime . _Wrapped'
         timespan = lessonTimesSpan lessons
-    $logDebugS "Occurrences" $ tshow timespan
+    exOccs <- flip foldMapM timespan $ getDayExamOccurrences False ssh $ Just cid -- TODO: change back default to True
-    exOccs <- flip foldMapM timespan $ getDayExamOccurrences True ssh $ Just cid
     let
       acts :: Map TutorialUserAction (AForm Handler TutorialUserActionData)
       acts = Map.fromList $
@@ -199,6 +228,31 @@ postTUsersR tid ssh csh tutn = do
         E.where_ $ tutor E.^. TutorTutorial E.==. E.val tutid
         return user
 
+      let mr :: (() -> Text) = const "TODO: message renderer for general tutorial action form" -- getMessageRender
+      genTutActWgt <- do
+        ((_gtaRes, gtaWgt), gtaEnctype) <- runFormPost . identifyForm FIDGeneralTutorialAction $ makeGenTutActionForm mr
+        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
+                              }
+
+        -----------------------------------------------
+        -- !!!!!TODO: evaluate form result !!!!!!!!! --
+        -----------------------------------------------
+
+        return [whamlet|
+            <h2 .show-hide__toggle uw-show-hide data-show-hide-collapsed>
+              _{MsgGenTutActions}
+            <div>
+              <P>
+                ^{gtaForm}
+          |]
       let heading = prependCourseTitle tid ssh csh $ CI.original tutorialName
       html <- siteLayoutMsg heading $ do
         setTitleI heading

src/Utils/Form.hs

@@ -324,6 +324,7 @@ data FormIdentifier
   | FIDAddSupervisor
   | FIDFirmUserChangeRequest
   | FIDFirmAction
+  | FIDGeneralTutorialAction
   | FIDUnreachableUsersAction
   deriving (Eq, Ord, Read, Show)
 

templates/tutorial-participants.hamlet

@@ -17,3 +17,5 @@ $# SPDX-License-Identifier: AGPL-3.0-or-later
             ^{userEmailWidget usr}
 <section>            
   ^{participantTable}
+<section>
+  ^{genTutActWgt}

test/Database/Fill.hs

@@ -1256,8 +1256,8 @@ fillDb = do
             , examStaff = Just "Jost"
             , examAuthorshipStatement = Nothing
             }
-          eOccA <- insert' $ ExamOccurrence e "OccA" (Just jost)   (Just $ RoomReferenceSimple "Room A") False (Just 3) (termTime tid TermDayLectureStart 27 Nothing $ toTimeOfDay 16  0  0) (jtt TermDayLectureStart 27 Nothing $ toTimeOfDay 16 30 0) Nothing
+          eOccA <- insert' $ ExamOccurrence e "OccA" (Just jost)   (Just $ RoomReferenceSimple "Room A") False (Just 1) (termTime tid TermDayLectureStart 27 Nothing $ toTimeOfDay 16  0  0) (jtt TermDayLectureStart 27 Nothing $ toTimeOfDay 16 30 0) Nothing
-          eOccB <- insert' $ ExamOccurrence e "OccB" (Just gkleen) (Just $ RoomReferenceSimple "Room B") False (Just 4) (termTime tid TermDayLectureStart 28 Nothing $ toTimeOfDay 16  5  0) (jtt TermDayLectureStart 28 Nothing $ toTimeOfDay 16 35 0) Nothing
+          eOccB <- insert' $ ExamOccurrence e "OccB" (Just gkleen) (Just $ RoomReferenceSimple "Room B") False Nothing  (termTime tid TermDayLectureStart 28 Nothing $ toTimeOfDay 16  5  0) (jtt TermDayLectureStart 28 Nothing $ toTimeOfDay 16 35 0) Nothing
           insert_ $ ExamRegistration e svaupel (Just eOccA) now
           insert_ $ ExamRegistration e fhamann (Just eOccB) now
   insert_ $ UserDay svaupel nowaday True