feat(users): store first names and titles
This commit is contained in:
Gregor Kleen
parent
d0fb6ffd72
commit
ceed070e35
@ -1239,8 +1239,9 @@ Proportion c@Text of@Text prop@Rational: #{c}/#{of} (#{rationalToFixed2 (100 * p
|
||||
|
||||
CsvColumnsExplanationsLabel: Spalten
|
||||
CsvColumnsExplanationsTip: Bedeutung der in der CSV-Datei enthaltenen Spalten
|
||||
CsvColumnExamUserSurname: Nachname des Teilnehmers
|
||||
CsvColumnExamUserName: Voller Name des Teilnehmers (inkl. Nachname)
|
||||
CsvColumnExamUserSurname: Nachname(n) des Teilnehmers
|
||||
CsvColumnExamUserFirstName: Vorname(n) des Teilnehmers
|
||||
CsvColumnExamUserName: Voller Name des Teilnehmers (gewöhnlicherweise inkl. Vor- und Nachname(n))
|
||||
CsvColumnExamUserMatriculation: Matrikelnummer des Teilnehmers
|
||||
CsvColumnExamUserField: Hauptfach, mit dem der Teilnehmer seine Kursanmeldung assoziiert hat
|
||||
CsvColumnExamUserDegree: Abschluss, den der Teilnehmer im assoziierten Hauptfach anstrebt
|
||||
@ -1250,7 +1251,7 @@ CsvColumnExamUserExercisePoints: Anzahl von Punkten, die der Teilnehmer im Übun
|
||||
CsvColumnExamUserExercisePointsMax: Maximale Anzahl von Punkten, die der Teilnehmer im Übungsbetrieb bis zu seinem Klausurtermin erreichen hätte können
|
||||
CsvColumnExamUserExercisePasses: Anzahl von Übungsblättern, die der Teilnehmer bestanden hat
|
||||
CsvColumnExamUserExercisePassesMax: Maximale Anzahl von Übungsblättern, die der Teilnehmer bis zu seinem Klausurtermin bestehen hätte können
|
||||
CsvColumnExamResult: Erreichte Klausurleistung; "passed", "failed", "no-show", "voided", oder eine Note ("1.0", "1.3", "1.7", ..., "4.0", "5.0")
|
||||
CsvColumnExamUserResult: Erreichte Klausurleistung; "passed", "failed", "no-show", "voided", oder eine Note ("1.0", "1.3", "1.7", ..., "4.0", "5.0")
|
||||
|
||||
Action: Aktion
|
||||
|
||||
|
||||
@ -16,6 +16,8 @@ User json -- Each Uni2work user has a corresponding row in this table; create
|
||||
email (CI Text) -- Case-insensitive eMail address
|
||||
displayName Text -- we only show LDAP-DisplayName, and highlight LDAP-Surname within (appended if not contained)
|
||||
surname Text -- Display user names always through 'nameWidget displayName surname'
|
||||
firstName Text -- For export in tables, pre-split firstName from displayName
|
||||
title Text Maybe -- For upcoming name customisation
|
||||
maxFavourites Int default=12 -- max number of rows with this userId in table "CourseFavourite"; for convenience links; user-defined
|
||||
theme Theme default='Default' -- Color-theme of the frontend; user-defined
|
||||
dateTimeFormat DateTimeFormat "default='%a %d %b %Y %R'" -- preferred Date+Time display format for user; user-defined
|
||||
|
||||
@ -33,6 +33,7 @@ import qualified Data.ByteString.Base64.URL as Base64 (encode)
|
||||
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString.Lazy as Lazy.ByteString
|
||||
import qualified Data.ByteString as ByteString
|
||||
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.Encoding as Text
|
||||
@ -2748,7 +2749,9 @@ instance YesodAuth UniWorX where
|
||||
userMatrikelnummer' = lookup (Attr "LMU-Stud-Matrikelnummer") ldapData
|
||||
userEmail' = lookup (Attr "mail") ldapData
|
||||
userDisplayName' = lookup (Attr "displayName") ldapData
|
||||
userFirstName' = lookup (Attr "givenName") ldapData
|
||||
userSurname' = lookup (Attr "sn") ldapData
|
||||
userTitle' = lookup (Attr "title") ldapData
|
||||
|
||||
userAuthentication
|
||||
| isPWHash = error "PWHash should only work for users that are already known"
|
||||
@ -2767,12 +2770,26 @@ instance YesodAuth UniWorX where
|
||||
-> return userDisplayName
|
||||
| otherwise
|
||||
-> throwError $ ServerError "Could not retrieve user name"
|
||||
userFirstName <- if
|
||||
| Just [bs] <- userFirstName'
|
||||
, Right userFirstName <- Text.decodeUtf8' bs
|
||||
-> return userFirstName
|
||||
| otherwise
|
||||
-> throwError $ ServerError "Could not retrieve user given name"
|
||||
userSurname <- if
|
||||
| Just [bs] <- userSurname'
|
||||
, Right userSurname <- Text.decodeUtf8' bs
|
||||
-> return userSurname
|
||||
| otherwise
|
||||
-> throwError $ ServerError "Could not retrieve user surname"
|
||||
userTitle <- if
|
||||
| maybe True (all ByteString.null) userTitle'
|
||||
-> return Nothing
|
||||
| Just [bs] <- userTitle'
|
||||
, Right userTitle <- Text.decodeUtf8' bs
|
||||
-> return $ Just userTitle
|
||||
| otherwise
|
||||
-> throwError $ ServerError "Could not retrieve user title"
|
||||
userMatrikelnummer <- if
|
||||
| Just [bs] <- userMatrikelnummer'
|
||||
, Right userMatrikelnummer <- Text.decodeUtf8' bs
|
||||
|
||||
@ -92,6 +92,7 @@ resultExamResult = _dbrOutput . _7 . _Just
|
||||
|
||||
data ExamUserTableCsv = ExamUserTableCsv
|
||||
{ csvEUserSurname :: Maybe Text
|
||||
, csvEUserFirstName :: Maybe Text
|
||||
, csvEUserName :: Maybe Text
|
||||
, csvEUserMatriculation :: Maybe Text
|
||||
, csvEUserField :: Maybe Text
|
||||
@ -122,6 +123,7 @@ instance DefaultOrdered ExamUserTableCsv where
|
||||
instance CsvColumnsExplained ExamUserTableCsv where
|
||||
csvColumnsExplanations = genericCsvColumnsExplanations examUserTableCsvOptions $ Map.fromList
|
||||
[ ('csvEUserSurname , MsgCsvColumnExamUserSurname )
|
||||
, ('csvEUserFirstName , MsgCsvColumnExamUserFirstName )
|
||||
, ('csvEUserName , MsgCsvColumnExamUserName )
|
||||
, ('csvEUserMatriculation , MsgCsvColumnExamUserMatriculation )
|
||||
, ('csvEUserField , MsgCsvColumnExamUserField )
|
||||
@ -132,7 +134,7 @@ instance CsvColumnsExplained ExamUserTableCsv where
|
||||
, ('csvEUserExerciseNumPasses , MsgCsvColumnExamUserExercisePasses )
|
||||
, ('csvEUserExercisePointsMax , MsgCsvColumnExamUserExercisePointsMax )
|
||||
, ('csvEUserExerciseNumPassesMax, MsgCsvColumnExamUserExercisePassesMax )
|
||||
, ('csvEUserExamResult , MsgCsvColumnExamResult )
|
||||
, ('csvEUserExamResult , MsgCsvColumnExamUserResult )
|
||||
]
|
||||
|
||||
data ExamUserAction = ExamUserDeregister
|
||||
@ -253,8 +255,6 @@ postEUsersR tid ssh csh examn = do
|
||||
]
|
||||
dbtSorting = Map.fromList
|
||||
[ sortUserNameLink queryUser
|
||||
, sortUserSurname queryUser
|
||||
, sortUserDisplayName queryUser
|
||||
, sortUserMatriclenr queryUser
|
||||
, sortField queryStudyField
|
||||
, sortDegreeShort queryStudyDegree
|
||||
@ -325,6 +325,7 @@ postEUsersR tid ssh csh examn = do
|
||||
dbtCsvEncode :: DBTCsvEncode ExamUserTableData ExamUserTableCsv
|
||||
dbtCsvEncode = DictJust . C.map $ ExamUserTableCsv
|
||||
<$> view (resultUser . _entityVal . _userSurname . to Just)
|
||||
<*> view (resultUser . _entityVal . _userFirstName . to Just)
|
||||
<*> view (resultUser . _entityVal . _userDisplayName . to Just)
|
||||
<*> view (resultUser . _entityVal . _userMatrikelnummer)
|
||||
<*> preview (resultStudyField . _entityVal . to (\StudyTerms{..} -> studyTermsName <|> studyTermsShorthand <|> Just (tshow studyTermsKey)) . _Just)
|
||||
@ -511,6 +512,7 @@ postEUsersR tid ssh csh examn = do
|
||||
[ (user E.^. UserMatrikelnummer E.==.) . E.val . Just <$> csvEUserMatriculation
|
||||
, (user E.^. UserDisplayName E.==.) . E.val <$> csvEUserName
|
||||
, (user E.^. UserSurname E.==.) . E.val <$> csvEUserSurname
|
||||
, (user E.^. UserFirstName E.==.) . E.val <$> csvEUserFirstName
|
||||
]
|
||||
let isCourseParticipant = E.exists . E.from $ \courseParticipant ->
|
||||
E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. E.val examCourse
|
||||
|
||||
@ -16,6 +16,10 @@ import qualified Data.Map as Map
|
||||
import Data.Set ()
|
||||
import qualified Data.Set as Set
|
||||
|
||||
import qualified Data.Text as Text
|
||||
|
||||
import qualified Data.Conduit.List as C
|
||||
|
||||
import Database.Persist.Sql
|
||||
import Database.Persist.Postgresql
|
||||
|
||||
@ -61,7 +65,7 @@ share [mkPersist sqlSettings, mkMigrate "migrateDBVersioning"]
|
||||
|
||||
migrateAll :: ( MonadLogger m
|
||||
, MonadBaseControl IO m
|
||||
, MonadIO m
|
||||
, MonadResource m
|
||||
)
|
||||
=> ReaderT SqlBackend m ()
|
||||
migrateAll = do
|
||||
@ -86,7 +90,7 @@ migrateAll = do
|
||||
requiresMigration :: forall m.
|
||||
( MonadLogger m
|
||||
, MonadBaseControl IO m
|
||||
, MonadIO m
|
||||
, MonadResource m
|
||||
)
|
||||
=> ReaderT SqlBackend m Bool
|
||||
requiresMigration = mapReaderT (exceptT return return) $ do
|
||||
@ -117,7 +121,7 @@ getMissingMigrations :: forall m m'.
|
||||
( MonadLogger m
|
||||
, MonadBaseControl IO m
|
||||
, MonadIO m
|
||||
, MonadIO m'
|
||||
, MonadResource m'
|
||||
)
|
||||
=> ReaderT SqlBackend m (Map (Key AppliedMigration) (ReaderT SqlBackend m' ()))
|
||||
getMissingMigrations = do
|
||||
@ -134,8 +138,9 @@ getMissingMigrations = do
|
||||
-}
|
||||
|
||||
|
||||
customMigrations :: ( MonadIO m
|
||||
) => Map (Key AppliedMigration) (ReaderT SqlBackend m ())
|
||||
customMigrations :: forall m.
|
||||
MonadResource m
|
||||
=> Map (Key AppliedMigration) (ReaderT SqlBackend m ())
|
||||
customMigrations = Map.fromListWith (>>)
|
||||
[ ( AppliedMigrationKey [migrationVersion|initial|] [version|0.0.0|]
|
||||
, whenM (columnExists "user" "theme") $ do -- New theme format
|
||||
@ -318,6 +323,24 @@ customMigrations = Map.fromListWith (>>)
|
||||
ALTER TABLE "exam_occurrence" ALTER COLUMN "name" SET NOT NULL;
|
||||
|]
|
||||
)
|
||||
, ( AppliedMigrationKey [migrationVersion|14.0.0|] [version|15.0.0|]
|
||||
, whenM (tableExists "user") $ do
|
||||
[executeQQ|
|
||||
ALTER TABLE "user" ADD COLUMN "first_name" text NOT NULL DEFAULT '';
|
||||
ALTER TABLE "user" ADD COLUMN "title" text DEFAULT null;
|
||||
|]
|
||||
let getUsers = rawQuery [st|SELECT "id", "display_name", "surname" FROM "user"|] []
|
||||
updateUser (uid, firstName) = [executeQQ|UPDATE "user" SET "first_name" = #{firstName} WHERE "id" = #{uid}|]
|
||||
splitFirstName :: [PersistValue] -> Maybe (UserId, Text)
|
||||
splitFirstName [fromPersistValue -> Right uid, fromPersistValue -> Right displayName, fromPersistValue -> Right surname] = Just . (uid, ) $ if
|
||||
| Just givenName <- Text.stripSuffix surname displayName
|
||||
<|> Text.stripPrefix surname displayName
|
||||
-> Text.strip givenName
|
||||
| otherwise
|
||||
-> Text.replace surname "…" displayName
|
||||
splitFirstName _ = Nothing
|
||||
runConduit $ getUsers .| C.mapMaybe splitFirstName .| C.mapM_ updateUser
|
||||
)
|
||||
]
|
||||
|
||||
|
||||
|
||||
@ -95,6 +95,8 @@ fillDb = do
|
||||
, userEmail = "G.Kleen@campus.lmu.de"
|
||||
, userDisplayName = "Gregor Kleen"
|
||||
, userSurname = "Kleen"
|
||||
, userFirstName = "Gregor Julius Arthur"
|
||||
, userTitle = Nothing
|
||||
, userMaxFavourites = 6
|
||||
, userTheme = ThemeDefault
|
||||
, userDateTimeFormat = userDefaultDateTimeFormat
|
||||
@ -113,6 +115,8 @@ fillDb = do
|
||||
, userEmail = "felix.hamann@campus.lmu.de"
|
||||
, userDisplayName = "Felix Hamann"
|
||||
, userSurname = "Hamann"
|
||||
, userFirstName = "Felix"
|
||||
, userTitle = Nothing
|
||||
, userMaxFavourites = userDefaultMaxFavourites
|
||||
, userTheme = ThemeDefault
|
||||
, userDateTimeFormat = userDefaultDateTimeFormat
|
||||
@ -131,6 +135,8 @@ fillDb = do
|
||||
, userEmail = "jost@tcs.ifi.lmu.de"
|
||||
, userDisplayName = "Steffen Jost"
|
||||
, userSurname = "Jost"
|
||||
, userFirstName = "Steffen"
|
||||
, userTitle = Just "Dr."
|
||||
, userMaxFavourites = 14
|
||||
, userTheme = ThemeMossGreen
|
||||
, userDateTimeFormat = userDefaultDateTimeFormat
|
||||
@ -149,6 +155,8 @@ fillDb = do
|
||||
, userEmail = "max@campus.lmu.de"
|
||||
, userDisplayName = "Max Musterstudent"
|
||||
, userSurname = "Musterstudent"
|
||||
, userFirstName = "Max"
|
||||
, userTitle = Nothing
|
||||
, userMaxFavourites = 7
|
||||
, userTheme = ThemeAberdeenReds
|
||||
, userDateTimeFormat = userDefaultDateTimeFormat
|
||||
@ -167,6 +175,8 @@ fillDb = do
|
||||
, userEmail = "tester@campus.lmu.de"
|
||||
, userDisplayName = "Tina Tester"
|
||||
, userSurname = "von Terror"
|
||||
, userFirstName = "Sabrina"
|
||||
, userTitle = Just "Magister"
|
||||
, userMaxFavourites = 5
|
||||
, userTheme = ThemeAberdeenReds
|
||||
, userDateTimeFormat = userDefaultDateTimeFormat
|
||||
@ -185,6 +195,8 @@ fillDb = do
|
||||
, userEmail = "vaupel.sarah@campus.lmu.de"
|
||||
, userDisplayName = "Sarah Vaupel"
|
||||
, userSurname = "Vaupel"
|
||||
, userFirstName = "Sarah"
|
||||
, userTitle = Nothing
|
||||
, userMaxFavourites = 14
|
||||
, userTheme = ThemeMossGreen
|
||||
, userDateTimeFormat = userDefaultDateTimeFormat
|
||||
|
||||
Loading…
Reference in New Issue
Block a user