From a590f45cc150dfac5d786963dbec351ff53a5b63 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Thu, 27 Feb 2020 16:31:38 +0100 Subject: [PATCH] feat(allocations): upload of priorities --- frontend/src/utils/form/form.sass | 32 +++++++ frontend/src/utils/inputs/checkbox.js | 18 +++- frontend/src/utils/inputs/checkbox.sass | 94 ++++++++++++------- frontend/src/utils/inputs/inputs.js | 2 +- frontend/src/utils/inputs/radio-group.sass | 55 +++++++++++ frontend/src/utils/inputs/radio.js | 47 ++++++++++ frontend/src/utils/inputs/radio.sass | 86 ++++++++--------- messages/uniworx/de-de-formal.msg | 12 ++- records.json | 26 +++++ routes | 1 + src/Database/Esqueleto/Utils.hs | 11 +++ src/Foundation.hs | 14 +++ src/Handler/Allocation.hs | 1 + src/Handler/Allocation/Prios.hs | 82 ++++++++++++++++ src/Handler/Utils/Allocation.hs | 6 +- src/Handler/Utils/Csv.hs | 12 ++- src/Handler/Utils/Form.hs | 43 +++++++++ src/Import/NoModel.hs | 2 +- src/Model/Types/Allocation.hs | 13 ++- src/Utils.hs | 5 +- src/Utils/Form.hs | 25 +++-- templates/default-layout.hamlet | 4 +- .../numeric/de-de-formal.hamlet | 19 ++++ .../ordinal/de-de-formal.hamlet | 17 ++++ templates/i18n/changelog/de-de-formal.hamlet | 6 +- templates/i18n/changelog/en-eu.hamlet | 2 +- .../widgets/explained-selection-field.hamlet | 21 +++++ .../widgets/pageaction/pageaction.hamlet | 4 +- .../widgets/pageaction/primary-wrapper.hamlet | 2 +- 29 files changed, 558 insertions(+), 104 deletions(-) create mode 100644 frontend/src/utils/inputs/radio-group.sass create mode 100644 frontend/src/utils/inputs/radio.js create mode 100644 src/Handler/Allocation/Prios.hs create mode 100644 templates/i18n/allocation-priority-explanation/numeric/de-de-formal.hamlet create mode 100644 templates/i18n/allocation-priority-explanation/ordinal/de-de-formal.hamlet create mode 100644 templates/widgets/explained-selection-field.hamlet diff --git a/frontend/src/utils/form/form.sass b/frontend/src/utils/form/form.sass index 675deabd9..ff093901c 100644 --- a/frontend/src/utils/form/form.sass +++ b/frontend/src/utils/form/form.sass @@ -33,3 +33,35 @@ fieldset .label-pagesize margin-right: 13px + +.explained-selection-field + display: flex + flex-flow: row wrap + margin: -5px + + .explained-selection-field__option + display: grid + grid-gap: 5px 7px + grid-template-columns: 30px 1fr + grid-template-rows: 2em 1fr + grid-template-areas: 'radiobox title' '. explanation' + margin: 5px + max-width: 500px + + .explained-selection-field__input + grid-area: radiobox + place-self: center center + width: 20px + height: 20px + + .explained-selection-field__label + grid-area: title + place-self: center stretch + font-weight: 600 + + .explained-selection-field__explanation + grid-area: explanation + place-self: stretch stretch + font-weight: 600 + font-size: .9rem + color: var(--color-fontsec) diff --git a/frontend/src/utils/inputs/checkbox.js b/frontend/src/utils/inputs/checkbox.js index 1cf408ba8..54611dd9e 100644 --- a/frontend/src/utils/inputs/checkbox.js +++ b/frontend/src/utils/inputs/checkbox.js @@ -2,25 +2,33 @@ import { Utility } from '../../core/utility'; import './checkbox.sass'; var CHECKBOX_CLASS = 'checkbox'; +var RADIOBOX_CLASS = 'radiobox'; var CHECKBOX_INITIALIZED_CLASS = 'checkbox--initialized'; @Utility({ - selector: 'input[type="checkbox"]:not([uw-no-checkbox])', + selector: 'input[type="checkbox"]:not([uw-no-checkbox]), input[type="radio"]:not([uw-no-radiobox])', }) export class Checkbox { - constructor(element) { if (!element) { throw new Error('Checkbox utility cannot be setup without an element!'); } + const isRadio = element.type === 'radio'; + const box_class = isRadio ? RADIOBOX_CLASS : CHECKBOX_CLASS; + + if (isRadio && element.closest('.radio-group')) { + // Don't initialize radiobox, if radio is part of a group + return false; + } + if (element.classList.contains(CHECKBOX_INITIALIZED_CLASS)) { // throw new Error('Checkbox utility already initialized!'); return false; } - if (element.parentElement.classList.contains(CHECKBOX_CLASS)) { - // throw new Error('Checkbox element\'s wrapper already has class '' + CHECKBOX_CLASS + ''!'); + if (element.parentElement.classList.contains(box_class)) { + // throw new Error('Checkbox element\'s wrapper already has class '' + box_class + ''!'); return false; } @@ -28,7 +36,7 @@ export class Checkbox { var parentEl = element.parentElement; var wrapperEl = document.createElement('div'); - wrapperEl.classList.add(CHECKBOX_CLASS); + wrapperEl.classList.add(box_class); var labelEl = document.createElement('label'); labelEl.setAttribute('for', element.id); diff --git a/frontend/src/utils/inputs/checkbox.sass b/frontend/src/utils/inputs/checkbox.sass index ce15110ae..ab7f0cd11 100644 --- a/frontend/src/utils/inputs/checkbox.sass +++ b/frontend/src/utils/inputs/checkbox.sass @@ -1,6 +1,6 @@ // CUSTOM CHECKBOXES // Completely replaces legacy checkbox -.checkbox [type='checkbox'], #lang-checkbox +.checkbox [type='checkbox'], .radiobox [type='radio'], #lang-checkbox position: fixed top: -1px left: -1px @@ -9,7 +9,7 @@ overflow: hidden display: none -.checkbox +.checkbox, .radiobox position: relative display: inline-block @@ -17,47 +17,77 @@ display: block height: 20px width: 20px - background-color: #f3f3f3 + background-color: var(--color-grey-lighter) box-shadow: inset 0 1px 2px 1px rgba(50, 50, 50, 0.05) border: 2px solid var(--color-primary) border-radius: 4px color: white cursor: pointer - label::before, - label::after - position: absolute - display: block - top: 12px - left: 8px - height: 2px - width: 8px - background-color: var(--color-font) + &.radiobox label + border-radius: 10px - \:checked + label - background-color: var(--color-primary) - [type='checkbox']:focus + label - border-color: #3273dc - box-shadow: 0 0 0 0.125em rgba(50, 115, 220, 0.25) - outline: 0 + &.checkbox + label::before, + label::after + position: absolute + display: block + top: 12px + left: 8px + height: 2px + width: 8px + background-color: var(--color-font) - \:checked + label::before, - :checked + label::after - content: '' + \:checked + label + background-color: var(--color-primary) - \:checked + label::before - background-color: white - transform: rotate(45deg) - left: 2px - top: 11px + [type='checkbox']:focus + label + border-color: #3273dc + box-shadow: 0 0 0 0.125em rgba(50, 115, 220, 0.25) + outline: 0 - \:checked + label::after - background-color: white - transform: rotate(-45deg) - top: 9px - width: 12px - left: 7px + \:checked + label::before, + :checked + label::after + content: '' + + \:checked + label::before + background-color: white + transform: rotate(45deg) + left: 2px + top: 11px + + \:checked + label::after + background-color: white + transform: rotate(-45deg) + top: 9px + width: 12px + left: 7px + + &.radiobox + label::before + position: absolute + display: block + top: 6.5px + left: 6.5px + height: 7px + width: 7px + border-radius: 3.5px + background-color: var(--color-font) + + \:checked + label + background-color: var(--color-primary) + + [type='radio']:focus + label + border-color: #3273dc + box-shadow: 0 0 0 0.125em rgba(50, 115, 220, 0.25) + outline: 0 + + \:checked + label::before + content: '' + + \:checked + label::before + background-color: white [disabled] + label pointer-events: none diff --git a/frontend/src/utils/inputs/inputs.js b/frontend/src/utils/inputs/inputs.js index 1909d964a..39b484759 100644 --- a/frontend/src/utils/inputs/inputs.js +++ b/frontend/src/utils/inputs/inputs.js @@ -2,7 +2,7 @@ import { Checkbox } from './checkbox'; import { FileInput } from './file-input'; import './inputs.sass'; -import './radio.sass'; +import './radio-group.sass'; export const InputUtils = [ Checkbox, diff --git a/frontend/src/utils/inputs/radio-group.sass b/frontend/src/utils/inputs/radio-group.sass new file mode 100644 index 000000000..367a05702 --- /dev/null +++ b/frontend/src/utils/inputs/radio-group.sass @@ -0,0 +1,55 @@ +// CUSTOM RADIO BOXES +// Completely replaces native radiobox + +.radio-group + display: flex + +.radio + position: relative + display: inline-block + + [type='radio'] + position: fixed + top: -1px + left: -1px + width: 1px + height: 1px + overflow: hidden + + label + display: block + height: 34px + min-width: 42px + line-height: 34px + text-align: center + padding: 0 13px + background-color: #f3f3f3 + box-shadow: inset 2px 1px 2px 1px rgba(50, 50, 50, 0.05) + color: var(--color-font) + cursor: pointer + + \:checked + label + background-color: var(--color-primary) + color: var(--color-lightwhite) + box-shadow: inset -2px -1px 2px 1px rgba(255, 255, 255, 0.15) + + \:focus + label + border-color: #3273dc + box-shadow: 0 0 0.125em 0 rgba(50, 115, 220, 0.8) + outline: 0 + + [disabled] + label + pointer-events: none + border: none + opacity: 0.6 + filter: grayscale(1) + +.radio:first-child + label + border-top-left-radius: 4px + border-bottom-left-radius: 4px + +.radio:last-child + label + border-top-right-radius: 4px + border-bottom-right-radius: 4px diff --git a/frontend/src/utils/inputs/radio.js b/frontend/src/utils/inputs/radio.js new file mode 100644 index 000000000..3778fda84 --- /dev/null +++ b/frontend/src/utils/inputs/radio.js @@ -0,0 +1,47 @@ +import { Utility } from '../../core/utility'; +import './radio.sass'; + +var RADIO_CLASS = 'radiobox'; +var RADIO_INITIALIZED_CLASS = 'radio--initialized'; + +@Utility({ + selector: 'input[type="radio"]:not([uw-no-radio])', +}) +export class Radio { + + constructor(element) { + if (!element) { + throw new Error('Radio utility cannot be setup without an element!'); + } + + if (element.closest('.radio-group')) { + return false; + } + + if (element.classList.contains(RADIO_INITIALIZED_CLASS)) { + // throw new Error('Radio utility already initialized!'); + return false; + } + + if (element.parentElement.classList.contains(RADIO_CLASS)) { + // throw new Error('Radio element\'s wrapper already has class '' + RADIO_CLASS + ''!'); + return false; + } + + var siblingEl = element.nextSibling; + var parentEl = element.parentElement; + + var wrapperEl = document.createElement('div'); + wrapperEl.classList.add(RADIO_CLASS); + + var labelEl = document.createElement('label'); + labelEl.setAttribute('for', element.id); + + wrapperEl.appendChild(element); + wrapperEl.appendChild(labelEl); + + parentEl.insertBefore(wrapperEl, siblingEl); + + element.classList.add(RADIO_INITIALIZED_CLASS); + } +} diff --git a/frontend/src/utils/inputs/radio.sass b/frontend/src/utils/inputs/radio.sass index 367a05702..0603875aa 100644 --- a/frontend/src/utils/inputs/radio.sass +++ b/frontend/src/utils/inputs/radio.sass @@ -1,55 +1,55 @@ -// CUSTOM RADIO BOXES +// GROUPS OF RADIO BUTTONS // Completely replaces native radiobox .radio-group display: flex -.radio - position: relative - display: inline-block + & > .radio + position: relative + display: inline-block - [type='radio'] - position: fixed - top: -1px - left: -1px - width: 1px - height: 1px - overflow: hidden + [type='radio'] + position: fixed + top: -1px + left: -1px + width: 1px + height: 1px + overflow: hidden - label - display: block - height: 34px - min-width: 42px - line-height: 34px - text-align: center - padding: 0 13px - background-color: #f3f3f3 - box-shadow: inset 2px 1px 2px 1px rgba(50, 50, 50, 0.05) - color: var(--color-font) - cursor: pointer + label + display: block + height: 34px + min-width: 42px + line-height: 34px + text-align: center + padding: 0 13px + background-color: #f3f3f3 + box-shadow: inset 2px 1px 2px 1px rgba(50, 50, 50, 0.05) + color: var(--color-font) + cursor: pointer - \:checked + label - background-color: var(--color-primary) - color: var(--color-lightwhite) - box-shadow: inset -2px -1px 2px 1px rgba(255, 255, 255, 0.15) + \:checked + label + background-color: var(--color-primary) + color: var(--color-lightwhite) + box-shadow: inset -2px -1px 2px 1px rgba(255, 255, 255, 0.15) - \:focus + label - border-color: #3273dc - box-shadow: 0 0 0.125em 0 rgba(50, 115, 220, 0.8) - outline: 0 + \:focus + label + border-color: #3273dc + box-shadow: 0 0 0.125em 0 rgba(50, 115, 220, 0.8) + outline: 0 - [disabled] + label - pointer-events: none - border: none - opacity: 0.6 - filter: grayscale(1) + [disabled] + label + pointer-events: none + border: none + opacity: 0.6 + filter: grayscale(1) -.radio:first-child - label - border-top-left-radius: 4px - border-bottom-left-radius: 4px + &:first-child + label + border-top-left-radius: 4px + border-bottom-left-radius: 4px -.radio:last-child - label - border-top-right-radius: 4px - border-bottom-right-radius: 4px + &:last-child + label + border-top-right-radius: 4px + border-bottom-right-radius: 4px diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg index 092ef2538..c5ca45984 100644 --- a/messages/uniworx/de-de-formal.msg +++ b/messages/uniworx/de-de-formal.msg @@ -1213,6 +1213,7 @@ MenuExternalExamList: Externe Prüfungen MenuParticipantsList: Kursteilnehmerlisten MenuParticipantsIntersect: Überschneidung von Kursteilnehmern MenuAllocationUsers: Bewerber +MenuAllocationPriorities: Zentrale Dringlichkeiten BreadcrumbSubmissionFile: Datei BreadcrumbSubmissionUserInvite: Einladung zur Abgabe @@ -1279,6 +1280,7 @@ BreadcrumbParticipants: Kursteilnehmerliste BreadcrumbExamAutoOccurrence: Automatische Termin-/Raumverteilung BreadcrumbStorageKey: Lokalen Schlüssel generieren BreadcrumbAllocationUsers: Bewerber +BreadcrumbAllocationPriorities: Zentrale Dringlichkeiten ExternalExamEdit coursen@CourseName examn@ExamName: Bearbeiten: #{coursen}, #{examn} ExternalExamGrades coursen@CourseName examn@ExamName: Prüfungsleistungen: #{coursen}, #{examn} @@ -2357,4 +2359,12 @@ CsvColumnAllocationUserRequested: Maximale Anzahl von Plätzen, die der Bewerber CsvColumnAllocationUserApplied: Anzahl von Bewerbungen, die der Bewerber eingereicht hat CsvColumnAllocationUserVetos: Anzahl von Bewerbungen, die von Kursverwaltern ein Veto oder eine Note erhalten haben, die äquivalent ist zu "Nicht Bestanden" (5.0) CsvColumnAllocationUserAssigned: Anzahl von Plätzen, die der Bewerber durch diese Zentralanmeldung bereits erhalten hat -AllocationUsersCsvName tid@TermId ssh@SchoolId ash@AllocationShorthand: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase ash}-bewerber \ No newline at end of file +AllocationUsersCsvName tid@TermId ssh@SchoolId ash@AllocationShorthand: #{foldCase (termToText (unTermKey tid))}-#{foldedCase (unSchoolKey ssh)}-#{foldedCase ash}-bewerber + +AllocationPrioritiesMode: Modus +AllocationPrioritiesNumeric: Numerische Dringlichkeiten +AllocationPrioritiesOrdinal: Dringlichkeiten durch Sortierung +AllocationPrioritiesTitle tid@TermId ssh@SchoolId ash@AllocationShorthand: #{tid}-#{ssh}-#{ash}: Zentrale Dringlichkeiten +AllocationPrioritiesFile: CSV-Datei +AllocationPrioritiesSunk num@Int64: Zentrale Prioritäten für #{num} Bewerber erfolgreich hinterlegt +AllocationPrioritiesMissing num@Int64: Für #{num} Bewerber ist keine zentrale Priorität hinterlegt, da in der hochgeladenen CSV-Datei die #{pluralDE num "entsprechende Matrikelnummer" "entsprechenden Matrikelnummern"} nicht gefunden #{pluralDE num "wurde" "wurden"} \ No newline at end of file diff --git a/records.json b/records.json index d84014b37..e9a1244c8 100644 --- a/records.json +++ b/records.json @@ -802,5 +802,31 @@ "usedIds": [] } } + ], + "mini-css-extract-plugin node_modules/css-loader/dist/cjs.js??ref--6-1!node_modules/postcss-loader/src/index.js??ref--6-2!node_modules/resolve-url-loader/index.js??ref--6-3!node_modules/sass-loader/dist/cjs.js??ref--6-4!frontend/src/utils/inputs/radio-group.sass": [ + { + "modules": { + "byIdentifier": {}, + "usedIds": {} + }, + "chunks": { + "byName": {}, + "bySource": {}, + "usedIds": [] + } + } + ], + "mini-css-extract-plugin node_modules/css-loader/dist/cjs.js??ref--6-1!node_modules/postcss-loader/src/index.js??ref--6-2!node_modules/resolve-url-loader/index.js??ref--6-3!node_modules/sass-loader/dist/cjs.js??ref--6-4!frontend/src/utils/inputs/radiobox.sass": [ + { + "modules": { + "byIdentifier": {}, + "usedIds": {} + }, + "chunks": { + "byName": {}, + "bySource": {}, + "usedIds": [] + } + } ] } \ No newline at end of file diff --git a/routes b/routes index a3cb83bec..0e6777f0a 100644 --- a/routes +++ b/routes @@ -109,6 +109,7 @@ /register ARegisterR POST !time /course/#CryptoUUIDCourse/apply AApplyR POST !timeANDallocation-registered /users AUsersR GET POST !allocation-admin + /priorities APriosR GET POST !allocation-admin /participants ParticipantsListR GET !evaluation /participants/#TermId/#SchoolId ParticipantsR GET !evaluation diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs index 8b304ea99..a01dd25fa 100644 --- a/src/Database/Esqueleto/Utils.hs +++ b/src/Database/Esqueleto/Utils.hs @@ -21,6 +21,7 @@ module Database.Esqueleto.Utils , SqlProject(..) , (->.) , fromSqlKey + , selectCountRows , module Database.Esqueleto.Utils.TH ) where @@ -257,3 +258,13 @@ instance (PersistEntity val, PersistField typ) => SqlProject val typ (Maybe (E.E fromSqlKey :: (ToBackendKey SqlBackend entity, PersistField (Key entity)) => E.SqlExpr (E.Value (Key entity)) -> E.SqlExpr (E.Value Int64) fromSqlKey = E.veryUnsafeCoerceSqlExprValue + + +selectCountRows :: (Num a, PersistField a, MonadIO m) => E.SqlQuery ignored -> E.SqlReadT m a +selectCountRows q = do + res <- E.select $ E.countRows <$ q + case res of + [E.Value res'] + -> return res' + _other + -> error "E.countRows did not return exactly one result" diff --git a/src/Foundation.hs b/src/Foundation.hs index cbb198e44..79fae88f8 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -2029,6 +2029,7 @@ instance YesodBreadcrumbs UniWorX where MaybeT $ get cid return (CI.original courseName, Just $ AllocationR tid ssh ash AShowR) AUsersR -> i18nCrumb MsgBreadcrumbAllocationUsers . Just $ AllocationR tid ssh ash AShowR + APriosR -> i18nCrumb MsgBreadcrumbAllocationPriorities . Just $ AllocationR tid ssh ash AUsersR breadcrumb ParticipantsListR = i18nCrumb MsgBreadcrumbParticipantsList $ Just CourseListR breadcrumb (ParticipantsR _ _) = i18nCrumb MsgBreadcrumbParticipants $ Just ParticipantsListR @@ -3021,6 +3022,19 @@ pageActions (AllocationR tid ssh ash AShowR) = return , navChildren = [] } ] +pageActions (AllocationR tid ssh ash AUsersR) = return + [ NavPageActionPrimary + { navLink = NavLink + { navLabel = MsgMenuAllocationPriorities + , navRoute = AllocationR tid ssh ash APriosR + , navAccess' = return True + , navType = NavTypeLink { navModal = True } + , navQuick' = mempty + , navForceActive = False + } + , navChildren = [] + } + ] pageActions CourseListR = do participantsSecondary <- pageQuickActions NavQuickViewPageActionSecondary ParticipantsListR return diff --git a/src/Handler/Allocation.hs b/src/Handler/Allocation.hs index b31ba58db..9ff9b336a 100644 --- a/src/Handler/Allocation.hs +++ b/src/Handler/Allocation.hs @@ -8,3 +8,4 @@ import Handler.Allocation.Application as Handler.Allocation import Handler.Allocation.Register as Handler.Allocation import Handler.Allocation.List as Handler.Allocation import Handler.Allocation.Users as Handler.Allocation +import Handler.Allocation.Prios as Handler.Allocation diff --git a/src/Handler/Allocation/Prios.hs b/src/Handler/Allocation/Prios.hs new file mode 100644 index 000000000..60ad57cae --- /dev/null +++ b/src/Handler/Allocation/Prios.hs @@ -0,0 +1,82 @@ +module Handler.Allocation.Prios + ( getAPriosR, postAPriosR + ) where + +import Import + +import Handler.Utils +import Handler.Utils.Csv +import Handler.Utils.Allocation + +import qualified Database.Esqueleto as E +import qualified Database.Esqueleto.Utils as E + +import qualified Data.Conduit.List as C + +import qualified Data.Csv as Csv + + +data AllocationPrioritiesMode + = AllocationPrioritiesNumeric + | AllocationPrioritiesOrdinal + deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable) +instance Universe AllocationPrioritiesMode +instance Finite AllocationPrioritiesMode + +nullaryPathPiece ''AllocationPrioritiesMode $ camelToPathPiece' 2 + +embedRenderMessage ''UniWorX ''AllocationPrioritiesMode id + + +getAPriosR, postAPriosR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html +getAPriosR = postAPriosR +postAPriosR tid ssh ash = do + doNumericPrios <- runDB $ do + Entity aId _ <- getBy404 $ TermSchoolAllocationShort tid ssh ash + + numericPrios <- E.selectCountRows . E.from $ \allocationUser -> do + E.where_ $ allocationUser E.^. AllocationUserAllocation E.==. E.val aId + E.where_ . E.maybe E.false sqlAllocationPriorityNumeric $ allocationUser E.^. AllocationUserPriority + + ordinalPrios <- E.selectCountRows . E.from $ \allocationUser -> do + E.where_ $ allocationUser E.^. AllocationUserAllocation E.==. E.val aId + E.where_ . E.maybe E.false (E.not_ . sqlAllocationPriorityNumeric) $ allocationUser E.^. AllocationUserPriority + let doNumericPrios = ((>=) :: Int64 -> Int64 -> Bool) numericPrios ordinalPrios + + return doNumericPrios + + let explainAllocationPrioMode = \case + AllocationPrioritiesNumeric -> return $(i18nWidgetFile "allocation-priority-explanation/numeric") + AllocationPrioritiesOrdinal -> return $(i18nWidgetFile "allocation-priority-explanation/ordinal") + + ((priosRes, priosView), priosEnctype) <- runFormPost . renderAForm FormStandard $ (,) + <$> apopt (explainedSelectionField Nothing (explainOptionList optionsFinite explainAllocationPrioMode)) (fslI MsgAllocationPrioritiesMode) (Just $ bool AllocationPrioritiesOrdinal AllocationPrioritiesNumeric doNumericPrios) + <*> areq fileField (fslI MsgAllocationPrioritiesFile) Nothing + + formResult priosRes $ \(mode, fInfo) -> do + let sourcePrios = case mode of + AllocationPrioritiesNumeric -> fileSourceCsvPositional Csv.NoHeader fInfo + AllocationPrioritiesOrdinal -> fileSourceCsvPositional Csv.NoHeader fInfo .| C.map Csv.fromOnly .| ordinalPriorities + + (matrSunk, matrMissing) <- runDB $ do + Entity aId _ <- getBy404 $ TermSchoolAllocationShort tid ssh ash + updateWhere + [ AllocationUserAllocation ==. aId ] + [ AllocationUserPriority =. Nothing ] + matrSunk <- runConduit $ sourcePrios .| sinkAllocationPriorities aId + matrMissing <- fromIntegral <$> count [ AllocationUserAllocation ==. aId, AllocationUserPriority ==. Nothing ] + return (matrSunk, matrMissing) + + when (matrSunk > 0) $ + addMessageI Success $ MsgAllocationPrioritiesSunk matrSunk + when (matrMissing > 0) $ + addMessageI Error $ MsgAllocationPrioritiesMissing matrMissing + redirect $ AllocationR tid ssh ash AUsersR + + siteLayoutMsg MsgMenuAllocationPriorities $ do + setTitleI $ MsgAllocationPrioritiesTitle tid ssh ash + + wrapForm priosView def + { formEncoding = priosEnctype + , formAction = Just . SomeRoute $ AllocationR tid ssh ash APriosR + } diff --git a/src/Handler/Utils/Allocation.hs b/src/Handler/Utils/Allocation.hs index 39246dafe..48e70448b 100644 --- a/src/Handler/Utils/Allocation.hs +++ b/src/Handler/Utils/Allocation.hs @@ -46,9 +46,9 @@ ordinalPriorities :: Monad m => ConduitT UserMatriculation (Map UserMatriculatio ordinalPriorities = evalStateC 0 . C.mapM $ \matr -> singletonMap matr <$> (AllocationPriorityOrdinal <$> State.get <* State.modify' succ) sinkAllocationPriorities :: AllocationId - -> ConduitT (Map UserMatriculation AllocationPriority) Void DB () -sinkAllocationPriorities allocId = C.mapM_ . imapM_ $ \matr prio -> - E.update $ \allocationUser -> do + -> ConduitT (Map UserMatriculation AllocationPriority) Void DB Int64 +sinkAllocationPriorities allocId = fmap getSum . C.foldMapM . ifoldMapM $ \matr prio -> + fmap Sum . E.updateCount $ \allocationUser -> do E.set allocationUser [ AllocationUserPriority E.=. E.val (Just prio) ] E.where_ $ allocationUser E.^. AllocationUserAllocation E.==. E.val allocId E.where_ . E.exists . E.from $ \user -> diff --git a/src/Handler/Utils/Csv.hs b/src/Handler/Utils/Csv.hs index 81705aa53..b192a1c4f 100644 --- a/src/Handler/Utils/Csv.hs +++ b/src/Handler/Utils/Csv.hs @@ -7,7 +7,7 @@ module Handler.Utils.Csv , encodeDefaultOrderedCsv , respondCsv, respondCsvDB , respondDefaultOrderedCsv, respondDefaultOrderedCsvDB - , fileSourceCsv + , fileSourceCsv, fileSourceCsvPositional , partIsAttachmentCsv , CsvParseError(..) , ToNamedRecord(..), FromNamedRecord(..) @@ -210,6 +210,16 @@ fileSourceCsv :: ( FromNamedRecord csv -> ConduitT () csv m () fileSourceCsv = (.| decodeCsv) . fileSource +fileSourceCsvPositional :: ( MonadHandler m + , HandlerSite m ~ UniWorX + , MonadThrow m + , FromRecord csv + ) + => HasHeader + -> FileInfo + -> ConduitT () csv m () +fileSourceCsvPositional hdr = (.| decodeCsvPositional hdr) . fileSource + instance ToWidget UniWorX CsvRendered where toWidget CsvRendered{..} = liftWidget $(widgetFile "widgets/csvRendered") diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index f3b38f2d3..fb68b9105 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -1479,3 +1479,46 @@ csvOptionsForm :: forall m. csvOptionsForm mPrev = hoistAForm liftHandler $ CsvOptions <$> csvFormatOptionsForm (fslI MsgCsvFormatOptions & setTooltip MsgCsvOptionsTip) (csvFormat <$> mPrev) <*> apopt checkBoxField (fslI MsgCsvTimestamp & setTooltip MsgCsvTimestampTip) (csvTimestamp <$> mPrev) + + +explainedSelectionField :: forall m a. + ( MonadHandler m + , HandlerSite m ~ UniWorX + , Eq a + ) + => Maybe (SomeMessage UniWorX, Maybe Widget) -- ^ Label for none option + -> Handler ([(Option a, Maybe Widget)], Text -> Maybe a) + -> Field m a +explainedSelectionField optMsg' mkOpts = Field{..} + where + fieldEnctype = UrlEncoded + fieldParse ts _ = do + (_, parser) <- liftHandler mkOpts + if + | t : _ <- ts + , Just t' <- parser t + -> return . Right $ Just t' + | t : _ <- ts + , null t + -> return $ Right Nothing + | t : _ <- ts + -> return . Left . SomeMessage $ MsgInvalidEntry t + | otherwise + -> return $ Right Nothing + fieldView theId name attrs val isReq = do + (opts, _) <- liftHandler mkOpts + let optMsg = guardOnM (not isReq) optMsg' + inputId optExternal = [st|#{theId}__input--#{optExternal}|] + matchesVal Nothing = is _Left val + matchesVal (Just x) = val == Right x + $(widgetFile "widgets/explained-selection-field") + +explainOptionList :: forall a. + Handler (OptionList a) + -> (a -> MaybeT Handler Widget) + -> Handler ([(Option a, Maybe Widget)], Text -> Maybe a) +explainOptionList ol mkExplanation = do + OptionList{..} <- ol + olOptions' <- forM olOptions $ \opt@Option{..} -> (opt, ) <$> runMaybeT (mkExplanation optionInternalValue) + return (olOptions', olReadExternal) + diff --git a/src/Import/NoModel.hs b/src/Import/NoModel.hs index d01136a6d..04d714ef3 100644 --- a/src/Import/NoModel.hs +++ b/src/Import/NoModel.hs @@ -17,7 +17,7 @@ import ClassyPrelude.Yesod as Import , HasHttpManager(..) , embed , try, embed, catches, handle, catch, bracket, bracketOnError, bracket_, catchJust, finally, handleJust, mask, mask_, onException, tryJust, uninterruptibleMask, uninterruptibleMask_ - , htmlField + , htmlField, fileField ) import UnliftIO.Async.Utils as Import diff --git a/src/Model/Types/Allocation.hs b/src/Model/Types/Allocation.hs index 6fe299312..8f4a6a6bf 100644 --- a/src/Model/Types/Allocation.hs +++ b/src/Model/Types/Allocation.hs @@ -1,5 +1,6 @@ module Model.Types.Allocation ( AllocationPriority(..) + , sqlAllocationPriorityNumeric , AllocationPriorityComparison(..) , AllocationFingerprint , module Utils.Allocation @@ -16,6 +17,10 @@ import qualified Data.Map.Strict as Map import Crypto.Hash (SHAKE128) +import qualified Database.Esqueleto as E +import qualified Database.Esqueleto.Internal.Sql as E +import qualified Database.Esqueleto.PostgreSQL.JSON as E + {-# ANN module ("HLint: ignore Use newtype instead of data"::String) #-} @@ -31,7 +36,9 @@ deriveJSON defaultOptions , unwrapUnaryRecords = False , tagSingleConstructors = True } ''AllocationPriority -derivePersistFieldJSON ''AllocationPriority + +deriving via E.JSONB AllocationPriority instance E.PersistField AllocationPriority +deriving via E.JSONB AllocationPriority instance E.PersistFieldSql AllocationPriority instance Binary AllocationPriority @@ -43,6 +50,10 @@ instance Csv.FromRecord (Map UserMatriculation AllocationPriority) where | otherwise = mzero +sqlAllocationPriorityNumeric :: E.SqlExpr (E.Value AllocationPriority) -> E.SqlExpr (E.Value Bool) +sqlAllocationPriorityNumeric prio = E.veryUnsafeCoerceSqlExprValue prio E.->. "mode" E.==. E.jsonbVal ("numeric" :: Text) + + data AllocationPriorityComparison = AllocationPriorityComparisonNumeric { allocationGradeScale :: Rational } | AllocationPriorityComparisonOrdinal { allocationCloneIndex :: Down Natural, allocationOrdinalScale :: Rational } diff --git a/src/Utils.hs b/src/Utils.hs index 56809e75d..97e13c70a 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -670,7 +670,10 @@ ofoldl1M f (otoList -> x:xs) = foldlM f x xs ofoldl1M _ _ = error "otoList of NonNull is empty" foldMapM :: (Foldable f, Monad m, Monoid b) => (a -> m b) -> f a -> m b -foldMapM f = foldrM (\x xs -> (<>) <$> f x <*> pure xs) mempty +foldMapM f = foldrM (\x xs -> (<> xs) <$> f x) mempty + +ifoldMapM :: (FoldableWithIndex i f, Monad m, Monoid b) => (i -> a -> m b) -> f a -> m b +ifoldMapM f = ifoldrM (\i x xs -> (<> xs) <$> f i x) mempty partitionM :: forall mono m . ( MonoFoldable mono diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs index 1c37049fa..4ca0e17e9 100644 --- a/src/Utils/Form.hs +++ b/src/Utils/Form.hs @@ -639,17 +639,30 @@ secretJsonField :: forall m a. secretJsonField = secretJsonField' $ fieldView (hiddenField :: Field m Text) fileFieldMultiple :: Monad m => Field m [FileInfo] -fileFieldMultiple = Field - { fieldParse = \_ files -> return $ case files of +fileFieldMultiple = Field{..} + where + fieldEnctype = Multipart + fieldParse _ files = return $ case files of [] -> Right Nothing fs -> Right $ Just fs - , fieldView = \id' name attrs _ isReq -> + fieldView id' name attrs _ isReq = [whamlet| $newline never - + + |] + +fileField :: Monad m => Field m FileInfo +fileField = Field{..} + where + fieldEnctype = Multipart + fieldParse _ files = return $ case files of + [] -> Right Nothing + f : _ -> Right $ Just f + fieldView id' name attrs _ isReq = + [whamlet| + $newline never + |] - , fieldEnctype = Multipart - } guardField :: Functor m => (a -> Bool) -> Field m a -> Field m a guardField p field = field { fieldParse = \ts fs -> fieldParse field ts fs <&> \case diff --git a/templates/default-layout.hamlet b/templates/default-layout.hamlet index 2f8a66ebb..924271789 100644 --- a/templates/default-layout.hamlet +++ b/templates/default-layout.hamlet @@ -2,9 +2,9 @@ $newline never $if not isModal $with containers <- filter isNavHeaderContainer nav $if not (null containers) - + $forall (_, containerIdent, _, _) <- containers - + ^{asidenav} diff --git a/templates/i18n/allocation-priority-explanation/numeric/de-de-formal.hamlet b/templates/i18n/allocation-priority-explanation/numeric/de-de-formal.hamlet new file mode 100644 index 000000000..b526d2b6e --- /dev/null +++ b/templates/i18n/allocation-priority-explanation/numeric/de-de-formal.hamlet @@ -0,0 +1,19 @@ +$newline never + +Es wird erwartet, dass die erste Spalte der hochgeladenen CSV-Datei die # +Matrikelnummer der Zentralanmeldungs-Bewerber enthält. + +
+ +Alle weiteren Spalten werden als ganze Zahlen interpretiert und # +kodieren die jeweilige zentrale Dringlichkeit bei der Vergabe der # +Plätze. # + +Hierbei wird die erste Dringlichkeits-Spalte verwendet zur Vergabe des # +jeweils ersten Platzes, die zweite Spalte für den zweiten Platz, usw. # + +Größere Zahlen kodieren eine höhere Dringlichkeit. + +
+ +Die CSV-Datei darf keine Spaltenüberschriften enthalten. diff --git a/templates/i18n/allocation-priority-explanation/ordinal/de-de-formal.hamlet b/templates/i18n/allocation-priority-explanation/ordinal/de-de-formal.hamlet new file mode 100644 index 000000000..b11e5bfc4 --- /dev/null +++ b/templates/i18n/allocation-priority-explanation/ordinal/de-de-formal.hamlet @@ -0,0 +1,17 @@ +$newline never + +Es wird erwartet, dass die hochgeladene CSV-Datei genau eine Spalte # +mit den Matrikelnummern der Zentralanmeldungs-Bewerber enthält. + +
+ +Die zentrale Dringlichkeit ergibt sich ausschließlich anhand der # +Sortierung der CSV-Datei. # + +Bewerber, deren Matrikelnummer später in der Datei vorkommt, erhalten # +für alle ihre Plätze eine höhere Dringlichkeit, als Bewerber, deren # +Matrikelnummern in der Datei früher vorkommen. # + +
+ +Die CSV-Datei darf keine Spaltenüberschriften enthalten. diff --git a/templates/i18n/changelog/de-de-formal.hamlet b/templates/i18n/changelog/de-de-formal.hamlet index 7d34f24bb..a36836316 100644 --- a/templates/i18n/changelog/de-de-formal.hamlet +++ b/templates/i18n/changelog/de-de-formal.hamlet @@ -7,7 +7,7 @@ $newline never
  • Alle HTML-Eingabefelder akzeptieren nun stattdessen Markdown
  • - Alle ausgehenden HTML E-Mails haben nun auch einen \ + Alle ausgehenden HTML E-Mails haben nun auch einen # Markdown-Teil
    @@ -15,8 +15,8 @@ $newline never
    • - Prüfungen können nun angeben in welchem Format Leistungen \ - eingetragen werden dürfen (Bestanden/Nicht Bestanden, \ + Prüfungen können nun angeben in welchem Format Leistungen # + eingetragen werden dürfen (Bestanden/Nicht Bestanden, # Numerische Noten oder Gemischt)
      diff --git a/templates/i18n/changelog/en-eu.hamlet b/templates/i18n/changelog/en-eu.hamlet index cb05515f9..6e25fca18 100644 --- a/templates/i18n/changelog/en-eu.hamlet +++ b/templates/i18n/changelog/en-eu.hamlet @@ -14,7 +14,7 @@ $newline never
      • - Exams may now specify in which format results are expected to \ + Exams may now specify in which format results are expected to # entered (passed/failed, numeric grades, or mixed)
        diff --git a/templates/widgets/explained-selection-field.hamlet b/templates/widgets/explained-selection-field.hamlet new file mode 100644 index 000000000..8baf29372 --- /dev/null +++ b/templates/widgets/explained-selection-field.hamlet @@ -0,0 +1,21 @@ +$newline never +
        + $maybe (msg, wgt) <- optMsg +
        +