Merge branch 'master' into modal-migration
This commit is contained in:
Felix Hamann
commit
1999b494c3
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
7
routes
7
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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -78,6 +78,8 @@ import qualified Crypto.Saltine.Core.SecretBox as SecretBox
|
||||
import qualified Database.Memcached.Binary.IO as Memcached
|
||||
import Data.Bits (Bits(zeroBits))
|
||||
|
||||
import Network.Wai.Parse (lbsBackEnd)
|
||||
|
||||
|
||||
instance DisplayAble b => DisplayAble (E.CryptoID a b) where
|
||||
display = display . ciphertext
|
||||
@ -891,6 +893,8 @@ instance Yesod UniWorX where
|
||||
. runIdentity
|
||||
$ sourceList (Lazy.ByteString.toChunks content) $$ sinkHash
|
||||
|
||||
fileUpload _site _length = FileUploadMemory lbsBackEnd
|
||||
|
||||
-- What messages should be logged. The following includes all messages when
|
||||
-- in development, and warnings and errors in production.
|
||||
shouldLog _ _ _ = error "Must use shouldLogIO"
|
||||
@ -1016,6 +1020,7 @@ siteLayout' headingOverride widget = do
|
||||
addScript $ StaticR js_utils_alerts_js
|
||||
addScript $ StaticR js_utils_asidenav_js
|
||||
addScript $ StaticR js_utils_asyncTable_js
|
||||
addScript $ StaticR js_utils_checkAll_js
|
||||
addScript $ StaticR js_utils_form_js
|
||||
addScript $ StaticR js_utils_inputs_js
|
||||
addScript $ StaticR js_utils_modal_js
|
||||
@ -1069,12 +1074,14 @@ instance YesodBreadcrumbs UniWorX where
|
||||
breadcrumb (AdminUserR _) = return ("Users" , Just UsersR)
|
||||
|
||||
breadcrumb InfoR = return ("Information" , Nothing)
|
||||
breadcrumb ImpressumR = return ("Impressum" , Just InfoR)
|
||||
breadcrumb InfoLecturerR = return ("Veranstalter" , Just InfoR)
|
||||
breadcrumb DataProtR = return ("Datenschutz" , Just InfoR)
|
||||
breadcrumb VersionR = return ("Impressum" , Just InfoR)
|
||||
breadcrumb ImpressumR = return ("Impressum" , Just InfoR)
|
||||
breadcrumb VersionR = return ("Versionsgeschichte", Just InfoR)
|
||||
|
||||
|
||||
breadcrumb HelpR = return ("Hilfe" , Just HomeR)
|
||||
breadcrumb InfoLecturerR = return ("Veranstalter" , Just HelpR)
|
||||
|
||||
|
||||
breadcrumb ProfileR = return ("User" , Just HomeR)
|
||||
breadcrumb ProfileDataR = return ("Profile" , Just ProfileR)
|
||||
@ -1161,6 +1168,14 @@ defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, return MenuItem
|
||||
{ menuItemType = Footer
|
||||
, menuItemLabel = MsgMenuInformation
|
||||
, menuItemIcon = Just "info"
|
||||
, menuItemRoute = SomeRoute InfoR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, do
|
||||
mCurrentRoute <- getCurrentRoute
|
||||
|
||||
@ -1273,6 +1288,16 @@ pageActions (HomeR) =
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (InfoR) = [
|
||||
MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgInfoLecturerTitle
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute InfoLecturerR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (VersionR) = [
|
||||
MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
@ -1284,14 +1309,14 @@ pageActions (VersionR) = [
|
||||
}
|
||||
]
|
||||
pageActions (HelpR) = [
|
||||
MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgInfoLecturerTitle
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute InfoLecturerR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
-- MenuItem
|
||||
-- { menuItemType = PageActionPrime
|
||||
-- , menuItemLabel = MsgInfoLecturerTitle
|
||||
-- , menuItemIcon = Nothing
|
||||
-- , menuItemRoute = SomeRoute InfoLecturerR
|
||||
-- , menuItemModal = False
|
||||
-- , menuItemAccessCallback' = return True
|
||||
-- }
|
||||
]
|
||||
pageActions (ProfileR) =
|
||||
[ MenuItem
|
||||
@ -1349,6 +1374,16 @@ pageActions (CourseListR) =
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (CourseNewR) = [
|
||||
MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
, menuItemLabel = MsgInfoLecturerTitle
|
||||
, menuItemIcon = Nothing
|
||||
, menuItemRoute = SomeRoute InfoLecturerR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
]
|
||||
pageActions (CourseR tid ssh csh CShowR) =
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionPrime
|
||||
@ -1370,6 +1405,14 @@ pageActions (CourseR tid ssh csh CShowR) =
|
||||
}
|
||||
] ++ pageActions (CourseR tid ssh csh SheetListR) ++
|
||||
[ MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuCourseMembers
|
||||
, menuItemIcon = Just "user-graduate"
|
||||
, menuItemRoute = SomeRoute $ CourseR tid ssh csh CUsersR
|
||||
, menuItemModal = False
|
||||
, menuItemAccessCallback' = return True
|
||||
}
|
||||
, MenuItem
|
||||
{ menuItemType = PageActionSecondary
|
||||
, menuItemLabel = MsgMenuCourseEdit
|
||||
, menuItemIcon = Nothing
|
||||
@ -1683,14 +1726,22 @@ pageHeading HomeR
|
||||
= Just $ i18nHeading MsgHomeHeading
|
||||
pageHeading UsersR
|
||||
= Just $ i18nHeading MsgUsers
|
||||
pageHeading (AdminTestR)
|
||||
= Just $ [whamlet|Internal Code Demonstration Page|]
|
||||
pageHeading (AdminUserR _)
|
||||
= Just $ i18nHeading MsgAdminUserHeading
|
||||
pageHeading (AdminTestR)
|
||||
= Just $ [whamlet|Internal Code Demonstration Page|]
|
||||
pageHeading (AdminErrMsgR)
|
||||
= Just $ i18nHeading MsgErrMsgHeading
|
||||
pageHeading (VersionR)
|
||||
|
||||
pageHeading (InfoR)
|
||||
= Just $ i18nHeading MsgInfoHeading
|
||||
pageHeading (DataProtR)
|
||||
= Just $ i18nHeading MsgDataProtHeading
|
||||
pageHeading (ImpressumR)
|
||||
= Just $ i18nHeading MsgImpressumHeading
|
||||
pageHeading (VersionR)
|
||||
= Just $ i18nHeading MsgVersionHeading
|
||||
|
||||
pageHeading (HelpR)
|
||||
= Just $ i18nHeading MsgHelpRequest
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 = sortable (Just "course") (i18nCell MsgCourse) $ do
|
||||
course <- view $ _dbrOutput . _1 . _entityVal
|
||||
return $ courseCell course
|
||||
-- colCourseDescr :: IsDBTable m a => Colonnade Sortable CourseTableData (DBCell m a)
|
||||
-- colCourseDescr = sortable (Just "course") (i18nCell MsgCourse) $ do
|
||||
-- course <- view $ _dbrOutput . _1 . _entityVal
|
||||
-- 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 = sortable (Just "cshort") (i18nCell MsgCourseShort)
|
||||
$ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _) } -> mappend
|
||||
( anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) [whamlet|#{display courseShorthand}|] )
|
||||
( case courseDescription of
|
||||
Nothing -> mempty
|
||||
(Just descr) -> cell
|
||||
[whamlet|
|
||||
$newline never
|
||||
<div>
|
||||
^{modal "Beschreibung" (Right $ toWidget descr)}
|
||||
|]
|
||||
)
|
||||
-- colCShortDescr :: IsDBTable m a => Colonnade _ CourseTableData (DBCell m a)
|
||||
-- colCShortDescr = sortable (Just "cshort") (i18nCell MsgCourseShort)
|
||||
-- $ \DBRow{ dbrOutput=(Entity _ Course{..}, _, _, _) } -> mappend
|
||||
-- ( anchorCell (CourseR courseTerm courseSchool courseShorthand CShowR) [whamlet|#{display courseShorthand}|] )
|
||||
-- ( case courseDescription of
|
||||
-- Nothing -> mempty
|
||||
-- (Just descr) -> cell
|
||||
-- [whamlet|
|
||||
-- $newline never
|
||||
-- <div>
|
||||
-- ^{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 UserTableWhere = UserTableExpr -> E.SqlExpr (E.Value Bool)
|
||||
type UserTableData = DBRow (Entity User, Entity CourseParticipant, Maybe (Key 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 UserTableData = DBRow (Entity User, E.Value UTCTime, E.Value (Maybe CourseUserNoteId))
|
||||
|
||||
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
|
||||
forceUserTableType :: (UserTableExpr -> a) -> (UserTableExpr -> a)
|
||||
forceUserTableType = id
|
||||
|
||||
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
|
||||
|
||||
instance HasUser UserTableData where
|
||||
hasUser = _entityVal
|
||||
return (user, participant E.^. CourseParticipantRegistration, note E.?. CourseUserNoteId)
|
||||
|
||||
instance HasEntity UserTableData User where
|
||||
hasEntity = _dbrOutput . _1
|
||||
|
||||
-- -- there can be only one -- FunctionalDependency violation
|
||||
-- instance HasEntity UserTableData CourseParticipant where
|
||||
-- hasEntity = _dbrOutput . _2
|
||||
instance HasUser UserTableData where
|
||||
-- hasUser = _entityVal
|
||||
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)
|
||||
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 :: IsDBTable m a => TermId -> SchoolId -> CourseShorthand -> Colonnade Sortable 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
|
||||
makeUserTable _whereClause _colChoices _psValidator =
|
||||
-- do
|
||||
-- dbTable psValidator DBTable
|
||||
-- { userTableQUery whereClause
|
||||
-- ,
|
||||
return [whamlet| Course user table not yet implemented |]
|
||||
-- makeCourseUserTable :: (ToSortable h, Functor h) =>
|
||||
-- UserTableWhere
|
||||
-- -> Colonnade
|
||||
-- h
|
||||
-- (DBRow
|
||||
-- (Entity User, E.Value UTCTime,
|
||||
-- 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
|
||||
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
|
||||
Entity cid course <- runDB $ getBy404 $ TermSchoolCourseShort tid ssh csh
|
||||
let heading = [whamlet|_{MsgMenuCourseMembers} #{courseName course} #{display tid}|]
|
||||
whereClause = courseIs cid
|
||||
colChoices = mconcat
|
||||
[ colUserParticipantLink tid ssh csh
|
||||
, colUserMatriclenr
|
||||
-- ,colUserComment tid ssh csh
|
||||
]
|
||||
psValidator = def
|
||||
tableWidget <- runDB $ makeCourseUserTable whereClause colChoices psValidator
|
||||
siteLayout heading $ do
|
||||
setTitle [shamlet| #{toPathPiece tid} - #{csh}|]
|
||||
[whamlet|
|
||||
User table not yet implemented
|
||||
$# ^{tableWidget}
|
||||
|]
|
||||
-- TODO: creat hamlet wrapper
|
||||
tableWidget
|
||||
|
||||
|
||||
|
||||
|
||||
@ -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 <> ")"
|
||||
|
||||
@ -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 SelFormatDate) (fslI MsgDateFormat) (stgDate <$> template)
|
||||
<*> areq (selectField $ dateTimeFormatOptions SelFormatTime) (fslI MsgTimeFormat) (stgTime <$> template)
|
||||
<*> areq checkBoxField (fslI MsgDownloadFiles
|
||||
& setTooltip MsgDownloadFilesTip
|
||||
) (stgDownloadFiles <$> template)
|
||||
<*> (NotificationSettings <$> funcForm nsForm (fslI MsgNotificationSettings) True)
|
||||
<* submitButton
|
||||
<*> areq (selectField $ dateTimeFormatOptions SelFormatDateTime) (fslI MsgDateTimeFormat) (stgDateTime <$> template)
|
||||
<*> areq (selectField $ dateTimeFormatOptions SelFormatDate) (fslI MsgDateFormat) (stgDate <$> template)
|
||||
<*> areq (selectField $ dateTimeFormatOptions SelFormatTime) (fslI MsgTimeFormat) (stgTime <$> template)
|
||||
<* aformSection MsgFormBehaviour
|
||||
<*> areq checkBoxField (fslI MsgDownloadFiles
|
||||
& setTooltip MsgDownloadFilesTip
|
||||
) (stgDownloadFiles <$> template)
|
||||
<* 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)
|
||||
|
||||
@ -10,18 +10,19 @@ import qualified Data.Set as Set
|
||||
import qualified Data.List.NonEmpty as NonEmpty
|
||||
|
||||
import Handler.Utils
|
||||
import Handler.Utils.Table.Cells
|
||||
|
||||
import Utils.Lens
|
||||
|
||||
import qualified Database.Esqueleto as E
|
||||
|
||||
|
||||
|
||||
htmlField' :: Field (HandlerT UniWorX IO) Html
|
||||
htmlField' = htmlField
|
||||
{ fieldParse = \vs fis -> fieldParse htmlField (map Text.strip vs) fis
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
getMessageR, postMessageR :: CryptoUUIDSystemMessage -> Handler Html
|
||||
getMessageR = postMessageR
|
||||
@ -88,7 +89,7 @@ postMessageR cID = do
|
||||
]
|
||||
addMessageI Success MsgSystemMessageEditTranslationSuccess
|
||||
redirect $ MessageR cID
|
||||
|
||||
|
||||
let
|
||||
messageEditModal = modal [whamlet|_{MsgSystemMessageEdit}|] $ Right
|
||||
[whamlet|
|
||||
@ -113,7 +114,7 @@ postMessageR cID = do
|
||||
|
||||
maySubmit <- (== Authorized) <$> evalAccess (MessageR cID) True
|
||||
forms <- traverse (const mkForm) $ () <$ guard maySubmit
|
||||
|
||||
|
||||
defaultLayout
|
||||
$(widgetFile "system-message")
|
||||
where
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
31
src/Handler/Utils/Database.hs
Normal file
31
src/Handler/Utils/Database.hs
Normal file
@ -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
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -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
|
||||
nWdgt = nameWidget (user ^. _entityVal . _userDisplayName) (user ^. _entityVal . _userSurname)
|
||||
let userEntity = user ^. hasEntityUser
|
||||
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
|
||||
commentCell (Just link) = anchorCell link icon
|
||||
--------------------------------
|
||||
-- Generic Columns
|
||||
-- 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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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}>
|
||||
|
||||
@ -2,7 +2,9 @@ module Jobs.Handler.QueueNotification
|
||||
( dispatchJobQueueNotification
|
||||
) where
|
||||
|
||||
import Import
|
||||
import Import hiding ((\\))
|
||||
|
||||
import Data.List (nub, (\\))
|
||||
|
||||
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 $ nub $ 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
|
||||
|
||||
|
||||
|
||||
@ -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 ()
|
||||
|
||||
27
src/Jobs/Handler/SendNotification/UserRightsUpdate.hs
Normal file
27
src/Jobs/Handler/SendNotification/UserRightsUpdate.hs
Normal file
@ -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))
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
|
||||
48
src/Utils.hs
48
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
|
||||
tickmark = fromString "✔"
|
||||
-- Avoid annoying warnings:
|
||||
tickmarkS :: String
|
||||
tickmarkS = tickmark
|
||||
tickmarkT :: Text
|
||||
tickmarkT = tickmark
|
||||
-- DEPRECATED: use hasTickmark instead;
|
||||
-- maybe reinstate if needed for @bewertung.txt@ files
|
||||
|
||||
-- tickmark :: IsString a => a
|
||||
-- tickmark = fromString "✔"
|
||||
|
||||
text2Html :: Text -> Html
|
||||
text2Html = toHtml -- prevents ambiguous types
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
|
||||
@ -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
|
||||
-- class HasEntity c record | c -> record where
|
||||
-- hasEntity :: Lens' c (Entity record)
|
||||
-----------------------------------
|
||||
-- Lens Definitions for our Types
|
||||
|
||||
|
||||
-- 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 #-}
|
||||
-- hasUser :: Lens' c User
|
||||
-- class HasUser c where
|
||||
-- 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
|
||||
hasUser = _entityVal . hasUser
|
||||
-- This is what we would want instead:
|
||||
|
||||
makeLenses_ ''Entity
|
||||
-- BUILD SERVER FAILS TO MAKE HADDOCK FOR THE ONE BELOW:
|
||||
-- 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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -24,7 +24,7 @@ projNI n i = lamE [pat] rhs
|
||||
where pat = tupP (map varP xs)
|
||||
rhs = varE (xs !! (i - 1))
|
||||
xs = [ mkName $ "x" ++ show j | j <- [1..n] ]
|
||||
|
||||
|
||||
---------------
|
||||
-- Functions --
|
||||
---------------
|
||||
@ -34,21 +34,38 @@ permuteFun perm = lamE pat rhs
|
||||
where pat = map varP $ fn:xs
|
||||
rhs = foldl appE (varE fn) $ map varE ps
|
||||
-- rhs = appE (varE fn) (varE $ xs!!1)
|
||||
ln = length perm
|
||||
ln = length perm
|
||||
xs = [ mkName $ "x" ++ show j | j <- [1..ln] ]
|
||||
ps = [ xs !! (j-1) | j <- perm ]
|
||||
fn = mkName "fn"
|
||||
fn = mkName "fn"
|
||||
|
||||
altFun :: [Int] -> ExpQ -- generic permutation/repetition of function arguments, i.e. $(permuteFun [2,1]) == flip
|
||||
altFun perm = lamE pat rhs
|
||||
where pat = map varP $ fn:xs
|
||||
rhs = foldl appE (varE fn) $ map varE ps
|
||||
-- rhs = appE (varE fn) (varE $ xs!!1)
|
||||
-- rhs = appE (varE fn) (varE $ xs!!1)
|
||||
mx = maximum $ impureNonNull perm
|
||||
xs = [ mkName $ "x" ++ show j | j <- [1..mx] ]
|
||||
ps = [ xs !! (j-1) | j <- perm ]
|
||||
fn = mkName "fn"
|
||||
|
||||
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
|
||||
@ -105,10 +122,10 @@ embedRenderMessage f inner mangle = do
|
||||
|
||||
f' <- newName "f"
|
||||
ls <- newName "ls"
|
||||
|
||||
|
||||
pure <$> instanceD (cxt []) [t|RenderMessage $(conT f) $(conT inner)|]
|
||||
[ funD 'renderMessage
|
||||
[ clause [varP f', varP ls] (normalB $ [e|renderMessage $(varE f') $(varE ls) . $(lamCaseE matches)|]) []
|
||||
[ clause [varP f', varP ls] (normalB $ [e|renderMessage $(varE f') $(varE ls) . $(lamCaseE matches)|]) []
|
||||
]
|
||||
]
|
||||
|
||||
@ -129,13 +146,13 @@ embedRenderMessageVariant f newT mangle = do
|
||||
|
||||
f' <- newName "f"
|
||||
ls <- newName "ls"
|
||||
|
||||
|
||||
pure <$> instanceD (cxt []) [t|RenderMessage $(conT f) $(conT newT)|]
|
||||
[ funD 'renderMessage
|
||||
[ clause [varP f', varP ls] (normalB $ [e|renderMessage $(varE f') $(varE ls) . $(lamCaseE matches)|]) []
|
||||
[ clause [varP f', varP ls] (normalB $ [e|renderMessage $(varE f') $(varE ls) . $(lamCaseE matches)|]) []
|
||||
]
|
||||
]
|
||||
|
||||
|
||||
|
||||
dispatchTH :: Name -- ^ Datatype to pattern match
|
||||
-> ExpQ
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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 {
|
||||
|
||||
@ -18,7 +18,7 @@
|
||||
var scrollTable;
|
||||
|
||||
function init() {
|
||||
var table = wrapper.querySelector('#' + tableIdent);
|
||||
var table = wrapper.querySelector('#' + tableIdent);
|
||||
|
||||
if (!table) {
|
||||
return;
|
||||
|
||||
117
static/js/utils/checkAll.js
Normal file
117
static/js/utils/checkAll.js
Normal file
@ -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();
|
||||
};
|
||||
})();
|
||||
@ -37,4 +37,4 @@
|
||||
<li>
|
||||
^{modal "Email-Test" (Right emailWidget')}
|
||||
<li>
|
||||
^{visibleWidget False}
|
||||
Some icons: ^{isVisible False} ^{hasComment True}
|
||||
|
||||
@ -1,3 +1,5 @@
|
||||
<p>
|
||||
<a href="mailto:#{userEmail}">#{userEmail}
|
||||
<form method=post action=@{AdminUserR uuid} enctype=#{formEnctype}>
|
||||
^{formWidget}
|
||||
^{submitButtonView}
|
||||
|
||||
@ -1,7 +1,6 @@
|
||||
<div .container>
|
||||
<section>
|
||||
<h2>Stand
|
||||
<h3>Version 0.91 vom 22.5.2018
|
||||
<h2>Stand 19.02.2019
|
||||
<p>
|
||||
Die LMU unterliegt als Körperschaft des öffentlichen Rechts dem
|
||||
bayerischen Datenschutzgesetz, in einigen Bereichen dem Bundesdatenschutzgesetz,
|
||||
|
||||
@ -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/...
|
||||
|
||||
|
||||
@ -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}
|
||||
|
||||
@ -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}
|
||||
|
||||
@ -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,
|
||||
z.B. EiP, ProMo, SysPrak, etc.
|
||||
<br>
|
||||
Das Kürzel muss innerhalb Institut und Semester eindeutig sein.
|
||||
<p>
|
||||
Alle Veranstaltungen müssen ein Kürzel zur Identifikation besitzen,
|
||||
z.B. EiP, ProMo, SysPrak, etc.
|
||||
<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.
|
||||
<br>
|
||||
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!
|
||||
<p>
|
||||
Veranstalter können <em>alle</em> Kurse Ihres Instituts für das aktuelle Semesters klonen.
|
||||
|
||||
<dt .deflist__dt> Passwort
|
||||
<dd .deflist__dd> Die Anmeldung zum Kurs kann durch ein Passwort geschützt werden.
|
||||
Dabei werden vor allem Kurskürzel und die Kursbeschreibung übernommen;
|
||||
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
|
||||
<dd .deflist__dd>
|
||||
Anzeige und Benachrichtigung angemeldeter
|
||||
Teilnehmer ist leider noch nicht fertig implementiert.
|
||||
Voraussichtlich noch vor Start des Sommersemesters 2019 verfügbar.
|
||||
<dt .deflist__dt> Kurs Passwort
|
||||
<dd .deflist__dd> Die Anmeldung zum Kurs kann durch ein Passwort geschützt werden.
|
||||
|
||||
|
||||
<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
|
||||
für Teilnehmer sichtbaren Zeitstempel versehen.
|
||||
<br>
|
||||
Eine visuelle Hervorhebung geänderter/neuer Dateien
|
||||
und entsprechende Benachrichtigungen sind geplant,
|
||||
aber noch nicht verfügbar.
|
||||
<p>
|
||||
Alle Dateien eines Übungsblattes sind mit einem
|
||||
für Teilnehmer sichtbaren Zeitstempel versehen.
|
||||
<p>
|
||||
Eine visuelle Hervorhebung geänderter/neuer Dateien
|
||||
und entsprechende Benachrichtigungen sind geplant,
|
||||
aber noch nicht verfügbar.
|
||||
|
||||
<dt .deflist__dt> Übungsgruppen
|
||||
<dd .deflist__dd>
|
||||
|
||||
35
templates/mail/userRightsUpdate.hamlet
Normal file
35
templates/mail/userRightsUpdate.hamlet
Normal file
@ -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}
|
||||
@ -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);
|
||||
}
|
||||
});
|
||||
|
||||
@ -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
|
||||
<li>
|
||||
Format von Bewertungsdateien ist provisorisch
|
||||
Format von Bewertungsdateien ist noch provisorisch
|
||||
|
||||
<section>
|
||||
<h2>
|
||||
|
||||
@ -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 _
|
||||
|
||||
@ -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
|
||||
<div .form-group :fvRequired view:.form-group--required :not $ fvRequired view:.form-group--optional :isJust $ fvErrors view:.form-group--has-error>
|
||||
$if not (Blaze.null $ fvLabel view)
|
||||
<label .form-group__label for=#{fvId view}>
|
||||
#{fvLabel view}
|
||||
$maybe tooltip <- fvTooltip view
|
||||
<div .tooltip>
|
||||
<div .tooltip__handle>
|
||||
<div .tooltip__content>^{tooltip}
|
||||
<div .form-group__input>
|
||||
^{fvInput view}
|
||||
$if fvId view == idFormSectionNoinput
|
||||
<h3 .form-section-title>
|
||||
^{fvLabel view}
|
||||
$else
|
||||
<div .form-group :fvRequired view:.form-group--required :not $ fvRequired view:.form-group--optional :isJust $ fvErrors view:.form-group--has-error>
|
||||
$if not (Blaze.null $ fvLabel view)
|
||||
<label .form-group__label for=#{fvId view}>
|
||||
#{fvLabel view}
|
||||
$maybe hint <- fvTooltip view
|
||||
<div .form-group__hint>^{hint}
|
||||
<div .form-group__input>
|
||||
^{fvInput view}
|
||||
$maybe err <- fvErrors view
|
||||
<div .form-error>#{err}
|
||||
|
||||
@ -18,4 +18,4 @@ $maybe points <- submissionRatingPoints
|
||||
_{MsgNotPassed}
|
||||
, _{SheetTypeHeader sheetType}
|
||||
$nothing
|
||||
#{tickmarkS}
|
||||
#{hasTickmark True}
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user