diff --git a/config/settings.yml b/config/settings.yml index c3ff0ecf3..d369568f1 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -40,7 +40,11 @@ ldap: password: "_env:LDAPPW:" basename: "_env:LDAPBN:" -userDefaultFavourites: 12 +default-favourites: 12 +default-theme: Default +default-date-time-format: "%a %d %b %Y %R" +default-date-format: "%d.%m.%Y" +default-time-format: "%R" cryptoid-keyfile: "_env:CRYPTOID_KEYFILE:cryptoid_key.bf" diff --git a/db.hs b/db.hs index a0f980180..6db5f2188 100755 --- a/db.hs +++ b/db.hs @@ -5,6 +5,7 @@ {-# LANGUAGE PackageImports #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RecordWildCards #-} import "uniworx" Import hiding (Option(..)) import "uniworx" Application (db, getAppDevSettings) @@ -47,7 +48,7 @@ main = do fillDb :: DB () fillDb = do - defaultFavourites <- getsYesod $ appDefaultFavourites . appSettings + AppSettings{..} <- getsYesod appSettings now <- liftIO getCurrentTime let summer2017 = TermIdentifier 2017 Summer @@ -60,7 +61,10 @@ fillDb = do , userEmail = "G.Kleen@campus.lmu.de" , userDisplayName = "Gregor Kleen" , userMaxFavourites = 6 - , userTheme = AberdeenReds + , userTheme = Default + , userDateTimeFormat = appDefaultDateTimeFormat + , userDateFormat = appDefaultDateFormat + , userTimeFormat = appDefaultTimeFormat } fhamann <- insert User { userPlugin = "LDAP" @@ -68,8 +72,11 @@ fillDb = do , userMatrikelnummer = Nothing , userEmail = "felix.hamann@campus.lmu.de" , userDisplayName = "Felix Hamann" - , userMaxFavourites = defaultFavourites + , userMaxFavourites = appDefaultMaxFavourites , userTheme = Default + , userDateTimeFormat = appDefaultDateTimeFormat + , userDateFormat = appDefaultDateFormat + , userTimeFormat = appDefaultTimeFormat } jost <- insert User { userPlugin = "LDAP" @@ -79,6 +86,9 @@ fillDb = do , userDisplayName = "Steffen Jost" , userMaxFavourites = 14 , userTheme = MossGreen + , userDateTimeFormat = appDefaultDateTimeFormat + , userDateFormat = appDefaultDateFormat + , userTimeFormat = appDefaultTimeFormat } void . insert $ User { userPlugin = "LDAP" @@ -88,6 +98,9 @@ fillDb = do , userDisplayName = "Max Musterstudent" , userMaxFavourites = 7 , userTheme = AberdeenReds + , userDateTimeFormat = appDefaultDateTimeFormat + , userDateFormat = appDefaultDateFormat + , userTimeFormat = appDefaultTimeFormat } void . insert $ Term { termName = summer2017 diff --git a/messages/de.msg b/messages/de.msg index ea407972e..4188502e7 100644 --- a/messages/de.msg +++ b/messages/de.msg @@ -76,6 +76,7 @@ CorrectionHead tid@TermId courseShortHand@Text sheetName@Text cid@CryptoFileName SubmissionMember g@Int: Mitabgebende(r) ##{display g} SubmissionArchive: Zip-Archiv der Abgabedatei(en) SubmissionFile: Datei zur Abgabe +SubmissionFiles: Abgegebene Dateien SubmissionAlreadyExistsFor user@Text: #{user} hat bereits eine Abgabe zu diesem bÜbungsblatt. CorrectionsTitle: Zugewiesene Korrekturen @@ -195,4 +196,12 @@ NoUpcomingSheetDeadlines: Keine anstehenden Übungsblätter AdminFor: Administrator LecturerFor: Dozent -UserListTitle: Komprehensive Benutzerliste \ No newline at end of file +UserListTitle: Komprehensive Benutzerliste + +DateTimeFormatOption dateTimeExp@String dateExp@String timeExp@String: #{dateTimeExp} / #{dateExp} / #{timeExp} + +InvalidDateTimeFormat: Ungültiges Datums- und Zeitformat, JJJJ-MM-TTTHH:MM[:SS] Format erwartet +AmbiguousUTCTime: Der angegebene Zeitpunkt lässt sich nicht eindeutig zu UTC konvertieren + +LastEdits: Letzte Änderungen +EditedBy name@Text time@Text: Durch #{name} um #{time} \ No newline at end of file diff --git a/models b/models index 909a72610..0fbb50c92 100644 --- a/models +++ b/models @@ -4,8 +4,11 @@ User json matrikelnummer Text Maybe email Text displayName Text - maxFavourites Int default=12 - theme Theme default='default' + maxFavourites Int default=12 + theme Theme default='Default' + dateTimeFormat DateTimeFormat "default='%a %d %b %Y %R'" + dateFormat DateTimeFormat "default='%d.%m.%Y'" + timeFormat DateTimeFormat "default='%R'" UniqueAuthentication plugin ident UniqueEmail email deriving Show @@ -67,7 +70,7 @@ Course registerTo UTCTime Maybe deregisterUntil UTCTime Maybe registerSecret Text Maybe -- Falls ein Passwort erforderlich ist - materialFree Bool default=true + materialFree Bool CourseTermShort term shorthand CourseEdit user UserId diff --git a/package.yaml b/package.yaml index 1f2496141..6f6de5fd2 100644 --- a/package.yaml +++ b/package.yaml @@ -83,6 +83,9 @@ dependencies: - MonadRandom - email-validate - scientific +- tz +- system-locale +- th-lift-instances # The library contains all of our application code. The executable # defined below is just a thin wrapper. diff --git a/src/Foundation.hs b/src/Foundation.hs index 8a307908b..0a6a3b50d 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -72,8 +72,8 @@ import System.FilePath import Handler.Utils.Templates import Handler.Utils.StudyFeatures -import Handler.Utils.DateTime import Control.Lens +import Utils import Utils.Lens import Data.Aeson @@ -88,9 +88,6 @@ import Text.Shakespeare.Text (st) instance DisplayAble TermId where display = termToText . unTermKey -instance DisplayAble UTCTime where - display = pack . formatTimeGerDT2 -- default Time Format to be used: 00.00.00 00:00 - instance (PathPiece b) => DisplayAble (Data.CryptoID.CryptoID a b) where display = toPathPiece -- requires import of Data.CryptoID here -- -- MOVE ABOVE @@ -184,6 +181,13 @@ instance RenderMessage UniWorX SheetFileType where SheetMarking -> renderMessage' MsgSheetMarking where renderMessage' = renderMessage foundation ls +getTimeLocale' :: [Lang] -> TimeLocale +getTimeLocale' = $(timeLocaleMap [("de", "de_DE.utf8")]) + +appTZ :: TZ +appTZ = $(includeSystemTZ "Europe/Berlin") + + -- Access Control data AccessPredicate = APPure (Route UniWorX -> Bool -> Reader MsgRenderer AuthResult) @@ -999,9 +1003,14 @@ instance YesodAuth UniWorX where userEmail <- maybe (throwError $ ServerError "Could not retrieve user email") return userEmail' userDisplayName <- maybe (throwError $ ServerError "Could not retrieve user name") return userDisplayName' + AppSettings{..} <- getsYesod appSettings + let - userMaxFavourites = 12 -- TODO: appDefaultFavourites appSettings - userTheme = Default -- TODO: appDefaultFavourites appSettings + userMaxFavourites = appDefaultMaxFavourites + userTheme = appDefaultTheme + userDateTimeFormat = appDefaultDateTimeFormat + userDateFormat = appDefaultDateFormat + userTimeFormat = appDefaultTimeFormat newUser = User{..} userUpdate = [ UserMatrikelnummer =. userMatrikelnummer , UserDisplayName =. userDisplayName diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index d4e2c529b..6b75a8f89 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -62,8 +62,8 @@ getTermCourseListR tid = do [ sortable (Just "shorthand") (textCell MsgCourse) $ anchorCell' (\(Entity _ Course{..}, _) -> CourseR courseTerm courseShorthand CShowR) (\(Entity _ Course{..}, _) -> toWidget courseShorthand) - , sortable (Just "register-from") (textCell MsgRegisterFrom) $ \(Entity _ Course{..}, _) -> textCell $ display courseRegisterFrom - , sortable (Just "register-to") (textCell MsgRegisterTo) $ \(Entity _ Course{..}, _) -> textCell $ display courseRegisterTo + , sortable (Just "register-from") (textCell MsgRegisterFrom) $ \(Entity _ Course{..}, _) -> cell $ traverse (formatTime SelFormatDateTime) courseRegisterFrom >>= maybe mempty toWidget + , sortable (Just "register-to") (textCell MsgRegisterTo) $ \(Entity _ Course{..}, _) -> cell $ traverse (formatTime SelFormatDateTime) courseRegisterTo >>= maybe mempty toWidget , sortable (Just "members") (textCell MsgCourseMembers) $ \(Entity _ Course{..}, E.Value num) -> textCell $ case courseCapacity of Nothing -> MsgCourseMembersCount num Just max -> MsgCourseMembersCountLimited num max @@ -110,6 +110,8 @@ getCShowR tid csh = do let course = entityVal courseEnt (regWidget, regEnctype) <- generateFormPost $ identifyForm "registerBtn" $ registerForm registered $ courseRegisterSecret course registrationOpen <- (==Authorized) <$> isAuthorized (CourseR tid csh CRegisterR) True + mRegFrom <- traverse (formatTime SelFormatDateTime) $ courseRegisterFrom course + mRegTo <- traverse (formatTime SelFormatDateTime) $ courseRegisterTo course defaultLayout $ do setTitle $ [shamlet| #{toPathPiece tid} - #{csh}|] $(widgetFile "course") diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs index b5e0b7412..3f3c2184f 100644 --- a/src/Handler/Home.hs +++ b/src/Handler/Home.hs @@ -16,7 +16,7 @@ import Handler.Utils import qualified Data.Map as Map -import Data.Time +import Data.Time hiding (formatTime) -- import qualified Data.Text as T -- import Yesod.Form.Bootstrap3 @@ -77,7 +77,7 @@ homeAnonymous = do , sortable (Just "term") (textCell MsgTerm) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } -> textCell $ display $ courseTerm course , sortable (Just "deadline") (textCell MsgRegisterTo) $ \DBRow{ dbrOutput=(Entity {entityVal = course}) } -> - textCell $ display $ courseRegisterTo course + cell $ traverse (formatTime SelFormatDateTime) (courseRegisterTo course) >>= maybe mempty toWidget ] courseTable <- dbTable def $ DBTable { dbtSQLQuery = tableData @@ -154,7 +154,7 @@ homeUser uid = do , sortable (Just "sheet") (textCell MsgSheet) $ \DBRow{ dbrOutput=(E.Value tid, E.Value csh, E.Value shn, _, _) } -> cell [whamlet|#{display shn}|] , sortable (Just "deadline") (textCell MsgDeadline) $ \DBRow{ dbrOutput=(_, _, _, E.Value deadline, _) } -> - textCell $ display deadline + cell $ formatTime SelFormatDateTime deadline >>= toWidget , sortable (Just "done") (textCell MsgDone) $ \(DBRow{ dbrOutput=(E.Value tid, E.Value csh, E.Value shn, _, E.Value mbsid) }) -> case mbsid of Nothing -> mempty diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 1ddbd051c..d85e9694a 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -160,8 +160,8 @@ getSheetListR tid csh = do let tid = courseTerm course let colBase = mconcat [ headed "Blatt" $ \(sid,sheet,_) -> simpleLink (toWgt $ sheetName sheet) $ CSheetR tid csh (sheetName sheet) SShowR - , headed "Abgabe ab" $ toWgt . formatTimeGerWD . sheetActiveFrom . snd3 - , headed "Abgabe bis" $ toWgt . formatTimeGerWD . sheetActiveTo . snd3 + , headed "Abgabe ab" $ \(_,Sheet{..},_) -> formatTime SelFormatDateTime sheetActiveFrom >>= toWidget + , headed "Abgabe bis" $ \(_,Sheet{..},_) -> formatTime SelFormatDateTime sheetActiveTo >>= toWidget , headed "Bewertung" $ toWgt . display . sheetType . snd3 ] let colAdmin = mconcat -- only show edit button for allowed course assistants @@ -222,7 +222,7 @@ getSShowR tid csh shn = do SheetExercise -> textCell $ display $ sheetActiveFrom sheet SheetHint -> textCell $ display $ sheetHintFrom sheet SheetSolution -> textCell $ display $ sheetSolutionFrom sheet - , sortable (Just "time") "Modifikation" $ \(_,E.Value modified,_) -> stringCell $ formatTimeGerWDT (modified :: UTCTime) + , sortable (Just "time") "Modifikation" $ \(_,E.Value modified,_) -> cell $ formatTime SelFormatDateTime (modified :: UTCTime) >>= toWidget ] fileTable <- dbTable def $ DBTable { dbtSQLQuery = fileData @@ -244,8 +244,9 @@ getSShowR tid csh shn = do } defaultLayout $ do setTitle $ toHtml $ T.append "Übung " $ sheetName sheet + sheetFrom <- formatTime SelFormatDateTime $ sheetActiveFrom sheet + sheetTo <- formatTime SelFormatDateTime $ sheetActiveTo sheet $(widgetFile "sheetShow") - [whamlet| Under Construction !!! |] -- TODO getSFileR :: TermId -> Text -> Text -> SheetFileType -> FilePath -> Handler TypedContent getSFileR tid csh shn typ title = do diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index 5ff6058a1..130bfaa73 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -160,7 +160,7 @@ submissionHelper tid csh shn (SubmissionMode mcid) = do E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime] E.limit numberOfSubmissionEditDates return $ (user E.^. UserDisplayName, submissionEdit E.^. SubmissionEditTime) - let lastEdits = map (bimap E.unValue E.unValue) lastEditValues + lastEdits <- forM lastEditValues $ \(E.Value name, E.Value time) -> (name, ) <$> formatTime SelFormatDateTime time return (sheet,buddies,lastEdits) let unpackZips = True -- undefined -- TODO ((res,formWidget), formEnctype) <- runFormPost $ makeSubmissionForm msmid unpackZips sheetGrouping $ map E.unValue buddies diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index 22782165f..28cb87731 100644 --- a/src/Handler/Term.hs +++ b/src/Handler/Term.hs @@ -46,19 +46,25 @@ getTermShowR = do anchorCell' (\(Entity tid _, _) -> TermCourseListR tid) (\(Entity tid _, _) -> [whamlet|#{display tid}|]) , sortable (Just "lecture-start") (i18nCell MsgLectureStart) $ \(Entity _ Term{..},_) -> - stringCell $ formatTimeGerWD termLectureStart + cell $ formatTime SelFormatDate termLectureStart >>= toWidget , sortable (Just "lecture-end") "Ende Vorlesungen" $ \(Entity _ Term{..},_) -> - stringCell $ formatTimeGerWD termLectureEnd + cell $ formatTime SelFormatDate termLectureEnd >>= toWidget , sortable Nothing "Aktiv" $ \(Entity _ Term{..},_) -> textCell $ (bool "" tickmark termActive :: Text) , sortable Nothing "Kurse" $ \(_, E.Value numCourses) -> cell [whamlet|_{MsgNumCourses numCourses}|] , sortable (Just "start") "Semesteranfang" $ \(Entity _ Term{..},_) -> - stringCell $ formatTimeGerWD termStart + cell $ formatTime SelFormatDate termStart >>= toWidget , sortable (Just "end") "Semesterende" $ \(Entity _ Term{..},_) -> - stringCell $ formatTimeGerWD termEnd + cell $ formatTime SelFormatDate termEnd >>= toWidget , sortable Nothing "Feiertage im Semester" $ \(Entity _ Term{..},_) -> - stringCell $ (intercalate ", ") $ map formatTimeGerWD termHolidays + cell $ do + termHolidays' <- mapM (formatTime SelFormatDate) termHolidays + [whamlet| +