diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 68b033660..ee248c382 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -67,7 +67,7 @@ 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 -CourseMembers: Teilnehmer +CourseMember: Teilnehmer CourseMembersCount num@Int64: #{display num} CourseMembersCountLimited num@Int64 max@Int64: #{display num}/#{display max} CourseName: Name @@ -88,6 +88,7 @@ CourseFilterSearch: Volltext-Suche CourseFilterRegistered: Registriert CourseDeleteQuestion: Wollen Sie den unten aufgeführten Kurs wirklich löschen? CourseDeleted: Kurs gelöscht +CourseUserNote: Notiz NoSuchTerm tid@TermId: Semester #{display tid} gibt es nicht. NoSuchSchool ssh@SchoolId: Institut #{display ssh} gibt es nicht. @@ -235,6 +236,7 @@ ProfileHeading: Benutzereinstellungen ProfileFor: Benutzereinstellungen für ProfileDataHeading: Gespeicherte Benutzerdaten ImpressumHeading: Impressum +DataProtHeading: Datenschutzerklärung SystemMessageHeading: Uni2work Statusmeldung SystemMessageListHeading: Uni2work Statusmeldungen @@ -340,6 +342,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. @@ -420,11 +423,17 @@ MailSubmissionsUnassignedIntro n@Int courseName@Text termDesc@Text sheetName@She MailSubjectSheetSoonInactive csh@CourseShorthand sheetName@SheetName: #{sheetName} in #{csh} kann nur noch kurze Zeit abgegeben werden MailSheetSoonInactiveIntro courseName@Text termDesc@Text sheetName@SheetName: Abgabefirst für #{sheetName} im Kurs #{courseName} (#{termDesc}) endet in Kürze. MailSubjectSheetInactive csh@CourseShorthand sheetName@SheetName: Abgabfrist für #{sheetName} in #{csh} abgelaufen -MailSheetInactiveIntro courseName@Text termDesc@Text sheetName@SheetName: Die Abgabefirst für #{sheetName} im Kurs #{courseName} (#{termDesc}) beendet. +MailSheetInactiveIntro courseName@Text termDesc@Text sheetName@SheetName n@Int num@Int64: Die Abgabefirst für #{sheetName} im Kurs #{courseName} (#{termDesc}) beendet. Es gab #{noneOneMoreDE n "Keine Abgaben" "Nur eine Abgabe von " (display n <> " Abgaben von ")}#{noneOneMoreDE num "" "einem Teilnehmer" (display num <> " Teilnehmern")}. 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 @@ -473,6 +482,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}" @@ -571,6 +581,7 @@ InvalidRoute: Konnte URL nicht interpretieren MenuHome: Aktuell MenuImpressum: Impressum +MenuDataProt: Datenschutz MenuVersion: Versionsgeschichte MenuHelp: Hilfe MenuProfile: Anpassen 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 aca3c5735..be9016096 100644 --- a/routes +++ b/routes @@ -10,22 +10,23 @@ -- Admins always have access to entities within their assigned schools. -- -- Access Tags: --- !free -- free for all --- !lecturer -- lecturer for this course (or for any school, if route is not connected to a course) --- !corrector -- corrector for this sheet (or the submission, if route is connected to a submission, or the course, if route is not connected to a sheet, or any course, if route is not connected to a course) --- !registered -- participant for this course (no effect outside of courses) --- !participant -- connected with a given course (not necessarily registered), i.e. has a submission, is a corrector, etc. (no effect outside of courses) --- !owner -- part of the group of owners of this submission --- !capacity -- course this route is associated with has at least one unit of participant capacity --- !empty -- course this route is associated with has no participants whatsoever +-- !free -- free for all +-- !lecturer -- lecturer for this course (or for any school, if route is not connected to a course) +-- !corrector -- corrector for this sheet (or the submission, if route is connected to a submission, or the course, if route is not connected to a sheet, or any course, if route is not connected to a course) +-- !registered -- participant for this course (no effect outside of courses) +-- !participant -- connected with a given course (not necessarily registered), i.e. has a submission, is a corrector, etc. (no effect outside of courses) +-- !owner -- part of the group of owners of this submission +-- !capacity -- course this route is associated with has at least one unit of participant capacity +-- !empty -- course this route is associated with has no participants whatsoever -- --- !materials -- only if course allows all materials to be free (no meaning outside of courses) --- !time -- access depends on time somehow --- !read -- only if it is read-only access (i.e. GET but not POST) --- !write -- only if it is write access (i.e. POST only, included for completeness) +-- !materials -- only if course allows all materials to be free (no meaning outside of courses) +-- !time -- access depends on time somehow +-- !read -- only if it is read-only access (i.e. GET but not POST) +-- !write -- only if it is write access (i.e. POST only, included for completeness) -- --- !deprecated -- like free, but logs and gives a warning; entirely disabled in production --- !development -- like free, but only for development builds +-- !no-escalation -- +-- !deprecated -- like free, but logs and gives a warning; entirely disabled in production +-- !development -- like free, but only for development builds /static StaticR EmbeddedStatic appStatic !free /auth AuthR Auth getAuth !free @@ -39,9 +40,13 @@ /users/#CryptoUUIDUser/hijack AdminHijackUserR POST !adminANDno-escalation /admin/test AdminTestR GET POST /admin/errMsg AdminErrMsgR GET POST -/impressum ImpressumR GET !free -/version VersionR GET !free + + /info InfoR GET !free +/impressum ImpressumR GET !free +/info/data DataProtR GET !free +/version VersionR GET !free + /help HelpR GET POST !free /help/lecturer InfoLecturerR GET !lecturer diff --git a/src/Auth/Dummy.hs b/src/Auth/Dummy.hs index e7033f3d8..cdb8db1e8 100644 --- a/src/Auth/Dummy.hs +++ b/src/Auth/Dummy.hs @@ -7,7 +7,7 @@ import Import.NoFoundation import Database.Persist.Sql (SqlBackendCanRead) import Utils.Form - + import Data.CaseInsensitive (CI) import qualified Data.CaseInsensitive as CI @@ -54,4 +54,4 @@ dummyLogin = AuthPlugin{..} apDispatch _ _ = notFound apLogin toMaster = do (login, loginEnctype) <- handlerToWidget . generateFormPost $ renderAForm FormStandard dummyForm - $(widgetFile "widgets/dummy-login-form") + $(widgetFile "widgets/dummy-login-form/dummy-login-form") diff --git a/src/Auth/LDAP.hs b/src/Auth/LDAP.hs index cd2a9a037..861c03620 100644 --- a/src/Auth/LDAP.hs +++ b/src/Auth/LDAP.hs @@ -36,7 +36,7 @@ data CampusMessage = MsgCampusIdentNote | MsgCampusSubmit | MsgCampusInvalidCredentials deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable) - + findUser :: LdapConf -> Ldap -> Text -> [Ldap.Attr] -> IO [Ldap.SearchEntry] findUser LdapConf{..} ldap campusIdent = Ldap.search ldap ldapBase userSearchSettings userFilter @@ -48,7 +48,7 @@ findUser LdapConf{..} ldap campusIdent = Ldap.search ldap ldapBase userSearchSet , Ldap.time ldapSearchTimeout , Ldap.derefAliases Ldap.DerefAlways ] - + userPrincipalName :: Ldap.Attr userPrincipalName = Ldap.Attr "userPrincipalName" @@ -105,7 +105,7 @@ campusLogin conf@LdapConf{..} pool = AuthPlugin{..} apDispatch _ _ = notFound apLogin toMaster = do (login, loginEnctype) <- handlerToWidget . generateFormPost $ renderAForm FormStandard campusForm - $(widgetFile "widgets/campus-login-form") + $(widgetFile "widgets/campus-login/campus-login-form") data CampusUserException = CampusUserLdapError LdapPoolError | CampusUserHostNotResolved String diff --git a/src/Auth/PWHash.hs b/src/Auth/PWHash.hs index 68df34703..74c4e67a3 100644 --- a/src/Auth/PWHash.hs +++ b/src/Auth/PWHash.hs @@ -35,7 +35,7 @@ hashForm = HashLogin <*> areq passwordField (fslpI MsgPWHashPassword "Passwort") Nothing <* submitButton - + hashLogin :: ( YesodAuth site , YesodPersist site , SqlBackendCanRead (YesodPersistBackend site) @@ -90,5 +90,5 @@ hashLogin pwHashAlgo = AuthPlugin{..} apDispatch _ _ = notFound apLogin toMaster = do (login, loginEnctype) <- handlerToWidget . generateFormPost $ renderAForm FormStandard hashForm - $(widgetFile "widgets/hash-login-form") + $(widgetFile "widgets/hash-login-form/hash-login-form") diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs new file mode 100644 index 000000000..9e78f9fd0 --- /dev/null +++ b/src/Database/Esqueleto/Utils.hs @@ -0,0 +1,45 @@ +module Database.Esqueleto.Utils where + +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 +true :: E.SqlExpr (E.Value Bool) +true = E.val True + +-- | Often needed with this concrete type +false :: E.SqlExpr (E.Value Bool) +false = E.val False + +-- | Check if the first string is contained in the text derived from the second argument +isInfixOf :: (E.Esqueleto query expr backend, E.SqlString s2) => + Text -> expr (E.Value s2) -> expr (E.Value Bool) +isInfixOf needle strExpr = E.castString strExpr `E.ilike` (E.%) E.++. E.val needle E.++. (E.%) + +hasInfix :: (E.Esqueleto query expr backend, E.SqlString s2) => + expr (E.Value s2) -> Text -> expr (E.Value Bool) +hasInfix = flip isInfixOf + +-- | Given a test and a set of values, check whether anyone succeeds the test +-- WARNING: SQL leaves it explicitely unspecified whether || is short curcuited (i.e. lazily evaluated) +any :: Foldable f => + (a -> SqlExpr (E.Value Bool)) -> f a -> SqlExpr (E.Value Bool) +any test = F.foldr (\needle acc -> acc ||. test needle) false + +-- | Given a test and a set of values, check whether all succeeds the test +-- WARNING: SQL leaves it explicitely unspecified whether && is short curcuited (i.e. lazily evaluated) +all :: Foldable f => + (a -> SqlExpr (E.Value Bool)) -> f a -> SqlExpr (E.Value Bool) +all test = F.foldr (\needle acc -> acc &&. test needle) true + + diff --git a/src/Foundation.hs b/src/Foundation.hs index 05f50b22c..a5a8e1f56 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -157,6 +157,19 @@ pluralDE num singularForm pluralForm | num == 1 = singularForm | otherwise = pluralForm +noneOneMoreDE :: (Eq a, Num a) + => a -- ^ Count + -> Text -- ^ None + -> Text -- ^ Singular + -> Text -- ^ Plural + -> Text +noneOneMoreDE num noneText singularForm pluralForm + | num == 0 = noneText + | num == 1 = singularForm + | otherwise = pluralForm + + + -- Messages creates type UniWorXMessage and RenderMessage UniWorX instance mkMessage "UniWorX" "messages/uniworx" "de" mkMessageVariant "UniWorX" "Campus" "messages/campus" "de" @@ -969,19 +982,19 @@ siteLayout' headingOverride widget = do -- you to use normal widget features in default-layout. navbar :: Widget - navbar = $(widgetFile "widgets/navbar") + navbar = $(widgetFile "widgets/navbar/navbar") asidenav :: Widget - asidenav = $(widgetFile "widgets/asidenav") + asidenav = $(widgetFile "widgets/asidenav/asidenav") footer :: Widget - footer = $(widgetFile "widgets/footer") + footer = $(widgetFile "widgets/footer/footer") alerts :: Widget alerts = $(widgetFile "widgets/alerts/alerts") contentHeadline :: Maybe Widget contentHeadline = headingOverride <|> (pageHeading =<< mcurrentRoute) breadcrumbsWgt :: Widget - breadcrumbsWgt = $(widgetFile "widgets/breadcrumbs") + breadcrumbsWgt = $(widgetFile "widgets/breadcrumbs/breadcrumbs") pageaction :: Widget - pageaction = $(widgetFile "widgets/pageaction") + pageaction = $(widgetFile "widgets/pageaction/pageaction") -- functions to determine if there are page-actions (primary or secondary) hasPageActions, hasSecondaryPageActions, hasPrimaryPageActions :: Bool hasPageActions = hasPrimaryPageActions || hasSecondaryPageActions @@ -989,25 +1002,35 @@ siteLayout' headingOverride widget = do hasPrimaryPageActions = any (is _PageActionPrime) $ toListOf (traverse . _1 . _menuItemType) menuTypes pc <- widgetToPageContent $ do - addScript $ StaticR js_vendor_zepto_js + -- 3rd party addScript $ StaticR js_vendor_flatpickr_js - addScript $ StaticR js_polyfills_fetchPolyfill_js - addScript $ StaticR js_polyfills_urlPolyfill_js - addScript $ StaticR js_utils_featureChecker_js - addScript $ StaticR js_utils_tabber_js - addScript $ StaticR js_utils_alerts_js + addScript $ StaticR js_vendor_zepto_js addStylesheet $ StaticR css_vendor_flatpickr_css addStylesheet $ StaticR css_vendor_fontawesome_css + -- fonts addStylesheet $ StaticR css_fonts_css - addStylesheet $ StaticR css_utils_tabber_css + -- polyfills + addScript $ StaticR js_polyfills_fetchPolyfill_js + addScript $ StaticR js_polyfills_urlPolyfill_js + -- JavaScript utils + addScript $ StaticR js_utils_alerts_js + addScript $ StaticR js_utils_asidenav_js + addScript $ StaticR js_utils_asyncTable_js + addScript $ StaticR js_utils_form_js + addScript $ StaticR js_utils_inputs_js + addScript $ StaticR js_utils_setup_js + addScript $ StaticR js_utils_showHide_js + addScript $ StaticR js_utils_tabber_js addStylesheet $ StaticR css_utils_alerts_scss + addStylesheet $ StaticR css_utils_asidenav_scss + addStylesheet $ StaticR css_utils_form_scss + addStylesheet $ StaticR css_utils_inputs_scss + addStylesheet $ StaticR css_utils_showHide_scss + addStylesheet $ StaticR css_utils_tabber_scss + addStylesheet $ StaticR css_utils_tooltip_scss + -- widgets $(widgetFile "default-layout") $(widgetFile "standalone/modal") - $(widgetFile "standalone/showHide") - $(widgetFile "standalone/inputs") - $(widgetFile "standalone/tooltip") - $(widgetFile "standalone/tabber") - $(widgetFile "standalone/datepicker") withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet") @@ -1038,13 +1061,18 @@ applySystemMessages = liftHandlerT . runDB . runConduit $ selectSource [] [] .| -- Define breadcrumbs. instance YesodBreadcrumbs UniWorX where - breadcrumb (AuthR _) = return ("Login" , Just HomeR) - breadcrumb HomeR = return ("Uni2work" , Nothing) - breadcrumb UsersR = return ("Benutzer" , Just HomeR) - breadcrumb AdminTestR = return ("Test" , Just HomeR) - breadcrumb (AdminUserR _) = return ("Users" , Just UsersR) - breadcrumb VersionR = return ("Impressum" , Just HomeR) - breadcrumb HelpR = return ("Hilfe" , Just HomeR) + breadcrumb (AuthR _) = return ("Login" , Just HomeR) + breadcrumb HomeR = return ("Uni2work" , Nothing) + breadcrumb UsersR = return ("Benutzer" , Just HomeR) + breadcrumb AdminTestR = return ("Test" , Just HomeR) + breadcrumb (AdminUserR _) = return ("Users" , Just UsersR) + + breadcrumb InfoR = return ("Information" , Nothing) + breadcrumb ImpressumR = return ("Impressum" , Just InfoR) + breadcrumb DataProtR = return ("Datenschutz" , Just InfoR) + breadcrumb VersionR = return ("Impressum" , Just InfoR) + + breadcrumb HelpR = return ("Hilfe" , Just HomeR) breadcrumb InfoLecturerR = return ("Veranstalter" , Just HelpR) breadcrumb ProfileR = return ("User" , Just HomeR) @@ -1116,10 +1144,18 @@ defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the , menuItemModal = False , menuItemAccessCallback' = return True } + , return MenuItem + { menuItemType = Footer + , menuItemLabel = MsgMenuDataProt + , menuItemIcon = Just "shield" + , menuItemRoute = SomeRoute DataProtR + , menuItemModal = False + , menuItemAccessCallback' = return True + } , return MenuItem { menuItemType = Footer , menuItemLabel = MsgMenuImpressum - , menuItemIcon = Just "book" + , menuItemIcon = Just "file-signature" , menuItemRoute = SomeRoute ImpressumR , menuItemModal = False , menuItemAccessCallback' = return True @@ -1161,17 +1197,17 @@ defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the } , return MenuItem { menuItemType = NavbarAside - , menuItemLabel = MsgMenuCourseList - , menuItemIcon = Just "graduation-cap" - , menuItemRoute = SomeRoute CourseListR + , menuItemLabel = MsgMenuTermShow + , menuItemIcon = Just "calendar-alt" -- SJ wrote: calendar icon, since Term will be repleaced with TimeTable in the future; arguably Term is more calendar-like than courses anyway!!! + , menuItemRoute = SomeRoute TermShowR , menuItemModal = False , menuItemAccessCallback' = return True } , return MenuItem { menuItemType = NavbarAside - , menuItemLabel = MsgMenuTermShow - , menuItemIcon = Just "calendar-alt" -- SJ wrote: calendar icon, since Term will be repleaced with TimeTable in the future; arguably Term is more calendar-like than courses anyway!!! - , menuItemRoute = SomeRoute TermShowR + , menuItemLabel = MsgMenuCourseList + , menuItemIcon = Just "graduation-cap" + , menuItemRoute = SomeRoute CourseListR , menuItemModal = False , menuItemAccessCallback' = return True } diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 1fece3778..29f31b107 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -162,7 +162,7 @@ colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(E cid <- encrypt subId return $ CSubmissionR tid ssh csh sheetName cid CorrectionR in mconcat - [ anchorCellM mkRoute $(widgetFile "widgets/rating") + [ anchorCellM mkRoute $(widgetFile "widgets/rating/rating") , writerCell $ do let summary :: SheetTypeSummary diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 3401cf4de..e7cf7276b 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + module Handler.Course where import Import @@ -89,8 +91,8 @@ colRegTo = sortable (Just "register-to") (i18nCell MsgRegisterTo) $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _) } -> maybe mempty timeCell courseRegisterTo -colParticipants :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) -colParticipants = sortable (Just "participants") (i18nCell MsgCourseMembers) +colMembers :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a) +colMembers = sortable (Just "members") (i18nCell MsgCourseMember) $ \DBRow{ dbrOutput=(Entity _ Course{..}, currentParticipants, _, _) } -> i18nCell $ case courseCapacity of Nothing -> MsgCourseMembersCount currentParticipants Just limit -> MsgCourseMembersCountLimited currentParticipants limit @@ -137,7 +139,7 @@ makeCourseTable whereClause colChoices psValidator = do , ( "schoolshort", SortColumn $ \(_course `E.InnerJoin` school) -> school E.^. SchoolShorthand) , ( "register-from", SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseRegisterFrom) , ( "register-to", SortColumn $ \(course `E.InnerJoin` _school) -> course E.^. CourseRegisterTo) - , ( "participants", SortColumn course2Participants ) + , ( "members", SortColumn course2Participants ) , ( "registered", SortColumn $ course2Registered muid) ] , dbtFilter = Map.fromList -- OverloadedLists does not work with the templates here @@ -221,7 +223,7 @@ getTermSchoolCourseListR tid ssh = do , colCShortDescr , colRegFrom , colRegTo - , colParticipants + , colMembers , maybe mempty (const colRegistered) muid ] whereClause (course, _, _) = @@ -245,7 +247,7 @@ getTermCourseListR tid = do , colSchoolShort , colRegFrom , colRegTo - , colParticipants + , colMembers , maybe mempty (const colRegistered) muid ] whereClause (course, _, _) = course E.^. CourseTerm E.==. E.val tid @@ -295,7 +297,7 @@ registerForm registered msecret extra = do (Just _) | not registered -> bimap Just Just <$> mreq textField (fslpI MsgCourseSecret "Code") Nothing _ -> return (Nothing,Nothing) (btnRes, btnView) <- mreq (buttonField $ bool BtnRegister BtnDeregister registered) "buttonField ignores settings anyway" Nothing - let widget = $(widgetFile "widgets/registerForm") + let widget = $(widgetFile "widgets/register-form/register-form") let msecretRes | Just res <- msecretRes' = Just <$> res | otherwise = FormSuccess Nothing return (btnRes *> ((==msecret) <$> msecretRes), widget) -- checks that correct button was pressed, and ignores result of btnRes @@ -617,8 +619,81 @@ validateCourse CourseForm{..} = +-- CourseUserTable + +type UserTableExpr = (E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) `E.LeftOuterJoin` E.SqlExpr (Entity CourseUserNote) +type UserTableWhere = UserTableExpr -> E.SqlExpr (E.Value Bool) +type UserTableData = DBRow (Entity User, Entity CourseParticipant, Maybe (Key CourseUserNote)) + +userTableQuery :: UserTableWhere -> (UserTableExpr -> v) -> UserTableExpr -> E.SqlQuery v +userTableQuery whereClause returnStatement t@((user `E.InnerJoin` participant) `E.LeftOuterJoin` note) = do + E.on $ participant E.^. CourseParticipantUser E.==. note E.^. CourseUserNoteUser + E.on $ participant E.^. CourseParticipantUser E.==. user E.^. UserId + E.where_ $ whereClause t + return $ returnStatement t + +instance HasUser UserTableData where + hasUser = _entityVal + +instance HasEntity UserTableData User where + hasEntity = _dbrOutput . _1 + +-- -- there can be only one -- FunctionalDependency violation +-- instance HasEntity UserTableData CourseParticipant where +-- hasEntity = _dbrOutput . _2 + +courseIs :: CourseId -> UserTableWhere +courseIs cid ((_user `E.InnerJoin` participant) `E.LeftOuterJoin` _note) = participant E.^. CourseParticipantCourse E.==. E.val cid + +-- TODO: delete commented function +-- colUserParticipant' :: IsDBTable m a => Colonnade _ UserTableData (DBCell m a) +-- colUserParticipant' = sortable (Just "participant") (i18nCell MsgCourseMember) +-- $ \DBRow { dbrOutput=(Entity _ user,_,_) } -> userCell (userDisplayName user) (userSurname user) + +colUserParticipant :: IsDBTable m a => Colonnade _ UserTableData (DBCell m a) +colUserParticipant = sortable (Just "participant") (i18nCell MsgCourseMember) cellHasUser + +colUserParticipantLink :: IsDBTable m a => TermId -> SchoolId -> CourseShorthand -> Colonnade _ UserTableData (DBCell m a) +colUserParticipantLink tid ssh csh = sortable (Just "participant") (i18nCell MsgCourseMember) (cellHasUserLink courseLink) + where + courseLink = CourseR tid ssh csh . CUserR + +colUserMatriclenr :: IsDBTable m a => Colonnade _ UserTableData (DBCell m a) +colUserMatriclenr = sortable (Just "matriclenumber") (i18nCell MsgMatrikelNr) cellHasMatrikelnummer + +colUserComment :: IsDBTable m a => TermId -> SchoolId -> CourseShorthand -> Colonnade _ UserTableData (DBCell m a) +colUserComment tid ssh csh = + sortable (Just "course-user-note") (i18nCell MsgCourseUserNote) + $ \DBRow{ dbrOutput=(Entity uid _, _, mbNoteKey) } -> + maybeEmpty mbNoteKey $ const $ + anchorCellM (courseLink <$> encrypt uid) (commentWidget True) + where + courseLink = CourseR tid ssh csh . CUserR + +makeUserTable :: UserTableWhere -> _ -> _ -> DB Widget +makeUserTable _whereClause _colChoices _psValidator = + -- do + -- dbTable psValidator DBTable + -- { userTableQUery whereClause + -- , + return [whamlet| Course user table not yet implemented |] + + getCUsersR :: TermId -> SchoolId -> CourseShorthand -> Handler Html -getCUsersR = error "CUsersR: Not implemented" +getCUsersR tid ssh csh = do + Entity _cid course <- runDB $ getBy404 $ TermSchoolCourseShort tid ssh csh + let heading = [whamlet|_{MsgCourseMember} #{courseName course} #{display tid}|] + -- whereClause = courseIs cid + -- colChoices = [colUserParticipant,colUserMatriclenr,colUserComment tid ssh csh] + -- psValidator = def + -- tableWidget <- runDB $ makeUserTable whereClause colChoices psValidator + siteLayout heading $ do + setTitle [shamlet| #{toPathPiece tid} - #{csh}|] + [whamlet| + User table not yet implemented + $# ^{tableWidget} + |] + getCUserR :: TermId -> SchoolId -> CourseShorthand -> CryptoUUIDUser -> Handler Html diff --git a/src/Handler/Home.hs b/src/Handler/Home.hs index 24fd36b6e..05708b6e3 100644 --- a/src/Handler/Home.hs +++ b/src/Handler/Home.hs @@ -183,16 +183,31 @@ homeUser uid = do $(widgetFile "homeUser") -- (widgetFile "dsgvDisclaimer") - +-- | Versionsgeschichte getVersionR :: Handler TypedContent getVersionR = getInfoR -- TODO -getImpressumR :: Handler TypedContent -getImpressumR = getInfoR -- TODO +-- | Impressum +getImpressumR :: Handler Html +getImpressumR = -- do + siteLayoutMsg' MsgMenuImpressum $ do + setTitleI MsgImpressumHeading + $(widgetFile "impressum") + +-- | Hinweise zu Datenschutz und Aufbewahrungspflichten +getDataProtR :: Handler Html +getDataProtR = -- do + siteLayoutMsg' MsgMenuDataProt $ do + setTitleI MsgDataProtHeading + $(widgetFile "data-protection-de") + + +-- | Allgemeine Informationen getInfoR :: Handler TypedContent getInfoR = selectRep $ do - provideRep . defaultLayout $ do + let infoHeading = [whamlet|Re-Implementierung von UniWorX|] + provideRep . siteLayout infoHeading $ do let features = $(widgetFile "featureList") gitInfo :: Text gitInfo = $gitDescribe <> " (" <> $gitCommitDate <> ")" diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index edd3c9e4f..567c20a9d 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -251,7 +251,7 @@ getProfileDataR = do -- Delete Button (btnWdgt, btnEnctype) <- generateFormPost (buttonForm :: Form ButtonDelete) defaultLayout $ do - let delWdgt = $(widgetFile "widgets/data-delete") + let delWdgt = $(widgetFile "widgets/data-delete/data-delete") $(widgetFile "profileData") $(widgetFile "dsgvDisclaimer") diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 615fa91e1..ebd365521 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -205,7 +205,7 @@ getSheetListR tid ssh csh = do mkRoute = do cid' <- mkCid return $ CSubmissionR tid ssh csh sheetName cid' CorrectionR - acell = anchorCellM mkRoute $(widgetFile "widgets/rating") + acell = anchorCellM mkRoute $(widgetFile "widgets/rating/rating") in cellTell acell $ stats submissionRatingPoints , sortable Nothing -- (Just "percent") diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index 4d5e6c125..3fa72341f 100644 --- a/src/Handler/Users.hs +++ b/src/Handler/Users.hs @@ -1,6 +1,8 @@ module Handler.Users where import Import + +import Jobs -- import Data.Text import Handler.Utils @@ -12,15 +14,21 @@ import qualified Data.Set as Set import qualified Data.Map as Map import qualified Database.Esqueleto as E +import qualified Database.Esqueleto.Utils as E hijackUserForm :: CryptoUUIDUser -> Form () hijackUserForm cID csrf = do (uidResult, uidView) <- mforced hiddenField "" (cID :: CryptoUUIDUser) (btnResult, btnView) <- mreq (buttonField BtnHijack) "" Nothing - return (() <$ uidResult <* btnResult, mconcat [toWidget csrf, fvInput uidView, fvInput btnView]) +-- In case of refactoring, use this: +-- instance HasEntity (DBRow (Entity User)) User where +-- hasEntity = _dbrOutput +-- instance HasUser (DBRow (Entity USer)) where +-- hasUser = _entityVal + getUsersR :: Handler Html getUsersR = do let @@ -71,28 +79,60 @@ getUsersR = do psValidator = def & defaultSorting [SortAscBy "name", SortAscBy "display-name"] - ((), userList) <- runDB $ dbTable psValidator DBTable - { dbtSQLQuery = return :: E.SqlExpr (Entity User) -> E.SqlQuery (E.SqlExpr (Entity User)) - , dbtRowKey = (E.^. UserId) - , dbtColonnade - , dbtProj = return - , dbtSorting = Map.fromList - [ ( "name" - , SortColumn $ \user -> user E.^. UserSurname - ) - , ( "display-name" - , SortColumn $ \user -> user E.^. UserDisplayName - ) - , ( "matriculation" - , SortColumn $ \user -> user E.^. UserMatrikelnummer - ) - ] - , dbtFilter = mempty - , dbtFilterUI = mempty - , dbtStyle = def - , dbtParams = def - , dbtIdent = "users" :: Text - } + ((), userList) <- runDB $ do + schoolOptions <- map (CI.original . schoolName . entityVal &&& CI.original . unSchoolKey . entityKey) + <$> selectList [] [Asc SchoolName] + + dbTable psValidator DBTable + { dbtSQLQuery = return :: E.SqlExpr (Entity User) -> E.SqlQuery (E.SqlExpr (Entity User)) + , dbtRowKey = (E.^. UserId) + , dbtColonnade + , dbtProj = return + , dbtSorting = Map.fromList + [ ( "name" + , SortColumn $ \user -> user E.^. UserSurname + ) + , ( "display-name" + , SortColumn $ \user -> user E.^. UserDisplayName + ) + , ( "matriculation" + , SortColumn $ \user -> user E.^. UserMatrikelnummer + ) + ] + , dbtFilter = Map.fromList -- OverloadedLists does not work with the templates + [ ( "user-search", FilterColumn $ \user criterion -> + if Set.null criterion then E.true else -- TODO: why is this condition not needed? + -- Set.foldr (\needle acc -> acc E.||. (user E.^. UserDisplayName) `E.hasInfix` needle) eFalse (criterion :: Set.Set Text) + E.any (user E.^. UserDisplayName `E.hasInfix`) criterion + ) + , ( "matriculation", FilterColumn $ \user (criterion :: Set.Set Text) -> if + | Set.null criterion -> E.true -- TODO: why can this be eFalse and work still? + | otherwise -> E.any (user E.^. UserMatrikelnummer `E.hasInfix`) criterion + ) + , ( "school", FilterColumn $ \user criterion -> if + | Set.null criterion -> E.val True :: E.SqlExpr (E.Value Bool) + | otherwise -> let schools = E.valList (Set.toList criterion) in + E.exists ( E.from $ \ulectr -> do + E.where_ $ ulectr E.^. UserLecturerUser E.==. user E.^. UserId + E.where_ $ ulectr E.^. UserLecturerSchool `E.in_` schools + ) E.||. + E.exists ( E.from $ \uadmin -> do + E.where_ $ uadmin E.^. UserAdminUser E.==. user E.^. UserId + E.where_ $ uadmin E.^. UserAdminSchool `E.in_` schools + ) + ) + ] + , dbtFilterUI = \mPrev -> mconcat + [ prismAForm (singletonFilter "user-search") mPrev $ aopt (searchField True) (fslI MsgName) + -- , prismAForm (singletonFilter "matriculation" ) mPrev $ aopt (searchField False) (fslI MsgMatrikelNr) + , prismAForm (singletonFilter "matriculation" ) mPrev $ aopt matriculationField (fslI MsgMatrikelNr) + + , prismAForm (singletonFilter "school" ) mPrev $ aopt (lift `hoistField` selectFieldList schoolOptions) (fslI MsgCourseSchool) + ] + , dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } + , dbtParams = def + , dbtIdent = "users" :: Text + } defaultLayout $ do setTitleI MsgUserListTitle @@ -116,7 +156,8 @@ postAdminUserR uuid = do adminId <- requireAuthId uid <- decrypt uuid let fromSchoolList = Set.fromList . map (userAdminSchool . entityVal) - (User{..}, fromSchoolList -> adminSchools, userRights) <- runDB $ (,,) + let unValueRights (school, E.Value isAdmin, E.Value isLecturer) = (school,isAdmin,isLecturer) + (User{..}, fromSchoolList -> adminSchools, fmap unValueRights -> userRights) <- runDB $ (,,) <$> get404 uid <*> selectList [UserAdminUser ==. adminId] [] <*> E.select ( E.from $ \school -> do @@ -132,7 +173,7 @@ postAdminUserR uuid = do -- above data is needed for both form generation and result evaluation let userRightsForm :: Form [(SchoolId, Bool, Bool)] userRightsForm csrf = do - boxRights <- forM userRights $ \(school@(Entity sid _), E.Value isAdmin, E.Value isLecturer) -> + boxRights <- forM userRights $ \(school@(Entity sid _), isAdmin, isLecturer) -> if Set.member sid adminSchools then do cbAdmin <- mreq checkBoxField "" (Just isAdmin) @@ -144,7 +185,7 @@ postAdminUserR uuid = do return (school, cbAdmin, cbLecturer) let result = forM boxRights $ \(Entity sid _, (resAdmin,_), (resLecturer, _)) -> (,,) <$> pure sid <*> resAdmin <*> resLecturer - return (result,$(widgetFile "widgets/user-rights-form")) + return (result,$(widgetFile "widgets/user-rights-form/user-rights-form")) let userRightsAction changes = do void . runDB $ forM changes $ \(sid, userAdmin, userLecturer) -> @@ -158,6 +199,7 @@ postAdminUserR uuid = do then void . insertUnique $ UserLecturer uid sid else deleteBy $ UniqueSchoolLecturer uid sid -- Note: deleteWhere would not work well here since we filter by adminSchools + queueJob' . JobQueueNotification $ NotificationUserRightsUpdate uid (over _1 (schoolShorthand . entityVal) <$> userRights) -- original rights to check for difference addMessageI Info MsgAccessRightsSaved ((result, formWidget),formEnctype) <- runFormPost userRightsForm formResult result userRightsAction diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs index 3ecc4b932..f899f2991 100644 --- a/src/Handler/Utils.hs +++ b/src/Handler/Utils.hs @@ -74,3 +74,8 @@ visibleWidget :: Bool -> Widget -- ^ @visibleWidget False@ is an icon that denotes that something™ is not visible visibleWidget True = mempty visibleWidget False = [whamlet||] + +commentWidget :: Bool -> Widget +-- ^ @commentWidget True@ is an icon that denotes that something™ has a comment +commentWidget True = [whamlet||] +commentWidget False = mempty diff --git a/src/Handler/Utils/Database.hs b/src/Handler/Utils/Database.hs new file mode 100644 index 000000000..386fe0983 --- /dev/null +++ b/src/Handler/Utils/Database.hs @@ -0,0 +1,31 @@ +module Handler.Utils.Database + ( getSchoolsOf + , makeSchoolDictionaryDB, makeSchoolDictionary + ) where + +import Import + +import Data.Map as Map +-- import Data.CaseInsensitive (CI) +-- import qualified Data.CaseInsensitive as CI + + +import qualified Database.Esqueleto as E + +makeSchoolDictionaryDB :: DB (Map.Map SchoolId SchoolName) +makeSchoolDictionaryDB = makeSchoolDictionary <$> selectList [] [Asc SchoolShorthand] + +makeSchoolDictionary :: [Entity School] -> Map.Map SchoolId SchoolName +makeSchoolDictionary schools = Map.fromDistinctAscList [ (ssh,schoolName) | Entity ssh School{schoolName} <- schools ] + +-- getSchoolsOf :: ( BaseBackend backend ~ SqlBackend +-- , PersistEntityBackend val ~ SqlBackend +-- , PersistUniqueRead backend, PersistQueryRead backend +-- , IsPersistBackend backend, PersistEntity val, MonadIO m) => +-- UserId -> EntityField val SchoolId -> EntityField val UserId -> ReaderT backend m [E.Value SchoolName] +getSchoolsOf :: (PersistEntity val, PersistEntityBackend val ~ SqlBackend) => UserId -> EntityField val SchoolId -> EntityField val UserId -> DB [SchoolName] +getSchoolsOf uid uschool uuser = fmap (Import.map E.unValue) $ E.select $ E.from $ \(urights `E.InnerJoin` school) -> do + E.on $ urights E.^. uschool E.==. school E.^. SchoolId + E.where_ $ urights E.^. uuser E.==. E.val uid + E.orderBy [E.asc $ school E.^.SchoolName] + return $ school E.^. SchoolName diff --git a/src/Handler/Utils/Delete.hs b/src/Handler/Utils/Delete.hs index c35d2a14f..400ef2d72 100644 --- a/src/Handler/Utils/Delete.hs +++ b/src/Handler/Utils/Delete.hs @@ -90,9 +90,9 @@ getDeleteR DeleteRoute{..} = do (deleteFormWdgt, deleteFormEnctype) <- generateFormPost $ confirmForm' drRecords confirmString Just targetRoute <- getCurrentRoute - + sendResponse =<< - defaultLayout $(widgetFile "widgets/delete-confirmation") + defaultLayout $(widgetFile "widgets/delete-confirmation/delete-confirmation") diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 995bcd12f..2a568432e 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -179,6 +179,9 @@ pointsFieldMax :: (Monad m, HandlerSite m ~ UniWorX) => Maybe Points -> Field m pointsFieldMax Nothing = pointsField pointsFieldMax (Just maxp) = checkBool (<= maxp) (MsgPointsTooHigh maxp) pointsField +matriculationField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Text +matriculationField = textField -- no restrictions, since not everyone has a matriculation and pupils need special tags here + termsActiveField :: Field Handler TermId termsActiveField = selectField $ optionsPersistKey [TermActive ==. True] [Desc TermStart] termName @@ -588,9 +591,9 @@ multiAction acts defAction = do widgets <- mapM mToWidget results let actionWidgets = Map.foldrWithKey accWidget [] widgets accWidget _act Nothing = id - accWidget act (Just w) = cons $(widgetFile "widgets/multiAction") + accWidget act (Just w) = cons $(widgetFile "widgets/multi-action/multi-action") actionResults = Map.map fst results - return ((actionResults Map.!) =<< actionRes, $(widgetFile "widgets/multiActionCollect")) + return ((actionResults Map.!) =<< actionRes, $(widgetFile "widgets/multi-action/multi-action-collect")) multiActionA :: (RenderMessage UniWorX action, PathPiece action, Ord action, Eq action) => FieldSettings UniWorX diff --git a/src/Handler/Utils/SheetType.hs b/src/Handler/Utils/SheetType.hs index 43b98a92f..9e69815c9 100644 --- a/src/Handler/Utils/SheetType.hs +++ b/src/Handler/Utils/SheetType.hs @@ -25,7 +25,7 @@ gradeSummaryWidget title sts = hasMarkedPasses = positiveSum $ numMarkedPasses sumSummaries hasPoints = positiveSum $ numSheetsPoints sumSummaries hasMarkedPoints = positiveSum $ numMarkedPoints sumSummaries - rowWdgts = [ $(widgetFile "widgets/gradingSummaryRow") + rowWdgts = [ $(widgetFile "widgets/grading-summary/grading-summary-row") | (sumHeader,summary) <- [ (MsgSheetTypeNormal' ,normalSummary) , (MsgSheetTypeBonus' ,bonusSummary) @@ -33,4 +33,4 @@ gradeSummaryWidget title sts = ] ] in if 0 == numSheets sumSummaries then mempty - else $(widgetFile "widgets/gradingSummary") + else $(widgetFile "widgets/grading-summary/grading-summary") diff --git a/src/Handler/Utils/Table/Cells.hs b/src/Handler/Utils/Table/Cells.hs index a164e9f96..453c04d9e 100644 --- a/src/Handler/Utils/Table/Cells.hs +++ b/src/Handler/Utils/Table/Cells.hs @@ -34,6 +34,18 @@ timeCell t = cell $ formatTime SelFormatDateTime t >>= toWidget userCell :: IsDBTable m a => Text -> Text -> DBCell m a userCell displayName surname = cell $ nameWidget displayName surname +cellHasUser :: (IsDBTable m a, HasUser c) => c -> DBCell m a +cellHasUser = liftA2 userCell (view _userDisplayName) (view _userSurname) + +cellHasUserLink :: (IsDBTable m a, HasEntity u User) => (CryptoUUIDUser -> Route UniWorX) -> u -> DBCell m a +cellHasUserLink toLink user = + let uid = user ^. _entityKey + nWdgt = nameWidget (user ^. _entityVal . _userDisplayName) (user ^. _entityVal . _userSurname) + in anchorCellM (toLink <$> encrypt uid) nWdgt + +cellHasMatrikelnummer :: (IsDBTable m a, HasUser c) => c -> DBCell m a +cellHasMatrikelnummer = maybe mempty textCell . view _userMatrikelnummer + -- Just for documentation purposes; inline this code instead: maybeTimeCell :: IsDBTable m a => Maybe UTCTime -> DBCell m a maybeTimeCell = maybe mempty timeCell @@ -110,3 +122,10 @@ correctorStateCell sc = correctorLoadCell :: IsDBTable m a => SheetCorrector -> DBCell m a correctorLoadCell sc = i18nCell $ sheetCorrectorLoad sc + + +commentCell :: IsDBTable m a => Maybe (Route UniWorX) -> DBCell m a +commentCell Nothing = mempty +commentCell (Just link) = anchorCell link icon + where + icon = commentWidget True diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index 368758bea..b5b36fdcf 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -576,7 +576,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db , let t' = toPathPiece $ SortingSetting t d ] wIdent :: Text -> Text - wIdent = toPathPiece . WithIdent dbtIdent + wIdent = toPathPiece . WithIdent dbtIdent dbsAttrs' | not $ null dbtIdent = ("id", dbtIdent) : dbsAttrs | otherwise = dbsAttrs @@ -802,7 +802,7 @@ cellTooltip :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a - cellTooltip msg = cellContents.mapped %~ (<> tipWdgt) where tipWdgt = [whamlet| -
+
_{msg} |] diff --git a/src/Handler/Utils/Templates.hs b/src/Handler/Utils/Templates.hs index c316d9b77..f29d79fba 100644 --- a/src/Handler/Utils/Templates.hs +++ b/src/Handler/Utils/Templates.hs @@ -9,7 +9,7 @@ modal modalTrigger modalContent = do let modalDynamic = isLeft modalContent modalId <- newIdent triggerId <- newIdent - $(widgetFile "widgets/modal") + $(widgetFile "widgets/modal/modal") case modalContent of Left route -> do route' <- toTextUrl route diff --git a/src/Jobs/Handler/QueueNotification.hs b/src/Jobs/Handler/QueueNotification.hs index 8c9a759a9..5dfdc20fa 100644 --- a/src/Jobs/Handler/QueueNotification.hs +++ b/src/Jobs/Handler/QueueNotification.hs @@ -2,7 +2,9 @@ module Jobs.Handler.QueueNotification ( dispatchJobQueueNotification ) where -import Import +import Import hiding ((\\)) + +import Data.List ((\\)) import Jobs.Types @@ -20,7 +22,7 @@ dispatchJobQueueNotification jNotification = runDBJobs . setSerializable $ do guard $ notificationAllowed userNotificationSettings nClass return uid - + determineNotificationCandidates :: Notification -> DB [Entity User] determineNotificationCandidates NotificationSubmissionRated{..} = E.select . E.from $ \(user `E.InnerJoin` submissionUser) -> do @@ -40,20 +42,34 @@ determineNotificationCandidates NotificationSheetSoonInactive{..} E.where_ $ sheet E.^. SheetId E.==. E.val nSheet return user determineNotificationCandidates NotificationSheetInactive{..} - = E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` sheet) -> do - E.on $ lecturer E.^. LecturerCourse E.==. sheet E.^. SheetCourse + = E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` sheet) -> do + E.on $ lecturer E.^. LecturerCourse E.==. sheet E.^. SheetCourse E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId E.where_ $ sheet E.^. SheetId E.==. E.val nSheet return user determineNotificationCandidates NotificationCorrectionsAssigned{..} - = selectList [UserId ==. nUser] [] + = selectList [UserId ==. nUser] [] determineNotificationCandidates NotificationCorrectionsNotDistributed{nSheet} = E.select . E.from $ \(user `E.InnerJoin` lecturer `E.InnerJoin` sheet) -> do E.on $ lecturer E.^. LecturerCourse E.==. sheet E.^. SheetCourse E.on $ lecturer E.^. LecturerUser E.==. user E.^. UserId E.where_ $ sheet E.^. SheetId E.==. E.val nSheet return user - +determineNotificationCandidates NotificationUserRightsUpdate{..} + = do + -- always send to affected user + affectedUser <- selectList [UserId ==. nUser] [] + -- send to same-school admins only if there was an update + currentAdminSchools <- fmap (userAdminSchool . entityVal) <$> selectList [UserAdminUser ==. nUser] [] + let oldAdminSchools = [ SchoolKey ssh | (ssh, True, _) <- originalRights ] + newAdminSchools = currentAdminSchools \\ oldAdminSchools + affectedAdmins <- E.select . E.from $ \(user `E.InnerJoin` admin) -> do + E.on $ admin E.^. UserAdminUser E.==. user E.^. UserId + E.where_ $ admin E.^. UserAdminSchool `E.in_` E.valList newAdminSchools + return user + return $ affectedUser <> affectedAdmins + + classifyNotification :: Notification -> DB NotificationTrigger classifyNotification NotificationSubmissionRated{..} = do Sheet{sheetType} <- belongsToJust submissionSheet =<< getJust nSubmission @@ -65,5 +81,6 @@ classifyNotification NotificationSheetSoonInactive{} = return NTSheetSoonInactiv classifyNotification NotificationSheetInactive{} = return NTSheetInactive classifyNotification NotificationCorrectionsAssigned{} = return NTCorrectionsAssigned classifyNotification NotificationCorrectionsNotDistributed{} = return NTCorrectionsNotDistributed +classifyNotification NotificationUserRightsUpdate{} = return NTUserRightsUpdate diff --git a/src/Jobs/Handler/SendNotification.hs b/src/Jobs/Handler/SendNotification.hs index 547830603..64921e118 100644 --- a/src/Jobs/Handler/SendNotification.hs +++ b/src/Jobs/Handler/SendNotification.hs @@ -12,6 +12,7 @@ import Jobs.Handler.SendNotification.SheetActive import Jobs.Handler.SendNotification.SheetInactive import Jobs.Handler.SendNotification.CorrectionsAssigned import Jobs.Handler.SendNotification.CorrectionsNotDistributed +import Jobs.Handler.SendNotification.UserRightsUpdate dispatchJobSendNotification :: UserId -> Notification -> Handler () diff --git a/src/Jobs/Handler/SendNotification/SheetInactive.hs b/src/Jobs/Handler/SendNotification/SheetInactive.hs index f318539f4..7112e5c39 100644 --- a/src/Jobs/Handler/SendNotification/SheetInactive.hs +++ b/src/Jobs/Handler/SendNotification/SheetInactive.hs @@ -12,6 +12,8 @@ import Handler.Utils.Mail import Text.Hamlet import qualified Data.CaseInsensitive as CI +import qualified Database.Esqueleto as E + dispatchNotificationSheetSoonInactive :: SheetId -> UserId -> Handler () dispatchNotificationSheetSoonInactive nSheet jRecipient = userMailT jRecipient $ do (Course{..}, Sheet{..}) <- liftHandlerT . runDB $ do @@ -33,10 +35,16 @@ dispatchNotificationSheetSoonInactive nSheet jRecipient = userMailT jRecipient $ dispatchNotificationSheetInactive :: SheetId -> UserId -> Handler () dispatchNotificationSheetInactive nSheet jRecipient = userMailT jRecipient $ do - (Course{..}, Sheet{..}) <- liftHandlerT . runDB $ do + (Course{..}, Sheet{..}, nrSubs, nrSubmitters) <- liftHandlerT . runDB $ do sheet <- getJust nSheet course <- belongsToJust sheetCourse sheet - return (course, sheet) + nrSubs <- count [SubmissionSheet ==. nSheet] + (E.Value nrSubmitters:_) <- E.select . E.from $ \(subUser `E.InnerJoin` submission) -> do + E.on $ subUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId + E.where_ $ submission E.^. SubmissionSheet E.==. E.val nSheet + -- E.distinctOn [E.don (subUser E.^. SubmissionUserUser)] -- Not necessary due to UniqueSubmisionUser + return (E.countRows :: E.SqlExpr (E.Value Int64)) + return (course, sheet, nrSubs, nrSubmitters) setSubjectI $ MsgMailSubjectSheetInactive courseShorthand sheetName MsgRenderer mr <- getMailMsgRenderer @@ -49,4 +57,4 @@ dispatchNotificationSheetInactive nSheet jRecipient = userMailT jRecipient $ do addAlternatives $ do let editNotifications = $(ihamletFile "templates/mail/editNotifications.hamlet") providePreferredAlternative ($(ihamletFile "templates/mail/sheetInactive.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) - + diff --git a/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs b/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs new file mode 100644 index 000000000..aaf50ac72 --- /dev/null +++ b/src/Jobs/Handler/SendNotification/UserRightsUpdate.hs @@ -0,0 +1,27 @@ +{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} -- ihamletFile discards do results + +module Jobs.Handler.SendNotification.UserRightsUpdate + ( dispatchNotificationUserRightsUpdate + ) where + +import Import + +import Handler.Utils.Database +import Handler.Utils.Mail + +import Text.Hamlet +-- import qualified Data.CaseInsensitive as CI + +dispatchNotificationUserRightsUpdate :: UserId -> [(SchoolShorthand,Bool,Bool)]-> UserId -> Handler () +dispatchNotificationUserRightsUpdate nUser _originalRights jRecipient = userMailT jRecipient $ do + (User{..}, adminSchools, lecturerSchools) <- liftHandlerT . runDB $ do + user <-getJust nUser + adminSchools <- getSchoolsOf nUser UserAdminSchool UserAdminUser + lecturerSchools <- getSchoolsOf nUser UserLecturerSchool UserLecturerUser + return (user,adminSchools,lecturerSchools) + setSubjectI $ MsgMailSubjectUserRightsUpdate userDisplayName + -- MsgRenderer mr <- getMailMsgRenderer + addAlternatives $ do + let editNotifications = $(ihamletFile "templates/mail/editNotifications.hamlet") + providePreferredAlternative ($(ihamletFile "templates/mail/userRightsUpdate.hamlet") :: HtmlUrlI18n UniWorXMessage (Route UniWorX)) + diff --git a/src/Jobs/Types.hs b/src/Jobs/Types.hs index 2e6eb3164..151d0e404 100644 --- a/src/Jobs/Types.hs +++ b/src/Jobs/Types.hs @@ -18,7 +18,7 @@ data Job = JobSendNotification { jRecipient :: UserId, jNotification :: Notifica | JobHelpRequest { jSender :: Either (Maybe Address) UserId , jRequestTime :: UTCTime , jHelpRequest :: Text, jReferer :: Maybe Text } - | JobSetLogSettings { jInstance :: InstanceId, jLogSettings :: LogSettings } + | JobSetLogSettings { jInstance :: InstanceId, jLogSettings :: LogSettings } | JobDistributeCorrections { jSheet :: SheetId } deriving (Eq, Ord, Show, Read, Generic, Typeable) data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId } @@ -27,6 +27,7 @@ data Notification = NotificationSubmissionRated { nSubmission :: SubmissionId } | NotificationSheetInactive { nSheet :: SheetId } | NotificationCorrectionsAssigned { nUser :: UserId, nSheet :: SheetId } | NotificationCorrectionsNotDistributed { nSheet :: SheetId } + | NotificationUserRightsUpdate { nUser :: UserId, originalRights :: [(SchoolShorthand,Bool,Bool)] } -- User rights (admin, lecturer,...) were changed somehow deriving (Eq, Ord, Show, Read, Generic, Typeable) instance Hashable Job diff --git a/src/Model/Types.hs b/src/Model/Types.hs index dfedb2663..94655817d 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -559,6 +559,7 @@ data NotificationTrigger = NTSubmissionRatedGraded | NTSheetInactive | NTCorrectionsAssigned | NTCorrectionsNotDistributed + | NTUserRightsUpdate deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable) instance Universe NotificationTrigger @@ -590,6 +591,7 @@ instance Default NotificationSettings where NTSheetInactive -> True NTCorrectionsAssigned -> True NTCorrectionsNotDistributed -> True + NTUserRightsUpdate -> True instance ToJSON NotificationSettings where toJSON v = toJSON . HashMap.fromList $ map (id &&& notificationAllowed v) universeF @@ -607,7 +609,6 @@ derivePersistFieldJSON ''NotificationSettings instance ToBackendKey SqlBackend record => Hashable (Key record) where hashWithSalt s key = s `hashWithSalt` fromSqlKey key - derivePersistFieldJSON ''MailLanguages diff --git a/src/Utils/DB.hs b/src/Utils/DB.hs index 2b8f8bd01..cb8b80d4e 100644 --- a/src/Utils/DB.hs +++ b/src/Utils/DB.hs @@ -10,15 +10,12 @@ import qualified Data.Set as Set import qualified Database.Esqueleto as E -- import Database.Persist -- currently not needed here --- ezero = E.val (0 :: Int64) - emptyOrIn :: PersistField typ => E.SqlExpr (E.Value typ) -> Set typ -> E.SqlExpr (E.Value Bool) emptyOrIn criterion testSet | Set.null testSet = E.val True | otherwise = criterion `E.in_` E.valList (Set.toList testSet) - entities2map :: PersistEntity record => [Entity record] -> Map (Key record) record entities2map = foldl' (\m entity -> Map.insert (entityKey entity) (entityVal entity) m) Map.empty diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs index 0391faea1..8c53501f8 100644 --- a/src/Utils/Form.hs +++ b/src/Utils/Form.hs @@ -42,7 +42,7 @@ data FormLayout = FormStandard | FormDBTableFilter | FormDBTablePagesize renderAForm :: Monad m => FormLayout -> FormRender m a renderAForm formLayout aform fragment = do (res, ($ []) -> fieldViews) <- aFormToForm aform - let widget = $(widgetFile "widgets/form") + let widget = $(widgetFile "widgets/form/form") return (res, widget) -- | special id to identify form section headers, see 'aformSection' and 'formSection' @@ -407,7 +407,7 @@ reorderField optList = Field{..} isSel n = (==) (either (const $ map optionInternalValue olOptions) id val !! pred n) . optionInternalValue nums = map (id &&& withNum theId) [1..length olOptions] withNum t n = tshow n <> "." <> t - $(widgetFile "widgets/permutation") + $(widgetFile "widgets/permutation/permutation") optionsFinite :: ( MonadHandler m , Finite a diff --git a/src/Utils/Lens.hs b/src/Utils/Lens.hs index 68a1ba2a8..3fea6ff14 100644 --- a/src/Utils/Lens.hs +++ b/src/Utils/Lens.hs @@ -3,7 +3,7 @@ module Utils.Lens ( module Utils.Lens ) where import Import.NoFoundation import Control.Lens as Utils.Lens hiding ((<.>)) import Control.Lens.Extras as Utils.Lens (is) -import Utils.Lens.TH as Utils.Lens (makeLenses_) +import Utils.Lens.TH as Utils.Lens (makeLenses_, makeClassyFor_) import qualified Database.Esqueleto as E (Value(..),InnerJoin(..)) @@ -26,9 +26,35 @@ _InnerJoinRight :: Lens' (E.InnerJoin l r) r _InnerJoinRight f (E.InnerJoin l r) = (l `E.InnerJoin`) <$> f r -makeLenses_ ''Entity +-- makeLenses_ ''Entity +makeClassyFor_ "HasEntity" "hasEntity" ''Entity +-- class HasEntity c record | c -> record where +-- hasEntity :: Lens' c (Entity record) + +-- makeLenses_ ''Course +makeClassyFor_ "HasCourse" "hasCourse" ''Course +-- class HasCourse c where +-- hasCourse :: Lens' c Course + +instance (HasCourse a) => HasCourse (Entity a) where + hasCourse = _entityVal . hasCourse + +makeClassyFor_ "HasUser" "hasUser" ''User +-- > :info HasUser +-- class HasUser c where {-# MINIMAL hasUser #-} +-- hasUser :: Lens' c User +-- _userDisplayName :: Lens' c Text +-- _userSurname :: Lens' c Text +-- _user... +-- + +-- TODO: Is this instance needed? +instance (HasUser a) => HasUser (Entity a) where + hasUser = _entityVal . hasUser +-- This is what we would want instead: +-- instance (HasEntity a User) => HasUser a where +-- hasUser = _entityVal -makeLenses_ ''Course makeLenses_ ''SheetCorrector diff --git a/src/Utils/Lens/TH.hs b/src/Utils/Lens/TH.hs index 6f5bf4c14..dffbf10c0 100644 --- a/src/Utils/Lens/TH.hs +++ b/src/Utils/Lens/TH.hs @@ -1,5 +1,6 @@ module Utils.Lens.TH where +import ClassyPrelude (String, Maybe(..)) import Control.Lens import Control.Lens.Internal.FieldTH import Language.Haskell.TH @@ -15,6 +16,13 @@ lensRules_ :: LensRules lensRules_ = lensRules & lensField .~ \_ _ n -> [TopName (mkName ('_':nameBase n))] +-- | Like lensRules_, but different class and function name +classyRulesFor_ :: ClassyNamer -> LensRules +classyRulesFor_ clsNamer = classyRules + & lensClass .~ clsNamer + & lensField .~ \_ _ n -> [TopName (mkName ('_':nameBase n))] + + -- | Build lenses (and traversals) with a sensible default configuration. -- Works the same as 'makeLenses' except that -- the resulting lens is also prefixed with an underscore. @@ -42,6 +50,14 @@ lensRules_ = lensRules -- @ -- 'makeLenses_' = 'makeLensesWith' 'lensRules_' -- @ - makeLenses_ :: Name -> DecsQ makeLenses_ = makeFieldOptics lensRules_ + +-- | like makeClassyFor but only specifies names for class and its function, +-- otherwise lenses are created with underscore like `makeLenses_` +makeClassyFor_ :: String -> String -> Name -> DecsQ +makeClassyFor_ clsName funName = makeFieldOptics (classyRulesFor_ clNamer) + where + clNamer :: ClassyNamer + -- clNamer _ = Just (clsName, funName) -- for newer versions >= 4.17 + clNamer _ = Just (mkName clsName, mkName funName) \ No newline at end of file diff --git a/src/index.md b/src/index.md index 563023e8b..17798d0df 100644 --- a/src/index.md +++ b/src/index.md @@ -1,40 +1,45 @@ +# Datei Index + +Database,Esqueleto.* + : Hilfsdefinitionen, welche Esqueleto anbieten könnte + Utils, Utils.* : Hilfsfunktionionen _unabhängig von Foundation_ - + Utils : Yesod Hilfsfunktionen und Instanzen, Text-HTML-Widget-Konvertierungen (`DisplayAble`), Crud, `NTop`, Utility-Funktionen für `MonadPlus`, `Maybe`, `MaybeT`, `Map`, und Attrs-Lists - + Utils.TH : Template Haskell code-generatoren von unabhängigen Hilfsfunktionen (`deriveSimpleWith`) - + Utils.DB : Derived persistent functions (`existsBy`, `getKeyBy404`, ...) - + Utils.Form : `renderAForm`, Field-Settings helper, `FormIdentifier`, `Button`-Klasse, unabhängige konkrete Buttons - + Utils.PathPiece : (Template-Haskell)-Hilfsfunktionen für Formulierung von PathPiece-Instanzen - + Utils.Message : redefines addMessage, addMessageI, defines MessageClass Utils.Lens : Automatisch erzeugt Linsen für eigene und Yesod-Typen, `Control.Lens`-Export - + Utils.DateTime : Template Haskell code-generatoren zum compile-time einbinden von Zeitzone und `TimeLocale` - + Handler.Utils, Handler.Utils.* : Hilfsfunktionien, importieren `Import` - + Handler.Utils : `Handler.Utils.*`, Unsortierte _Foundation-abhängige_ Hilfsfunktionen - + Handler.Utils.DateTime : Nutzer-spezifisches `DateTime`-Formatieren @@ -42,39 +47,39 @@ Handler.Utils.Form : Konkrete Buttons, spezielle Felder (inkl. Datei-Upload-Felder), Optionslisten (`optionsPersistCryptoId`), `forced`-Felder (erzwungenes Ergebnis, deaktiviertes Feld), `multiAction` - + Handler.Utils.Rating : `Rating` (kodiert eine Rating-Datei), Parsen und PrettyPrinten von Rating-Dateien - + Handler.Utils.Sheet : `fetchSheet` - + Handler.Utils.StudyFeatures : Parsen von LDAP StudyFeatures-Strings - + Handler.Utils.Submission : `assignSubmissions`, `sinkSubmission` State-Maschinen die (bereits geparste) ZIP-Archive auseinandernehmen und (in einer Transaction) in die Datenbank speichern - + Handler.Utils.Submission.TH : Template Haskell zum parsen und einkompilieren von Dateiname-Blacklist für `sinkSubmission`; Patterns in `config/submission-blacklist` - + Handler.Utils.Table : Hilfsfunktion zum direkten Benutzen von Colonnade (kein `dbTable`) - + Handler.Utils.Table.Pagination : Here be Dragons - + Paginated database-backed tables with support for sorting, filtering, numbering, forms, further database-requests within cells - + Includes helper functions for mangling pagination-, sorting-, and filter-settings - + Includes helper functions for constructing common types of cells - + Handler.Utils.Table.Pagination.Types : `Sortable`-Headedness for colonnade @@ -83,17 +88,17 @@ Handler.Utils.Table.Cells Handler.Utils.Templates : Modals - + Handler.Utils.Zip : Conduit-basiertes ZIP Parsen und Erstellen - + Handler.Common : Handler aus dem Scaffolding; Implementierungen von Handlern, die _jede Website_ irgendwann braucht - + CryptoID : Definiert CryptoIDs für custom Typen (aus Model) - + Model.Migration : Manuelle Datenbank-Migration @@ -103,43 +108,43 @@ Model.Rating Jobs : `handleJobs` worker thread handling background jobs `JobQueueException` - + Jobs.Types : `Job`, `Notification`, `JobCtl` Types of Jobs - + Cron.Types : Datentypen zur Spezifikation von Intervallen zu denen Jobs ausgeführt werden können: - + `Cron`, `CronMatch`, `CronAbsolute`, `CronRepeat`, `Crontab` - + Cron : Seiteneffektfreie Berechnungen auf Typen aus `Cron.Types`: `nextCronMatch` - + Jobs.Queue : Funktionen zum _anstoßen_ von Jobs und zur Kommunikation mit den Worker-Threads - + `writeJobCtl` schickt Nachricht an einen pseudo-Zufälligen worker-thread der lokalen Instanz - + `queueJob` und `queueJob'` schreiben neue Jobs in die Instanz-übergreifende Job-Queue, `queueJob'` stößt außerdem einen lokalen worker-thread an sich des Jobs anzunehmen - + `runDBJobs` ersetzt `runDB` und erlaubt `queueDBJob` zu benutzen. `queueDBJob` schreibt einen Job in die Queue; am Ende stößt `runDBJobs` lokale worker-threads für alle mit `queueDBJobs` eingetragenen Jobs an. - + Jobs.TH : Templatehaskell für den dispatch mechanismus für `Jobs` - + Jobs.Crontab : Generiert `Crontab JobCtl` aus der Datenbank (sammelt alle in den Daten aus der Datenbank impliziten Jobs (notifications zu bestimmten zeiten, aufräumaktionen, ...) ein) - + Jobs.Handler.** : Via `Jobs.TH` delegiert `Jobs` das Interpretieren und Ausführen eines Werts aus `Jobs.Types` an einen dieser Handler diff --git a/templates/widgets/asidenav.lucius b/static/css/utils/asidenav.scss similarity index 92% rename from templates/widgets/asidenav.lucius rename to static/css/utils/asidenav.scss index 9123c407d..51fe73163 100644 --- a/templates/widgets/asidenav.lucius +++ b/static/css/utils/asidenav.scss @@ -4,12 +4,11 @@ z-index: 1; top: 0; left: 0; - flex: 0 0 0; - flex-basis: var(--asidenav-width-lg, 20%); - min-height: calc(100% - var(--header-height)); - transition: all .2s ease-out; width: var(--asidenav-width-lg, 20%); height: 100%; + flex: 0 0 0; + flex-basis: var(--asidenav-width-lg, 20%); + transition: all .2s ease-out; &::before { position: absolute; @@ -72,6 +71,14 @@ .asidenav { color: var(--color-font); + min-height: calc(100% - var(--header-height)); + height: 400px; + overflow-y: auto; + overflow-x: hidden; + + &::-webkit-scrollbar { + width: 0; + } } .asidenav__box { @@ -183,9 +190,7 @@ /* LIST-ITEM */ .asidenav__list-item { - position: relative; color: var(--color-font); - min-height: 50px; display: flex; flex-direction: column; justify-content: flex-start; @@ -207,10 +212,8 @@ text-shadow: none; } - .asidenav__nested-list { - transform: translateX(100%); - opacity: 1; - width: 200px; + .asidenav__nested-list-wrapper { + display: block; } } } @@ -242,7 +245,7 @@ display: flex; flex: 1; align-items: center; - padding: 7px 10px; + padding: 8px 3px; justify-content: flex-start; color: var(--color-font); width: 100%; @@ -258,17 +261,17 @@ } /* hover sub-menus */ -.asidenav__nested-list { +.asidenav__nested-list-wrapper { position: absolute; - top: 0; - right: 0; + z-index: 10; + display: none; color: var(--color-font); - transform: translateX(0); - opacity: 0; - width: 0; - overflow: hidden; - z-index: -1; - box-shadow: 0 0 13px rgba(0, 0, 0, 0.4); + background-color: var(--color-grey-light); + box-shadow: 1px 1px 1px 0px var(--color-grey); +} + +.asidenav__nested-list { + min-width: 200px; } @media (max-width: 425px) { @@ -280,19 +283,16 @@ .asidenav__nested-list-item { position: relative; - color: var(--color-lightwhite); - background-color: var(--color-dark); &:hover { - background-color: var(--color-darker); + background-color: var(--color-lightwhite); } .asidenav__link-wrapper { padding-left: 13px; padding-right: 13px; - border-left: 20px solid white; transition: all .2s ease; - color: var(--color-lightwhite); + color: var(--color-font); } } diff --git a/templates/widgets/form.lucius b/static/css/utils/form.scss similarity index 100% rename from templates/widgets/form.lucius rename to static/css/utils/form.scss diff --git a/templates/standalone/inputs.lucius b/static/css/utils/inputs.scss similarity index 100% rename from templates/standalone/inputs.lucius rename to static/css/utils/inputs.scss diff --git a/templates/standalone/showHide.lucius b/static/css/utils/showHide.scss similarity index 94% rename from templates/standalone/showHide.lucius rename to static/css/utils/showHide.scss index d1413c0fb..64dfe367c 100644 --- a/templates/standalone/showHide.lucius +++ b/static/css/utils/showHide.scss @@ -1,7 +1,3 @@ -.js-show-hide { - position: relative; -} - .js-show-hide__toggle { position: relative; cursor: pointer; diff --git a/static/css/utils/tabber.css b/static/css/utils/tabber.scss similarity index 89% rename from static/css/utils/tabber.css rename to static/css/utils/tabber.scss index 6f823b410..d135a5f27 100644 --- a/static/css/utils/tabber.css +++ b/static/css/utils/tabber.scss @@ -17,7 +17,7 @@ text-align: center; padding: 0 13px; margin: 0 2px; - background-color: #b3b7c1; + background-color: var(--color-dark); color: white; font-size: 16px; text-transform: uppercase; @@ -35,5 +35,5 @@ .tab-opener.tab-visible { background-color: transparent; color: rgb(52, 48, 58); - border-bottom-color: #5F98C2; + border-bottom-color: var(--color-primary); } diff --git a/templates/standalone/tooltip.lucius b/static/css/utils/tooltip.scss similarity index 97% rename from templates/standalone/tooltip.lucius rename to static/css/utils/tooltip.scss index 0a2154768..7e538e46a 100644 --- a/templates/standalone/tooltip.lucius +++ b/static/css/utils/tooltip.scss @@ -1,4 +1,4 @@ -.js-tooltip { +.tooltip { position: relative; display: inline-block; height: 1.5rem; @@ -67,7 +67,7 @@ @media (max-width: 768px) { - .js-tooltip { + .tooltip { display: block; margin-top: 10px; diff --git a/static/js/utils/alerts.js b/static/js/utils/alerts.js index eec2fb73a..d52a47376 100644 --- a/static/js/utils/alerts.js +++ b/static/js/utils/alerts.js @@ -3,6 +3,7 @@ window.utils = window.utils || {}; + var ALERTS_CLASS = 'alerts'; var ALERTS_TOGGLER_CLASS = 'alerts__toggler'; var ALERTS_TOGGLER_VISIBLE_CLASS = 'alerts__toggler--visible'; var ALERTS_TOGGLER_APPEAR_DELAY = 120; @@ -18,7 +19,11 @@ window.utils.alerts = function(alertsEl) { if (alertsEl.classList.contains(JS_INITIALIZED_CLASS)) { - return; + return false; + } + + if (!alertsEl || !alertsEl.classList.contains(ALERTS_CLASS)) { + throw new Error('utils.alerts has to be called with alerts element'); } var togglerCheckRequested = false; diff --git a/static/js/utils/asidenav.js b/static/js/utils/asidenav.js new file mode 100644 index 000000000..154232109 --- /dev/null +++ b/static/js/utils/asidenav.js @@ -0,0 +1,59 @@ +(function() { + 'use strict'; + + window.utils = window.utils || {}; + + var FAVORITES_BTN_CLASS = 'navbar__list-item--favorite'; + var FAVORITES_BTN_ACTIVE_CLASS = 'navbar__list-item--active'; + var ASIDENAV_EXPANDED_CLASS = 'main__aside--expanded'; + var ASIDENAV_LIST_ITEM_CLASS = 'asidenav__list-item'; + var ASIDENAV_SUBMENU_CLASS = 'asidenav__nested-list-wrapper'; + + window.utils.aside = function(asideEl) { + + if (!asideEl) { + throw new Error('asideEl not defined'); + } + + function initFavoritesButton() { + var favoritesBtn = document.querySelector('.' + FAVORITES_BTN_CLASS); + favoritesBtn.addEventListener('click', function(event) { + favoritesBtn.classList.toggle(FAVORITES_BTN_ACTIVE_CLASS); + asideEl.classList.toggle(ASIDENAV_EXPANDED_CLASS); + event.preventDefault(); + }, true); + } + + function initAsidenavSubmenus() { + var asidenavLinksWithSubmenus = Array.from(asideEl.querySelectorAll('.' + ASIDENAV_LIST_ITEM_CLASS)) + .map(function(listItem) { + var submenu = listItem.querySelector('.' + ASIDENAV_SUBMENU_CLASS); + return { listItem, submenu }; + }).filter(function(union) { + return union.submenu !== null; + }); + + asidenavLinksWithSubmenus.forEach(function(union) { + union.listItem.addEventListener('mouseover', createMouseoverHandler(union)); + }); + } + + function createMouseoverHandler(union) { + return function mouseoverHanlder(event) { + var rectListItem = union.listItem.getBoundingClientRect(); + var rectSubMenu = union.submenu.getBoundingClientRect(); + + union.submenu.style.left = (rectListItem.left + rectListItem.width) + 'px'; + if (window.innerHeight - rectListItem.top < rectSubMenu.height) { + union.submenu.style.top = (rectListItem.top + rectListItem.height - rectSubMenu.height) + 'px'; + } else { + union.submenu.style.top = rectListItem.top + 'px'; + } + + }; + } + + initFavoritesButton(); + initAsidenavSubmenus(); + }; +})(); diff --git a/static/js/utils/asyncTable.js b/static/js/utils/asyncTable.js new file mode 100644 index 000000000..fe164d3b2 --- /dev/null +++ b/static/js/utils/asyncTable.js @@ -0,0 +1,202 @@ +(function collonadeClosure() { + 'use strict'; + + window.utils = window.utils || {}; + + var HEADER_HEIGHT = 80; + var RESET_OPTIONS = [ 'scrollTo' ]; + + window.utils.asyncTable = function(wrapper, options) { + + options = options || {}; + var tableIdent = options.dbtIdent; + var shortCircuitHeader = options ? options.headerDBTableShortcircuit : null; + + var ths = []; + var pageLinks = []; + var pagesizeForm; + var scrollTable; + + function init() { + var table = wrapper.querySelector('#' + tableIdent); + + if (!table) { + return; + } + + scrollTable = wrapper.querySelector('.scrolltable'); + + // sortable table headers + ths = Array.from(table.querySelectorAll('th.sortable')).map(function(th) { + return { element: th }; + }); + + // pagination links + var pagination = wrapper.querySelector('#' + tableIdent + '-pagination'); + if (pagination) { + pageLinks = Array.from(pagination.querySelectorAll('.page-link')).map(function(link) { + return { element: link }; + }); + } + + // pagesize form + pagesizeForm = wrapper.querySelector('#' + tableIdent + '-pagesize-form'); + + // take options into account + if (options && options.scrollTo) { + window.scrollTo(options.scrollTo); + } + + if (options && options.horizPos && scrollTable) { + scrollTable.scrollLeft = options.horizPos; + } + + setupListeners(); + wrapper.classList.add('js-initialized'); + } + + function setupListeners() { + ths.forEach(function(th) { + th.clickHandler = function(event) { + var boundClickHandler = clickHandler.bind(this); + var horizPos = (scrollTable || {}).scrollLeft; + boundClickHandler(event, { horizPos }); + }; + th.element.addEventListener('click', th.clickHandler); + }); + + pageLinks.forEach(function(link) { + link.clickHandler = function(event) { + var boundClickHandler = clickHandler.bind(this); + var tableBoundingRect = scrollTable.getBoundingClientRect(); + var tableOptions = {}; + if (tableBoundingRect.top < HEADER_HEIGHT) { + tableOptions.scrollTo = { + top: (scrollTable.offsetTop || 0) - HEADER_HEIGHT, + left: scrollTable.offsetLeft || 0, + behavior: 'smooth', + }; + } + boundClickHandler(event, tableOptions); + } + link.element.addEventListener('click', link.clickHandler); + }); + + if (pagesizeForm) { + var pagesizeSelect = pagesizeForm.querySelector('[name=' + tableIdent + '-pagesize]'); + pagesizeSelect.addEventListener('change', changePagesizeHandler); + } + } + + function removeListeners() { + ths.forEach(function(th) { + th.element.removeEventListener('click', th.clickHandler); + }); + + pageLinks.forEach(function(link) { + link.element.removeEventListener('click', link.clickHandler); + }); + + if (pagesizeForm) { + var pagesizeSelect = pagesizeForm.querySelector('[name=' + tableIdent + '-pagesize]') + pagesizeSelect.removeEventListener('change', changePagesizeHandler); + } + } + + function clickHandler(event, tableOptions) { + event.preventDefault(); + var url = new URL(window.location.origin + window.location.pathname + getClickDestination(this)); + updateTableFrom(url, tableOptions); + } + + function getClickDestination(el) { + if (!el.querySelector('a')) { + return ''; + } + return el.querySelector('a').getAttribute('href'); + } + + function changePagesizeHandler(event) { + var currentTableUrl = options.currentUrl || window.location.href; + var url = getUrlWithUpdatedPagesize(currentTableUrl, event.target.value); + url = new URL(getUrlWithResetPagenumber(url)); + updateTableFrom(url); + } + + function getUrlWithUpdatedPagesize(url, pagesize) { + if (url.indexOf('pagesize') >= 0) { + return url.replace(/pagesize=(\d+|all)/, 'pagesize=' + pagesize); + } else if (url.indexOf('?') >= 0) { + return url += '&' + tableIdent + '-pagesize=' + pagesize; + } + + return url += '?' + tableIdent + '-pagesize=' + pagesize; + } + + function getUrlWithResetPagenumber(url) { + return url.replace(/-page=\d+/, '-page=0'); + } + + // fetches new sorted table from url with params and replaces contents of current table + function updateTableFrom(url, tableOptions) { + tableOptions = tableOptions || {}; + fetch(url, { + credentials: 'same-origin', + headers: { + 'Accept': 'text/html', + [shortCircuitHeader]: tableIdent + } + }).then(function(response) { + if (!response.ok) { + throw new Error('Looks like there was a problem fetching ' + url.href + '. Status Code: ' + response.status); + } + return response.text(); + }).then(function(data) { + tableOptions.currentUrl = url.href; + removeListeners(); + updateWrapperContents(data, tableOptions); + }).catch(function(err) { + console.error(err); + }); + } + + function updateWrapperContents(newHtml, tableOptions) { + tableOptions = tableOptions || {}; + wrapper.innerHTML = newHtml; + wrapper.classList.remove("js-initialized"); + + // setup the wrapper and its components to behave async again + window.utils.teardown('asyncTable'); + window.utils.teardown('form'); + // merge global options and table specific options + var resetOptions = {}; + Object.keys(options) + .filter(function(key) { + return !RESET_OPTIONS.includes(key); + }) + .forEach(function(key) { + resetOptions[key] = options[key]; + }); + var combinedOptions = {}; + combinedOptions = Object.keys(tableOptions) + .filter(function(key) { + return tableOptions.hasOwnProperty(key); + }) + .map(function(key) { + return { key, value: tableOptions[key] } + }) + .reduce(function(cumulatedOpts, opt) { + cumulatedOpts[opt.key] = opt.value; + return cumulatedOpts; + }, resetOptions); + + window.utils.setup('asyncTable', wrapper, combinedOptions); + + Array.from(wrapper.querySelectorAll('form')).forEach(function(form) { + window.utils.setup('form', form); + }); + } + + init(); + }; +})(); diff --git a/static/js/utils/featureChecker.js b/static/js/utils/featureChecker.js deleted file mode 100644 index ad8e26303..000000000 --- a/static/js/utils/featureChecker.js +++ /dev/null @@ -1,4 +0,0 @@ -window.addEventListener('touchstart', function onFirstTouch() { - document.body.classList.add('touch-supported'); - window.removeEventListener('touchstart', onFirstTouch, false); -}, false); diff --git a/templates/widgets/form.julius b/static/js/utils/form.js similarity index 51% rename from templates/widgets/form.julius rename to static/js/utils/form.js index e318ca3f3..30ba76c96 100644 --- a/templates/widgets/form.julius +++ b/static/js/utils/form.js @@ -3,13 +3,57 @@ window.utils = window.utils || {}; + var JS_INITIALIZED = 'js-initialized'; + var SUBMIT_BUTTON_SELECTOR = '[type="submit"]:not([formnovalidate])'; + var AUTOSUBMIT_BUTTON_SELECTOR = '[type="submit"][data-autosubmit]'; + + function formValidator(inputs) { + var done = true; + inputs.forEach(function(inp) { + var len = inp.value.trim().length; + if (done && len === 0) { + done = false; + } + }); + return done; + } + + window.utils.form = function(form, options) { + + if (form.classList.contains(JS_INITIALIZED)) { + return false; + } + form.classList.add(JS_INITIALIZED); + + // reactive buttons + var submitBtn = form.querySelector(SUBMIT_BUTTON_SELECTOR); + if (submitBtn) { + window.utils.setup('reactiveButton', form, { button: submitBtn }); + } + + // conditonal fieldsets + var fieldSets = Array.from(form.querySelectorAll('fieldset[data-conditional-id][data-conditional-value]')); + window.utils.setup('interactiveFieldset', form, { fieldSets }); + + // hide autoSubmit submit button + window.utils.setup('autoSubmit', form, options); + }; + // registers input-listener for each element in (array) and - // enables