Merge branch 'master' into modal-migration

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

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

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

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

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
+    -- MenuItem
-      { menuItemType = PageActionPrime
+    --   { menuItemType = PageActionPrime
-      , menuItemLabel = MsgInfoLecturerTitle
+    --   , menuItemLabel = MsgInfoLecturerTitle
-      , menuItemIcon  = Nothing
+    --   , menuItemIcon  = Nothing
-      , menuItemRoute = SomeRoute InfoLecturerR
+    --   , menuItemRoute = SomeRoute InfoLecturerR
-      , menuItemModal = False
+    --   , menuItemModal = False
-      , menuItemAccessCallback' = return True
+    --   , 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
 

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:
+              <ul>
+                <li>#{show i}
+                <li>#{show b}
+                <li>#{show d}
+          $nothing
+            No form values received, due to #
+            $# Using formResult' above means that we usually to not distinguish the following two cases here, sind formResult does this already:
+            $case demoResult
+              $of FormSuccess _
+                $# Already dealt with above, to showecase usage of formResult' as normally done.
+                success, which should not happen here.
+              $of FormMissing
+                Form data missing, probably empty.
+              $of FormFailure msgs
+                <ul>
+                  $forall m <- msgs
+                    <li>#{m}
+        |]
+
+  let locallyDefinedPageHeading = [whamlet|Admin TestPage for Uni2work|]
+  siteLayout locallyDefinedPageHeading $ do
+  -- defaultLayout $ do
+    setTitle "Uni2work Admin Testpage"
     $(widgetFile "adminTest")
 
+    [whamlet|<h2>Formular Demonstration|]
+    $(widgetFile "formPage")
+    showDemoResult
+
 
 getAdminErrMsgR, postAdminErrMsgR :: Handler Html
 getAdminErrMsgR = postAdminErrMsgR

src/Handler/Course.hs

@@ -34,36 +34,36 @@ colCourse = sortable (Just "course") (i18nCell MsgCourse)
             anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR)
               [whamlet|#{display courseName}|]
 
-colCourseDescr :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
+-- colCourseDescr :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
-colCourseDescr = sortable (Just "course") (i18nCell MsgCourse) $ do
+-- colCourseDescr = sortable (Just "course") (i18nCell MsgCourse) $ do
-    course <- view $ _dbrOutput . _1 . _entityVal
+--     course <- view $ _dbrOutput . _1 . _entityVal
-    return $ courseCell course
+--     return $ courseCell course
 
 colDescription :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
-colDescription = sortable Nothing (i18nCell MsgCourseDescription)
+colDescription = sortable Nothing mempty
           $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _) } ->
             case courseDescription of
               Nothing      -> mempty
-              (Just descr) -> cell $ modal "Beschreibung" (Right $ toWidget descr)
+              (Just descr) -> cell $ modal (toWidget $ hasComment True) (Right $ toWidget descr)
 
 colCShort :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
 colCShort = sortable (Just "cshort") (i18nCell MsgCourseShort)
           $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _) } ->
             anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) [whamlet|#{display courseShorthand}|]
 
-colCShortDescr :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
+-- colCShortDescr :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
-colCShortDescr = sortable (Just "cshort") (i18nCell MsgCourseShort)
+-- colCShortDescr = sortable (Just "cshort") (i18nCell MsgCourseShort)
-          $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _) } -> mappend
+--           $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _) } -> mappend
-            ( anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) [whamlet|#{display courseShorthand}|] )
+--             ( anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) [whamlet|#{display courseShorthand}|] )
-            ( case courseDescription of
+--             ( case courseDescription of
-                Nothing      -> mempty
+--                 Nothing      -> mempty
-                (Just descr) -> cell
+--                 (Just descr) -> cell
-                  [whamlet|
+--                   [whamlet|
-                    $newline never
+--                     $newline never
-                    <div>
+--                     <div>
-                      ^{modal "Beschreibung" (Right $ toWidget descr)}
+--                       ^{modal "Beschreibung" (Right $ toWidget descr)}
-                  |]
+--                   |]
-            )
+--             )
 
 colTerm :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
 colTerm = sortable (Just "term") (i18nCell MsgTerm)
@@ -92,7 +92,7 @@ colRegTo = sortable (Just "register-to") (i18nCell MsgRegisterTo)
             maybe mempty timeCell courseRegisterTo
 
 colMembers :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
-colMembers = sortable (Just "members") (i18nCell MsgCourseMember)
+colMembers = sortable (Just "members") (i18nCell MsgCourseMembers)
           $ \DBRow{ dbrOutput=(Entity _ Course{..}, currentParticipants, _, _) } -> i18nCell $ case courseCapacity of
               Nothing -> MsgCourseMembersCount currentParticipants
               Just limit -> MsgCourseMembersCountLimited currentParticipants limit
@@ -190,16 +190,16 @@ getCourseListR :: Handler Html
 getCourseListR = do
   muid <- maybeAuthId
   let colonnade = widgetColonnade $ mconcat
-        [ colCourseDescr
+        [ colCourse -- colCourseDescr
+        , colDescription
         , colSchoolShort
         , colTerm
         , colCShort
         , maybe mempty (const colRegistered) muid
-
         ]
       whereClause = const $ E.val True
       validator = def
-        & defaultSorting [SortAscBy "course", SortDescBy "term"]
+        & defaultSorting [SortDescBy "term",SortAscBy "course"]
   coursesTable <- runDB $ makeCourseTable whereClause colonnade validator
   defaultLayout $ do
     setTitleI MsgCourseListTitle
@@ -220,7 +220,8 @@ getTermSchoolCourseListR tid ssh = do
   muid <- maybeAuthId
   let colonnade = widgetColonnade $ mconcat
         [ dbRow
-        , colCShortDescr
+        , colCShort
+        , colDescription
         , colRegFrom
         , colRegTo
         , colMembers
@@ -243,7 +244,8 @@ getTermCourseListR tid = do
   muid <- maybeAuthId
   let colonnade = widgetColonnade $ mconcat
         [ dbRow
-        , colCShortDescr
+        , colCShort
+        , colDescription
         , colSchoolShort
         , colRegFrom
         , colRegTo
@@ -561,9 +563,10 @@ makeCourseForm template = identForm FIDcourse $ \html -> do
     (result, widget) <- flip (renderAForm FormStandard) html $ CourseForm
       <$> pure (cfCourseId =<< template)
       <*> areq ciField (fslI MsgCourseName)                             (cfName       <$> template)
-      <*> aopt htmlField (fslI MsgCourseDescription
+      <*> aopt htmlField (fslpI MsgCourseDescription "Bitte mindestens die Modulbeschreibung angeben"
                          & setTooltip MsgCourseDescriptionTip)          (cfDesc       <$> template)
-      <*> aopt urlField  (fslI MsgCourseHomepage)                       (cfLink       <$> template)
+      <*> aopt urlField  (fslpI MsgCourseHomepageExternal "Optionale externe URL")
+                                                                        (cfLink       <$> template)
       <*> areq ciField (fslI MsgCourseShorthand
             -- & addAttr "disabled" "disabled"
             & setTooltip MsgCourseShorthandUnique)                      (cfShort      <$> template)
@@ -618,81 +621,98 @@ validateCourse CourseForm{..} =
   ] ]
 
 
-
+--------------------
 -- CourseUserTable
 
-type UserTableExpr  = (E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) `E.LeftOuterJoin` E.SqlExpr (Entity CourseUserNote)
+type UserTableExpr   = (E.SqlExpr (Entity User) `E.InnerJoin` E.SqlExpr (Entity CourseParticipant)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity CourseUserNote))
-type UserTableWhere = UserTableExpr -> E.SqlExpr (E.Value Bool)
+type UserTableWhere  = UserTableExpr -> E.SqlExpr (E.Value Bool)
-type UserTableData  = DBRow (Entity User, Entity CourseParticipant, Maybe (Key CourseUserNote))
+type UserTableData   = DBRow (Entity User, E.Value UTCTime, E.Value (Maybe CourseUserNoteId))
 
-userTableQuery :: UserTableWhere -> (UserTableExpr -> v) -> UserTableExpr -> E.SqlQuery v
+forceUserTableType :: (UserTableExpr -> a) -> (UserTableExpr -> a)
-userTableQuery whereClause returnStatement t@((user `E.InnerJoin` participant) `E.LeftOuterJoin` note) = do
+forceUserTableType = id
-  E.on $ participant E.^. CourseParticipantUser E.==. note E.^. CourseUserNoteUser
+
-  E.on $ participant E.^. CourseParticipantUser E.==. user E.^. UserId
+userTableQuery :: UserTableWhere -> UserTableExpr
+   -> E.SqlQuery  ( E.SqlExpr (Entity User)
+                  , E.SqlExpr (E.Value UTCTime)
+                  , E.SqlExpr (E.Value (Maybe CourseUserNoteId)))
+userTableQuery whereClause t@((user `E.InnerJoin` participant) `E.LeftOuterJoin` note) = do
+  E.on $ E.just (participant E.^. CourseParticipantUser) E.==. note E.?. CourseUserNoteUser
+  E.on $         participant E.^. CourseParticipantUser  E.==. user E.^. UserId
   E.where_ $ whereClause t
-  return $ returnStatement t
+  return (user, participant E.^. CourseParticipantRegistration, note E.?. CourseUserNoteId)
-
-instance HasUser UserTableData where
-  hasUser = _entityVal
 
 instance HasEntity UserTableData User where
   hasEntity = _dbrOutput . _1
 
--- -- there can be only one -- FunctionalDependency violation
+instance HasUser UserTableData where
--- instance HasEntity UserTableData CourseParticipant where
+  -- hasUser = _entityVal
---   hasEntity = _dbrOutput . _2
+  hasUser = _dbrOutput . _1 . _entityVal
 
+_userTableRegistration :: Lens' UserTableData UTCTime
+_userTableRegistration = _dbrOutput . _2 . _unValue
+
+-- FIXME: I am a prism due to maybe
+_userTableNote :: Lens' UserTableData (Maybe CourseUserNoteId)
+_userTableNote = _dbrOutput . _3 . _unValue
+
+-- default Where-Clause
 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)
+colUserComment :: IsDBTable m a => TermId -> SchoolId -> CourseShorthand -> Colonnade Sortable 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) } ->
+      $ \DBRow{ dbrOutput=(Entity uid _, _, E.Value mbNoteKey) } ->
         maybeEmpty mbNoteKey $ const $
-          anchorCellM (encrypt uid >>= return . courseLink) (commentWidget True)
+          anchorCellM (courseLink <$> encrypt uid) (toWidget $ hasComment True)
   where
     courseLink = CourseR tid ssh csh . CUserR
 
-makeUserTable :: UserTableWhere -> _ -> _ -> DB Widget
+    --  makeCourseUserTable :: (ToSortable h, Functor h) =>
-makeUserTable _whereClause _colChoices _psValidator =
+    --                          UserTableWhere
-  -- do
+    --                          -> Colonnade
-  --   dbTable psValidator DBTable
+    --                               h
-  --     { userTableQUery whereClause
+    --                               (DBRow
-  --     ,
+    --                                  (Entity User, E.Value UTCTime,
-  return [whamlet| Course user table not yet implemented |]
+    --                                   E.Value (Maybe CourseUserNoteId)))
+    --                               (DBCell (HandlerT UniWorX IO) ())
+    --                          -> PSValidator (HandlerT UniWorX IO) ()
+    --                          -> ReaderT SqlBackend (HandlerT UniWorX IO) Widget
+
+makeCourseUserTable :: UserTableWhere -> _ -> _ -> DB Widget
+makeCourseUserTable whereClause colChoices psValidator =
+  -- return [whamlet|TODO|] -- TODO
+  -- -- psValidator has default sorting and filtering
+  let dbtIdent     = "courseUsers" :: Text
+      dbtStyle     = def
+      dbtSQLQuery  = userTableQuery whereClause
+      dbtRowKey ((user `E.InnerJoin` _participant) `E.LeftOuterJoin` _note) = user E.^. UserId
+      dbtProj      = return -- . dbrOutput -- NOT SURE
+      dbtColonnade = colChoices
+      dbtSorting   = Map.fromList [] -- TODO
+      dbtFilter    = Map.fromList [] -- TODO
+      dbtFilterUI  = mempty -- TODO
+      dbtParams    = def
+  in dbTableWidget' psValidator DBTable{..}
 
 
 getCUsersR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getCUsersR tid ssh csh = do
-  Entity _cid course <- runDB $ getBy404 $ TermSchoolCourseShort tid ssh csh
+  Entity cid course <- runDB $ getBy404 $ TermSchoolCourseShort tid ssh csh
-  let heading = [whamlet|_{MsgCourseMember} #{courseName course} #{display tid}|]
+  let heading = [whamlet|_{MsgMenuCourseMembers} #{courseName course} #{display tid}|]
-  --     whereClause = courseIs cid
+      whereClause = courseIs cid
-  --     colChoices  = [colUserParticipant,colUserMatriclenr,colUserComment tid ssh csh]
+      colChoices  = mconcat
-  --     psValidator = def
+        [ colUserParticipantLink tid ssh csh
-  -- tableWidget <- runDB $ makeUserTable whereClause colChoices psValidator
+        , colUserMatriclenr
+        -- ,colUserComment tid ssh csh
+        ]
+      psValidator = def
+  tableWidget <- runDB $ makeCourseUserTable whereClause colChoices psValidator
   siteLayout heading $ do
     setTitle [shamlet| #{toPathPiece tid} - #{csh}|]
-    [whamlet|
+    -- TODO: creat hamlet wrapper
-      User table not yet implemented
+    tableWidget
-      $# ^{tableWidget}
-     |]
 
 
 

src/Handler/Home.hs

@@ -137,7 +137,7 @@ homeUser uid = do
             case mbsid of
               Nothing    -> mempty
               (Just sid) -> anchorCellM (CSubmissionR tid ssh csh shn <$> encrypt sid <*> pure SubShowR)
-                                        tickmark
+                                        (toWidget $ hasTickmark True)
         ]
   let validator = def & defaultSorting [SortDescBy "done", SortAscBy "deadline"]
   sheetTable <- runDB $ dbTableWidget' validator DBTable
@@ -206,7 +206,8 @@ getDataProtR = -- do
 -- | Allgemeine Informationen
 getInfoR :: Handler TypedContent
 getInfoR = selectRep $ do
-    provideRep . defaultLayout $ do
+    let infoHeading = [whamlet|Re-Implementierung von <a href="https://uniworx.ifi.lmu.de/">UniWorX</a>|]
+    provideRep . siteLayout infoHeading $ do
       let features = $(widgetFile "featureList")
           gitInfo :: Text
           gitInfo  = $gitDescribe <> " (" <> $gitCommitDate <> ")"

src/Handler/Profile.hs

@@ -28,24 +28,54 @@ data SettingsForm = SettingsForm
 
 makeSettingForm :: Maybe SettingsForm -> Form SettingsForm
 makeSettingForm template = identForm FIDsettings $ \html -> do
-    let themeList = [Option (display t) t (toPathPiece t) | t <- universeF]
     (result, widget) <- flip (renderAForm FormStandard) html $ SettingsForm
-      <$> areq (natFieldI $ MsgNatField "Favoriten") -- TODO: natFieldI not working here
+        <$  aformSection MsgFormCosmetics
+        <*> areq (natFieldI $ MsgNatField "Favoriten") -- TODO: natFieldI not working here
             (fslpI MsgFavoriten "Anzahl Favoriten") (stgMaxFavourties <$> template)
-      <*> areq (selectField . return $ mkOptionList themeList)
+        <*> areq (selectField . return $ mkOptionList themeList)
             (fslI  MsgTheme) { fsId = Just "theme-select" } (stgTheme         <$> template)
-      <*> areq (selectField $ dateTimeFormatOptions SelFormatDateTime) (fslI MsgDateTimeFormat) (stgDateTime <$> template)
+        <*> areq (selectField $ dateTimeFormatOptions SelFormatDateTime) (fslI MsgDateTimeFormat) (stgDateTime <$> template)
-      <*> areq (selectField $ dateTimeFormatOptions SelFormatDate) (fslI MsgDateFormat) (stgDate <$> template)
+        <*> areq (selectField $ dateTimeFormatOptions SelFormatDate) (fslI MsgDateFormat) (stgDate <$> template)
-      <*> areq (selectField $ dateTimeFormatOptions SelFormatTime) (fslI MsgTimeFormat) (stgTime <$> template)
+        <*> areq (selectField $ dateTimeFormatOptions SelFormatTime) (fslI MsgTimeFormat) (stgTime <$> template)
-      <*> areq checkBoxField (fslI MsgDownloadFiles
+        <*  aformSection MsgFormBehaviour
-                               & setTooltip MsgDownloadFilesTip
+        <*> areq checkBoxField (fslI MsgDownloadFiles
-                             ) (stgDownloadFiles <$> template)
+                                   & setTooltip MsgDownloadFilesTip
-      <*> (NotificationSettings <$> funcForm nsForm (fslI MsgNotificationSettings) True)
+                                ) (stgDownloadFiles <$> template)
-      <*  submitButton
+        <*  aformSection MsgFormNotifications
+        <*> (NotificationSettings <$> funcForm nsForm (fslI MsgNotificationSettings) True)
+        <*  submitButton
     return (result, widget) -- no validation required here
   where
+    themeList = [Option (display t) t (toPathPiece t) | t <- universeF]
     nsForm nt = fromMaybe False <$> aopt checkBoxField (fslI nt) (Just $ flip notificationAllowed nt . stgNotificationSettings <$> template)
-
+--
+-- Version with proper grouping:
+--
+-- makeSettingForm :: Maybe SettingsForm -> Form SettingsForm
+-- makeSettingForm template = identForm FIDsettings $ \html -> do
+--     (result, widget) <- flip (renderAForm FormStandard) html $ settingsFormT5T2
+--       <$> aFormGroup "Cosmetics"     cosmeticsForm
+--       <*> aFormGroup "Notifications" notificationsForm
+--       <*  submitButton
+--     return (result, widget) -- no validation required here
+--   where
+--     settingsFormT5T2 :: (Int,Theme,DateTimeFormat,DateTimeFormat,DateTimeFormat) -> (Bool,NotificationSettings) -> SettingsForm
+--     settingsFormT5T2 = $(uncurryN 2) . $(uncurryN 5) SettingsForm
+--     themeList = [Option (display t) t (toPathPiece t) | t <- universeF]
+--     cosmeticsForm = (,,,,)
+--       <$> areq (natFieldI $ MsgNatField "Favoriten") -- TODO: natFieldI not working here
+--             (fslpI MsgFavoriten "Anzahl Favoriten") (stgMaxFavourties <$> template)
+--       <*> areq (selectField . return $ mkOptionList themeList)
+--             (fslI  MsgTheme) { fsId = Just "theme-select" } (stgTheme         <$> template)
+--       <*> areq (selectField $ dateTimeFormatOptions SelFormatDateTime) (fslI MsgDateTimeFormat) (stgDateTime <$> template)
+--       <*> areq (selectField $ dateTimeFormatOptions SelFormatDate) (fslI MsgDateFormat) (stgDate <$> template)
+--       <*> areq (selectField $ dateTimeFormatOptions SelFormatTime) (fslI MsgTimeFormat) (stgTime <$> template)
+--     notificationsForm = (,)
+--       <$> areq checkBoxField (fslI MsgDownloadFiles
+--                                & setTooltip MsgDownloadFilesTip
+--                              ) (stgDownloadFiles <$> template)
+--       <*> (NotificationSettings <$> funcForm nsForm (fslI MsgNotificationSettings) True)
+--     nsForm nt = fromMaybe False <$> aopt checkBoxField (fslI nt) (Just $ flip notificationAllowed nt . stgNotificationSettings <$> template)
 
 getProfileR, postProfileR :: Handler Html
 getProfileR = postProfileR
@@ -214,9 +244,9 @@ getProfileDataR = do
            <*> mkCorrectionsTable uid -- Tabelle mit allen Korrektor-Aufgaben
 
 
-  let examTable = [whamlet| Klausuren werden momentan leider noch nicht unterstützt.|]
+  let examTable        = [whamlet|Klausuren werden momentan leider noch nicht unterstützt.|]
   let ownTutorialTable = [whamlet|Übungsgruppen werden momentan leider noch nicht unterstützt.|]
-  let tutorialTable = [whamlet|Übungsgruppen werden momentan leider noch nicht unterstützt.|]
+  let tutorialTable    = [whamlet|Übungsgruppen werden momentan leider noch nicht unterstützt.|]
 
   -- Delete Button
   (btnWdgt, btnEnctype) <- generateFormPost (buttonForm :: Form ButtonDelete)

src/Handler/SystemMessage.hs

@@ -10,6 +10,7 @@ import qualified Data.Set as Set
 import qualified Data.List.NonEmpty as NonEmpty
 
 import Handler.Utils
+import Handler.Utils.Table.Cells
 
 import Utils.Lens
 

src/Handler/Term.hs

@@ -2,6 +2,7 @@ module Handler.Term where
 
 import Import
 import Handler.Utils
+import Handler.Utils.Table.Cells
 import qualified Data.Map as Map
 
 -- import qualified Data.Text as T
@@ -67,7 +68,7 @@ getTermShowR = do
     provideRep $ toJSON . map fst <$> runDB (E.select $ E.from termData)
     provideRep $ do
       let colonnadeTerms = widgetColonnade $ mconcat
-            [ sortable Nothing "Kürzel" $ \(Entity tid _, _) -> anchorCell
+            [ sortable (Just "term-id") "Kürzel" $ \(Entity tid _, _) -> anchorCell
                 (TermCourseListR tid)
                 [whamlet|#{toPathPiece tid}|]
             , sortable (Just "lecture-start") (i18nCell MsgLectureStart) $ \(Entity _ Term{..},_) ->
@@ -75,7 +76,7 @@ getTermShowR = do
             , sortable (Just "lecture-end") "Ende Vorlesungen"   $ \(Entity _ Term{..},_) ->
                 cell $ formatTime SelFormatDate termLectureEnd >>= toWidget
             , sortable Nothing "Aktiv" $ \(Entity _ Term{..},_) ->
-                textCell (bool "" tickmark termActive :: Text)
+                tickmarkCell termActive
             , sortable Nothing "Kurse" $ \(_, E.Value numCourses) ->
                 cell [whamlet|_{MsgNumCourses numCourses}|]
             , sortable (Just "start") "Semesteranfang" $ \(Entity _ Term{..},_) ->
@@ -103,7 +104,8 @@ getTermShowR = do
 --                       #{termToText termName}
 --                 |]
 --           ]
-      table <- runDB $ dbTableWidget' def DBTable
+      let validator = def & defaultSorting [SortDescBy "term-id"]
+      table <- runDB $ dbTableWidget' validator DBTable
         { dbtSQLQuery = termData
         , dbtRowKey = (E.^. TermId)
         , dbtColonnade = colonnadeTerms
@@ -121,6 +123,9 @@ getTermShowR = do
             , ( "lecture-end"
               , SortColumn $ \term -> term E.^. TermLectureEnd
               )
+            , ( "term-id"
+              , SortColumn $ \term -> term E.^. TermId
+              )
             ]
         , dbtFilter = Map.fromList
             [ ( "active"
@@ -148,7 +153,7 @@ getTermEditR = do
   mbLastTerm <- runDB $ selectFirst [] [Desc TermName]
   let template = case mbLastTerm of
         Nothing -> mempty
-        (Just Entity{ entityVal=Term{..} }) -> let
+        (Just Entity{ entityVal=Term{..}}) -> let
             ntid = succ termName
             seas = season ntid
             yr   = year   ntid

src/Handler/Users.hs

@@ -1,6 +1,8 @@
 module Handler.Users where
 
 import Import
+
+import Jobs
 -- import Data.Text
 import Handler.Utils
 
@@ -154,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
@@ -170,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)
@@ -196,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

src/Handler/Utils.hs

@@ -70,12 +70,3 @@ warnTermDays tid times = do
   forM_ outoflecture  $ warnI MsgDayIsOutOfLecture
   forM_ outoftermdays $ warnI MsgDayIsOutOfTerm
 
-visibleWidget :: Bool -> Widget
--- ^ @visibleWidget False@ is an icon that denotes that something™ is not visible
-visibleWidget True = mempty
-visibleWidget False = [whamlet|<i .fas .fa-eye-slash>|]
-
-commentWidget :: Bool -> Widget
--- ^ @commentWidget True@ is an icon that denotes that something™ has a comment
-commentWidget True  = [whamlet|<i .fas .fa-comment-alt>|]
-commentWidget False = mempty

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

src/Handler/Utils/Form.hs

@@ -156,10 +156,11 @@ natIntField ::(Monad m, RenderMessage (HandlerSite m) FormMessage) => Text -> Fi
 natIntField = natField
 
 posIntField :: (Monad m, Integral i, RenderMessage (HandlerSite m) FormMessage) => Text -> Field m i
-posIntField d = checkBool (>= 1) (T.append  d " muss eine positive Zahl sein.") intField
+posIntField d = checkBool (> 0) (T.append  d " muss eine positive Zahl sein.") intField
 
+-- | Field to request integral number > 'm'
 minIntField :: (Monad m, Integral i, Show i, RenderMessage (HandlerSite m) FormMessage) => i -> Text -> Field m i
-minIntField m d = checkBool (>= m) (T.concat [d," muss größer als ", T.pack $ show m, " sein."]) intField
+minIntField m d = checkBool (> m) (T.concat [d," muss größer als ", T.pack $ show m, " sein."]) intField
 
 pointsField :: (Monad m, HandlerSite m ~ UniWorX) => Field m Points --TODO allow fractions
 pointsField = checkBool (>= 0) MsgPointsNotPositive Field{..}
@@ -289,7 +290,6 @@ multiFileField permittedFiles' = Field{..}
       Right _ -> return ()
       Left  r -> yield r
 
-
 data SheetGrading' = Points' | PassPoints' | PassBinary'
   deriving (Eq, Ord, Read, Show, Enum, Bounded)
 

src/Handler/Utils/Table/Cells.hs

@@ -12,7 +12,11 @@ import Handler.Utils
 
 type CourseLink = (TermId, SchoolId, CourseShorthand) -- TODO: Refactor with WithHoles !
 
---------------------
+----------------
+-- Some basic cells are defined in Handler.Utils.Table.Pagination
+-- such as: i18nCell, cellTooltip, anchorCell for links, etc.
+
+----------------
 -- Special cells
 
 tellCell :: (Monoid a, IsDBTable m a) => a -> DBCell m a -> DBCell m a
@@ -27,6 +31,23 @@ indicatorCell = writerCell . tell $ Any True
 writerCell :: IsDBTable m w => WriterT w m () -> DBCell m w
 writerCell act = mempty & cellContents %~ (<* act)
 
+maybeCell :: (IsDBTable m a) => Maybe a -> (a -> DBCell m a) -> DBCell m a
+maybeCell =flip foldMap
+
+
+---------------------
+-- Icon cells
+
+tickmarkCell :: (IsDBTable m a) => Bool -> DBCell m a
+tickmarkCell = cell . toWidget . hasTickmark
+
+commentCell :: IsDBTable m a => Maybe (Route UniWorX) -> DBCell m a
+commentCell Nothing     = mempty
+commentCell (Just link) = anchorCell link icon
+  where icon = toWidget $ hasComment True
+
+
+-----------------
 -- Datatype cells
 timeCell :: IsDBTable m a => UTCTime -> DBCell m a
 timeCell t = cell $ formatTime SelFormatDateTime t >>= toWidget
@@ -34,15 +55,21 @@ 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 :: (IsDBTable m c, HasUser a) => a -> DBCell m c
 cellHasUser = liftA2 userCell (view _userDisplayName) (view _userSurname)
 
-cellHasUserLink :: (IsDBTable m a, HasEntity u User) => (CryptoUUIDUser -> Route UniWorX) -> u -> DBCell m a
+cellHasUserLink :: (IsDBTable m c, HasEntity u User) => (CryptoUUIDUser -> Route UniWorX) -> u -> DBCell m c
+-- cellHasUserLink toLink user =
+--   let uid   = user ^. hasEntityUser . _entityKey
+--       nWdgt = nameWidget (user ^. hasEntityUser . _entityVal . _userDisplayName) (user ^. hasEntityUser .  _entityVal . _userSurname)
+--   in  anchorCellM (toLink <$> encrypt uid) nWdgt
 cellHasUserLink toLink user =
-  let uid   = user ^. _entityKey
+  let userEntity = user ^. hasEntityUser
-      nWdgt = nameWidget (user ^. _entityVal . _userDisplayName) (user ^. _entityVal . _userSurname)
+      uid   = userEntity ^. _entityKey
+      nWdgt = nameWidget (userEntity ^. _entityVal . _userDisplayName) (userEntity ^.  _entityVal . _userSurname)
   in  anchorCellM (toLink <$> encrypt uid) nWdgt
 
+
 cellHasMatrikelnummer :: (IsDBTable m a, HasUser c) => c -> DBCell m a
 cellHasMatrikelnummer = maybe mempty textCell . view _userMatrikelnummer
 
@@ -124,8 +151,26 @@ correctorLoadCell sc =
   i18nCell $ sheetCorrectorLoad sc
 
 
-commentCell :: IsDBTable m a => Maybe (Route UniWorX) -> DBCell m a
+--------------------------------
-commentCell Nothing     = mempty
+-- Generic Columns
-commentCell (Just link) = anchorCell link icon
+-- reuse encourages consistency
+--
+-- if it works out, turn into its own module
+-- together with filters and sorters
+
+
+-- | Does not work, since we have now show Instance for RenderMesage UniWorX msg
+colUser :: (IsDBTable m c, HasUser a, RenderMessage UniWorX msg, Show msg) => msg -> Colonnade Sortable a  (DBCell m c)
+colUser msg = sortable (Just $ fromString $ show msg) (i18nCell msg) cellHasUser
+
+colUserParticipant :: (IsDBTable m c, HasUser a) => Colonnade Sortable a  (DBCell m c)
+colUserParticipant = sortable (Just "participant") (i18nCell MsgCourseMembers) cellHasUser
+
+colUserMatriclenr ::  (IsDBTable m c, HasUser a) => Colonnade Sortable a (DBCell m c)
+colUserMatriclenr = sortable (Just "matriclenumber") (i18nCell MsgMatrikelNr) cellHasMatrikelnummer
+
+colUserParticipantLink :: (IsDBTable m c, HasEntity a User) => TermId -> SchoolId -> CourseShorthand -> Colonnade Sortable a (DBCell m c)
+colUserParticipantLink tid ssh csh = sortable (Just "participant") (i18nCell MsgCourseMembers) (cellHasUserLink courseLink)
   where
-    icon = commentWidget True
+    -- courseLink :: CryptoUUIDUser -> Route UniWorX
+    courseLink = CourseR tid ssh csh . CUserR

src/Handler/Utils/Table/Pagination.hs

@@ -23,7 +23,7 @@ module Handler.Utils.Table.Pagination
   , widgetColonnade, formColonnade, dbColonnade
   , cell, textCell, stringCell, i18nCell
   , anchorCell, anchorCell', anchorCellM, anchorCellM'
-  , tickmarkCell, cellTooltip
+  , cellTooltip
   , listCell
   , formCell, DBFormResult, getDBFormResult
   , dbRow, dbSelect
@@ -780,7 +780,8 @@ pagesizeField psLim = selectField $ do
   return . toOptionList . toNullable $ pagesizeOptions psLim
 
 
---- DBCell utility functions
+---------------------------------------------------------------
+--- DBCell utility functions, more in Handler.Utils.Table.Cells
 
 cell :: IsDBTable m a => Widget -> DBCell m a
 cell wgt = dbCell # ([], return wgt)
@@ -794,10 +795,6 @@ i18nCell msg = cell $ do
   mr <- getMessageRender
   toWidget $ mr msg
 
-tickmarkCell :: (IsDBTable m a) => Bool -> DBCell m a
-tickmarkCell True  = textCell (tickmark :: Text)
-tickmarkCell False = mempty
-
 cellTooltip :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a -> DBCell m a
 cellTooltip msg = cellContents.mapped %~ (<> tipWdgt)
   where
@@ -807,7 +804,6 @@ cellTooltip msg = cellContents.mapped %~ (<> tipWdgt)
           <div .tooltip__content>_{msg}
       |]
 
-
 anchorCell :: IsDBTable m a => Route UniWorX -> Widget -> DBCell m a
 anchorCell = anchorCellM . return
 

src/Handler/Utils/Templates.hs

@@ -18,7 +18,7 @@ modal modalTrigger modalContent = do
         <a .modal__trigger href=#{route'} ##{triggerId}>
           <span .modal__trigger-label>^{modalTrigger}
       |]
-    Right _     -> -- do
+    Right _     ->
       [whamlet|
         $newline never
         <div .modal__trigger ##{triggerId}>

src/Jobs/Handler/QueueNotification.hs

@@ -2,7 +2,9 @@ module Jobs.Handler.QueueNotification
   ( dispatchJobQueueNotification
   ) where
 
-import Import
+import Import hiding ((\\))
+
+import Data.List (nub, (\\))
 
 import Jobs.Types
 
@@ -53,6 +55,20 @@ determineNotificationCandidates NotificationCorrectionsNotDistributed{nSheet}
       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 $ nub $ affectedUser <> affectedAdmins
+
 
 classifyNotification :: Notification -> DB NotificationTrigger
 classifyNotification NotificationSubmissionRated{..} = do
@@ -65,5 +81,6 @@ classifyNotification NotificationSheetSoonInactive{} = return NTSheetSoonInactiv
 classifyNotification NotificationSheetInactive{} = return NTSheetInactive
 classifyNotification NotificationCorrectionsAssigned{} = return NTCorrectionsAssigned
 classifyNotification NotificationCorrectionsNotDistributed{} = return NTCorrectionsNotDistributed
+classifyNotification NotificationUserRightsUpdate{} = return NTUserRightsUpdate
 
 

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 ()

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))
+

src/Jobs/Types.hs

@@ -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

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
 
 

src/Utils.hs

@@ -123,17 +123,51 @@ instance HasRoute site (SomeRoute site) where
   urlRoute (SomeRoute url) = urlRoute url
 
 
+-- | A @Widget@ for any site; no language interpolation, etc.
+type WidgetSiteless = forall site. forall m. (MonadIO m, MonadThrow m, MonadBaseControl IO m)
+  => WidgetT site m ()
+
+
+-----------
+-- Icons --
+-----------
+
+isVisible :: Bool -> Markup
+-- ^ Display an icon that denotes that something™ is visible or invisible
+isVisible True  = [shamlet|<i .fas .fa-eye>|]
+isVisible False = [shamlet|<i .fas .fa-eye-slash>|]
+--
+-- For documentation on how to avoid these unneccessary functions
+-- we implement them here just once for the first icon:
+--
+isVisibleWidget :: Bool -> WidgetSiteless
+-- ^ Widget having an icon that denotes that something™ is visible or invisible
+isVisibleWidget = toWidget . isVisible
+
+maybeIsVisibleWidget :: Maybe Bool -> WidgetSiteless
+-- ^ Maybe a widget with an icon that denotes that something™ is visible or invisible
+maybeIsVisibleWidget = toWidget . foldMap isVisible
+
+-- Other _frequently_ used icons:
+hasComment :: Bool -> Markup
+-- ^ Display an icon that denotes that something™ has a comment or not
+hasComment True  = [shamlet|<i .fas .fa-comment-alt>|]
+hasComment False = [shamlet|<i .fas .fa-comment-slash>|] -- comment-alt-slash is not available for free
+
+hasTickmark :: Bool -> Markup
+-- ^ Display an icon that denotes that something™ is okay
+hasTickmark True  = [shamlet|<i .fas .fa-check>|]
+hasTickmark False = mempty
+
 ---------------------
 -- Text and String --
 ---------------------
 
-tickmark :: IsString a => a
+-- DEPRECATED: use hasTickmark instead;
-tickmark = fromString "✔"
+-- maybe reinstate if needed for @bewertung.txt@ files
--- Avoid annoying warnings:
+
-tickmarkS :: String
+-- tickmark :: IsString a => a
-tickmarkS = tickmark
+-- tickmark = fromString "✔"
-tickmarkT :: Text
-tickmarkT = tickmark
 
 text2Html :: Text -> Html
 text2Html = toHtml -- prevents ambiguous types

src/Utils/Form.hs

@@ -5,6 +5,7 @@ module Utils.Form where
 import ClassyPrelude.Yesod hiding (addMessage, cons, Proxy(..))
 import Settings
 
+-- import Text.Blaze (toMarkup) -- for debugging
 import qualified Text.Blaze.Internal as Blaze (null)
 import qualified Data.Text as T
 
@@ -44,6 +45,38 @@ renderAForm formLayout aform fragment = do
   let widget = $(widgetFile "widgets/form/form")
   return (res, widget)
 
+-- | special id to identify form section headers, see 'aformSection' and 'formSection'
+--   currently only treated by form generation through 'renderAForm'
+idFormSectionNoinput :: Text
+idFormSectionNoinput = "form-section-noinput"
+
+-- | Generates a form having just a form-section-header and no input title.
+--   Currently only correctly rendered by 'renderAForm' and mforms using 'widget/form.hamlet'
+--   Usage:
+--   @
+--      (,) <$  formSection MsgInt
+--          <*> areq intField "int here" Nothing
+--          <*  formSection MsgDouble
+--          <*> areq doubleField "double there " Nothing
+--          <*  submitButton
+--   @
+--   If tooltips or other attributes are required, see 'formSection\'' instead.
+aformSection :: (MonadHandler m, site ~ HandlerSite m, RenderMessage site msg) => msg -> AForm m ()
+aformSection = formToAForm . fmap (second pure) . formSection
+
+formSection :: (MonadHandler m, site ~ HandlerSite m, RenderMessage site msg) => msg -> MForm m (FormResult (), FieldView site) -- TODO: WIP, delete
+formSection formSectionTitle = do
+    mr <- getMessageRender
+    return (FormSuccess (), FieldView
+      { fvLabel    = toHtml $ mr formSectionTitle
+      , fvTooltip  = Nothing
+      , fvId       = idFormSectionNoinput
+      , fvErrors   = Nothing
+      , fvRequired = False
+      , fvInput    = mempty
+      })
+
+
 --------------------
 -- Field Settings --
 --------------------
@@ -323,6 +356,13 @@ submitButtonView = do
 -- Custom Fields --
 -------------------
 
+-- | empty field that has no view and always succeeds, useful for form sections having only a label
+noinputField :: Monad m => Field m ()
+noinputField = Field  { fieldEnctype = UrlEncoded
+                      , fieldParse = const $ const $ return $ Right $ Just ()
+                      , fieldView  = \_theId _name _attrs _val _isReq -> mempty
+                      }
+
 ciField :: ( Textual t
            , CI.FoldCase t
            , Monad m
@@ -386,6 +426,24 @@ optionsFinite = do
       }
   return . mkOptionList $ mkOption <$> universeF
 
+-------------------
+-- Special Forms --
+-------------------
+
+-- | Alternative implementation for 'aformSection' in a more standard that
+--  allows tooltips and arbitrary attributs. Section header must be given through `fsLabel`
+aformSection' :: (MonadHandler m, site ~ HandlerSite m, RenderMessage site FormMessage) => FieldSettings site -> AForm m ()
+aformSection' = formToAForm . fmap (second pure) . formSection'
+
+-- | Alternative implementation for 'formSection' in a more standard that
+--  allows tooltips and arbitrary attributs. Section header must be given through `fsLabel`
+formSection' :: (MonadHandler m, site ~ HandlerSite m, RenderMessage site FormMessage) =>
+   FieldSettings site  -> MForm m (FormResult (), FieldView site) -- TODO: WIP, delete
+formSection' formSectionTitleSettings = mreq noinputField sectionSettings Nothing
+  where
+    sectionSettings = formSectionTitleSettings { fsId = Just idFormSectionNoinput }
+
+
 
 ---------------------
 -- Form evaluation --
@@ -453,3 +511,5 @@ prismAForm :: Monad m => Prism' s a -> Maybe s ->  (Maybe a -> AForm m a) -> AFo
 prismAForm p outer form = review p <$> form inner
   where
     inner = outer >>= preview p
+
+

src/Utils/Lens.hs

@@ -26,34 +26,48 @@ _InnerJoinRight :: Lens' (E.InnerJoin l r) r
 _InnerJoinRight f (E.InnerJoin l r) = (l `E.InnerJoin`) <$> f r
 
 
--- makeLenses_ ''Entity
+-----------------------------------
-makeClassyFor_ "HasEntity" "hasEntity" ''Entity
+-- Lens Definitions for our Types
--- 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
 
+-- makeLenses_ ''User
 makeClassyFor_ "HasUser" "hasUser" ''User
 -- > :info HasUser
--- class HasUser c where {-# MINIMAL hasUser #-}
+-- class HasUser c where
---   hasUser :: Lens' c User
+--   hasUser :: Lens' c User -- MINIMAL
 --   _userDisplayName :: Lens' c Text
 --   _userSurname :: Lens' c Text
 --   _user...
 --
 
--- TODO: Is this instance needed?
+
-instance (HasUser a) => HasUser (Entity a) where
+makeLenses_ ''Entity
-  hasUser = _entityVal . hasUser
+-- BUILD SERVER FAILS TO MAKE HADDOCK FOR THE ONE BELOW:
--- This is what we would want instead:
+-- makeClassyFor_ "HasEntity" "hasEntity" ''Entity
+-- class HasEntity c record | c -> record where
+--   hasEntity :: Lens' c (Entity record)
+--
+-- Manual definition, explicitely leaving out the unwanted Functional Dependency, since we want Instances differing on the result-type
+class HasEntity c record where
+  hasEntity :: Lens' c (Entity record)
+
+-- Typed convenience to avoid type signatures, due to the missing FunctionalDepenency that we do not want.
+hasEntityUser :: (HasEntity a User) => Lens' a (Entity User)
+hasEntityUser = hasEntity
+
+-- This is what we would want, but is an UndecidableInstance since the type is not reduced:
 -- instance (HasEntity a User) => HasUser a where
---   hasUser = _entityVal
+--   hasUser = hasEntityUser
+--
+-- Possible, but rather useless:
+-- instance (HasUser a) => HasUser (Entity a) where
+--   hasUser = _entityVal . hasUser
 
 
 makeLenses_ ''SheetCorrector

src/Utils/Lens/TH.hs

@@ -6,7 +6,8 @@ import Control.Lens.Internal.FieldTH
 import Language.Haskell.TH
 
 -- import Control.Lens.Misc
-{-  NOTE: The code for lensRules_  and makeLenses_ was stolen from package lens-misc-0.0.2.0,
+{-
+    NOTE: The code for lensRules_  and makeLenses_ was stolen from package lens-misc-0.0.2.0,
     which was currently unavailable in our stack snapshot.
     See https://github.com/louispan/lens-misc
 -}
@@ -16,7 +17,7 @@ lensRules_ :: LensRules
 lensRules_ = lensRules
     & lensField .~ \_ _ n -> [TopName (mkName ('_':nameBase n))]
 
--- | Like lensRules_, but different class and function name
+-- | Like @lensRules_@, but different class and function name
 classyRulesFor_ :: ClassyNamer -> LensRules
 classyRulesFor_ clsNamer = classyRules
     & lensClass .~ clsNamer

src/Utils/TH.hs

@@ -49,6 +49,23 @@ altFun perm = lamE pat rhs
         ps  = [ xs !! (j-1) | j <- perm ]
         fn  = mkName "fn"
 
+-- |
+curryN :: Int -> ExpQ
+curryN n = do
+  fn <- newName "foo"
+  xs <- replicateM n $ newName "x"
+  let pat = map VarP (fn:xs)
+  let tup = TupE (map VarE xs)
+  let rhs = AppE (VarE fn) tup
+  return $ LamE pat rhs
+
+uncurryN :: Int -> ExpQ
+uncurryN n = do
+  fn <- newName "foo"
+  xs <- replicateM n $ newName "x"
+  let pat = [VarP fn, TupP (map VarP xs)]
+  let rhs = foldl AppE (VarE fn) (map VarE xs)
+  return $ LamE pat rhs
 
 
 -- Special Show-Instances for Themes

static/css/utils/form.scss

@@ -11,6 +11,12 @@ fieldset {
   margin-bottom: 0;
 }
 
+@media (min-width: 769px) {
+  .form-group__input {
+    grid-column: 2;
+  }
+}
+
 [data-autosubmit][type="submit"] {
   animation: fade-in 500ms ease-in-out backwards;
   animation-delay: 500ms;

static/css/utils/inputs.scss

@@ -13,8 +13,16 @@
   border-left: 2px solid transparent;
 
   + .form-group {
-    margin-top: 13px;
+    margin-top: 7px;
   }
+
+  + .form-section-title {
+    margin-top: 40px;
+  }
+}
+
+.form-section-title {
+  color: var(--color-fontsec);
 }
 
 .form-group__label {
@@ -22,6 +30,12 @@
   padding-top: 6px;
 }
 
+.form-group__hint {
+  margin-top: 7px;
+  color: var(--color-fontsec);
+  font-size: 0.9rem;
+}
+
 .form-group--required {
 
   .form-group__label::after {

static/js/utils/asyncTable.js

@@ -18,7 +18,7 @@
     var scrollTable;
 
     function init() {
-    var table = wrapper.querySelector('#' + tableIdent);
+      var table = wrapper.querySelector('#' + tableIdent);
 
       if (!table) {
         return;

static/js/utils/checkAll.js

@@ -0,0 +1,117 @@
+(function() {
+  'use strict';
+
+  window.utils = window.utils || {};
+
+  var JS_INITIALIZED_CLASS = 'js-check-all-initialized';
+  var CHECKBOX_SELECTOR    = '[type="checkbox"]';
+
+  function getCheckboxId() {
+    return 'check-all-checkbox-' + Math.floor(Math.random() * 100000);
+  }
+
+  window.utils.checkAll = function(wrapper, options) {
+
+    if (!wrapper || wrapper.classList.contains(JS_INITIALIZED_CLASS)) {
+      return false;
+    }
+    options = options || {};
+
+    var columns = [];
+    var checkboxColumn = [];
+    var checkAllCheckbox = null;
+
+    function init() {
+
+      columns = gatherColumns(wrapper);
+
+      setupCheckAllCheckbox(findCheckboxColumn(columns));
+
+      wrapper.classList.add(JS_INITIALIZED_CLASS);
+    }
+
+    function gatherColumns(table) {
+      var rows = Array.from(table.querySelectorAll('tr'));
+      var cols = [];
+      rows.forEach(function(tr) {
+        var cells = Array.from(tr.querySelectorAll('td'));
+        cells.forEach(function(cell, cellIndex) {
+          if (!cols[cellIndex]) {
+            cols[cellIndex] = [];
+          }
+          cols[cellIndex].push(cell);
+        });
+      });
+      return cols;
+    }
+
+    function findCheckboxColumn(columns) {
+      var checkboxColumnId = null;
+      columns.forEach(function(col, i) {
+        if (isCheckboxColumn(col)) {
+          checkboxColumnId = i;
+        }
+      });
+      return checkboxColumnId;
+    }
+
+    function isCheckboxColumn(col) {
+      var onlyCheckboxes = true;
+      col.forEach(function(cell) {
+        if (onlyCheckboxes && !cell.querySelector(CHECKBOX_SELECTOR)) {
+          onlyCheckboxes = false;
+        }
+      });
+      return onlyCheckboxes;
+    }
+
+    function setupCheckAllCheckbox(columnId) {
+      if (columnId === null) {
+        return;
+      }
+
+      checkboxColumn = columns[columnId];
+      var firstRow = wrapper.querySelector('tr');
+      var th = Array.from(firstRow.querySelectorAll('th, td'))[columnId];
+      th.innerHTML = 'test';
+      checkAllCheckbox = document.createElement('input');
+      checkAllCheckbox.setAttribute('type', 'checkbox');
+      checkAllCheckbox.setAttribute('id', getCheckboxId());
+      th.innerHTML = '';
+      th.insertBefore(checkAllCheckbox, null);
+      window.utils.setup('checkboxRadio', checkAllCheckbox);
+
+      checkAllCheckbox.addEventListener('input', onCheckAllCheckboxInput);
+      setupCheckboxListeners();
+    }
+
+    function onCheckAllCheckboxInput() {
+      toggleAll(checkAllCheckbox.checked);
+    }
+
+    function setupCheckboxListeners() {
+      checkboxColumn
+        .map(function(cell) {
+          return cell.querySelector(CHECKBOX_SELECTOR);
+        })
+        .forEach(function(checkbox) {
+          checkbox.addEventListener('input', updateCheckAllCheckboxState);
+        });
+    }
+
+    function updateCheckAllCheckboxState() {
+      var allChecked = checkboxColumn.reduce(function(acc, cell) {
+        return acc && cell.querySelector(CHECKBOX_SELECTOR).checked;
+      }, true);
+      checkAllCheckbox.checked = allChecked;
+    }
+
+    function toggleAll(checked) {
+      checkboxColumn.forEach(function(cell) {
+        cell.querySelector(CHECKBOX_SELECTOR).checked = checked;
+      });
+    }
+
+    init();
+  };
+})();

templates/adminTest.hamlet

@@ -37,4 +37,4 @@
     <li>
       ^{modal "Email-Test" (Right emailWidget')}
     <li>
-      ^{visibleWidget False}
+      Some icons: ^{isVisible False} ^{hasComment True}

templates/adminUser.hamlet

@@ -1,3 +1,5 @@
+<p>
+  <a href="mailto:#{userEmail}">#{userEmail}
 <form method=post action=@{AdminUserR uuid} enctype=#{formEnctype}>
   ^{formWidget}
   ^{submitButtonView}

templates/data-protection-de.hamlet

@@ -1,7 +1,6 @@
 <div .container>
   <section>
-    <h2>Stand
+    <h2>Stand 19.02.2019
-    <h3>Version 0.91 vom 22.5.2018
     <p>
       Die LMU unterliegt als Körperschaft des öffentlichen Rechts dem
       bayerischen Datenschutzgesetz, in einigen Bereichen dem Bundesdatenschutzgesetz,

templates/featureList.hamlet

@@ -14,7 +14,7 @@
       <h4>
         neue geplante Features:
       <ul>
-        <li> Stundenplan/Kalender
+        <li> Stundenplan/Kalender mit Veranstaltungen und Klausuren
         <li> Vollständige Vorlesungshomepages
         <li> Vollständige Internationalisierung deutsch/englisch/...
 

templates/formPage.hamlet

@@ -1,2 +1,5 @@
+$newline never
+$#TODO: anchor must be generic for working with multiple forms
+<a id="forms">
 <form method=post action=@{actionUrl}#forms enctype=#{formEnctype}>
   ^{formWidget}

templates/formPageI18n.hamlet

@@ -1,5 +1,8 @@
+$newline never
 $maybe text <- formText
-  <h3>
+  <h2>
     _{text}
+$#TODO: anchor must be generic for working with multiple forms
+<a id="forms">
 <form method=post action=@{actionUrl}#forms enctype=#{formEnctype}>
-   ^{formWidget}
+  ^{formWidget}

templates/infoLecturer.hamlet

@@ -1,40 +1,79 @@
 
 UniWorX erfahrene Veranstalter finden
 hier die wichtigsten Neuerungen.
+<section>
+  <h2>Bekannte Probleme in Bearbeitung
+
+  <dl .deflist>
+    $#
+    $# MOVE ITEM TO SECTION "VERANSTALTUNGEN", once it is implemented:
+    $#
+    <dt .deflist__dt> Kurs Assistenten
+    <dd .deflist__dd>
+      Momentan ist leider nur ein Dozent/Veranstalter pro Kurs erlaubt.
+
+      <p>
+        <h4>Folgendes ist in Vorbereitung:
+        Kurs-Veranstalter dürfen <em>beliebige</em> Personen
+        ebenfalls zu Veranstaltern des Kurses machen.
+
+        Innerhalb des Kurses haben alle Kurs-Veranstalter die
+        gleichen Befugnisse und können insbesondere auch die
+        Liste der Veranstalter dieses Kurses bearbeiten.
+
+      <p>
+        <h4>Unterschied zu UniWorX:
+
+        In Uni2work gibt es die Rollen "Dozent"
+        und "Veranstalter":
+        Dozenten dürfen im Wesentlichen neue Kurse erstellen.
+        Veranstalter haben vollen Zugriff auf einen speziellen Kurs.
+
+        Die Dozenten Berechtigung wird nach Instituten unterschieden.
+
+      <p>
+        In UniWorX gab es die Rolle "Assistent",
+        d.h. alle "Veranstalter" mussten auch "Dozent" sein;
+        eine Unterscheidung nach Instituten gab es nicht.
+
+    <dt .deflist__dt> Kurs Teilnehmer
+    <dd .deflist__dd>
+      Anzeige und Benachrichtigung angemeldeter
+      Kurs-Teilnehmer ist leider noch nicht fertig implementiert.
+      Voraussichtlich vor Start des Sommersemesters 2019 verfügbar.
+
+
 <section>
   <h2>Veranstaltungen
 
   <dl .deflist>
     <dt .deflist__dt> Kurskürzel
     <dd .deflist__dd>
-      Alle Veranstaltungen müssen ein Kürzel zur Identifikation besitzen,
+      <p>
-      z.B. EiP, ProMo, SysPrak, etc.
+        Alle Veranstaltungen müssen ein Kürzel zur Identifikation besitzen,
-      <br>
+        z.B. EiP, ProMo, SysPrak, etc.
-      Das Kürzel muss innerhalb Institut und Semester eindeutig sein.
+      <p>
+        Das Kürzel muss innerhalb Institut und Semester eindeutig sein.
 
     <dt .deflist__dt> Kurse klonen
     <dd .deflist__dd>
-      Veranstalter können <em>alle</em> Kurse Ihres Instituts für das aktuelle Semesters klonen.
+      <p>
-      <br>
+        Veranstalter können <em>alle</em> Kurse Ihres Instituts für das aktuelle Semesters klonen.
-      Dabei werden vor allem Kurskürzel und die Kursbeschreibung übernommen;
-      nicht jedoch Übungsblätter, Klausuren oder Anmeldungen.
-      <br>
-      Die Kursbeschreibung kann in Html verfasst werden und
-      <em>sollte die Modulbeschreibung enthalten!
 
-    <dt .deflist__dt> Passwort
+        Dabei werden vor allem Kurskürzel und die Kursbeschreibung übernommen;
-    <dd .deflist__dd> Die Anmeldung zum Kurs kann durch ein Passwort geschützt werden.
+        nicht jedoch Übungsblätter, Klausuren oder Anmeldungen.
+      <pr>
+        Die Kursbeschreibung kann in Html verfasst werden und
+        <em>sollte die Modulbeschreibung enthalten!
 
     <dt .deflist__dt> Materialzugriff
     <dd .deflist__dd>
       Der Zugriff auf Übungsblätter, Folien und andere Materialien
       kann von der Anmeldung zum Kurs abhängig gemacht werden.
 
-    <dt .deflist__dt> Teilnehmer
+    <dt .deflist__dt> Kurs Passwort
-    <dd .deflist__dd>
+    <dd .deflist__dd> Die Anmeldung zum Kurs kann durch ein Passwort geschützt werden.
-      Anzeige und Benachrichtigung angemeldeter
+
-      Teilnehmer ist leider noch nicht fertig implementiert.
-      Voraussichtlich noch vor Start des Sommersemesters 2019 verfügbar.
 
 <section>
   <h2>Übungsbetrieb
@@ -53,7 +92,7 @@ hier die wichtigsten Neuerungen.
     <dt .deflist__dt> Verteilung
     <dd .deflist__dd>
       Korrektoren können pro Blatt auch als Abwesend oder Entschuldigt
-      markiert werden und bekommen dann keine Abgaben zugeteilt.
+      markiert werden und bekommen dann keine Abgaben automatisch zugeteilt.
 
       Abwesende Korrektoren bekommen in späteren Blättern
       mehr Abgaben zugeteilt, entsprechend ihres
@@ -75,15 +114,19 @@ hier die wichtigsten Neuerungen.
     <dt .deflist__dt> Sichtbarkeit
     <dd .deflist__dd>
       Übungsblätter können bis zu einem Datum vor den Teilnehmern versteckt werden.
+      <p>
+        Die Aufgabenstellung ist erst mit Eröffnung der Abgabe erhältlich,
+        so wie bisher in UniWorX auch.
 
     <dt .deflist__dt> Zeitstempel
     <dd .deflist__dd>
-      Alle Dateien eines Übungsblattes sind mit einem
+      <p>
-      für Teilnehmer sichtbaren Zeitstempel versehen.
+        Alle Dateien eines Übungsblattes sind mit einem
-      <br>
+        für Teilnehmer sichtbaren Zeitstempel versehen.
-      Eine visuelle Hervorhebung geänderter/neuer Dateien
+      <p>
-      und entsprechende Benachrichtigungen sind geplant,
+        Eine visuelle Hervorhebung geänderter/neuer Dateien
-      aber noch nicht verfügbar.
+        und entsprechende Benachrichtigungen sind geplant,
+        aber noch nicht verfügbar.
 
     <dt .deflist__dt> Übungsgruppen
     <dd .deflist__dd>

templates/mail/userRightsUpdate.hamlet

@@ -0,0 +1,35 @@
+$newline never
+\<!doctype html>
+<html>
+  <head>
+    <meta charset="UTF-8">
+    <style>
+      h1 {
+        font-size: 1.25em;
+        font-variant: small-caps;
+        font-weight: normal;
+      }
+  <body>
+    <h1>
+      _{MsgMailUserRightsIntro userDisplayName userEmail}
+    $with numSchools <- length adminSchools
+      $if numSchools > 0
+        <p>
+          <h2>_{MsgAdminFor} _{MsgForSchools numSchools}
+          <ul>
+            $forall sn <- adminSchools
+              <li>#{sn}
+    $with numSchools <- length lecturerSchools
+      $if numSchools > 0
+        <p>
+          <h2>_{MsgLecturerFor} _{MsgForSchools numSchools}
+          <ul>
+            $forall sn <- lecturerSchools
+              <li>#{sn}
+        <p>
+          <a href=@{CourseNewR}>
+            _{MsgMailLecturerRights numSchools}
+      $else
+        <p>_{MsgMailNoLecturerRights}
+
+    ^{editNotifications}

templates/table/layout.julius

@@ -1,10 +1,11 @@
 document.addEventListener('DOMContentLoaded', function() {
   var dbtIdent = #{String $ dbtIdent};
   var headerDBTableShortcircuit = #{String (toPathPiece HeaderDBTableShortcircuit)};
-  var selector = '#' + dbtIdent + '-table-wrapper:not(.js-initialized)';
+  var selector = '#' + dbtIdent + '-table-wrapper';
   var wrapper = document.querySelector(selector);
 
   if (wrapper) {
     window.utils.setup('asyncTable', wrapper, { headerDBTableShortcircuit, dbtIdent });
+    window.utils.setup('checkAll', wrapper);
   }
 });

templates/versionHistory.hamlet

@@ -1,6 +1,4 @@
 <div .container>
-  <h3>
-    Re-Implementierung von <a href="https://uniworx.ifi.lmu.de/">UniWorX</a>
 
   <section>
     ^{features}
@@ -8,13 +6,13 @@
   <section>
     <h2>
       Bekannte Bugs
+    <h3>
+      Stand: Februar 2019
     <ul>
       <li>
-        Login ist u.U. anders als im alten System, z.B. <span style="font-family:monospace">@campus.lmu.de</span> statt <span style="font-family:monospace">@lmu.de</span>
+        Login ist u.U. anders als im alten System, z.B. momentan geht nur <span style="font-family:monospace">@campus.lmu.de</span> aber nicht die Abkürzung <span style="font-family:monospace">@lmu.de</span>
       <li>
-        Favicon ist default des Frameworks
+        Format von Bewertungsdateien ist noch provisorisch
-      <li>
-        Format von Bewertungsdateien ist provisorisch
 
   <section>
     <h2>

templates/widgets/footer/footer.hamlet

@@ -8,5 +8,5 @@
           $#   menuItemModal :: Bool -- ^ Should this menu item open a modal instead of being a normal link
           $#   menuItemIcon :: Maybe Text -- ^ Should this menu item have an icon, if yes, then the name of the icon
           <a href=#{route} ##{menuIdent}>
-            _{SomeMessage menuItemLabel} #
+            _{SomeMessage menuItemLabel}
         $of _

templates/widgets/form/form.hamlet

@@ -7,14 +7,17 @@ $case formLayout
       ^{fvInput view}
   $of _
     $forall view <- fieldViews
-      $# TODO: add class 'form-group--submit' if this is the submit-button view
+      $if fvId view == idFormSectionNoinput
-      <div .form-group :fvRequired view:.form-group--required :not $ fvRequired view:.form-group--optional :isJust $ fvErrors view:.form-group--has-error>
+        <h3 .form-section-title>
-        $if not (Blaze.null $ fvLabel view)
+          ^{fvLabel view}
-          <label .form-group__label for=#{fvId view}>
+      $else
-            #{fvLabel view}
+        <div .form-group :fvRequired view:.form-group--required :not $ fvRequired view:.form-group--optional :isJust $ fvErrors view:.form-group--has-error>
-            $maybe tooltip <- fvTooltip view
+          $if not (Blaze.null $ fvLabel view)
-              <div .tooltip>
+            <label .form-group__label for=#{fvId view}>
-                <div .tooltip__handle>
+              #{fvLabel view}
-                <div .tooltip__content>^{tooltip}
+              $maybe hint <- fvTooltip view
-        <div .form-group__input>
+                <div .form-group__hint>^{hint}
-          ^{fvInput view}
+          <div .form-group__input>
+            ^{fvInput view}
+            $maybe err <- fvErrors view
+              <div .form-error>#{err}

templates/widgets/rating/rating.hamlet

@@ -18,4 +18,4 @@ $maybe points <- submissionRatingPoints
           _{MsgNotPassed}
     , _{SheetTypeHeader sheetType}
   $nothing
-    #{tickmarkS}
+    #{hasTickmark True}

test/Database.hs

@@ -218,9 +218,22 @@ fillDb = do
   repsert sdInf  $ StudyTerms  79 (Just "IfI") (Just "Institut für Informatik")
   repsert sdMath $ StudyTerms 105 (Just "MI" ) (Just "Mathematisches Institut")
   -- FFP
+  let nbrs :: [Int]
+      nbrs = [1,2,3,27,7,1]
   ffp <- insert' Course
     { courseName = "Fortgeschrittene Funktionale Programmierung"
-    , courseDescription = Nothing
+    , courseDescription = Just [shamlet|
+        <h2>It is fun!
+          <p>Come to where the functional is!
+          <section>
+            <h3>Functional programming can be done in Haskell!
+            <p>This is not a joke, this is serious!
+          <section>
+            <h3>Consider some numbers
+            <ul>
+              $forall n <- nbrs
+                <li>Number #{n}
+        |]
     , courseLinkExternal = Nothing
     , courseShorthand = "FFP"
     , courseTerm = TermKey summer2018
@@ -354,7 +367,7 @@ fillDb = do
   -- datenbanksysteme
   dbs <- insert' Course
     { courseName = "Datenbanksysteme"
-    , courseDescription = Nothing
+    , courseDescription = Just "Datenbanken banken Daten damit die Daten nicht wanken. Die Datenschützer danken!"
     , courseLinkExternal = Nothing
     , courseShorthand = "DBS"
     , courseTerm = TermKey summer2018