diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index e747132b0..e9f008c79 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -67,13 +67,13 @@ TermSchoolCourseListTitle tid@TermId school@SchoolName: Kurse #{display tid} fü CourseNewHeading: Neuen Kurs anlegen CourseEditHeading tid@TermId ssh@SchoolId csh@CourseShorthand: Kurs #{display tid}-#{display ssh}-#{csh} editieren CourseEditTitle: Kurs editieren/anlegen -CourseMember: Teilnehmer +CourseMembers: Teilnehmer CourseMembersCount num@Int64: #{display num} CourseMembersCountLimited num@Int64 max@Int64: #{display num}/#{display max} CourseName: Name CourseDescription: Beschreibung CourseDescriptionTip: Beliebiges HTML-Markup ist gestattet -CourseHomepage: Homepage +CourseHomepageExternal: Externe Homepage CourseShorthand: Kürzel CourseShorthandUnique: Muss innerhalb Institut und Semester eindeutig sein CourseSemester: Semester @@ -235,6 +235,8 @@ LoginTitle: Authentifizierung ProfileHeading: Benutzereinstellungen ProfileFor: Benutzereinstellungen für ProfileDataHeading: Gespeicherte Benutzerdaten +InfoHeading: Informationen +VersionHeading: Versionsgeschichte ImpressumHeading: Impressum DataProtHeading: Datenschutzerklärung SystemMessageHeading: Uni2work Statusmeldung @@ -342,6 +344,7 @@ AccessRightsFor: Berechtigungen für AdminFor: Administrator LecturerFor: Dozent LecturersFor: Dozenten +ForSchools n@Int: für #{pluralDE n "Institut" "Institute"} UserListTitle: Komprehensive Benutzerliste AccessRightsSaved: Berechtigungsänderungen wurden gespeichert. @@ -352,6 +355,9 @@ TimeFormat: Uhrzeitformat DownloadFiles: Dateien automatisch herunterladen DownloadFilesTip: Wenn gesetzt werden Dateien von Abgaben und Übungsblättern automatisch als Download behandelt, ansonsten ist das Verhalten browserabhängig (es können z.B. PDFs im Browser geöffnet werden). NotificationSettings: Erwünschte Benachrichtigungen +FormNotifications: Benachrichtigungen +FormBehaviour: Verhalten +FormCosmetics: Oberfläche ActiveAuthTags: Aktivierte Authorisierungsprädikate @@ -424,6 +430,12 @@ MailSheetInactiveIntro courseName@Text termDesc@Text sheetName@SheetName n@Int n MailSubjectCorrectionsAssigned csh@CourseShorthand sheetName@SheetName: Ihnen wurden Korrekturen zu #{sheetName} in #{csh} zugeteilt MailCorrectionsAssignedIntro courseName@Text termDesc@Text sheetName@SheetName n@Int: #{display n} #{pluralDE n "Abgabe wurde" "Abgaben wurden"} Ihnen zur Korrektur für #{sheetName} im Kurs #{courseName} (#{termDesc}) zugeteilt. +MailSubjectUserRightsUpdate name@Text: Berechtigungen für #{name} aktualisiert +MailUserRightsIntro name@Text email@UserEmail: #{name} <#{email}> hat folgende Uni2work Berechtigungen: +MailNoLecturerRights: Sie haben derzeit keine Dozenten-Rechte. +MailLecturerRights n@Int: Als Dozent dürfen Sie Veranstaltungen innerhalb #{pluralDE n "Ihres Instituts" "Ihrer Institute"} anlegen. + + MailEditNotifications: Benachrichtigungen ein-/ausschalten MailSubjectSupport: Supportanfrage @@ -472,6 +484,7 @@ NotificationTriggerSheetSoonInactive: Ich kann ein Übungsblatt bald nicht mehr NotificationTriggerSheetInactive: Abgabefrist eines meiner Übungsblätter ist abgelaufen NotificationTriggerCorrectionsAssigned: Mir wurden Abgaben zur Korrektur zugeteilt NotificationTriggerCorrectionsNotDistributed: Abgaben eines meiner Übungsblätter konnten keinem Korrektur zugeteilt werden +NotificationTriggerUserRightsUpdate: Meine Berechtigungen wurden geändert CorrCreate: Abgaben erstellen UnknownPseudonymWord pseudonymWord@Text: Unbekanntes Pseudonym-Wort "#{pseudonymWord}" @@ -569,6 +582,7 @@ ErrorCryptoIdMismatch: Verschlüsselte Id der Abgabe passte nicht zu anderen Dat InvalidRoute: Konnte URL nicht interpretieren MenuHome: Aktuell +MenuInformation: Informationen MenuImpressum: Impressum MenuDataProt: Datenschutz MenuVersion: Versionsgeschichte @@ -577,6 +591,7 @@ MenuProfile: Anpassen MenuLogin: Login MenuLogout: Logout MenuCourseList: Kurse +MenuCourseMembers: Kursteilnehmer MenuTermShow: Semester MenuSubmissionDelete: Abgabe löschen MenuUsers: Benutzer diff --git a/models/schools b/models/schools index 625235f2f..6b73e1c27 100644 --- a/models/schools +++ b/models/schools @@ -1,7 +1,7 @@ School json name (CI Text) - shorthand (CI Text) + shorthand (CI Text) -- SchoolKey :: SchoolShorthand -> SchoolId UniqueSchool name UniqueSchoolShorthand shorthand -- required for Normalisation of CI Text - Primary shorthand -- newtype Key School = SchoolKey { unSchoolKey :: SchoolShorthand } + Primary shorthand -- newtype Key School = SchoolKey { unSchoolKey :: SchoolShorthand } deriving Eq Show Generic diff --git a/routes b/routes index be9016096..1a9f35659 100644 --- a/routes +++ b/routes @@ -41,16 +41,13 @@ /admin/test AdminTestR GET POST /admin/errMsg AdminErrMsgR GET POST - /info InfoR GET !free -/impressum ImpressumR GET !free +/info/lecturer InfoLecturerR GET !lecturer /info/data DataProtR GET !free +/impressum ImpressumR GET !free /version VersionR GET !free - /help HelpR GET POST !free -/help/lecturer InfoLecturerR GET !lecturer - /user ProfileR GET POST !free /user/profile ProfileDataR GET POST !free diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs index 443af5517..41464cc00 100644 --- a/src/Database/Esqueleto/Utils.hs +++ b/src/Database/Esqueleto/Utils.hs @@ -1,14 +1,16 @@ module Database.Esqueleto.Utils where --- | Convenience for using Esqueleto, --- intended to be imported qualified --- just like Esqueleto - import ClassyPrelude.Yesod hiding (isInfixOf, (||.)) import Data.Foldable as F import Database.Esqueleto as E +-- +-- Description : Convenience for using @Esqueleto@, +-- intended to be imported qualified +-- just like Esqueleto + + -- ezero = E.val (0 :: Int64) -- | Often needed with this concrete type diff --git a/src/Foundation.hs b/src/Foundation.hs index c77890f1b..f35c841e7 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -78,6 +78,8 @@ import qualified Crypto.Saltine.Core.SecretBox as SecretBox import qualified Database.Memcached.Binary.IO as Memcached import Data.Bits (Bits(zeroBits)) +import Network.Wai.Parse (lbsBackEnd) + instance DisplayAble b => DisplayAble (E.CryptoID a b) where display = display . ciphertext @@ -891,6 +893,8 @@ instance Yesod UniWorX where . runIdentity $ sourceList (Lazy.ByteString.toChunks content) $$ sinkHash + fileUpload _site _length = FileUploadMemory lbsBackEnd + -- What messages should be logged. The following includes all messages when -- in development, and warnings and errors in production. shouldLog _ _ _ = error "Must use shouldLogIO" @@ -1016,6 +1020,7 @@ siteLayout' headingOverride widget = do addScript $ StaticR js_utils_alerts_js addScript $ StaticR js_utils_asidenav_js addScript $ StaticR js_utils_asyncTable_js + addScript $ StaticR js_utils_checkAll_js addScript $ StaticR js_utils_form_js addScript $ StaticR js_utils_inputs_js addScript $ StaticR js_utils_modal_js @@ -1069,12 +1074,14 @@ instance YesodBreadcrumbs UniWorX where breadcrumb (AdminUserR _) = return ("Users" , Just UsersR) breadcrumb InfoR = return ("Information" , Nothing) - breadcrumb ImpressumR = return ("Impressum" , Just InfoR) + breadcrumb InfoLecturerR = return ("Veranstalter" , Just InfoR) breadcrumb DataProtR = return ("Datenschutz" , Just InfoR) - breadcrumb VersionR = return ("Impressum" , Just InfoR) + breadcrumb ImpressumR = return ("Impressum" , Just InfoR) + breadcrumb VersionR = return ("Versionsgeschichte", Just InfoR) + breadcrumb HelpR = return ("Hilfe" , Just HomeR) - breadcrumb InfoLecturerR = return ("Veranstalter" , Just HelpR) + breadcrumb ProfileR = return ("User" , Just HomeR) breadcrumb ProfileDataR = return ("Profile" , Just ProfileR) @@ -1161,6 +1168,14 @@ defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the , menuItemModal = False , menuItemAccessCallback' = return True } + , return MenuItem + { menuItemType = Footer + , menuItemLabel = MsgMenuInformation + , menuItemIcon = Just "info" + , menuItemRoute = SomeRoute InfoR + , menuItemModal = False + , menuItemAccessCallback' = return True + } , do mCurrentRoute <- getCurrentRoute @@ -1273,6 +1288,16 @@ pageActions (HomeR) = , menuItemAccessCallback' = return True } ] +pageActions (InfoR) = [ + MenuItem + { menuItemType = PageActionPrime + , menuItemLabel = MsgInfoLecturerTitle + , menuItemIcon = Nothing + , menuItemRoute = SomeRoute InfoLecturerR + , menuItemModal = False + , menuItemAccessCallback' = return True + } + ] pageActions (VersionR) = [ MenuItem { menuItemType = PageActionPrime @@ -1284,14 +1309,14 @@ pageActions (VersionR) = [ } ] pageActions (HelpR) = [ - MenuItem - { menuItemType = PageActionPrime - , menuItemLabel = MsgInfoLecturerTitle - , menuItemIcon = Nothing - , menuItemRoute = SomeRoute InfoLecturerR - , menuItemModal = False - , menuItemAccessCallback' = return True - } + -- MenuItem + -- { menuItemType = PageActionPrime + -- , menuItemLabel = MsgInfoLecturerTitle + -- , menuItemIcon = Nothing + -- , menuItemRoute = SomeRoute InfoLecturerR + -- , menuItemModal = False + -- , menuItemAccessCallback' = return True + -- } ] pageActions (ProfileR) = [ MenuItem @@ -1349,6 +1374,16 @@ pageActions (CourseListR) = , menuItemAccessCallback' = return True } ] +pageActions (CourseNewR) = [ + MenuItem + { menuItemType = PageActionPrime + , menuItemLabel = MsgInfoLecturerTitle + , menuItemIcon = Nothing + , menuItemRoute = SomeRoute InfoLecturerR + , menuItemModal = False + , menuItemAccessCallback' = return True + } + ] pageActions (CourseR tid ssh csh CShowR) = [ MenuItem { menuItemType = PageActionPrime @@ -1370,6 +1405,14 @@ pageActions (CourseR tid ssh csh CShowR) = } ] ++ pageActions (CourseR tid ssh csh SheetListR) ++ [ MenuItem + { menuItemType = PageActionSecondary + , menuItemLabel = MsgMenuCourseMembers + , menuItemIcon = Just "user-graduate" + , menuItemRoute = SomeRoute $ CourseR tid ssh csh CUsersR + , menuItemModal = False + , menuItemAccessCallback' = return True + } + , MenuItem { menuItemType = PageActionSecondary , menuItemLabel = MsgMenuCourseEdit , menuItemIcon = Nothing @@ -1683,14 +1726,22 @@ pageHeading HomeR = Just $ i18nHeading MsgHomeHeading pageHeading UsersR = Just $ i18nHeading MsgUsers -pageHeading (AdminTestR) - = Just $ [whamlet|Internal Code Demonstration Page|] pageHeading (AdminUserR _) = Just $ i18nHeading MsgAdminUserHeading +pageHeading (AdminTestR) + = Just $ [whamlet|Internal Code Demonstration Page|] pageHeading (AdminErrMsgR) = Just $ i18nHeading MsgErrMsgHeading -pageHeading (VersionR) + +pageHeading (InfoR) + = Just $ i18nHeading MsgInfoHeading +pageHeading (DataProtR) + = Just $ i18nHeading MsgDataProtHeading +pageHeading (ImpressumR) = Just $ i18nHeading MsgImpressumHeading +pageHeading (VersionR) + = Just $ i18nHeading MsgVersionHeading + pageHeading (HelpR) = Just $ i18nHeading MsgHelpRequest diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 3a53de344..501cc97b9 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -54,6 +54,24 @@ emailTestForm = (,) SelFormatDate -> d SelFormatTime -> t +makeDemoForm :: Int -> Form (Int,Bool,Double) +makeDemoForm n = identifyForm "adminTestForm" $ \html -> do -- Important: used identForm instead! + (result, widget) <- flip (renderAForm FormStandard) html $ (,,) + <$> areq (minIntField n "Zahl") (fromString $ "Ganzzahl > " ++ show n) Nothing + <* aformSection MsgFormBehaviour + <*> areq checkBoxField "Muss nächste Zahl größer sein?" (Just True) + <*> areq doubleField "Fliesskommazahl" Nothing + <* submitButton + return $ case result of + FormSuccess fsres + | errorMsgs <- validateResult fsres + , not $ null errorMsgs -> (FormFailure errorMsgs, widget) + _otherwise -> (result, widget) + where + validateResult :: (Int,Bool,Double) -> [Text] + validateResult (i,True,d) | fromIntegral i >= d = [tshow d <> " ist nicht größer als " <> tshow i, "Zweite Fehlermeldung", "Dritte Fehlermeldung"] + validateResult _other = [] + getAdminTestR, postAdminTestR :: Handler Html -- Demo Page. Referenzimplementierungen sollte hier gezeigt werden! getAdminTestR = postAdminTestR @@ -81,10 +99,43 @@ postAdminTestR = do ^{emailWidget} |] - defaultLayout $ - -- setTitle "Uni2work Admin Testpage" + + let demoFormAction (_i,_b,_d) = addMessage Info "All ok." + ((demoResult, formWidget),formEnctype) <- runFormPost $ makeDemoForm 7 + formResult demoResult demoFormAction + let actionUrl = AdminTestR + let showDemoResult = [whamlet| + $maybe (i,b,d) <- formResult' demoResult + Received values: +