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.
This commit is contained in:
Steffen Jost 2024-12-19 17:56:21 +01:00
parent f9562c4a32
commit 8b52f00fb0
6 changed files with 73 additions and 6 deletions

View File

@ -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

View File

@ -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

View File

@ -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 True ssh $ Just cid
exOccs <- flip foldMapM timespan $ getDayExamOccurrences False ssh $ Just cid -- TODO: change back default to True
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

View File

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

View File

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

View File

@ -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
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
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 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