diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 4bf4301c3..1645c1da7 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -419,6 +419,8 @@ DegreeShort: Abschlusskürzel StudyTermsKey: Schlüssel Studiengang StudyTermsName: Studiengang StudyTermsShort: Studiengangkürzel +StudyDegreeChangeSuccess: Abschlusszuordnungen wurden aktualisiert + MailTestFormEmail: Email-Addresse MailTestFormLanguages: Spracheinstellungen diff --git a/routes b/routes index 3be16416b..a7961404f 100644 --- a/routes +++ b/routes @@ -39,7 +39,7 @@ /users/#CryptoUUIDUser AdminUserR GET POST !development /users/#CryptoUUIDUser/hijack AdminHijackUserR POST !adminANDno-escalation /admin/test AdminTestR GET POST -/admin/features AdminFeaturesR GET --POST +/admin/features AdminFeaturesR GET POST /admin/errMsg AdminErrMsgR GET POST /info InfoR GET !free diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 76795c743..741e4b17e 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -163,13 +163,24 @@ postAdminErrMsgR = do -getAdminFeaturesR :: Handler Html -getAdminFeaturesR = do - (degreeTable,studytermsTable,candidateTable) <- runDB $ (,,) +getAdminFeaturesR, postAdminFeaturesR :: Handler Html +getAdminFeaturesR = postAdminFeaturesR +postAdminFeaturesR = do + ((degreeResult,degreeTable),studytermsTable,candidateTable) <- runDB $ (,,) <$> mkDegreeTable <*> mkStudytermsTable <*> mkCandidateTable + let degreeResult' :: FormResult (Map (Key StudyDegree) (Maybe Text, Maybe Text)) + degreeResult' = degreeResult <&> getDBFormResult + (\row -> ( row ^. _dbrOutput . _entityVal . _studyDegreeName + , row ^. _dbrOutput . _entityVal . _studyDegreeShorthand + )) + updateDegree degreeKey (name,short) = update degreeKey [StudyDegreeName =. name, StudyDegreeShorthand =. short] + formResult degreeResult' $ \res -> do + void . runDB $ Map.traverseWithKey updateDegree res + addMessageI Success MsgStudyDegreeChangeSuccess + siteLayoutMsg MsgAdminFeaturesHeading $ do setTitleI MsgAdminFeaturesHeading [whamlet| @@ -184,6 +195,7 @@ getAdminFeaturesR = do ^{candidateTable} |] where + mkDegreeTable :: DB (FormResult (DBFormResult (Key StudyDegree) (Maybe Text, Maybe Text) (DBRow (Entity StudyDegree))), Widget) mkDegreeTable = let dbtIdent = "admin-studydegrees" :: Text dbtStyle = def @@ -193,8 +205,18 @@ getAdminFeaturesR = do dbtProj = return dbtColonnade = mconcat [ sortable (Just "degree-key") (i18nCell MsgDegreeKey) (numCell . view (_dbrOutput . _entityVal . _studyDegreeKey)) - , sortable (Just "degree-name") (i18nCell MsgDegreeName) (foldMap textCell . view (_dbrOutput . _entityVal . _studyDegreeName)) - , sortable (Just "degree-short") (i18nCell MsgDegreeShort) (foldMap textCell . view (_dbrOutput . _entityVal . _studyDegreeShorthand)) + , sortable (Just "degree-name") (i18nCell MsgDegreeName) + (formCell id (return . view (_dbrOutput . _entityKey)) + (\row _mkUnique -> + (\(res,nameview) -> (set _1 <$> res, fvInput nameview)) <$> + mopt textField "" (Just $ row ^. _dbrOutput . _entityVal . _studyDegreeName) + )) + , sortable (Just "degree-short") (i18nCell MsgDegreeShort) + (formCell id (return . view (_dbrOutput . _entityKey)) + (\row _mkUnique -> + (\(res,shortview) -> (set _2 <$> res, fvInput shortview)) <$> + mopt textField "" (Just $ row ^. _dbrOutput . _entityVal . _studyDegreeShorthand) + )) ] dbtSorting = Map.fromList [ ("degree-key" , SortColumn (E.^. StudyDegreeKey)) @@ -203,9 +225,9 @@ getAdminFeaturesR = do ] dbtFilter = mempty dbtFilterUI = mempty - dbtParams = def + dbtParams = def { dbParamsFormAddSubmit = True } psValidator = def & defaultSorting [SortAscBy "degree-name", SortAscBy "degree-short", SortAscBy "degree-key"] - in dbTableWidget' psValidator DBTable{..} + in dbTable psValidator DBTable{..} mkStudytermsTable = let dbtIdent = "admin-studyterms" :: Text diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index aa839b697..1175bf6e0 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -787,7 +787,7 @@ makeCourseUserTable cid colChoices psValidator = -- , ("course-user-note", error "TODO") -- TODO ] dbtFilterUI mPrev = mconcat - [ fltrUserNameEmailUI mPrev + [ fltrUserNameEmailUI mPrev , fltrUserMatriclenrUI mPrev ] dbtParams = def diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index a7bfbfa9b..22e536887 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -844,11 +844,11 @@ instance Ord i => Monoid (DBFormResult i a r) where getDBFormResult :: forall r i a. Ord i => (r -> a) -> DBFormResult i a r -> Map i a getDBFormResult initial (DBFormResult m) = Map.map (\(r, f) -> f $ initial r) m -formCell :: forall res r i a. (Ord i, Monoid res) - => Lens' res (FormResult (DBFormResult i a (DBRow r))) - -> (DBRow r -> MForm (HandlerT UniWorX IO) i) +formCell :: forall x r i a. (Ord i, Monoid x) + => Lens' x (FormResult (DBFormResult i a (DBRow r))) -- ^ lens focussing on the form result within the larger DBResult; @id@ iff the form delivers the only result of the table + -> (DBRow r -> MForm (HandlerT UniWorX IO) i) -- ^ generate row identfifiers for use in form result -> (DBRow r -> (forall p. PathPiece p => p -> Text) -> MForm (HandlerT UniWorX IO) (FormResult (a -> a), Widget)) -- ^ Given the row data and a callback to make an input name suitably unique generate the `MForm` - -> (DBRow r -> DBCell (MForm (HandlerT UniWorX IO)) res) + -> (DBRow r -> DBCell (MForm (HandlerT UniWorX IO)) x) formCell formCellLens genIndex genForm input@(DBRow{dbrKey}) = FormCell { formCellAttrs = [] , formCellContents = do -- MForm (HandlerT UniWorX IO) (FormResult (Map i (Endo a)), Widget) @@ -871,11 +871,11 @@ formCell formCellLens genIndex genForm input@(DBRow{dbrKey}) = FormCell dbRow :: forall h r m a. (Headedness h, IsDBTable m a) => Colonnade h (DBRow r) (DBCell m a) dbRow = Colonnade.singleton (headednessPure $ i18nCell MsgNrColumn) $ \DBRow{ dbrIndex } -> textCell $ tshow dbrIndex -dbSelect :: forall res h r i a. (Headedness h, Ord i, PathPiece i, Monoid res) - => Lens' res (FormResult (DBFormResult i a (DBRow r))) +dbSelect :: forall x h r i a. (Headedness h, Ord i, PathPiece i, Monoid x) + => Lens' x (FormResult (DBFormResult i a (DBRow r))) -> Setter' a Bool -> (DBRow r -> MForm (HandlerT UniWorX IO) i) - -> Colonnade h (DBRow r) (DBCell (MForm (HandlerT UniWorX IO)) res) + -> Colonnade h (DBRow r) (DBCell (MForm (HandlerT UniWorX IO)) x) dbSelect resLens selLens genIndex = Colonnade.singleton (headednessPure $ i18nCell MsgSelectColumn) $ formCell resLens genIndex genForm where genForm _ mkUnique = do