chore(day): complete form columns for daily view (untested)
unfortunately `make start` does not enter DEVELOPMENT mode currently, so this is not yet testeted.
This commit is contained in:
parent
e1dca7d6b0
commit
cd76bdd4e7
@ -55,4 +55,5 @@ TutorialDrivingPermit: Führerschein
|
||||
TutorialEyeExam: Sehtest
|
||||
TutorialNote: Kursnotiz
|
||||
TutorialDayAttendance day@Text: Anwesenheit am #{day}
|
||||
TutorialDayNote day@Text: Anwesenheitsnotiz für #{day}
|
||||
TutorialDayNote day@Text: Anwesenheitsnotiz für #{day}
|
||||
TutorialParticipantsDayEdits n@Int: #{tshow n} Kursteilnehmer-Tagesnotizen aktualisiert
|
||||
@ -56,4 +56,5 @@ TutorialDrivingPermit: Driving permit
|
||||
TutorialEyeExam: Eye exam
|
||||
TutorialNote: Course note
|
||||
TutorialDayAttendance day: Attendance #{day}
|
||||
TutorialDayNote day: Attendance note #{day}
|
||||
TutorialDayNote day: Attendance note #{day}
|
||||
TutorialParticipantsDayEdits n@Int: #{tshow n} course participant day notes updated
|
||||
@ -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)}
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user