feat(favourites): usability improvements

2019-10-04 13:28:58 +02:00 · 2019-10-04 13:28:58 +02:00 · fccc2ea212
commit fccc2ea212
parent 93232201f2
9 changed files with 153 additions and 73 deletions
--- a/config/settings.yml
+++ b/config/settings.yml
@ -122,13 +122,14 @@ widget-memcached:
  expiration: "_env:MEMCACHEDEXPIRATION:3600"

 user-defaults:
-  max-favourites:   12
-  theme:            Default
-  date-time-format: "%a %d %b %Y %R"
-  date-format:      "%d.%m.%Y"
-  time-format:      "%R"
-  download-files:   false
-  warning-days:     1209600
+  max-favourites:      12
+  max-favourite-terms: 2
+  theme:               Default
+  date-time-format:    "%a %d %b %Y %R"
+  date-format:         "%d.%m.%Y"
+  time-format:         "%R"
+  download-files:      false
+  warning-days:        1209600

 # During central allocations lecturer-given ratings of applications (as
 # ExamGrades) are combined with a central priority.
--- a/frontend/src/utils/asidenav/asidenav.scss
+++ b/frontend/src/utils/asidenav/asidenav.scss
@ -56,6 +56,10 @@
      font-size: 18px;
      padding-left: 10px;
    }
+
+    .asidenav__box-subtitle {
+      display: none;
+    }
  }
 }

@ -95,6 +99,14 @@
  border-bottom: 1px solid var(--color-grey);
 }

+.asidenav__box-subtitle {
+  color: var(--color-fontsec);
+  font-size: 0.9rem;
+  font-weight: 600;
+  padding: 0 13px;
+  margin: 3px 0;
+}
+
 /* LOGO */

 .asidenav__logo {
@ -170,7 +182,7 @@
  position: absolute;
  bottom: -40px;
  right: 25px;
-  opacity: 0.2;
+  opacity: 0.1;

  > img {
    width: 350px;
@ -314,8 +326,16 @@
      color: var(--color-lightwhite);

      &:hover {
-        background-color: var(--color-dark);
+        background-color: var(--color-darker);
      }
+
+      &::before {
+        display: none;
+      }
+    }
+
+    .asidenav__box-subtitle {
+      display: none;
    }

    .asidenav__link-shorthand {
--- a/messages/uniworx/de.msg
+++ b/messages/uniworx/de.msg
@ -479,7 +479,9 @@ LdapSynced: LDAP-Synchronisiert
 LdapSyncedBefore: Letzte LDAP-Synchronisation vor
 NoMatrikelKnown: Keine Matrikelnummer
 Theme: Oberflächen Design
-Favoriten: Anzahl gespeicherter Favoriten
+Favourites: Anzahl gespeicherter Favoriten
+FavouritesTip: Betrifft nur automatisch angelegte Favoriten („Kürzlich besucht“)
+FavouriteSemesters: Maximale Anzahl an Semestern in Seitenleiste
 Plugin: Plugin
 Ident: Identifikation
 LastLogin: Letzter Login
@ -1873,4 +1875,9 @@ AllocationResultsLecturer: Es wurden Plätze zugewiesen, wie folgt:
 AllocationResultLecturer csh@CourseShorthand count@Int64: #{count} Teilnehmer für #{csh}
 AllocationResultsStudent: Sie haben Plätze erhalten in:
 AllocationNoResultsStudent: Sie haben leider keine Plätze erhalten.
-AllocationResultStudent csh@CourseShorthand: Sie haben einen Platz in #{csh} erhalten.
+AllocationResultStudent csh@CourseShorthand: Sie haben einen Platz in #{csh} erhalten.
+
+FavouriteVisited: Kürzlich besucht
+FavouriteParticipant: Ihre Kurse
+FavouriteManual: Favoriten
+FavouriteCurrent: Aktueller Kurs
--- a/models/users.model
+++ b/models/users.model
@ -21,7 +21,8 @@ User json    -- Each Uni2work user has a corresponding row in this table; create
    matrikelnummer UserMatriculation Maybe  -- optional immatriculation-string; usually a number, but not always (e.g. lecturers, pupils, guests,...)
    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
+    maxFavourites  Int default=12           -- max number of non-manual entries in favourites bar (pruned only if below a set importance threshold)
+    maxFavouriteTerms Int default=2         -- max number of term-sections in favourites bar
    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
    dateFormat     DateTimeFormat "default='%d.%m.%Y'"       -- preferred Date-only display format for user; user-defined
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@ -333,6 +333,7 @@ embedRenderMessage ''UniWorX ''AFormMessage $ concat . drop 2 . splitCamel
 embedRenderMessage ''UniWorX ''SchoolFunction id
 embedRenderMessage ''UniWorX ''CsvPreset id
 embedRenderMessage ''UniWorX ''Quoting ("Csv" <>)
+embedRenderMessage ''UniWorX ''FavouriteReason id

 embedRenderMessage ''UniWorX ''AuthenticationMode id

@ -1684,24 +1685,61 @@ siteLayout' headingOverride widget = do

  isAuth <- isJust <$> maybeAuthId

-  -- Lookup Favourites & Theme if possible -- TODO: cache this info in a cookie?!
-  (favourites', currentTheme) <- do
+  -- Lookup Favourites & Theme if possible
+  (favourites', maxFavouriteTerms, currentTheme) <- do
      muid <- maybeAuthPair
-      case muid of
-          Nothing         -> return ([],userDefaultTheme)
-          (Just (uid,user)) -> do
-              favs <- runDB $ E.select . E.from $ \(course `E.InnerJoin` courseFavourite) -> do
-                  E.on (course E.^. CourseId E.==. courseFavourite E.^. CourseFavouriteCourse)
-                  E.where_ (courseFavourite E.^. CourseFavouriteUser E.==. E.val uid)
-                  E.orderBy [ E.asc $ course E.^. CourseShorthand ]
-                  return course
-              return (favs, userTheme user)
-  favourites <- forM favourites' $ \(Entity _ c@Course{..})
+
+      favCourses <- runDB . E.select . E.from $ \(course `E.LeftOuterJoin` courseFavourite) -> do
+        E.on $ E.just (course E.^. CourseId) E.==. courseFavourite E.?. CourseFavouriteCourse
+         E.&&. courseFavourite E.?. CourseFavouriteUser E.==. E.val (view _1 <$> muid)
+
+        let isFavourite = E.not_ . E.isNothing $ courseFavourite E.?. CourseFavouriteId
+            isCurrent
+              | Just (CourseR tid ssh csh _) <- mcurrentRoute
+              =       course E.^. CourseTerm E.==. E.val tid
+                E.&&. course E.^. CourseSchool E.==. E.val ssh
+                E.&&. course E.^. CourseShorthand E.==. E.val csh
+              | otherwise
+              = E.false
+            notBlacklist = E.not_ . E.exists . E.from $ \courseNoFavourite ->
+              E.where_ $ E.just (courseNoFavourite E.^. CourseNoFavouriteUser) E.==. E.val (view _1 <$> muid)
+                   E.&&. courseNoFavourite E.^. CourseNoFavouriteCourse E.==. course E.^. CourseId
+            isParticipant = E.exists . E.from $ \participant ->
+              E.where_ $ participant E.^. CourseParticipantCourse E.==. course E.^. CourseId
+                   E.&&. E.just (participant E.^. CourseParticipantUser) E.==. E.val (view _1 <$> muid)
+            isLecturer = E.exists . E.from $ \lecturer ->
+              E.where_ $ lecturer E.^. LecturerCourse E.==. course E.^. CourseId
+                   E.&&. E.just (lecturer E.^. LecturerUser) E.==. E.val (view _1 <$> muid)
+            isCorrector = E.exists . E.from $ \(corrector `E.InnerJoin` sheet) -> do
+              E.on $ corrector E.^. SheetCorrectorSheet E.==. sheet E.^. SheetId
+               E.&&. sheet E.^. SheetCourse E.==. course E.^. CourseId
+              E.where_ $ E.just (corrector E.^. SheetCorrectorUser) E.==. E.val (view _1 <$> muid)
+            isTutor = E.exists . E.from $ \(tutor `E.InnerJoin` tutorial) -> do
+              E.on $ tutor E.^. TutorTutorial E.==. tutorial E.^. TutorialId
+               E.&&. tutorial E.^. TutorialCourse E.==. course E.^. CourseId
+              E.where_ $ E.just (tutor E.^. TutorUser) E.==. E.val (view _1 <$> muid)
+            isAssociated = isParticipant E.||. isLecturer E.||. isCorrector E.||. isTutor
+
+            reason = E.case_
+              [ E.when_ isAssociated E.then_ . E.just $ E.val FavouriteParticipant
+              , E.when_ isCurrent E.then_ . E.just $ E.val FavouriteCurrent
+              ] (E.else_ $ courseFavourite E.?. CourseFavouriteReason)
+            
+        E.where_ $ ((isFavourite E.||. isAssociated) E.&&. notBlacklist) E.||. isCurrent
+
+        return (course, reason)
+
+      return ( favCourses
+             , maybe userDefaultMaxFavouriteTerms userMaxFavouriteTerms $ view _2 <$> muid
+             , maybe userDefaultTheme userTheme $ view _2 <$> muid
+             )
+  favourites <- forM favourites' $ \(Entity _ c@Course{..}, E.Value mFavourite)
      -> let courseRoute = CourseR courseTerm courseSchool courseShorthand CShowR
+             favouriteReason = fromMaybe FavouriteCurrent mFavourite
         in do
           items <- filterM menuItemAccessCallback (pageActions courseRoute)
           items' <- forM items $ \i -> (i, ) <$> toTextUrl i
-           return (c, courseRoute, items')
+           return (c, courseRoute, items', favouriteReason)

  mmsgs <- if
    | isModal -> getMessages
@ -1718,9 +1756,11 @@ siteLayout' headingOverride widget = do
                      highR  = find (`elem` navItems) . uncurry (++) $ partition (`elem` map (view _2) favourites) crumbs
                  in \r -> Just r == highR
      favouriteTerms :: [TermIdentifier]
-      favouriteTerms = Set.toDescList $ foldMap (\(Course{..}, _, _) -> Set.singleton $ unTermKey courseTerm) favourites
-      favouriteTerm :: TermIdentifier -> [(Course, Route UniWorX, [(MenuItem, Text)])]
-      favouriteTerm tid = filter (\(Course{..}, _, _) -> unTermKey courseTerm == tid) favourites
+      favouriteTerms = take maxFavouriteTerms . Set.toDescList $ foldMap (\(Course{..}, _, _, _) -> Set.singleton $ unTermKey courseTerm) favourites
+      favouriteTermReason :: TermIdentifier -> FavouriteReason -> [(Course, Route UniWorX, [(MenuItem, Text)], FavouriteReason)]
+      favouriteTermReason tid favReason' = favourites
+        & filter (\(Course{..}, _, _, favReason) -> unTermKey courseTerm == tid && favReason == favReason')
+        & sortOn (\(Course{..}, _, _, _) -> courseName)

      -- We break up the default layout into two components:
      -- default-layout is the contents of the body tag, and
@ -3365,6 +3405,7 @@ upsertCampusUser ldapData Creds{..} = do
    newUser = User
      { userIdent                = mk credsIdent
      , userMaxFavourites        = userDefaultMaxFavourites
+      , userMaxFavouriteTerms    = userDefaultMaxFavouriteTerms
      , userTheme                = userDefaultTheme
      , userDateTimeFormat       = userDefaultDateTimeFormat
      , userDateFormat           = userDefaultDateFormat
--- a/src/Handler/Profile.hs
+++ b/src/Handler/Profile.hs
@ -29,16 +29,17 @@ import Jobs


 data SettingsForm = SettingsForm
-      { stgDisplayName   :: UserDisplayName
-      , stgDisplayEmail  :: UserEmail
-      , stgMaxFavourties :: Int
-      , stgTheme         :: Theme
-      , stgDateTime      :: DateTimeFormat
-      , stgDate          :: DateTimeFormat
-      , stgTime          :: DateTimeFormat
-      , stgDownloadFiles :: Bool
-      , stgWarningDays   :: NominalDiffTime
-      , stgSchools       :: Set SchoolId
+      { stgDisplayName          :: UserDisplayName
+      , stgDisplayEmail         :: UserEmail
+      , stgMaxFavourites        :: Int
+      , stgMaxFavouriteTerms    :: Int
+      , stgTheme                :: Theme
+      , stgDateTime             :: DateTimeFormat
+      , stgDate                 :: DateTimeFormat
+      , stgTime                 :: DateTimeFormat
+      , stgDownloadFiles        :: Bool
+      , stgWarningDays          :: NominalDiffTime
+      , stgSchools              :: Set SchoolId
      , stgNotificationSettings :: NotificationSettings
      }
 makeLenses_ ''SettingsForm
@ -77,8 +78,10 @@ makeSettingForm template html = do
        <*> areq (textField & cfStrip) (fslI MsgUserDisplayName & setTooltip MsgUserDisplayNameRulesBelow) (stgDisplayName <$> template)
        <*> areq (emailField & cfStrip & cfCI) (fslI MsgUserDisplayEmail & setTooltip MsgUserDisplayEmailTip) (stgDisplayEmail <$> template)
        <*  aformSection MsgFormCosmetics
-        <*> areq (natFieldI $ MsgNatField "Favoriten") -- TODO: natFieldI not working here
-            (fslpI MsgFavoriten "Anzahl Favoriten") (stgMaxFavourties <$> template)
+        <*> areq (natFieldI $ MsgNatField "Favoriten")
+            (fslpI MsgFavourites "Anzahl Favoriten" & setTooltip MsgFavouritesTip) (stgMaxFavourites <$> template)
+        <*> areq (natFieldI $ MsgNatField "Favoriten-Semester")
+            (fslpI MsgFavouriteSemesters "Anzahl Semester") (stgMaxFavouriteTerms <$> template)
        <*> areq (selectField . return $ mkOptionList themeList)
            (fslI  MsgTheme) { fsId = Just "theme-select" } (stgTheme         <$> template)
        <*> areq (selectField $ dateTimeFormatOptions SelFormatDateTime) (fslI MsgDateTimeFormat) (stgDateTime <$> template)
@ -235,31 +238,33 @@ postProfileR = do
           E.&&. userSchool E.^. UserSchoolSchool E.==. school E.^. SchoolId
    return $ school E.^. SchoolId
  let settingsTemplate = Just SettingsForm
-        { stgDisplayName   = userDisplayName
-        , stgDisplayEmail  = userDisplayEmail
-        , stgMaxFavourties = userMaxFavourites
-        , stgTheme         = userTheme
-        , stgDateTime      = userDateTimeFormat
-        , stgDate          = userDateFormat
-        , stgTime          = userTimeFormat
-        , stgDownloadFiles = userDownloadFiles
-        , stgSchools       = userSchools
+        { stgDisplayName          = userDisplayName
+        , stgDisplayEmail         = userDisplayEmail
+        , stgMaxFavourites        = userMaxFavourites
+        , stgMaxFavouriteTerms    = userMaxFavouriteTerms
+        , stgTheme                = userTheme
+        , stgDateTime             = userDateTimeFormat
+        , stgDate                 = userDateFormat
+        , stgTime                 = userTimeFormat
+        , stgDownloadFiles        = userDownloadFiles
+        , stgSchools              = userSchools
        , stgNotificationSettings = userNotificationSettings
-        , stgWarningDays   = userWarningDays
+        , stgWarningDays          = userWarningDays
        }
  ((res,formWidget), formEnctype) <- runFormPost . validateForm (validateSettings user) . identifyForm ProfileSettings $ makeSettingForm settingsTemplate

  formResult res $ \SettingsForm{..} -> do
    runDBJobs $ do
      update uid $
-        [ UserDisplayName    =. stgDisplayName
-        , UserMaxFavourites  =. stgMaxFavourties
-        , UserTheme          =. stgTheme
-        , UserDateTimeFormat =. stgDateTime
-        , UserDateFormat     =. stgDate
-        , UserTimeFormat     =. stgTime
-        , UserDownloadFiles  =. stgDownloadFiles
-        , UserWarningDays    =. stgWarningDays
+        [ UserDisplayName          =. stgDisplayName
+        , UserMaxFavourites        =. stgMaxFavourites
+        , UserMaxFavouriteTerms    =. stgMaxFavouriteTerms
+        , UserTheme                =. stgTheme
+        , UserDateTimeFormat       =. stgDateTime
+        , UserDateFormat           =. stgDate
+        , UserTimeFormat           =. stgTime
+        , UserDownloadFiles        =. stgDownloadFiles
+        , UserWarningDays          =. stgWarningDays
        , UserNotificationSettings =. stgNotificationSettings
        ] ++ [ UserDisplayEmail =. stgDisplayEmail | userDisplayEmail == stgDisplayEmail ]
      when (stgDisplayEmail /= userDisplayEmail) $ do
--- a/src/Handler/Users/Add.hs
+++ b/src/Handler/Users/Add.hs
@ -65,6 +65,7 @@ postAdminUserAddR = do
      newUser@User{..} = User
        { userIdent                   = aufIdent
        , userMaxFavourites           = userDefaultMaxFavourites
+        , userMaxFavouriteTerms       = userDefaultMaxFavouriteTerms
        , userTheme                   = userDefaultTheme
        , userDateTimeFormat          = userDefaultDateTimeFormat
        , userDateFormat              = userDefaultDateFormat
--- a/src/Settings.hs
+++ b/src/Settings.hs
@ -170,7 +170,7 @@ instance NFData LogDestination

 data UserDefaultConf = UserDefaultConf
  { userDefaultTheme :: Theme
-  , userDefaultMaxFavourites :: Int
+  , userDefaultMaxFavourites, userDefaultMaxFavouriteTerms :: Int
  , userDefaultDateTimeFormat, userDefaultDateFormat, userDefaultTimeFormat :: DateTimeFormat
  , userDefaultDownloadFiles :: Bool
  , userDefaultWarningDays :: NominalDiffTime
--- a/templates/widgets/asidenav/asidenav.hamlet
+++ b/templates/widgets/asidenav/asidenav.hamlet
@ -12,20 +12,24 @@ $newline never
      <div .asidenav__box>
        <h3 .asidenav__box-title uw-show-hide data-show-hide-id="#{termToText tid}" data-show-hide-align=right>
          _{ShortTermIdentifier tid}
-        <ul .asidenav__list.list--iconless>
-          $forall (Course{courseShorthand, courseName}, courseRoute, pageActions) <- favouriteTerm tid
-            <li .asidenav__list-item :highlight courseRoute:.asidenav__list-item--active>
-              <a .asidenav__link-wrapper href=@{courseRoute}>
-                <div .asidenav__link-shorthand>#{courseShorthand}
-                <div .asidenav__link-label>#{courseName}
-              <div .asidenav__nested-list-wrapper>
-                <ul .asidenav__nested-list.list--iconless>
-                  $forall (MenuItem{menuItemType, menuItemLabel}, route) <- pageActions
-                    $case menuItemType
-                      $of PageActionPrime
-                        <li .asidenav__nested-list-item>
-                          <a .asidenav__link-wrapper href=#{route}>_{menuItemLabel}
-                      $of _
+        $forall favReason <- sortOn Down universeF
+          $if not (null $ favouriteTermReason tid favReason)
+            <h3 .asidenav__box-subtitle>
+              _{favReason}
+            <ul .asidenav__list.list--iconless>
+              $forall (Course{courseShorthand, courseName}, courseRoute, pageActions, _) <- favouriteTermReason tid favReason
+                <li .asidenav__list-item :highlight courseRoute:.asidenav__list-item--active>
+                  <a .asidenav__link-wrapper href=@{courseRoute}>
+                    <div .asidenav__link-shorthand>#{courseShorthand}
+                    <div .asidenav__link-label>#{courseName}
+                  <div .asidenav__nested-list-wrapper>
+                    <ul .asidenav__nested-list.list--iconless>
+                      $forall (MenuItem{menuItemType, menuItemLabel}, route) <- pageActions
+                        $case menuItemType
+                          $of PageActionPrime
+                            <li .asidenav__nested-list-item>
+                              <a .asidenav__link-wrapper href=#{route}>_{menuItemLabel}
+                          $of _

    <div .asidenav__sigillum>
      <img src=@{StaticR img_lmu_sigillum_svg}>