From 7a1f4b5a5ff217539112eee4705117cabb007f97 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Wed, 20 Nov 2024 18:03:36 +0100 Subject: [PATCH] fix(daily): form submit now works as intended --- .../courses/tutorial/de-de-formal.msg | 2 +- src/Handler/School/DayTasks.hs | 88 +++++++++++-------- 2 files changed, 52 insertions(+), 38 deletions(-) diff --git a/messages/uniworx/categories/courses/tutorial/de-de-formal.msg b/messages/uniworx/categories/courses/tutorial/de-de-formal.msg index 5969b085e..f1064aa89 100644 --- a/messages/uniworx/categories/courses/tutorial/de-de-formal.msg +++ b/messages/uniworx/categories/courses/tutorial/de-de-formal.msg @@ -54,6 +54,6 @@ CommTutorial: Kursmitteilung TutorialDrivingPermit: Führerschein TutorialEyeExam: Sehtest TutorialNote: Kursnotiz -TutorialDayAttendance day@Text: Anwesenheit am #{day} +TutorialDayAttendance day@Text: Anwesenheit #{day} TutorialDayNote day@Text: Anwesenheitsnotiz für #{day} TutorialParticipantsDayEdits n@Int: #{tshow n} Kursteilnehmer-Tagesnotizen aktualisiert \ No newline at end of file diff --git a/src/Handler/School/DayTasks.hs b/src/Handler/School/DayTasks.hs index bcc7475d5..8a02f8048 100644 --- a/src/Handler/School/DayTasks.hs +++ b/src/Handler/School/DayTasks.hs @@ -240,10 +240,10 @@ instance HasUser DailyTableData where -- see colRatedField' for an example of formCell usage drivingPermitField :: (RenderMessage (HandlerSite m) FormMessage, MonadHandler m, HandlerSite m ~ UniWorX) => Field m UserDrivingPermit -drivingPermitField = selectField' Nothing optionsFinite +drivingPermitField = selectField' (Just $ SomeMessage MsgBoolIrrelevant) optionsFinite eyeExamField :: (RenderMessage (HandlerSite m) FormMessage, MonadHandler m, HandlerSite m ~ UniWorX) => Field m UserEyeExam -eyeExamField = selectField' Nothing optionsFinite +eyeExamField = selectField' (Just $ SomeMessage MsgBoolIrrelevant) optionsFinite mkDailyFormColumn :: (RenderMessage UniWorX msg) => Text -> msg -> Lens' DailyTableData a -> ASetter' DailyFormData a -> Field _ a -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData))) mkDailyFormColumn k msg lg ls f = sortable (Just $ SortingKey $ stripCI k) (i18nCell msg) $ formCell id -- lens focussing on the form result within the larger DBResult; id iff the form delivers the only result of the table @@ -256,7 +256,7 @@ colParticipantPermitField :: Colonnade Sortable DailyTableData (DBCell _ (FormRe colParticipantPermitField = colParticipantPermitField' _dailyFormDrivingPermit colParticipantPermitField' :: ASetter' a (Maybe UserDrivingPermit) -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId a DailyTableData))) -colParticipantPermitField' l = sortable (Just "permit") (i18nCell MsgTutorialNote) $ formCell id -- lens focussing on the form result within the larger DBResult; id iff the form delivers the only result of the table +colParticipantPermitField' l = sortable (Just "permit") (i18nCell MsgTutorialDrivingPermit) $ formCell id -- lens focussing on the form result within the larger DBResult; id iff the form delivers the only result of the table (views (resultParticipant . _entityKey) return) -- generate row identfifiers for use in form result (\(view (resultParticipant . _entityVal . _tutorialParticipantDrivingPermit) -> x) mkUnique -> over (_1.mapped) (l .~) . over _2 fvWidget <$> mopt drivingPermitField (fsUniq mkUnique "permit") (Just x) @@ -266,18 +266,26 @@ colParticipantEyeExamField :: Colonnade Sortable DailyTableData (DBCell _ (FormR colParticipantEyeExamField = colParticipantEyeExamField' _dailyFormEyeExam colParticipantEyeExamField' :: ASetter' a (Maybe UserEyeExam) -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId a DailyTableData))) -colParticipantEyeExamField' l = sortable (Just "eye-exam") (i18nCell MsgTutorialNote) $ formCell id +colParticipantEyeExamField' l = sortable (Just "eye-exam") (i18nCell MsgTutorialEyeExam) $ formCell id (views (resultParticipant . _entityKey) return) (\(view (resultParticipant . _entityVal . _tutorialParticipantEyeExam) -> x) mkUnique -> over (_1.mapped) (l .~) . over _2 fvWidget <$> mopt eyeExamField (fsUniq mkUnique "eye-exam") (Just x) ) +-- colParticipantNoteField :: Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData))) +-- colParticipantNoteField = sortable (Just "note-tutorial") (i18nCell MsgTutorialNote) $ (cellAttrs <>~ [("style","width:60%")]) <$> formCell id +-- (views (resultParticipant . _entityKey) return) +-- (\(view (resultParticipant . _entityVal . _tutorialParticipantNote) -> note) mkUnique -> +-- over (_1.mapped) ((_dailyFormParticipantNote .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvWidget <$> +-- mopt textareaField (fsUniq mkUnique "note-tutorial") (Just $ Textarea <$> note) +-- ) + colParticipantNoteField :: Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData))) colParticipantNoteField = sortable (Just "note-tutorial") (i18nCell MsgTutorialNote) $ (cellAttrs <>~ [("style","width:60%")]) <$> formCell id (views (resultParticipant . _entityKey) return) (\(view (resultParticipant . _entityVal . _tutorialParticipantNote) -> note) mkUnique -> - over (_1.mapped) ((_dailyFormParticipantNote .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvWidget <$> - mopt textareaField (fsUniq mkUnique "note-tutorial") (Just $ Textarea <$> note) + over (_1.mapped) ((_dailyFormParticipantNote .~) . assertM (not . null) . fmap Text.strip) . over _2 fvWidget <$> + mopt textField (fsUniq mkUnique "note-tutorial") (Just note) ) colAttendanceField :: Text -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData))) @@ -288,11 +296,15 @@ colAttendanceField dday = sortable (Just "attendance") (i18nCell $ MsgTutorialDa ) colAttendanceNoteField :: Text -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData))) -colAttendanceNoteField dday = sortable (Just "note-attend") (i18nCell $ MsgTutorialDayNote dday) $ (cellAttrs <>~ [("style","width:60%")]) <$> formCell id +colAttendanceNoteField dday = sortable (Just "note-attend") (i18nCell $ MsgTutorialDayNote dday) $ (cellAttrs <>~ [("style","width:10%"), ("style","height:200px")]) <$> formCell id (views (resultParticipant . _entityKey) return) (\(preview (resultParticipantDay . _tutorialParticipantDayNote) -> note) mkUnique -> over (_1.mapped) ((_dailyFormAttendanceNote .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvWidget <$> - mopt textareaField (fsUniq mkUnique "note-attendance") (Textarea <<$>> note) + mopt textareaField (fsUniq mkUnique "note-attendance" + -- & addAutosubmit -- submits while typing + & addAttr "cols" "7" + & addAttr "rows" "2" -- does not work if height is set via css (search "170px") + ) (Textarea <<$>> note) ) colParkingField :: Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData))) @@ -356,13 +368,13 @@ mkDailyTable isAdmin ssh nd = do , colAttendanceField dday , colAttendanceNoteField dday , colParkingField - -- TODO: DEBUG ONLY - , sortable (Just "permit") (i18nCell MsgTutorialDrivingPermit) $ \(view $ resultParticipant . _entityVal . _tutorialParticipantDrivingPermit -> x) -> x & cellMaybe i18nCell - , sortable (Just "eye-exam") (i18nCell MsgTutorialEyeExam) $ \(view $ resultParticipant . _entityVal . _tutorialParticipantEyeExam -> x) -> x & cellMaybe i18nCell - , sortable (Just "note-tutorial") (i18nCell MsgTutorialNote) $ \(view $ resultParticipant . _entityVal . _tutorialParticipantNote -> x) -> x & cellMaybe textCell - , sortable (Just "attendance") (i18nCell $ MsgTutorialDayAttendance dday) $ \(preview $ resultParticipantDay . _tutorialParticipantDayAttendance -> x) -> x & cellMaybe tickmarkCell - , sortable (Just "note-attend") (i18nCell $ MsgTutorialDayNote dday) $ \(preview $ resultParticipantDay . _tutorialParticipantDayNote . _Just -> x) -> x & cellMaybe textCell - , sortable (Just "parking") (i18nCell MsgTableUserParkingToken) $ \(preview $ resultUserDay . _userDayParkingToken -> x) -> maybeCell x tickmarkCell + -- FOR DEBUGGING ONLY + -- , sortable (Just "permit") (i18nCell MsgTutorialDrivingPermit) $ \(view $ resultParticipant . _entityVal . _tutorialParticipantDrivingPermit -> x) -> x & cellMaybe i18nCell + -- , sortable (Just "eye-exam") (i18nCell MsgTutorialEyeExam) $ \(view $ resultParticipant . _entityVal . _tutorialParticipantEyeExam -> x) -> x & cellMaybe i18nCell + -- , sortable (Just "note-tutorial") (i18nCell MsgTutorialNote) $ \(view $ resultParticipant . _entityVal . _tutorialParticipantNote -> x) -> x & cellMaybe textCell + -- , sortable (Just "attendance") (i18nCell $ MsgTutorialDayAttendance dday) $ \(preview $ resultParticipantDay . _tutorialParticipantDayAttendance -> x) -> x & cellMaybe tickmarkCell + -- , sortable (Just "note-attend") (i18nCell $ MsgTutorialDayNote dday) $ \(preview $ resultParticipantDay . _tutorialParticipantDayNote . _Just -> x) -> x & cellMaybe textCell + -- , sortable (Just "parking") (i18nCell MsgTableUserParkingToken) $ \(preview $ resultUserDay . _userDayParkingToken -> x) -> maybeCell x tickmarkCell ] dbtSorting = Map.fromList [ sortUserNameLink queryUser @@ -450,28 +462,30 @@ postSchoolDayR ssh nd = do , dailyFormParkingToken = row ^? resultUserDay . _userDayParkingToken & fromMaybe False } (fmap unFormResult -> tableRes,tableDaily) <- runDB $ mkDailyTable isAdmin ssh nd - formResult tableRes $ \resMap -> runDB $ do - forM_ (Map.toList resMap) $ \(tpid, DailyFormData{..}) -> do - TutorialParticipant{..} <- get404 tpid -- needed anyway to find the ParticipantDay/UserDay updated - when ( tutorialParticipantDrivingPermit /= dailyFormDrivingPermit - || tutorialParticipantEyeExam /= dailyFormEyeExam - || tutorialParticipantNote /= dailyFormParticipantNote) $ - update tpid [ TutorialParticipantDrivingPermit =. dailyFormDrivingPermit - , TutorialParticipantEyeExam =. dailyFormEyeExam - , TutorialParticipantNote =. dailyFormParticipantNote - ] - let tpdUq = UniqueTutorialParticipantDay tutorialParticipantTutorial tutorialParticipantUser nd - if not dailyFormAttendance && isNothing (canonical dailyFormAttendanceNote) - then deleteBy tpdUq - else upsertBy_ tpdUq (TutorialParticipantDay tutorialParticipantTutorial tutorialParticipantUser nd dailyFormAttendance dailyFormAttendanceNote) - [ TutorialParticipantDayAttendance =. dailyFormAttendance - , TutorialParticipantDayNote =. dailyFormAttendanceNote - ] - let udUq = UniqueUserDay tutorialParticipantUser nd - updateUserDay = if dailyFormParkingToken - then flip upsertBy_ (UserDay tutorialParticipantUser nd dailyFormParkingToken) -- upsert if a permit was issued - else updateBy -- only update to no permit, if the record exists, but do not create a fresh record with parkingToken==False - updateUserDay udUq [ UserDayParkingToken =. dailyFormParkingToken] + formResult tableRes $ \resMap -> do + runDB $ do + forM_ (Map.toList resMap) $ \(tpid, DailyFormData{..}) -> do + -- $logDebugS "TableForm" (tshow dfd) + TutorialParticipant{..} <- get404 tpid -- needed anyway to find the ParticipantDay/UserDay updated + when ( tutorialParticipantDrivingPermit /= dailyFormDrivingPermit + || tutorialParticipantEyeExam /= dailyFormEyeExam + || tutorialParticipantNote /= dailyFormParticipantNote) $ + update tpid [ TutorialParticipantDrivingPermit =. dailyFormDrivingPermit + , TutorialParticipantEyeExam =. dailyFormEyeExam + , TutorialParticipantNote =. dailyFormParticipantNote + ] + let tpdUq = UniqueTutorialParticipantDay tutorialParticipantTutorial tutorialParticipantUser nd + if not dailyFormAttendance && isNothing (canonical dailyFormAttendanceNote) + then deleteBy tpdUq + else upsertBy_ tpdUq (TutorialParticipantDay tutorialParticipantTutorial tutorialParticipantUser nd dailyFormAttendance dailyFormAttendanceNote) + [ TutorialParticipantDayAttendance =. dailyFormAttendance + , TutorialParticipantDayNote =. dailyFormAttendanceNote + ] + let udUq = UniqueUserDay tutorialParticipantUser nd + updateUserDay = if dailyFormParkingToken + then flip upsertBy_ (UserDay tutorialParticipantUser nd dailyFormParkingToken) -- upsert if a permit was issued + else updateBy -- only update to no permit, if the record exists, but do not create a fresh record with parkingToken==False + updateUserDay udUq [ UserDayParkingToken =. dailyFormParkingToken] -- TODO: audit log? addMessageI Success $ MsgTutorialParticipantsDayEdits $ Map.size resMap redirect $ SchoolR ssh $ SchoolDayR nd