diff --git a/messages/uniworx/categories/courses/tutorial/de-de-formal.msg b/messages/uniworx/categories/courses/tutorial/de-de-formal.msg index 4311bf005..5969b085e 100644 --- a/messages/uniworx/categories/courses/tutorial/de-de-formal.msg +++ b/messages/uniworx/categories/courses/tutorial/de-de-formal.msg @@ -55,4 +55,5 @@ TutorialDrivingPermit: Führerschein TutorialEyeExam: Sehtest TutorialNote: Kursnotiz TutorialDayAttendance day@Text: Anwesenheit am #{day} -TutorialDayNote day@Text: Anwesenheitsnotiz für #{day} \ No newline at end of file +TutorialDayNote day@Text: Anwesenheitsnotiz für #{day} +TutorialParticipantsDayEdits n@Int: #{tshow n} Kursteilnehmer-Tagesnotizen aktualisiert \ No newline at end of file diff --git a/messages/uniworx/categories/courses/tutorial/en-eu.msg b/messages/uniworx/categories/courses/tutorial/en-eu.msg index 407bb1b88..b1e027eaa 100644 --- a/messages/uniworx/categories/courses/tutorial/en-eu.msg +++ b/messages/uniworx/categories/courses/tutorial/en-eu.msg @@ -56,4 +56,5 @@ TutorialDrivingPermit: Driving permit TutorialEyeExam: Eye exam TutorialNote: Course note TutorialDayAttendance day: Attendance #{day} -TutorialDayNote day: Attendance note #{day} \ No newline at end of file +TutorialDayNote day: Attendance note #{day} +TutorialParticipantsDayEdits n@Int: #{tshow n} course participant day notes updated \ No newline at end of file diff --git a/src/Handler/School/DayTasks.hs b/src/Handler/School/DayTasks.hs index de4680891..bcc7475d5 100644 --- a/src/Handler/School/DayTasks.hs +++ b/src/Handler/School/DayTasks.hs @@ -245,6 +245,13 @@ drivingPermitField = selectField' Nothing optionsFinite eyeExamField :: (RenderMessage (HandlerSite m) FormMessage, MonadHandler m, HandlerSite m ~ UniWorX) => Field m UserEyeExam eyeExamField = selectField' Nothing 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 + (views (resultParticipant . _entityKey) return) -- generate row identfifiers for use in form result + (\(view lg -> x) mkUnique -> + over (_1.mapped) (ls .~) . over _2 fvWidget <$> mreq f (fsUniq mkUnique k) (Just x) + ) -- Given the row data and a callback to make an input name suitably unique generate the MForm + colParticipantPermitField :: Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData))) colParticipantPermitField = colParticipantPermitField' _dailyFormDrivingPermit @@ -259,18 +266,18 @@ 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 "permit") (i18nCell MsgTutorialNote) $ formCell id +colParticipantEyeExamField' l = sortable (Just "eye-exam") (i18nCell MsgTutorialNote) $ 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-participant") (i18nCell MsgTutorialNote) $ (cellAttrs <>~ [("style","width:60%")]) <$> formCell id +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-participant") (Just $ Textarea <$> note) + mopt textareaField (fsUniq mkUnique "note-tutorial") (Just $ Textarea <$> note) ) colAttendanceField :: Text -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData))) @@ -281,7 +288,7 @@ colAttendanceField dday = sortable (Just "attendance") (i18nCell $ MsgTutorialDa ) colAttendanceNoteField :: Text -> Colonnade Sortable DailyTableData (DBCell _ (FormResult (DBFormResult TutorialParticipantId DailyFormData DailyTableData))) -colAttendanceNoteField dday = sortable (Just "note-attendance") (i18nCell $ MsgTutorialDayNote dday) $ (cellAttrs <>~ [("style","width:60%")]) <$> formCell id +colAttendanceNoteField dday = sortable (Just "note-attend") (i18nCell $ MsgTutorialDayNote dday) $ (cellAttrs <>~ [("style","width:60%")]) <$> 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 <$> @@ -343,18 +350,19 @@ mkDailyTable isAdmin ssh nd = do , colUserNameModalHdr MsgCourseParticipant ForProfileDataR , colUserMatriclenr isAdmin , sortable (Just "card-no") (i18nCell MsgAvsCardNo) $ \(preview $ resultUserAvs . _userAvsLastCardNo . _Just -> cn :: Maybe AvsFullCardNo) -> cellMaybe (textCell . tshowAvsFullCardNo) cn - , 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 , colParticipantPermitField , colParticipantEyeExamField , colParticipantNoteField , 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 ] dbtSorting = Map.fromList [ sortUserNameLink queryUser @@ -432,7 +440,42 @@ getSchoolDayR = postSchoolDayR postSchoolDayR ssh nd = do isAdmin <- hasReadAccessTo AdminR dday <- formatTime SelFormatDate nd - (_,tableDaily) <- runDB $ mkDailyTable isAdmin ssh nd + let unFormResult = getDBFormResult $ \row -> let tpt = row ^. resultParticipant . _entityVal + in DailyFormData + { dailyFormDrivingPermit = tpt ^. _tutorialParticipantDrivingPermit + , dailyFormEyeExam = tpt ^. _tutorialParticipantEyeExam + , dailyFormParticipantNote = tpt ^. _tutorialParticipantNote + , dailyFormAttendance = row ^? resultParticipantDay ._tutorialParticipantDayAttendance & fromMaybe False + , dailyFormAttendanceNote = row ^? resultParticipantDay ._tutorialParticipantDayNote . _Just + , 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] + -- TODO: audit log? + addMessageI Success $ MsgTutorialParticipantsDayEdits $ Map.size resMap + redirect $ SchoolR ssh $ SchoolDayR nd + siteLayoutMsg (MsgMenuSchoolDay ssh dday) $ do setTitleI (MsgMenuSchoolDay ssh dday) [whamlet|TODO Overview School #{ciOriginal (unSchoolKey ssh)} diff --git a/src/Utils/DB.hs b/src/Utils/DB.hs index 7cf9dc8a9..24b71dec3 100644 --- a/src/Utils/DB.hs +++ b/src/Utils/DB.hs @@ -202,6 +202,13 @@ upsertBySafe uniq newr upd = maybeM (insertUnique newr) do_upd (getBy uniq) delete oid insertUnique $ upd oldr +upsertBy_ :: ( MonadIO m + , PersistEntity record + , PersistUniqueWrite backend + , PersistEntityBackend record ~ BaseBackend backend + ) + => Unique record -> record -> [Update record] -> ReaderT backend m () +upsertBy_ = ((void .) .) . upsertBy checkUniqueKeys :: ( MonadIO m , PersistUniqueRead backend