From 7c0c70f2413f0095cc209cef21ec44d1b4ad5fe4 Mon Sep 17 00:00:00 2001 From: SJost Date: Tue, 18 Sep 2018 16:04:21 +0200 Subject: [PATCH] users have surnames now! --- db.hs | 19 +++++++++++++++++++ models | 1 + src/Foundation.hs | 7 +++++++ src/Handler/Corrections.hs | 5 +++-- src/Handler/Utils.hs | 14 ++++++++++++++ src/Handler/Utils/Table/Cells.hs | 3 +++ src/Model/Migration.hs | 14 +++++++++++++- 7 files changed, 60 insertions(+), 3 deletions(-) diff --git a/db.hs b/db.hs index 0c254a588..894c404d9 100755 --- a/db.hs +++ b/db.hs @@ -71,6 +71,7 @@ fillDb = do , userMatrikelnummer = Nothing , userEmail = "G.Kleen@campus.lmu.de" , userDisplayName = "Gregor Kleen" + , userSurname = "Kleen" , userMaxFavourites = 6 , userTheme = ThemeDefault , userDateTimeFormat = userDefaultDateTimeFormat @@ -84,6 +85,7 @@ fillDb = do , userMatrikelnummer = Nothing , userEmail = "felix.hamann@campus.lmu.de" , userDisplayName = "Felix Hamann" + , userSurname = "Hamann" , userMaxFavourites = userDefaultMaxFavourites , userTheme = ThemeDefault , userDateTimeFormat = userDefaultDateTimeFormat @@ -97,6 +99,7 @@ fillDb = do , userMatrikelnummer = Nothing , userEmail = "jost@tcs.ifi.lmu.de" , userDisplayName = "Steffen Jost" + , userSurname = "Jost" , userMaxFavourites = 14 , userTheme = ThemeMossGreen , userDateTimeFormat = userDefaultDateTimeFormat @@ -110,6 +113,7 @@ fillDb = do , userMatrikelnummer = Nothing , userEmail = "max@campus.lmu.de" , userDisplayName = "Max Musterstudent" + , userSurname = "Musterstudent" , userMaxFavourites = 7 , userTheme = ThemeAberdeenReds , userDateTimeFormat = userDefaultDateTimeFormat @@ -117,6 +121,21 @@ fillDb = do , userTimeFormat = userDefaultTimeFormat , userDownloadFiles = userDefaultDownloadFiles } + void . insert $ Term + void . insert $ User + { userPlugin = "LDAP" + , userIdent = "tester@campus.lmu.de" + , userMatrikelnummer = "999" + , userEmail = "tester@campus.lmu.de" + , userDisplayName = "Tina Tester" + , userSurname = "von Terror" + , userMaxFavourites = 5 + , userTheme = ThemeAberdeenReds + , userDateTimeFormat = userDefaultDateTimeFormat + , userDateFormat = userDefaultDateFormat + , userTimeFormat = userDefaultTimeFormat + , userDownloadFiles = userDefaultDownloadFiles + } void . insert $ Term { termName = summer2017 , termStart = fromGregorian 2017 04 09 diff --git a/models b/models index c3cb175bf..88a300dba 100644 --- a/models +++ b/models @@ -4,6 +4,7 @@ User json matrikelnummer Text Maybe email (CI Text) displayName Text + surname Text maxFavourites Int default=12 theme Theme default='Default' dateTimeFormat DateTimeFormat "default='%a %d %b %Y %R'" diff --git a/src/Foundation.hs b/src/Foundation.hs index e5a4dc284..388ff2372 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -1177,6 +1177,7 @@ instance YesodAuth UniWorX where userMatrikelnummer' = lookup (Attr "LMU-Stud-Matrikelnummer") ldapData userEmail' = lookup (Attr "mail") ldapData userDisplayName' = lookup (Attr "displayName") ldapData + userSurname' = lookup (Attr "sn") ldapData userEmail <- if | Just [bs] <- userEmail' @@ -1190,6 +1191,12 @@ instance YesodAuth UniWorX where -> return userDisplayName | otherwise -> throwError $ ServerError "Could not retrieve user name" + userSurname <- if + | Just [bs] <- userSurname' + , Right userSurname <- Text.decodeUtf8' bs + -> return userSurname + | otherwise + -> throwError $ ServerError "Could not retrieve user surname" userMatrikelnummer <- if | Just [bs] <- userMatrikelnummer' , Right userMatrikelnummer <- Text.decodeUtf8' bs diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 793e34772..d4692c59d 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -23,6 +23,7 @@ import Import import Handler.Utils import Handler.Utils.Submission +import Handler.Utils.Table.Cells -- import Handler.Utils.Zip import Data.Set (Set) @@ -103,7 +104,7 @@ colSheet = sortable (Just "sheet") (i18nCell MsgSheet) colCorrector :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a) colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector) $ \case DBRow{ dbrOutput = (_, _, _, Nothing , _) } -> cell mempty - DBRow{ dbrOutput = (_, _, _, Just corr, _) } -> textCell . display . userDisplayName $ entityVal corr + DBRow{ dbrOutput = (_, _, _, Just (Entity _ User{..}), _) } -> userCell userDisplayName userSurname colSubmissionLink :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a) colSubmissionLink = sortable Nothing (i18nCell MsgSubmission) @@ -183,7 +184,7 @@ makeCorrectionsTable whereClause colChoices psValidator = do , SortColumn $ \((_ `E.InnerJoin` sheet `E.InnerJoin` _) `E.LeftOuterJoin` _) -> sheet E.^. SheetName ) , ( "corrector" - , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` corrector) -> corrector E.?. UserDisplayName + , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` corrector) -> corrector E.?. UserSurname ) , ( "rating" , SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingPoints diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs index d9710c119..f2902da57 100644 --- a/src/Handler/Utils.hs +++ b/src/Handler/Utils.hs @@ -11,6 +11,8 @@ module Handler.Utils import Import +import qualified Data.Text as T + import Handler.Utils.DateTime as Handler.Utils import Handler.Utils.Form as Handler.Utils import Handler.Utils.Table as Handler.Utils @@ -31,3 +33,15 @@ downloadFiles = do Nothing -> do AppSettings{ appUserDefaults = UserDefaultConf{..} } <- getsYesod appSettings return userDefaultDownloadFiles + + +nameWidget :: Text -> Text -> Widget +nameWidget displayName surname + | null surname = toWidget displayName + | otherwise = case reverse $ T.splitOn surname displayName of + [_notContained] -> [whamlet|#{displayName} (#{surname})|] + (suffix:prefixes) -> + let prefix = T.intercalate surname $ reverse prefixes + in [whamlet|#{prefix}#{surname}#{suffix}|] + [] -> error "Data.Text.splitOn returned empty list in violation of specification." + diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs index ef1deabf8..bb658c68c 100644 --- a/src/Handler/Utils/Table/Cells.hs +++ b/src/Handler/Utils/Table/Cells.hs @@ -28,6 +28,9 @@ indicatorCell = mempty & cellContents %~ (tell (Any True) *>) timeCell :: IsDBTable m a => UTCTime -> DBCell m a timeCell t = cell $ formatTime SelFormatDateTime t >>= toWidget +userCell :: IsDBTable m a => Text -> Text -> DBCell m a +userCell displayName surname = cell $ nameWidget displayName surname + -- Just for documentation purposes; inline this code instead: maybeTimeCell :: IsDBTable m a => Maybe UTCTime -> DBCell m a maybeTimeCell = maybe mempty timeCell diff --git a/src/Model/Migration.hs b/src/Model/Migration.hs index 6e2e2474c..723ccd964 100644 --- a/src/Model/Migration.hs +++ b/src/Model/Migration.hs @@ -12,6 +12,8 @@ module Model.Migration import ClassyPrelude.Yesod +import Utils (lastMaybe) + import Model import Model.Migration.Version import Data.Map (Map) @@ -153,7 +155,7 @@ customMigrations = Map.fromListWith (>>) |] ) , ( AppliedMigrationKey [migrationVersion|2.0.0|] [version|3.0.0|] - , whenM (tableExists "sheet_corrector") $ do + , whenM (tableExists "sheet_corrector") $ do -- Load is encoded as JSON now. correctorLoads <- [sqlQQ| SELECT "id", "load" FROM "sheet_corrector"; |] forM_ correctorLoads $ \(uid, Single str) -> case readMaybe str of Just load -> update uid [SheetCorrectorLoad =. load] @@ -162,6 +164,16 @@ customMigrations = Map.fromListWith (>>) ALTER TABLE "sheet_corrector" ALTER COLUMN "load" TYPE json USING "load"::json; |] ) + , ( AppliedMigrationKey [migrationVersion|3.0.0|] [version|3.1.0|] + , whenM (tableExists "user") $ do + userDisplayNames <- [sqlQQ| SELECT "id", "display_name" FROM "user"; |] + [executeQQ| + ALTER TABLE "user" ADD COLUMN "surname" text DEFAULT ' '; + |] + forM_ userDisplayNames $ \(uid, Single str) -> case lastMaybe $ words str of + Just name -> update uid [UserSurname =. name] + _other -> error $ "Empty userDisplayName found" + ) ]