fix(daily): form submit now works as intended
This commit is contained in:
parent
eab39bc5db
commit
7a1f4b5a5f
@ -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
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user