refactor(tutorial): exam occurrence editing received specialised page

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

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

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

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

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

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
+    Just act -> act -- execute action and return produced content (i.e. pdf)
-    Nothing -> do   -- no table action, continue normally
+    Nothing -> do   -- no table action content to return, continue normally
-      let (fmap (toMidnight . succ) -> tbegin, fmap toMidnight -> tend) = munzip timespan
+      let mkExamCreateBtn = linkButton mempty (msg2widget MsgMenuExamNew)  [BCIsButton, BCPrimary] $ SomeRoute $ CourseR tid ssh csh  CExamNewR
-      $logInfoS "ExamOccurrenceForm" [st|Exam from #{tshow tbegin} until #{tshow tend}.|]
+          (fmap (toMidnight . succ) -> tbegin, fmap toMidnight -> tend) = munzip timespan
-      (openExams, tutors) <- runDBRead $ (,)
+          exmFltr = ([ExamEnd >=. tbegin] ||. [ExamEnd ==. Nothing]) ++ [ExamCourse ==. cid, ExamStart <=. tend]
-        <$> selectList ([ExamCourse ==. cid, ExamStart <=. tend] ++ ([ExamEnd >=. tbegin] ||. [ExamEnd ==. Nothing])) [Asc ExamName]
+      $logInfoS "ExamOccurrenceForm" [st|Exams from #{tshow tbegin} until #{tshow tend}.|]
-        <*> E.select (do
+      ((gtaRes, gtaWgt), gtaEnctype) <- runFormPost . identifyForm ("FIDGeneralTutorialAction"::Text) $ mkGenTutForm exmFltr
-              (tutor :& user) <- E.from $ E.table @Tutor `E.innerJoin` E.table @User
+      let gtaAnchor  = "general-tutorial-action-form" :: Text
-                `E.on` (\(tutor :& user) -> tutor E.^. TutorUser E.==. user E.^. UserId)
+          gtaRoute   = croute :#: gtaAnchor
-              E.where_ $ tutor E.^. TutorTutorial E.==. E.val tutid
+          gtaForm    = wrapForm gtaWgt FormSettings
-              return user
+                            { formMethod = POST
-            )
+                            , formAction = Just . SomeRoute $ gtaRoute
-
+                            , formEncoding = gtaEnctype
-      let mkExamCreateBtn     = linkButton mempty (msg2widget MsgMenuExamNew)  [BCIsButton, BCPrimary] $ SomeRoute $ CourseR tid ssh csh  CExamNewR
+                            , formAttrs = []
-          mkExamEditBtn ename = linkButton mempty (msg2widget MsgMenuExamEdit) [BCIsButton, BCDefault] $ SomeRoute $ CourseR tid ssh csh $ ExamR ename EEditR
+                            , formSubmit = FormSubmit
-      examOccWgt <- if null openExams
+                            , formAnchor = Just gtaAnchor
-        then return $(i18nWidgetFile "exam-missing")
+                            }
-        else do
+      formResult gtaRes $ \case
-          openExamsUUIDs <- forM openExams $ \ent@Entity{entityKey=k, entityVal=Exam{examName}} -> (ent,,) <$> encrypt k <*> pure (mkExamEditBtn examName)
+        GenTutActOccEditData { gtaExamMb=Nothing  } -> do
-          ((gtaRes, gtaWgt), gtaEnctype) <- runFormPost . identifyForm ("FIDGeneralTutorialAction"::Text) $ mkExamOccurrenceForm openExamsUUIDs exOccs -- TODO also TODO: occurrence name auto generation
+          redirect $ CourseR tid ssh csh CExamNewR
-          let gtaAnchor  = "general-tutorial-action-form" :: Text
+        GenTutActOccEditData { gtaExamMb=Just eId } -> do
-              gtaRoute   = croute :#: gtaAnchor
+          Exam{examName=ename} <- runDBRead $ get404 eId
-              gtaForm    = wrapForm gtaWgt FormSettings
+          redirect $ CTutorialR tid ssh csh tutn $ TExamR ename
-                                { formMethod = POST
+        GenTutActOccCopyData { gtaExam=eId } -> do
-                                , formAction = Just . SomeRoute $ gtaRoute
+          error "TODO"
-                                , formEncoding = gtaEnctype
+      tutors <- runDBRead $ E.select do
-                                , formAttrs = []
+                  (tutor :& user) <- E.from $ E.table @Tutor `E.innerJoin` E.table @User
-                                , formSubmit = FormSubmit
+                    `E.on` (\(tutor :& user) -> tutor E.^. TutorUser E.==. user E.^. UserId)
-                                , formAnchor = Just gtaAnchor
+                  E.where_ $ tutor E.^. TutorTutorial E.==. E.val tutid
-                                }
+                  return user
-          $logInfoS "ExamOccurrenceEdit" $ tshow (Set.map (eofName &&& eofId) . trd3 <$> gtaRes)
+      --   $(i18nWidgetFile "exam-missing")
-          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
       let heading = prependCourseTitle tid ssh csh $ CI.original tutorialName
       html <- siteLayoutMsg heading do
         setTitleI heading

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) $
+examField optMsg cId = examFieldFilter optMsg [ExamCourse ==. cId]
-                  optionsPersistCryptoId [ExamCourse ==. cId] [Asc ExamName] examName
+
+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

templates/tutorial-participants.hamlet

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