chore(day): complete form columns for daily view (untested)

unfortunately `make start` does not enter DEVELOPMENT mode currently, so this is not yet testeted.

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}
+TutorialDayNote day@Text: Anwesenheitsnotiz für #{day}
+TutorialParticipantsDayEdits n@Int: #{tshow n} Kursteilnehmer-Tagesnotizen aktualisiert

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}
+TutorialDayNote day: Attendance note #{day}
+TutorialParticipantsDayEdits n@Int: #{tshow n} course participant day notes updated

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)}

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