diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 39bd3310d..918c007d9 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -19,8 +19,7 @@ BtnCorrInvDecline: Ablehnen Aborted: Abgebrochen Remarks: Hinweise Registered: Angemeldet -RegisteredHeader: Anmeldung -RegisteredSince date@Text: Angemeldet seit #{date} +RegisteredSince: Angemeldet seit 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 diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 6fcc56968..c50780b77 100644 --- a/src/Handler/Course.hs +++ b/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) - _other -> mreq (studyFeaturesPrimaryFieldFor [ ] loggedin) (fslI MsgCourseStudyFeature + -> mforced (studyFeaturesPrimaryFieldFor False [sfid] loggedin) (fslI MsgCourseStudyFeature) (Just sfid) + _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
@@ -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 - formResult noteRes $ \mbNote -> (do + let noteFrag :: Text + 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! - maybeM (return ()) (\nk -> deleteWhere [CourseUserNoteEditNote ==. nk]) (getKeyBy thisUniqueNote) - deleteBy thisUniqueNote + -- must delete all edits due to foreign key constraints, which does not make sense -> refactor! + maybeM (return ()) (\nk -> deleteWhere [CourseUserNoteEditNote ==. nk]) (getKeyBy 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] - void . insert $ CourseUserNoteEdit dozentId now noteKey + (Entity noteKey _) <- upsertBy thisUniqueNote (CourseUserNote cid uid note) [CourseUserNoteNote =. note] + void . insert $ CourseUserNoteEdit dozentId now noteKey addMessageI Success MsgCourseUserNoteSaved - redirect currentRoute -- reload page after post - ) - -- De-/Register Button for Lecturer - mRegAt <- traverse (formatTime SelFormatDateTime) $ courseParticipantRegistration <$> registration - ((registerRes,registerView), registerEnctype) <- runFormPost $ registerForm (Just uid) registration Nothing Nothing -- Lecturers are never asked their own register secret - formResult registerRes $ \(mbSfId, _secretCorrect) -> if -- lecturers need no secret verification - | isJust registration -> do - runDB $ deleteBy $ UniqueParticipant uid cid + redirect $ currentRoute :#: noteFrag -- reload page after post + + ((regFieldRes, regFieldView), regFieldEnctype) <- runFormPost . identifyForm FIDcRegField $ \csrf -> + let currentField :: Maybe (Maybe StudyFeaturesId) + currentField = courseParticipantField . entityVal <$> mRegistration + in over _2 ((toWidget csrf <>) . fvInput) <$> mreq (studyFeaturesPrimaryFieldFor True (maybeToList $ join currentField) $ Just uid) ("" & addAutosubmit) currentField + + 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 - actTime <- liftIO getCurrentTime - regOk <- runDB $ insertUnique $ CourseParticipant cid uid actTime mbSfId - when (isJust regOk) $ addMessageI Success MsgCourseRegisterOk + redirect $ CourseR tid ssh csh CUsersR + | otherwise + -> invalidArgs ["User not registered"] + 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 diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 225886a1a..aa3828422 100644 --- a/src/Handler/Utils/Form.hs +++ b/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 oldFeatures mbuid = selectField $ do +studyFeaturesPrimaryFieldFor :: Bool -- ^ Allow user to select `Nothing` (only applies if set of options is nonempty)? + -> [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 diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index 574866084..88e08be1f 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/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 diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs index 412dd5b0c..daab376d3 100644 --- a/src/Utils/Form.hs +++ b/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 diff --git a/static/js/utils/form.js b/static/js/utils/form.js index 4312b5099..f19b27f52 100644 --- a/static/js/utils/form.js +++ b/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: + * + */ + + 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 diff --git a/templates/course-user.hamlet b/templates/course-user.hamlet index c7ae5a0c6..dd0bac222 100644 --- a/templates/course-user.hamlet +++ b/templates/course-user.hamlet @@ -9,17 +9,16 @@ #{matnr} $nothing _{MsgNoMatrikelKnown} -
_{MsgRegisteredHeader} + $maybe date <- mRegAt +
_{MsgRegisteredSince} +
#{date} +
-
- -
- ^{registerView} - $maybe date <- mRegAt - _{MsgRegisteredSince date} - - -
_{MsgStudyTerms} + ^{regButtonWidget} + $maybe _ <- mRegistration +

+ _{MsgCourseDeregisterLecturerTip} +

_{MsgStudyTerms}
$if null studies _{MsgNoStudyTermsKnown} @@ -35,15 +34,16 @@ _{MsgStudyFeatureUpdate} $forall ((Entity _ StudyFeatures{..}), (Entity _ degree), (Entity _ field)) <- studies $with _ <- notUsedT studyFeaturesUser - + _{field}#{notUsedT studyFeaturesField} _{degree}#{notUsedT studyFeaturesDegree} _{studyFeaturesType} #{display studyFeaturesSemester} #{hasTickmark studyFeaturesValid} ^{formatTimeW SelFormatDate studyFeaturesUpdated} + $maybe _ <- mRegistration +
_{MsgCourseStudyFeature} +
^{regFieldWidget}
- - - ^{noteView} + ^{noteWidget} diff --git a/templates/course.hamlet b/templates/course.hamlet index 29eac6294..93d788a26 100644 --- a/templates/course.hamlet +++ b/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}
Material