diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 6558b7e75..4bf4301c3 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -353,6 +353,7 @@ LecturersFor: Dozenten ForSchools n@Int: für #{pluralDE n "Institut" "Institute"} UserListTitle: Komprehensive Benutzerliste AccessRightsSaved: Berechtigungsänderungen wurden gespeichert. +AdminFeaturesHeading: Studiengänge Date: Datum DateTimeFormat: Datums- und Uhrzeitformat @@ -412,6 +413,13 @@ FieldPrimary: Hauptfach FieldSecondary: Nebenfach NoPrimaryStudyField: (kein Hauptfach registriert) +DegreeKey: Schlüssel Abschluss +DegreeName: Abschluss +DegreeShort: Abschlusskürzel +StudyTermsKey: Schlüssel Studiengang +StudyTermsName: Studiengang +StudyTermsShort: Studiengangkürzel + MailTestFormEmail: Email-Addresse MailTestFormLanguages: Spracheinstellungen diff --git a/routes b/routes index 1a9f35659..3be16416b 100644 --- a/routes +++ b/routes @@ -39,6 +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/errMsg AdminErrMsgR GET POST /info InfoR GET !free diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 946310640..083e5656e 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -8,11 +8,17 @@ import Data.Aeson.Encode.Pretty (encodePrettyToTextBuilder) import Control.Monad.Trans.Except +import Utils.Lens + -- import Data.Time -- import qualified Data.Text as T -- import Data.Function ((&)) -- import Yesod.Form.Bootstrap3 +-- import qualified Data.Set as Set +import qualified Data.Map as Map +import Handler.Utils.Table.Cells +import qualified Database.Esqueleto as E import Database.Persist.Sql (fromSqlKey) -- import Colonnade hiding (fromMaybe) @@ -154,3 +160,63 @@ postAdminErrMsgR = do
^{ctView} |] + + + +getAdminFeaturesR :: Handler Html +getAdminFeaturesR = do + degreeTable <- runDB mkDegreeTable + studytermsTable <- runDB mkStudytermsTable + + siteLayoutMsg MsgAdminFeaturesHeading $ do + setTitleI MsgAdminFeaturesHeading + [whamlet| + ^{degreeTable} + ^{studytermsTable} + |] + where + mkDegreeTable = + let dbtIdent = "admin-studydegrees" :: Text + dbtStyle = def + dbtSQLQuery :: (E.SqlExpr (Entity StudyDegree)) -> E.SqlQuery ( E.SqlExpr (Entity StudyDegree)) + dbtSQLQuery = return + dbtRowKey = (E.^. StudyDegreeKey) + 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)) + ] + dbtSorting = Map.fromList + [ ("degree-key" , SortColumn (E.^. StudyDegreeKey)) + , ("degree-name" , SortColumn (E.^. StudyDegreeName)) + , ("degree-short", SortColumn (E.^. StudyDegreeShorthand)) + ] + dbtFilter = mempty + dbtFilterUI = mempty + dbtParams = def + psValidator = def & defaultSorting [SortAscBy "degree-name", SortAscBy "degree-short", SortAscBy "degree-key"] + in dbTableWidget' psValidator DBTable{..} + + mkStudytermsTable = + let dbtIdent = "admin-studyterms" :: Text + dbtStyle = def + dbtSQLQuery :: (E.SqlExpr (Entity StudyTerms)) -> E.SqlQuery ( E.SqlExpr (Entity StudyTerms)) + dbtSQLQuery = return + dbtRowKey = (E.^. StudyTermsKey) + dbtProj = return + dbtColonnade = mconcat + [ sortable (Just "studyterms-key") (i18nCell MsgStudyTermsKey) (numCell . view (_dbrOutput . _entityVal . _studyTermsKey)) + , sortable (Just "studyterms-name") (i18nCell MsgStudyTermsName) (foldMap textCell . view (_dbrOutput . _entityVal . _studyTermsName)) + , sortable (Just "studyterms-short") (i18nCell MsgStudyTermsShort) (foldMap textCell . view (_dbrOutput . _entityVal . _studyTermsShorthand)) + ] + dbtSorting = Map.fromList + [ ("studyterms-key" , SortColumn (E.^. StudyTermsKey)) + , ("studyterms-name" , SortColumn (E.^. StudyTermsName)) + , ("studyterms-short", SortColumn (E.^. StudyTermsShorthand)) + ] + dbtFilter = mempty + dbtFilterUI = mempty + dbtParams = def + psValidator = def & defaultSorting [SortAscBy "studyterms-name", SortAscBy "studyterms-short", SortAscBy "studyterms-key"] + in dbTableWidget' psValidator DBTable{..} \ No newline at end of file diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index ccba2fdbb..0306d097c 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -757,7 +757,7 @@ makeCourseUserTable cid colChoices psValidator = let dbtIdent = "courseUsers" :: Text dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } dbtSQLQuery = userTableQuery cid - dbtRowKey ((user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note `E.LeftOuterJoin` _studyFeatures) = user E.^. UserId + dbtRowKey = queryUser >>> (E.^. UserId) dbtProj = traverse $ \(user, E.Value registrationTime , E.Value userNoteId, (feature,degree,terms)) -> return (user, registrationTime, userNoteId, (entityVal <$> feature, entityVal <$> degree, entityVal <$> terms)) dbtColonnade = colChoices dbtSorting = Map.fromList diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs index fc7e7a18e..1443b259d 100644 --- a/src/Utils/Lens.hs +++ b/src/Utils/Lens.hs @@ -82,6 +82,13 @@ makePrisms ''AuthResult makeLenses_ ''StudyFeatures +makeLenses_ ''StudyDegree + +makeLenses_ ''StudyTerms + +makeLenses_ ''StudyTermCandidate + + -- makeClassy_ ''Load