From d495a31ad821c8c10de497f1ab64d90417ae37da Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Mon, 25 Sep 2023 06:48:49 +0000 Subject: [PATCH 01/36] chore(qualifications): thoughts on the prerequisite modelling --- models/lms.model | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/models/lms.model b/models/lms.model index 616940762..9f3fc2288 100644 --- a/models/lms.model +++ b/models/lms.model @@ -40,18 +40,19 @@ Qualification -- - PinReset==1 mit bestehendem Passwort kann problemlos erneut gesendet werden -- - Flag "interner Mitarbeiter" wird von Know-How ignoriert / nicht ausgewertet (legacy) -QualificationPrecondition -- NOTE: this can only be enforced through a background job adding or removing qualifications - qualification QualificationId OnDeleteCascade OnUpdateCascade -- AND: not unique, ie. qualification can have multiple required preconditions - required [QualificationId] -- OR : alternatives, any one will suffice - continuous Bool -- expiring precondition blocks qualification - deriving Generic +-- QualificationPrecondition -- NOTE: this can only be enforced through a background job adding or removing qualifications +-- qualification QualificationId OnDeleteCascade OnUpdateCascade -- AND: not unique, ie. qualification can have multiple required preconditions +-- required [QualificationId] -- OR : alternatives, any one will suffice +-- continuous Bool -- expiring precondition blocks qualification +-- deriving Generic -- Maybe an alternative for online qualification validity checking, transitivity through recursive CTEs? (already available in our version) --- QualificationRequirement --- qualification QualificationId OnDeleteCascade OnUpdateCascade --- requirement QualificationId OnDeleteCascade OnUpdateCascade --- group Text -- OR: several requirements within the same group are considered equivalent --- UniqueQualificationRequirement qualification requirement +QualificationRequirement + qualification QualificationId OnDeleteCascade OnUpdateCascade + requirement QualificationId OnDeleteCascade OnUpdateCascade + group Text -- OR: several requirements within the same group are considered equivalent + UniqueQualificationRequirement qualification requirement + deriving Generic -- -- TODO: connect Qualification with Exams! @@ -81,6 +82,7 @@ QualificationUserBlock from UTCTime reason Text blocker UserId Maybe + precondition Bool default=false -- if true, this was due to a precondition deriving Eq Ord Read Show Generic -- LMS Interface Tables, need regular processing by background jobs, per QualificationId: From e4883c62d0e3bc09fd7d0c25ebd024807f35bd46 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Fri, 20 Oct 2023 16:49:08 +0000 Subject: [PATCH 02/36] chore(test): ensure test branch uses different filenames and idents --- src/Handler/Utils/LMS.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Handler/Utils/LMS.hs b/src/Handler/Utils/LMS.hs index eb619276b..3c0aa14e7 100644 --- a/src/Handler/Utils/LMS.hs +++ b/src/Handler/Utils/LMS.hs @@ -125,7 +125,7 @@ csvFilenameLmsReport = makeLmsFilename "report" makeLmsFilename :: MonadHandler m => Text -> QualificationShorthand -> m Text makeLmsFilename ftag (citext2lower -> qsh) = do ymth <- getYMTH - return $ "fradrive_" <> qsh <> "_" <> ftag <> "_" <> ymth <> ".csv" + return $ "fradrive_" <> "test" <> "_" <> qsh <> "_" <> ftag <> "_" <> ymth <> ".csv" -- | Return current datetime in YYYYMMDDHH format getYMTH :: MonadHandler m => m Text @@ -213,8 +213,8 @@ randomText extra n = fmap pack . evalRandTIO . replicateM n $ uniform range -- eopt = Elo.genOptions -- { genCapitals = False, genSpecials = False, genDigitis = True } randomLMSIdent :: MonadIO m => Maybe Char -> m LmsIdent -randomLMSIdent Nothing = LmsIdent . Text.cons 'j' <$> randomText [] (pred lengthIdent) -- idents must not contain '_' nor '-' -randomLMSIdent (Just c) = LmsIdent . Text.cons c <$> randomText [] (pred lengthIdent) +randomLMSIdent Nothing = LmsIdent . Text.cons 't' . Text.cons 'j' <$> randomText [] (pred $ pred lengthIdent) -- idents must not contain '_' nor '-' +randomLMSIdent (Just c) = LmsIdent . Text.cons 't' . Text.cons c <$> randomText [] (pred $ pred lengthIdent) randomLMSIdentBut :: MonadIO m => Maybe Char -> Set LmsIdent -> m (Maybe LmsIdent) randomLMSIdentBut prefix banList = untilJustMaxM maxLmsUserIdentRetries getIdentOk From bc4594bea250df07ade834fd908f092c0423e785 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Mon, 23 Oct 2023 08:02:03 +0000 Subject: [PATCH 03/36] fix(build): comment planned model changes --- models/lms.model | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/models/lms.model b/models/lms.model index 9f3fc2288..d501899f7 100644 --- a/models/lms.model +++ b/models/lms.model @@ -47,15 +47,15 @@ Qualification -- deriving Generic -- Maybe an alternative for online qualification validity checking, transitivity through recursive CTEs? (already available in our version) -QualificationRequirement - qualification QualificationId OnDeleteCascade OnUpdateCascade - requirement QualificationId OnDeleteCascade OnUpdateCascade - group Text -- OR: several requirements within the same group are considered equivalent - UniqueQualificationRequirement qualification requirement - deriving Generic +--QualificationRequirement +-- qualification QualificationId OnDeleteCascade OnUpdateCascade +-- requirement QualificationId OnDeleteCascade OnUpdateCascade +-- group Text -- OR: several requirements within the same group are considered equivalent +-- UniqueQualificationRequirement qualification requirement +-- deriving Generic -- --- TODO: connect Qualification with Exams! +-- TODO: connect Qualifications with Exams!? QualificationEdit user UserId @@ -82,7 +82,7 @@ QualificationUserBlock from UTCTime reason Text blocker UserId Maybe - precondition Bool default=false -- if true, this was due to a precondition + -- precondition Bool default=false -- if true, this was due to a precondition deriving Eq Ord Read Show Generic -- LMS Interface Tables, need regular processing by background jobs, per QualificationId: From 307cda543e1536f109e83ff16ae2af97cf803b22 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Thu, 26 Oct 2023 17:14:40 +0000 Subject: [PATCH 04/36] chore(release): 27.4.46 --- CHANGELOG.md | 26 ++++++++++++++++++++++++++ nix/docker/version.json | 2 +- package-lock.json | 2 +- package.json | 2 +- package.yaml | 2 +- 5 files changed, 30 insertions(+), 4 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 5d9b7616d..96b4434b0 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,32 @@ All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines. +## [27.4.46](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/t27.4.35...t27.4.46) (2023-10-26) + + +### Bug Fixes + +* **build:** comment planned model changes ([bc4594b](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/bc4594bea250df07ade834fd908f092c0423e785)) +* **build:** minor ([954a239](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/954a23936a35ea6c32247d7e191312e63888c12d)) +* **build:** Update ParticipantInvite.hs ([f888da3](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/f888da3ab0df45bb3c515ebb7cbb43569fdaa1fa)) +* **build:** Update ParticipantInvite.hs ([fa4f9b2](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/fa4f9b24475261afc1e534541c8878a85e6a1b10)) +* **build:** Update Utils.hs ([87f0b2e](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/87f0b2edab2bcf696b7b776e47272ef2204c0b75)) +* **course:** grant qualifications now issues and unblocks ([5d8d8cf](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/5d8d8cf17e634ecb950a1c329c859fb93f94ef77)) +* **firm:** foreign supervisor counts correct and sortable ([601ce7a](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/601ce7abdf2a392d30f1ff799a2338968be795f1)) +* **hoogle:** remove erroneous comment ([c011d88](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/c011d887cece8338920355b540aa4b233e0b994f)) +* **lms:** disable workaround for late lms success ([cb9e09d](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/cb9e09d071d22f41a92ab8140d7aaa643c748373)) +* **lms:** do not mark lms users with open status as ended ([a848126](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/a84812640f02981875275c96e37338de4ab49996)) +* **lms:** sorting and filtering lms status ([f48862e](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/f48862efbcb95e92203a200267e1bcc613af4af1)) +* **lms:** sorting and filtering lms status works throughout now ([ae44703](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/ae4470333e2b1b5c271b38092210c094822f4a19)) +* **print:** apc ident aliases did not stop at first success ([b7d4f69](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/b7d4f6913d8b1a70c1b7ef73782cf29861dc11a7)) +* **qualifications:** latest block could ignore itself ([bb708ca](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/bb708ca540557b41d33996cfea9a390a457ed855)) +* **sap:** combine immediate next day licence chnages for SAP ([f4adfdf](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/f4adfdf87270930d4ca6611f2a9956613fcace53)) +* **sap:** combine immediate next day licence chnages for SAP ([cbb44f1](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/cbb44f106ad59e0a53ca04963ade5544120b7e21)) +* **sap:** combineBlocks yet another bug squashed ([3924d14](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/3924d14abd868305b42c9d04913536b4999dc45b)) +* **sap:** compileBlocks ([b4a88ab](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/b4a88abcf85783c350ad2bf3a5e973d13d1eb1f6)) +* **sap:** yet another fix for finding date intervals ([fde97b0](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/fde97b048ab04ab59c9e3f2a2f74bb2c1e996b22)) +* **users:** allow prefer postal setting for users with fraport department ([a9d56c5](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/a9d56c51dcc727f8637b09a0e849372e75032f5e)) + ## [27.4.45](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.44...v27.4.45) (2023-10-18) diff --git a/nix/docker/version.json b/nix/docker/version.json index 77bb560f7..2e7f57f38 100644 --- a/nix/docker/version.json +++ b/nix/docker/version.json @@ -1,3 +1,3 @@ { - "version": "27.4.45" + "version": "27.4.46" } diff --git a/package-lock.json b/package-lock.json index 31b4132f1..2c3044679 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "27.4.45", + "version": "27.4.46", "lockfileVersion": 1, "requires": true, "dependencies": { diff --git a/package.json b/package.json index 014db6ed0..b9d237fac 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "27.4.45", + "version": "27.4.46", "description": "", "keywords": [], "author": "", diff --git a/package.yaml b/package.yaml index 42efdc6bb..5bc45e960 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: uniworx -version: 27.4.45 +version: 27.4.46 dependencies: - base - yesod From 2a4158303e5c57e2b768fe6ba617a46c2b4eddcb Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Fri, 27 Oct 2023 23:49:40 +0000 Subject: [PATCH 05/36] chore(release): 27.4.47 --- CHANGELOG.md | 2 ++ nix/docker/version.json | 2 +- package-lock.json | 2 +- package.json | 2 +- package.yaml | 2 +- 5 files changed, 6 insertions(+), 4 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 96b4434b0..4a3f2b2cb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,8 @@ All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines. +## [27.4.47](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/t27.4.46...t27.4.47) (2023-10-27) + ## [27.4.46](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/t27.4.35...t27.4.46) (2023-10-26) diff --git a/nix/docker/version.json b/nix/docker/version.json index 2e7f57f38..ab8350d96 100644 --- a/nix/docker/version.json +++ b/nix/docker/version.json @@ -1,3 +1,3 @@ { - "version": "27.4.46" + "version": "27.4.47" } diff --git a/package-lock.json b/package-lock.json index 2c3044679..db2b94dbc 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "27.4.46", + "version": "27.4.47", "lockfileVersion": 1, "requires": true, "dependencies": { diff --git a/package.json b/package.json index b9d237fac..24ecd1bcc 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "27.4.46", + "version": "27.4.47", "description": "", "keywords": [], "author": "", diff --git a/package.yaml b/package.yaml index 5bc45e960..edd6f7dcc 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: uniworx -version: 27.4.46 +version: 27.4.47 dependencies: - base - yesod From de005691f1534f73a2131c9628981069827fb1c5 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Fri, 3 Nov 2023 16:59:25 +0000 Subject: [PATCH 06/36] chore(release): 27.4.48 --- CHANGELOG.md | 2 ++ nix/docker/version.json | 2 +- package-lock.json | 2 +- package.json | 2 +- package.yaml | 2 +- 5 files changed, 6 insertions(+), 4 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 8f715c83e..74002cf3a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,8 @@ All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines. +## [27.4.48](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/t27.4.47...t27.4.48) (2023-11-03) + ## [27.4.47](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.46...v27.4.47) (2023-11-03) ## [27.4.46](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.45...v27.4.46) (2023-11-03) diff --git a/nix/docker/version.json b/nix/docker/version.json index ab8350d96..128f6e4a8 100644 --- a/nix/docker/version.json +++ b/nix/docker/version.json @@ -1,3 +1,3 @@ { - "version": "27.4.47" + "version": "27.4.48" } diff --git a/package-lock.json b/package-lock.json index db2b94dbc..67f032ee5 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "27.4.47", + "version": "27.4.48", "lockfileVersion": 1, "requires": true, "dependencies": { diff --git a/package.json b/package.json index 24ecd1bcc..04e02d31c 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "27.4.47", + "version": "27.4.48", "description": "", "keywords": [], "author": "", diff --git a/package.yaml b/package.yaml index edd6f7dcc..de481c5b4 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: uniworx -version: 27.4.47 +version: 27.4.48 dependencies: - base - yesod From aa41004c39364e191e78212136587ec0d1bc00b0 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Thu, 9 Nov 2023 10:21:10 +0000 Subject: [PATCH 07/36] chore(release): 27.4.49 --- CHANGELOG.md | 10 ++++++++++ nix/docker/version.json | 2 +- package-lock.json | 2 +- package.json | 2 +- package.yaml | 2 +- 5 files changed, 14 insertions(+), 4 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index dfb8ece65..1eefa6acb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,16 @@ All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines. +## [27.4.49](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/t27.4.48...t27.4.49) (2023-11-09) + + +### Bug Fixes + +* **build:** fix whitespace in routes ([a24e44e](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/a24e44efc9a20d3934d96640bb9e21b3b6d55b96)) +* **lms:** improve sorting for firm all ([3865bda](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/3865bda64d488c161b55e1f6eb48ca1b742dff98)) +* **lms:** mark as ended only if not seen for at least one day ([8165892](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/8165892b2e4f945780bb8420cfc4eed50fdd294d)) +* **lms:** report log did not match qualification ([390ff31](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/commit/390ff317ea3bb4ef8918c9cda858f5f228e4a882)) + ## [27.4.48](https://gitlab2.rz.ifi.lmu.de/uni2work/uni2work/compare/v27.4.47...v27.4.48) (2023-11-07) diff --git a/nix/docker/version.json b/nix/docker/version.json index 128f6e4a8..ae41d9f2a 100644 --- a/nix/docker/version.json +++ b/nix/docker/version.json @@ -1,3 +1,3 @@ { - "version": "27.4.48" + "version": "27.4.49" } diff --git a/package-lock.json b/package-lock.json index 67f032ee5..a24e9106c 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "27.4.48", + "version": "27.4.49", "lockfileVersion": 1, "requires": true, "dependencies": { diff --git a/package.json b/package.json index 04e02d31c..b11cc7651 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "27.4.48", + "version": "27.4.49", "description": "", "keywords": [], "author": "", diff --git a/package.yaml b/package.yaml index de481c5b4..04e5ca14e 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: uniworx -version: 27.4.48 +version: 27.4.49 dependencies: - base - yesod From d332c0c11afd8b1dfe1343659f0b1626c968bbde Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Thu, 25 Jan 2024 13:19:09 +0100 Subject: [PATCH 08/36] fix(course): fix #147 abort addd participant aborts now Check that runButtonForm will always work with the correct field ids! --- .../courses/courses/de-de-formal.msg | 2 +- src/Handler/Course/ParticipantInvite.hs | 38 +++++++++++-------- src/Utils/Form.hs | 4 +- 3 files changed, 26 insertions(+), 18 deletions(-) diff --git a/messages/uniworx/categories/courses/courses/de-de-formal.msg b/messages/uniworx/categories/courses/courses/de-de-formal.msg index a0bf4391e..d8faf2d87 100644 --- a/messages/uniworx/categories/courses/courses/de-de-formal.msg +++ b/messages/uniworx/categories/courses/courses/de-de-formal.msg @@ -95,7 +95,7 @@ CourseParticipantsInvited n@Int: #{n} #{pluralDE n "Einladung" "Einladungen"} pe CourseParticipantsAlreadyRegistered n@Int: #{n} #{pluralDE n "Teinehmer:in" "Teilnehmer:innen"} #{pluralDE n "ist" "sind"} bereits zur Kursart angemeldet CourseParticipantsAlreadyTutorialMember n@Int: #{n} #{pluralDE n "Teinehmer:in" "Teilnehmer:innen"} #{pluralDE n "ist" "sind"} bereits in dieser Kurs angemeldet CourseParticipantsRegistered n@Int: #{n} #{pluralDE n "Teinehmer:in" "Teilnehmer:innen"} erfolgreich zur Kursart angemeldet -CourseParticipantsRegisteredTutorial n@Int: #{n} #{pluralDE n "Teinehmer:in" "Teilnehmer:innen"} erfolgreich zur Kurs angemeldet +CourseParticipantsRegisteredTutorial n@Int: #{n} #{pluralDE n "Teinehmer:in" "Teilnehmer:innen"} erfolgreich zum Kurs angemeldet CourseParticipantsRegisterConfirmationHeading: Teilnehmer:innen hinzufügen CourseParticipantsRegisterUnnecessary: Alle angeforderten Anmeldungen sind bereits vorhanden. Es wurden keine Änderungen vorgenommen. CourseParticipantsRegisterConfirmInvalid: Ungültiges Bestätigungsformular! diff --git a/src/Handler/Course/ParticipantInvite.hs b/src/Handler/Course/ParticipantInvite.hs index 82ebe492f..8172b21bd 100644 --- a/src/Handler/Course/ParticipantInvite.hs +++ b/src/Handler/Course/ParticipantInvite.hs @@ -192,23 +192,29 @@ handleAddUserR tid ssh csh tdesc ttyp = do currentRoute <- fromMaybe (error "postCAddUserR called from 404-handler") <$> getCurrentRoute - confirmedActs :: Set CourseRegisterActionData <- fmap Set.fromList . throwExceptT . mapMM encodedSecretBoxOpen . lookupPostParams $ toPathPiece PostCourseUserAddConfirmAction - -- $logDebugS "CAddUserR confirmedActs" . tshow $ Set.map Aeson.encode confirmedActs - unless (Set.null confirmedActs) $ do -- TODO: check that all acts are member of availableActs - let - users = Map.fromList . fmap (\act -> (crActIdent act, Just . view _1 $ crActUser act)) $ Set.toList confirmedActs - tutActs = Set.filter (is _CourseRegisterActionAddTutorialMemberData) confirmedActs - actTutorial = crActTutorial <$> Set.lookupMin tutActs -- tutorial ident must be the same for every added member! - registeredUsers <- registerUsers cid users - whenIsJust actTutorial $ \(tutName,tutType,tutDay) -> do - whenIsJust (tutName <|> fmap (tutorialDefaultName tutType) tutDay) $ \tName -> do - tutId <- upsertNewTutorial cid tName tutType tutDay - registerTutorialMembers tutId registeredUsers - -- when (Set.size tutActs == Set.size confirmedActs) $ -- not sure how this condition might be false at this point - redirect $ CTutorialR tid ssh csh tName TUsersR - redirect $ CourseR tid ssh csh CUsersR + (_ , registerConfirmResult) <- runButtonForm FIDCourseRegisterConfirm + $logDebugS "***AbortProblem***" $ tshow registerConfirmResult + case registerConfirmResult of + Nothing -> return () + (Just BtnCourseRegisterAbort) -> addMessageI Warning MsgAborted + (Just BtnCourseRegisterConfirm) -> do + confirmedActs :: Set CourseRegisterActionData <- fmap Set.fromList . throwExceptT . mapMM encodedSecretBoxOpen . lookupPostParams $ toPathPiece PostCourseUserAddConfirmAction + -- $logDebugS "CAddUserR confirmedActs" . tshow $ Set.map Aeson.encode confirmedActs + unless (Set.null confirmedActs) $ do -- TODO: check that all acts are member of availableActs + let + users = Map.fromList . fmap (\act -> (crActIdent act, Just . view _1 $ crActUser act)) $ Set.toList confirmedActs + tutActs = Set.filter (is _CourseRegisterActionAddTutorialMemberData) confirmedActs + actTutorial = crActTutorial <$> Set.lookupMin tutActs -- tutorial ident must be the same for every added member! + registeredUsers <- registerUsers cid users + whenIsJust actTutorial $ \(tutName,tutType,tutDay) -> do + whenIsJust (tutName <|> fmap (tutorialDefaultName tutType) tutDay) $ \tName -> do + tutId <- upsertNewTutorial cid tName tutType tutDay + registerTutorialMembers tutId registeredUsers + -- when (Set.size tutActs == Set.size confirmedActs) $ -- not sure how this condition might be false at this point + redirect $ CTutorialR tid ssh csh tName TUsersR + redirect $ CourseR tid ssh csh CUsersR - ((usersToAdd :: FormResult AddUserRequest, formWgt), formEncoding) <- runFormPost . renderWForm FormStandard $ do + ((usersToAdd :: FormResult AddUserRequest, formWgt), formEncoding) <- runFormPost . identifyForm FIDCourseRegister . renderWForm FormStandard $ do let tutTypesMsg = [(SomeMessage tt,tt) | tt <- tutTypes] tutDefType = ttyp >>= (\ty -> if ty `elem` tutTypes then Just ty else Nothing) auReqUsers <- wreq (textField & cfAnySeparatedSet) (fslI MsgCourseParticipantsRegisterUsersField & setTooltip MsgCourseParticipantsRegisterUsersFieldTip) mempty diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs index e79761885..18c96c289 100644 --- a/src/Utils/Form.hs +++ b/src/Utils/Form.hs @@ -367,6 +367,8 @@ identifyForm = identifyForm' id -- Buttons (new version ) -- ---------------------------- +-- Bemerke: Back Button Widget implementierbar durch