Redesign course-user

messages/uniworx/de.msg

@@ -19,8 +19,7 @@ BtnCorrInvDecline: Ablehnen
 Aborted: Abgebrochen
 Remarks: Hinweise
 Registered: Angemeldet
-RegisteredHeader: Anmeldung
+RegisteredSince: Angemeldet seit
-RegisteredSince date@Text: Angemeldet seit #{date}
 RegisterFrom: Anmeldungen von
 RegisterTo: Anmeldungen bis
 DeRegUntil: Abmeldungen bis
@@ -74,7 +73,9 @@ TutorialNoCapacity: In dieser Übung sind keine Plätze mehr frei.
 CourseNotEmpty: In diesem Kurs sind momentan Teilnehmer angemeldet.
 CourseRegisterOk: Anmeldung erfolgreich
 CourseDeregisterOk: Erfolgreich abgemeldet
+CourseDeregisterLecturerTip: Wenn Sie den Teilnehmer vom Kurs abmelden kann es sein, dass sie Zugriff auf diese Daten verlieren
 CourseStudyFeature: Assoziiertes Hauptfach
+CourseStudyFeatureUpdated: Assoziiertes Hauptfach geändert
 CourseTutorial: Tutorium
 CourseStudyFeatureTooltip: Korrekte Angabe kann Notenweiterleitungen beschleunigen
 CourseSecretWrong: Falsches Kennwort

src/Handler/Course.hs

@@ -423,8 +423,8 @@ registerForm loggedin participant defSFid msecret = identifyForm FIDcourseRegist
       Nothing -> return (Nothing,Nothing)
       Just _  -> bimap Just Just <$> case participant of
         Just CourseParticipant{courseParticipantField=Just sfid}
-                -> mforced (studyFeaturesPrimaryFieldFor [sfid] loggedin) (fslI MsgCourseStudyFeature) (Just sfid)
+                -> mforced (studyFeaturesPrimaryFieldFor False [sfid] loggedin) (fslI MsgCourseStudyFeature) (Just sfid)
-        _other  -> mreq    (studyFeaturesPrimaryFieldFor [ ]    loggedin) (fslI MsgCourseStudyFeature
+        _other  -> mreq    (studyFeaturesPrimaryFieldFor False [ ]    loggedin) (fslI MsgCourseStudyFeature
                                                                  & setTooltip  MsgCourseStudyFeatureTooltip) (Just defSFid)
     -- button de-/register
     (btnRes, btnView) <- mreq (buttonField $ bool BtnRegister BtnDeregister isRegistered) "buttonField ignores settings anyway" Nothing
@@ -1140,7 +1140,7 @@ postCUsersR tid ssh csh = do
           , colUserDegreeShort
           , colUserField
           , colUserSemester
-          , sortable (Just "registration") (i18nCell MsgRegisteredHeader) (dateCell . view _userTableRegistration)
+          , sortable (Just "registration") (i18nCell MsgRegisteredSince) (dateCell . view _userTableRegistration)
           , colUserComment tid ssh csh
           ]
         psValidator = def & defaultSortingByName
@@ -1225,11 +1225,11 @@ postCUserR tid ssh csh uCId = do
   dozentId <- requireAuthId
   uid <- decrypt uCId
   -- DB reads
-  (cid, User{..}, registration, thisUniqueNote, noteText, noteEdits, studies ) <- runDB $ do
+  (cid, User{..}, mRegistration, thisUniqueNote, noteText, noteEdits, studies) <- runDB $ do
     cid  <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
     -- Abfrage Benutzerdaten
     user <- get404 uid
-    registration <- fmap entityVal <$> getBy (UniqueParticipant uid cid)
+    registration <- getBy (UniqueParticipant uid cid)
     -- Abfrage Teilnehmernotiz
     let thisUniqueNote = UniqueCourseUserNote uid cid
     mbNoteEnt <- getBy thisUniqueNote
@@ -1249,8 +1249,7 @@ postCUserR tid ssh csh uCId = do
       E.on $ studyfeat E.^. StudyFeaturesField  E.==. studyterms  E.^. StudyTermsId
       E.on $ studyfeat E.^. StudyFeaturesDegree E.==. studydegree E.^. StudyDegreeId
       return  (studyfeat, studydegree, studyterms)
-
+    return (cid, user, registration, thisUniqueNote, noteText, noteEdits, studies)
-    return (cid,user,registration,thisUniqueNote,noteText,noteEdits,studies)
   let editByWgt = [whamlet|
           $forall (etime,_eemail,ename,_esurname) <- noteEdits
             <br>
@@ -1259,36 +1258,93 @@ postCUserR tid ssh csh uCId = do
 
   ((noteRes, noteView), noteEnctype) <- runFormPost . identifyForm FIDcUserNote . renderAForm FormStandard $
       aopt (annotateField editByWgt htmlField') (fslpI MsgCourseUserNote "HTML" & setTooltip MsgCourseUserNoteTooltip) (Just noteText)
-      <*  saveButton
+  let noteFrag :: Text
-  formResult noteRes $ \mbNote -> (do
+      noteFrag = "notes"
+      noteWidget = wrapForm noteView FormSettings
+        { formMethod = POST
+        , formAction = Just . SomeRoute $ currentRoute :#: noteFrag
+        , formEncoding = noteEnctype
+        , formAttrs = []
+        , formSubmit = FormSubmit
+        , formAnchor = Just noteFrag
+        }
+  formResult noteRes $ \mbNote -> do
     now <- liftIO getCurrentTime
-    case mbNote of
+    runDB $ case mbNote of
       Nothing -> do
-        runDB $ do
+        -- must delete all edits due to foreign key constraints, which does not make sense -> refactor!
-          -- must delete all edits due to foreign key constraints, which does not make sense -> refactor!
+        maybeM (return ()) (\nk -> deleteWhere [CourseUserNoteEditNote ==. nk]) (getKeyBy thisUniqueNote)
-          maybeM (return ()) (\nk -> deleteWhere [CourseUserNoteEditNote ==. nk]) (getKeyBy thisUniqueNote)
+        deleteBy thisUniqueNote
-          deleteBy thisUniqueNote
         addMessageI Info MsgCourseUserNoteDeleted
-        redirect currentRoute -- reload page after post
+      _ | (renderHtml <$> mbNote) == (renderHtml <$> noteText) -> return () -- no changes
-      _ | (renderHtml <$> mbNote) == (renderHtml <$> noteText) -> return() -- no changes
       (Just note) -> do
-        runDB $ do
+        (Entity noteKey _) <- upsertBy thisUniqueNote (CourseUserNote cid uid note) [CourseUserNoteNote =. note]
-          (Entity noteKey _) <- upsertBy thisUniqueNote (CourseUserNote cid uid note) [CourseUserNoteNote =. note]
+        void . insert $ CourseUserNoteEdit dozentId now noteKey
-          void . insert $ CourseUserNoteEdit dozentId now noteKey
         addMessageI Success MsgCourseUserNoteSaved
-        redirect currentRoute -- reload page after post
+    redirect $ currentRoute :#: noteFrag -- reload page after post
-    )
+
-  -- De-/Register Button for Lecturer
+  ((regFieldRes, regFieldView), regFieldEnctype) <- runFormPost . identifyForm FIDcRegField $ \csrf ->
-  mRegAt   <- traverse (formatTime SelFormatDateTime) $ courseParticipantRegistration <$> registration
+    let currentField :: Maybe (Maybe StudyFeaturesId)
-  ((registerRes,registerView), registerEnctype) <- runFormPost $ registerForm (Just uid) registration Nothing Nothing -- Lecturers are never asked their own register secret
+        currentField = courseParticipantField . entityVal <$> mRegistration
-  formResult registerRes $ \(mbSfId, _secretCorrect) -> if -- lecturers need no secret verification
+     in over _2 ((toWidget csrf <>) . fvInput) <$> mreq (studyFeaturesPrimaryFieldFor True (maybeToList $ join currentField) $ Just uid) ("" & addAutosubmit) currentField
-      | isJust registration -> do
+
-          runDB $ deleteBy $ UniqueParticipant uid cid
+  let registrationFieldFrag :: Text
+      registrationFieldFrag = "registration-field"
+      regFieldWidget = wrapForm regFieldView FormSettings
+        { formMethod = POST
+        , formAction = Just . SomeRoute $ currentRoute :#: registrationFieldFrag
+        , formEncoding = regFieldEnctype
+        , formAttrs = []
+        , formSubmit = FormAutoSubmit
+        , formAnchor = Just registrationFieldFrag
+        }
+  for_ mRegistration $ \(Entity pId CourseParticipant{..}) ->
+    formResult regFieldRes $ \courseParticipantField' -> do
+      runDB $ do
+        update pId [ CourseParticipantField =. courseParticipantField' ]
+        addMessageI Success MsgCourseStudyFeatureUpdated
+      redirect $ currentRoute :#: registrationFieldFrag
+
+  let regButton
+        | Just _ <- mRegistration = BtnDeregister
+        | otherwise = BtnRegister
+  ((regButtonRes, regButtonView), regButtonEnctype) <- runFormPost . identifyForm FIDcRegButton $ buttonForm' [regButton]
+
+  let registrationButtonFrag :: Text
+      registrationButtonFrag = "registration-button"
+      regButtonWidget = wrapForm regButtonView FormSettings
+        { formMethod = POST
+        , formAction = Just . SomeRoute $ currentRoute :#: registrationButtonFrag
+        , formEncoding = regButtonEnctype
+        , formAttrs = []
+        , formSubmit = FormNoSubmit
+        , formAnchor = Just registrationButtonFrag
+        }
+  formResult regButtonRes $ \case
+    BtnDeregister
+      | Just (Entity pId _) <- mRegistration
+        -> do
+          runDB $ delete pId
           addMessageI Info MsgCourseDeregisterOk
-      | otherwise -> do
+          redirect $ CourseR tid ssh csh CUsersR
-          actTime <- liftIO getCurrentTime
+      | otherwise
-          regOk <- runDB $ insertUnique $ CourseParticipant cid uid actTime mbSfId
+        -> invalidArgs ["User not registered"]
-          when (isJust regOk) $ addMessageI Success MsgCourseRegisterOk
+    BtnRegister -> do
+      now <- liftIO getCurrentTime
+      let primaryField
+            | [(Entity featId _, _, _)] <- filter (\(Entity _ StudyFeatures{..}, _, _) -> studyFeaturesType == FieldPrimary && studyFeaturesValid) studies
+            = Just featId
+            | otherwise
+            = Nothing
+      pId <- runDB . insertUnique $ CourseParticipant cid uid now primaryField
+      case pId of
+        Just _  -> do
+          addMessageI Success MsgCourseRegisterOk
+          redirect currentRoute
+        Nothing -> invalidArgs ["User already registered"]
+
+  mRegAt <- for (courseParticipantRegistration . entityVal <$> mRegistration) $ formatTime SelFormatDateTime
+
   -- generate output
   let headingLong  = [whamlet|^{nameWidget userDisplayName userSurname} - _{MsgCourseMemberOf} #{csh} #{display tid}|]
       headingShort = prependCourseTitle tid ssh csh $ SomeMessage userDisplayName

src/Handler/Utils/Form.hs

@@ -287,8 +287,9 @@ schoolFieldFor :: [SchoolId] -> Field Handler SchoolId
 schoolFieldFor userSchools = selectField $ optionsPersistKey [SchoolShorthand <-. map unSchoolKey userSchools] [Asc SchoolName] schoolName
 
 -- | Select one of the user's primary active courses, or from a given list of StudyFeatures (regardless of user)
-studyFeaturesPrimaryFieldFor :: [StudyFeaturesId] -> Maybe UserId -> Field Handler (Maybe StudyFeaturesId)
+studyFeaturesPrimaryFieldFor :: Bool -- ^ Allow user to select `Nothing` (only applies if set of options is nonempty)?
-studyFeaturesPrimaryFieldFor oldFeatures mbuid = selectField $ do
+                             -> [StudyFeaturesId] -> Maybe UserId -> Field Handler (Maybe StudyFeaturesId)
+studyFeaturesPrimaryFieldFor isOptional oldFeatures mbuid = selectField $ do
     -- we need a join, so we cannot just use optionsPersistCryptoId
     rawOptions <- runDB $ E.select $ E.from $ \(feature `E.InnerJoin` degree `E.InnerJoin` field) -> do
         E.on     $   feature E.^. StudyFeaturesField  E.==. field  E.^. StudyTermsId
@@ -316,12 +317,15 @@ studyFeaturesPrimaryFieldFor oldFeatures mbuid = selectField $ do
 
     nonEmptyOptions :: Text -> [Option (Maybe StudyFeaturesId)] -> [Option (Maybe StudyFeaturesId)]
     nonEmptyOptions emptyOpt opts
-      | null opts = [ Option
+      | null opts  = pure nullOption
+      | isOptional = nullOption : opts
+      | otherwise  = opts
+      where
+        nullOption = Option
           { optionDisplay       = emptyOpt
           , optionInternalValue = Nothing
           , optionExternalValue = "NoPrimaryStudyField"
-          } ]
+          }
-      | otherwise = opts
 
 
 uploadModeField :: Field Handler UploadMode

src/Handler/Utils/Table/Pagination.hs

@@ -657,7 +657,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db
     (filterRes'@((filterRes, _), _)) <- runFormGet . identifyForm FIDDBTableFilter . addPIHiddenField dbtable (prevPi & _piFilter .~ Nothing & _piPage .~ Nothing & _piLimit .~ (formResult' pagesizeRes <|> piLimit prevPi)) . renderAForm FormDBTableFilter $ dbtFilterUI (piFilter prevPi)
 
     (pagesizeRes'@((pagesizeRes, _), _)) <- lift . runFormGet . identifyForm FIDDBTablePagesize . addPIHiddenField dbtable (prevPi & _piPage .~ Nothing & _piLimit .~ Nothing & _piFilter .~ (formResult' filterRes <|> piFilter prevPi)) . renderAForm FormDBTablePagesize $
-          areq (pagesizeField referencePagesize) (fslI MsgDBTablePagesize & addAutosubmit & addName (wIdent "pagesize") & addClass "select--pagesize") (Just referencePagesize)
+          areq (pagesizeField referencePagesize) (fslI MsgDBTablePagesize & addName (wIdent "pagesize") & addClass "select--pagesize") (Just referencePagesize)
     return (filterRes', pagesizeRes')
 
   let

src/Utils/Form.hs

@@ -153,7 +153,7 @@ inputReadonly :: FieldSettings site -> FieldSettings site
 inputReadonly = addAttr "readonly" ""
 
 addAutosubmit :: FieldSettings site -> FieldSettings site
-addAutosubmit = addAttr "data-autosubmit" ""
+addAutosubmit = addAttr "uw-auto-submit-input" ""
 
 ------------------------------------------------
 -- Unique Form Identifiers to avoid accidents --
@@ -183,6 +183,8 @@ data FormIdentifier
   | FIDCourseRegister
   | FIDuserRights
   | FIDcUserNote
+  | FIDcRegField
+  | FIDcRegButton
   | FIDAdminDemo
   | FIDUserDelete
   | FIDCommunication
@@ -340,9 +342,6 @@ combinedButtonFieldF_ _ = void . combinedButtonFieldF @m @a
 submitButton :: (Button (HandlerSite m) ButtonSubmit, MonadHandler m) => AForm m ()
 submitButton = combinedButtonFieldF_ (Proxy @ButtonSubmit) ""
 
-autosubmitButton :: (Button (HandlerSite m) ButtonSubmit, MonadHandler m) => AForm m ()
-autosubmitButton = combinedButtonFieldF_ (Proxy @ButtonSubmit) $ "" & addAutosubmit
-
 -- | just Html for a Submit-Button
 submitButtonView :: forall site . Button site ButtonSubmit => WidgetT site IO ()
 submitButtonView = buttonView BtnSubmit

static/js/utils/form.js

@@ -286,6 +286,61 @@
     setup: autoSubmitButtonUtil,
   });
 
+  /**
+   *
+   * Auto Submit Input Utility
+   *  Programmatically submits forms when a certain input changes value
+   *
+   * Attribute: uw-auto-submit-input
+   *
+   * Example usage:
+   *  <input type="text" uw-auto-submit-input />
+   */
+
+  var AUTO_SUBMIT_INPUT_UTIL_NAME = 'autoSubmitInput';
+  var AUTO_SUBMIT_INPUT_UTIL_SELECTOR = '[uw-auto-submit-input]';
+
+  var AUTO_SUBMIT_INPUT_INITIALIZED_CLASS = 'auto-submit-input--initialized';
+
+  var autoSubmitInputUtil = function(element) {
+    var form;
+    
+    function autoSubmit() {
+      form.submit();
+    }
+
+    function init() {
+      if (!element) {
+        throw new Error('Auto Submit Input utility needs to be passed an element!');
+      }
+
+      form = element.form;
+      if (!form) {
+        throw new Error('Could not determine associated form for auto submit input');
+      }
+
+      element.addEventListener('change', autoSubmit);
+      
+      element.classList.add(AUTO_SUBMIT_INPUT_INITIALIZED_CLASS);
+
+      return {
+        name: AUTO_SUBMIT_INPUT_UTIL_NAME,
+        element: element,
+        destroy: function() { 
+          element.removeEventListener('change', autoSubmit);
+        },
+      };
+    }
+
+    return init();
+  };
+
+  formUtilities.push({
+    name: AUTO_SUBMIT_INPUT_UTIL_NAME,
+    selector: AUTO_SUBMIT_INPUT_UTIL_SELECTOR,
+    setup: autoSubmitInputUtil,
+  });
+
   /**
    *
    * Form Error Remover Utility

templates/course-user.hamlet

@@ -9,17 +9,16 @@
             #{matnr}
           $nothing
             _{MsgNoMatrikelKnown}
-        <dt .deflist__dt>_{MsgRegisteredHeader}
+        $maybe date <- mRegAt
+          <dt .deflist__dt>_{MsgRegisteredSince}
+          <dd .deflist__dd>#{date}
+        <dt .deflist__dt>
         <dd .deflist__dd>
-          <div .course__registration>
+          ^{regButtonWidget}
-            <a id="register-form">
+          $maybe _ <- mRegistration
-            <form method=post action=@{currentRoute}#register-form enctype=#{registerEnctype}>
+            <p>
-              ^{registerView}
+              _{MsgCourseDeregisterLecturerTip}
-            $maybe date <- mRegAt
+        <dt .deflist__dt>_{MsgStudyTerms}
-              _{MsgRegisteredSince date}
-
-
-        <dt .deflist__dt> _{MsgStudyTerms}
         <dd .deflist__dd>
           $if null studies
             _{MsgNoStudyTermsKnown}
@@ -35,15 +34,16 @@
                   <th .table__th>_{MsgStudyFeatureUpdate}
                 $forall ((Entity _ StudyFeatures{..}), (Entity _ degree), (Entity _ field)) <- studies
                   $with _ <- notUsedT studyFeaturesUser
-                  <tr.table__row>
+                  <tr .table__row>
                     <td .table__td>_{field}#{notUsedT studyFeaturesField}
                     <td .table__td>_{degree}#{notUsedT studyFeaturesDegree}
                     <td .table__td>_{studyFeaturesType}
                     <td .table__td>#{display studyFeaturesSemester}
                     <td .table__td>#{hasTickmark studyFeaturesValid}
                     <td .table__td>^{formatTimeW SelFormatDate studyFeaturesUpdated}
+        $maybe _ <- mRegistration
+          <dt .deflist__dt>_{MsgCourseStudyFeature}
+          <dd .deflist__dd>^{regFieldWidget}
 
 <section>
-  <a id="note-form">
+  ^{noteWidget}
-  <form method=post action=@{currentRoute}#note-form enctype=#{noteEnctype}>
-    ^{noteView}

templates/course.hamlet

@@ -83,7 +83,7 @@ $#    $if NTop (Just 0) < NTop (courseCapacity course)
           $# regForm is defined through templates/widgets/registerForm
           ^{regForm}
         $maybe date <- mRegAt
-          _{MsgRegisteredSince date}
+          _{MsgRegisteredSince} #{date}
   <dt .deflist__dt>
     Material
   <dd .deflist__dd>