From b757acb5224adf9a9c1b8a0e21ce1a5c09b6f011 Mon Sep 17 00:00:00 2001
From: Sarah Vaupel <>
Date: Tue, 27 Oct 2020 12:22:10 +0100
Subject: [PATCH] feat(profile): add default schedule view to profile form

---
 messages/uniworx/de-de-formal.msg |  3 +++
 messages/uniworx/en-eu.msg        |  3 +++
 src/Foundation/I18n.hs            |  8 ++++++++
 src/Handler/Profile.hs            | 11 ++++++++++-
 4 files changed, 24 insertions(+), 1 deletion(-)

diff --git a/messages/uniworx/de-de-formal.msg b/messages/uniworx/de-de-formal.msg
index f470abd8e..0e54d3b66 100644
--- a/messages/uniworx/de-de-formal.msg
+++ b/messages/uniworx/de-de-formal.msg
@@ -107,6 +107,9 @@ ScheduleTitle: Terminübersicht
 ScheduleView: Ansicht
 ScheduleViewWeek: Woche
 
+ProfileScheduleView: Standard-Ansicht der Terminübersicht
+ProfileScheduleViewTip: Betrifft Terminübersicht auf „Aktuelles“ und „Terminübersicht“ (weitere Ansichten in Arbeit)
+
 ScheduleOffsetWeekBackwardWeek: 1 Woche zurück
 ScheduleOffsetWeekBackwardDay: 1 Tag zurück
 ScheduleOffsetWeekCurrent: Zu aktueller Woche springen
diff --git a/messages/uniworx/en-eu.msg b/messages/uniworx/en-eu.msg
index a21b4b503..0c89abb57 100644
--- a/messages/uniworx/en-eu.msg
+++ b/messages/uniworx/en-eu.msg
@@ -108,6 +108,9 @@ ScheduleTitle: Schedule
 ScheduleView: View
 ScheduleViewWeek: Week
 
+ProfileScheduleView: Standard schedule view
+ProfileScheduleViewTip: Relevant for schedule on "News" and "Schedule" (more views are in the works)
+
 ScheduleOffsetWeekBackwardWeek: 1 week back
 ScheduleOffsetWeekBackwardDay: 1 day back
 ScheduleOffsetWeekCurrent: Jump to current week
diff --git a/src/Foundation/I18n.hs b/src/Foundation/I18n.hs
index ac5e31cb0..b8cee3c41 100644
--- a/src/Foundation/I18n.hs
+++ b/src/Foundation/I18n.hs
@@ -34,6 +34,7 @@ import Data.CaseInsensitive (original, mk)
 import qualified Data.Text as Text
 
 import Utils.Form
+import Utils.Schedule.Types.ScheduleView
 
 import qualified GHC.Exts (IsList(..))
 
@@ -322,6 +323,13 @@ instance RenderMessage UniWorX CourseParticipantState where
       mr :: RenderMessage UniWorX msg => msg -> Text
       mr = renderMessage foundation ls
 
+instance RenderMessage UniWorX ScheduleView where
+  renderMessage foundation ls = \case
+    ScheduleViewWeek -> mr MsgScheduleViewWeek
+    where
+      mr :: RenderMessage UniWorX msg => msg -> Text
+      mr = renderMessage foundation ls
+
 -- ToMessage instances for converting raw numbers to Text (no internationalization)
 
 instance ToMessage Int where
diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs
index 743bb67f2..0030dd0d0 100644
--- a/src/Handler/Profile.hs
+++ b/src/Handler/Profile.hs
@@ -28,8 +28,11 @@ import qualified Data.CaseInsensitive as CI
 
 import Jobs
 
+import Foundation.I18n ()
 import Foundation.Yesod.Auth (updateUserLanguage)
 
+import Utils.Schedule.Types.ScheduleView
+
 
 data SettingsForm = SettingsForm
       { stgDisplayName          :: UserDisplayName
@@ -40,6 +43,7 @@ data SettingsForm = SettingsForm
       , stgDateTime             :: DateTimeFormat
       , stgDate                 :: DateTimeFormat
       , stgTime                 :: DateTimeFormat
+      , stgScheduleView         :: ScheduleView
       , stgDownloadFiles        :: Bool
       , stgWarningDays          :: NominalDiffTime
       , stgShowSex              :: Bool
@@ -107,6 +111,8 @@ makeSettingForm template html = do
         <*> areq (selectField $ dateTimeFormatOptions SelFormatDateTime) (fslI MsgDateTimeFormat) (stgDateTime <$> template)
         <*> areq (selectField $ dateTimeFormatOptions SelFormatDate) (fslI MsgDateFormat) (stgDate <$> template)
         <*> areq (selectField $ dateTimeFormatOptions SelFormatTime) (fslI MsgTimeFormat) (stgTime <$> template)
+        <*> areq (selectField . return $ mkOptionList (scheduleViewList mr))
+            (fslI MsgProfileScheduleView & setTooltip MsgProfileScheduleViewTip) { fsId = Just "schedule-view-select" } (stgScheduleView <$> template)
         <*  aformSection MsgFormBehaviour
         <*> apopt checkBoxField (fslI MsgDownloadFiles
                                    & setTooltip MsgDownloadFilesTip
@@ -121,7 +127,8 @@ makeSettingForm template html = do
         <*> allocationNotificationForm (stgAllocationNotificationSettings <$> template)
     return (result, widget) -- no validation required here
   where
-    themeList = [Option (toMessage t) t (toPathPiece t) | t <- universeF]
+    themeList = [ Option (toMessage t) t (toPathPiece t) | t <- universeF ]
+    scheduleViewList mr = [ Option (mr t) t (toPathPiece t) | t <- universeF ]
 
 schoolsForm :: Maybe (Set SchoolId) -> AForm Handler (Set SchoolId)
 schoolsForm template = formToAForm $ schoolsFormView =<< renderWForm FormStandard schoolsForm' mempty
@@ -358,6 +365,7 @@ postProfileR = do
         , stgDateTime             = userDateTimeFormat
         , stgDate                 = userDateFormat
         , stgTime                 = userTimeFormat
+        , stgScheduleView         = userScheduleView
         , stgDownloadFiles        = userDownloadFiles
         , stgSchools              = userSchools
         , stgNotificationSettings = userNotificationSettings
@@ -377,6 +385,7 @@ postProfileR = do
         , UserDateTimeFormat       =. stgDateTime
         , UserDateFormat           =. stgDate
         , UserTimeFormat           =. stgTime
+        , UserScheduleView         =. stgScheduleView
         , UserDownloadFiles        =. stgDownloadFiles
         , UserWarningDays          =. stgWarningDays
         , UserNotificationSettings =. stgNotificationSettings