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"
+ )
]